small update

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 537a3b9..c8bee61 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -7,6 +7,7 @@ import iTasks
 import iTasksTTY
 import TTY
 import qualified Data.Map as DM
 import iTasksTTY
 import TTY
 import qualified Data.Map as DM

+import qualified Data.List as DL

 import Utils.SDS
 import Utils.Devices
 
 import Utils.SDS
 import Utils.Devices
 


@@ -18,7 +19,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, MTaskDeviceSpec, MTaskMSGRecv, MTaskMSGSend, BCShare
+derive class iTask MTaskDevice, MTaskResource, 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
 


@@ -29,6 +30,12 @@ startupDevices :: Task [MTaskDevice]
 startupDevices = upd (map reset) deviceStore
        where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}
 
 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
 makeDevice :: String MTaskResource -> Task MTaskDevice
 makeDevice name res = get randomInt @ \rand->{MTaskDevice
                |deviceChannels=name +++ toString rand


@@ -63,7 +70,9 @@ addDevice devices processFun
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 connectDevice pf d = let ch = channels d in appendTopLevelTask 'DM'.newMap True
        (pf d ch -||- catchAll (getSynFun d.deviceData ch) errorHandle)
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 connectDevice pf d = let ch = channels d in appendTopLevelTask 'DM'.newMap True
        (pf d ch -||- catchAll (getSynFun d.deviceData ch) errorHandle)

-       >>= \tid->withDevices d (\d->{d&deviceTask=Just tid,deviceError=Nothing}) @! ()
+       >>= \tid->withDevices d (\d->{d&deviceTask=Just tid,deviceError=Nothing})
+       >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch
+       @! ()

        where
                errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e})
 
        where
                errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e})
 


@@ -93,32 +102,9 @@ 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
 deleteDevice 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

        @! ()
 
        @! ()
 

-sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
-sendToDevice wta mTask (device, timeout) =
-               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
-       >>| traceValue "Messages sent"
-       >>| makeTask wta -1
-       >>= \t->traceValue "Task made"
-       >>| withDevices device (addTask t)
-       >>| traceValue "Tasks share updated"
-       @! ()
-       where
-               sharename i = device.deviceChannels +++ "-" +++ toString i
-               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]}

 
 sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
 sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels
 
 sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
 sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels


@@ -126,9 +112,11 @@ 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 @! ()
 
 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 [] = []
        where
                ackFirst :: [MTaskTask] -> [MTaskTask]
                ackFirst [] = []


@@ -143,4 +131,4 @@ deviceTaskDeleteAcked d i = withDevices d $ deleteTask
        where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}
 
 deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task ()
        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}
+deviceAddSpec d s = withDevices d $ \r->{MTaskDevice | r & deviceSpec=Just s}