Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
C
CleanSerial
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Mart Lubbers
CleanSerial
Commits
98f0b213
Commit
98f0b213
authored
5 years ago
by
Mart Lubbers
Browse files
Options
Downloads
Patches
Plain Diff
rewrite task
parent
3dbc3850
No related branches found
No related tags found
No related merge requests found
Pipeline
#28595
passed
5 years ago
Stage: test
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/iTasksTTY.icl
+65
-71
65 additions, 71 deletions
src/iTasksTTY.icl
with
65 additions
and
71 deletions
src/iTasksTTY.icl
+
65
−
71
View file @
98f0b213
...
...
@@ -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
eval
init
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
No
Value
(
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
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment