Commit 98f0b213 authored by Mart Lubbers's avatar Mart Lubbers

rewrite task

parent 3dbc3850
Pipeline #28595 passed with stage
in 3 minutes and 21 seconds
......@@ -7,6 +7,7 @@ import Data.Func
import Text
import iTasks
import iTasks.Internal.Util
import iTasks.Internal.IWorld
import iTasks.Internal.SDS
import iTasks.Internal.TaskEval
......@@ -19,84 +20,77 @@ 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)
evalinit DestroyEvent evalOpts iworld
= (DestroyedResult, iworld)
evalinit event evalOpts=:{TaskEvalOpts|taskId,ts} iworld=:{IWorld|resources,world}
# (mtty, iworld=:{world,resources}) = getResource iworld
= case mtty of
[] = case liftIWorld ((\(a, b, c)->((a, b), c)) o (TTYopen opts)) iworld of
((False, _), iworld)
# (err, iworld) = liftIWorld TTYerror iworld
= (exc err, iworld)
((True, tty), iworld)
= eval "" event evalOpts iworld
_ = (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)
eval acc DestroyEvent evalOpts iworld=:{IWorld|resources}
# (mtty, iworld) = getResource iworld
= case mtty of
[] = (exc "This tty was already closed", iworld)
[_,_:_] = (exc "Multiple matching resources", iworld)
[TTYd _ tty]
# (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]
# (merr, iworld) = readRegister taskId ticker iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
//TODO Keep async in mind
# (merr, iworld) = read rw EmptyContext iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
= case fromOk merr of
//We need to stop
ReadingDone (_,_,True)
# (ok, world) = TTYclose tty iworld.world
# iworld & world = world
| not ok = (exc "Couldn't close device", iworld)
= (ValueResult
(Value () True)
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
TCNop, iworld)
ReadingDone (r,s,ss)
# tty = foldr TTYwrite tty $ reverse $ map enc s
# (merr, tty) = readWhileAvailable tty
| isError merr = (exc (fromError merr), iworld)
# iworld = {iworld & resources=[TTYd dp tty:iworld.resources]}
= case dec (acc +++ toString (fromOk merr)) of
(Left err, newacc) = (exc ("Error while parsing: " +++ join " " [toString (toInt c)\\c<-:acc+toString (fromOk merr)]), iworld)
(Right msgs, newacc)
# (merr, iworld) = if (msgs =: [] && s =: [])
(Ok WritingDone, iworld)
//TODO Keep async in mind
(write (r++msgs, [], False) rw EmptyContext iworld)
| isError merr = (ExceptionResult (fromError merr), iworld)
eval acc event evalOpts=:{TaskEvalOpts|taskId,ts} iworld
//TODO Check whether the event is for us
# (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
| isError merr = (ExceptionResult (fromError merr), iworld)
//TODO Keep async in mind
# (merr, iworld) = read rw EmptyContext iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
= case fromOk merr of
//We need to stop
ReadingDone (_,_,True)
# (ok, iworld) = liftIWorld (TTYclose tty) iworld
| not ok = (exc "Couldn't close device", iworld)
= (ValueResult
NoValue
(Value () True)
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCBasic taskId ts (DeferredJSONNode $ JSONString newacc) False)
, iworld)
(rep event)
(return ())
, iworld)
ReadingDone (r,s,ss)
# tty = foldr TTYwrite tty $ reverse $ map enc s
# (merr, tty) = readWhileAvailable tty
| isError merr = (exc (fromError merr), iworld)
# iworld = {iworld & resources=[TTYd dp tty:iworld.resources]}
= case dec (acc +++ toString (fromOk merr)) of
(Left err, newacc) = (exc ("Error while parsing: " +++ join " " [toString (toInt c)\\c<-:acc+toString (fromOk merr)]), iworld)
(Right msgs, newacc)
# (merr, iworld) = if (msgs =: [] && s =: [])
(Ok WritingDone, iworld)
//TODO Keep async in mind
(write (r++msgs, [], False) rw EmptyContext iworld)
| isError merr = (ExceptionResult (fromError merr), iworld)
= (ValueResult
NoValue
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
(rep event)
(Task (eval newacc))
, iworld)
rep ResetEvent = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
rep _ = NoChange
rep = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
ticker = sdsFocus {start=zero,interval=poll} iworldTimespec
getResource = iworldResource (\t=:(TTYd p _)->(p == opts.devicePath, t))
exc = ExceptionResult o exception
......
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