implementation module Devices.mTaskDevice
+from StdFunc import flip
import Generics.gCons
import mTaskInterpret
import iTasks
derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
+instance == MTaskDevice where
+ (==) a b = a.deviceChannels == b.deviceChannels
+
channels :: MTaskDevice -> Shared Channels
channels d = memoryShare d.deviceChannels ([], [], False)
<<@ ArrangeWithTabs @! ()
viewDevice :: MTaskDevice -> Task ()
-viewDevice d = anyTask
+viewDevice d = forever $ anyTask
[viewInformation "Device settings" [] d @! ()
,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
,forever $
>>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
@! ()
] <<@ ArrangeHorizontal
+ >>* [OnAction (Action "Delete Device") (always $ deleteDevice d)]
where
dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
+deleteDevice :: MTaskDevice -> Task ()
+deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
+ >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask
+ >>| upd (filter ((==)d)) deviceStore
+ @! ()
+
sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task ()
sendToDevice wta mTask (device, timeout) =
- get bcStateStore
- >>= \st->treturn (toMessages timeout (toRealByteCode (unMain mTask) st))
+ get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
>>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
>>| makeShares sdss
>>| sendMessage device msgs
>>| makeTask wta -1
- >>= \task->withDevices device (addTask timeout task)
+ >>= withDevices device o addTask timeout
@! ()
where
sharename i = device.deviceChannels +++ "-" +++ toString i
sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
-withDevices a trans = upd (map withDevice) deviceStore @! ()
- where withDevice b = if (a.deviceChannels == b.deviceChannels) (trans b) b
+withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()
deviceTaskAcked :: MTaskDevice Int -> Task ()
deviceTaskAcked dev i
[ viewmTasks @! ()
, whileUnchanged sdsStore viewShares
, whileUnchanged deviceStore $ manageDevices process
- ] <<@ ApplyLayout layout
- where
- layout = sequenceLayouts
+ ] <<@ ApplyLayout (sequenceLayouts
[ arrangeWithSideBar 0 LeftSide 260 True
, arrangeSplit Vertical True
- ]
-
+ ])
+ where
viewmTasks :: Task String
viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
>&^ \sh->whileUnchanged sh $ \mi->forever (case mi of