add device shares

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index 5fc0bfe..ce4a047 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -37,9 +37,6 @@ instance == MTaskDevice
 class MTaskDuplex a where
        synFun :: a (Shared Channels) -> Task ()
 
-withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task [MTaskDevice]
-//withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
-
 startupDevices :: Task [MTaskDevice]
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) -> Task ()
@@ -49,6 +46,8 @@ sendMessagesIW :: [MTaskMSGSend] MTaskDevice *IWorld -> *(MaybeError TaskExcepti
 
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
-deviceTaskAcked :: MTaskDevice Int Int -> Task [MTaskDevice]
-deviceTaskDeleteAcked :: MTaskDevice Int -> Task [MTaskDevice]
-deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task [MTaskDevice]
+deviceTaskAcked :: MTaskDevice Int Int -> Task MTaskDevice
+deviceTaskDeleteAcked :: MTaskDevice Int -> Task MTaskDevice
+deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task MTaskDevice
+
+deviceShare :: MTaskDevice -> Shared MTaskDevice

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index a91a0b3..193c4d7 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -15,6 +15,7 @@ import GenBimap
 import Devices.mTaskSerial
 import Devices.mTaskTCP
 import Data.Tuple
+import Data.List
 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
 
@@ -86,23 +87,23 @@ connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task
 connectDevice procFun device = let ch = channels device
        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})
+               >>= \tid->upd (\d->{d&deviceTask=Just tid,deviceError=Nothing}) (deviceShare device)
                >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch
        where
                errHdl e
                | not (trace_tn "error") = undef
-               = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! ()
+               = upd (\d->{d & deviceTask=Nothing, deviceError=Just e}) (deviceShare device) @! ()
 
 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]]
+manageDevices processFun = whileUnchanged 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 
-               [viewInformation "Device settings" [] d @! ()
+               [viewInformation "Device settings" [ViewAs noShares] d @! ()
                /*,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()*/
                ,forever $ 
                        enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
@@ -113,6 +114,7 @@ viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask
                                if (isJust d.deviceTask) []
                                [OnAction (Action "Connect") (always $ connectDevice pf d @! ())]]
        where
+               noShares d = {d & deviceShares=[], deviceTasks=[]}
                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
 deleteDevice :: MTaskDevice -> Task ()
@@ -134,14 +136,12 @@ sendMessagesIW msgs dev iworld
 realMessageSend :: [MTaskMSGSend] Channels -> Channels
 realMessageSend msgs (r,s,ss) = (r,msgs++s,ss)
 
-withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task [MTaskDevice]
-withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStoreNP
-
-deviceTaskAcked :: MTaskDevice Int Int -> Task [MTaskDevice]
+deviceTaskAcked :: MTaskDevice Int Int -> Task MTaskDevice
 deviceTaskAcked dev i mem
-       = withDevices dev (\d->{d
-                       &deviceTasks=ackFirst d.deviceTasks
-                       ,deviceSpec=Just {fromJust d.deviceSpec & bytesMemory=mem}})
+       = upd (\d->{d
+                       & deviceTasks=ackFirst d.deviceTasks
+                       , deviceSpec=Just {fromJust d.deviceSpec & bytesMemory=mem}})
+               $ deviceShare dev
        where
                ackFirst :: [MTaskTask] -> [MTaskTask]
                ackFirst [] = []
@@ -151,10 +151,18 @@ deviceTaskAcked dev i mem
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 
-deviceTaskDeleteAcked :: MTaskDevice Int -> Task [MTaskDevice]
+deviceTaskDeleteAcked :: MTaskDevice Int -> Task MTaskDevice
 deviceTaskDeleteAcked d i = cleanSharesTask i d
-       >>| withDevices d deleteTask
+       >>| upd deleteTask (deviceShare d)
        where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}
 
-deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task [MTaskDevice]
-deviceAddSpec d s = withDevices d $ \r->{MTaskDevice | r & deviceSpec=Just s}
+deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task MTaskDevice
+deviceAddSpec d s = upd (\r->{MTaskDevice | r & deviceSpec=Just s}) $ deviceShare d
+
+deviceShare :: MTaskDevice -> Shared MTaskDevice
+deviceShare d = mapReadWriteError 
+       ( \ds->mb2error (exception "Device lost") $ find ((==)d) ds
+       , \w ds->case splitWith ((==)d) ds of
+               ([], _) = Error $ exception "Device lost"
+               ([_], ds) = Ok $ Just [w:ds]
+       ) $ sdsFocus (Just (d, -1)) deviceStore

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index e8ed9a2..a9ebf56 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -6,7 +6,9 @@ import Utils.Devices
 import iTasks
 import mTask
 import Data.List
+import Data.Error
 import Data.Tuple
+from Control.Monad import `b`
 from Data.Func import $
 from StdFunc import flip
 
@@ -123,11 +125,9 @@ getRealShare dev share = sdsFocus ()
 deviceLens dev share = (mread, mwrite)
 where
        mread :: [MTaskDevice] -> MaybeError TaskException BCValue
-       mread devs = case find ((==)dev) devs 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
+       mread devs = mb2error (exception "Device lost") (find ((==)dev) devs)
+               `b` \d->mb2error (exception "Share lost") (find ((==)share) d.deviceShares)
+               `b` \s->Ok s.MTaskShare.value
        
        mwrite :: BCValue [MTaskDevice] -> MaybeError TaskException (Maybe [MTaskDevice])
        mwrite val devs = case partition ((==)dev) devs of

diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index f5976d3..ec14976 100644 (file)
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -13,4 +13,6 @@ derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCS
        }
 
 makeTask :: String Int -> Task MTaskTask
-sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task MTaskTask
+
+liftmTask :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()

diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index e828257..d586f4f 100644 (file)
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -3,6 +3,8 @@ implementation module Tasks.mTaskTask
 import mTask
 import iTasks
 import Devices.mTaskDevice
+import Data.List
+from Data.Func import $
 
 import iTasks._Framework.Serialization
 
@@ -14,23 +16,27 @@ makeTask name ident = get currentDateTime
 
 import StdDebug
 import StdMisc
-sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task MTaskTask
 sendTaskToDevice wta mTask (device, timeout)
-| not (trace_tn "compiling task") = undef
 # (msgs, newState=:{sdss}) = toMessages timeout mTask device.deviceState
-| not (trace_tn "Done compiling task") = undef
 # shares = [makeShare wta "" sdsi sdsval\\{sdsi,sdsval}<-sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`]
 = updateShares device ((++) shares)
        >>| sendMessages msgs device
        >>| makeTask wta -1
-       >>= withDevices device o addTaskUpState newState
+       >>= \t->upd (addTaskUpState newState t) (deviceShare device) 
+       >>| wait "Waiting for task to be acked" (taskAcked t) (deviceShare device)
+       >>| treturn t
        where
                addTaskUpState :: BCState MTaskTask MTaskDevice -> MTaskDevice
                addTaskUpState st task device = { MTaskDevice | device &
                        deviceState=st, deviceTasks=[task:device.deviceTasks]}
+               taskAcked t d = maybe True (\t->t.ident <> -1) $ find (eq t) d.deviceTasks
+               eq t1 t2 = t1.dateAdded == t2.dateAdded &&
+                       t1.MTaskTask.name == t2.MTaskTask.name
 
-//liftmTask :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task a
-//liftmTask wta mTask (device, timeout)
-//     = sendTaskToDevice wta mTask (device, timeout)
-//     >>| wait "waiting for task to return" $ sdsFocus
-//     >>| treturn 
+liftmTask :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
+liftmTask wta mTask c=:(dev, _)= sendTaskToDevice wta mTask c
+       >>= \t->wait "Waiting for mTask to return" (taskRemoved t) (deviceShare dev)
+       >>| viewInformation "Done!" [] ()
+where
+       taskRemoved t d = isNothing $ find (\t1->t1.ident==t.ident) d.deviceTasks

diff --git a/miTask.icl b/miTask.icl
index 85196eb..c0ee6f2 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -70,6 +70,7 @@ mTaskManager = (>>|) startupDevices $
                                        >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] d
                                                -&&- enterInformation "Timeout" []
                                        ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice task bc)]
+                                       >>| treturn []
                                ]
 
                process :: MTaskDevice (Shared Channels) -> Task ()