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 implementation module iTasksTTY
import Data.Tuple
import StdEnv import StdEnv
from Data.Map import :: Map, newMap from Data.Map import :: Map, newMap
...@@ -9,6 +10,8 @@ import Text ...@@ -9,6 +10,8 @@ import Text
import iTasks import iTasks
import iTasks.Internal.IWorld import iTasks.Internal.IWorld
import iTasks.Internal.SDS import iTasks.Internal.SDS
import iTasks.Internal.Util
import iTasks.Internal.Task
import iTasks.Internal.TaskEval import iTasks.Internal.TaskEval
import iTasks.Internal.TaskState import iTasks.Internal.TaskState
...@@ -19,47 +22,34 @@ import TTY ...@@ -19,47 +22,34 @@ import TTY
derive class iTask TTYSettings, Parity, BaudRate, ByteSize 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 :: 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 where
eval DestroyEvent evalOpts tree iworld=:{IWorld|resources,world} evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
# (mtty, iworld) = getResource iworld evalinit event evalOpts iworld
= case mtty of # (mtty, iworld=:{world,resources}) = getResource iworld
[] = (exc "This tty was already closed", iworld) = case mtty of
[_,_:_] = (exc "Multiple matching resources", iworld) [] = case TTYopen opts world of
[TTYd _ tty] (False, _, world)
# (ok, world) = TTYclose tty iworld.world = appFst exc $ liftIWorld TTYerror {iworld&world=world}
# iworld & world = world (True, tty, world)
| not ok = (exc "Couldn't close device", iworld) = eval "" event evalOpts {iworld&world=world,resources=[TTYd opts.devicePath tty:resources]}
= (DestroyedResult, iworld) _ = (exc "This tty was already open", iworld)
eval event evalOpts tree=:(TCInit taskId ts) iworld withTTY f iworld
# (mtty, iworld=:{world,resources}) = getResource iworld # (mtty, iworld) = getResource iworld
= case mtty of = case mtty of
[] = case TTYopen opts iworld.world of [] = (exc "This tty was already closed", iworld)
(False, _, world) [_,_:_] = (exc "Multiple matching resources", iworld)
# (err, world) = TTYerror world [tty] = f tty iworld
= (exc err, {iworld & world=world})
(True, tty, world) eval acc DestroyEvent evalOpts
# (merr, iworld) = readRegister taskId ticker {iworld & world=world, resources=[TTYd opts.devicePath tty:resources]} = withTTY \(TTYd _ tty) iworld
| isError merr = (ExceptionResult (fromError merr), iworld) # (ok, iworld) = liftIWorld (TTYclose tty) iworld
= (ValueResult | not ok = (exc "Couldn't close device", iworld)
NoValue = (DestroyedResult, iworld)
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCBasic taskId ts (DeferredJSONNode $ JSONString "") False)
, iworld)
_ = (exc "This tty was already open", iworld)
eval _ _ TCNop iworld eval acc event evalOpts=:{taskId,lastEval}
= (ValueResult (Value () True) = withTTY \(TTYd dp tty) iworld
{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]
# (merr, iworld) = readRegister taskId ticker iworld # (merr, iworld) = readRegister taskId ticker iworld
| isError merr = (ExceptionResult (fromError merr), iworld) | isError merr = (ExceptionResult (fromError merr), iworld)
//TODO Keep async in mind //TODO Keep async in mind
...@@ -68,14 +58,9 @@ where ...@@ -68,14 +58,9 @@ where
= case fromOk merr of = case fromOk merr of
//We need to stop //We need to stop
ReadingDone (_,_,True) ReadingDone (_,_,True)
# (ok, world) = TTYclose tty iworld.world # (ok, iworld) = liftIWorld (TTYclose tty) iworld
# iworld & world = world
| not ok = (exc "Couldn't close device", iworld) | not ok = (exc "Couldn't close device", iworld)
= (ValueResult = (ValueResult NoValue (mkTaskEvalInfo lastEval) NoChange (return ()), iworld)
(Value () True)
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
TCNop, iworld)
ReadingDone (r,s,ss) ReadingDone (r,s,ss)
# tty = foldr TTYwrite tty $ reverse $ map enc s # tty = foldr TTYwrite tty $ reverse $ map enc s
# (merr, tty) = readWhileAvailable tty # (merr, tty) = readWhileAvailable tty
...@@ -91,14 +76,16 @@ where ...@@ -91,14 +76,16 @@ where
| isError merr = (ExceptionResult (fromError merr), iworld) | isError merr = (ExceptionResult (fromError merr), iworld)
= (ValueResult = (ValueResult
NoValue NoValue
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap} (mkTaskEvalInfo lastEval)
rep (mkUIIfReset event $ stringDisplay $ "Serial client" <+++ opts.devicePath)
(TCBasic taskId ts (DeferredJSONNode $ JSONString newacc) False) (Task (eval newacc))
, iworld) , iworld)
rep = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
ticker = sdsFocus {start=zero,interval=poll} iworldTimespec ticker = sdsFocus {start=zero,interval=poll} iworldTimespec
getResource = iworldResource (\t=:(TTYd p _)->(p == opts.devicePath, t)) getResource = iworldResource (\t=:(TTYd p _)->(p == opts.devicePath, t))
exc :: (String -> TaskResult ())
exc = ExceptionResult o exception exc = ExceptionResult o exception
readWhileAvailable :: !*TTY -> (MaybeError String [Char], !*TTY) 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