fix device deletion

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 661c701..537a3b9 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -18,7 +18,7 @@ import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.
 
 from Data.Func import $
 
 
 from Data.Func import $
 

-derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
+derive class iTask MTaskDevice, MTaskResource, MTaskDeviceSpec, MTaskMSGRecv, MTaskMSGSend, BCShare

 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
 


@@ -36,7 +36,8 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice
                ,deviceTasks=[]
                ,deviceTask=Nothing
                ,deviceError=Nothing
                ,deviceTasks=[]
                ,deviceTask=Nothing
                ,deviceError=Nothing

-               ,deviceData=res}
+               ,deviceData=res
+               ,deviceSpec=Nothing}

 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t


@@ -74,7 +75,7 @@ manageDevices processFun ds = anyTask [
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()

-viewDevice pf d = forever $ anyTask 
+viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask 

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


@@ -91,30 +92,30 @@ viewDevice pf d = forever $ anyTask
 deleteDevice :: MTaskDevice -> Task ()
 deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
        >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask
 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
+       >>| upd (filter ((<>)d)) deviceStore

        @! ()
 
 sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 sendToDevice wta mTask (device, timeout) =
        @! ()
 
 sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 sendToDevice wta mTask (device, timeout) =

-               get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
-       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords 
-       >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare
-       >>| makeShares sdss
+               traceValue "starting to send"
+       >>| get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
+       >>= \(msgs, st1)->traceValue "messages generated"
+       >>| set st1 bcStateStore
+       >>| traceValue "bcstate store updated"
+       >>| toSDSRecords st1
+       >>= \sdss->traceValue "Shares created"
+       >>| set sdss sdsStore//MTaskShareaddToSDSShare
+       >>| traceValue "Shares store updated"

        >>| sendMessages msgs device
        >>| sendMessages msgs device

+       >>| traceValue "Messages sent"

        >>| makeTask wta -1
        >>| makeTask wta -1

-       >>= withDevices device o addTask
+       >>= \t->traceValue "Task made"
+       >>| withDevices device (addTask t)
+       >>| traceValue "Tasks share updated"

        @! ()
        where
                sharename i = device.deviceChannels +++ "-" +++ toString i
        @! ()
        where
                sharename i = device.deviceChannels +++ "-" +++ toString i

-               toSDSRecords st = [{MTaskShare |
-                       withTask=wta,
-                       identifier=sdsi,
-                       //We skip the only/local shares
-                       realShare="mTaskSDS-" +++ toString sdsi}
-                               \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub]
-
-               makeShares :: ([MTaskShare] -> Task ())
-               makeShares = undef //foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+               toSDSRecords st = sequence "" [makeShare wta sdsi sdsval\\{sdsi,sdspub,sdsval}<-st.sdss]// | sdspub]

 
                addTask :: MTaskTask MTaskDevice -> MTaskDevice
                addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
 
                addTask :: MTaskTask MTaskDevice -> MTaskDevice
                addTask task device = {device & deviceTasks=[task:device.deviceTasks]}


@@ -140,3 +141,6 @@ deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
 deviceTaskDeleteAcked d i = withDevices d $ deleteTask
        where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
 deviceTaskDeleteAcked d i = withDevices d $ deleteTask
        where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}

+
+deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task ()
+deviceAddSpec d s = withDevices d $ \r->{r&deviceSpec=Just s}