We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

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