Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Mart Lubbers
CleanSerial
Commits
3820fba8
Commit
3820fba8
authored
Mar 19, 2018
by
Mart Lubbers
Browse files
Update to latest greatest mTask
parent
7ebd3e6b
Changes
2
Hide whitespace changes
Inline
Side-by-side
iTasksTTY.dcl
View file @
3820fba8
...
@@ -9,4 +9,4 @@ getTTYDevices :: !*env -> *(![String], !*env)
...
@@ -9,4 +9,4 @@ getTTYDevices :: !*env -> *(![String], !*env)
enterTTYSettings
::
Task
TTYSettings
enterTTYSettings
::
Task
TTYSettings
syncSerialChannel
::
TTYSettings
(
b
->
String
)
(
String
->
a
)
(
Shared
([
a
],[
b
],
Bool
))
->
Task
()
|
iTask
a
&
iTask
b
syncSerialChannel
::
TTYSettings
(
b
->
String
)
(
String
->
(
Either
String
[
a
],
String
)
)
(
Shared
([
a
],[
b
],
Bool
))
->
Task
()
|
iTask
a
&
iTask
b
iTasksTTY.icl
View file @
3820fba8
...
@@ -68,10 +68,10 @@ where
...
@@ -68,10 +68,10 @@ where
liftWorld
f
=
\
iw
=:{
world
}->{
iw
&
world
=
f
world
}
liftWorld
f
=
\
iw
=:{
world
}->{
iw
&
world
=
f
world
}
syncSerialChannel
::
TTYSettings
(
b
->
String
)
(
String
->
a
)
(
Shared
([
a
],[
b
],
Bool
))
->
Task
()
|
iTask
a
&
iTask
b
syncSerialChannel
::
TTYSettings
(
b
->
String
)
(
String
->
(
Either
String
[
a
],
String
)
)
(
Shared
([
a
],[
b
],
Bool
))
->
Task
()
|
iTask
a
&
iTask
b
syncSerialChannel
opts
enc
dec
rw
=
Task
eval
syncSerialChannel
opts
enc
dec
rw
=
withShared
""
\
sh
->
Task
$
eval
sh
where
where
eval
event
evalOpts
tree
=:(
TCInit
taskId
ts
)
iworld
eval
sh
event
evalOpts
tree
=:(
TCInit
taskId
ts
)
iworld
#
(
mtty
,
iworld
)
=
getTTYResource
opts
.
devicePath
iworld
#
(
mtty
,
iworld
)
=
getTTYResource
opts
.
devicePath
iworld
=
case
mtty
of
=
case
mtty
of
Just
(
tty
,
_)
=
(
ExceptionResult
(
exception
"This tty was already open"
),
iworld
)
Just
(
tty
,
_)
=
(
ExceptionResult
(
exception
"This tty was already open"
),
iworld
)
...
@@ -81,15 +81,15 @@ syncSerialChannel opts enc dec rw = Task eval
...
@@ -81,15 +81,15 @@ syncSerialChannel opts enc dec rw = Task eval
=
(
ExceptionResult
(
exception
err
),
{
iworld
&
world
=
world
})
=
(
ExceptionResult
(
exception
err
),
{
iworld
&
world
=
world
})
(
True
,
tty
,
world
)
(
True
,
tty
,
world
)
#
iworld
=
{
iworld
&
world
=
world
}
#
iworld
=
{
iworld
&
world
=
world
}
=
case
addBackgroundTask
(
BackgroundTask
(
serialDeviceBackgroundTask
opts
.
devicePath
enc
dec
rw
))
iworld
of
=
case
addBackgroundTask
(
BackgroundTask
(
serialDeviceBackgroundTask
opts
.
devicePath
enc
dec
sh
rw
))
iworld
of
(
Error
e
,
iworld
)
=
(
ExceptionResult
(
exception
"background task couldn't be added"
),
iworld
)
(
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
),
(
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
]})
{
iworld
&
resources
=[
TTYd
(
opts
.
devicePath
,
bgid
,
tty
):
iworld
.
resources
]})
eval
_
_
tree
=:(
TCBasic
_
ts
_
_)
iworld
eval
_
_
_
tree
=:(
TCBasic
_
ts
_
_)
iworld
=
(
ValueResult
NoValue
{
TaskEvalInfo
|
lastEvent
=
ts
,
removedTasks
=[],
refreshSensitive
=
False
}
rep
tree
,
iworld
)
=
(
ValueResult
NoValue
{
TaskEvalInfo
|
lastEvent
=
ts
,
removedTasks
=[],
refreshSensitive
=
False
}
rep
tree
,
iworld
)
eval
event
evalOpts
tree
=:(
TCDestroy
_)
iworld
=:{
IWorld
|
resources
,
world
}
eval
_
event
evalOpts
tree
=:(
TCDestroy
_)
iworld
=:{
IWorld
|
resources
,
world
}
#
(
mtty
,
iworld
)
=
getTTYResource
opts
.
devicePath
iworld
#
(
mtty
,
iworld
)
=
getTTYResource
opts
.
devicePath
iworld
=
case
mtty
of
=
case
mtty
of
Nothing
=
(
ExceptionResult
(
exception
"This tty was already closed"
),
iworld
)
Nothing
=
(
ExceptionResult
(
exception
"This tty was already closed"
),
iworld
)
...
@@ -102,7 +102,6 @@ syncSerialChannel opts enc dec rw = Task eval
...
@@ -102,7 +102,6 @@ syncSerialChannel opts enc dec rw = Task eval
rep
=
ReplaceUI
$
stringDisplay
$
"Serial client "
<+++
opts
.
devicePath
rep
=
ReplaceUI
$
stringDisplay
$
"Serial client "
<+++
opts
.
devicePath
import
StdDebug
,
StdMisc
/*
/*
* The actual backgroundtask synchronizing the device
* The actual backgroundtask synchronizing the device
*
*
...
@@ -113,8 +112,8 @@ import StdDebug, StdMisc
...
@@ -113,8 +112,8 @@ import StdDebug, StdMisc
* @param IWorld
* @param IWorld
* @return Maybe an exception
* @return Maybe an exception
*/
*/
serialDeviceBackgroundTask
::
String
(
b
->
String
)
(
String
->
a
)
(
Shared
([
a
],[
b
],
Bool
))
!*
IWorld
->
(
MaybeError
TaskException
(),
*
IWorld
)
|
iTask
a
&
iTask
b
serialDeviceBackgroundTask
::
String
(
b
->
String
)
(
String
->
(
Either
String
[
a
],
String
))
(
Shared
String
)
(
Shared
([
a
],[
b
],
Bool
))
!*
IWorld
->
(
MaybeError
TaskException
(),
*
IWorld
)
|
iTask
a
&
iTask
b
serialDeviceBackgroundTask
dp
enc
dec
rw
iworld
serialDeviceBackgroundTask
dp
enc
dec
accShare
rw
iworld
=
case
read
rw
iworld
of
=
case
read
rw
iworld
of
(
Error
e
,
iworld
)
=
(
Error
$
exception
"share couldn't be read"
,
iworld
)
(
Error
e
,
iworld
)
=
(
Error
$
exception
"share couldn't be read"
,
iworld
)
...
@@ -122,16 +121,29 @@ serialDeviceBackgroundTask dp enc dec rw iworld
...
@@ -122,16 +121,29 @@ serialDeviceBackgroundTask dp enc dec rw iworld
(
Ok
(_,_,
True
),
iworld
)
=
(
Ok
(),
iworld
)
(
Ok
(_,_,
True
),
iworld
)
=
(
Ok
(),
iworld
)
(
Ok
(
r
,
s
,
ss
),
iworld
)
(
Ok
(
r
,
s
,
ss
),
iworld
)
#
(
merr
,
iworld
)
=
read
accShare
iworld
|
isError
merr
=
(
liftError
merr
,
iworld
)
#
(
Ok
acc
)
=
merr
#
(
mtty
,
iworld
)
=
getTTYResource
dp
iworld
#
(
mtty
,
iworld
)
=
getTTYResource
dp
iworld
=
case
mtty
of
=
case
mtty
of
Nothing
=
(
Error
(
exception
"The tty device is gone"
),
iworld
)
Nothing
=
(
Error
(
exception
"The tty device is gone"
),
iworld
)
Just
(
tty
,
bgid
)
Just
(
tty
,
bgid
)
#
tty
=
foldr
TTYwrite
tty
$
reverse
$
map
enc
s
#
tty
=
foldr
TTYwrite
tty
$
reverse
$
map
enc
s
#
(
ml
,
tty
)
=
case
TTYavailable
tty
of
#
(
newdata
,
tty
)
=
readWhileAvailable
tty
(
False
,
tty
)
=
([],
tty
)
(_,
tty
)
=
appFst
(
pure
o
dec
)
$
TTYreadline
tty
#
iworld
=
{
iworld
&
resources
=[
TTYd
(
dp
,
bgid
,
tty
):
iworld
.
resources
]}
#
iworld
=
{
iworld
&
resources
=[
TTYd
(
dp
,
bgid
,
tty
):
iworld
.
resources
]}
|
isEmpty
ml
&&
isEmpty
s
=
(
Ok
(),
iworld
)
=
case
dec
(
acc
+++
newdata
)
of
#
(
merr
,
iworld
)
=
notify
rw
iworld
(
Left
err
,
newacc
)
=
(
Error
(
exception
"Error while parsing"
),
iworld
)
|
isError
merr
=
(
Error
$
fromError
merr
,
iworld
)
(
Right
msgs
,
newacc
)
=
write
(
r
++
ml
,[],
False
)
rw
iworld
#
(
merr
,
iworld
)
=
if
(
msgs
=:
[])
(
Ok
(),
iworld
)
(
write
(
r
++
msgs
,
[],
False
)
rw
iworld
)
|
isError
merr
=
(
liftError
merr
,
iworld
)
=
write
newacc
accShare
iworld
readWhileAvailable
::
!*
TTY
->
(
String
,
!*
TTY
)
readWhileAvailable
tty
#
(
available
,
tty
)
=
TTYavailable
tty
|
not
available
=
(
""
,
tty
)
#
(
c
,
tty
)
=
TTYread
tty
#
(
cs
,
tty
)
=
readWhileAvailable
tty
=
(
toString
(
toChar
c
)
+++
cs
,
tty
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment