merge
authorMart Lubbers <mart@martlubbers.net>
Mon, 6 Mar 2017 18:48:38 +0000 (19:48 +0100)
committerMart Lubbers <mart@martlubbers.net>
Mon, 6 Mar 2017 18:48:38 +0000 (19:48 +0100)
1  2 
CleanSerial
Devices/mTaskDevice.dcl
Devices/mTaskDevice.icl

diff --combined CleanSerial
@@@ -1,1 -1,1 +1,1 @@@
- Subproject commit 8a5d42279e8067d9dee26d5fae466deea27c6805
 -Subproject commit bfa6a41e5ecfb2e11e9e389b6bb6720fda7f1ebb
++Subproject commit ef6413393c66231637cc89c252c28e866a46f14b
diff --combined Devices/mTaskDevice.dcl
@@@ -4,15 -4,18 +4,16 @@@ from Data.Maybe import :: Mayb
  import iTasks
  import Devices.mTaskSerial
  import Devices.mTaskTCP
+ import Utils.SDS
  import Tasks.mTaskTask
  import mTaskInterpret
  import Generics.gCons
  import iTasksTTY
  
 -derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
 +derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
  derive conses MTaskResource, TCPSettings
  derive consName MTaskResource, TCPSettings
  
 -
 -channels :: MTaskDevice -> Shared Channels
  :: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
  
  :: MTaskResource 
@@@ -21,6 -24,7 +22,7 @@@
  
  :: MTaskDevice = {
                 deviceTask :: Maybe TaskId
+               ,deviceError :: Maybe String
                ,deviceChannels :: String
                ,deviceName :: String
                ,deviceTasks :: [MTaskTask]
@@@ -32,9 -36,10 +34,11 @@@ instance == MTaskDevic
  class MTaskDuplex a where
        synFun :: a (Shared Channels) -> Task ()
  
+ startupDevices :: Task [MTaskDevice]
+ connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
  manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
  sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 +sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
  
  deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
  deviceTaskAcked :: MTaskDevice Int -> Task ()
diff --combined Devices/mTaskDevice.icl
@@@ -8,28 -8,36 +8,34 @@@ import iTasksTT
  import TTY
  import qualified Data.Map as DM
  import Utils.SDS
 +import Utils.Devices
  
  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 $
  
 -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
  
  instance == MTaskDevice where
        (==) a b = a.deviceChannels == b.deviceChannels
  
 -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
+               ,deviceError=Nothing
                ,deviceData=res}
  
  getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
@@@ -43,26 -51,32 +49,32 @@@ addDevice devices processFu
                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
-               tlt dev = let ch = channels dev in processFun dev ch -||- getSynFun dev.deviceData ch
                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" @! ():
-                       [viewDevice d <<@ Title d.deviceName\\d<-ds]]
+                       [viewDevice processFun d 
+                               <<@ Title d.deviceName\\d<-ds]]
        <<@ ArrangeWithTabs @! ()
  
- viewDevice :: MTaskDevice -> Task ()
- viewDevice d = forever $ anyTask 
+ viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
+ viewDevice pf d = forever $ anyTask 
                [viewInformation "Device settings" [] d @! ()
                ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
                ,forever $ 
@@@ -70,7 -84,9 +82,9 @@@
                        >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
                        @! ()
                ] <<@ ArrangeHorizontal
-               >>* [OnAction (Action "Delete Device") (always $ deleteDevice d)]
+               >>* [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)
  
@@@ -83,29 -99,28 +97,29 @@@ deleteDevice d = upd (\(r,s,ss)->(r,s,T
  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->set sdss sdsStore//MTaskShareaddToSDSShare
        >>| makeShares sdss
 -      >>| sendMessage device msgs
 +      >>| sendMessages msgs device
        >>| makeTask wta -1
        >>= withDevices device o addTask
        @! ()
        where
                sharename i = device.deviceChannels +++ "-" +++ toString i
                toSDSRecords st = [{MTaskShare |
 -                      initValue=toInt d1*265 + toInt d2,
 +                      initValue=toInt (sdsval!!0)*265 + toInt (sdsval!!1),
                        withTask=wta,
 -                      identifier=i,
 -                      realShare="mTaskSDS-" +++ toString i}
 -                              \\(i,[d1,d2])<-st.sdss]
 +                      identifier=sdsi,
 +                      //We skip the only/local shares
 +                      realShare="mTaskSDS-" +++ toString sdsi}
 +                              \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub]
                makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
  
                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) @! ()
 +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 @! ()
@@@ -120,7 -135,7 +134,7 @@@ deviceTaskAcked dev 
                        [{t & ident=i}:ts] [t:ackFirst ts]
  
  deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 -deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident]
 +deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
  
  deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
  deviceTaskDeleteAcked d i = withDevices d $ deleteTask