Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
I
iTasks-SDK
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
82
Issues
82
List
Boards
Labels
Service Desk
Milestones
Merge Requests
10
Merge Requests
10
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
iTasks-SDK
Commits
ed6b941f
Commit
ed6b941f
authored
Apr 15, 2019
by
Bas Lijnse
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'master' into modernize-html-and-css
parents
65e21dc4
d350142a
Pipeline
#21201
passed with stage
in 4 minutes and 49 seconds
Changes
12
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
234 additions
and
248 deletions
+234
-248
Libraries/iTasks/Engine.dcl
Libraries/iTasks/Engine.dcl
+1
-0
Libraries/iTasks/Engine.icl
Libraries/iTasks/Engine.icl
+4
-0
Libraries/iTasks/Internal/Client/RunOnClient.icl
Libraries/iTasks/Internal/Client/RunOnClient.icl
+2
-0
Libraries/iTasks/Internal/IWorld.dcl
Libraries/iTasks/Internal/IWorld.dcl
+22
-19
Libraries/iTasks/Internal/IWorld.icl
Libraries/iTasks/Internal/IWorld.icl
+2
-0
Libraries/iTasks/Internal/TaskServer.icl
Libraries/iTasks/Internal/TaskServer.icl
+26
-2
Libraries/iTasks/Internal/WebService.icl
Libraries/iTasks/Internal/WebService.icl
+6
-2
Libraries/iTasks/Util/Testing.icl
Libraries/iTasks/Util/Testing.icl
+2
-2
Libraries/iTasks/WF/Tasks/Core.dcl
Libraries/iTasks/WF/Tasks/Core.dcl
+8
-9
Libraries/iTasks/WF/Tasks/Core.icl
Libraries/iTasks/WF/Tasks/Core.icl
+143
-196
Libraries/iTasks/WF/Tasks/Interaction.icl
Libraries/iTasks/WF/Tasks/Interaction.icl
+17
-17
Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl
Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl
+1
-1
No files found.
Libraries/iTasks/Engine.dcl
View file @
ed6b941f
...
...
@@ -63,6 +63,7 @@ instance Startable (a,b) | Startable a & Startable b
,
appVersion
::
String
,
serverPort
::
Int
,
serverUrl
::
String
,
allowedHosts
::
[
String
]
// Only allow connections from these hosts (default ["127.0.0.1"])
,
keepaliveTime
::
Timespec
,
sessionTime
::
Timespec
,
persistTasks
::
Bool
...
...
Libraries/iTasks/Engine.icl
View file @
ed6b941f
...
...
@@ -108,6 +108,9 @@ where
(
"Specify the HTTP port (default: "
+++
toString
defaults
.
serverPort
+++
")"
)
,
Option
[]
[
"timeout"
]
(
OptArg
(\
mp
->
fmap
\
o
->{
o
&
timeout
=
fmap
toInt
mp
})
"MILLISECONDS"
)
"Specify the timeout in ms (default: 500)
\n
If not given, use an indefinite timeout."
,
Option
[]
[
"allowed-hosts"
]
(
ReqArg
(\
p
->
fmap
\
o
->{
o
&
allowedHosts
=
split
","
p
})
"IPADRESSES"
)
(
"Specify a comma separated white list of hosts that are allowed to connected to this application
\n
default: "
+++
join
","
defaults
.
allowedHosts
)
,
Option
[]
[
"keepalive"
]
(
ReqArg
(\
p
->
fmap
\
o
->{
o
&
keepaliveTime
={
tv_sec
=
toInt
p
,
tv_nsec
=
0
}})
"SECONDS"
)
"Specify the keepalive time in seconds (default: 300)"
,
Option
[]
[
"maxevents"
]
(
ReqArg
(\
p
->
fmap
\
o
->{
o
&
maxEvents
=
toInt
p
})
"NUM"
)
...
...
@@ -203,6 +206,7 @@ defaultEngineOptions world
,
appVersion
=
appVersion
,
serverPort
=
IF_POSIX_OR_WINDOWS
8080
80
,
serverUrl
=
"http://localhost/"
,
allowedHosts
=
[
"127.0.0.1"
]
,
keepaliveTime
=
{
tv_sec
=
300
,
tv_nsec
=
0
}
// 5 minutes
,
sessionTime
=
{
tv_sec
=
60
,
tv_nsec
=
0
}
// 1 minute, (the client pings every 10 seconds by default)
,
persistTasks
=
False
...
...
Libraries/iTasks/Internal/Client/RunOnClient.icl
View file @
ed6b941f
...
...
@@ -126,6 +126,7 @@ createClientIWorld serverURL currentInstance
,
appVersion
=
locundef
"appVersion"
,
serverPort
=
80
,
serverUrl
=
locundef
"serverUrl"
,
allowedHosts
=
[]
,
keepaliveTime
=
locundef
"keepaliveTime"
,
sessionTime
=
locundef
"sessionTime"
,
persistTasks
=
False
...
...
@@ -158,6 +159,7 @@ createClientIWorld serverURL currentInstance
,
ioTasks
=
{
done
=[],
todo
=[]}
,
ioStates
=
'
Data
.
Map
'.
newMap
,
world
=
world
,
signalHandlers
=
[]
,
resources
=
[]
,
onClient
=
True
}
...
...
Libraries/iTasks/Internal/IWorld.dcl
View file @
ed6b941f
...
...
@@ -21,6 +21,7 @@ from iTasks.Internal.SDS import :: SDSNotifyRequest, :: DeferredWrite, :: SDSIde
from
iTasks
.
SDS
.
Definition
import
::
SDSSource
,
::
SDSLens
,
::
SDSParallel
,
class
RWShared
,
class
Registrable
,
class
Modifiable
,
class
Identifiable
,
class
Readable
,
class
Writeable
from
iTasks
.
Extensions
.
DateTime
import
::
Time
,
::
Date
,
::
DateTime
from
System
.
Signal
import
::
SigHandler
from
Sapl
.
Linker
.
LazyLinker
import
::
LoaderState
from
Sapl
.
Linker
.
SaplLinkerShared
import
::
LineType
,
::
FuncTypeMap
from
Sapl
.
Target
.
Flavour
import
::
Flavour
...
...
@@ -29,30 +30,32 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC
CLEAN_HOME_VAR
:==
"CLEAN_HOME"
::
*
IWorld
=
{
options
::
!
EngineOptions
// Engine configuration
,
clock
::
!
Timespec
// Server side clock
,
current
::
!
TaskEvalState
// Shared state during task evaluation
::
*
IWorld
=
{
options
::
!
EngineOptions
// Engine configuration
,
clock
::
!
Timespec
// Server side clock
,
current
::
!
TaskEvalState
// Shared state during task evaluation
,
random
::
[
Int
]
// Infinite random stream
,
random
::
[
Int
]
// Infinite random stream
,
sdsNotifyRequests
::
!
Map
SDSIdentity
(
Map
SDSNotifyRequest
Timespec
)
// Notification requests from previously read sds's
,
sdsNotifyReqsByTask
::
!
Map
TaskId
(
Set
SDSIdentity
)
// Allows to efficiently find notification by taskID for clearing notifications
,
memoryShares
::
!
Map
String
Dynamic
// Run-time memory shares
,
readCache
::
!
Map
(
String
,
String
)
Dynamic
// Cached share reads
,
writeCache
::
!
Map
(
String
,
String
)
(
Dynamic
,
DeferredWrite
)
// Cached deferred writes
,
jsCompilerState
::
!
Maybe
JSCompilerState
// Sapl to Javascript compiler state
,
sdsNotifyRequests
::
!
Map
SDSIdentity
(
Map
SDSNotifyRequest
Timespec
)
// Notification requests from previously read sds's
,
sdsNotifyReqsByTask
::
!
Map
TaskId
(
Set
SDSIdentity
)
// Allows to efficiently find notification by taskID for clearing notifications
,
memoryShares
::
!
Map
String
Dynamic
// Run-time memory shares
,
readCache
::
!
Map
(
String
,
String
)
Dynamic
// Cached share reads
,
writeCache
::
!
Map
(
String
,
String
)
(
Dynamic
,
DeferredWrite
)
// Cached deferred writes
,
jsCompilerState
::
!
Maybe
JSCompilerState
// Sapl to Javascript compiler state
,
ioTasks
::
!*
IOTasks
// The low-level input/output tasks
,
ioStates
::
!
IOStates
// Results of low-level io tasks, indexed by the high-level taskid that it is linked to
,
sdsEvalStates
::
!
SDSEvalStates
,
ioTasks
::
!*
IOTasks
// The low-level input/output tasks
,
ioStates
::
!
IOStates
// Results of low-level io tasks, indexed by the high-level taskid that it is linked to
,
sdsEvalStates
::
!
SDSEvalStates
,
world
::
!*
World
// The outside world
,
signalHandlers
::
*[*
SigHandler
]
// Signal handlers
,
world
::
!*
World
// The outside world
//Experimental database connection cache
,
resources
::
*[*
Resource
]
,
onClient
::
!
Bool
// "False" on the server, "True" on the client
,
shutdown
::
!
Maybe
Int
// Signals the server function to shut down, the int will be set as exit code
}
//Experimental database connection cache
,
resources
::
*[*
Resource
]
,
onClient
::
!
Bool
// "False" on the server, "True" on the client
,
shutdown
::
!
Maybe
Int
// Signals the server function to shut down, the int will be set as exit code
}
::
JSCompilerState
=
{
loaderState
::
!
LoaderState
// State of the lazy loader
...
...
Libraries/iTasks/Internal/IWorld.icl
View file @
ed6b941f
...
...
@@ -24,6 +24,7 @@ from StdOrdList import sortBy
from
TCPIP
import
::
TCP_Listener
,
::
TCP_Listener_
,
::
TCP_RChannel_
,
::
TCP_SChannel_
,
::
TCP_DuplexChannel
,
::
DuplexChannel
,
::
IPAddress
,
::
ByteSeq
import
System
.
Time
,
StdList
,
Text
.
Encodings
.
Base64
,
_SystemArray
,
StdBool
,
StdTuple
,
Text
.
GenJSON
,
Data
.
Error
,
Math
.
Random
import
System
.
Signal
import
iTasks
.
Internal
.
TaskStore
,
iTasks
.
Internal
.
Util
import
iTasks
.
Internal
.
Serialization
import
iTasks
.
Internal
.
SDS
...
...
@@ -84,6 +85,7 @@ createIWorld options world
,
ioStates
=
'
DM
'.
newMap
,
sdsEvalStates
=
'
DM
'.
newMap
,
world
=
world
,
signalHandlers
=
[]
,
resources
=
[]
,
random
=
genRandInt
seed
,
onClient
=
False
...
...
Libraries/iTasks/Internal/TaskServer.icl
View file @
ed6b941f
...
...
@@ -6,6 +6,7 @@ import Data.Tuple
import
StdEnv
import
System
.
CommandLine
import
System
.
Time
import
System
.
Signal
import
TCPIP
import
Text
import
iTasks
.
Engine
...
...
@@ -31,6 +32,7 @@ serve its cts determineTimeout iworld
init
::
![
StartupTask
]
![(!
Int
,!
ConnectionTask
)]
!*
IWorld
->
*
IWorld
init
its
cts
iworld
#
iworld
=
installSignalHandlers
iworld
// Check if the initial tasks have been added already
#
iworld
=
createInitialInstances
its
iworld
// All persistent task instances should receive a reset event to continue their work
...
...
@@ -67,13 +69,23 @@ where
#
opts
=
{
ListenerInstanceOpts
|
taskId
=
TaskId
0
0
,
port
=
port
,
connectionTask
=
ct
,
removeOnClose
=
True
}
=
(
ListenerInstance
opts
(
fromJust
mbListener
),
world
)
installSignalHandlers
iworld
=:{
signalHandlers
,
world
}
=
case
signalInstall
SIGTERM
world
of
(
Error
(_,
e
),
world
)
=
abort
(
"Couldn't install SIGTERM: "
+++
e
)
(
Ok
h1
,
world
)
=
case
signalInstall
SIGINT
world
of
(
Error
(_,
e
),
world
)
=
abort
(
"Couldn't install SIGINT: "
+++
e
)
(
Ok
h2
,
world
)
=
{
iworld
&
signalHandlers
=[
h1
,
h2
:
signalHandlers
],
world
=
world
}
loop
::
!(*
IWorld
->
(!
Maybe
Timeout
,!*
IWorld
))
!*
IWorld
->
*
IWorld
loop
determineTimeout
iworld
=:{
ioTasks
,
sdsNotifyRequests
}
loop
determineTimeout
iworld
=:{
ioTasks
,
sdsNotifyRequests
,
signalHandlers
}
// Also put all done tasks at the end of the todo list, as the previous event handling may have yielded new tasks.
#
(
mbTimeout
,
iworld
=:{
IWorld
|
ioTasks
={
todo
},
world
})
=
determineTimeout
{
iworld
&
ioTasks
=
{
done
=[],
todo
=
ioTasks
.
todo
++
(
reverse
ioTasks
.
done
)}}
//Check which mainloop tasks have data available
#
(
todo
,
chList
,
world
)
=
select
mbTimeout
todo
world
#
(
merr
,
iworld
)
=
updateClock
{
iworld
&
ioTasks
=
{
done
=[],
todo
=
todo
},
world
=
world
}
#
iworld
=
{
iworld
&
ioTasks
=
{
done
=[],
todo
=
todo
},
world
=
world
}
#
(
hadsig
,
iworld
)
=
hadSignal
iworld
|
hadsig
=
halt
1
iworld
#
(
merr
,
iworld
)
=
updateClock
iworld
|
merr
=:(
Error
_)
=
abort
"Error updating clock
\n
"
// Write ticker
#
(
merr
,
iworld
=:{
options
})
=
write
()
tick
EmptyContext
iworld
...
...
@@ -89,6 +101,18 @@ loop determineTimeout iworld=:{ioTasks,sdsNotifyRequests}
=
case
shutdown
of
(
Just
exitCode
)
=
halt
exitCode
iworld
_
=
loop
determineTimeout
iworld
where
pollSignalHandlers
[]
world
=
(
False
,
[],
world
)
pollSignalHandlers
[
h
:
hs
]
world
=
case
signalPoll
h
world
of
(
Error
e
,
h
,
world
)
=
abort
"Error polling signal handler"
//Shouldn't occur
(
Ok
s
,
h
,
world
)
#
(
stop
,
hs
,
world
)
=
pollSignalHandlers
hs
world
=
(
stop
||
s
,
[
h
:
hs
],
world
)
hadSignal
iworld
=:{
signalHandlers
,
world
}
#
(
hadsig
,
signalHandlers
,
world
)
=
pollSignalHandlers
signalHandlers
world
#
iworld
=
{
iworld
&
signalHandlers
=
signalHandlers
,
world
=
world
}
=
(
hadsig
,
iworld
)
select
::
(
Maybe
Timeout
)
*[
IOTaskInstance
]
*
World
->
(!*[
IOTaskInstance
],![(
Int
,
SelectResult
)],!*
World
)
select
mbTimeout
mlInstances
world
...
...
Libraries/iTasks/Internal/WebService.icl
View file @
ed6b941f
...
...
@@ -133,8 +133,12 @@ httpServer :: !Int !Timespec ![WebService r w] (sds () r w) -> ConnectionTask |
httpServer
port
keepAliveTime
requestProcessHandlers
sds
=
wrapIWorldConnectionTask
{
ConnectionHandlersIWorld
|
onConnect
=
onConnect
,
onData
=
onData
,
onShareChange
=
onShareChange
,
onTick
=
onTick
,
onDisconnect
=
onDisconnect
,
onDestroy
=
onDestroy
}
sds
where
onConnect
connId
host
r
iworld
=:{
IWorld
|
world
,
clock
}
=
(
Ok
(
NTIdle
host
clock
),
Nothing
,[],
False
,{
IWorld
|
iworld
&
world
=
world
})
onConnect
connId
host
r
iworld
=:{
IWorld
|
world
,
clock
,
options
={
allowedHosts
}}
|
allowedHosts
=:
[]
||
isMember
host
allowedHosts
=
(
Ok
(
NTIdle
host
clock
),
Nothing
,[],
False
,{
IWorld
|
iworld
&
world
=
world
})
|
otherwise
//Close the connection immediately if the remote host is not in the whitelist
=
(
Ok
(
NTIdle
host
clock
),
Nothing
,[],
True
,{
IWorld
|
iworld
&
world
=
world
})
onData
data
connState
=:(
NTProcessingRequest
request
localState
)
r
env
//Select handler based on request path
...
...
Libraries/iTasks/Util/Testing.icl
View file @
ed6b941f
...
...
@@ -84,7 +84,7 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na
//UTILITY TASKS
testEditor
::
(
Editor
a
)
(
EditMode
a
)
->
Task
a
|
iTask
a
testEditor
editor
mode
=
(
interact
"Editor test"
unitShare
{
onInit
=
const
((),
mode
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\_
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
editor
@
snd
=
(
interact
R
"Editor test"
unitShare
{
onInit
=
const
((),
mode
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\_
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
editor
@
snd
>&>
viewSharedInformation
"Editor value"
[
ViewAs
(
toString
o
toJSON
)]
@?
tvFromMaybe
)
<<@
ArrangeHorizontal
...
...
@@ -93,7 +93,7 @@ testEditorWithShare editor model viewMode = (withShared model
\
smodel
->
updateSharedInformation
"Edit the shared source"
[]
smodel
||-
interact
"Editor under test"
smodel
{
onInit
=
\
r
->
((),
if
viewMode
View
Update
$
r
)
interact
R
"Editor under test"
smodel
{
onInit
=
\
r
->
((),
if
viewMode
View
Update
$
r
)
,
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\_
->
v
))
,
onRefresh
=
\
r
l
v
->
(
l
,
r
,
Nothing
)}
editor
@
snd
)
<<@
ArrangeHorizontal
...
...
Libraries/iTasks/WF/Tasks/Core.dcl
View file @
ed6b941f
...
...
@@ -85,18 +85,17 @@ instance toString OSException
/**
* Core interaction task. All other interaction tasks are derived from this one.
* There are two almost identical versions:
* The `interactRW` version can update the given sds.
* The `interactR` version only reads, which means it can also be used for sds's that are not writable.
*/
::
Edit
InteractionHandlers
l
r
w
v
=
::
InteractionHandlers
l
r
w
v
=
{
onInit
::
!(
r
->
(!
l
,
!
EditMode
v
))
,
onEdit
::
!(
v
l
(
Maybe
v
)
->
(!
l
,
!
v
,
!
Maybe
(
r
->
w
)))
,
onRefresh
::
!(
r
l
(
Maybe
v
)
->
(!
l
,
!
v
,
!
Maybe
(
r
->
w
)))
}
interact
::
!
d
!(
sds
()
r
w
)
(
EditInteractionHandlers
l
r
w
v
)
(
Editor
v
)
->
Task
(
l
,
v
)
|
toPrompt
d
&
iTask
l
&
iTask
r
&
iTask
v
&
TC
r
&
TC
w
&
RWShared
sds
::
ViewInteractionHandlers
l
r
w
v
=
{
onInitView
::
!(
r
->
(!
l
,
!
EditMode
v
))
,
onRefreshView
::
!(
r
l
(
Maybe
v
)
->
(!
l
,
!
v
,
!
Maybe
(
r
->
w
)))
}
interactView
::
!
d
(
sds
()
r
w
)
(
ViewInteractionHandlers
l
r
w
v
)
(
Editor
v
)
->
Task
(
l
,
v
)
|
toPrompt
d
&
iTask
l
&
iTask
r
&
iTask
v
&
TC
r
&
TC
w
&
Registrable
sds
//Version which can write shared data
interactRW
::
!
d
!(
sds
()
r
w
)
(
InteractionHandlers
l
r
w
v
)
(
Editor
v
)
->
Task
(
l
,
v
)
|
toPrompt
d
&
iTask
l
&
iTask
r
&
iTask
v
&
TC
r
&
TC
w
&
RWShared
sds
//Version which does not write shared data
interactR
::
!
d
(
sds
()
r
w
)
(
InteractionHandlers
l
r
w
v
)
(
Editor
v
)
->
Task
(
l
,
v
)
|
toPrompt
d
&
iTask
l
&
iTask
r
&
iTask
v
&
TC
r
&
TC
w
&
Registrable
sds
Libraries/iTasks/WF/Tasks/Core.icl
View file @
ed6b941f
This diff is collapsed.
Click to expand it.
Libraries/iTasks/WF/Tasks/Interaction.icl
View file @
ed6b941f
...
...
@@ -23,38 +23,38 @@ derive class iTask ChoiceText, ChoiceGrid, ChoiceRow, ChoiceNode
enterInformation
::
!
d
![
EnterOption
m
]
->
Task
m
|
toPrompt
d
&
iTask
m
enterInformation
d
[
EnterAs
fromf
:_]
=
interact
d
unitShare
{
onInit
=
const
((),
Enter
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
_
->
(
l
,
undef
,
Nothing
)}
gEditor
{|*|}
@
(\((),
v
)
->
fromf
v
)
=
interact
RW
d
unitShare
{
onInit
=
const
((),
Enter
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
_
->
(
l
,
undef
,
Nothing
)}
gEditor
{|*|}
@
(\((),
v
)
->
fromf
v
)
enterInformation
d
opts
=:[
EnterUsing
fromf
editor
:_]
=
interact
d
unitShare
{
onInit
=
const
((),
Enter
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
_
->
(
l
,
undef
,
Nothing
)}
editor
@
(\((),
v
)
->
fromf
v
)
=
interact
RW
d
unitShare
{
onInit
=
const
((),
Enter
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
_
->
(
l
,
undef
,
Nothing
)}
editor
@
(\((),
v
)
->
fromf
v
)
enterInformation
d
_
=
enterInformation
d
[
EnterAs
id
]
updateInformation
::
!
d
![
UpdateOption
m
m
]
m
->
Task
m
|
toPrompt
d
&
iTask
m
updateInformation
d
[
UpdateAs
tof
fromf
:_]
m
=
interact
d
unitShare
{
onInit
=
const
((),
Update
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
=
interact
RW
d
unitShare
{
onInit
=
const
((),
Update
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
gEditor
{|*|}
@
(\((),
v
)
->
fromf
m
v
)
updateInformation
d
[
UpdateUsing
tof
fromf
editor
:_]
m
=
interact
d
unitShare
{
onInit
=
const
((),
Update
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
=
interact
RW
d
unitShare
{
onInit
=
const
((),
Update
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
editor
@
(\((),
v
)
->
fromf
m
v
)
updateInformation
d
_
m
=
updateInformation
d
[
UpdateAs
(\
l
->
l
)
(\_
v
->
v
)]
m
viewInformation
::
!
d
![
ViewOption
m
]
!
m
->
Task
m
|
toPrompt
d
&
iTask
m
viewInformation
d
[
ViewAs
tof
:_]
m
=
interact
d
unitShare
{
onInit
=
const
((),
View
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
gEditor
{|*|}
@!
m
=
interact
RW
d
unitShare
{
onInit
=
const
((),
View
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
gEditor
{|*|}
@!
m
viewInformation
d
[
ViewUsing
tof
editor
:_]
m
=
interact
d
unitShare
{
onInit
=
const
((),
View
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
editor
@!
m
=
interact
RW
d
unitShare
{
onInit
=
const
((),
View
$
tof
m
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)}
editor
@!
m
viewInformation
d
_
m
=
viewInformation
d
[
ViewAs
id
]
m
updateSharedInformation
::
!
d
![
UpdateOption
r
w
]
!(
sds
()
r
w
)
->
Task
r
|
toPrompt
d
&
iTask
r
&
iTask
w
&
RWShared
sds
updateSharedInformation
d
[
UpdateAs
tof
fromf
:_]
shared
=
interact
d
shared
{
onInit
=
\
r
->
(
r
,
Update
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\
r
->
fromf
r
v
)),
onRefresh
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
=
interact
RW
d
shared
{
onInit
=
\
r
->
(
r
,
Update
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\
r
->
fromf
r
v
)),
onRefresh
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
gEditor
{|*|}
@
fst
updateSharedInformation
d
[
UpdateUsing
tof
fromf
editor
:_]
shared
=
interact
d
shared
{
onInit
=
\
r
->
(
r
,
Update
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\
r
->
fromf
r
v
)),
onRefresh
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
=
interact
RW
d
shared
{
onInit
=
\
r
->
(
r
,
Update
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\
r
->
fromf
r
v
)),
onRefresh
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
editor
@
fst
updateSharedInformation
d
[
UpdateSharedAs
tof
fromf
conflictf
:_]
shared
=
interact
d
shared
{
onInit
=
\
r
->
(
r
,
Update
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\
r
->
fromf
r
v
)),
onRefresh
=
\
r
_
(
Just
v
)
->
(
r
,
conflictf
(
tof
r
)
v
,
Nothing
)}
=
interact
RW
d
shared
{
onInit
=
\
r
->
(
r
,
Update
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Just
(\
r
->
fromf
r
v
)),
onRefresh
=
\
r
_
(
Just
v
)
->
(
r
,
conflictf
(
tof
r
)
v
,
Nothing
)}
gEditor
{|*|}
@
fst
updateSharedInformation
d
_
shared
...
...
@@ -66,22 +66,22 @@ updateSharedInformation d _ shared
viewSharedInformation
::
!
d
![
ViewOption
r
]
!(
sds
()
r
w
)
->
Task
r
|
toPrompt
d
&
iTask
r
&
TC
w
&
Registrable
sds
viewSharedInformation
d
[
ViewAs
tof
:_]
shared
=
interact
View
d
shared
{
onInitView
=
\
r
->
(
r
,
View
$
tof
r
),
onRefreshView
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
gEditor
{|*|}
@
fst
=
interact
R
d
shared
{
onInit
=
\
r
->
(
r
,
View
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
gEditor
{|*|}
@
fst
viewSharedInformation
d
[
ViewUsing
tof
editor
:_]
shared
=
interact
View
d
shared
{
onInitView
=
\
r
->
(
r
,
View
$
tof
r
),
onRefreshView
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
editor
@
fst
=
interact
R
d
shared
{
onInit
=
\
r
->
(
r
,
View
$
tof
r
),
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
),
onRefresh
=
\
r
_
_
->
(
r
,
tof
r
,
Nothing
)}
editor
@
fst
viewSharedInformation
d
_
shared
=
viewSharedInformation
d
[
ViewAs
id
]
shared
updateInformationWithShared
::
!
d
![
UpdateOption
(
r
,
m
)
m
]
!(
sds
()
r
w
)
m
->
Task
m
|
toPrompt
d
&
iTask
r
&
iTask
m
&
TC
w
&
RWShared
sds
updateInformationWithShared
d
[
UpdateAs
tof
fromf
:_]
shared
m
=
interact
d
shared
=
interact
RW
d
shared
{
onInit
=
\
r
->
((
r
,
m
),
Update
$
tof
(
r
,
m
))
,
onEdit
=
\
v
(
r
,
m
)
_
->
let
nm
=
fromf
(
r
,
m
)
v
in
((
r
,
nm
),
v
,
Nothing
)
,
onRefresh
=
\
r
(_,
m
)
_
->
((
r
,
m
),
tof
(
r
,
m
),
Nothing
)
}
gEditor
{|*|}
@
(
snd
o
fst
)
updateInformationWithShared
d
[
UpdateUsing
tof
fromf
editor
:_]
shared
m
=
interact
d
shared
=
interact
RW
d
shared
{
onInit
=
\
r
->
((
r
,
m
),
Update
$
tof
(
r
,
m
))
,
onEdit
=
\
v
(
r
,
m
)
_
->
let
nm
=
fromf
(
r
,
m
)
v
in
((
r
,
nm
),
v
,
Nothing
)
,
onRefresh
=
\
r
(_,
m
)
_
->
((
r
,
m
),
tof
(
r
,
m
),
Nothing
)
...
...
@@ -97,7 +97,7 @@ editSelection d multi (SelectInList toView fromView) container sel = editSelecti
editSelection
d
multi
(
SelectInGrid
toView
fromView
)
container
sel
=
editSelection`
d
(
grid
<<@
multipleAttr
multi
)
toView
fromView
container
sel
editSelection
d
multi
(
SelectInTree
toView
fromView
)
container
sel
=
editSelection`
d
(
tree
<<@
multipleAttr
multi
)
toView
fromView
container
sel
editSelection`
d
editor
toView
fromView
container
sel
=
interact
d
unitShare
=
interact
RW
d
unitShare
{
onInit
=
\
r
->
((),
Update
(
toView
container
,
sel
))
,
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
)
,
onRefresh
=
\_
l
(
Just
v
)
->
(
l
,
v
,
Nothing
)
...
...
@@ -110,7 +110,7 @@ editSelectionWithShared d multi (SelectInList toView fromView) sharedContainer i
editSelectionWithShared
d
multi
(
SelectInGrid
toView
fromView
)
sharedContainer
initSel
=
editSelectionWithShared`
d
(
grid
<<@
multipleAttr
multi
)
toView
fromView
sharedContainer
initSel
editSelectionWithShared
d
multi
(
SelectInTree
toView
fromView
)
sharedContainer
initSel
=
editSelectionWithShared`
d
(
tree
<<@
multipleAttr
multi
)
toView
fromView
sharedContainer
initSel
editSelectionWithShared`
d
editor
toView
fromView
sharedContainer
initSel
=
interact
d
sharedContainer
=
interact
RW
d
sharedContainer
{
onInit
=
\
r
->
(
r
,
Update
(
toView
r
,
initSel
r
))
,
onEdit
=
\
v
l
_
->
(
l
,
v
,
Nothing
)
,
onRefresh
=
\
r
l
(
Just
(
v
,
sel
))
->
(
r
,(
toView
r
,
sel
),
Nothing
)
...
...
@@ -123,7 +123,7 @@ editSharedSelection d multi (SelectInList toView fromView) container sharedSel =
editSharedSelection
d
multi
(
SelectInGrid
toView
fromView
)
container
sharedSel
=
editSharedSelection`
d
(
grid
<<@
multipleAttr
multi
)
toView
fromView
container
sharedSel
editSharedSelection
d
multi
(
SelectInTree
toView
fromView
)
container
sharedSel
=
editSharedSelection`
d
(
tree
<<@
multipleAttr
multi
)
toView
fromView
container
sharedSel
editSharedSelection`
d
editor
toView
fromView
container
sharedSel
=
interact
d
sharedSel
=
interact
RW
d
sharedSel
{
onInit
=
\
r
->
((),
Update
(
toView
container
,
r
))
,
onEdit
=
\(
vt
,
vs
)
l
_
->
(
l
,(
vt
,
vs
),
Just
(
const
vs
))
,
onRefresh
=
\
r
l
(
Just
(
vt
,
vs
))
->
(
l
,(
vt
,
r
),
Nothing
)
...
...
@@ -141,7 +141,7 @@ editSharedSelectionWithShared d multi (SelectInGrid toView fromView) sharedConta
editSharedSelectionWithShared
d
multi
(
SelectInTree
toView
fromView
)
sharedContainer
sharedSel
=
editSharedSelectionWithShared`
d
(
tree
<<@
multipleAttr
multi
)
toView
fromView
sharedContainer
sharedSel
editSharedSelectionWithShared`
d
editor
toView
fromView
sharedContainer
sharedSel
=
interact
d
(
sharedContainer
|*<
sharedSel
)
=
interact
RW
d
(
sharedContainer
|*<
sharedSel
)
{
onInit
=
\(
rc
,
rs
)
->
(
rc
,
Update
(
toView
rc
,
rs
))
,
onEdit
=
\
v
=:(_,
vs
)
l
_
->
(
l
,
v
,
Just
(
const
vs
))
,
onRefresh
=
\(
rc
,
rs
)
_
_
->
(
rc
,
(
toView
rc
,
rs
),
Nothing
)
...
...
Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl
View file @
ed6b941f
...
...
@@ -17,7 +17,7 @@ expPromptUI msg
minimalInteractUI
=
skip
(
testTaskOutput
"Initial UI of minimal interaction task"
task
events
exp
checkEqual
)
where
task
::
Task
((),
String
)
task
=
interact
"TEST"
unitShare
handlers
gEditor
{|*|}
task
=
interact
R
"TEST"
unitShare
handlers
gEditor
{|*|}
handlers
=
{
onInit
=
\()
->
((),
Update
"Hello world"
),
onEdit
=
\_
l
v
->
(
l
,
fromJust
v
,
Nothing
),
onRefresh
=
\_
l
v
->
(
l
,
fromJust
v
,
Nothing
)}
events
=
[
Left
ResetEvent
]
...
...
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