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
74
Issues
74
List
Boards
Labels
Service Desk
Milestones
Merge Requests
7
Merge Requests
7
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
64825291
Commit
64825291
authored
Jun 14, 2019
by
Tim Steenvoorden
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add simple share of integers
parent
cc5f03a5
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
64 additions
and
10 deletions
+64
-10
Examples/DynamicEditor/DynEditorExample.icl
Examples/DynamicEditor/DynEditorExample.icl
+64
-10
No files found.
Examples/DynamicEditor/DynEditorExample.icl
View file @
64825291
...
...
@@ -15,6 +15,8 @@ import iTasks.Extensions.Editors.DynamicEditor
always
x
:==
const
True
x
cons
x
xs
:==
[
x
:
xs
]
(>?>)
infixl
1
::
(
Task
a
)
(
List
(
Button
,
a
->
Bool
,
a
->
Task
b
))
->
Task
b
|
iTask
a
&
iTask
b
(>?>)
task
options
=
task
>>*
map
trans
options
where
...
...
@@ -56,11 +58,16 @@ where
|
Both
TaskExpr
TaskExpr
|
Any
TaskExpr
TaskExpr
|
One
Button
TaskExpr
Button
TaskExpr
// | Init Ty TaskExpr
|
Watch
String
// | Change String
::
TaskFunc
=
ThenF
TaskFunc
TaskFunc
|
ViewF
String
Func
|
UpdateF
String
Func
|
StoreF
|
WatchF
String
::
Expr
=
Int
Int
...
...
@@ -87,7 +94,8 @@ where
|
Snd
::
Value
=
VInt
Int
=
VUnit
|
VInt
Int
|
VBool
Bool
|
VString
String
|
VTuple
Value
Value
...
...
@@ -102,12 +110,12 @@ derive class iTask TaskExpr, TaskFunc, Expr, Func, Value, Typed
// These instances cannot be auto derived because of the existential quantifier.
// However, they will be never used, so we make them undefined.
gDefault
{|
Ty
|}
=
undef
gEq
{|
Ty
|}
_
_
=
undef
JSONEncode
{|
Ty
|}
_
_
=
undef
JSONDecode
{|
Ty
|}
_
_
=
undef
gText
{|
Ty
|}
_
_
=
undef
gEditor
{|
Ty
|}
=
undef
gDefault
{|
Ty
|}
=
abort
"Typed task editor: internal error with gDefault of Ty"
gEq
{|
Ty
|}
_
_
=
abort
"Typed task editor: internal error with gEq of Ty"
JSONEncode
{|
Ty
|}
_
_
=
abort
"Typed task editor: internal error with JSONEncode of Ty"
JSONDecode
{|
Ty
|}
_
_
=
abort
"Typed task editor: internal error with JSONDecode of Ty"
gText
{|
Ty
|}
_
_
=
abort
"Typed task editor: internal error with gText of Ty"
gEditor
{|
Ty
|}
=
abort
"Typed task editor: internal error with gEditor of Ty"
// Editor //////////////////////////////////////////////////////////////////////
...
...
@@ -224,6 +232,37 @@ taskEditor = DynamicEditor
<<@@@
applyHorizontalBoxedLayout
]
// Non-task functions:
,
DynamicConsGroup
"Shares"
// [ functionConsDyn "Init" "initialise"
// ( dynamic \(Typed sharedTy) (Typed taskExpr) -> Typed (Init sharedTy taskExpr) ::
// A.s a:
// (Typed Ty s)
// (Typed TaskExpr (Task a))
// -> Typed TaskExpr (Task a)
// )
// <<@@@ applyVerticalBoxedLayout
[
functionConsDyn
"StoreF"
"store"
(
dynamic
Typed
StoreF
::
Typed
TaskFunc
(
Int
->
Task
()))
<<@@@
applyHorizontalBoxedLayout
<<@@@
AddLabels
[
Just
"message"
]
,
functionConsDyn
"Watch"
"watch"
(
dynamic
\
msg
->
Typed
(
Watch
msg
)
::
A
.
a
:
String
->
Typed
TaskExpr
(
Task
())
)
<<@@@
applyHorizontalBoxedLayout
<<@@@
AddLabels
[
Just
"message"
]
,
functionConsDyn
"WatchF"
"watch"
(
dynamic
\
msg
->
Typed
(
WatchF
msg
)
::
A
.
a
:
String
->
Typed
TaskFunc
(
a
->
Task
())
)
<<@@@
applyHorizontalBoxedLayout
<<@@@
AddLabels
[
Just
"message"
]
]
// Non-task functions:
,
DynamicConsGroup
"Basics"
[
functionConsDyn
"Identity"
"this value"
(
dynamic
Typed
Identity
::
A
.
a
:
Typed
Func
(
a
->
a
))
...
...
@@ -355,17 +394,23 @@ where
// Evaluation //////////////////////////////////////////////////////////////////
// globalValueShare :: SimpleSDSLens ( Ty, List Value )
// globalValueShare = sharedStore "global share for typed task editor" ( abort "Global share not initialised", [] )
globalValueShare
::
SimpleSDSLens
(
List
Value
)
globalValueShare
=
sharedStore
"global share for typed task editor"
[]
evalTaskExpr
::
TaskExpr
->
Task
Value
evalTaskExpr
(
Done
expr
)
=
return
$
evalExpr
expr
evalTaskExpr
(
EnterInfo
(
Ty
toValue
)
msg
)
=
enterInformation
msg
[]
@
toValue
evalTaskExpr
(
Then
task
taskFunc
)
=
evalTaskExpr
task
>>=
evalTaskFunc
taskFunc
evalTaskExpr
(
Both
task1
task2
)
=
(
evalTaskExpr
task1
-&&-
evalTaskExpr
task2
)
<<@
ApplyLayout
arrangeHorizontal
@
\(
a
,
b
)
->
VTuple
a
b
evalTaskExpr
(
Any
task1
task2
)
=
(
evalTaskExpr
task1
-||-
evalTaskExpr
task2
)
<<@
ApplyLayout
arrangeHorizontal
evalTaskExpr
(
One
button1
task1
button2
task2
)
=
viewInformation
"Make a choice"
[]
()
>?>
evalTaskExpr
(
One
button1
task1
button2
task2
)
=
viewInformation
"Make a choice"
[]
()
>?>
[
(
button1
,
const
True
,
\_
->
evalTaskExpr
task1
)
,
(
button2
,
const
True
,
\_
->
evalTaskExpr
task2
)
]
// evalTaskExpr (Init sharedTy task) = set ( sharedTy, [] ) globalValueShare >>| evalTaskExpr task
evalTaskExpr
(
Watch
msg
)
=
viewSharedInformation
msg
[]
globalValueShare
@
(
const
VUnit
)
// evalTaskExpr (When task1 options) = evalTaskExpr task1
// >>* [ OnAction (Action name) (ifValue (test pred) (evalTaskFunc cont))
...
...
@@ -383,7 +428,8 @@ evalTaskExpr (One button1 task1 button2 task2)
evalTaskFunc
::
TaskFunc
Value
->
Task
Value
evalTaskFunc
(
ThenF
this
next
)
val
=
evalTaskFunc
this
val
>>=
evalTaskFunc
next
evalTaskFunc
(
ThenF
this
next
)
val
=
evalTaskFunc
this
val
>>=
evalTaskFunc
next
evalTaskFunc
(
ViewF
msg
func
)
val
=
case
evalFunc
val
func
of
(
VInt
i
)
->
(
viewInformation
msg
[]
i
@
VInt
)
<<@
ApplyLayout
arrangeHorizontal
...
...
@@ -407,6 +453,14 @@ evalTaskFunc (UpdateF msg func) val = case evalFunc val func of
)
<<@
ApplyLayout
arrangeHorizontal
evalTaskFunc
(
StoreF
)
val
=
// upd (\( sharedTy, values ) -> ( sharedTy, cons val values)) globalValueShare @ (const VUnit)
upd
(
cons
val
)
globalValueShare
@
(
const
VUnit
)
evalTaskFunc
(
WatchF
msg
)
val
=
viewSharedInformation
msg
[]
globalValueShare
@
(
const
VUnit
)
evalExpr
::
Expr
->
Value
evalExpr
(
Int
i
)
=
VInt
i
...
...
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