From: Mart Lubbers Date: Fri, 23 Jun 2017 18:25:38 +0000 (+0200) Subject: Merge branch 'master' of gitlab.science:mlubbers/mTask X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=23df390c56cd0c57eeb6d71e44bfa89ccb27cad7;hp=6badd886c4b09ac1805a005e525447a7e910ea56;p=mTask.git Merge branch 'master' of gitlab.science:mlubbers/mTask --- diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index 5fc0bfe..ce4a047 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- a/client/interface.h +++ b/client/interface.h @@ -10,43 +10,35 @@ extern "C" { #include #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 --- 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 --- 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 --- 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 ()