supposedly working parametric lenses, needs testing

diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl
index a3155fd..9cb38ca 100644 (file)
--- 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
 
 //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
 //updateShare :: Int BCValue -> Task [MTaskShare]
 
 getRealShare :: MTaskDevice MTaskShare -> Shared BCValue

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index edd84d0..bf8f2a1 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -67,14 +67,6 @@ makeShare withTask identifier value = {MTaskShare
                ,value=value
                }
 
                ,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
 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)
                                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
                        
                // 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]
                                (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 (file)
--- 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]
 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 (file)
--- 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" []
 
 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
 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]