equality for devices, externalize tasks

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index bae7af6..0e9f567 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -29,6 +29,8 @@ channels :: MTaskDevice -> Shared Channels
                ,deviceData :: MTaskResource
        }
 
                ,deviceData :: MTaskResource
        }
 

+instance == MTaskDevice
+

 class MTaskDuplex a where
        synFun :: a (Shared Channels) -> Task ()
 
 class MTaskDuplex a where
        synFun :: a (Shared Channels) -> Task ()
 

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 9a93634..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,7 +64,7 @@ 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 $ 


@@ -68,19 +72,25 @@ viewDevice d = anyTask
                        >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
                        @! ()
                ] <<@ ArrangeHorizontal
                        >>* [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) =
 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
        >>= \(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
        @! ()
        where
                sharename i = device.deviceChannels +++ "-" +++ toString i


@@ -99,8 +109,7 @@ sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
 sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
 
 withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> 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 

diff --git a/miTask.icl b/miTask.icl
index a2ef345..09fb5dd 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -35,13 +35,11 @@ mTaskManager = anyTask
                [ viewmTasks @! ()
                , whileUnchanged sdsStore viewShares
                , whileUnchanged deviceStore $ manageDevices process
                [ viewmTasks @! ()
                , whileUnchanged sdsStore viewShares
                , whileUnchanged deviceStore $ manageDevices process

-               ] <<@ ApplyLayout layout
-       where
-               layout = sequenceLayouts
+               ] <<@ ApplyLayout (sequenceLayouts 

                        [ arrangeWithSideBar 0 LeftSide 260 True
                        , arrangeSplit Vertical True
                        [ 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
                viewmTasks :: Task String
                viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
                        >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of