add task deletion and acknowledgements

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index 457a1a6..f21e654 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -31,10 +31,9 @@ channels :: MTaskDevice -> Shared Channels
 class MTaskDuplex a where
        synFun :: a (Shared Channels) -> Task ()
 
-//makeDevice :: MTaskResource String -> Task MTaskDevice
+manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
+sendToDevice :: (Map String (Main (ByteCode () Stmt))) String (MTaskDevice, Int) -> Task ()
 
-addDevice :: (Shared [MTaskDevice]) -> Task String
-//addDevice :: (Shared [MTaskDevice]) -> Task MTaskResource
-//addDevice :: (Shared [MTaskDevice]) -> Task ()
-
-viewDevices :: [MTaskDevice] -> Task ()
+deviceTaskDelete :: MTaskDevice Int -> Task ()
+deviceTaskAcked :: MTaskDevice Int -> Task ()
+deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index b059b10..53b3944 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -34,31 +34,84 @@ 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
-                       >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch=channels dev in getSynFun dev.deviceData ch)
+                       >>= \dev->appendTopLevelTask 'DM'.newMap True (tlt dev)
                        >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
                        @! ""
        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{|*|}
 
-viewDevices :: [MTaskDevice] -> Task ()
-viewDevices ds = anyTask [
-               addDevice deviceStore <<@ 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]]
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: MTaskDevice -> Task ()
-viewDevice d = (viewInformation "Device settings" [] d 
-               ||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
-               ) <<@ ArrangeHorizontal
+viewDevice d = anyTask 
+               [viewInformation "Device settings" [] d @! ()
+               ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
+               ,forever $ 
+                       enterChoice "Delete task on device" [ChooseFromList fst] d.deviceTasks
+                       >>* [OnAction (Action "Delete") $ ifValue (\(_,i)->i <> -1) (deviceTaskDelete d o snd)]
+                       @! ()
+               ] <<@ ArrangeHorizontal
        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
+       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
+       >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
+       >>| makeShares sdss
+       >>| sendMessage device msgs
+       >>| withDevices device (addTask timeout)
+       @! ()
+       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,
+                       withTask=mTask,
+                       identifier=i,
+                       realShare="mTaskSDS-" +++ toString i}
+                               \\(i,[d1,d2])<-st.sdss]
+               makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+
+               addTask :: Int MTaskDevice -> MTaskDevice
+               addTask timeout device = {device & deviceTasks=[(mTask, -1):device.deviceTasks]}
+
+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
+
+deviceTaskAcked :: MTaskDevice Int -> Task ()
+deviceTaskAcked dev i 
+       = withDevices dev (\d->{d&deviceTasks=ackFirst i d.deviceTasks})
+       where
+               ackFirst :: Int [(String, Int)] -> [(String, Int)]
+               ackFirst _ [] = []
+               ackFirst a [(s,i):ts] = if (i == -1)  [(s,a):ts] [(s,i):ackFirst a ts]
+
+deviceTaskDelete :: MTaskDevice Int -> Task ()
+deviceTaskDelete dev tid = sendMessage dev [MTTaskDel tid]
+
+deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
+deviceTaskDeleteAcked d i = withDevices d $ deleteTask
+       where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> snd s]}

diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl
index bf05e05..e0b85e2 100644 (file)
--- a/Devices/mTaskTCP.icl
+++ b/Devices/mTaskTCP.icl
@@ -1,9 +1,12 @@
 implementation module Devices.mTaskTCP
 
+import GenPrint
+import StdDebug
 import Devices.mTaskDevice
 import iTasks
 
 derive class iTask TCPSettings
+derive gPrint MTaskMSGRecv
 
 getmTaskTCPDevice :: Task MTaskResource
 getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" []
@@ -21,8 +24,9 @@ instance MTaskDuplex TCPSettings where
                        onConnect _ (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
 
                        whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
-                       whileConnected Nothing acc (msgs,send,sendStopped) = (Ok acc, Nothing, [], False)
-                       whileConnected (Just newData) acc (msgs,send,sendStopped) = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+                       whileConnected mnewData acc (msgs,send,sendStopped)
+                       | not (trace_tn (printToString (map decode (maybeToList mnewData)))) = undef
+                       = (Ok acc, Just (msgs ++ map decode (maybeToList mnewData),[],sendStopped), map encode send, False)
                        
                        onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
                        onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)

diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl
index e3fdd42..0f476d5 100644 (file)
--- a/Shares/mTaskShare.dcl
+++ b/Shares/mTaskShare.dcl
@@ -1,8 +1,12 @@
 definition module Shares.mTaskShare
 
+import iTasks
+
 :: MTaskShare = {
                initValue :: Int,
                withTask :: String,
                identifier :: Int,
                realShare :: String
        }
