From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 14 Jun 2017 13:13:47 +0000 (+0200)
Subject: Merge branch 'master' of gitlab.science:mlubbers/mTask
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=ac7af718140b7b2950c52ae1a45ac16a3a7d0fbc;hp=848595d1288804d6de43625f9e6f1cf76295c285;p=mTask.git

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

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index dc097f5..bae443e 100644
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -25,6 +25,7 @@ derive consName MTaskResource, TCPSettings
 		, deviceError :: Maybe String
 		, deviceChannels :: String
 		, deviceName :: String
+		, deviceState :: BCState
 		, deviceTasks :: [MTaskTask]
 		, deviceData :: MTaskResource
 		, deviceSpec :: Maybe MTaskDeviceSpec
diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 0a6ab0f..f4789cc 100644
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -44,6 +44,7 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice
 		,deviceTasks=[]
 		,deviceTask=Nothing
 		,deviceError=Nothing
+		,deviceState=zero
 		,deviceData=res
 		,deviceSpec=Nothing
 		,deviceShares=[]}
diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl
index 57855c1..2ba97cb 100644
--- a/Shares/mTaskShare.dcl
+++ b/Shares/mTaskShare.dcl
@@ -6,6 +6,7 @@ import mTask
 import Devices.mTaskDevice
 
 derive class iTask MTaskShare
+derive gPrint BCState
 
 :: MTaskShare =
 		{withTask :: [String]
diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 81ebb8b..43350e1 100644
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -68,6 +68,9 @@ makeShare withTask identifier value = {MTaskShare
 		}
 
 import GenPrint, StdMisc, StdDebug, TTY
+
+gPrint{|BCState|} x st = gPrint{|*|} "BCState..." st
+
 derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime
 derive gPrint Parity, BaudRate, ByteSize
 
diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index 0beddf2..f5976d3 100644
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -13,4 +13,4 @@ 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 ()
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index 27edc82..dcd0b8a 100644
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -12,23 +12,15 @@ makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
 	@ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt}
 
-sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
-sendTaskToDevice wta mTask (device, timeout) =
-		get bcStateStore @ toMessages timeout mTask
-	>>= \(msgs, st1)->set st1 bcStateStore
-	>>| toSDSRecords msgs st1 device
-	>>= \sdss->updateShares device ((++) sdss)
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
+sendTaskToDevice wta mTask (device, timeout)
+# (msgs, newState) = toMessages timeout mTask device.deviceState
+# shares = [makeShare wta sdsi sdsval\\{sdsi,sdsval}<-newState.sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`] 
+= updateShares device ((++) shares)
 	>>| sendMessages msgs device
 	>>| makeTask wta -1
-	>>= withDevices device o addTask
-	@! ()
+	>>= withDevices device o addTaskUpState newState
 	where
-		sharename i = device.deviceChannels +++ "-" +++ toString i
-
-		toSDSRecords :: [MTaskMSGSend] BCState MTaskDevice -> Task [MTaskShare]
-		toSDSRecords s st device = treturn 
-			[makeShare wta sdsi sdsval
-			\\{sdsi,sdsval}<-st.sdss, (MTSds sdsi` _)<-s | sdsi == sdsi`]
-
-		addTask :: MTaskTask MTaskDevice -> MTaskDevice
-		addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
+		addTaskUpState :: BCState MTaskTask MTaskDevice -> MTaskDevice
+		addTaskUpState st task device = { MTaskDevice | device &
+			deviceState=st, deviceTasks=[task:device.deviceTasks]}
diff --git a/Utils/SDS.icl b/Utils/SDS.icl
index 3cd2566..9975d27 100644
--- a/Utils/SDS.icl
+++ b/Utils/SDS.icl
@@ -10,6 +10,8 @@ import qualified Data.Map as DM
 from Data.Func import $
 import Data.Tuple
 
+import StdDebug
+
 memoryShare :: String a -> Shared a | iTask a
 memoryShare s d = sdsFocus s $ memoryStore s $ Just d
 
@@ -30,9 +32,11 @@ where
 	| ident == -1 = (merr $> const True, iw)
 	= case find ((==)dev) w of
 		Nothing = (Error $ exception "Device doesn't exist anymore", iw)
-		Just {deviceShares} = case find (\{identifier}->identifier == ident) deviceShares of
+		Just {deviceShares} = case find (\d->d.identifier == ident) deviceShares of
 			Nothing = (Error $ exception $ "deviceStore: Share doesn't exist: " +++ toString ident, iw)
-			Just s = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
+			Just s
+			| 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)