From 1d6cedaf81bbbe0ae869f20c9003bf018fb027ff Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Mar 2017 09:23:28 +0100 Subject: [PATCH] working again, externalized some device helper functions and added share updating --- Devices/mTaskDevice.dcl | 3 +-- Devices/mTaskDevice.icl | 12 +++++------- Shares/mTaskShare.icl | 10 +++++++--- Utils/Devices.dcl | 7 +++++++ Utils/Devices.icl | 14 ++++++++++++++ 5 files changed, 34 insertions(+), 12 deletions(-) create mode 100644 Utils/Devices.dcl create mode 100644 Utils/Devices.icl diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index 213fccb..1662cbb 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -13,8 +13,6 @@ derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCSha derive conses MTaskResource, TCPSettings derive consName MTaskResource, TCPSettings -channels :: MTaskDevice -> Shared Channels - :: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool) :: MTaskResource @@ -36,6 +34,7 @@ class MTaskDuplex a where manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task () sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () +sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) deviceTaskDelete :: MTaskDevice MTaskTask -> Task () deviceTaskAcked :: MTaskDevice Int -> Task () diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 6a8c369..928432b 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -8,6 +8,7 @@ import iTasksTTY import TTY import qualified Data.Map as DM import Utils.SDS +import Utils.Devices import GenBimap import Devices.mTaskSerial @@ -23,9 +24,6 @@ derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSetti instance == MTaskDevice where (==) a b = a.deviceChannels == b.deviceChannels -channels :: MTaskDevice -> Shared Channels -channels d = memoryShare d.deviceChannels ([], [], False) - makeDevice :: String MTaskResource -> Task MTaskDevice makeDevice name res = get randomInt @ \rand->{MTaskDevice |deviceChannels=name +++ toString rand @@ -88,7 +86,7 @@ sendToDevice wta mTask (device, timeout) = >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare >>| makeShares sdss - >>| sendMessage device msgs + >>| sendMessages msgs device >>| makeTask wta -1 >>= withDevices device o addTask @! () @@ -106,8 +104,8 @@ sendToDevice wta mTask (device, timeout) = addTask :: MTaskTask MTaskDevice -> MTaskDevice addTask task device = {device & deviceTasks=[task:device.deviceTasks]} -sendMessage :: MTaskDevice [MTaskMSGSend] -> Task () -sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! () +sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) +sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! () @@ -122,7 +120,7 @@ deviceTaskAcked dev i [{t & ident=i}:ts] [t:ackFirst ts] deviceTaskDelete :: MTaskDevice MTaskTask -> Task () -deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident] +deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! () deviceTaskDeleteAcked :: MTaskDevice Int -> Task () deviceTaskDeleteAcked d i = withDevices d $ deleteTask diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index b0c4424..1e9294c 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -1,7 +1,9 @@ implementation module Shares.mTaskShare import Utils.SDS +import Utils.Devices import iTasks +import mTask from Data.Func import $ manageShares :: [MTaskShare] -> Task () @@ -10,14 +12,16 @@ manageShares shares = forever (enterChoice "Choose share to update" [ChooseFromG Nothing = viewShares shares @! zero Just sh = forever ( viewSharedInformation "View value" [] (getSDSStore sh) - >>* [OnAction (Action "Update") (withValue $ Just $ updateInformation "New value" [])] + >>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))] >>= updateShare sh ) ) @! () -updateShare :: MTaskShare Int -> Task MTaskShare -updateShare sh=:{withTask} i = return sh +updateShare :: MTaskShare a -> Task MTaskShare | toByteCode a +updateShare sh=:{withTask,identifier} a = getDeviceByName withTask + >>= sendMessages [MTUpd identifier $ toString $ toByteCode a] + >>| treturn sh viewShares :: [MTaskShare] -> Task () diff --git a/Utils/Devices.dcl b/Utils/Devices.dcl new file mode 100644 index 0000000..d816d3f --- /dev/null +++ b/Utils/Devices.dcl @@ -0,0 +1,7 @@ +definition module Utils.Devices + +import iTasks +import Devices.mTaskDevice + +getDeviceByName :: String -> Task MTaskDevice +channels :: MTaskDevice -> Shared Channels diff --git a/Utils/Devices.icl b/Utils/Devices.icl new file mode 100644 index 0000000..6a8052e --- /dev/null +++ b/Utils/Devices.icl @@ -0,0 +1,14 @@ +implementation module Utils.Devices + +import iTasks +import mTask +import Utils.SDS +import Data.List + +getDeviceByName :: String -> Task MTaskDevice +getDeviceByName nm = get deviceStore @ find (\d->d.deviceChannels == nm) + >>= maybe (throw "Help, device not found") treturn + +channels :: MTaskDevice -> Shared Channels +channels d = memoryShare d.deviceChannels ([], [], False) + -- 2.20.1