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]
......@@ -18,11 +19,6 @@ messaging
, workflow "Messaging/Send a new Group-Message" newMessageToGroup
, workflow "Messaging/View Message Archive" viewArchive
]
toolbox :: [Workflow]
toolbox
= [ workflow "Toolbox/Pick a date" pickADate
]
lists :: [Workflow]
lists = [ workflow "List Management/New List" newList
......
......@@ -137,8 +137,8 @@ updateChoiceA subject description actions [] index = throw (subject +++ ": cann
updateChoiceA subject description actions options index = mkInteractiveTask subject (toString (html description)) (makeChoiceTask options index Nothing actions)
enterChoiceAbout :: !String !description b [a] -> Task a | html description & iTask a & iTask b
enterChoiceAbout subject description about [] = throw (subject +++ ": cannot choose from empty option list")
enterChoiceAbout subject description about options = mkInteractiveTask subject (toString (html description)) (ignoreActionA (makeChoiceTask options -1 (Just (visualizeAsHtmlDisplay about)) [ButtonAction (ActionOk, IfValid)]))
enterChoiceAbout subject description about [] = throw (subject +++ ": cannot choose from empty option list")
enterChoiceAbout subject description about options = mkInteractiveTask subject (toString (html description)) (ignoreActionA (makeChoiceTask options -1 (Just (visualizeAsHtmlDisplay about)) [ButtonAction (ActionOk, IfValid)]))
enterChoiceAboutA :: !String !description ![TaskAction a] b [a] -> Task (!Action,!a) | html description & iTask a & iTask b
enterChoiceAboutA subject description actions about [] = throw (subject +++ ": cannot choose from empty option list")
......
......@@ -6,9 +6,10 @@ from Types import :: Task, :: ManagerProperties, :: User, :: TaskPriority
from Time import :: Timestamp
from TaskTree import :: GroupedBehaviour, :: GroupActionsBehaviour
:: Subject s = Subject !s & toString s
:: Tag s = Tag !s & toString s
:: Tags s = Tags ![s] & toString s
:: Subject s = Subject !s & toString s
:: Description s = Description !s & toString s
:: Tag s = Tag !s & toString s
:: Tags s = Tags ![s] & toString s
//Annotation combinator
class tune b :: !b !(Task a) -> Task a
......@@ -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
......
......@@ -6,23 +6,25 @@ from TaskTree import :: GroupedBehaviour, :: GroupActionsBehaviour
class tune b :: !b !(Task a) -> Task a
instance tune ManagerProperties
where tune props (Task _ gprops mbTn tf) = Task props gprops mbTn tf
where tune props (Task _ gprops mbTn tf) = Task props gprops mbTn tf
instance tune User
where tune u (Task props gprops mbTn tf) = Task {ManagerProperties|props & worker = u} gprops mbTn tf
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
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
where tune p (Task props gprops mbTn tf) = Task {ManagerProperties|props & priority = p} gprops mbTn tf
instance tune Timestamp
where tune d (Task props gprops mbTn tf) = Task {ManagerProperties|props & deadline = Just d} gprops mbTn tf
where tune d (Task props gprops mbTn tf) = Task {ManagerProperties|props & deadline = Just d} gprops mbTn tf
instance tune (Tag s)
where tune (Tag t) (Task props gprops mbTn tf) = Task {ManagerProperties|props & tags = [toString t : props.tags]} gprops mbTn tf
where tune (Tag t) (Task props gprops mbTn tf) = Task {ManagerProperties|props & tags = [toString t : props.tags]} gprops mbTn tf
instance tune (Tags s)
where tune (Tags ts) (Task props gprops mbTn tf) = Task {ManagerProperties|props & tags = (map toString ts) ++ props.tags} gprops mbTn tf
where tune (Tags ts) (Task props gprops mbTn tf) = Task {ManagerProperties|props & tags = (map toString ts) ++ props.tags} gprops mbTn tf
instance tune GroupedBehaviour
where tune gb (Task props gprops mbTn tf) = Task props {gprops & groupedBehaviour = gb} mbTn tf
where tune gb (Task props gprops mbTn tf) = Task props {gprops & groupedBehaviour = gb} mbTn tf
instance tune GroupActionsBehaviour
where tune ga (Task props gprops mbTn tf) = Task props {gprops & groupActionsBehaviour = ga} mbTn tf
where tune ga (Task props gprops mbTn tf) = Task props {gprops & groupActionsBehaviour = ga} mbTn tf
(<<@) infixl 2 :: !(Task a) !b -> Task a | tune b
(<<@) t a = tune a t
......
......@@ -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
//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
askOpinionsDate :: Topic -> Task (Results Date)
askOpinionsDate topic = askOpinionsGeneric topic
:: DateVotes :== (HtmlDisplay [DateVote])
askOpinionsDocument :: Topic -> Task (Results Document)
askOpinionsDocument topic = askOpinionsGeneric topic
:: DateVote =
{ date :: Date
, vote :: (Editable Vote)
}
askOpinionsOther :: Topic -> Task (Results String)
askOpinionsOther topic = askOpinionsGeneric topic
:: Vote = Yes | No | Maybe
defineTopic :: Task Topic
defineTopic
= enterInformation "Define topic" "Please define the topic that you would like to get opinions about"
:: VoteCount =
{ date :: Date
, yes :: Int
, no :: Int
, maybe :: Int
}
defineItemType :: Task String
defineItemType
= enterChoice "Define item type" "What type of item(s) would you like to get opinions about" ["Date","Document","Other"]
derive class iTask DateVote, Vote, VoteCount
derive gEq Date
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)
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")
datePicker :: [User] -> Task Date
datePicker users = pickDates
>>= \dates -> allProc [u @>> voteDates dates \\ u <- users] Open
>>= \votes -> pickFinal votes
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
pickDates :: Task [Date]
pickDates = enterInformation "Pick dates" "Please select date options"
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
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
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}
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