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 derive class iTask UserLED
  28
  29 Start :: *World -> *World
  30 Start world = startEngine (mTaskManager
  31         >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
  32
  33 mTaskManager :: Task ()
  34 mTaskManager = anyTask
  35                 [ viewmTasks @! ()
  36                 , whileUnchanged sdsStore viewShares
  37                 , whileUnchanged deviceStore $ manageDevices process
  38                 ] <<@ ApplyLayout layout
  39         where
  40                 layout = sequenceLayouts
  41                         [ arrangeWithSideBar 0 LeftSide 260 True
  42                         , arrangeSplit Vertical True
  43                         ]
  44
  45                 viewmTasks = listmTasks
  46                         >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
  47                                 Nothing = viewInformation "No task selected" [] ()
  48                                 Just mTaskTask = get deviceStore
  49                                         >>= \devices->case devices of
  50                                                 [] = viewInformation "No devices yet" [] ()
  51                                                 ds = sendmTask mTaskTask ds @! ())
  52                         where
  53                                 listmTasks :: Task String
  54                                 listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
  55
  56                                 sendmTask mTaskId ds = fromJust ('DM'.get mTaskId allmTasks)
  57 //                                      >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
  58 //                                              -&&- enterInformation "Timeout, 0 for one-shot" [])
  59 //                                      >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice bc)]
  60
  61                 process :: MTaskDevice (Shared Channels) -> Task ()
  62                 process device ch = forever (watch ch >>* [OnValue (
  63                                 ifValue (not o isEmpty o fst3)
  64                                 (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
  65                         where
  66                                 proc :: [MTaskMSGRecv] -> Task ()
  67                                 proc [] = treturn ()
  68                                 proc [m:ms] = (case m of
  69 //                                      MTSDSAck i = traceValue (toString m) @! ()
  70 //                                      MTSDSDelAck i = traceValue (toString m) @! ()
  71                                         MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
  72                                         MTTaskAck i = deviceTaskAcked device i
  73                                         MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
  74                                         MTEmpty = treturn ()
  75                                         _ = traceValue (toString m) @! ()
  76                                         ) >>| proc ms
  77
  78                 mapPar :: (a -> Task a) [a] -> Task ()
  79                 mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
  80                 allAtOnce t = foldr1 (||-) t @! ()
  81                 //allAtOnce = (flip (@!) ()) o foldr1 (||-)