add device shares

[mTask.git] / Shares / mTaskShare.icl

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 481d3ad..a9ebf56 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -6,16 +6,19 @@ import Utils.Devices
 import iTasks
 import mTask
 import Data.List
 import iTasks
 import mTask
 import Data.List

+import Data.Error
+import Data.Tuple
+from Control.Monad import `b`

 from Data.Func import $
 from StdFunc import flip
 
 derive class iTask MTaskShare
 
 manageShares :: Task [MTaskDevice]
 from Data.Func import $
 from StdFunc import flip
 
 derive class iTask MTaskShare
 
 manageShares :: Task [MTaskDevice]

-manageShares = whileUnchanged deviceStore
-       $ \devs->case devs of
-               [] = viewInformation "No devices yet" [] []
-               _ = allTasks (map manageSharesOnDevice devs)
+manageShares = viewInformation "" [] []//whileUnchanged deviceStoreNP
+//     $ \devs->case devs of
+//             [] = viewInformation "No devices yet" [] []
+//             _ = allTasks (map manageSharesOnDevice devs)

 
 manageSharesOnDevice :: MTaskDevice -> Task MTaskDevice
 manageSharesOnDevice dev = (case dev.deviceShares of
 
 manageSharesOnDevice :: MTaskDevice -> Task MTaskDevice
 manageSharesOnDevice dev = (case dev.deviceShares of


@@ -24,7 +27,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


@@ -59,20 +62,18 @@ updateShares dev tfun = upd (map upFun) deviceStore
 //viewShare m = viewSharedInformation "" [] (getSDSShare m)
 //     <<@ Title ("SDS: " +++ toString m.identifier)
 
 //viewShare m = viewSharedInformation "" [] (getSDSShare m)
 //     <<@ Title ("SDS: " +++ toString m.identifier)
 

-makeShare :: String Int BCValue -> MTaskShare
-makeShare withTask identifier value = {MTaskShare
+makeShare :: String String Int BCValue -> MTaskShare
+makeShare withTask human identifier value = {MTaskShare

                |withTask=[withTask]
                ,identifier=identifier
                ,value=value
                |withTask=[withTask]
                ,identifier=identifier
                ,value=value

+               ,humanName=human

                }
 
                }
 

-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
 import GenPrint, StdMisc, StdDebug, TTY

+
+gPrint{|BCState|} x st = gPrint{|*|} "BCState..." st
+

 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
 


@@ -90,33 +91,59 @@ cleanSharesTask taskid d = updateShares d id //TODO
 //             up :: [String] MTaskShare -> MTaskShare
 //             up ns s = {MTaskShare | s & withTask=[t\\t<-s.withTask|not (isMember t ns)]}
 
 //             up :: [String] MTaskShare -> MTaskShare
 //             up ns s = {MTaskShare | s & withTask=[t\\t<-s.withTask|not (isMember t ns)]}
 

+instance == MTaskShare where
+       (==) a b = a.identifier == b.identifier
+

 getRealShare :: MTaskDevice MTaskShare -> Shared BCValue
 getRealShare :: MTaskDevice MTaskShare -> Shared BCValue

-getRealShare dev {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 (\s->s.identifier == identifier) 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 (\r->((), map (modFun value) r)) 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 $ const True, iworld)
-
-               //Selects the correct device
-               modFun value d
-               | d == dev = {d & deviceShares=map (modFun2 value) d.deviceShares}
-               = d
-
-               //Selects the correct share
-               modFun2 value share
-               | identifier == share.MTaskShare.identifier = {MTaskShare | share & value=value}
-               = share
+getRealShare dev share = sdsFocus ()
+       $ mapReadWriteError (deviceLens dev share)
+       $ sdsFocus (Just (dev, share.identifier))
+       $ deviceStore
+
+//getRealShare :: MTaskDevice MTaskShare -> Shared BCValue
+//getRealShare dev share = sdsLens
+//     ("realShare" +++ toString share.identifier)
+//     (const $ Just (dev, share.identifier))
+//     (SDSRead $ const $ \rs->case find ((==)dev) rs 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
+//     )
+//     (SDSWrite $ const $ \rs w->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])
+//     (SDSNotify $ const $ \rs w
+
+deviceLens dev share = (mread, mwrite)
+where
+       mread :: [MTaskDevice] -> MaybeError TaskException BCValue
+       mread devs = mb2error (exception "Device lost") (find ((==)dev) devs)
+               `b` \d->mb2error (exception "Share lost") (find ((==)share) d.deviceShares)
+               `b` \s->Ok s.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|humanName="",value=BCValue 0,identifier=ident,withTask=[]}