Commit 5c9454f3 authored by Bas Lijnse's avatar Bas Lijnse

More improvements on the ad-hoc tasks

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1146 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent d3457649
......@@ -9,7 +9,8 @@ Start :: !*World -> *World
Start world = startEngine workflows world
where
workflows = [ workflow "Groups" manageGroups
: flatten [ messaging, toolbox, lists ]
, workflow "Ask opinions" askOpinions
: flatten [ messaging, lists ]
]
messaging :: [Workflow]
......@@ -19,11 +20,6 @@ messaging
, workflow "Messaging/View Message Archive" viewArchive
]
toolbox :: [Workflow]
toolbox
= [ workflow "Toolbox/Pick a date" pickADate
]
lists :: [Workflow]
lists = [ workflow "List Management/New List" newList
, workflow "List Management/Edit List" editList
......
......@@ -7,6 +7,7 @@ from Time import :: Timestamp
from TaskTree import :: GroupedBehaviour, :: GroupActionsBehaviour
:: Subject s = Subject !s & toString s
:: Description s = Description !s & toString s
:: Tag s = Tag !s & toString s
:: Tags s = Tags ![s] & toString s
......@@ -18,6 +19,7 @@ class tune b :: !b !(Task a) -> Task a
instance tune ManagerProperties //Set initial properties
instance tune User //Set initial worker
instance tune (Subject s) //Set initial subject
instance tune (Description s) //Set initial subject
instance tune TaskPriority //Set initial priority
instance tune Timestamp //Set initial deadline
instance tune (Tag s) //Append Tag
......
......@@ -11,6 +11,8 @@ instance tune User
where tune u (Task props gprops mbTn tf) = Task {ManagerProperties|props & worker = u} gprops mbTn tf
instance tune (Subject s)
where tune (Subject s) (Task props gprops mbTn tf) = Task {ManagerProperties|props & subject = toString s} gprops mbTn tf
instance tune (Description s)
where tune (Description s) (Task props gprops mbTn tf) = Task {ManagerProperties|props & description = toString s} gprops mbTn tf
instance tune TaskPriority
where tune p (Task props gprops mbTn tf) = Task {ManagerProperties|props & priority = p} gprops mbTn tf
instance tune Timestamp
......
......@@ -2,7 +2,4 @@ definition module Consensus
import iTasks
pickADate :: Task Void
// Date Picking
datePicker :: [User] -> Task Date
\ No newline at end of file
askOpinions :: Task Void
\ No newline at end of file
......@@ -5,65 +5,90 @@ import CommonDomain, Messaging, Groups
derive bimap Maybe, (,)
:: Topic = { topic :: String, description :: Maybe Note}
:: Results a :== [(a,[(User,String)])]
derive class iTask Topic
//========================================================================================================================================================================
// DatePicker
//========================================================================================================================================================================
askOpinions :: Task Void
askOpinions
= defineTopic
>>= \topic ->
defineItemType
>>= \type -> case type of
"Date" = askOpinionsDate topic >>| stop
"Document" = askOpinionsDocument topic >>| stop
"Other" = askOpinionsOther topic >>| stop
:: DateVotes :== (HtmlDisplay [DateVote])
//The type dependent second part of the flow
askOpinionsGeneric :: Topic -> Task (Results a) | iTask a
askOpinionsGeneric topic
= defineItems
>>= \items ->
defineAnswers
>>= \answers ->
defineParticipants
>>= \participants ->
collectOpinions topic items answers participants
>>= showResult
:: DateVote =
{ date :: Date
, vote :: (Editable Vote)
}
askOpinionsDate :: Topic -> Task (Results Date)
askOpinionsDate topic = askOpinionsGeneric topic
:: Vote = Yes | No | Maybe
askOpinionsDocument :: Topic -> Task (Results Document)
askOpinionsDocument topic = askOpinionsGeneric topic
:: VoteCount =
{ date :: Date
, yes :: Int
, no :: Int
, maybe :: Int
}
askOpinionsOther :: Topic -> Task (Results String)
askOpinionsOther topic = askOpinionsGeneric topic
derive class iTask DateVote, Vote, VoteCount
derive gEq Date
defineTopic :: Task Topic
defineTopic
= enterInformation "Define topic" "Please define the topic that you would like to get opinions about"
pickADate :: Task Void
pickADate = enterInformation "Subject" "What is the subject?"
>>= \subj -> getCurrentUser
>>= \me -> updateInformation "Manager" "Who should be managing the decision?" me
>>= \ref -> enterInformation "Choose people" "Who else should be involved in the decision?"
>>= \oth -> (ref @: datePicker [ref:oth])
>>= \date -> broadcast [ref:oth] ("The chosen date for "+++subj+++": ") (Just date)
defineItemType :: Task String
defineItemType
= enterChoice "Define item type" "What type of item(s) would you like to get opinions about" ["Date","Document","Other"]
datePicker :: [User] -> Task Date
datePicker users = pickDates
>>= \dates -> allProc [u @>> voteDates dates \\ u <- users] Open
>>= \votes -> pickFinal votes
defineItems :: Task [a] | iTask a
defineItems
= enterInformation "Define items" "Enter the item(s) you would like to get opinions about"
defineAnswers :: Task [String]
defineAnswers
= (enterInformation "Define answers" "Please define the available answer choices")
-||-
(enterChoice "Common answers" "Or select one of these common answer sets"
[["Yes","No"],["Yes","No","Maybe"],["I agree","I disagree"],["1","2","3","4","5"]] )
defineParticipants :: Task [User]
defineParticipants
= getMyGroups
>>= \groups -> case groups of
[] = enterInformation "Define people" "Enter the people you would like to ask for an opinion"
_ = (enterChoice "Choose a group" "Choose a group..." groups >>= \group -> return group.members)
-||-
(enterInformation "Define people" "Or enter individual people to ask for an opinion")
collectOpinions :: Topic [a] [String] [User] -> Task (Results a) | iTask a
collectOpinions topic items answers participants
= ( Subject"Collecting opinions..." @>>
Description "Waiting for everyone to give their opinion" @>>
allProc [collectOpinion topic user items answers \\ user <- participants ] Open
)
>>= transform (orderByItem items)
where
orderByItem :: [a] [(User,[(a,String)])] -> [(a,[(User,String)])]
orderByItem items opinions = [(item, [(user, snd (options !! i)) \\ (user,options) <- opinions ]) \\ item <- items & i <- [0..]]
collectOpinion :: Topic User [a] [String] -> Task (User,[(a,String)]) | iTask a
collectOpinion topic user items answers
= user @>>
Subject ("Your opinion about: " +++ topic.topic) @>>
(allTasks [enterChoiceAbout ("Option " <+++ i) "What is your opinion about:" item answers \\ item <- items & i <- [1..]] >>= transform (merge items))
where
pickDates :: Task [Date]
pickDates = enterInformation "Pick dates" "Please select date options"
voteDates :: [Date] -> Task DateVotes
voteDates dates = updateInformation "Date preference" "Please indicate your preference" (HtmlDisplay [{DateVote | date = d, vote = (Editable Maybe)} \\ d <- dates])
pickFinal :: [DateVotes] -> Task Date
pickFinal votes
# v = (map fromHtmlDisplay votes)
# init = [{VoteCount | date = dv.DateVote.date, yes = 0, no = 0, maybe = 0} \\ dv <- (hd v)]
# overview = foldl countVotes init v
= enterChoice "Final decision" "Please select the final option" overview
>>= \final -> return final.VoteCount.date
where
countVotes votecount [] = votecount
countVotes votecount [d:ds]
# votecount = [if(d.DateVote.date === vc.VoteCount.date) (updateCount vc d.vote) vc \\ vc <- votecount]
= countVotes votecount ds
updateCount vc=:{yes,no,maybe} (Editable v)
= case v of
Yes = {VoteCount|vc & yes = inc yes}
No = {VoteCount|vc & no = inc no}
Maybe = {VoteCount|vc & maybe = inc maybe}
merge items opinions = (user,zip (items,opinions))
showResult :: (Results a) -> Task (Results a) | iTask a
showResult result = showMessageAbout "Opinions" "The results of your opinion request:" result
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