+
+viewShares :: [MTaskShare] -> Task ()

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index ad2e341..836b504 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -1,2 +1,11 @@
 implementation module Shares.mTaskShare
 
+import Utils.SDS
+import iTasks
+
+viewShares :: [MTaskShare] -> Task ()
+viewShares st = anyTask (map viewer st)
+
+viewer :: MTaskShare -> Task ()
+viewer m = viewSharedInformation "" [] (getSDSStore m)
+       <<@ Title ("SDS: " +++ toString m.identifier) @! ()

diff --git a/Utils/SDS.dcl b/Utils/SDS.dcl
index 88f1200..7020451 100644 (file)
--- a/Utils/SDS.dcl
+++ b/Utils/SDS.dcl
@@ -4,7 +4,7 @@ import Shares.mTaskShare
 import Devices.mTaskDevice
 import iTasks
 
-derive class iTask MTaskShare
+derive class iTask MTaskShare, BCState
 
 memoryShare :: String a -> Shared a | iTask a
 
@@ -12,3 +12,6 @@ deviceStore :: Shared [MTaskDevice]
 sdsStore :: Shared [MTaskShare]
 bcStateStore :: Shared BCState
 mTaskTaskStore :: Shared [String]
+
+getSDSStore :: MTaskShare -> Shared Int
+getSDSRecord :: Int -> Task MTaskShare

diff --git a/Utils/SDS.icl b/Utils/SDS.icl
index f1184a8..cd684ae 100644 (file)
--- a/Utils/SDS.icl
+++ b/Utils/SDS.icl
@@ -22,3 +22,9 @@ bcStateStore = memoryShare "mTaskBCState" zero
 
 mTaskTaskStore :: Shared [String]
 mTaskTaskStore = memoryShare "mTaskTasks" ["count", "ledon", "ledoff"]
+
+getSDSStore :: MTaskShare -> Shared Int
+getSDSStore sh = memoryShare sh.realShare 0
+
+getSDSRecord :: Int -> Task MTaskShare
+getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]

diff --git a/client/task.c b/client/task.c
index 9ef5403..1dd8ffb 100644 (file)
--- a/client/task.c
+++ b/client/task.c
@@ -55,7 +55,7 @@ void task_register(void)
 
 void task_delete(void)
 {
-       uint8_t c = read_byte();
+       uint8_t c = read16();
        tasks[c].used = false;
        write_byte('d');
        write16(c);

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 8c8e422..221c8a4 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -16,6 +16,7 @@ import mTask
 
 :: MTaskMSGSend
        = MTTask Int String
+       | MTTaskDel Int
        | MTSds Int String
        | MTUpd Int String
 

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 4876e93..2c44484 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -26,6 +26,7 @@ import Text.Encodings.Base64
 
 encode :: MTaskMSGSend -> String
 encode (MTTask to data) = "t" +++ to16bit to +++ to16bit (size data) +++ data +++ "\n"
+encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"
 encode (MTSds i v) = "s" +++ to16bit i +++ v +++ "\n"
 encode (MTUpd i v) = "u" +++ to16bit i +++ v +++ "\n"
 
@@ -50,6 +51,7 @@ instance toString MTaskMSGSend where
                +++ " value " +++ safePrint v
        toString (MTTask to data) = "Task timeout: " +++ toString to
                +++ " data " +++ safePrint data
+       toString (MTTaskDel i) = "Task delete request: " +++ toString i
        toString (MTUpd i v) = "Update id: " +++ toString i
                +++ " value " +++ safePrint v
 

diff --git a/miTask.icl b/miTask.icl
index 47778b2..4bef600 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -55,14 +55,11 @@ bc2 d = {main = ledOn d}
 bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 
-:: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [String]}
-derive class iTask MTaskDeviceStatus, BCState
-
 mTaskManager :: Task ()
 mTaskManager = anyTask 
                [ viewmTasks @! ()
                , whileUnchanged sdsStore viewShares
-               , whileUnchanged deviceStore viewDevices
+               , whileUnchanged deviceStore $ manageDevices process
                ] <<@ ApplyLayout layout
        where
                layout = sequenceLayouts
@@ -84,113 +81,26 @@ mTaskManager = anyTask
                                sendmTask mTaskId ds = 
                                                (enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
                                                -&&- enterInformation "Timeout, 0 for one-shot" [])
