updates

[mTask.git] / Devices / mTaskDevice.icl

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 972aa7b..58dd5ed 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -1,5 +1,6 @@
 implementation module Devices.mTaskDevice
 
 implementation module Devices.mTaskDevice
 

+from StdFunc import flip

 import Generics.gCons
 import mTaskInterpret
 import iTasks
 import Generics.gCons
 import mTaskInterpret
 import iTasks


@@ -12,6 +13,7 @@ import GenBimap
 import Devices.mTaskSerial
 import Devices.mTaskTCP
 import iTasks._Framework.Store
 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 $
 


@@ -19,15 +21,23 @@ derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
 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
 

+instance == MTaskDevice where
+       (==) a b = a.deviceChannels == b.deviceChannels
+

 channels :: MTaskDevice -> Shared Channels
 channels d = memoryShare d.deviceChannels ([], [], False)
 
 channels :: MTaskDevice -> Shared Channels
 channels d = memoryShare d.deviceChannels ([], [], False)
 

+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
                |deviceChannels=name +++ toString rand
                ,deviceName=name
                ,deviceTasks=[]
                ,deviceTask=Nothing
 makeDevice :: String MTaskResource -> Task MTaskDevice
 makeDevice name res = get randomInt @ \rand->{MTaskDevice
                |deviceChannels=name +++ toString rand
                ,deviceName=name
                ,deviceTasks=[]
                ,deviceTask=Nothing

+               ,deviceError=Nothing

                ,deviceData=res}
 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
                ,deviceData=res}
 
 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())


@@ -41,26 +51,32 @@ addDevice devices processFun
                Nothing = viewInformation "No type selected yet" [] ""
                Just ty = enterInformation "Name" [] -&&- deviceSettings ty
                        >>= \(name, settings)->makeDevice name settings
                Nothing = viewInformation "No type selected yet" [] ""
                Just ty = enterInformation "Name" [] -&&- deviceSettings ty
                        >>= \(name, settings)->makeDevice name settings

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

                        @! ""
        where
                        @! ""
        where

-               tlt dev = let ch = channels dev in processFun dev ch -||- getSynFun dev.deviceData ch
-

                deviceSettings "SerialDevice" = getmTaskSerialDevice
                deviceSettings "TCPDevice" = getmTaskTCPDevice
 
                deviceTypes :: [MTaskResource]
                deviceTypes = conses{|*|}
 
                deviceSettings "SerialDevice" = getmTaskSerialDevice
                deviceSettings "TCPDevice" = getmTaskTCPDevice
 
                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" @! ():
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
 manageDevices processFun ds = anyTask [
                addDevice deviceStore processFun <<@ Title "Add new device" @! ():

-                       [viewDevice d <<@ Title d.deviceName\\d<-ds]]
+                       [viewDevice processFun d 
+                               <<@ Title d.deviceName\\d<-ds]]

        <<@ ArrangeWithTabs @! ()
 
        <<@ ArrangeWithTabs @! ()
 

-viewDevice :: MTaskDevice -> Task ()
-viewDevice d = anyTask 
+viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
+viewDevice pf d = forever $ anyTask 

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


@@ -68,39 +84,46 @@ viewDevice d = anyTask
                        >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
                        @! ()
                ] <<@ ArrangeHorizontal
                        >>* [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)
 
        where
                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 

-sendToDevice :: (Map String (Main (ByteCode () Stmt))) String (MTaskDevice, Int) -> Task ()
-sendToDevice tmap mTask (device, timeout) =
-               get bcStateStore @ createBytecode
+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) =
+               get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)

        >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
        >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords

-       >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
+       >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare

        >>| makeShares sdss
        >>| sendMessage device msgs
        >>| makeShares sdss
        >>| sendMessage device msgs

-       >>| makeTask mTask -1
-       >>= \task->withDevices device (addTask timeout task)
+       >>| makeTask wta -1
+       >>= withDevices device o addTask

        @! ()
        where
        @! ()
        where

-               createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask tmap)) st

                sharename i = device.deviceChannels +++ "-" +++ toString i
                toSDSRecords st = [{MTaskShare |
                        initValue=toInt d1*265 + toInt d2,
                sharename i = device.deviceChannels +++ "-" +++ toString i
                toSDSRecords st = [{MTaskShare |
                        initValue=toInt d1*265 + toInt d2,

-                       withTask=mTask,
+                       withTask=wta,

                        identifier=i,
                        realShare="mTaskSDS-" +++ toString i}
                                \\(i,[d1,d2])<-st.sdss]
                makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 
                        identifier=i,
                        realShare="mTaskSDS-" +++ toString i}
                                \\(i,[d1,d2])<-st.sdss]
                makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 

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

 
 sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
 sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
 
 withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
 
 sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
 sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
 
 withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()

-withDevices a trans = upd (map withDevice) deviceStore @! ()
-       where withDevice b = if (a.deviceChannels == b.deviceChannels) (trans b) b
+withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()

 
 deviceTaskAcked :: MTaskDevice Int -> Task ()
 deviceTaskAcked dev i 
 
 deviceTaskAcked :: MTaskDevice Int -> Task ()
 deviceTaskAcked dev i