From: Mart Lubbers Date: Sat, 24 Jun 2017 17:27:55 +0000 (+0200) Subject: refactoors X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=d99f9bb5fdcf3a58381281b5927a65f82b44b494;p=mTask.git refactoors --- diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 193c4d7..1f03e0f 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -74,14 +74,6 @@ addDevice processFun deviceTypes :: [MTaskResource] deviceTypes = conses{|*|} -//connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () -//connectDevice pf d = let ch = channels d in appendTopLevelTask 'DM'.newMap True -// (pf d ch -||- catchAll (getSynFun d.deviceData ch) errorHandle) -// >>= \tid->withDevices d (\d->{d&deviceTask=Just tid,deviceError=Nothing}) -// >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch -// @! () -// where -// errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e}) @! () import StdDebug connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels connectDevice procFun device = let ch = channels device diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl index 6cd08a9..686a372 100644 --- a/Shares/mTaskShare.dcl +++ b/Shares/mTaskShare.dcl @@ -34,7 +34,7 @@ cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare] updateShareFromPublish :: MTaskDevice Int BCValue -> Task BCValue //updateShare :: Int BCValue -> Task [MTaskShare] -getRealShare :: MTaskDevice MTaskShare -> Shared BCValue -//getRealShare :: MTaskDevice BCShare -> Shared BCValue +shareShare :: MTaskDevice MTaskShare -> Shared BCValue +//shareShare :: MTaskDevice BCShare -> Shared BCValue //updateShare :: Int BCValue -> Task () diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index 2133f0b..1ccbcc4 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -94,34 +94,12 @@ 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 @@ -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 diff --git a/miTask.icl b/miTask.icl index c0ee6f2..c47f525 100644 --- a/miTask.icl +++ b/miTask.icl @@ -40,9 +40,9 @@ demo = set 5 (sharedDynamicStore "Hoi" 5) cont :: MTaskDevice -> Task () cont dev - # rs = getRealShare dev (hd dev.deviceShares) + # rs = shareShare dev (hd dev.deviceShares) = get rs >>= \oldvalue-> - forever (updateSharedInformation "Blinkyblink" [] (getRealShare dev (hd dev.deviceShares)) + forever (updateSharedInformation "Blinkyblink" [] (shareShare dev (hd dev.deviceShares)) >>* [OnAction ActionContinue (const $ Just $ treturn ())]) -|| (wait "bigger than 10" (\x->x == oldvalue) rs >>= viewInformation "Bigger:)" [])