Commit dc30e897 authored by Bas Lijnse's avatar Bas Lijnse

Major simplification of user handling. Merged UserName and User into a more...

Major simplification of user handling. Merged UserName and User into a more simple User type that can be both. Since this is a big change it is likely that it may have broken some stuff.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1033 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 5fd0692d
...@@ -38,6 +38,7 @@ import LaunchFlow ...@@ -38,6 +38,7 @@ import LaunchFlow
//Shared Value Examples //Shared Value Examples
import SharedVariables import SharedVariables
Start :: *World -> *World Start :: *World -> *World
Start world = startEngine workflows world Start world = startEngine workflows world
where where
...@@ -64,4 +65,4 @@ where ...@@ -64,4 +65,4 @@ where
, launchFlow , launchFlow
] ]
, sharedValueExamples , sharedValueExamples
] ]
\ No newline at end of file
...@@ -21,7 +21,7 @@ derive bimap (,), Maybe ...@@ -21,7 +21,7 @@ derive bimap (,), Maybe
BookTrip :: Task FlightHotel BookTrip :: Task FlightHotel
BookTrip BookTrip
= enterInformation "Please fill in trip information to make booking" = enterInformation "Please fill in trip information to make booking"
>>= \info -> assign info.delegateTo NormalPriority Nothing (enterInformationAbout "Please book the following trip" info) >>= \info -> assign info.delegateTo (enterInformationAbout "Please book the following trip" info)
>>= \booking -> showMessageAbout "The following trip has been booked" booking >>= \booking -> showMessageAbout "The following trip has been booked" booking
>>| return booking >>| return booking
...@@ -30,7 +30,7 @@ BookTrip ...@@ -30,7 +30,7 @@ BookTrip
= { destination :: String = { destination :: String
, leaving :: Date , leaving :: Date
, returning :: Date , returning :: Date
, delegateTo :: UserName , delegateTo :: User
} }
:: FlightHotel :: FlightHotel
= { carrier :: String = { carrier :: String
......
...@@ -44,10 +44,10 @@ duplicate me user topics = ...@@ -44,10 +44,10 @@ duplicate me user topics =
where where
change :: User User String TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a change :: User User String TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change me user topics props t t0 change me user topics props t t0
= ( Just {TaskProperties | props & managerProps = {ManagerProperties | props.managerProps & worker = toUserName me}} = ( Just {TaskProperties | props & managerProps = {ManagerProperties | props.managerProps & worker = me}}
, Just (assign (toUserName me) NormalPriority Nothing , Just (assign me
(anyProc [ {AssignedTask| user = props.managerProps.ManagerProperties.worker , task = t <<@ topics} (anyProc [ props.managerProps.ManagerProperties.worker @>> topics @>> t
, {AssignedTask| user = toUserName user, task = t <<@ topics} , user @>> topics @>> t
] Open ] Open
) )
<<@ ("Duplicated " +++ topics)) <<@ ("Duplicated " +++ topics))
...@@ -59,7 +59,7 @@ inform user procName = ...@@ -59,7 +59,7 @@ inform user procName =
dynamic change user :: A.a: Change a | iTask a dynamic change user :: A.a: Change a | iTask a
where where
change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change user props t t0 = (Nothing, Just (t >>= \res -> spawnProcess (toUserName user) True (showMessageAbout ("Process " +++ procName +++ " ended!") res) >>| return res), Nothing) change user props t t0 = (Nothing, Just (t >>= \res -> spawnProcess user True (showMessageAbout ("Process " +++ procName +++ " ended!") res) >>| return res), Nothing)
//check will pass the result to the indicated user who can change the result in an editor before it passed. //check will pass the result to the indicated user who can change the result in an editor before it passed.
check :: User String -> ChangeDyn check :: User String -> ChangeDyn
...@@ -67,7 +67,7 @@ check user procName = ...@@ -67,7 +67,7 @@ check user procName =
dynamic change user :: A.a: Change a | iTask a dynamic change user :: A.a: Change a | iTask a
where where
change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change user props t t0 = (Nothing, Just (t >>= \res -> assign user HighPriority Nothing (updateInformation ("Please verify result of " +++ procName) res)), Nothing) change user props t t0 = (Nothing, Just (t >>= \res -> assign user (HighPriority @>> (updateInformation ("Please verify result of " +++ procName) res))), Nothing)
//cancel stop the process, and give the indicated user the responsibility to fill in the result //cancel stop the process, and give the indicated user the responsibility to fill in the result
cancel :: String ProcessId -> ChangeDyn cancel :: String ProcessId -> ChangeDyn
...@@ -87,8 +87,7 @@ reassign user procName pid = ...@@ -87,8 +87,7 @@ reassign user procName pid =
where where
change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change user props t t0 change user props t t0
# username = (toUserName user) = (Just {TaskProperties | props & managerProps = {ManagerProperties | props.managerProps & worker = user}},Nothing, Nothing)
= (Just {TaskProperties | props & managerProps = {ManagerProperties | props.managerProps & worker = username}},Nothing, Nothing)
//restart starts the task from scratch and assigns it to the indicated user //restart starts the task from scratch and assigns it to the indicated user
restart :: User String -> Dynamic restart :: User String -> Dynamic
...@@ -96,7 +95,7 @@ restart user procName = ...@@ -96,7 +95,7 @@ restart user procName =
dynamic change user procName :: A.a: Change a | iTask a dynamic change user procName :: A.a: Change a | iTask a
where where
change :: User String TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a change :: User String TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change user procName props t t0 = (Nothing, Just (assign (toUserName user) HighPriority Nothing (t0 <<@ procName)), Nothing) change user procName props t t0 = (Nothing, Just (assign user (procName @>> HighPriority @>> t0 )), Nothing)
changePrio :: Task Void changePrio :: Task Void
changePrio changePrio
......
...@@ -41,25 +41,25 @@ where ...@@ -41,25 +41,25 @@ where
::Provider = ::Provider =
{ name :: String { name :: String
, id :: UserName , id :: User
, location :: Location , location :: Location
, capacity :: Int , capacity :: Int
} }
::Opinion = Opinion UserName Note ::Opinion = Opinion User Note
//Static population //Static population
allproviders = [{name="Ambulance Post 0",id=toUserName "ambupost0",location={street="Teststreet",place="Testville",coordinates=Just{lat=1.0,lon=2.0}},capacity=2} allproviders = [{name="Ambulance Post 0",id=NamedUser "ambupost0",location={street="Teststreet",place="Testville",coordinates=Just{lat=1.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 1",id=toUserName "ambupost1",location={street="Teststreet",place="Testville",coordinates=Just{lat=2.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 1",id=NamedUser "ambupost1",location={street="Teststreet",place="Testville",coordinates=Just{lat=2.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 2",id=toUserName "ambupost2",location={street="Teststreet",place="Testville",coordinates=Just{lat=3.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 2",id=NamedUser "ambupost2",location={street="Teststreet",place="Testville",coordinates=Just{lat=3.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 3",id=toUserName "ambupost3",location={street="Teststreet",place="Testville",coordinates=Just{lat=4.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 3",id=NamedUser "ambupost3",location={street="Teststreet",place="Testville",coordinates=Just{lat=4.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 4",id=toUserName "ambupost4",location={street="Teststreet",place="Testville",coordinates=Just{lat=5.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 4",id=NamedUser "ambupost4",location={street="Teststreet",place="Testville",coordinates=Just{lat=5.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 5",id=toUserName "ambupost5",location={street="Teststreet",place="Testville",coordinates=Just{lat=6.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 5",id=NamedUser "ambupost5",location={street="Teststreet",place="Testville",coordinates=Just{lat=6.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 6",id=toUserName "ambupost6",location={street="Teststreet",place="Testville",coordinates=Just{lat=7.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 6",id=NamedUser "ambupost6",location={street="Teststreet",place="Testville",coordinates=Just{lat=7.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 7",id=toUserName "ambupost7",location={street="Teststreet",place="Testville",coordinates=Just{lat=8.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 7",id=NamedUser "ambupost7",location={street="Teststreet",place="Testville",coordinates=Just{lat=8.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 8",id=toUserName "ambupost8",location={street="Teststreet",place="Testville",coordinates=Just{lat=9.0,lon=2.0}},capacity=2} ,{name="Ambulance Post 8",id=NamedUser "ambupost8",location={street="Teststreet",place="Testville",coordinates=Just{lat=9.0,lon=2.0}},capacity=2}
,{name="Ambulance Post 9",id=toUserName "ambupost9",location={street="Teststreet",place="Testville",coordinates=Just{lat=9.0,lon=3.0}},capacity=2} ,{name="Ambulance Post 9",id=NamedUser "ambupost9",location={street="Teststreet",place="Testville",coordinates=Just{lat=9.0,lon=3.0}},capacity=2}
] ]
derive gPrint Incident, IncidentType, Location, Address, MapCoordinates, Provider, Opinion derive gPrint Incident, IncidentType, Location, Address, MapCoordinates, Provider, Opinion
...@@ -171,16 +171,16 @@ where ...@@ -171,16 +171,16 @@ where
preCombine as = (0,as) preCombine as = (0,as)
allCombine as = (needed - sum (map numAmbulances as),as) allCombine as = (needed - sum (map numAmbulances as),as)
resourceRequestTimeOut :: [(b,UserName,a)] Time ([(b,Maybe a)] -> Bool) ([(b,Maybe a)] -> (a,[(b,Maybe a)])) ([(b,Maybe a)] -> (a,[(b,Maybe a)])) (a -> Task a) -> resourceRequestTimeOut :: [(b,User,a)] Time ([(b,Maybe a)] -> Bool) ([(b,Maybe a)] -> (a,[(b,Maybe a)])) ([(b,Maybe a)] -> (a,[(b,Maybe a)])) (a -> Task a) ->
Task (a,[(b,Maybe a)]) | iTask a & iTask b Task (a,[(b,Maybe a)]) | iTask a & iTask b
resourceRequestTimeOut resources time_out check predf allf task resourceRequestTimeOut resources time_out check predf allf task
= oldParallel "Resource_requests" check predf allf = oldParallel "Resource_requests" check predf allf
[(delegateTaskTimeOut uid "Resource Request" amount task time_out >>= \mba -> return (resource, mba)) [(delegateTaskTimeOut uid "Resource Request" amount task time_out >>= \mba -> return (resource, mba))
\\ (resource,uid,amount) <- resources] \\ (resource,uid,amount) <- resources]
delegateTaskTimeOut :: UserName String a (a -> Task a) Time -> Task (Maybe a) | iTask a delegateTaskTimeOut :: User String a (a -> Task a) Time -> Task (Maybe a) | iTask a
delegateTaskTimeOut who description value task time_out delegateTaskTimeOut who description value task time_out
= timeOutTask (who @: (description, task value)) time_out = timeOutTask (who @: (description @>> task value)) time_out
timeOutTask :: (Task a) Time -> Task (Maybe a) | iTask a timeOutTask :: (Task a) Time -> Task (Maybe a) | iTask a
timeOutTask task time timeOutTask task time
......
...@@ -23,7 +23,7 @@ derive gHint Flow, FlowShape, AssignInfo, CleanExpr ...@@ -23,7 +23,7 @@ derive gHint Flow, FlowShape, AssignInfo, CleanExpr
| CleanExpr !CleanExpr | CleanExpr !CleanExpr
| First | First
| Second | Second
:: AssignInfo = { nameOfUser:: !UserName :: AssignInfo = { nameOfUser:: !User
, taskName :: !String , taskName :: !String
} }
:: CleanExpr = CI Int :: CleanExpr = CI Int
......
...@@ -30,7 +30,7 @@ derive bimap Maybe, (,) ...@@ -30,7 +30,7 @@ derive bimap Maybe, (,)
| CleanExpr !CleanExpr | CleanExpr !CleanExpr
| First | First
| Second | Second
:: AssignInfo = { nameOfUser:: !UserName :: AssignInfo = { nameOfUser:: !User
, taskName :: !String , taskName :: !String
} }
:: CleanExpr = CI Int :: CleanExpr = CI Int
...@@ -91,7 +91,7 @@ where ...@@ -91,7 +91,7 @@ where
assignTask :: !AssignInfo !Dynamic -> Task Dynamic assignTask :: !AssignInfo !Dynamic -> Task Dynamic
assignTask info (e :: DF0 a b | iTask a) assignTask info (e :: DF0 a b | iTask a)
= return (dynamic (case e of = return (dynamic (case e of
(DF0 e) -> DF0 (\v -> assign info.nameOfUser NormalPriority Nothing (e v <<@ info.taskName))) :: DF0 a b | iTask a) (DF0 e) -> DF0 (\v -> assign info.nameOfUser (e v <<@ info.taskName))) :: DF0 a b | iTask a)
assignTask info d assignTask info d
= throw (typeErrorMess "Assign" d) = throw (typeErrorMess "Assign" d)
......
...@@ -48,7 +48,7 @@ where ...@@ -48,7 +48,7 @@ where
= getCurrentUser = getCurrentUser
>>= \me -> requestConfirmation ("Workflow of type :: " +++ showDynType d +++ " can be started; Shall I ?") >>= \me -> requestConfirmation ("Workflow of type :: " +++ showDynType d +++ " can be started; Shall I ?")
>>= \ok -> if ok ( updateInformation "Name of this workflow: " "workflow" >>= \ok -> if ok ( updateInformation "Name of this workflow: " "workflow"
>>= \name -> spawnProcess (toUserName me) True (t <<@ name) >>= \name -> spawnProcess me True (t <<@ name)
>>| return Void) >>| return Void)
(return Void) (return Void)
......
...@@ -68,10 +68,9 @@ where ...@@ -68,10 +68,9 @@ where
mergeTestList :: Task Void mergeTestList :: Task Void
mergeTestList = mergeTestList =
getCurrentUser getCurrentUser
>>= \user. return (toUserName user) >>= \user. createDB emptyL
>>= \uname. createDB emptyL >>= \sid. spawnProcess user True ("1st View" @>> view sid)
>>= \sid. spawnProcess uname True ("1st View" @>> view sid) >>| spawnProcess user True ("2nd View" @>> view sid)
>>| spawnProcess uname True ("2nd View" @>> view sid)
>>| stop >>| stop
where where
view :: (DBid [String]) -> Task (Action,[String]) view :: (DBid [String]) -> Task (Action,[String])
...@@ -83,11 +82,10 @@ where ...@@ -83,11 +82,10 @@ where
mergeTestDocuments :: Task Void mergeTestDocuments :: Task Void
mergeTestDocuments = mergeTestDocuments =
getCurrentUser getCurrentUser
>>= \user. return (toUserName user) >>= \user. createDB emptyL
>>= \uname. createDB emptyL >>= \sid. spawnProcess user True ("1st View" @>> view sid idEditor)
>>= \sid. spawnProcess uname True ("1st View" @>> view sid idEditor) >>| spawnProcess user True ("2nd View" @>> view sid idEditor)
>>| spawnProcess uname True ("2nd View" @>> view sid idEditor) >>| spawnProcess user True ("3rd View" @>> view sid idListener)
>>| spawnProcess uname True ("3rd View" @>> view sid idListener)
>>| stop >>| stop
where where
view :: (DBid [Document]) (View [Document]) -> Task (Action,[Document]) view :: (DBid [Document]) (View [Document]) -> Task (Action,[Document])
......
...@@ -24,7 +24,7 @@ deadline :: (Task a) -> Task a | iTask a ...@@ -24,7 +24,7 @@ deadline :: (Task a) -> Task a | iTask a
deadline task deadline task
= chooseUser "Choose person you want to delegate work to:" = chooseUser "Choose person you want to delegate work to:"
>>= \whom -> enterInformation "How long do you want to wait?" >>= \whom -> enterInformation "How long do you want to wait?"
>>= \time -> (delegateTask whom.User.userName time task) >>= \time -> (delegateTask whom time task)
-||- -||-
(showMessage "Cancel delegated work if you are getting impatient:" >>| return Nothing) (showMessage "Cancel delegated work if you are getting impatient:" >>| return Nothing)
>>= checkDone >>= checkDone
...@@ -35,7 +35,7 @@ where ...@@ -35,7 +35,7 @@ where
= showMessage "Task expired or canceled, you have to do it yourself!" >>| task = showMessage "Task expired or canceled, you have to do it yourself!" >>| task
delegateTask who time task delegateTask who time task
= who @: ("Timed Task",mytask) = who @: ("Timed Task" @>> mytask)
where where
mytask mytask
= // wait for timeout and return nothing = // wait for timeout and return nothing
......
...@@ -59,11 +59,7 @@ where ...@@ -59,11 +59,7 @@ where
timerStop time = waitForTimerTask time #>> return True timerStop time = waitForTimerTask time #>> return True
*/ */
instance < UserName determineSet :: [User] -> Task [User]
where
(<) (UserName ida dispa) (UserName idb dispb) = ida < idb
determineSet :: [UserName] -> Task [UserName]
determineSet people = determineSet` determineSet people = determineSet`
where where
determineSet` determineSet`
...@@ -73,10 +69,10 @@ where ...@@ -73,10 +69,10 @@ where
] ]
>>= \task -> task >>= \task -> task
>>= \result -> case result of >>= \result -> case result of
(Just new) -> determineSet (sort (removeDup [toUserName new:people])) (Just new) -> determineSet (sort (removeDup [new:people]))
Nothing -> if (people == []) (determineSet people) (return people) Nothing -> if (people == []) (determineSet people) (return people)
choosePerson = chooseUser "Select a user" >>= \user -> return (Just user.User.userName) choosePerson = chooseUser "Select a user" >>= \user -> return (Just user)
cancelTask task = task -||- (showMessage "Cancel task?" >>| getDefaultValue ) cancelTask task = task -||- (showMessage "Cancel task?" >>| getDefaultValue )
\ No newline at end of file
...@@ -94,9 +94,8 @@ where ...@@ -94,9 +94,8 @@ where
>>| return False >>| return False
selectUser :: !String -> Task UserName selectUser :: !String -> Task User
selectUser question selectUser question
= getUsers = getUsers
>>= \users -> enterChoice question users >>= \users -> enterChoice question users
>>= \user -> return (toUserName user)
...@@ -50,15 +50,15 @@ reviewTaskExample ...@@ -50,15 +50,15 @@ reviewTaskExample
= [workflow "Examples/Higher order/Review task" ("Review the results of a task" @>> reviewtask) ] = [workflow "Examples/Higher order/Review task" ("Review the results of a task" @>> reviewtask) ]
reviewtask :: Task (QForm,Review) reviewtask :: Task (QForm,Review)
reviewtask = getDefaultValue >>= \def -> taskToReview "unknown" (def, mytask) reviewtask = getDefaultValue >>= \def -> taskToReview AnyUser (def, mytask)
mytask :: a -> (Task a) | iTask a mytask :: a -> (Task a) | iTask a
mytask v = updateInformation "Fill in Form:" v mytask v = updateInformation "Fill in Form:" v
taskToReview :: String (a,a -> Task a) -> Task (a,Review) | iTask a taskToReview :: User (a,a -> Task a) -> Task (a,Review) | iTask a
taskToReview reviewer (v`,task) taskToReview reviewer (v`,task)
= task v` = task v`
>>= \v -> reviewer @: ("Review", review v) >>= \v -> reviewer @: ("Review" @>> review v)
>>= \r -> showMessageAbout [Text ("Reviewer " <+++ reviewer <+++ " says ")] r >>= \r -> showMessageAbout [Text ("Reviewer " <+++ reviewer <+++ " says ")] r
>>| case r of >>| case r of
(NeedsRework _) -> taskToReview reviewer (v,task) (NeedsRework _) -> taskToReview reviewer (v,task)
......
...@@ -21,12 +21,12 @@ import CommonDomain ...@@ -21,12 +21,12 @@ import CommonDomain
{ bugNr :: BugNr { bugNr :: BugNr
, status :: BugStatus , status :: BugStatus
, reportedAt :: (Date,Time) , reportedAt :: (Date,Time)
, reportedBy :: UserName , reportedBy :: User
, report :: BugReport , report :: BugReport
, analysis :: Maybe BugAnalysis , analysis :: Maybe BugAnalysis
} }
:: BugStatus = Reported | Assigned UserName | Repaired :: BugStatus = Reported | Assigned User | Repaired
:: BugAnalysis = :: BugAnalysis =
{ cause :: Note { cause :: Note
...@@ -63,7 +63,7 @@ reportBugVerySimple :: Task Note ...@@ -63,7 +63,7 @@ reportBugVerySimple :: Task Note
reportBugVerySimple reportBugVerySimple
= enterInformation "Please describe the bug you have found" = enterInformation "Please describe the bug you have found"
>>= \report -> >>= \report ->
assign (toUserName "bas") NormalPriority Nothing assign (NamedUser "bas")
("Bug Report" @>> showInstructionAbout "Fix bug" "The following bug has been reported, please fix it." report) ("Bug Report" @>> showInstructionAbout "Fix bug" "The following bug has been reported, please fix it." report)
>>| return report >>| return report
...@@ -71,7 +71,7 @@ reportBugSimple :: Task BugReport ...@@ -71,7 +71,7 @@ reportBugSimple :: Task BugReport
reportBugSimple reportBugSimple
= enterInformation "Please describe the bug you have found" = enterInformation "Please describe the bug you have found"
>>= \report -> >>= \report ->
assign (toUserName "bas") NormalPriority Nothing assign (NamedUser "bas")
("Bug Report" @>> showInstructionAbout "Fix bug" "The following bug has been reported, please fix it." report) ("Bug Report" @>> showInstructionAbout "Fix bug" "The following bug has been reported, please fix it." report)
>>| return report >>| return report
...@@ -83,7 +83,7 @@ where ...@@ -83,7 +83,7 @@ where
reportBug = enterInformation "Please describe the bug you found" reportBug = enterInformation "Please describe the bug you found"
fixBug :: BugReport -> Task Void fixBug :: BugReport -> Task Void
fixBug bug = "bas" @: ("Bug Report", showInstructionAbout "Fix bug" "The following bug has been reported, please fix it." bug) fixBug bug = NamedUser "bas" @: ("Bug Report" @>> showInstructionAbout "Fix bug" "The following bug has been reported, please fix it." bug)
//Main workflow //Main workflow
reportBug :: Task Void reportBug :: Task Void
...@@ -106,8 +106,7 @@ assignBug bug critical ...@@ -106,8 +106,7 @@ assignBug bug critical
>>= \developer -> >>= \developer ->
updateBug (\b -> {Bug| b & status = Assigned developer}) bug updateBug (\b -> {Bug| b & status = Assigned developer}) bug
>>= \bug -> >>= \bug ->
assign developer priority Nothing assign developer (subject @>> priority @>> resolveBug bug critical)
(subject @>> resolveBug bug critical)
where where
priority = if critical HighPriority NormalPriority priority = if critical HighPriority NormalPriority
subject = if critical "Critical bug!" "Bug" subject = if critical "Critical bug!" "Bug"
...@@ -139,7 +138,7 @@ fileBug :: BugReport -> Task Bug ...@@ -139,7 +138,7 @@ fileBug :: BugReport -> Task Bug
fileBug report fileBug report
= getDefaultValue -&&- getCurrentUser = getDefaultValue -&&- getCurrentUser
>>= \(bug,user) -> >>= \(bug,user) ->
dbCreateItem {bug & report = report, reportedBy = (toUserName user)} dbCreateItem {bug & report = report, reportedBy = user}
updateBug :: (Bug -> Bug) Bug -> Task Bug updateBug :: (Bug -> Bug) Bug -> Task Bug
updateBug f bug = dbUpdateItem (f bug) updateBug f bug = dbUpdateItem (f bug)
...@@ -148,30 +147,26 @@ confirmCritical :: BugReport -> Task Bool ...@@ -148,30 +147,26 @@ confirmCritical :: BugReport -> Task Bool
confirmCritical report confirmCritical report
= selectDeveloper report.BugReport.application = selectDeveloper report.BugReport.application
>>= \assessor -> >>= \assessor ->
assign assessor HighPriority Nothing assign assessor
( "Bug report assessment" ( "Bug report assessment"
@>> @>> HighPriority @>>
requestConfirmationAbout "Is this bug really critical?" report requestConfirmationAbout "Is this bug really critical?" report
) )
instance < UserName selectDeveloper :: String -> Task User
where
(<) (UserName ida dispa) (UserName idb dispb) = ida < idb
selectDeveloper :: String -> Task UserName
selectDeveloper application selectDeveloper application
= findAppDevelopers application = findAppDevelopers application
>>= \developers -> case developers of >>= \developers -> case developers of
[] = getCurrentUser >>= \user -> return (toUserName user) [] = getCurrentUser
_ = selectLeastBusy developers _ = selectLeastBusy developers
where where
findAppDevelopers :: String -> Task [UserName] findAppDevelopers :: String -> Task [User]
findAppDevelopers "itasks" = return [toUserName "bas"] findAppDevelopers "itasks" = return [NamedUser "bas"]
findAppDevelopers _ = return [] findAppDevelopers _ = return []
selectLeastBusy :: [UserName] -> Task UserName selectLeastBusy :: [User] -> Task User
selectLeastBusy [] selectLeastBusy []
= getCurrentUser >>= \user -> return (toUserName