equality for devices, externalize tasks

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 53b3944..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)
 


@@ -60,58 +64,65 @@ manageDevices processFun ds = anyTask [
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: MTaskDevice -> Task ()
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: MTaskDevice -> Task ()

-viewDevice d = anyTask 
+viewDevice d = forever $ anyTask 

                [viewInformation "Device settings" [] d @! ()
                ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
                ,forever $ 
                [viewInformation "Device settings" [] d @! ()
                ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
                ,forever $ 

-                       enterChoice "Delete task on device" [ChooseFromList fst] d.deviceTasks
-                       >>* [OnAction (Action "Delete") $ ifValue (\(_,i)->i <> -1) (deviceTaskDelete d o snd)]
+                       enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
+                       >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]

                        @! ()
                ] <<@ ArrangeHorizontal
                        @! ()
                ] <<@ 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)
 

-sendToDevice :: (Map String (Main (ByteCode () Stmt))) String (MTaskDevice, Int) -> Task ()
-sendToDevice tmap mTask (device, timeout) =
-               get bcStateStore @ createBytecode
+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
        >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
        >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
        >>| makeShares sdss
        >>| sendMessage device msgs

-       >>| withDevices device (addTask timeout)
+       >>| makeTask wta -1
+       >>= withDevices device o addTask timeout

        @! ()
        where
        @! ()
        where

-               createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask tmap)) st

                sharename i = device.deviceChannels +++ "-" +++ toString i
                toSDSRecords st = [{MTaskShare |
                        initValue=toInt d1*265 + toInt d2,
                sharename i = device.deviceChannels +++ "-" +++ toString i
                toSDSRecords st = [{MTaskShare |
                        initValue=toInt d1*265 + toInt d2,

-                       withTask=mTask,
+                       withTask=wta,

                        identifier=i,
                        realShare="mTaskSDS-" +++ toString i}
                                \\(i,[d1,d2])<-st.sdss]
                makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 
                        identifier=i,
                        realShare="mTaskSDS-" +++ toString i}
                                \\(i,[d1,d2])<-st.sdss]
                makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 

-               addTask :: Int MTaskDevice -> MTaskDevice
-               addTask timeout device = {device & deviceTasks=[(mTask, -1):device.deviceTasks]}
+               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 ()
 
 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 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 
 
 deviceTaskAcked :: MTaskDevice Int -> Task ()
 deviceTaskAcked dev i 

-       = withDevices dev (\d->{d&deviceTasks=ackFirst i d.deviceTasks})
+       = withDevices dev (\d->{d&deviceTasks=ackFirst d.deviceTasks})

        where
        where

-               ackFirst :: Int [(String, Int)] -> [(String, Int)]
-               ackFirst _ [] = []
-               ackFirst a [(s,i):ts] = if (i == -1)  [(s,a):ts] [(s,i):ackFirst a ts]
+               ackFirst :: [MTaskTask] -> [MTaskTask]
+               ackFirst [] = []
+               ackFirst [t:ts] = if (t.ident == -1)
+                       [{t & ident=i}:ts] [t:ackFirst ts]

 
 

-deviceTaskDelete :: MTaskDevice Int -> Task ()
-deviceTaskDelete dev tid = sendMessage dev [MTTaskDel tid]
+deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
+deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident]

 
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
 deviceTaskDeleteAcked d i = withDevices d $ deleteTask
 
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
 deviceTaskDeleteAcked d i = withDevices d $ deleteTask

-       where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> snd s]}
+       where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}