refactoors master
authorMart Lubbers <mart@martlubbers.net>
Sat, 24 Jun 2017 17:27:55 +0000 (19:27 +0200)
committerMart Lubbers <mart@martlubbers.net>
Sat, 24 Jun 2017 17:27:55 +0000 (19:27 +0200)
Devices/mTaskDevice.icl
Shares/mTaskShare.dcl
Shares/mTaskShare.icl
miTask.icl

index 193c4d7..1f03e0f 100644 (file)
@@ -74,14 +74,6 @@ addDevice processFun
                deviceTypes :: [MTaskResource]
                deviceTypes = conses{|*|}
 
                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
 import StdDebug
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
 connectDevice procFun device = let ch = channels device
index 6cd08a9..686a372 100644 (file)
@@ -34,7 +34,7 @@ cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare]
 updateShareFromPublish :: MTaskDevice Int BCValue -> Task BCValue
 //updateShare :: Int BCValue -> 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 ()
 
 //updateShare :: Int BCValue -> Task ()
index 2133f0b..1ccbcc4 100644 (file)
@@ -94,34 +94,12 @@ cleanSharesTask taskid d = updateShares d id //TODO
 instance == MTaskShare where
        (==) a b = a.identifier == b.identifier
 
 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
 
        $ 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
 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"
                ([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 
 
 updateShareFromPublish :: MTaskDevice Int BCValue -> Task BCValue
 updateShareFromPublish dev ident val = set val 
index c0ee6f2..c47f525 100644 (file)
@@ -40,9 +40,9 @@ demo = set 5 (sharedDynamicStore "Hoi" 5)
 
                cont :: MTaskDevice -> Task ()
                cont dev
 
                cont :: MTaskDevice -> Task ()
                cont dev
-               # rs = getRealShare dev (hd dev.deviceShares)
+               # rs = shareShare dev (hd dev.deviceShares)
                = get rs >>= \oldvalue->
                = 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:)" [])
                        >>* [OnAction ActionContinue (const $ Just $ treturn ())])
                 -|| (wait "bigger than 10" (\x->x == oldvalue) rs
                        >>= viewInformation "Bigger:)" [])