separate share publishing from share class

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 537a3b9..0a6ab0f 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -7,18 +7,20 @@ 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 GenBimap
 import Devices.mTaskSerial
 import Devices.mTaskTCP
 import Utils.SDS
 import Utils.Devices
 
 import GenBimap
 import Devices.mTaskSerial
 import Devices.mTaskTCP

+import Data.Tuple

 import iTasks._Framework.Store
 import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Common, iTasks.UI.Layout.Default, iTasks.UI.Layout.Common
 
 from Data.Func import $
 
 import iTasks._Framework.Store
 import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Common, iTasks.UI.Layout.Default, iTasks.UI.Layout.Common
 
 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
 


@@ -26,9 +28,15 @@ instance == MTaskDevice where
        (==) a b = a.deviceChannels == b.deviceChannels
 
 startupDevices :: Task [MTaskDevice]
        (==) a b = a.deviceChannels == b.deviceChannels
 
 startupDevices :: Task [MTaskDevice]

-startupDevices = upd (map reset) deviceStore
+startupDevices = upd (map reset) deviceStoreNP

        where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}
 
        where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}
 

+withDevice :: (MTaskDevice -> Task a) String -> Task a | iTask a
+withDevice f s = get deviceStoreNP
+       >>= \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


@@ -37,7 +45,8 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice
                ,deviceTask=Nothing
                ,deviceError=Nothing
                ,deviceData=res
                ,deviceTask=Nothing
                ,deviceError=Nothing
                ,deviceData=res

-               ,deviceSpec=Nothing}
+               ,deviceSpec=Nothing
+               ,deviceShares=[]}

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


@@ -60,16 +69,27 @@ addDevice devices processFun
                deviceTypes :: [MTaskResource]
                deviceTypes = conses{|*|}
 
                deviceTypes :: [MTaskResource]
                deviceTypes = conses{|*|}
 

-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}) @! ()
+//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})
+//     >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch
+//     @! ()
+//     where
+//             errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e}) @! ()
+connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
+connectDevice procFun device = let ch = channels device
+       in appendTopLevelTask 'DM'.newMap True
+               (       procFun device ch 
+               -||- catchAll (getSynFun device.deviceData ch) errHdl)
+               >>= \tid->withDevices device (\d->{d&deviceTask=Just tid,deviceError=Nothing})
+               >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch

        where
        where

-               errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e})
+               errHdl e = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! ()

 
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
 manageDevices processFun ds = anyTask [
 
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
 manageDevices processFun ds = anyTask [

-               addDevice deviceStore processFun <<@ Title "Add new device" @! ():
+               addDevice deviceStoreNP processFun <<@ Title "Add new device" @! ():

                        [viewDevice processFun d 
                                <<@ Title d.deviceName\\d<-ds]]
        <<@ ArrangeWithTabs @! ()
                        [viewDevice processFun d 
                                <<@ Title d.deviceName\\d<-ds]]
        <<@ ArrangeWithTabs @! ()


@@ -85,50 +105,37 @@ viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask
                ] <<@ ArrangeHorizontal
                >>* [OnAction (Action "Delete Device") (always $ deleteDevice d):
                                if (isJust d.deviceTask) []
                ] <<@ ArrangeHorizontal
                >>* [OnAction (Action "Delete Device") (always $ deleteDevice d):
                                if (isJust d.deviceTask) []

-                               [OnAction (Action "Connect") (always $ connectDevice pf d)]]
+                               [OnAction (Action "Connect") (always $ connectDevice pf d @! ())]]

        where
                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
 deleteDevice :: MTaskDevice -> Task ()
        where
                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
        >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask

-       >>| upd (filter ((<>)d)) deviceStore
+       >>| upd (filter ((<>)d)) deviceStoreNP
+//     >>| cleanSharesDevice d.deviceName

        @! ()
 
        @! ()
 

-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]
+sendMessages :: [MTaskMSGSend] MTaskDevice -> Task Channels
+sendMessages msgs dev = upd (realMessageSend msgs) $ channels dev

 
 

-               addTask :: MTaskTask MTaskDevice -> MTaskDevice
-               addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
+sendMessagesIW :: [MTaskMSGSend] MTaskDevice *IWorld -> *(MaybeError TaskException (), *IWorld)
+sendMessagesIW msgs dev iworld 
+       = modify (tuple () o realMessageSend msgs) (channels dev) iworld

 
 

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

 
 

-withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
-withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()
+withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task [MTaskDevice]
+withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStoreNP

 
 

-deviceTaskAcked :: MTaskDevice Int -> Task ()
-deviceTaskAcked dev i 
-       = withDevices dev (\d->{d&deviceTasks=ackFirst d.deviceTasks})
+deviceTaskAcked :: MTaskDevice Int Int -> Task [MTaskDevice]
+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 [] = []


@@ -138,9 +145,10 @@ deviceTaskAcked dev i
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 

-deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
-deviceTaskDeleteAcked d i = withDevices d $ deleteTask
+deviceTaskDeleteAcked :: MTaskDevice Int -> Task [MTaskDevice]
+deviceTaskDeleteAcked d i = cleanSharesTask i d
+       >>| withDevices d deleteTask

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