import TTY, iTasksTTY
-Start :: *World -> *World
-Start world = startEngine (mTaskManager
- >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
+Start world = startEngine [
+ publish "/manage" $ const $ mTaskManager
+ >>* [OnAction (Action "Shutdown") (always $ shutDown 0)],
+ publish "/" $ const demo
+ ] world
+
+demo :: Task ()
+demo = set 5 (sharedDynamicStore "Hoi" 5)
+ >>| viewSharedInformation "Devices" [] deviceStoreNP
+ >>* [OnValue $ ifValue pred (cont o hd)]
+ where
+ pred [] = False
+ pred [x:_] = not $ isEmpty x.deviceShares
+
+ cont :: MTaskDevice -> Task ()
+ cont dev
+ # rs = shareShare dev (hd dev.deviceShares)
+ = get rs >>= \oldvalue->
+ forever (updateSharedInformation "Blinkyblink" [] (shareShare dev (hd dev.deviceShares))
+ >>* [OnAction ActionContinue (const $ Just $ treturn ())])
+ -|| (wait "bigger than 10" (\x->x == oldvalue) rs
+ >>= viewInformation "Bigger:)" [])
+
+ toInt :: BCValue -> Int
+ toInt (BCValue e) = dynToInt (dynamic e)
+
+ dynToInt :: Dynamic -> Int
+ dynToInt (a :: Int) = a
+ dynToInt x = abort "Not an int"
mTaskManager :: Task ()
-mTaskManager = startupDevices >>| anyTask
- [ viewmTasks @! ()
- , whileUnchanged sdsStore manageShares
- , whileUnchanged deviceStore $ manageDevices process
- ] <<@ ApplyLayout (sequenceLayouts
- [ arrangeWithSideBar 0 LeftSide 260 True
- , arrangeSplit Vertical True
- ])
+mTaskManager = (>>|) startupDevices $
+ forever viewmTasks ||-
+ ((manageShares ||- forever (manageDevices process)) <<@ ArrangeSplit Vertical True)
+ <<@ ArrangeWithSideBar 0 LeftSide 260 True
where
- viewmTasks :: Task String
+ viewmTasks :: Task [MTaskDevice]
viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
- >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
- Nothing = viewInformation "No task selected" [] ()
- Just mTaskTask = get deviceStore
- >>= \devices->case devices of
- [] = viewInformation "No devices yet" [] ()
- ds = fromJust ('DM'.get mTaskTask allmTasks)
- >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
- -&&- enterInformation "Timeout" []
- ) >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskTask bc)]
- @! ()
- )
+ >>= \task->get deviceStoreNP
+ >>* [OnValue $ (ifValue isEmpty) $ \_->
+ viewInformation "No devices yet" [] [] >>= treturn
+ ,OnValue $ (ifValue $ not o isEmpty) $ \d->
+ fromJust ('DM'.get task allmTasks)
+ >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] d
+ -&&- enterInformation "Timeout" []
+ ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice task bc)]
+ >>| treturn []
+ ]
process :: MTaskDevice (Shared Channels) -> Task ()
- process device ch = forever (watch ch >>* [OnValue (
- ifValue (not o isEmpty o fst3)
- (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
+ process device ch = forever
+ $ traceValue "Waiting for channel change"
+ >>| wait "process" (not o isEmpty o fst3) ch
+ >>= \(r,s,ss)->upd (appFst3 (const [])) ch
+ >>| proc r
where
proc :: [MTaskMSGRecv] -> Task ()
proc [] = treturn ()
- proc [m:ms] = (case m of
+ proc [MTEmpty:ms] = proc ms
+ proc [m:ms] = traceValue (toString m) >>| (case m of
// MTSDSAck i = traceValue (toString m) @! ()
// MTSDSDelAck i = traceValue (toString m) @! ()
-// MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
- MTTaskAck i = deviceTaskAcked device i
+ MTPub i val = updateShareFromPublish device i val @! ()
+ MTTaskAck i mem = deviceTaskAcked device i mem @! ()
MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
- MTEmpty = treturn ()
- _ = traceValue (toString m) @! ()
+ MTDevSpec s = deviceAddSpec device s @! ()
+ _ = treturn ()
) >>| proc ms
-
- mapPar :: (a -> Task a) [a] -> Task ()
- mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
- allAtOnce t = foldr1 (||-) t @! ()
- //allAtOnce = (flip (@!) ()) o foldr1 (||-)
repositories / mTask.git / blobdiff