implementation module Messages

import iTasks
import Groups

derive class iTask Message
derive bimap Maybe, (,)

:: Message =
	{ messageId			:: Hidden Int
	, subject			:: String
	, sender			:: Display User
	, recipients 		:: [User]
	, priority 			:: TaskPriority
	, needsReply		:: Bool	
	, message			:: Note
	, attachments		:: Maybe [Document]
	, thread 			:: Display [Message]
	}

instance DB Message
where
	databaseId				= sharedStore "Messages" []
	getItemId m				= DBRef (fromHidden m.Message.messageId)
	setItemId (DBRef i) m 	= {Message|m & messageId = toHidden i}

mkMsg :: User -> Message
mkMsg me = { Message
			| messageId		= toHidden 0
			, sender 		= toDisplay me
			, subject		= "New message"
			, recipients 	= []
			, priority 		= NormalPriority
			, needsReply	= False
			, message		= Note ""
		  	, attachments	= Nothing
		   	, thread		= Display []
		   	}

manageMessages :: Task Void
manageMessages =
	(	getMyMessages
	>>= overview
	>>= \res -> case res of
		(ActionOpen,Just message)		= manageMessage message	>>|	return False
		(Action "New message",_) 		= newMessage			>>|	return False
		(Action "New group message",_)	= newGroupMessage		>>| return False
		(ActionQuit,_)					= 							return True
	) <! id >>| return Void
where
	overview :: [Message] -> Task (Action,Maybe Message)
	overview []		= showInformation ("My messages","You have no messages") [] Void >>+ \_ -> UserActions [(aNew,Just (aNew,Nothing)),(aNewGroup,Just (aNewGroup,Nothing)),(aQuit,Just (aQuit,Nothing))]
	overview msgs	= enterChoice ("My messages","Your messages:") [] msgs >>+ \{modelValue,localValid} -> let mbM = if localValid (Just modelValue) Nothing in UserActions [(aOpen,maybe Nothing (\m -> Just (aOpen,Just m)) mbM),(aNew,Just (aNew,Nothing)),(aNewGroup,Just (aNewGroup,Nothing)),(aQuit,Just (aQuit,Nothing))]
	
	aOpen		= ActionOpen
	aNew		= Action "New message"
	aNewGroup	= Action "New group message"
	aQuit		= ActionQuit

manageMessage :: Message -> Task Bool
manageMessage msg=:{Message |subject} 
	= 	showInformation (subject,"You received a message") [About msg] Void >>+ (\_ -> UserActions [(aClose,Just aClose),(aReply,Just aReply),(aReplyAll,Just aReplyAll),(aForward,Just aForward),(aDelete,Just aDelete)])
	>>= \act -> case act of
		ActionClose
			= return False
		(Action "Reply")
			= 			get currentUser
			>>= \me	->	writeMessage me ("Re: " +++ msg.Message.subject) [(fromDisplay msg.sender)] (Just msg)
			>>= \msg -> sendMessage msg
			>>| return True
		(Action "Reply All")
			= 			get currentUser
			>>= \me	->	writeMessage me ("Re: " +++ msg.Message.subject) [(fromDisplay msg.sender):[u \\ u <- msg.recipients | u <> me]] (Just msg)
			>>= \msg -> sendMessage msg
			>>| return True
		(Action "Forward")
			= 			get currentUser 
			>>= \me -> 	writeMessage me ("Fw: " +++ msg.Message.subject) [] (Just msg)
			>>= \msg -> sendMessage msg
			>>| return False
		ActionDelete
			=			dbDeleteItem (getItemId msg)
			>>|			showInformation ("Deleted","Message deleted") [] False	
where
	aReply		= Action "Reply"
	aReplyAll	= Action "Reply All"
	aForward	= Action "Forward"
	aDelete		= ActionDelete
	aClose		= ActionClose

newMessage :: Task Void
newMessage
	=				get currentUser
	>>= \me -> 		writeMessage me "" [] Nothing
	>>= \msg -> 	sendMessage msg

newGroupMessage :: Task Void
newGroupMessage = get currentUser
	>>= \me ->		getMyGroups
	>>= \groups ->	case groups of
		[]	=	showInformation ("No groups","You are not a member of any group") [] Void
		_	=	enterChoice ("Choose group","Select group") [] groups
			>>= \group ->	writeMessage me "" group.members Nothing
			>>= \msg ->		sendMessage msg
	
sendMessage :: Message -> Task Void
sendMessage msg
	=	dbCreateItem msg
	>>= \msg -> case msg.needsReply of
			False	= allTasks [appendTopLevelTask {worker = rcp, priority = msg.Message.priority, deadline = Nothing, status = Active} (subject msg @>> manageMessage msg) \\ rcp <- msg.Message.recipients] >>| return Void
			True	= appendTopLevelTask initManagerProperties (awaitReplies msg) >>| return Void
	>>| showInformation ("Message sent","The following message has been sent:") [About msg] Void
where
	awaitReplies msg =
		Description ("Waiting for reply on " +++ msg.Message.subject) @>>
		case msg.Message.recipients of
			[recipient]	= recipient @: (askReplyTask recipient msg) >>= \answer -> notifyNoReplies [recipient] [answer]
			recipients	= allTasks [askReplyTask rcp msg \\ rcp <- recipients] >>=  notifyNoReplies recipients
	
	askReplyTask user msg =
		subject msg @>>
			((showInformation ("Reply requested","The sender would like to receive a reply to this message.") [] Void >>+ noActions`)
			 ||-
			 manageMessage msg
			 )

	subject msg
		= Description ("Message from " +++ toString (fromDisplay msg.Message.sender)+++ ": "+++msg.Message.subject)
	
	notifyNoReplies recipients answers
		= case [rcp \\ rcp <- recipients & ans <- answers | not ans] of
			[]		= return Void
			users	= showInformation ("Reply request ignored","The following users ignored your request for a reply:") [About users] Void

	noActions` :: (TermFunc a Void) | iTask a
	noActions` = noActions
			
writeMessage :: User String [User] (Maybe Message) -> Task Message
writeMessage sender subj recipients mbThread
	= updateInformation ("Compose","Enter your message") []
		{Message | (mkMsg sender) & subject = subj, recipients = recipients,thread = updateThread mbThread}
where
	updateThread :: (Maybe Message) -> Display [Message] 
	updateThread Nothing	= Display []
	updateThread (Just msg)	= Display [{Message|msg & thread = Display []}:fromDisplay msg.Message.thread]
	
getMyMessages :: Task [Message]
getMyMessages
	=	get currentUser
	>>= \user ->
		dbReadAll
	>>= transform (filter (isRecipient user))
where
	isRecipient user msg = isMember user msg.Message.recipients

getAllMessages ::Task [Message]
getAllMessages = dbReadAll