From 8155b7e2298e78fd53fc17df35d940472dcf8661 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 21 Mar 2017 12:34:13 +0100 Subject: [PATCH] send device move to task --- Devices/mTaskDevice.dcl | 3 ++- Devices/mTaskDevice.icl | 16 ---------------- Tasks/mTaskTask.dcl | 1 + Tasks/mTaskTask.icl | 27 +++++++++++++++++++++++++++ mTaskInterpret.dcl | 2 +- mTaskInterpret.icl | 12 ++++++++---- miTask.icl | 2 +- 7 files changed, 40 insertions(+), 23 deletions(-) diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index ce6e608..103da32 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -38,9 +38,10 @@ class MTaskDuplex a where startupDevices :: Task [MTaskDevice] connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task () -sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) +withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () + deviceTaskDelete :: MTaskDevice MTaskTask -> Task () deviceTaskAcked :: MTaskDevice Int -> Task () deviceTaskDeleteAcked :: MTaskDevice Int -> Task () diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 6f6480a..5e3f6dc 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -98,22 +98,6 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) // >>| upd (removeShares d) sdsStore @! () -sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () -sendToDevice wta mTask (device, timeout) = - get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) - >>= \(msgs, st1)->set st1 bcStateStore - >>| toSDSRecords st1 - >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare - >>| sendMessages msgs device - >>| makeTask wta -1 - >>= withDevices device o addTask - @! () - where - sharename i = device.deviceChannels +++ "-" +++ toString i - toSDSRecords st = sequence "" [makeShare wta sdsi sdsval\\{sdsi,sdspub,sdsval}<-st.sdss]// | sdspub] - - addTask :: MTaskTask MTaskDevice -> MTaskDevice - addTask task device = {device & deviceTasks=[task:device.deviceTasks]} sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl index 19a3db0..3370e4a 100644 --- a/Tasks/mTaskTask.dcl +++ b/Tasks/mTaskTask.dcl @@ -13,3 +13,4 @@ derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCS } makeTask :: String Int -> Task MTaskTask +sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl index 1cd45f8..3e209da 100644 --- a/Tasks/mTaskTask.icl +++ b/Tasks/mTaskTask.icl @@ -2,6 +2,8 @@ implementation module Tasks.mTaskTask import mTask import iTasks +import Devices.mTaskDevice + import iTasks._Framework.Serialization @@ -10,3 +12,28 @@ derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCS makeTask :: String Int -> Task MTaskTask makeTask name ident = get currentDateTime @ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt} + +sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () +sendTaskToDevice wta mTask (device, timeout) = + get bcStateStore @ toMessages timeout mTask + >>= \(msgs, st1)->set st1 bcStateStore + >>| toSDSRecords msgs st1 + >>= \sdss->upd (mergeShares sdss) sdsStore + >>| sendMessages msgs device + >>| makeTask wta -1 + >>= withDevices device o addTask + @! () + where + sharename i = device.deviceChannels +++ "-" +++ toString i + + toSDSRecords :: [MTaskMSGSend] BCState -> Task [MTaskShare] + toSDSRecords s st = sequence "" + [makeShare wta sdsi sdsval + \\{sdsi,sdspub,sdsval}<-st.sdss + , (MTSds sdsi` _)<-s + | sdsi == sdsi`] + + mergeShares a b = a ++ b + + addTask :: MTaskTask MTaskDevice -> MTaskDevice + addTask task device = {device & deviceTasks=[task:device.deviceTasks]} diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 84c1e3f..2e9e5b8 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -150,7 +150,7 @@ instance assign ByteCode instance seq ByteCode instance serial ByteCode -toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState) +toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState) toSDSUpdate :: Int Int -> [MTaskMSGSend] toByteVal :: BC -> String diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index bd5572a..0026290 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -329,10 +329,14 @@ toReadableByteCode x s where (ex, newls) = splitAt (bclength b - 1) ls -toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState) -toMessages interval (bytes, st=:{sdss}) = ( - [MTSds sdsi $ toByteCode e\\{sdsi,sdsval=(BCValue e)}<-sdss] ++ - [MTTask interval bytes], st) +toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState) +toMessages interval x s +# (bc, newstate) = toRealByteCode (unMain x) s +# newsdss = 'DL'.difference s.sdss newstate.sdss += ([MTSds sdsi $ toByteCode e\\{sdsi,sdsval=(BCValue e)}<-newsdss] ++ + [MTTask interval bc], newstate) + +instance == BCShare where (==) a b = a.sdsi == b.sdsi toSDSUpdate :: Int Int -> [MTaskMSGSend] toSDSUpdate i v = [MTUpd i (to16bit v)] diff --git a/miTask.icl b/miTask.icl index 5c2b47a..cab7934 100644 --- a/miTask.icl +++ b/miTask.icl @@ -50,7 +50,7 @@ mTaskManager = startupDevices >>| anyTask ds = fromJust ('DM'.get mTaskTask allmTasks) >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds -&&- enterInformation "Timeout" [] - ) >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskTask bc)] + ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice mTaskTask bc)] @! () ) -- 2.20.1