Commit f9ce405f authored by Mart Lubbers's avatar Mart Lubbers

rewrite tasks

parent 3dbc3850
Pipeline #29745 passed with stage
in 3 minutes and 10 seconds
implementation module iTasksTTY
import Data.Tuple
import StdEnv
from Data.Map import :: Map, newMap
......@@ -9,6 +10,8 @@ import Text
import iTasks
import iTasks.Internal.IWorld
import iTasks.Internal.SDS
import iTasks.Internal.Util
import iTasks.Internal.Task
import iTasks.Internal.TaskEval
import iTasks.Internal.TaskState
......@@ -19,47 +22,34 @@ import TTY
derive class iTask TTYSettings, Parity, BaudRate, ByteSize
syncSerialChannel :: Timespec TTYSettings (b -> String) (String -> (Either String [a], String)) (Shared sds ([a],[b],Bool)) -> Task () | iTask a & iTask b & RWShared sds
syncSerialChannel poll opts enc dec rw = Task eval
syncSerialChannel poll opts enc dec rw = Task evalinit
where
eval DestroyEvent evalOpts tree iworld=:{IWorld|resources,world}
# (mtty, iworld) = getResource iworld
= case mtty of
[] = (exc "This tty was already closed", iworld)
[_,_:_] = (exc "Multiple matching resources", iworld)
[TTYd _ tty]
# (ok, world) = TTYclose tty iworld.world
# iworld & world = world
| not ok = (exc "Couldn't close device", iworld)
= (DestroyedResult, iworld)
evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
evalinit event evalOpts iworld
# (mtty, iworld=:{world,resources}) = getResource iworld
= case mtty of
[] = case TTYopen opts world of
(False, _, world)
= appFst exc $ liftIWorld TTYerror {iworld&world=world}
(True, tty, world)
= eval "" event evalOpts {iworld&world=world,resources=[TTYd opts.devicePath tty:resources]}
_ = (exc "This tty was already open", iworld)
eval event evalOpts tree=:(TCInit taskId ts) iworld
# (mtty, iworld=:{world,resources}) = getResource iworld
= case mtty of
[] = case TTYopen opts iworld.world of
(False, _, world)
# (err, world) = TTYerror world
= (exc err, {iworld & world=world})
(True, tty, world)
# (merr, iworld) = readRegister taskId ticker {iworld & world=world, resources=[TTYd opts.devicePath tty:resources]}
| isError merr = (ExceptionResult (fromError merr), iworld)
= (ValueResult
NoValue
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCBasic taskId ts (DeferredJSONNode $ JSONString "") False)
, iworld)
_ = (exc "This tty was already open", iworld)
withTTY f iworld
# (mtty, iworld) = getResource iworld
= case mtty of
[] = (exc "This tty was already closed", iworld)
[_,_:_] = (exc "Multiple matching resources", iworld)
[tty] = f tty iworld
eval acc DestroyEvent evalOpts
= withTTY \(TTYd _ tty) iworld
# (ok, iworld) = liftIWorld (TTYclose tty) iworld
| not ok = (exc "Couldn't close device", iworld)
= (DestroyedResult, iworld)
eval _ _ TCNop iworld
= (ValueResult (Value () True)
{TaskEvalInfo|lastEvent=0,removedTasks=[],attributes=newMap}
rep TCNop, iworld)
eval _ _ tree=:(TCBasic taskId ts (DeferredJSONNode (JSONString acc)) _) iworld
# (mtty, iworld) = getResource iworld
= case mtty of
[] = (exc"TTY resource lost", iworld)
[_,_:_] = (exc "Multiple matching resources", iworld)
[TTYd dp tty]
eval acc event evalOpts=:{taskId,lastEval}
= withTTY \(TTYd dp tty) iworld
# (merr, iworld) = readRegister taskId ticker iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
//TODO Keep async in mind
......@@ -68,14 +58,9 @@ where
= case fromOk merr of
//We need to stop
ReadingDone (_,_,True)
# (ok, world) = TTYclose tty iworld.world
# iworld & world = world
# (ok, iworld) = liftIWorld (TTYclose tty) iworld
| not ok = (exc "Couldn't close device", iworld)
= (ValueResult
(Value () True)
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
TCNop, iworld)
= (ValueResult NoValue (mkTaskEvalInfo lastEval) NoChange (return ()), iworld)
ReadingDone (r,s,ss)
# tty = foldr TTYwrite tty $ reverse $ map enc s
# (merr, tty) = readWhileAvailable tty
......@@ -91,14 +76,16 @@ where
| isError merr = (ExceptionResult (fromError merr), iworld)
= (ValueResult
NoValue
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCBasic taskId ts (DeferredJSONNode $ JSONString newacc) False)
(mkTaskEvalInfo lastEval)
(mkUIIfReset event $ stringDisplay $ "Serial client" <+++ opts.devicePath)
(Task (eval newacc))
, iworld)
rep = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
ticker = sdsFocus {start=zero,interval=poll} iworldTimespec
getResource = iworldResource (\t=:(TTYd p _)->(p == opts.devicePath, t))
exc :: (String -> TaskResult ())
exc = ExceptionResult o exception
readWhileAvailable :: !*TTY -> (MaybeError String [Char], !*TTY)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment