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
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
([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
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:)" [])