Commit acec3084 authored by Bas Lijnse's avatar Bas Lijnse

Updated ShipAdventure and TaxMan to attribute API changes

parent c4955cfa
......@@ -62,8 +62,8 @@ actorWithInstructions user
pickStartRoom :: Task Coord3D
pickStartRoom
= updateInformationWithShared "Which room do you want to start in?"
[UpdateUsing id (const snd) editor]
= Hint "Which room do you want to start in?" @>> updateInformationWithShared
[UpdateSharedUsing id (const snd) const editor]
(maps2DShare |*| myNetwork) NoAction
>>* [OnValue (\v -> case v of
Value (FocusOnSection c3d) _ = Just (return c3d)
......@@ -91,14 +91,14 @@ giveInstructions :: Task ()
giveInstructions =
forever
( get currentUser
>>- \me -> ( enterChoiceWithShared "Choose which alarm to handle: " [ChooseFromGrid showAlarm] allActiveAlarms
>&> withSelection (viewInformation () [] "No Alarm Selected")
>>- \me -> ( Hint "Choose which alarm to handle: " @>> enterChoiceWithShared [ChooseFromGrid showAlarm] allActiveAlarms
>&> withSelection (viewInformation [] "No Alarm Selected")
\(alarmLoc, detector) -> selectSomeOneToHandle (alarmLoc, detector)
>&> withSelection (viewInformation () [] "No Crew Member Selected")
>&> withSelection (viewInformation [] "No Crew Member Selected")
\(actorLoc, actor) -> scriptDefined detector
>>- \scriptExists -> (viewRelativeStatus (actorLoc, actor) (alarmLoc, detector)
||-
updateChoice "Select the Priority : " [ChooseFromCheckGroup id] [Low, Normal, High, Highest] High)
(Hint "Select the Priority : " @>> updateChoice [ChooseFromCheckGroup id] [Low, Normal, High, Highest] High))
>>* [ OnAction ActionByHand (hasValue (\prio -> handleAlarm (me, (alarmLoc, detector), (actorLoc, actor), prio)))
, OnAction ActionSimulated (hasValue (\prio -> autoHandleAlarm me actor.userName (alarmLoc, detector) @! ()))
//, OnAction ActionScript (hasValue (\prio -> autoHandleWithScript (me, (alarmLoc, detector), (actorLoc, actor), prio) @! ()))
......@@ -117,7 +117,7 @@ giveInstructions =
selectSomeOneToHandle :: !(!Coord3D, !SectionStatus) -> Task (!Coord3D, !MyActor)
selectSomeOneToHandle (number, detector)
= enterChoiceWithShared ("Who should handle: " <+++ showAlarm (number, detector))
= Hint ("Who should handle: " <+++ showAlarm (number, detector)) @>> enterChoiceWithShared
[ChooseFromGrid (\(roomNumber,actor) -> (roomNumber, actor.userName, actor.actorStatus))] allAvailableActors
viewRelativeStatus :: !(!Coord3D, !MyActor) !(!Coord3D, !SectionStatus) -> Task ()
......@@ -128,7 +128,7 @@ giveInstructions =
(\_ -> mkTable ["Status"] ["Everything in order"])
)
)
= viewSharedInformation () [ViewUsing view grid] (sharedGraph |*| myStatusMap |*| myInventoryMap |*| lockedExitsShare |*| lockedHopsShare) @! ()
= viewSharedInformation [ViewUsing view grid] (sharedGraph |*| myStatusMap |*| myInventoryMap |*| lockedExitsShare |*| lockedHopsShare) @! ()
where
mkFireView ((((graph, statusMap), inventoryMap), exitLocks), hopLocks)
#! (_,_,eCost,nrExt, (extLoc, distExt, _)) = smartShipPathToClosestObject FireExtinguisher inventoryMap actorLoc alarmLoc statusMap exitLocks hopLocks graph
......@@ -172,9 +172,9 @@ handleAlarm (me, (alarmLoc, detector), (actorLoc, actor), priority)
handleWhileWalking :: !MyActor !String !Priority -> Task ()
handleWhileWalking actor title priority
= addTaskForUser title actor.userName Immediate (const taskToHandle)
>>* [ OnValue (ifValue isDone (\x -> viewInformation ("Task " <+++ title <+++ " succeeded, returning:") [] x @! ()))
, OnValue (ifValue isFailed (\x -> viewInformation ("Task " <+++ title <+++ " failed, returning:") [] x @! ()))
, OnAction (Action "Cancel task") (always (viewInformation "Canceled" [] ("Task " <+++ title <+++ " has been cancelled by you") @! ()))
>>* [ OnValue (ifValue isDone (\x -> Title ("Task " <+++ title <+++ " succeeded, returning:") @>> viewInformation [] x @! ()))
, OnValue (ifValue isFailed (\x -> Title ("Task " <+++ title <+++ " failed, returning:") @>> viewInformation [] x @! ()))
, OnAction (Action "Cancel task") (always (Title "Canceled" @>> viewInformation [] ("Task " <+++ title <+++ " has been cancelled by you") @! ()))
]
>>| return ()
where
......@@ -189,7 +189,7 @@ handleAlarm (me, (alarmLoc, detector), (actorLoc, actor), priority)
taskToDo :: !(!Coord3D, !SectionStatus) !User !(Shared sds1 MySectionStatusMap) !(UserActorShare o a) !(Shared sds2 MySectionInventoryMap)
-> Task (MoveSt String) | RWShared sds1 & RWShared sds2
taskToDo (alarmLoc, status) user shStatusMap shUserActor shInventoryMap
= viewSharedInformation ("Handle " <+++ toString status <+++ " in Section: " <+++ alarmLoc) [ViewAs todoTable] (sectionForUserShare user |*| myUserActorMap |*| shStatusMap |*| shInventoryMap |*| lockedExitsShare |*| lockedHopsShare |*| sharedGraph)
= Hint ("Handle " <+++ toString status <+++ " in Section: " <+++ alarmLoc) @>> viewSharedInformation [ViewAs todoTable] (sectionForUserShare user |*| myUserActorMap |*| shStatusMap |*| shInventoryMap |*| lockedExitsShare |*| lockedHopsShare |*| sharedGraph)
>>* [ OnAction (Action "Use Fire Extinguisher") (ifValue (mayUseExtinguisher status) (withUser useExtinquisher))
, OnAction (Action "Use FireBlanket") (ifValue (mayUseFireBlanket status) (withUser useFireBlanket))
, OnAction (Action "Use Plug") (ifValue (mayUsePlug status) (withUser usePlug))
......@@ -227,27 +227,27 @@ handleAlarm (me, (alarmLoc, detector), (actorLoc, actor), priority)
= useObject alarmLoc (getObjectOfType curActor FireExtinguisher) user myUserActorMap inventoryInSectionShare
>>| setAlarm actor.userName (alarmLoc, NormalStatus) myStatusMap
>>| updStatusOfActor curActor.userName Available
>>| viewInformation "Well Done, Fire Extinguished !" [] ()
>>| viewInformation [] "Well Done, Fire Extinguished !" @! ()
>>| return (MoveDone "Fire Extinguised")
useFireBlanket curActor
= useObject alarmLoc (getObjectOfType curActor FireBlanket) user myUserActorMap inventoryInSectionShare
>>| setAlarm actor.userName (alarmLoc, NormalStatus) myStatusMap
>>| updStatusOfActor curActor.userName Available
>>| viewInformation "Well Done, Fire Extinguished !" [] ()
>>| viewInformation [] "Well Done, Fire Extinguished !" @! ()
>>| return (MoveDone "Fire Extinguised")
usePlug curActor
= useObject alarmLoc (getObjectOfType curActor Plug) user myUserActorMap inventoryInSectionShare
>>| setAlarm actor.userName (alarmLoc, NormalStatus) myStatusMap
>>| updStatusOfActor curActor.userName Available
>>| viewInformation "Well Done, Flooding Stopped !" [] ()
>>| viewInformation [] "Well Done, Flooding Stopped !" @! ()
>>| return (MoveDone "Flooding Stopped")
smokeReport curActor
= setAlarm actor.userName (alarmLoc, NormalStatus) myStatusMap
>>| updStatusOfActor curActor.userName Available
>>| viewInformation "Well Done, Reason of Smoke Detected !" [] ()
>>| viewInformation [] "Well Done, Reason of Smoke Detected !" @! ()
>>| return (MoveDone "Don't smoke under a smoke detector!")
giveUp curActor
......@@ -387,8 +387,8 @@ findClosest objectType statusMap inventoryMap myLoc targetLoc exitLocks hopLocks
mkSection :: MyDrawMapForActor
mkSection
= \user shStatusMap shUserActor shSectionInventoryMap ->
updateSharedInformation "Section Status"
[UpdateUsing id (\_ _ -> ()) editor]
Title "Section Status" @>> updateSharedInformation
[UpdateSharedUsing id (\_ _ -> ()) const editor]
(sectionForUserShare user |*| myNetwork |*| myDevices |*| shStatusMap |*| sectionUsersShare |*| myUserActorMap |*| shSectionInventoryMap |*| lockedExitsShare |*| lockedHopsShare |*| maps2DShare)
@! ()
where
......
......@@ -34,16 +34,16 @@ shipEditorTabs = allTasks [ viewLayout <<@ Title "View Ship"
exportShip :: Task ()
exportShip
= enterInformation "Enter file name" []
= Hint "Enter file name" @>> enterInformation []
>>= \fileName -> get (myInventoryMap |*| myNetwork |*| myCables |*| myDevices |*| maps2DShare)
>>- \data -> exportJSONFile (fileName +++ ".map") data
>>| viewInformation "Success!" [] "File exported"
>>| Title "Success!" @>> viewInformation [] "File exported"
>>| exportShip @! ()
importShip :: Task ()
importShip
= getMapNames
>>= \mapNames -> enterChoice "Select file" [] mapNames
>>= \mapNames -> Hint "Select file" @>> enterChoice [] mapNames
>>* [ OnAction (Action "Import") (hasValue doImport)
, OnAction (Action "Refresh list") (always importShip)
]
......@@ -52,7 +52,7 @@ importShip
doImport mapName
= getMap mapName
>>- \data -> set data (myInventoryMap >*< myNetwork >*< myCables >*< myDevices >*< maps2DShare)
>>| viewInformation "Ship imported" [] "Ship imported"
>>| Title "Ship imported" @>> viewInformation [] "Ship imported"
>>| importShip @! ()
getMap :: !String -> Task (!(!(!(!MySectionInventoryMap, !Network), !IntMap Cable), !IntMap Device), !Maps2D)
......@@ -169,15 +169,15 @@ manageCables :: Task ()
manageCables = intMapCrudWith "Cables" [ChooseFromGrid id] [] [] [] (\cable -> cable.Cable.cableId) myCables @! ()
intMapCrud :: !String !(r -> Int) !(SimpleSDSLens (IntMap r)) -> Task r | iTask r
intMapCrud descr mkId share = crud descr 'DIS'.elems (putItem mkId) (delItem mkId) share
intMapCrud descr mkId share = Title descr @>> crud 'DIS'.elems (putItem mkId) (delItem mkId) share
where
putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
putItem mkId item allItems = 'DIS'.put (mkId item) item allItems
delItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
delItem mkId item allItems = 'DIS'.del (mkId item) allItems
intMapCrudWith :: !String ![ChoiceOption r] [EnterOption r] [ViewOption r] [UpdateOption r r] !(r -> Int) !(SimpleSDSLens (IntMap r)) -> Task r | iTask r
intMapCrudWith descr cos eos vos uos mkId share = crudWith descr cos eos vos uos 'DIS'.elems (putItem mkId) (delItem mkId) share
intMapCrudWith :: !String ![ChoiceOption r] [EnterOption r] [ViewOption r] [UpdateOption r] !(r -> Int) !(SimpleSDSLens (IntMap r)) -> Task r | iTask r
intMapCrudWith descr cos eos vos uos mkId share = Title descr @>> crudWith cos eos vos uos 'DIS'.elems (putItem mkId) (delItem mkId) share
where
putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
putItem mkId item allItems = 'DIS'.put (mkId item) item allItems
......@@ -186,8 +186,8 @@ intMapCrudWith descr cos eos vos uos mkId share = crudWith descr cos eos vos uos
graphicalMapEditor :: Task ()
graphicalMapEditor
= updateSharedInformation (Title "Graphical map editor")
[UpdateUsing id (const fst) imageEditor]
= Title "Graphical map editor" @>> updateSharedInformation
[UpdateSharedUsing id (const fst) const imageEditor]
(sharedEditShip >*| (myInventoryMap |*| myNetwork |*| myDevices)) @! ()
@! ()
where
......@@ -202,10 +202,10 @@ where
editLayout :: Task ()
editLayout
= allTasks [ graphicalMapEditor
, updateSharedInformation (Title "Edit map dimensions") [UpdateAs toMapsForm fromMapsForm] maps2DShare @! ()
, updateSharedInformation (Title "Edit map") [UpdateAs toMapActionForm fromMapActionForm] sharedEditShip @! ()
, Title "Edit map dimensions" @>> updateSharedInformation [UpdateSharedAs toMapsForm fromMapsForm const] maps2DShare @! ()
, Title "Edit map" @>> updateSharedInformation [UpdateSharedAs toMapActionForm fromMapActionForm const] sharedEditShip @! ()
, (watch maps2DShare
-&&- enterChoiceWithShared (Title "Quick borders") [] (mapRead (\ship -> [mapId \\ {Map2D | mapId} <- ship]) maps2DShare)
-&&- (Title "Quick borders" @>> enterChoiceWithShared [] (mapRead (\ship -> [mapId \\ {Map2D | mapId} <- ship]) maps2DShare))
>>* [ OnAction (Action "Add outer borders" ) (hasValue (uncurry (editOuterBorders Wall)))
, OnAction (Action "Remove outer borders" ) (hasValue (uncurry (editOuterBorders Open)))
]
......@@ -252,7 +252,7 @@ editSectionContents :: Task ()
editSectionContents
= allTasks [ graphicalMapEditor
, withSelectedSection (
\mid c2d -> updateSharedInformation (Title (mkDesc mid c2d "Inventory")) [UpdateAs fromInv toInv] (sdsFocus (mid, c2d) inventoryInSectionShare)
\mid c2d -> (Title (mkDesc mid c2d "Inventory")) @>> updateSharedInformation [UpdateSharedAs fromInv toInv const] (sdsFocus (mid, c2d) inventoryInSectionShare)
)
, withSelectedSection (
\mid c2d -> let focusedShare = sdsFocus (mid, c2d) devicesInSectionShare
......@@ -270,14 +270,14 @@ editSectionContents
where
updateSectionEditor :: !String ![ChoiceOption a] (Shared sds1 [a]) (Shared sds2 [a]) -> Task [a] | iTask a & RWShared sds1 & RWShared sds2
updateSectionEditor d updOpts listShare focusedShare
= editSharedMultipleChoiceWithShared (Title d) updOpts listShare focusedShare
= Title d @>> editSharedMultipleChoiceWithShared updOpts listShare focusedShare
withSelectedSection :: !(Int Coord2D -> Task a) -> Task () | iTask a
withSelectedSection f
= whileUnchanged sharedMapAction
(\editLayout -> case editLayout of
FocusOnSection (mid, c2d) = f mid c2d @! ()
_ = viewInformation (Title "Please select section") [] "Please select section" @! ()
_ = (Title "Please select section") @>> viewInformation [] "Please select section" @! ()
)
/*
......
......@@ -33,9 +33,9 @@ changeSmokeScript = changeScript "Handling Smoke" handleSmokeScript
changeScript :: !String !(Shared sds [Script]) -> Task () | RWShared sds
changeScript prompt script
= viewSharedInformation ("Current Script: " <+++ prompt) [ViewAs (\script -> [toString i +++ " : " +++ line \\ line <- map toSingleLineText script & i <- [1..]])] script
= Hint ("Current Script: " <+++ prompt) @>> viewSharedInformation [ViewAs (\script -> [toString i +++ " : " +++ line \\ line <- map toSingleLineText script & i <- [1..]])] script
>>* [ OnAction (Action "Fine") (always (return ()))
, OnAction (Action "Change") (always ( updateSharedInformation ("Change Script: " <+++ prompt) [] script
, OnAction (Action "Change") (always ( Hint ("Change Script: " <+++ prompt) @>> updateSharedInformation [] script
>>| changeScript prompt script
))
]
......
......@@ -99,7 +99,7 @@ myInventoryMap :: SimpleSDSLens MySectionInventoryMap
myInventoryMap = sharedStore "myInventoryMap" 'DM'.newMap
viewDisabledDevices :: Task ()
viewDisabledDevices = viewSharedInformation "Disabled devices" [ViewAs (\(nw, ds) -> map toPPDevice (allDisabledDevices ds nw))] (myNetwork |*| myDevices) @! ()
viewDisabledDevices = Hint "Disabled devices" @>> viewSharedInformation [ViewAs (\(nw, ds) -> map toPPDevice (allDisabledDevices ds nw))] (myNetwork |*| myDevices) @! ()
//manageDevices :: Bool -> Task ()
//manageDevices kitchen
......@@ -421,8 +421,8 @@ updateMapStatus mode
= /* project (\tv _ -> case tv of
Value x _ -> Just x
_ -> Nothing) sharedMapAction */
(updateInformationWithShared "Map Status"
[UpdateUsing id (const snd) editor]
(Title "Map Status" @>> updateInformationWithShared
[UpdateSharedUsing id (const snd) const editor]
(disabledSections |*| maps2DShare |*| lockedExitsShare |*| lockedHopsShare |*| myInventoryMap |*| myStatusMap |*| sectionUsersShare |*| myUserActorMap |*| myNetwork |*| myDevices)
NoAction)
where
......@@ -438,8 +438,8 @@ disabledSections = sharedStore "disabledSections" 'DS'.newSet
updateSectionStatus :: !Coord3D -> Task (MapAction SectionStatus)
updateSectionStatus c3d=:(floorIdx, _)
= updateInformationWithShared "Section Status"
[UpdateUsing id (const snd) editor]
= Title "Section Status" @>> updateInformationWithShared
[UpdateSharedUsing id (const snd) const editor]
(maps2DShare |*| lockedExitsShare |*| lockedHopsShare |*| sdsFocus c3d inventoryInSectionShare |*| sdsFocus c3d statusInSectionShare |*| sdsFocus c3d (actorsInSectionShare myUserActorMap) |*| myNetwork |*| myDevices)
NoAction
where
......
......@@ -79,7 +79,7 @@ periodicallyUpdateEntity :: !Int -> Task ()
periodicallyUpdateEntity n = updateEntity n moveEntity // TODO FIXME PERFORMANCE doTaskPeriodically 1 (updateEntity n moveEntity) <<@ NoUserInterface
mapView` :: User [Entity] -> Task ()
mapView` currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (userMapState currentUser >*< entityMap) @! ())
mapView` currentUser es = (updateSharedInformation [UpdateSharedAs toMap fromMap const] (userMapState currentUser >*< entityMap) @! ())
where
toMap :: (MapState, EntityMap) -> LeafletMap
toMap ({MapState | perspective}, markers)
......@@ -105,7 +105,7 @@ mapView` currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (
mapView :: (sds () r w) (r -> Bool) User [Entity] -> Task () | iTask r & iTask w & RWShared sds
mapView sh radarWorks currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (mapState >*| sh) @! ())
mapView sh radarWorks currentUser es = (updateSharedInformation [UpdateSharedAs toMap fromMap const] (mapState >*| sh) @! ())
where
toMap ({perspective, entities = markers}, shval)
= toLeafletMap { ContactMap
......
......@@ -21,9 +21,9 @@ ccMain :: (User -> [User -> Task Entity])
(User -> [(String, User [Entity] -> Task ())])
-> Task ()
ccMain regEntities contBgTasks alwaysOnTasks tlist
= forever (catchAll (( enterChoiceWithShared "Select user" [] users <<@ ApplyLayout frameCompact
= forever (catchAll (( (Hint "Select user" @>> enterChoiceWithShared [] users) <<@ ApplyLayout frameCompact
>>= doUserTask))
(\err -> viewInformation "Error" [] err >>| return ()))
(\err -> Title "Error" @>> viewInformation [] err >>| return ()))
where
doUserTask me = set me currentUser
>>| allTasks (map (\f -> f me) (regEntities me))
......@@ -40,7 +40,7 @@ whileAuthenticated user ents alwaysOnTasks tlist
where
controlDash :: Task ()
controlDash
= (allTasks [ viewInformation () [] ("Welcome " +++ toString user) @! ()
= (allTasks [ viewInformation [] ("Welcome " +++ toString user) @! ()
, viewNotifications
] <<@ ArrangeHorizontal
>>* [OnAction (Action "Log out") (always (return ()))]
......@@ -73,7 +73,7 @@ whileAuthenticated user ents alwaysOnTasks tlist
chooseTaskAndAdd2TD :: User [Entity] [(String, User [Entity] -> Task ())] Workspace -> Task ()
chooseTaskAndAdd2TD user ents tlist taskList
= forever ( enterChoice "Select task to execute" [ChooseFromCheckGroup fst] tlist
= forever ( Hint "Select task to execute" @>> enterChoice [ChooseFromCheckGroup fst] tlist
>>* [OnAction (Action "Select") (hasValue doTask)])
where
doTask :: (String, User [Entity] -> Task ()) -> Task ()
......@@ -81,7 +81,7 @@ chooseTaskAndAdd2TD user ents tlist taskList
chooseIncomingTaskAndAdd2TD :: User !Workspace -> Task ()
chooseIncomingTaskAndAdd2TD user taskList
= forever ( enterChoiceWithShared "Select incoming task to execute" [ChooseFromGrid snd] incomingTasks
= forever ( Hint "Select incoming task to execute" @>> enterChoiceWithShared [ChooseFromGrid snd] incomingTasks
>>* [OnAction (Action "Open") (hasValue doTask)])
where
doTask :: (TaskId, WorklistRow) -> Task ()
......@@ -91,11 +91,11 @@ mkAssign :: !String !worker !TaskPrio !(Task a) -> Task a | iTask a & toUserCons
mkAssign desc worker prio task
= get currentUser -&&- get currentDateTime
>>- \(me, now) -> assign (workerAttributes worker
[ ("title", desc)
, ("createdBy", toString (toUserConstraint me))
, ("createdAt", toString now)
, ("priority", toString (toInt prio))
, ("createdFor", toString (toUserConstraint worker))
[ ("title", toJSON desc)
, ("createdBy", toJSON (toUserConstraint me))
, ("createdAt", toJSON now)
, ("priority", toJSON prio)
, ("createdFor", toJSON (toUserConstraint worker))
])
task
......@@ -119,7 +119,7 @@ addTaskForUserAndReport :: String User User TaskPrio (User -> Task a) -> Task a
addTaskForUserAndReport des user sender prio task = addTaskForUser des user prio extask
where
extask user = task user >>= \res -> addTaskForUser ("Result: " +++ des) sender prio (\_ -> viewRes res)
viewRes res = viewInformation "Result" [] res
viewRes res = Title "Result" @>> viewInformation [] res
makeWatchTask :: String User TaskPrio (sds () r w) (r -> Bool) (r -> Task ()) -> Task () | iTask r & RWShared sds & TC w
makeWatchTask des executer prio store cond task
......@@ -149,17 +149,17 @@ addNotification msg
>>- \now -> upd (\list -> take 10 [(now, msg) : list]) notifications @! ()
viewNotifications :: Task ()
viewNotifications = viewSharedInformation () [ViewAs (join ", ")] currentNotifications @! ()
viewNotifications = viewSharedInformation [ViewAs (join ", ")] currentNotifications @! ()
tasksToDo :: SDSLens () [(TaskId, WorklistRow)] ()
tasksToDo = taskForCurrentUser isToDo
where
isToDo {TaskListItem|attributes} = fmap (\x -> toInt x == toInt Immediate) ('DM'.get "priority" attributes) == Just True
isToDo {TaskListItem|attributes} = fmap (\(JSONInt x) -> x == toInt Immediate) ('DM'.get "priority" attributes) == Just True
incomingTasks :: SDSLens () [(TaskId, WorklistRow)] ()
incomingTasks = taskForCurrentUser isIncoming
where
isIncoming {TaskListItem|attributes} = fmap (\x -> toInt x /= toInt Immediate) ('DM'.get "priority" attributes) == Just True
isIncoming {TaskListItem|attributes} = fmap (\(JSONInt x) -> x /= toInt Immediate) ('DM'.get "priority" attributes) == Just True
taskForCurrentUser f = toReadOnly (mapRead (\(procs, ownPid) -> [(p.TaskListItem.taskId, mkRow p) \\ p <- procs | show ownPid p && isActive p && f p]) (processesForCurrentUser |*| currentTopTask))
......
......@@ -14,8 +14,5 @@ addLog who location about
>>| return ()
showLog :: Task [Log]
showLog
= viewSharedInformation "Loggings..." [] myLog
showLog = Title "Loggings..." @>> viewSharedInformation [] myLog
......@@ -328,7 +328,7 @@ addActorToMap roomViz actor location inventoryForSectionShare shipStatusShare us
( upd ('DM'.put actor.userName actor) userToActorShare
>>| move (0, {col = 0, row = 0}) location actor.userName
>>| moveAround roomViz actor.userName inventoryForSectionShare shipStatusShare userToActorShare inventoryForAllSectionsShare)
(viewInformation ("Section with number: " <+++ location <+++ " does not exist") [] () >>| return ())
(Hint ("Section with number: " <+++ location <+++ " does not exist") @>> viewInformation [] () >>| return ())
:: UITag :== [Int]
......@@ -429,19 +429,19 @@ moveAround viewDeck user inventoryForSectionShare
changeDecks :: Task ()
changeDecks
= watch (lockedHopsShare |*| roomNoForCurrentUserShare)
-&&- enterChoiceWithShared "Change deck" [prettyPrintHops] nearbyHops
-&&- (Hint "Change deck" @>> enterChoiceWithShared [prettyPrintHops] nearbyHops)
>>* [OnAction (Action "Change deck") changeDeck]
pickUpItems :: Task ()
pickUpItems
= watch roomNoForCurrentUserShare
-&&- enterChoiceWithShared "Items nearby" [prettyPrintItems] (nearbyItemsShare inventoryForSectionShare)
-&&- (Hint "Items nearby" @>> enterChoiceWithShared [prettyPrintItems] (nearbyItemsShare inventoryForSectionShare))
>>* [OnAction (Action "Grab selected item") (withSelectedObject userToActorShare inventoryForSectionShare pickupObject)]
dropItems :: Task ()
dropItems
= watch roomNoForCurrentUserShare
-&&- enterChoiceWithShared "Items in inventory" [prettyPrintItems] (inventoryShare userToActorShare)
-&&- (Hint "Items in inventory" @>> enterChoiceWithShared [prettyPrintItems] (inventoryShare userToActorShare))
>>* [OnAction (Action "Drop selected item") (withSelectedObject userToActorShare inventoryForSectionShare dropObject)]
moveAroundUI :: TaskUITree -> TaskUILayout
......
......@@ -18,11 +18,11 @@ derive class iTask Location
editSharedList :: (Shared sds [a]) -> Task () | iTask a & RWShared sds
editSharedList list
= editSharedListWithTask (updateInformation "Item Info" []) list
= editSharedListWithTask (\x -> Title "Item Info" @>> updateInformation [] x) list
editSharedListWithTask :: (a -> Task a) (Shared sds [a]) -> Task () | iTask a & RWShared sds
editSharedListWithTask tupdate list
= editSharedListWithTaskTask (enterInformation "Enter new item" []) tupdate list
= editSharedListWithTaskTask (Hint "Enter new item" @>> enterInformation []) tupdate list
editSharedListWithTaskTask :: (Task a) (a -> Task a) (Shared sds [a])-> Task () | iTask a & RWShared sds
editSharedListWithTaskTask tenter tupdate list
......@@ -33,7 +33,7 @@ editSharedListWithTaskTask tenter tupdate list
editSharedListGeneric :: [EditSharedListOption a] (Shared sds [a]) -> Task () | iTask a & RWShared sds
editSharedListGeneric options list
= doOrClose (forever (enterChoiceWithShared "Choose an item"
= doOrClose (forever (Hint "Choose an item" @>> enterChoiceWithShared
[ChooseFromGrid snd]
(mapRead (\ps -> [(i,p) \\ p <- ps & i <- [0..]]) list)
>>* [OnAction (Action desc) (always (addItem t))
......@@ -53,7 +53,7 @@ where addItem tenter = tenter >>= \item -> upd (\us -> us ++ [item]) list @! (
>>= \item -> upd (\us -> updateAt k item us) list
@! ()
viewItem t (k,u) = t u @! ()
clearAll = viewInformation "Clear All" []
clearAll = Title "Clear All" @>> viewInformation []
"Are you sure you want to delete all items?"
>>* [OnAction ActionOk
(always (upd (\us -> []) list @! ()))
......@@ -107,8 +107,7 @@ lastElems :: Int [a] -> [a]
lastElems n xs = drop (length xs - n) xs
showInfo :: String -> Task String
showInfo msg = viewInformation ("Information","") [] msg
showInfo msg = Title "Information" @>> viewInformation [] msg
doTasksSequentially :: [Task a] -> Task () | iTask a
doTasksSequentially [] = return ()
......@@ -148,10 +147,10 @@ chats = sharedStore "chats" []
derive class iTask ChatMessage
viewChats :: Int -> Task ()
viewChats n = viewSharedInformation "Chats" [] (mapRead (lastElems n) chats) @! ()
viewChats n = Title "Chats" @>> viewSharedInformation [] (mapRead (lastElems n) chats) @! ()
chatDialog :: User [Entity] -> Task ()
chatDialog me _ = doOrClose (forever (enterInformation "Type a message" []
chatDialog me _ = doOrClose (forever (Hint "Type a message" @>> enterInformation []
>>* [OnAction ActionOk (hasValue doUpate)])) @! ()
where
doUpate m = get currentDateTime
......
......@@ -20,8 +20,8 @@ addOnceToWorkspace identity task workspace
find identity [] = Nothing
find identity [p=:{TaskListItem|taskId,attributes}:ps]
| maybe False ((==) identity) ('DM'.get "name" attributes) = Just taskId
= find identity ps
| maybe False ((==) (JSONString identity)) ('DM'.get "name" attributes) = Just taskId
= find identity ps
removeWhenStable t l = t >>* [OnValue (ifStable (\_ -> get (taskListSelfId l) >>- \id -> removeTask id l @? const NoValue))]
......@@ -31,7 +31,7 @@ removeFromWorkspace identity workspace
>>- \items -> case find identity items of
Nothing = return ()
where names = map getName items
getName {TaskListItem|taskId,attributes} | isJust mbname = fromJust mbname
getName {TaskListItem|taskId,attributes} | isJust mbname = let (Just (JSONString name)) = mbname in name
| otherwise = "noname"
where mbname = 'DM'.get "name" attributes
appstr [] = ""
......
......@@ -58,7 +58,7 @@ commanderAlwaysOnTasks = [ ("Map", \cu es -> mapView myNetwork (const True) cu e
]
defineCommandAims :: Task ()
defineCommandAims = updateSharedInformation (Title "Command aims") [] commandAims @! ()
defineCommandAims = (Title "Command aims") @>> updateSharedInformation [] commandAims @! ()
commanderOptionalTasks :: [(String, User [Entity] -> Task ())]
commanderOptionalTasks =
......@@ -74,9 +74,9 @@ commanderOptionalTasks =
]
taakReportUitzetten sender _
= enterChoiceWithShared "Kies een gebruiker" [] users
>>= \user -> enterInformation "Korte beschrijving" []
>>= \des -> enterInformation "Kies prioriteit" []
= Hint "Kies een gebruiker" @>> enterChoiceWithShared [] users
>>= \user -> Title "Korte beschrijving" @>> enterInformation []
>>= \des -> Hint "Kies prioriteit" @>> enterInformation []
>>= \prio -> addTaskForUserAndReport des user sender prio stelOpReport @! ()
makeReport:: User [Entity] -> Task ()
......@@ -85,7 +85,7 @@ makeReport user _ = stelOpReport user >>= verstuur
stelOpReport :: User -> Task IntelReport
stelOpReport user
= get currentDateTime
>>= \dt -> updateInformation "Geef details" []
>>= \dt -> Hint "Geef details" @>> updateInformation[]
{ IntelReport
| sender = toString user
, date = dt
......@@ -96,10 +96,10 @@ stelOpReport user
verstuur :: IntelReport -> Task ()
verstuur report
= enterChoiceWithShared "Verzenden naar" [] users
>>= \user -> enterInformation "Onderwerp" []
>>= \des -> enterInformation "Kies prioriteit" []
>>= \prio -> addCancebleTaskForUser des user prio (\user -> viewInformation "Report" [] report @! ()) @! ()
= Title "Verzenden naar" @>> enterChoiceWithShared [] users
>>= \user -> Title "Onderwerp" @>> enterInformation []
>>= \des -> Title "Kies prioriteit" @>> enterInformation []
>>= \prio -> addCancebleTaskForUser des user prio (\user -> Title "Report" @>> viewInformation [] report @! ()) @! ()
communicateWithContact :: User [Entity] -> Task ()
......@@ -107,16 +107,16 @@ communicateWithContact sender _ = selectedContact @! () // TODO Implement
setInterceptCourse :: User [Entity] -> Task ()
setInterceptCourse sender [ownEntity]
= viewInformation "Setting intercept course towards contact" [ViewAs mkPPEntity] ownEntity @! ()
= Title "Setting intercept course towards contact" @>> viewInformation [ViewAs mkPPEntity] ownEntity @! ()
setInterceptCourse sender ownEntities
= enterMultipleChoice "Select your ships" [] ownEntities