-sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
-sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()
-
-syncSerialChannel :: String TTYSettings (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
-syncSerialChannel dev opts decodeFun encodeFun rw = Task eval
- where
- eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
- = case TTYopen dev opts world of
- (False, _, world)
- # (err, world) = TTYerror world
- = (ExceptionResult (exception err), {iworld & world=world})
- (True, tty, world)
- # iworld = {iworld & world=world, resources=Just (TTYd tty)}
- = case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw decodeFun encodeFun)) iworld of
- (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
- (Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoRep (TCBasic taskId ts JSONNull False), iworld)
-
- 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 maybeNewData acc (msgs,send,sendStopped)
- # l = map decode (maybeToList maybeNewData)
- # send = if (not sendStopped) [] (map encode send)
- = (Ok acc, Just (msgs ++ l,[],sendStopped), send, False)
-
- onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
- onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)