supposedly working parametric lenses, needs testing

[mTask.git] / Shares / mTaskShare.icl

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}