add device shares

[mTask.git] / Shares / mTaskShare.icl

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 81ebb8b..a9ebf56 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -6,17 +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
 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 deviceStoreNP
-       $ \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


@@ -60,14 +62,18 @@ updateShares dev tfun = upd (map upFun) (sdsFocus (Just (dev, -1)) 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

                }
 
 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
 


@@ -94,14 +100,34 @@ getRealShare dev share = sdsFocus ()
        $ sdsFocus (Just (dev, share.identifier))
        $ deviceStore
 
        $ 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
 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
+       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
        
        mwrite :: BCValue [MTaskDevice] -> MaybeError TaskException (Maybe [MTaskDevice])
        mwrite val devs = case partition ((==)dev) devs of


@@ -120,4 +146,4 @@ updateShareFromPublish dev ident val = set val
        $ mapReadWriteError (deviceLens dev dummy)
        $ deviceStoreNP
 where
        $ mapReadWriteError (deviceLens dev dummy)
        $ deviceStoreNP
 where

-       dummy = {MTaskShare|value=BCValue 0,identifier=ident,withTask=[]}
+       dummy = {MTaskShare|humanName="",value=BCValue 0,identifier=ident,withTask=[]}