From 6b9b7f62df51ee3f48a78ae05b8b8f287ecce5b2 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 18 May 2017 10:28:53 +0200 Subject: [PATCH] make shares of devices --- Devices/mTaskDevice.dcl | 1 + Devices/mTaskDevice.icl | 5 +-- Shares/mTaskShare.dcl | 16 ++++++--- Shares/mTaskShare.icl | 73 +++++++++++++++++++++++++++-------------- Tasks/mTaskTask.icl | 4 +-- Utils/SDS.dcl | 1 - miTask.icl | 4 +-- 7 files changed, 68 insertions(+), 36 deletions(-) diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index d75256b..2af19ea 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -28,6 +28,7 @@ derive consName MTaskResource, TCPSettings , deviceTasks :: [MTaskTask] , deviceData :: MTaskResource , deviceSpec :: Maybe MTaskDeviceSpec + , deviceShares :: [MTaskShare] } instance == MTaskDevice diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index e05d61b..7316f94 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -44,7 +44,8 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice ,deviceTask=Nothing ,deviceError=Nothing ,deviceData=res - ,deviceSpec=Nothing} + ,deviceSpec=Nothing + ,deviceShares=[]} getSynFun :: MTaskResource -> ((Shared Channels) -> Task ()) getSynFun (TCPDevice t) = synFun t @@ -104,7 +105,7 @@ deleteDevice d = sendMessages [MTShutdown] d >>| upd (\(r,s,ss)->(r,s,True)) (channels d) >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask >>| upd (filter ((<>)d)) deviceStore - >>| cleanSharesDevice d.deviceName +// >>| cleanSharesDevice d.deviceName @! () sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl index de2cbc4..c505362 100644 --- a/Shares/mTaskShare.dcl +++ b/Shares/mTaskShare.dcl @@ -9,21 +9,27 @@ derive class iTask MTaskShare :: MTaskShare = {withTask :: [String] - ,withDevice :: [String] ,identifier :: Int ,value :: BCValue } + //Constructor -makeShare :: String String Int BCValue -> MTaskShare +makeShare :: String Int BCValue -> MTaskShare //General viewing task -manageShares :: [MTaskShare] -> Task MTaskShare +manageShares :: Task [MTaskDevice] +//manageShares :: [MTaskShare] -> Task MTaskShare + +updateShares :: MTaskDevice ([MTaskShare] -> [MTaskShare]) -> Task [MTaskShare] //Clean out shares when a task has been removed cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare] +//cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare] //Clean out shares when a device has been removed -cleanSharesDevice :: String -> Task [MTaskShare] -updateShare :: Int BCValue -> Task [MTaskShare] +updateShare :: MTaskDevice Int BCValue -> Task [MTaskShare] +//updateShare :: Int BCValue -> Task [MTaskShare] + +getRealShare :: MTaskDevice BCShare -> Shared BCValue //updateShare :: Int BCValue -> Task () diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index 4cca134..9960f4e 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -11,9 +11,24 @@ from StdFunc import flip derive class iTask MTaskShare -manageShares :: [MTaskShare] -> Task MTaskShare -manageShares x = enterChoice "" [ChooseFromGrid id] x - >>| manageShares x +manageShares :: Task [MTaskDevice] +manageShares = whileUnchanged deviceStore + $ \devs->case devs of + [] = viewInformation "No devices yet" [] [] + _ = allTasks (map manageSharesOnDevice devs) + +manageSharesOnDevice :: MTaskDevice -> Task MTaskDevice +manageSharesOnDevice dev = (case dev.deviceShares of + [] = viewInformation dev.deviceName [] "No shares yet" + shs = enterChoice dev.deviceName [ChooseFromGrid id] shs @ const "" + ) >>| treturn dev + +updateShares :: MTaskDevice ([MTaskShare] -> [MTaskShare]) -> Task [MTaskShare] +updateShares dev tfun = upd (map upFun) deviceStore + @ (\d->d.deviceShares) o fromJust o find ((==)dev) + where + upFun d = if (dev == d) ({d&deviceShares=tfun d.deviceShares}) d + //manageShares shares = withShared Nothing $ \cs->forever $ // (viewSharesGrid cs shares -|| updateShares shares <<@ ArrangeVertical) // @! () @@ -44,17 +59,15 @@ manageShares x = enterChoice "" [ChooseFromGrid id] x //viewShare m = viewSharedInformation "" [] (getSDSShare m) // <<@ Title ("SDS: " +++ toString m.identifier) -makeShare :: String String Int BCValue -> MTaskShare -makeShare withTask withDevice identifier value = {MTaskShare +makeShare :: String Int BCValue -> MTaskShare +makeShare withTask identifier value = {MTaskShare |withTask=[withTask] - ,withDevice=[withDevice] ,identifier=identifier ,value=value -// ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier } -updateShare :: Int BCValue -> Task [MTaskShare] -updateShare ident val = upd (map $ up ident val) sdsStore +updateShare :: MTaskDevice Int BCValue -> Task [MTaskShare] +updateShare dev ident val = updateShares dev $ map $ up ident val where up :: Int BCValue MTaskShare -> MTaskShare up i v s = if (s.identifier == i) {MTaskShare | s & value=val} s @@ -64,20 +77,32 @@ derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, derive gPrint Parity, BaudRate, ByteSize cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare] -cleanSharesTask taskid d -| not (trace_tn $ printToString taskid) = undef -| not (trace_tn $ printToString d.deviceTasks) = undef -| not (trace_tn $ printToString $ getNames taskid d) = undef -= upd (map $ up $ getNames taskid d) sdsStore - where - getNames :: Int MTaskDevice -> [String] - getNames i d = [t.MTaskTask.name\\t<-d.deviceTasks|t.ident==i] - - up :: [String] MTaskShare -> MTaskShare - up ns s = {MTaskShare | s & withTask=[t\\t<-s.withTask|not (isMember t ns)]} +cleanSharesTask taskid d = updateShares d id //TODO +//# shares = d.deviceShares +//| not (trace_tn $ printToString taskid) = undef +//| not (trace_tn $ printToString d.deviceTasks) = undef +//| not (trace_tn $ printToString $ getNames taskid d) = undef +//= upd (map $ up $ getNames taskid d) sdsStore +// where +// getNames :: Int MTaskDevice -> [String] +// getNames i d = [t.MTaskTask.name\\t<-d.deviceTasks|t.ident==i] +// +// up :: [String] MTaskShare -> MTaskShare +// up ns s = {MTaskShare | s & withTask=[t\\t<-s.withTask|not (isMember t ns)]} -cleanSharesDevice :: String -> Task [MTaskShare] -cleanSharesDevice did = upd (map (up did)) sdsStore +getRealShare :: MTaskDevice BCShare -> Shared BCValue +getRealShare dev {sdsi} = SDSSource {SDSSource + | name = "mTaskShareMap-" +++ toString sdsi, read=rr, write=ww} where - up :: String MTaskShare -> MTaskShare - up i s = {MTaskShare | s & withDevice = [wt\\wt<-s.withDevice|wt <> i]} + rr name iworld = case read deviceStore iworld of + (Error e, iworld) = (Error e, iworld) + (Ok devices, iworld) = case find ((==)dev) devices of + Nothing = (Error $ exception "Device doesn't exist anymore", iworld) + Just {deviceShares} = case find (\s->s.identifier == sdsi) deviceShares of + Nothing = (Error $ exception "Share doesn't exist", iworld) + Just share = (Ok share.MTaskShare.value, iworld) + + // Also send messages + ww name value iworld = undef//case modify (modFun name value) sdsStore of +// (Error e, iworld) = (Error e, iworld) +// (Ok shares, iworld) = (Ok $ const True, iworld) diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl index 46637e8..27edc82 100644 --- a/Tasks/mTaskTask.icl +++ b/Tasks/mTaskTask.icl @@ -17,7 +17,7 @@ sendTaskToDevice wta mTask (device, timeout) = get bcStateStore @ toMessages timeout mTask >>= \(msgs, st1)->set st1 bcStateStore >>| toSDSRecords msgs st1 device - >>= \sdss->upd ((++) sdss) sdsStore + >>= \sdss->updateShares device ((++) sdss) >>| sendMessages msgs device >>| makeTask wta -1 >>= withDevices device o addTask @@ -27,7 +27,7 @@ sendTaskToDevice wta mTask (device, timeout) = toSDSRecords :: [MTaskMSGSend] BCState MTaskDevice -> Task [MTaskShare] toSDSRecords s st device = treturn - [makeShare wta device.deviceName sdsi sdsval + [makeShare wta sdsi sdsval \\{sdsi,sdsval}<-st.sdss, (MTSds sdsi` _)<-s | sdsi == sdsi`] addTask :: MTaskTask MTaskDevice -> MTaskDevice diff --git a/Utils/SDS.dcl b/Utils/SDS.dcl index 785af5d..9cc6766 100644 --- a/Utils/SDS.dcl +++ b/Utils/SDS.dcl @@ -7,7 +7,6 @@ import iTasks memoryShare :: String a -> Shared a | iTask a deviceStore :: Shared [MTaskDevice] -sdsStore :: Shared [MTaskShare] bcStateStore :: Shared BCState mTaskTaskStore :: Shared [String] diff --git a/miTask.icl b/miTask.icl index ba28987..e16d3c0 100644 --- a/miTask.icl +++ b/miTask.icl @@ -35,7 +35,7 @@ demo = viewInformation "" [] "Hello world" mTaskManager :: Task () mTaskManager = startupDevices >>| anyTask [ viewmTasks @! () - , whileUnchanged sdsStore manageShares @! () + , manageShares @! () , whileUnchanged deviceStore $ manageDevices process ] <<@ ApplyLayout (foldl1 sequenceLayouts [arrangeWithSideBar 0 LeftSide 260 True @@ -66,7 +66,7 @@ mTaskManager = startupDevices >>| anyTask proc [m:ms] = traceValue (toString m) >>| (case m of // MTSDSAck i = traceValue (toString m) @! () // MTSDSDelAck i = traceValue (toString m) @! () - MTPub i val = updateShare i val @! () + MTPub i val = updateShare device i val @! () MTTaskAck i mem = deviceTaskAcked device i mem MTTaskDelAck i = deviceTaskDeleteAcked device i @! () MTDevSpec s = deviceAddSpec device s @! () -- 2.20.1