From 778d5d97bc6f8a0f37d59177301348a960079e13 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 31 May 2017 14:39:00 +0200 Subject: [PATCH] supposedly working parametric lenses, needs testing --- Shares/mTaskShare.dcl | 2 +- Shares/mTaskShare.icl | 35 ++++++++++++++++++----------------- Utils/SDS.dcl | 2 -- Utils/SDS.icl | 6 ------ 4 files changed, 19 insertions(+), 26 deletions(-) diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl index a3155fd..9cb38ca 100644 --- a/Shares/mTaskShare.dcl +++ b/Shares/mTaskShare.dcl @@ -29,7 +29,7 @@ cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare] //cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare] //Clean out shares when a device has been removed -updateShareFromPublish :: MTaskDevice Int BCValue -> Task [MTaskShare] +updateShareFromPublish :: MTaskDevice Int BCValue -> Task [MTaskDevice] //updateShare :: Int BCValue -> Task [MTaskShare] getRealShare :: MTaskDevice MTaskShare -> Shared BCValue diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index edd84d0..bf8f2a1 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -67,14 +67,6 @@ makeShare withTask identifier value = {MTaskShare ,value=value } -if` i t e = if i t e - -updateShareFromPublish :: MTaskDevice Int BCValue -> Task [MTaskShare] -updateShareFromPublish 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 - import GenPrint, StdMisc, StdDebug, TTY derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime derive gPrint Parity, BaudRate, ByteSize @@ -106,7 +98,7 @@ getRealShare dev share=:{identifier} = sdsFocus (Just identifier) $ SDSSource {S Nothing = (Error $ exception "Device doesn't exist anymore", iworld) Just {deviceShares} = case find ((==)share) deviceShares of Nothing = (Error $ exception "Share doesn't exist", iworld) - Just share = (Ok share.MTaskShare.value, iworld) + Just s = (Ok s.MTaskShare.value, iworld) // Also send messages ww name value iworld @@ -118,11 +110,20 @@ getRealShare dev share=:{identifier} = sdsFocus (Just identifier) $ SDSSource {S (Ok _, iworld) = (Ok $ maybe True ((==) identifier), iworld) modifyValue :: BCValue [MTaskDevice] -> [MTaskDevice] - modifyValue v ds = filterMap ((==)dev) deviceUpdate ds - where - deviceUpdate d = {MTaskDevice | d - & deviceShares=filterMap ((==)share) shareUpd d.deviceShares} - shareUpd s = {MTaskShare | s & value=v} - - filterMap :: (a -> Bool) (a -> a) [a] -> [a] - filterMap f t xs = [if (f x) (t x) x\\x<-xs] + modifyValue v ds = filterMap ((==)dev) (updateShare identifier v) ds + +filterMap :: (a -> Bool) (a -> a) [a] -> [a] +filterMap f t xs = [if (f x) (t x) x\\x<-xs] + +getDeviceStoreForShare :: Int -> Shared [MTaskDevice] +getDeviceStoreForShare ident = sdsFocus (Just ident) $ sdsFocus () deviceStore + +updateShareFromPublish :: MTaskDevice Int BCValue -> Task [MTaskDevice] +updateShareFromPublish dev ident val + = upd (filterMap ((==)dev) (updateShare ident val)) $ getDeviceStoreForShare ident + +updateShare :: Int BCValue MTaskDevice -> MTaskDevice +updateShare ident val dev = {MTaskDevice | dev & deviceShares=filterMap + (\s->s.identifier==ident) + (\s->{MTaskShare | s & value=val}) + dev.deviceShares} diff --git a/Utils/SDS.dcl b/Utils/SDS.dcl index 9cc6766..17e2a9c 100644 --- a/Utils/SDS.dcl +++ b/Utils/SDS.dcl @@ -9,5 +9,3 @@ memoryShare :: String a -> Shared a | iTask a deviceStore :: Shared [MTaskDevice] bcStateStore :: Shared BCState mTaskTaskStore :: Shared [String] - -getSDSRecord :: Int -> Task MTaskShare diff --git a/Utils/SDS.icl b/Utils/SDS.icl index 920c7a6..b00a7ae 100644 --- a/Utils/SDS.icl +++ b/Utils/SDS.icl @@ -14,14 +14,8 @@ memoryShare s d = sdsFocus s $ memoryStore "" $ Just d deviceStore :: Shared [MTaskDevice] deviceStore = sharedStore "mTaskDevices" [] -sdsStore :: Shared [MTaskShare] -sdsStore = memoryShare "mTaskShares" [] - bcStateStore :: Shared BCState bcStateStore = memoryShare "mTaskBCState" zero mTaskTaskStore :: Shared [String] mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks - -getSDSRecord :: Int -> Task MTaskShare -getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i] -- 2.20.1