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