X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Shares%2FmTaskShare.icl;h=1ccbcc4f3a95affecd5d3cb1f9a62ad4a7fcdb5e;hb=d99f9bb5fdcf3a58381281b5927a65f82b44b494;hp=e8ed9a2077b3e50fe27ddb78e0dacf8575f77e87;hpb=3fe035b92e9bc0b745c57db64e78461b2f36b6d1;p=mTask.git diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index e8ed9a2..1ccbcc4 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 = viewInformation "" [] []//whileUnchanged deviceStoreNP -// $ \devs->case devs of -// [] = viewInformation "No devices yet" [] [] -// _ = allTasks (map manageSharesOnDevice devs) +manageShares = whileUnchanged deviceStoreNP + $ \devs->case devs of + [] = viewInformation "No devices yet" [] [] + _ = allTasks (map manageSharesOnDevice devs) manageSharesOnDevice :: MTaskDevice -> Task MTaskDevice manageSharesOnDevice dev = (case dev.deviceShares of @@ -92,42 +94,18 @@ cleanSharesTask taskid d = updateShares d id //TODO instance == MTaskShare where (==) a b = a.identifier == b.identifier -getRealShare :: MTaskDevice MTaskShare -> Shared BCValue -getRealShare dev share = sdsFocus () +shareShare :: MTaskDevice MTaskShare -> Shared BCValue +shareShare 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 = 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 @@ -136,10 +114,8 @@ where ([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] + ([s], shares) = Ok $ Just [{MTaskDevice | d & + deviceShares=[{MTaskShare | s & value=val}:shares]}:devs] updateShareFromPublish :: MTaskDevice Int BCValue -> Task BCValue updateShareFromPublish dev ident val = set val