update to new iTasks system, some error, heap full
[mTask.git] / miTask.icl
1 module miTask
2
3 import StdDebug, StdMisc
4 from StdFunc import flip
5
6 import iTasks
7 import mTask
8 import Devices.mTaskDevice
9 import Shares.mTaskShare
10 import Tasks.Examples
11 import Utils.SDS
12
13 from Text import class Text(startsWith,concat,split,join), instance Text String
14
15 import qualified Data.Map as DM
16
17 from Data.Func import $
18 import Data.Tuple
19 import Data.List
20 import System.Directory
21
22 import iTasks._Framework.Store
23 import iTasks._Framework.Serialization
24
25 import TTY, iTasksTTY
26
27 Start world = startEngine [
28 publish "/manage" $ const $ mTaskManager
29 >>* [OnAction (Action "Shutdown") (always $ shutDown 0)],
30 publish "/" $ const demo
31 ] world
32
33 demo :: Task ()
34 demo = viewSharedInformation "Devices" [] deviceStoreNP
35 >>* [OnValue $ ifValue pred (cont o hd)]
36 where
37 pred [] = False
38 pred [x:_] = not $ isEmpty x.deviceShares
39
40 cont :: MTaskDevice -> Task ()
41 cont dev
42 # rs = getRealShare dev (hd dev.deviceShares)
43 = get rs >>= \oldvalue->
44 forever (updateSharedInformation "Blinkyblink" [] (getRealShare dev (hd dev.deviceShares))
45 >>* [OnAction ActionContinue (const $ Just $ treturn ())])
46 -|| (wait "bigger than 10" (\x->x == oldvalue) rs
47 >>= viewInformation "Bigger:)" [])
48
49 toInt :: BCValue -> Int
50 toInt (BCValue e) = dynToInt (dynamic e)
51
52 dynToInt :: Dynamic -> Int
53 dynToInt (a :: Int) = a
54 dynToInt x = abort "Not an int"
55
56 mTaskManager :: Task ()
57 mTaskManager = (>>|) startupDevices $
58 viewmTasks ||-
59 ((manageShares ||- whileUnchanged deviceStoreNP (manageDevices process))
60 <<@ ArrangeSplit Vertical True)
61 <<@ ArrangeWithSideBar 0 LeftSide 260 True
62 where
63 viewmTasks :: Task String
64 viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
65 >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
66 Nothing = viewInformation "No task selected" [] ()
67 Just mTaskTask = get deviceStoreNP
68 >>= \devices->case devices of
69 [] = viewInformation "No devices yet" [] ()
70 ds = fromJust ('DM'.get mTaskTask allmTasks)
71 >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
72 -&&- enterInformation "Timeout" []
73 ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice mTaskTask bc)]
74 @! ()
75 )
76
77 process :: MTaskDevice (Shared Channels) -> Task ()
78 process device ch = forever (watch ch >>* [OnValue (
79 ifValue (not o isEmpty o fst3)
80 (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
81 where
82 proc :: [MTaskMSGRecv] -> Task ()
83 proc [] = treturn ()
84 proc [MTEmpty:ms] = proc ms
85 proc [m:ms] = traceValue (toString m) >>| (case m of
86 // MTSDSAck i = traceValue (toString m) @! ()
87 // MTSDSDelAck i = traceValue (toString m) @! ()
88 MTPub i val = updateShareFromPublish device i val @! ()
89 MTTaskAck i mem = deviceTaskAcked device i mem @! ()
90 MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
91 MTDevSpec s = deviceAddSpec device s @! ()
92 _ = treturn ()
93 ) >>| proc ms