Commit 99d3bd02 authored by Bas Lijnse's avatar Bas Lijnse

Updated iTaskconf examples

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1140 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent c29dd994
...@@ -14,7 +14,7 @@ derive bimap Maybe, (,) ...@@ -14,7 +14,7 @@ derive bimap Maybe, (,)
manageGroups :: Task Void manageGroups :: Task Void
manageGroups = buildGroups manageGroups = buildGroups
>>= \groups -> updateInformation "Please assign users to groups" groups >>= \groups -> updateInformation "Group assignment" "Please assign users to groups" groups
>>= \ngroups -> getUsers >>= \ngroups -> getUsers
>>= \users -> removeAllGroupsFromUsers users >>= \users -> removeAllGroupsFromUsers users
>>| assignGroupsToUsers ngroups users >>| assignGroupsToUsers ngroups users
...@@ -53,7 +53,7 @@ where ...@@ -53,7 +53,7 @@ where
listGroups :: Task Void listGroups :: Task Void
listGroups = buildGroups listGroups = buildGroups
>>= showMessageAbout "This is the current assignment of roles" >>= showMessageAbout "Role assignment" "This is the current assignment of roles" >>| return Void
getUserGroups :: Task [String] getUserGroups :: Task [String]
getUserGroups = buildGroups getUserGroups = buildGroups
......
...@@ -24,13 +24,7 @@ lists = [ workflow "List Management/New List" newList ...@@ -24,13 +24,7 @@ lists = [ workflow "List Management/New List" newList
, flagged :: Bool , flagged :: Bool
} }
derive gPrint ListDBItem, List, ListItem derive class iTask ListDBItem, List, ListItem
derive gParse ListDBItem, List, ListItem
derive gVisualize ListDBItem, List, ListItem
derive gUpdate ListDBItem, List, ListItem
derive gError ListDBItem, List, ListItem
derive gHint ListDBItem, List, ListItem
derive gMerge ListDBItem, List, ListItem derive gMerge ListDBItem, List, ListItem
derive bimap Maybe, (,) derive bimap Maybe, (,)
...@@ -41,11 +35,11 @@ getListDB = mkDBid "ListDB" ...@@ -41,11 +35,11 @@ getListDB = mkDBid "ListDB"
newList :: Task Void newList :: Task Void
newList = readDB getListDB newList = readDB getListDB
>>= \ldb -> getCurrentUser >>= \ldb -> getCurrentUser
>>= \me -> enterChoice "What kind of list do you want to create?" ["Note","Date","Document"] >>= \me -> enterChoice "Choose list" "What kind of list do you want to create?" ["Note","Date","Document"]
>>= \ltype -> initList ltype >>= \ltype -> initList ltype
>>= \list -> createDB list >>= \list -> createDB list
>>= \dbid -> writeDB getListDB [dbid:ldb] >>= \dbid -> writeDB getListDB [dbid:ldb]
>>| showMessage "List is succesfully created." >>| showMessage "Success" "List is succesfully created." Void
where where
initList :: String -> Task ListDBItem initList :: String -> Task ListDBItem
initList type = case type of initList type = case type of
...@@ -58,9 +52,9 @@ where ...@@ -58,9 +52,9 @@ where
_ _
= initListNote >>= \l -> return (NoteList l) = initListNote >>= \l -> return (NoteList l)
initListNote = enterInformation "Edit List" initListNote = enterInformation "Note list" "Edit List"
initListDate = enterInformation "Edit List" initListDate = enterInformation "Date list" "Edit List"
initListDoc = enterInformation "Edit List" initListDoc = enterInformation "Document list" "Edit List"
editList :: Task Void editList :: Task Void
editList = getCurrentUser editList = getCurrentUser
...@@ -70,18 +64,12 @@ editList = getCurrentUser ...@@ -70,18 +64,12 @@ editList = getCurrentUser
pushList :: Task Void pushList :: Task Void
pushList = getCurrentUser pushList = getCurrentUser
>>= \me -> selectList me >>= \me -> selectList me
>>= \id -> enterInformation "To whom do you want to push this list?" >>= \id -> enterInformation "User" "To whom do you want to push this list?"
>>= \usr -> enterMsg usr >>= \usr -> enterMsg usr
>>= \msg -> usr @: ((showInstructionAbout ("Request to edit list from "+++toString me) "Press 'Done' to continue to the list editor" msg) >>| listEditor id) >>= \msg -> usr @: ((showInstructionAbout ("Request to edit list from "+++toString me) "Press 'Done' to continue to the list editor" msg) >>| listEditor id)
where where
enterMsg :: User -> Task Note enterMsg :: User -> Task Note
enterMsg user = enterInformation ("What would you like ask from "+++toString user+++"?") enterMsg user = enterInformation "Message" ("What would you like ask from "+++toString user+++"?")
/*
pushListItem :: Task Void
pushListItem = getCurrentUser
>>= \me -> selectList me
>>= \id ->
*/
selectList :: User -> Task (DBid (ListDBItem)) selectList :: User -> Task (DBid (ListDBItem))
selectList user selectList user
...@@ -89,7 +77,7 @@ selectList user ...@@ -89,7 +77,7 @@ selectList user
= readDB getListDB = readDB getListDB
>>= \db -> sequence "Reading DB" [getListItem id \\ id <- db] >>= \db -> sequence "Reading DB" [getListItem id \\ id <- db]
>>= \items -> sequence "Get Info" [getListInfo item id \\ item <- items & id <- db | isMember user (getOwners item) || isMember "chair" roles] >>= \items -> sequence "Get Info" [getListInfo item id \\ item <- items & id <- db | isMember user (getOwners item) || isMember "chair" roles]
>>= \info -> enterChoice "Please select the list you wish to edit" info >>= \info -> enterChoice "Choose list" "Please select the list you wish to edit" info
>>= \choice -> return (fromHidden (snd choice)) >>= \choice -> return (fromHidden (snd choice))
where where
getListItem :: (DBid ListDBItem) -> Task ListDBItem getListItem :: (DBid ListDBItem) -> Task ListDBItem
......
...@@ -60,7 +60,7 @@ newMessage = getCurrentUser ...@@ -60,7 +60,7 @@ newMessage = getCurrentUser
newMessageToGroup :: Task Void newMessageToGroup :: Task Void
newMessageToGroup = getCurrentUser newMessageToGroup = getCurrentUser
>>= \me -> getUserGroups >>= \me -> getUserGroups
>>= \groups -> enterChoice "Select group" groups >>= \groups -> enterChoice "Choose group" "Select group" groups
>>= \role -> getUsersWithRole role >>= \role -> getUsersWithRole role
>>= \users -> writeMessage me "" users [] [] >>= \users -> writeMessage me "" users [] []
>>= \msg -> sendMessage msg >>= \msg -> sendMessage msg
...@@ -68,36 +68,36 @@ newMessageToGroup = getCurrentUser ...@@ -68,36 +68,36 @@ newMessageToGroup = getCurrentUser
sendMessage :: Message -> Task Void sendMessage :: Message -> Task Void
sendMessage msg = allProc [who @>> spawnProcess who True True sendMessage msg = allProc [who @>> spawnProcess who True True
((readMessage msg <<@ Subject ("Message from "+++toString (fromHtmlDisplay msg.Message.sender)+++": "+++msg.Message.subject)) <<@ msg.Message.priority) \\ who <- (msg.Message.to ++ if(isJust msg.cc) (fromJust msg.cc) [])] Closed ((readMessage msg <<@ Subject ("Message from "+++toString (fromHtmlDisplay msg.Message.sender)+++": "+++msg.Message.subject)) <<@ msg.Message.priority) \\ who <- (msg.Message.to ++ if(isJust msg.cc) (fromJust msg.cc) [])] Closed
>>| showMessageAbout "The following message has been sent:" msg >>| showMessageAbout "Message sent" "The following message has been sent:" msg >>| return Void
writeMessage :: User String [User] [User] [Message] -> Task Message writeMessage :: User String [User] [User] [Message] -> Task Message
writeMessage me subj to cc thread = updateInformation "Enter your message" {Message | (mkMsg me) & subject = subj, to = to, cc = if(isEmpty cc) Nothing (Just cc), previousMessages = (HtmlDisplay thread)} writeMessage me subj to cc thread = updateInformation "Compose" "Enter your message" {Message | (mkMsg me) & subject = subj, to = to, cc = if(isEmpty cc) Nothing (Just cc), previousMessages = (HtmlDisplay thread)}
readMessage :: Message -> Task Void readMessage :: Message -> Task Void
readMessage msg=:{Message | previousMessages} readMessage msg=:{Message | previousMessages, subject}
= showMessageAboutA "You received a message" [ButtonAction (ActionLabel "Reply",Always), = showMessageAboutA subject "You received a message" [ButtonAction (ActionLabel "Reply",Always),
ButtonAction (ActionLabel "Reply All",Always), ButtonAction (ActionLabel "Forward",Always), ButtonAction (ActionLabel "Delete", Always), ButtonAction (ActionLabel "Archive & Close",Always)] msg ButtonAction (ActionLabel "Reply All",Always), ButtonAction (ActionLabel "Forward",Always), ButtonAction (ActionLabel "Delete", Always), ButtonAction (ActionLabel "Archive & Close",Always)] msg
>>= \act -> case act of >>= \act -> case act of
(ActionLabel "Reply") (ActionLabel "Reply",_)
= getCurrentUser = getCurrentUser
>>= \me -> writeMessage me ("Re: "+++msg.Message.subject) [(fromHtmlDisplay msg.sender)] [] [{Message | msg & previousMessages = (HtmlDisplay [])}:fromHtmlDisplay previousMessages] >>= \me -> writeMessage me ("Re: "+++msg.Message.subject) [(fromHtmlDisplay msg.sender)] [] [{Message | msg & previousMessages = (HtmlDisplay [])}:fromHtmlDisplay previousMessages]
>>= \msg -> sendMessage msg >>= \msg -> sendMessage msg
(ActionLabel "Reply All") (ActionLabel "Reply All",_)
= getCurrentUser = getCurrentUser
>>= \me -> writeMessage me ("Re: "+++msg.Message.subject) [(fromHtmlDisplay msg.sender):[u \\ u <- msg.to | u <> me]] (if(isJust msg.cc) (fromJust msg.cc) []) [{Message | msg & previousMessages = (HtmlDisplay [])}:fromHtmlDisplay previousMessages] >>= \me -> writeMessage me ("Re: "+++msg.Message.subject) [(fromHtmlDisplay msg.sender):[u \\ u <- msg.to | u <> me]] (if(isJust msg.cc) (fromJust msg.cc) []) [{Message | msg & previousMessages = (HtmlDisplay [])}:fromHtmlDisplay previousMessages]
>>= \msg -> sendMessage msg >>= \msg -> sendMessage msg
(ActionLabel "Forward") (ActionLabel "Forward",_)
= getCurrentUser = getCurrentUser
>>= \me -> writeMessage me ("Fw: "+++msg.Message.subject) [] [] [{Message | msg & previousMessages = (HtmlDisplay [])}:fromHtmlDisplay previousMessages] >>= \me -> writeMessage me ("Fw: "+++msg.Message.subject) [] [] [{Message | msg & previousMessages = (HtmlDisplay [])}:fromHtmlDisplay previousMessages]
>>= \msg -> sendMessage msg >>= \msg -> sendMessage msg
(ActionLabel "Archive & Close") (ActionLabel "Archive & Close",_)
= readDB msgDBid = readDB msgDBid
>>= \mdb -> writeDB msgDBid (removeDup [msg:mdb]) >>= \mdb -> writeDB msgDBid (removeDup [msg:mdb])
>>| showMessage "Message stored in archive" >>| showMessage "Archived" "Message stored in archive" Void
(ActionLabel "Delete") (ActionLabel "Delete",_)
= readDB msgDBid = readDB msgDBid
>>= \mdb -> writeDB msgDBid (filter (\dbmsg -> dbmsg <> msg) mdb) >>= \mdb -> writeDB msgDBid (filter (\dbmsg -> dbmsg <> msg) mdb)
>>| showMessage "Message deleted" >>| showMessage "Deleted" "Message deleted" Void
viewArchive :: Task Void viewArchive :: Task Void
viewArchive = getCurrentUser viewArchive = getCurrentUser
...@@ -110,8 +110,8 @@ where ...@@ -110,8 +110,8 @@ where
selectMsg mdb me selectMsg mdb me
# mdbs = filter (\msg -> (isMember me msg.to) || (isMember me (if(isJust msg.cc) (fromJust msg.cc) []))) mdb # mdbs = filter (\msg -> (isMember me msg.to) || (isMember me (if(isJust msg.cc) (fromJust msg.cc) []))) mdb
= case mdb of = case mdb of
[] = showMessage "The archive is empty" >>| return [] [] = showMessage "Empty archive" "The archive is empty" []
_ = enterMultipleChoice "Which messages do you want to view?" mdbs _ = enterMultipleChoice "Select messages" "Which messages do you want to view?" mdbs
//======================================================================================================================================================================== //========================================================================================================================================================================
// Broadcasting // Broadcasting
...@@ -121,5 +121,5 @@ broadcast :: [User] String (Maybe a) -> Task Void | iTask a ...@@ -121,5 +121,5 @@ broadcast :: [User] String (Maybe a) -> Task Void | iTask a
broadcast to msg mbAbout = allProc [spawnProcess who True True show \\ who <- to] Closed >>| return Void broadcast to msg mbAbout = allProc [spawnProcess who True True show \\ who <- to] Closed >>| return Void
where where
show = case mbAbout of show = case mbAbout of
Just a = showMessageAbout msg a Just a = showMessageAbout "TODO" msg a >>| return Void
Nothing = showMessage msg Nothing = showMessage "TODOD" msg Void
\ No newline at end of file \ No newline at end of file
...@@ -40,10 +40,10 @@ derive class iTask DateVote, Vote, VoteCount ...@@ -40,10 +40,10 @@ derive class iTask DateVote, Vote, VoteCount
derive gEq Date derive gEq Date
pickADate :: Task Void pickADate :: Task Void
pickADate = enterInformation "What is the subject?" pickADate = enterInformation "Subject" "What is the subject?"
>>= \subj -> getCurrentUser >>= \subj -> getCurrentUser
>>= \me -> updateInformation "Who should be managing the descision?" me >>= \me -> updateInformation "Manager" "Who should be managing the decision?" me
>>= \ref -> enterInformation "Who else should be involved in the descision?" >>= \ref -> enterInformation "Choose people" "Who else should be involved in the decision?"
>>= \oth -> (ref @: datePicker [ref:oth]) >>= \oth -> (ref @: datePicker [ref:oth])
>>= \date -> broadcast [ref:oth] ("The chosen date for "+++subj+++": ") (Just date) >>= \date -> broadcast [ref:oth] ("The chosen date for "+++subj+++": ") (Just date)
...@@ -53,17 +53,17 @@ datePicker users = pickDates ...@@ -53,17 +53,17 @@ datePicker users = pickDates
>>= \votes -> pickFinal votes >>= \votes -> pickFinal votes
where where
pickDates :: Task [Date] pickDates :: Task [Date]
pickDates = enterInformation "Please select date options" pickDates = enterInformation "Pick dates" "Please select date options"
voteDates :: [Date] -> Task DateVotes voteDates :: [Date] -> Task DateVotes
voteDates dates = updateInformation "Please indicate your preference" (HtmlDisplay [{DateVote | date = d, vote = (Editable Maybe)} \\ d <- dates]) voteDates dates = updateInformation "Date preference" "Please indicate your preference" (HtmlDisplay [{DateVote | date = d, vote = (Editable Maybe)} \\ d <- dates])
pickFinal :: [DateVotes] -> Task Date pickFinal :: [DateVotes] -> Task Date
pickFinal votes pickFinal votes
# v = (map fromHtmlDisplay votes) # v = (map fromHtmlDisplay votes)
# init = [{VoteCount | date = dv.DateVote.date, yes = 0, no = 0, maybe = 0} \\ dv <- (hd v)] # init = [{VoteCount | date = dv.DateVote.date, yes = 0, no = 0, maybe = 0} \\ dv <- (hd v)]
# overview = foldl countVotes init v # overview = foldl countVotes init v
= enterChoice "Please select the final option" overview = enterChoice "Final decision" "Please select the final option" overview
>>= \final -> return final.VoteCount.date >>= \final -> return final.VoteCount.date
where where
countVotes votecount [] = votecount countVotes votecount [] = votecount
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment