make shares of devices

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index a99097d..7316f94 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -30,6 +30,12 @@ startupDevices :: Task [MTaskDevice]
 startupDevices = upd (map reset) deviceStore
        where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}
 
+withDevice :: (MTaskDevice -> Task a) String -> Task a | iTask a
+withDevice f s = get deviceStore
+       >>= \ds->case 'DL'.find (\d->d.deviceName == s) ds of
+               Nothing = throw "Device not available"
+               Just d = f d
+
 makeDevice :: String MTaskResource -> Task MTaskDevice
 makeDevice name res = get randomInt @ \rand->{MTaskDevice
                |deviceChannels=name +++ toString rand
@@ -38,7 +44,8 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice
                ,deviceTask=Nothing
                ,deviceError=Nothing
                ,deviceData=res
-               ,deviceSpec=Nothing}
+               ,deviceSpec=Nothing
+               ,deviceShares=[]}
 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
@@ -93,36 +100,37 @@ viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask
                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
 deleteDevice :: MTaskDevice -> Task ()
-deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
+deleteDevice d = sendMessages [MTShutdown] d
+       >>| wait "Waiting for the channels to empty" (\(r,s,ss)->isEmpty s) (channels d)
+       >>| upd (\(r,s,ss)->(r,s,True)) (channels d)
        >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask
        >>| upd (filter ((<>)d)) deviceStore
-//     >>| upd (removeShares d) sdsStore
+//     >>| cleanSharesDevice d.deviceName
        @! ()
 
-
 sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
 sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels
 
 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})
+deviceTaskAcked :: MTaskDevice Int Int -> Task ()
+deviceTaskAcked dev i mem
+       = withDevices dev (\d->{d
+                       &deviceTasks=ackFirst d.deviceTasks
+                       ,deviceSpec=Just {fromJust d.deviceSpec & bytesMemory=mem}})
        where
                ackFirst :: [MTaskTask] -> [MTaskTask]
                ackFirst [] = []
                ackFirst [t:ts] = if (t.ident == -1)
                        [{t & ident=i}:ts] [t:ackFirst ts]
 
-getDevice :: String -> Task MTaskDevice
-getDevice n = get deviceStore @ fromJust o 'DL'.find (\s->s.deviceName == n)
-
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
-deviceTaskDeleteAcked d i = withDevices d $ deleteTask
+deviceTaskDeleteAcked d i = cleanSharesTask i d
+       >>| withDevices d deleteTask
        where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}
 
 deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task ()