removed whileUnchanged for devices

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index bae443e..5fc0bfe 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -42,7 +42,7 @@ withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task [MTaskDevice]
 
 startupDevices :: Task [MTaskDevice]
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
-manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
+manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) -> Task ()
 
 sendMessages :: [MTaskMSGSend] MTaskDevice -> Task Channels
 sendMessagesIW :: [MTaskMSGSend] MTaskDevice *IWorld -> *(MaybeError TaskException (), *IWorld)

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index f4789cc..2a0f17e 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -53,15 +53,18 @@ getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
 getSynFun (SerialDevice t) = synFun t
 
-addDevice :: (Shared [MTaskDevice]) (MTaskDevice (Shared Channels) -> Task ()) -> Task String
-addDevice devices processFun
+addDevice :: (MTaskDevice (Shared Channels) -> Task ()) -> Task String
+addDevice 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
-                       >>= \dev->upd (\l->[dev:l]) devices
+                       >>= \dev->traceValue "make device done"
+                       >>| upd (\l->[dev:l]) deviceStoreNP
+                       >>| traceValue "update deviceslist"
                        >>| connectDevice processFun dev
+                       >>| traceValue "device connected"
                        @! ""
        where
                deviceSettings "SerialDevice" = getmTaskSerialDevice
@@ -80,7 +83,7 @@ addDevice devices processFun
 //             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
+       in traceValue "connectDevice" >>| appendTopLevelTask 'DM'.newMap True
                (       procFun device ch 
                -||- catchAll (getSynFun device.deviceData ch) errHdl)
                >>= \tid->withDevices device (\d->{d&deviceTask=Just tid,deviceError=Nothing})
@@ -88,12 +91,12 @@ connectDevice procFun device = let ch = channels device
        where
                errHdl e = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! ()
 
-manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
-manageDevices processFun ds = anyTask [
-               addDevice deviceStoreNP processFun <<@ Title "Add new device" @! ():
-                       [viewDevice processFun d 
-                               <<@ Title d.deviceName\\d<-ds]]
-       <<@ ArrangeWithTabs @! ()
+manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) -> Task ()
+manageDevices processFun = get deviceStoreNP >>= \ds->anyTask [
+               addDevice 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 

diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl
index 9d810ef..48dc193 100644 (file)
--- a/Devices/mTaskTCP.icl
+++ b/Devices/mTaskTCP.icl
@@ -18,19 +18,25 @@ getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" []
 
 instance MTaskDuplex TCPSettings where
        synFun :: TCPSettings (Shared Channels) -> Task ()
-       synFun s channels =
-               tcpconnect s.host s.port channels {ConnectionHandlers|
+       synFun s channels
+       | not (trace_tn "synFun started") = undef
+       = tcpconnect s.host s.port channels {ConnectionHandlers|
                                onConnect=onConnect,
                                onData=onData,
                                onShareChange=onShareChange,
-                               onDisconnect=onDisconnect} @! ()
+                               onDisconnect=onDisconnect} >>= \_->viewInformation "done" [] "done" @! ()
                where
                        onConnect :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
-                       onConnect acc (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
+                       onConnect acc (msgs,send,sendStopped)
+                       | not (trace_tn "onConnect") = undef
+                       = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
 
                        onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
-                       onData newdata acc (msgs,send,True) = (Ok acc, Nothing, [], True)
+                       onData newdata acc (msgs,send,True)
+                       | not (trace_tn "onData: stop") = undef
+                       = (Ok acc, Nothing, [], True)
                        onData newdata acc (msgs,send,sendStopped)
+                       | not (trace_tn "onData: notstop") = undef
                        # split = indexOf "\n" newdata
                        | split == -1 = (Ok acc, Just (msgs, send, True), [], False)
                        # newMsg = decode (newdata % (0, split-1))
@@ -40,11 +46,19 @@ instance MTaskDuplex TCPSettings where
                        
                        onShareChange :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
                        // Stop!
-                        0onShareChange acc (msgs,send,True) = (Ok acc, Nothing, [], True)
+                       onShareChange acc (msgs,send,True)
+                       | not (trace_tn "onSC: stop") = undef
+                       = (Ok acc, Nothing, [], True)
                        // Nothing to send
-                       onShareChange acc (msgs,[], _) = (Ok acc, Nothing, [], False)
+                       onShareChange acc (msgs,[], _)
+                       | not (trace_tn "onSC: nothing") = undef
+                       = (Ok acc, Nothing, [], False)
                        // Something to send
-                       onShareChange acc (msgs,send, ss) = (Ok acc, Just (msgs,[],ss), map encode send, False)
+                       onShareChange acc (msgs,send, ss)
+                       | not (trace_tn "onSC: send") = undef
+                       = (Ok acc, Just (msgs,[],ss), map encode send, False)
 
                        onDisconnect :: String ChD -> (MaybeErrorString String, Maybe ChD)
-                       onDisconnect _ (msgs,send,_) = (Ok "", Just ([], [], True))
+                       onDisconnect _ (msgs,send,_)
+                       | not (trace_tn "ondisconnect") = undef
+                       = (Ok "", Just ([], [], True))

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 43350e1..fda2a39 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -13,10 +13,10 @@ from StdFunc import flip
 derive class iTask MTaskShare
 
 manageShares :: Task [MTaskDevice]
-manageShares = whileUnchanged deviceStoreNP
-       $ \devs->case devs of
-               [] = viewInformation "No devices yet" [] []
-               _ = allTasks (map manageSharesOnDevice devs)
+manageShares = viewInformation "" [] []//whileUnchanged deviceStoreNP
+//     $ \devs->case devs of
+//             [] = viewInformation "No devices yet" [] []
+//             _ = allTasks (map manageSharesOnDevice devs)
 
 manageSharesOnDevice :: MTaskDevice -> Task MTaskDevice
 manageSharesOnDevice dev = (case dev.deviceShares of
@@ -97,6 +97,28 @@ getRealShare dev share = sdsFocus ()
        $ sdsFocus (Just (dev, share.identifier))
        $ deviceStore
 
+//getRealShare :: MTaskDevice MTaskShare -> Shared BCValue
+//getRealShare dev share = sdsLens
+//     ("realShare" +++ toString share.identifier)
+//     (const $ Just (dev, share.identifier))
+//     (SDSRead $ const $ \rs->case find ((==)dev) rs of
+//             Nothing = Error $ exception "Device doesn't exist anymore"
+//             Just {deviceShares} = case find ((==)share) deviceShares of
+//                     Nothing = Error $ exception "Share doesn't exist anymore"
+//                     Just share = Ok share.MTaskShare.value
+//     )
+//     (SDSWrite $ const $ \rs w->partition ((==)dev) devs of
+//             ([], _) = Error $ exception "Device doesn't exist anymore"
+//             ([_,_:_], _) = Error $ exception "Multiple matching devices"
+//             ([d=:{deviceShares}], devs) = case partition ((==)share) deviceShares of
+//                     ([], _) = Error $ exception "Share doesn't exist anymore"
+//                     ([_,_:_], _) = Error $ exception "Multiple matching shares"
+//                     ([s], shares)
+//                             # s = {MTaskShare | s & value=val}
+//                             # d = {MTaskDevice | d & deviceShares=[s:shares]}
+//                             = Ok $ Just [d:devs])
+//     (SDSNotify $ const $ \rs w
+
 deviceLens dev share = (mread, mwrite)
 where
        mread :: [MTaskDevice] -> MaybeError TaskException BCValue

diff --git a/Utils/SDS.dcl b/Utils/SDS.dcl
index b6a2ede..a9f1a6c 100644 (file)
--- a/Utils/SDS.dcl
+++ b/Utils/SDS.dcl
@@ -8,5 +8,4 @@ memoryShare :: String a -> Shared a | iTask a
 
 deviceStoreNP :: Shared [MTaskDevice]
 deviceStore :: RWShared (Maybe (MTaskDevice, Int)) [MTaskDevice] [MTaskDevice]
-bcStateStore :: Shared BCState
 mTaskTaskStore :: Shared [String]

diff --git a/Utils/SDS.icl b/Utils/SDS.icl
index 9975d27..afd1c6c 100644 (file)
--- a/Utils/SDS.icl
+++ b/Utils/SDS.icl
@@ -18,6 +18,10 @@ memoryShare s d = sdsFocus s $ memoryStore s $ Just d
 deviceStoreNP :: Shared [MTaskDevice]
 deviceStoreNP = sdsFocus Nothing $ deviceStore
 
+import GenPrint, TTY
+derive gPrint MTaskDevice, Maybe, MTaskShare, MTaskResource, TaskId, MTaskTask, (,), TTYSettings, TCPSettings, DateTime, Parity, BaudRate, ByteSize, MaybeError, ()
+gPrint{|Dynamic|} _ st = gPrint{|*|} "**Dynamic**" st
+
 deviceStore :: RWShared (Maybe (MTaskDevice, Int)) [MTaskDevice] [MTaskDevice]
 deviceStore = SDSSource {SDSSource 
        | name = "deviceStore"
@@ -25,11 +29,17 @@ deviceStore = SDSSource {SDSSource
        , write= realWrite
        }
 where
+       realRead p iw
+       | not (trace_tn $ "read called with: " +++ printToString p) = undef
+       = read realDeviceStore iw
+
        realWrite mi w iw
+       | not (trace_tn $ "write called with: " +++ printToString mi +++ " w " +++ printToString w) = undef
        # (merr, iw) = write w realDeviceStore iw
-       | isError merr || isNothing mi = (merr $> const True, iw)
+       | not (trace_tn $ "written to real store: " +++ printToString merr) = undef
+       | isError merr || isNothing mi = (merr $> notifyPred mi, iw)
        # (Just (dev, ident)) = mi
-       | ident == -1 = (merr $> const True, iw)
+       | ident == -1 = (merr $> notifyPred mi, iw)
        = case find ((==)dev) w of
                Nothing = (Error $ exception "Device doesn't exist anymore", iw)
                Just {deviceShares} = case find (\d->d.identifier == ident) deviceShares of
@@ -38,14 +48,22 @@ where
                        | not $ trace_tn "Really sending a message from a share update" = undef
                        = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
                                (Error e, iw) = (Error e, iw)
-                               (Ok _, iw) = (Ok $ lens mi, iw)
+                               (Ok _, iw) = (Ok $ notifyPred mi, iw)
 
-       lens Nothing (Just p) = False
-       lens Nothing Nothing = True
-       lens (Just (d1, i1)) (Just (d2, i2)) = d1 == d2 && (i2 == -1 || i1 == i2)
+       notifyPred :: (Maybe (MTaskDevice, Int)) (Maybe (MTaskDevice, Int)) -> Bool
+       // Global watcher looking at a global event
+       notifyPred Nothing Nothing = True
+       // Global watcher looking at a local event
+       notifyPred Nothing (Just _) = False
+       // Local watcher looking at a global event
+       notifyPred (Just _) Nothing = False
+       // Local device watcher looking at a local event
+       notifyPred (Just (d1, -1)) (Just (d2, _)) = d1 == d2
+       // Local share watcher looking at a local share event
+       notifyPred (Just (d1, i1)) (Just (d2, i2)) = d1 == d2 && i1 == i2
 
 realDeviceStore :: Shared [MTaskDevice]
-realDeviceStore = sharedStore "mTaskDevices" []
+realDeviceStore = memoryShare "mTaskDevices" []
 
 bcStateStore :: Shared BCState
 bcStateStore = memoryShare "mTaskBCState" zero

diff --git a/miTask.icl b/miTask.icl
index 918b414..233e072 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -56,8 +56,7 @@ demo = viewSharedInformation "Devices" [] deviceStoreNP
 mTaskManager :: Task ()
 mTaskManager = (>>|) startupDevices $ 
                viewmTasks ||-
-               ((manageShares ||- whileUnchanged deviceStoreNP (manageDevices process))
-                       <<@ ArrangeSplit Vertical True)
+               ((manageShares ||- forever (manageDevices process)) <<@ ArrangeSplit Vertical True)
                <<@ ArrangeWithSideBar 0 LeftSide 260 True
        where
                viewmTasks :: Task String