Merge branch 'master' of gitlab.science:mlubbers/mTask

[mTask.git] / Shares / mTaskShare.icl

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index edd84d0..43350e1 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -13,7 +13,7 @@ from StdFunc import flip
 derive class iTask MTaskShare
 
 manageShares :: Task [MTaskDevice]
 derive class iTask MTaskShare
 
 manageShares :: Task [MTaskDevice]

-manageShares = whileUnchanged deviceStore
+manageShares = whileUnchanged deviceStoreNP

        $ \devs->case devs of
                [] = viewInformation "No devices yet" [] []
                _ = allTasks (map manageSharesOnDevice devs)
        $ \devs->case devs of
                [] = viewInformation "No devices yet" [] []
                _ = allTasks (map manageSharesOnDevice devs)


@@ -25,7 +25,7 @@ manageSharesOnDevice dev = (case dev.deviceShares of
        ) >>| treturn dev
 
 updateShares :: MTaskDevice ([MTaskShare] -> [MTaskShare]) -> Task [MTaskShare]
        ) >>| treturn dev
 
 updateShares :: MTaskDevice ([MTaskShare] -> [MTaskShare]) -> Task [MTaskShare]

-updateShares dev tfun = upd (map upFun) deviceStore 
+updateShares dev tfun = upd (map upFun) (sdsFocus (Just (dev, -1)) deviceStore)

                @ (\d->d.deviceShares) o fromJust o find ((==)dev)
        where
                upFun d = if (dev == d) ({d&deviceShares=tfun d.deviceShares}) d
                @ (\d->d.deviceShares) o fromJust o find ((==)dev)
        where
                upFun d = if (dev == d) ({d&deviceShares=tfun d.deviceShares}) d


@@ -67,15 +67,10 @@ makeShare withTask identifier value = {MTaskShare
                ,value=value
                }
 
                ,value=value
                }
 

-if` i t e = if i t e
+import GenPrint, StdMisc, StdDebug, TTY

 
 

-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
+gPrint{|BCState|} x st = gPrint{|*|} "BCState..." st

 
 

-import GenPrint, StdMisc, StdDebug, TTY

 derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime
 derive gPrint Parity, BaudRate, ByteSize
 
 derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime
 derive gPrint Parity, BaudRate, ByteSize
 


@@ -97,32 +92,35 @@ instance == MTaskShare where
        (==) a b = a.identifier == b.identifier
 
 getRealShare :: MTaskDevice MTaskShare -> Shared BCValue
        (==) a b = a.identifier == b.identifier
 
 getRealShare :: MTaskDevice MTaskShare -> Shared BCValue

-getRealShare dev share=:{identifier} = sdsFocus (Just identifier) $ SDSSource {SDSSource
-       | name = "mTaskShareMap-" +++ toString identifier, read=rr, write=ww}
-       where
-               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 ((==)share) deviceShares of
-                                       Nothing = (Error $ exception "Share doesn't exist", iworld)
-                                       Just share = (Ok share.MTaskShare.value, iworld)
-                       
-               // Also send messages
-               ww name value iworld
-               | not (trace_tn ("Update to: " +++ printToString value)) = undef
-               = case modify (tuple () o modifyValue value) deviceStore iworld of
-                       (Error e, iworld) = (Error e, iworld)
-                       (Ok _, iworld) = case sendMessagesIW [MTUpd identifier value] dev iworld of
-                               (Error e, iworld) = (Error e, iworld)
-                               (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]
+getRealShare dev share = sdsFocus ()
+       $ mapReadWriteError (deviceLens dev share)
+       $ sdsFocus (Just (dev, share.identifier))
+       $ deviceStore
+
+deviceLens dev share = (mread, mwrite)
+where
+       mread :: [MTaskDevice] -> MaybeError TaskException BCValue
+       mread devs = case find ((==)dev) devs of
+               Nothing = Error $ exception "Device doesn't exist anymore"
+               Just {deviceShares} = case find ((==)share) deviceShares of
+                       Nothing = Error $ exception "Share doesn't exist anymore"
+                       Just share = Ok share.MTaskShare.value
+       
+       mwrite :: BCValue [MTaskDevice] -> MaybeError TaskException (Maybe [MTaskDevice])
+       mwrite val devs = case partition ((==)dev) devs of
+               ([], _) = Error $ exception "Device doesn't exist anymore"
+               ([_,_:_], _) = Error $ exception "Multiple matching devices"
+               ([d=:{deviceShares}], devs) = case partition ((==)share) deviceShares of
+                       ([], _) = Error $ exception "Share doesn't exist anymore"
+                       ([_,_:_], _) = Error $ exception "Multiple matching shares"
+                       ([s], shares)
+                               # s = {MTaskShare | s & value=val}
+                               # d = {MTaskDevice | d & deviceShares=[s:shares]}
+                               = Ok $ Just [d:devs]
+
+updateShareFromPublish :: MTaskDevice Int BCValue -> Task BCValue
+updateShareFromPublish dev ident val = set val 
+       $ mapReadWriteError (deviceLens dev dummy)
+       $ deviceStoreNP
+where
+       dummy = {MTaskShare|value=BCValue 0,identifier=ident,withTask=[]}