Merge branch 'master' of gitlab.science:mlubbers/mTask

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 36623bd..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,12 +87,12 @@ 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 = whileUnchanged deviceStoreNP $ \ds->anyTask [
@@ -102,8 +103,8 @@ manageDevices processFun = whileUnchanged deviceStoreNP $ \ds->anyTask [
 
 viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask 
-               [viewInformation "Device settings" [] d @! ()
-               ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
+               [viewInformation "Device settings" [ViewAs noShares] d @! ()
+               /*,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()*/
                ,forever $ 
                        enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
                        >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
@@ -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 d3dea6b..2133f0b 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/client/client.c b/client/client.c
index 28c1609..da74940 100644 (file)
--- a/client/client.c
+++ b/client/client.c
@@ -67,6 +67,7 @@ void read_message(void)
        debug("Shutdown received");
        mem_reset();
        reset();
+       break;
       case '\0':
         debug("Server closed connection");
         break;

diff --git a/client/interface.h b/client/interface.h
index 24e5c37..e6b14db 100644 (file)
--- a/client/interface.h
+++ b/client/interface.h
@@ -10,43 +10,35 @@ extern "C" {
 #include <stdarg.h>
 
 #ifdef LINUX
-#define NAPINS 128
-#define NDPINS 128
+#define APINS 128
+#define DPINS 128
 #define STACKSIZE 1024
 #define MEMSIZE 1024
 #define HAVELED 1
-#define HAVEAIO 1
-#define HAVEDIO 1
 
 extern int gargc;
 extern char **gargv;
 
 #elif defined STM
-#define NAPINS 128
-#define NDPINS 128
+#define APINS 128
+#define DPINS 128
 #define STACKSIZE 1024
 #define MEMSIZE 1024
 #define HAVELED 1
-#define HAVEAIO 1
-#define HAVEDIO 1
 
 #elif defined ARDUINO_ESP8266_NODEMCU
-#define NAPINS 128
-#define NDPINS 128
+#define APINS 128
+#define DPINS 128
 #define STACKSIZE 1024
 #define MEMSIZE 1024
 #define HAVELED 0
-#define HAVEAIO 0
-#define HAVEDIO 0
 
 #elif defined ARDUINO_AVR_UNO
-#define NAPINS 128
-#define NDPINS 128
+#define APINS 128
+#define DPINS 128
 #define STACKSIZE 64
 #define MEMSIZE 256
 #define HAVELED 0
-#define HAVEAIO 0
-#define HAVEDIO 0
 #else
 //Add you device here
 #endif
@@ -61,11 +53,11 @@ uint8_t read_byte(void);
 void write_byte(uint8_t b);
 
 /* Analog and digital pins */
-#if HAVEDIO == 1
+#if DPINS > 0
 void write_dpin(uint8_t i, bool b);
 bool read_dpin(uint8_t i);
 #endif
-#if HAVEAIO == 1
+#if APINS > 0
 void write_apin(uint8_t i, uint8_t a);
 uint8_t read_apin(uint8_t i);
 #endif

diff --git a/client/spec.c b/client/spec.c
index 38c58ef..52ed512 100644 (file)
--- a/client/spec.c
+++ b/client/spec.c
@@ -5,11 +5,11 @@
 void spec_send(void)
 {
        write_byte('c');
-       write_byte(0 | (HAVELED << 0) | (HAVEAIO << 1) | (HAVEDIO << 2));
+       write_byte(0 | (HAVELED << 0) );//| (HAVEAIO << 1) | (HAVEDIO << 2));
        write16(MEMSIZE);
        write16(STACKSIZE);
-       write_byte(NAPINS);
-       write_byte(NDPINS);
+       write_byte(APINS);
+       write_byte(DPINS);
        write_byte('\n');
        write_byte('\n');
 }

diff --git a/install_clean.sh b/install_clean.sh
index f7fe903..bcedd34 100755 (executable)
--- a/install_clean.sh
+++ b/install_clean.sh
@@ -16,6 +16,6 @@ mkdir -p "$TARGET"
 
 echo "Downloading and installing clean nightly" >&2
 curl -sSL ftp://ftp.cs.ru.nl/pub/Clean/builds/linux-x64/clean-bundle-complete-linux-x64-latest.tgz \
-       | tar --gunzip --strip-components=1 --extract --directory="$TARGET"
+       | tar --verbose --gunzip --strip-components=1 --extract --directory="$TARGET"
 
 echo "export CLEAN_HOME=$TARGET; export PATH=$TARGET/bin:\$PATH;"

diff --git a/miTask.icl b/miTask.icl
index 8c17f09..c0ee6f2 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -31,7 +31,8 @@ Start world = startEngine [
        ] world
 
 demo :: Task ()
-demo = viewSharedInformation "Devices" [] deviceStoreNP
+demo = set 5 (sharedDynamicStore "Hoi" 5)
+       >>| viewSharedInformation "Devices" [] deviceStoreNP
        >>* [OnValue $ ifValue pred (cont o hd)]
        where
                pred [] = False
@@ -69,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 ()