shares are updated now and visible

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 2bd7121..0304e7e 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -1,26 +1,33 @@
 implementation module Devices.mTaskDevice
 
 implementation module Devices.mTaskDevice
 

+from StdFunc import flip

 import Generics.gCons
 import mTaskInterpret
 import iTasks
 import iTasksTTY
 import TTY
 import qualified Data.Map as DM
 import Generics.gCons
 import mTaskInterpret
 import iTasks
 import iTasksTTY
 import TTY
 import qualified Data.Map as DM

-import Utils
+import Utils.SDS
+import Utils.Devices

 
 import GenBimap
 import Devices.mTaskSerial
 import Devices.mTaskTCP
 import iTasks._Framework.Store
 
 import GenBimap
 import Devices.mTaskSerial
 import Devices.mTaskTCP
 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 $
 
 
 from Data.Func import $
 

-derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+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
 

-channels :: MTaskDevice -> Shared Channels
-channels d = memoryShare d.deviceChannels ([], [], False)
+instance == MTaskDevice where
+       (==) a b = a.deviceChannels == b.deviceChannels
+
+startupDevices :: Task [MTaskDevice]
+startupDevices = upd (map reset) deviceStore
+       where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}

 
 makeDevice :: String MTaskResource -> Task MTaskDevice
 makeDevice name res = get randomInt @ \rand->{MTaskDevice
 
 makeDevice :: String MTaskResource -> Task MTaskDevice
 makeDevice name res = get randomInt @ \rand->{MTaskDevice


@@ -28,24 +35,108 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice
                ,deviceName=name
                ,deviceTasks=[]
                ,deviceTask=Nothing
                ,deviceName=name
                ,deviceTasks=[]
                ,deviceTask=Nothing

+               ,deviceError=Nothing

                ,deviceData=res}
 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
 getSynFun (SerialDevice t) = synFun t
 
                ,deviceData=res}
 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
 getSynFun (SerialDevice t) = synFun t
 

-addDevice :: (Shared [MTaskDevice]) -> Task String
-addDevice devices = enterChoice "Device type" [] (map consName{|*|} deviceTypes)
+addDevice :: (Shared [MTaskDevice]) (MTaskDevice (Shared Channels) -> Task ()) -> Task String
+addDevice devices processFun
+       =   enterChoice "Device type" [] (map consName{|*|} deviceTypes)

        >&^ \sh->whileUnchanged sh $ \mty->case mty of
                Nothing = viewInformation "No type selected yet" [] ""
                Just ty = enterInformation "Name" [] -&&- deviceSettings ty
                        >>= \(name, settings)->makeDevice name settings
        >&^ \sh->whileUnchanged sh $ \mty->case mty of
                Nothing = viewInformation "No type selected yet" [] ""
                Just ty = enterInformation "Name" [] -&&- deviceSettings ty
                        >>= \(name, settings)->makeDevice name settings

-                       >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch=channels dev in getSynFun dev.deviceData ch)
-                       >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
+                       >>= \dev->upd (\l->[dev:l]) devices
+                       >>| connectDevice processFun dev

                        @! ""
        where
                deviceSettings "SerialDevice" = getmTaskSerialDevice
                deviceSettings "TCPDevice" = getmTaskTCPDevice
 
                        @! ""
        where
                deviceSettings "SerialDevice" = getmTaskSerialDevice
                deviceSettings "TCPDevice" = getmTaskTCPDevice
 

-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}) @! ()
+       where
+               errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e})
+
+manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
+manageDevices processFun ds = anyTask [
+               addDevice deviceStore processFun <<@ Title "Add new device" @! ():
+                       [viewDevice processFun d 
+                               <<@ Title d.deviceName\\d<-ds]]
+       <<@ ArrangeWithTabs @! ()
+
+viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
+viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask 
+               [viewInformation "Device settings" [] d @! ()
+               ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
+               ,forever $ 
+                       enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
+                       >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
+                       @! ()
+               ] <<@ ArrangeHorizontal
+               >>* [OnAction (Action "Delete Device") (always $ deleteDevice d):
+                               if (isJust d.deviceTask) []
+                               [OnAction (Action "Connect") (always $ connectDevice pf d)]]
+       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, 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
+
+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})
+       where
+               ackFirst :: [MTaskTask] -> [MTaskTask]
+               ackFirst [] = []
+               ackFirst [t:ts] = if (t.ident == -1)
+                       [{t & ident=i}:ts] [t:ackFirst ts]
+
+deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
+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]}