Commit c709ac65 authored by Mart Lubbers's avatar Mart Lubbers

Add monitor example with list resources

parent a2879bc9
......@@ -3,3 +3,5 @@ TTY
sapl
TTY.prj
test
*-sapl
*-www
......@@ -12,7 +12,7 @@ endif
Clean\ System\ Files/ctty.o: tty.c
mkdir -p Clean\ System\ Files
ifeq "$(GCCVERSIONGTEQ6)" "1"
gcc-5 -c $< -o "$@"
gcc -c $< -o "$@"
else
gcc -c $< -o "$@"
endif
......
File added
module Monitor
import iTasks
import iTasksTTY
import StdTuple
Start w = startEngine monitor w
monitor :: Task ()
monitor = enterTTYSettings <<@ ApplyLayout frameCompact
>>! \ts->withShared ([], [], False) \channels->
syncSerialChannel ts id id channels
||- viewSharedInformation "Incoming messages" [ViewAs (take 20 o fst3)] channels
||- forever (
enterInformation "Send line of text" []
>>= \line->upd (\(r,w,s)->(r,w++[line+++"\n"],s)) channels
)
@! ()
This diff is collapsed.
......@@ -18,12 +18,14 @@ from Text import class Text(startsWith), instance Text String
import iTasks.UI.Definition
import iTasks._Framework.TaskState
import iTasks._Framework.TaskServer
import iTasks._Framework.IWorld
import iTasks._Framework.Store
import iTasks.Internal.IWorld
import iTasks.Internal.TaskState
import iTasks.Internal.Task
import iTasks.Internal.SDS
import iTasks.Internal.TaskServer
import iTasks.Internal.TaskEval
:: *Resource | TTYd *[*(String,Int,!*TTY)]
:: *Resource | TTYd *(String, Int, *TTY)
derive class iTask TTYSettings, Parity, BaudRate, ByteSize
......@@ -51,62 +53,85 @@ enterTTYSettings = accWorld getTTYDevices
<<@ ArrangeHorizontal)
@ \((dev, br), ((bs, pr), (st, xo)))->makeTTYSettings dev br bs pr st xo
getTTYResource :: String *IWorld -> (Maybe *(*TTY, Int), *IWorld)
getTTYResource dp iw=:{resources}
# (mt, resources) = getTTYResource` resources
= (mt, {iw & resources=resources})
where
getTTYResource` :: *[*Resource] -> (Maybe *(*TTY, Int), *[*Resource])
getTTYResource` [] = (Nothing, [])
getTTYResource` [TTYd (dpath, bgid, tty):xs]
| dpath == dp = (Just (tty, bgid), xs)
getTTYResource` [x:xs]
# (mt, xs) = getTTYResource` xs
= (mt, [x:xs])
liftWorld f = \iw=:{world}->{iw & world=f world}
syncSerialChannel :: TTYSettings (b -> String) (String -> a) (Shared ([a],[b],Bool)) -> Task () | iTask a & iTask b
syncSerialChannel opts enc dec rw = Task eval
where
eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world,ioTasks={todo}}
= case TTYopen opts world of
(False, _, world)
# (err, world) = TTYerror world
= (ExceptionResult (exception err), {iworld & world=world})
(True, tty, world)
# iworld = {iworld & world=world}
= case addBackgroundTask (BackgroundTask (serialDeviceBackgroundTask opts.devicePath enc dec rw)) iworld of
(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
(Ok bgid, iworld) = case iworld.resources of
Nothing = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep (TCBasic taskId ts JSONNull False),
{iworld & resources=Just $ TTYd [(opts.devicePath, bgid, tty)]})
Just (TTYd m) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep (TCBasic taskId ts JSONNull False),
{iworld & resources=Just $ TTYd [(opts.devicePath, bgid, tty):m]})
eval event evalOpts tree=:(TCInit taskId ts) iworld
# (mtty, iworld) = getTTYResource opts.devicePath iworld
= case mtty of
Just (tty, _) = (ExceptionResult (exception "This tty was already open"), iworld)
Nothing = case TTYopen opts iworld.world of
(False, _, world)
# (err, world) = TTYerror world
= (ExceptionResult (exception err), {iworld & world=world})
(True, tty, world)
# iworld = {iworld & world=world}
= case addBackgroundTask (BackgroundTask (serialDeviceBackgroundTask opts.devicePath enc dec rw)) iworld of
(Error e, iworld) = (ExceptionResult (exception "background task couldn't be added"), iworld)
(Ok bgid, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep (TCBasic taskId ts JSONNull False),
{iworld & resources=[TTYd (opts.devicePath, bgid, tty):iworld.resources]})
eval _ _ tree=:(TCBasic _ ts _ _) iworld
= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} rep tree, iworld)
eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
# (Just (TTYd ttys)) = resources
# ((tty, bgid), ttys) = flt opts.devicePath ttys
# (ok, world) = TTYclose tty world
# iworld = {iworld & world=world,resources=Just $ TTYd ttys}
= case removeBackgroundTask bgid iworld of
(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
(Ok _, iworld) = (DestroyedResult, iworld)
# (mtty, iworld) = getTTYResource opts.devicePath iworld
= case mtty of
Nothing = (ExceptionResult (exception "This tty was already closed"), iworld)
Just (tty, bgid)
# (ok, world) = TTYclose tty iworld.world
# iworld = {iworld & world=world}
= case removeBackgroundTask bgid iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
(Ok _, iworld) = (DestroyedResult, iworld)
rep = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
flt :: String [(String, Int, *TTY)] -> ((*TTY, Int), [(String, Int, *TTY)])
flt m [] = abort "not found"
flt m [(p,b,t):ps]
| p == m = ((t, b), ps)
# (tty, pps) = flt m ps
= (tty, [(p,b,t):pps])
import StdDebug, StdMisc
/*
* The actual backgroundtask synchronizing the device
*
* @param Device path
* @param encoding function
* @param decoding function
* @param shared channels
* @param IWorld
* @return Maybe an exception
*/
serialDeviceBackgroundTask :: String (b -> String) (String -> a) (Shared ([a],[b],Bool)) !*IWorld -> (MaybeError TaskException (), *IWorld) | iTask a & iTask b
serialDeviceBackgroundTask dp enc dec rw iworld
= case read rw iworld of
(Error e, iworld) = (Error $ exception "share couldn't be read", iworld)
//We need to stop
(Ok (_,_,True), iworld) = (Ok (), iworld)
(Ok (r,s,ss), iworld)
# (Just (TTYd ttys)) = iworld.resources
# ((tty, bgid), ttys) = flt dp ttys
# tty = foldr TTYwrite tty $ reverse $ map enc s
# (ml, tty) = case TTYavailable tty of
(False, tty) = ([], tty)
(_, tty) = appFst (pure o dec) $ TTYreadline tty
# iworld = {iworld & resources=Just (TTYd [(dp, bgid, tty):ttys])}
| isEmpty ml && isEmpty s = (Ok (), iworld)
# (merr, iworld) = notify rw iworld
| isError merr = (Error $ fromError merr, iworld)
= write (r++ml,[],False) rw iworld
# (mtty, iworld) = getTTYResource dp iworld
= case mtty of
Nothing = (Error (exception "The tty device is gone"), iworld)
Just (tty, bgid)
# tty = foldr TTYwrite tty $ reverse $ map enc s
# (ml, tty) = case TTYavailable tty of
(False, tty) = ([], tty)
(_, tty) = appFst (pure o dec) $ TTYreadline tty
# iworld = {iworld & resources=[TTYd (dp, bgid, tty):iworld.resources]}
| isEmpty ml && isEmpty s = (Ok (), iworld)
# (merr, iworld) = notify rw iworld
| isError merr = (Error $ fromError merr, iworld)
= write (r++ml,[],False) rw iworld
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