-                                       >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]
-
-                               sendToDevice :: String (MTaskDevice, Int) -> Task ()
-                               sendToDevice mTask (device, timeout) =
-                                               get bcStateStore @ createBytecode
-                                       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
-                                       >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
-                                       >>| makeShares sdss
-                                       >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device)
-                                       @! ()
-                                       where
-                                               createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st
-                                               sharename i = device.deviceChannels +++ "-" +++ toString i
-                                               toSDSRecords st = [{MTaskShare |
-                                                       initValue=toInt d1*265 + toInt d2,
-                                                       withTask=mTask,
-                                                       identifier=i,
-                                                       realShare="mTaskSDS-" +++ toString i}
-                                                               \\(i,[d1,d2])<-st.sdss]
-                                               makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
-
-               getSDSStore :: MTaskShare -> Shared Int
-               getSDSStore sh = memoryShare sh.realShare 0
-
-               getSDSRecord :: Int -> Task MTaskShare
-               getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]
-
-               viewShares :: [MTaskShare] -> Task ()
-               viewShares st = anyTask $ map viewer st
-                       where
-                               viewer :: MTaskShare -> Task ()
-                               viewer m = viewSharedInformation "" [] (getSDSStore m)
-                                       <<@ Title ("SDS: " +++ toString m.identifier) @! ()
-//                             enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore
-//                     >>* [OnValue $ withValue $ Just o updateShare]
-//                     >>* [OnAction (Action "Back") (const $ Just $ treturn ())]
-//                     where
-//                             sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
-//                             updateShare s = viewInformation "" [] ()
-//                             updateShare (k, v) = (viewInformation "Key" [] k
-//                                     ||- updateInformation "Value" [] v)
-                                       
-
-//             addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
-//             addDevice devices = enterInformation "Device type" []
-//                     >&^ \sh->whileUnchanged sh $ \mty->case mty of
-//                             Nothing = viewInformation "No type selected yet" [] "" @! ()
-//                             Just ty = case ty of
-//                                     TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
-//                                             >>= \(name, (host, port))->cont name (syncNetworkChannel host port)
-//                                     SerialDevice = (enterInformation "Name" [] -&&- enterTTYSettings)
-//                                             >>= \(name, set)->cont name (syncSerialChannel set encode decode)
-//                     where
-//                             cont :: String ((Shared Channels) -> Task ()) -> Task ()
-//                             cont name synfun = get randomInt 
-//                                     @ (\randint->{deviceChannels=name +++ toString randint, deviceName=name, deviceTasks=[], deviceTask=Nothing})
-//                                     >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
-//                                     >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
-//                                     @! ()
-
-               process :: (Shared Channels) -> Task ()
-               process ch = forever (watch ch >>* [OnValue (
+                                       >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskMap mTaskId)]
+
+               process :: MTaskDevice (Shared Channels) -> Task ()
+               process device ch = forever (watch ch >>* [OnValue (
                                ifValue (not o isEmpty o fst3)
-                               (\t->upd (appFst3 (const [])) ch >>| process (fst3 t)))])
-                       where
-                               process :: [MTaskMSGRecv] -> Task ()
-                               process [] = treturn ()
-                               process [m:ms] = (case m of
-                                       MTTaskAck i = traceValue (toString m) @! ()
-                                       MTTaskDelAck i = traceValue (toString m) @! ()
-                                       MTSDSAck i = traceValue (toString m) @! ()
-                                       MTSDSDelAck i = traceValue (toString m) @! ()
+                               (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
+                       where
+                               proc :: [MTaskMSGRecv] -> Task ()
+                               proc [] = treturn ()
+                               proc [m:ms] = (case m of
+//                                     MTSDSAck i = traceValue (toString m) @! ()
+//                                     MTSDSDelAck i = traceValue (toString m) @! ()
                                        MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
-                                       MTMessage val = traceValue (toString m) @! ()
+                                       MTTaskAck i = deviceTaskAcked device i
+                                       MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
                                        MTEmpty = treturn ()
-                                       ) >>| process ms
-
-               deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
-               deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
-                       connected = if (isNothing d.deviceTask) False True,
-                       tasks = [s +++ toString i\\(s, i)<-d.deviceTasks]}\\d<-ds]
+                                       _ = traceValue (toString m) @! ()
+                                       ) >>| proc ms
 
                mapPar :: (a -> Task a) [a] -> Task ()
                mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
                allAtOnce t = foldr1 (||-) t @! ()
                //allAtOnce = (flip (@!) ()) o foldr1 (||-)
-
-sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
-sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()
-
-syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
-syncNetworkChannel server port channel = catchAll
-               (tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ())
-               (\v->traceValue v @! ())
-       where
-               onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
-               onConnect _ (msgs,send,sendStopped)
-                       = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
-
-               whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
-               
-               //whileConnected Nothing acc (msgs,send,sendStopped)
-               //= (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
-               whileConnected mnewData acc (msgs,send,sendStopped)
-               = (Ok acc, Just (msgs ++ map decode (maybeToList mnewData),[],sendStopped), map encode send, False)
-               //| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
-//             = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
-               
-               onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
-               onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)