Skip to content
Snippets Groups Projects
Commit 98f0b213 authored by Mart Lubbers's avatar Mart Lubbers
Browse files

rewrite task

parent 3dbc3850
No related branches found
No related tags found
No related merge requests found
Pipeline #28595 passed
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment