X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Shares%2FmTaskShare.icl;h=a9ebf5600632271d4121e9dde64ebbe021db5cde;hb=1e18ef692756fa4a6f163994e7edb5ad4f11b3db;hp=81ebb8b69dcd281767682b6b03b958cec511e6a7;hpb=8782aef8ee6b8e0d3be35bee36b519212bdd8de9;p=mTask.git diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index 81ebb8b..a9ebf56 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -6,17 +6,19 @@ import Utils.Devices 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] -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 @@ -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) -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 + ,humanName=human } 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 @@ -94,14 +100,34 @@ getRealShare dev share = sdsFocus () $ 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 = 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 @@ -120,4 +146,4 @@ updateShareFromPublish dev ident val = set val $ mapReadWriteError (deviceLens dev dummy) $ deviceStoreNP where - dummy = {MTaskShare|value=BCValue 0,identifier=ident,withTask=[]} + dummy = {MTaskShare|humanName="",value=BCValue 0,identifier=ident,withTask=[]}