- eval _ _ tree=:(TCBasic _ ts _ _) iworld
- = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoRep tree, iworld)
-
- eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
- # (TTYd tty) = fromJust resources
- # (ok, world) = TTYclose tty world
- # iworld = {iworld & world=world,resources=Nothing}
- = case removeBackgroundTask 42 iworld of
- (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
- (Ok _, iworld) = (DestroyedResult, iworld)
-
-serialDeviceBackgroundTask :: (Shared ([m],Bool,[n],Bool)) (String -> m) (n -> String) !*IWorld -> *IWorld
-serialDeviceBackgroundTask rw de en iworld
- = case read rw iworld of
- (Error e, iworld) = abort "share couldn't be read"
- (Ok (r,rs,s,ss), iworld)
- # (Just (TTYd tty)) = iworld.resources
- # tty = writet (map en s) tty
- # (ml, tty) = case TTYavailable tty of
- (False, tty) = ([], tty)
- (_, tty)
- # (l, tty) = TTYreadline tty
- = ([de l], tty)
- # iworld = {iworld & resources=Just (TTYd tty)}
- = case write (r++ml,rs,[],ss) rw iworld of
- (Error e, iworld) = abort "share couldn't be written"
- (Ok _, iworld) = case notify rw iworld of
- (Error e, iworld) = abort "share couldn't be notified"
- (Ok _, iworld) = iworld
- where
- writet :: [String] !*TTY -> *TTY
- writet [] t = t
- writet [x:xs] t = writet xs (TTYwrite x t)
-
-
-syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
-syncNetworkChannel server port channel
- = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
- where
- onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
- onConnect _ (msgs,send,sendStopped)
- = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
-
- whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
- whileConnected Nothing acc (msgs,send,sendStopped)
- = (Ok acc, Nothing, [], False)
-// = (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
-
- whileConnected (Just newData) acc (msgs,send,sendStopped)
- | sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
- = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
-
- onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
- onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)
+ process :: MTaskDevice (Shared Channels) -> Task ()
+ process device ch = forever (watch ch >>* [OnValue (
+ ifValue (not o isEmpty o fst3)
+ (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
+ where
+ proc :: [MTaskMSGRecv] -> Task ()
+ proc [] = treturn ()
+ proc [m:ms] = (case m of
+// MTSDSAck i = traceValue (toString m) @! ()
+// MTSDSDelAck i = traceValue (toString m) @! ()
+// MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
+ MTTaskAck i = deviceTaskAcked device i
+ MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
+ MTEmpty = treturn ()
+ _ = traceValue (toString m) @! ()
+ ) >>| proc ms
+
+ mapPar :: (a -> Task a) [a] -> Task ()
+ mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
+ allAtOnce t = foldr1 (||-) t @! ()
+ //allAtOnce = (flip (@!) ()) o foldr1 (||-)