equality for devices, externalize tasks

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index b059b10..4fff9ae 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -1,5 +1,6 @@
 implementation module Devices.mTaskDevice
 
 implementation module Devices.mTaskDevice
 

+from StdFunc import flip

 import Generics.gCons
 import mTaskInterpret
 import iTasks
 import Generics.gCons
 import mTaskInterpret
 import iTasks


@@ -19,6 +20,9 @@ derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
 derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
 derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
 
 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)
 
 channels :: MTaskDevice -> Shared Channels
 channels d = memoryShare d.deviceChannels ([], [], False)
 


@@ -34,31 +38,91 @@ getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
 getSynFun (SerialDevice t) = synFun t
 
 getSynFun (TCPDevice t) = synFun t
 getSynFun (SerialDevice t) = synFun t
 

-addDevice :: (Shared [MTaskDevice]) -> Task String
-addDevice devices = enterChoice "Device type" [] (map consName{|*|} deviceTypes)
+addDevice :: (Shared [MTaskDevice]) (MTaskDevice (Shared Channels) -> Task ()) -> Task String
+addDevice devices processFun
+       =   enterChoice "Device type" [] (map consName{|*|} deviceTypes)

        >&^ \sh->whileUnchanged sh $ \mty->case mty of
                Nothing = viewInformation "No type selected yet" [] ""
                Just ty = enterInformation "Name" [] -&&- deviceSettings ty
                        >>= \(name, settings)->makeDevice name settings
        >&^ \sh->whileUnchanged sh $ \mty->case mty of
                Nothing = viewInformation "No type selected yet" [] ""
                Just ty = enterInformation "Name" [] -&&- deviceSettings ty
                        >>= \(name, settings)->makeDevice name settings

-                       >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch=channels dev in getSynFun dev.deviceData ch)
+                       >>= \dev->appendTopLevelTask 'DM'.newMap True (tlt dev)

                        >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
                        @! ""
        where
                        >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
                        @! ""
        where

+               tlt dev = let ch = channels dev in processFun dev ch -||- getSynFun dev.deviceData ch
+

                deviceSettings "SerialDevice" = getmTaskSerialDevice
                deviceSettings "TCPDevice" = getmTaskTCPDevice
 
                deviceTypes :: [MTaskResource]
                deviceTypes = conses{|*|}
 
                deviceSettings "SerialDevice" = getmTaskSerialDevice
                deviceSettings "TCPDevice" = getmTaskTCPDevice
 
                deviceTypes :: [MTaskResource]
                deviceTypes = conses{|*|}
 

-viewDevices :: [MTaskDevice] -> Task ()
-viewDevices ds = anyTask [
-               addDevice deviceStore <<@ Title "Add new device" @! ():
+manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
+manageDevices processFun ds = anyTask [
+               addDevice deviceStore processFun <<@ Title "Add new device" @! ():

                        [viewDevice d <<@ Title d.deviceName\\d<-ds]]
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: MTaskDevice -> Task ()
                        [viewDevice d <<@ Title d.deviceName\\d<-ds]]
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: MTaskDevice -> Task ()

-viewDevice d = (viewInformation "Device settings" [] d 
-               ||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
-               ) <<@ ArrangeHorizontal
+viewDevice d = forever $ anyTask 
+               [viewInformation "Device settings" [] d @! ()
+               ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
+               ,forever $ 
+                       enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
+                       >>* [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)
        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 @ 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
+       >>= withDevices device o addTask timeout
+       @! ()
+       where
+               sharename i = device.deviceChannels +++ "-" +++ toString i
+               toSDSRecords st = [{MTaskShare |
+                       initValue=toInt d1*265 + toInt d2,
+                       withTask=wta,
+                       identifier=i,
+                       realShare="mTaskSDS-" +++ toString i}
+                               \\(i,[d1,d2])<-st.sdss]
+               makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+
+               addTask :: Int MTaskTask MTaskDevice -> MTaskDevice
+               addTask timeout task device = {device & deviceTasks=[task:device.deviceTasks]}
+
+sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
+sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
+
+withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
+withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()
+
+deviceTaskAcked :: MTaskDevice Int -> Task ()
+deviceTaskAcked dev i 
+       = withDevices dev (\d->{d&deviceTasks=ackFirst d.deviceTasks})
+       where
+               ackFirst :: [MTaskTask] -> [MTaskTask]
+               ackFirst [] = []
+               ackFirst [t:ts] = if (t.ident == -1)
+                       [{t & ident=i}:ts] [t:ackFirst ts]
+
+deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
+deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident]
+
+deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
+deviceTaskDeleteAcked d i = withDevices d $ deleteTask
+       where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}