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
73
Issues
73
List
Boards
Labels
Service Desk
Milestones
Merge Requests
6
Merge Requests
6
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
c138a5c5
Verified
Commit
c138a5c5
authored
Apr 05, 2019
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Strip down iTasks.UI.JS.Interface; initial working version of the wasm interface
parent
c7c36e69
Changes
22
Hide whitespace changes
Inline
Side-by-side
Showing
22 changed files
with
311 additions
and
1070 deletions
+311
-1070
Examples/WasmTest.icl
Examples/WasmTest.icl
+55
-0
Libraries/iTasks/Extensions/Admin/TonicAdmin.icl
Libraries/iTasks/Extensions/Admin/TonicAdmin.icl
+0
-4
Libraries/iTasks/Extensions/DateTime.icl
Libraries/iTasks/Extensions/DateTime.icl
+4
-2
Libraries/iTasks/Extensions/SVG/SVGEditor.dcl
Libraries/iTasks/Extensions/SVG/SVGEditor.dcl
+3
-4
Libraries/iTasks/Extensions/SVG/SVGEditor.icl
Libraries/iTasks/Extensions/SVG/SVGEditor.icl
+15
-15
Libraries/iTasks/Internal/Client/Serialization.dcl
Libraries/iTasks/Internal/Client/Serialization.dcl
+3
-0
Libraries/iTasks/Internal/Client/Serialization.icl
Libraries/iTasks/Internal/Client/Serialization.icl
+8
-0
Libraries/iTasks/Internal/TaskEval.icl
Libraries/iTasks/Internal/TaskEval.icl
+0
-1
Libraries/iTasks/Internal/Tonic/Images.icl
Libraries/iTasks/Internal/Tonic/Images.icl
+1
-1
Libraries/iTasks/Internal/Tonic/Server.icl
Libraries/iTasks/Internal/Tonic/Server.icl
+0
-1
Libraries/iTasks/UI/Editor.dcl
Libraries/iTasks/UI/Editor.dcl
+2
-3
Libraries/iTasks/UI/Editor.icl
Libraries/iTasks/UI/Editor.icl
+10
-7
Libraries/iTasks/UI/Editor/Controls.dcl
Libraries/iTasks/UI/Editor/Controls.dcl
+1
-2
Libraries/iTasks/UI/Editor/Controls.icl
Libraries/iTasks/UI/Editor/Controls.icl
+1
-1
Libraries/iTasks/UI/JS/Encoding.dcl
Libraries/iTasks/UI/JS/Encoding.dcl
+0
-92
Libraries/iTasks/UI/JS/Encoding.icl
Libraries/iTasks/UI/JS/Encoding.icl
+0
-288
Libraries/iTasks/UI/JS/Interface.dcl
Libraries/iTasks/UI/JS/Interface.dcl
+23
-184
Libraries/iTasks/UI/JS/Interface.icl
Libraries/iTasks/UI/JS/Interface.icl
+65
-414
Libraries/iTasks/UI/WebPublic/index.html
Libraries/iTasks/UI/WebPublic/index.html
+3
-1
Libraries/iTasks/UI/WebPublic/js/abc-interpreter.js
Libraries/iTasks/UI/WebPublic/js/abc-interpreter.js
+107
-41
Libraries/iTasks/UI/WebPublic/js/itasks-core.js
Libraries/iTasks/UI/WebPublic/js/itasks-core.js
+2
-1
Libraries/iTasks/WF/Combinators/Core.icl
Libraries/iTasks/WF/Combinators/Core.icl
+8
-8
No files found.
Examples/WasmTest.icl
0 → 100644
View file @
c138a5c5
module
WasmTest
import
StdEnv
import
Data
.
Error
from
Data
.
Func
import
$
import
iTasks
.
Engine
import
iTasks
.
Internal
.
Client
.
Serialization
import
iTasks
.
UI
.
Definition
import
iTasks
.
UI
.
Editor
import
iTasks
.
UI
.
JS
.
Interface
import
iTasks
.
UI
.
Prompt
import
iTasks
.
WF
.
Tasks
.
Interaction
// TODO: remove
import
Text
.
GenJSON
Start
w
=
doTasks
task
w
//import iTasks.Internal.SDS
//import iTasks.SDS.Sources.System
//
//task = viewSharedInformation "Current date and time" [] currentDateTime
task
=
updateInformation
"test"
[
UpdateUsing
(\
m
->
m
)
(\_
v
->
v
)
$
leafEditorToEditor
{
LeafEditor
|
genUI
=
withClientSideInit
initUI
genUI
,
onEdit
=
\_
(_,
st
)
_
vst
->
(
Ok
(
NoChange
,
st
),
vst
)
,
onRefresh
=
\_
new
old
vst
|
new
==
old
->
(
Ok
(
NoChange
,
new
),
vst
)
|
otherwise
->
undef
// TODO: serialize
,
valueFromState
=
Just
}
]
37
where
initUI
::
!(
JSObj
())
!*
JSWorld
->
*
JSWorld
initUI
comp
w
#
(
jsInitDOMEl
,
w
)
=
jsWrapFun
(
initDOMEl
comp
)
w
#
w
=
(
comp
.#
"initDOMEl"
.=
jsInitDOMEl
)
w
=
w
where
initDOMEl
::
!(
JSObj
())
!*
JSWorld
->
(!
JSVal
a
,
!*
JSWorld
)
initDOMEl
comp
w
#
w
=
(
comp
.#
"domEl.value"
.=
toJS
37
)
w
=
(
jsNull
,
w
)
genUI
::
!
UIAttributes
!
DataPath
!(
EditMode
s
)
!*
VSt
->
*(!
MaybeErrorString
(!
UI
,
!
s
),
!*
VSt
)
genUI
attr
dp
mode
vst
=
case
editModeValue
mode
of
Nothing
->
(
Error
"cannot be in enter mode"
,
vst
)
Just
val
#
(
s
,
vst
)
=
serialize_in_vst
val
vst
->
(
Ok
(
ui
UITextField
,
val
),
vst
)
Libraries/iTasks/Extensions/Admin/TonicAdmin.icl
View file @
c138a5c5
...
...
@@ -20,7 +20,6 @@ from Control.Monad import `b`, class Monad(bind)
import
qualified
iTasks
.
Internal
.
SDS
as
DSDS
import
Data
.
List
from
iTasks
.
Extensions
.
SVG
.
SVGEditor
import
fromSVGEditor
,
::
SVGEditor
{..}
import
iTasks
.
UI
.
JS
.
Encoding
from
Data
.
IntMap
.
Strict
import
::
IntMap
import
qualified
Data
.
IntMap
.
Strict
as
DIS
import
Data
.
Maybe
...
...
@@ -35,9 +34,6 @@ derive gDefault Set
derive
JSONEncode
Set
derive
JSONDecode
Set
derive
JSEncode
ActionState
,
TClickAction
,
ClickMeta
,
TonicImageState
,
BlueprintRef
,
TonicFunc
,
TExpr
,
TPriority
,
TLit
,
TAssoc
derive
JSDecode
ActionState
,
TClickAction
,
ClickMeta
,
TonicImageState
,
BlueprintRef
,
TonicFunc
,
TExpr
,
TPriority
,
TLit
,
TAssoc
tonic
::
Task
()
tonic
=
tonicDashboard
[]
...
...
Libraries/iTasks/Extensions/DateTime.icl
View file @
c138a5c5
...
...
@@ -23,7 +23,7 @@ import Text, Text.GenJSON, System.Time
import
Data
.
Maybe
,
Data
.
Error
import
qualified
Data
.
Map
as
DM
from
iTasks
.
Extensions
.
Form
.
Pikaday
import
pikadayDateField
//from iTasks.Extensions.Form.Pikaday import pikadayDateField // TODO restore
from
iTasks
.
Internal
.
Util
import
tmToDateTime
//* (Local) date and time
...
...
@@ -69,7 +69,9 @@ JSONDecode{|Date|} _ c = (Nothing, c)
gText
{|
Date
|}
_
val
=
[
maybe
""
toString
val
]
gEditor
{|
Date
|}
=
pikadayDateField
// TODO restore
//gEditor{|Date|} = pikadayDateField
derive
gEditor
Date
gDefault
{|
Date
|}
=
{
Date
|
day
=
1
,
mon
=
1
,
year
=
2017
}
derive
gEq
Date
...
...
Libraries/iTasks/Extensions/SVG/SVGEditor.dcl
View file @
c138a5c5
definition
module
iTasks
.
Extensions
.
SVG
.
SVGEditor
import
Graphics
.
Scalable
.
Internal
.
Image`
from
iTasks
.
UI
.
Editor
import
::
Editor
import
iTasks
.
UI
.
JS
.
Encoding
from
iTasks
import
::
Editor
,
generic
gEq
,
generic
JSONEncode
,
generic
JSONDecode
,
::
JSONNode
// An SVGEditor let's you specify an editor as an interactive SVG image (Graphics.Scalable.Image)
::
SVGEditor
m
v
=
...
...
@@ -11,5 +11,4 @@ import iTasks.UI.JS.Encoding
,
updModel
::
m
v
->
m
// When the view is updated (using the image), the change needs to be merged back into the view
}
fromSVGEditor
::
(
SVGEditor
s
v
)
->
Editor
s
|
gEq
{|*|},
JSONEncode
{|*|},
JSONDecode
{|*|},
JSEncode
{|*|},
JSDecode
{|*|}
s
fromSVGEditor
::
(
SVGEditor
s
v
)
->
Editor
s
|
gEq
{|*|},
JSONEncode
{|*|},
JSONDecode
{|*|}
s
Libraries/iTasks/Extensions/SVG/SVGEditor.icl
View file @
c138a5c5
implementation
module
iTasks
.
Extensions
.
SVG
.
SVGEditor
import
Graphics
.
Scalable
.
Internal
.
Image`
import
iTasks
.
UI
.
Definition
,
iTasks
.
UI
.
Editor
,
iTasks
.
UI
.
JS
.
Encoding
import
iTasks
.
UI
.
Definition
,
iTasks
.
UI
.
Editor
import
StdEnv
...
...
@@ -23,17 +23,17 @@ CLICK_DELAY :== 225
svgns
=:
"http://www.w3.org/2000/svg"
//Predefined object methods
(
`
addEventListener`
)
obj
args
:==
obj
.#
"addEventListener"
.$
args
(
`
setAttribute`
)
obj
args
:==
obj
.#
"setAttribute"
.$
args
(
`
setAttributeNS`
)
obj
args
:==
obj
.#
"setAttributeNS"
.$
args
(
`
createElementNS`
)
obj
args
:==
obj
.#
"createElementNS"
.$
args
(
`
appendChild`
)
obj
args
:==
obj
.#
"appendChild"
.$
args
(
`
removeChild`
)
obj
args
:==
obj
.#
"removeChild"
.$
args
(
`
getComputedTextLength`
)
obj
args
:==
obj
.#
"getComputedTextLength"
.$
args
(
`
createSVGPoint`
)
obj
args
:==
obj
.#
"createSVGPoint"
.$
args
(
`
getScreenCTM`
)
obj
args
:==
obj
.#
"getScreenCTM"
.$
args
(
`
inverse`
)
obj
args
:==
obj
.#
"inverse"
.$
args
(
`
matrixTransform`
)
obj
args
:==
obj
.#
"matrixTransform"
.$
args
//
(`addEventListener`) obj args :== obj .# "addEventListener" .$ args
//
(`setAttribute`) obj args :== obj .# "setAttribute" .$ args
//
(`setAttributeNS`) obj args :== obj .# "setAttributeNS" .$ args
//
(`createElementNS`) obj args :== obj .# "createElementNS" .$ args
//
(`appendChild`) obj args :== obj .# "appendChild" .$ args
//
(`removeChild`) obj args :== obj .# "removeChild" .$ args
//
(`getComputedTextLength`) obj args :== obj .# "getComputedTextLength" .$ args
//
(`createSVGPoint`) obj args :== obj .# "createSVGPoint" .$ args
//
(`getScreenCTM`) obj args :== obj .# "getScreenCTM" .$ args
//
(`inverse`) obj args :== obj .# "inverse" .$ args
//
(`matrixTransform`) obj args :== obj .# "matrixTransform" .$ args
::
ImageSpanReal
:==
(!
Real
,
!
Real
)
...
...
@@ -51,9 +51,8 @@ svgns =: "http://www.w3.org/2000/svg"
derive
gEq
MousePos
fromSVGEditor
::
(
SVGEditor
s
v
)
->
Editor
s
|
gEq
{|*|},
JSONEncode
{|*|},
JSONDecode
{|*|},
JSEncode
{|*|},
JSDecode
{|*|}
s
fromSVGEditor
svglet
=
leafEditorToEditor
fromSVGEditor
::
(
SVGEditor
s
v
)
->
Editor
s
|
gEq
{|*|},
JSONEncode
{|*|},
JSONDecode
{|*|}
s
fromSVGEditor
svglet
=
undef
/* FIXME: restore leafEditorToEditor
{ LeafEditor
| genUI = withClientSideInit initUI genUI
, onEdit = onEdit
...
...
@@ -816,3 +815,4 @@ keepTransformAttrsTogether attr attrs
isTransformAttr :: !SVGAttr -> Bool
isTransformAttr (TransformAttr _) = True
isTransformAttr _ = False
*/
Libraries/iTasks/Internal/Client/Serialization.dcl
View file @
c138a5c5
...
...
@@ -2,5 +2,8 @@ definition module iTasks.Internal.Client.Serialization
from
Data
.
Error
import
::
MaybeError
,
::
MaybeErrorString
from
iTasks
.
Internal
.
IWorld
import
::
IWorld
from
iTasks
.
UI
.
Editor
import
::
VSt
serialize_for_client
::
f
!*
IWorld
->
*(!
MaybeErrorString
String
,
!*
IWorld
)
serialize_in_vst
::
f
!*
VSt
->
*(!
String
,
!*
VSt
)
Libraries/iTasks/Internal/Client/Serialization.icl
View file @
c138a5c5
...
...
@@ -10,6 +10,7 @@ import ABC.Interpreter
import
iTasks
.
Engine
import
iTasks
.
Internal
.
IWorld
import
iTasks
.
UI
.
Editor
serialize_for_client
::
f
!*
IWorld
->
*(!
MaybeErrorString
String
,
!*
IWorld
)
serialize_for_client
f
iworld
=:{
world
,
options
}
...
...
@@ -20,3 +21,10 @@ serialize_for_client f iworld=:{world,options}
Nothing
->
Error
"Failed to serialize graph"
Just
g
->
Ok
g
=
(
graph
,
iworld
)
serialize_in_vst
::
f
!*
VSt
->
*(!
String
,
!*
VSt
)
serialize_in_vst
f
vst
=:{
iworld
}
#
(
s
,
iworld
)
=
serialize_for_client
f
iworld
=
case
s
of
Error
e
->
abort
(
e
+++
"
\n
"
)
Ok
s
->
(
s
,
{
vst
&
iworld
=
iworld
})
Libraries/iTasks/Internal/TaskEval.icl
View file @
c138a5c5
...
...
@@ -19,7 +19,6 @@ from iTasks.SDS.Combinators.Common import sdsFocus, >*|, mapReadWrite, mapR
from
StdFunc
import
const
,
o
import
qualified
Data
.
CircularStack
as
DCS
from
Data
.
CircularStack
import
::
CircularStack
from
iTasks
.
Internal
.
Tonic
.
AbsSyn
import
::
ExprId
(..)
derive
gEq
TIMeta
,
TIType
...
...
Libraries/iTasks/Internal/Tonic/Images.icl
View file @
c138a5c5
...
...
@@ -7,6 +7,7 @@ import Data.Func
import
Data
.
List
import
Data
.
Maybe
import
Data
.
Either
import
Data
.
Functor
import
qualified
Data
.
Map
as
DM
from
Data
.
Map
import
instance
Functor
(
Map
a
)
from
Data
.
Set
import
::
Set
...
...
@@ -33,7 +34,6 @@ import iTasks.Internal.Tonic.Types
import
iTasks
.
Internal
.
Tonic
.
Pretty
import
iTasks
.
UI
.
Definition
from
iTasks
.
Extensions
.
SVG
.
SVGEditor
import
fromSVGEditor
,
::
SVGEditor
{..}
import
iTasks
.
UI
.
JS
.
Encoding
import
Text
import
StdMisc
...
...
Libraries/iTasks/Internal/Tonic/Server.icl
View file @
c138a5c5
...
...
@@ -13,7 +13,6 @@ from Data.IntMap.Strict import :: IntMap
import
iTasks
.
Internal
.
Tonic
.
Blueprints
import
iTasks
.
Extensions
.
Admin
.
TonicAdmin
import
iTasks
.
Extensions
.
SVG
.
SVGEditor
import
iTasks
.
UI
.
JS
.
Encoding
import
iTasks
.
Extensions
.
DateTime
import
iTasks
.
Internal
.
Tonic
.
AbsSyn
import
iTasks
.
Internal
.
Tonic
.
Types
...
...
Libraries/iTasks/UI/Editor.dcl
View file @
c138a5c5
...
...
@@ -6,7 +6,6 @@ definition module iTasks.UI.Editor
from
iTasks
.
UI
.
Definition
import
::
UI
,
::
UIAttributes
,
::
UIChange
,
::
UIAttributeChange
,
::
TaskId
from
iTasks
.
UI
.
JS
.
Interface
import
::
JSWorld
,
::
JSObj
,
::
JSVal
,
::
JSObject
from
iTasks
.
UI
.
JS
.
Encoding
import
generic
JSDecode
from
iTasks
.
Internal
.
IWorld
import
::
IWorld
from
iTasks
.
Internal
.
Generic
.
Defaults
import
generic
gDefault
...
...
@@ -55,12 +54,12 @@ from Control.GenBimap import generic bimap, :: Bimap
,
valueFromState
::
!
st
->
Maybe
a
}
leafEditorToEditor
::
!(
LeafEditor
edit
st
a
)
->
Editor
a
|
JS
Decode
{|*|}
edit
&
JS
ONEncode
{|*|},
JSONDecode
{|*|}
st
leafEditorToEditor
::
!(
LeafEditor
edit
st
a
)
->
Editor
a
|
JSONEncode
{|*|},
JSONDecode
{|*|}
st
//Version without overloading, for use in generic case
//The first two argument should be JSONEncode{|*|} and JSONDecode{|*|} which cannot be used by overloading within generic functions
leafEditorToEditor_
::
!(
Bool
st
->
[
JSONNode
])
!(
Bool
[
JSONNode
]
->
(!
Maybe
st
,
![
JSONNode
]))
!(
LeafEditor
edit
st
a
)
->
Editor
a
|
JSDecode
{|*|}
edit
->
Editor
a
/*
* Definition of a compound editor using an additional typed state, next to the children's states.
...
...
Libraries/iTasks/UI/Editor.icl
View file @
c138a5c5
implementation
module
iTasks
.
UI
.
Editor
import
Std
Bool
,
StdMisc
,
StdList
,
StdTuple
import
Std
Env
import
Data
.
Maybe
,
Data
.
Functor
,
Data
.
Tuple
,
Data
.
Func
,
Data
.
Error
import
iTasks
.
Internal
.
IWorld
import
iTasks
.
Internal
.
Client
.
Serialization
import
iTasks
.
UI
.
Definition
,
iTasks
.
WF
.
Definition
,
iTasks
.
UI
.
JS
.
Encoding
import
iTasks
.
UI
.
Definition
,
iTasks
.
WF
.
Definition
,
iTasks
.
UI
.
JS
.
Interface
import
qualified
Data
.
Map
as
DM
import
Text
,
Text
.
GenJSON
import
Data
.
GenEq
...
...
@@ -13,20 +13,20 @@ derive JSONEncode EditState, LeafState, EditMode
derive
JSONDecode
EditState
,
LeafState
,
EditMode
derive
gEq
EditState
,
LeafState
leafEditorToEditor
::
!(
LeafEditor
edit
st
a
)
->
Editor
a
|
JS
Decode
{|*|}
edit
&
JS
ONEncode
{|*|},
JSONDecode
{|*|}
st
leafEditorToEditor
::
!(
LeafEditor
edit
st
a
)
->
Editor
a
|
JSONEncode
{|*|},
JSONDecode
{|*|}
st
leafEditorToEditor
leafEditor
=
leafEditorToEditor_
JSONEncode
{|*|}
JSONDecode
{|*|}
leafEditor
leafEditorToEditor_
::
!(
Bool
st
->
[
JSONNode
])
!(
Bool
[
JSONNode
]
->
(!
Maybe
st
,
![
JSONNode
]))
!(
LeafEditor
edit
st
a
)
->
Editor
a
|
JSDecode
{|*|}
edit
->
Editor
a
leafEditorToEditor_
jsonEncode
jsonDecode
leafEditor
=
{
Editor
|
genUI
=
genUI
,
onEdit
=
onEdit
,
onRefresh
=
onRefresh
,
valueFromState
=
valueFromState
}
where
genUI
attr
dp
val
vst
=
mapRes
False
$
leafEditor
.
LeafEditor
.
genUI
attr
dp
val
vst
onEdit
dp
(
tp
,
jsone
)
(
LeafState
{
state
})
vst
=
case
fromJSON`
state
of
Just
st
=
case
decodeOnServer
jsone
of
Just
st
=
undef
/*case decodeOnServer jsone of // FIXME: decodeOnServer
Just e = mapRes True $ leafEditor.LeafEditor.onEdit dp (tp, e) st vst
_
=
(
Error
(
"Invalid edit event for leaf editor: "
+++
toString
jsone
),
vst
)
_ = (Error ("Invalid edit event for leaf editor: " +++ toString jsone), vst)
*/
_
=
(
Error
"Corrupt internal state in leaf editor"
,
vst
)
onEdit
_
_
_
vst
=
(
Error
"Corrupt editor state in leaf editor"
,
vst
)
...
...
@@ -152,7 +152,7 @@ withClientSideInit ::
!(
UIAttributes
DataPath
a
*
VSt
->
*(!
MaybeErrorString
(!
UI
,
!
st
),
!*
VSt
))
!
UIAttributes
!
DataPath
!
a
!*
VSt
->
*(!
MaybeErrorString
(!
UI
,
!
st
),
!*
VSt
)
withClientSideInit
initUI
genUI
attr
dp
val
vst
=:{
VSt
|
taskId
}
=
case
genUI
attr
dp
val
vst
of
(
Ok
(
UI
type
attr
items
,
mask
),
vst
=:{
VSt
|
iworld
})
->
case
serialize_for_client
initUI
iworld
of
(
Ok
(
UI
type
attr
items
,
mask
),
vst
=:{
VSt
|
iworld
})
->
case
serialize_for_client
initUI
`
iworld
of
(
Ok
initUI
,
iworld
)
#
extraAttr
=
'
DM
'.
fromList
[(
"taskId"
,
JSONString
taskId
)
...
...
@@ -163,3 +163,6 @@ withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr
(
Error
e
,
iworld
)
->
(
Error
e
,
{
VSt
|
vst
&
iworld
=
iworld
})
e
->
e
where
initUI`
::
Int
*
JSWorld
->
*
JSWorld
initUI`
ref_to_js_elem
world
=
initUI
(
referenceToJS
ref_to_js_elem
)
world
Libraries/iTasks/UI/Editor/Controls.dcl
View file @
c138a5c5
...
...
@@ -5,7 +5,6 @@ definition module iTasks.UI.Editor.Controls
*/
from
iTasks
.
UI
.
Editor
import
::
Editor
from
iTasks
.
UI
.
Definition
import
::
UIAttributes
,
::
UIType
from
iTasks
.
UI
.
JS
.
Encoding
import
generic
JSDecode
from
Data
.
Maybe
import
::
Maybe
from
Data
.
Map
import
::
Map
from
Text
.
HTML
import
::
HtmlTag
...
...
@@ -126,7 +125,7 @@ withConstantChoices :: !choices !(Editor (!choices, ![Int])) -> Editor [Int]
fieldComponent
::
!
UIType
!(
Maybe
a
)
!(
UIAttributes
a
->
Bool
)
->
Editor
a
|
JSONDecode
{|*|},
JSONEncode
{|*|},
gEq
{|*|}
a
&
JSDecode
{|*|}
a
|
JSONDecode
{|*|},
JSONEncode
{|*|},
gEq
{|*|}
a
//Convenient types for describing the values of grids and trees
::
ChoiceText
=
...
...
Libraries/iTasks/UI/Editor/Controls.icl
View file @
c138a5c5
...
...
@@ -122,7 +122,7 @@ where
//Field like components for which simply knowing the UI type is sufficient
fieldComponent
::
!
UIType
!(
Maybe
a
)
!(
UIAttributes
a
->
Bool
)
->
Editor
a
|
JSONDecode
{|*|},
JSONEncode
{|*|},
gEq
{|*|}
a
&
JSDecode
{|*|}
a
|
JSONDecode
{|*|},
JSONEncode
{|*|},
gEq
{|*|}
a
fieldComponent
type
mbEditModeInitValue
isValid
=
disableOnView
$
editorWithJSONEncode
(
leafEditorToEditor
o
leafEditor
)
where
leafEditor
toJSON
=
...
...
Libraries/iTasks/UI/JS/Encoding.dcl
deleted
100644 → 0
View file @
c7c36e69
definition
module
iTasks
.
UI
.
JS
.
Encoding
/**
* This module provides encoding/decoding functions for communicating values efficiently
* between an itasks server application and its client (webbrowser).
* It uses an encoding of Clean values as JSON that can be decoded natively in javascript
*/
import
iTasks
.
UI
.
JS
.
Interface
import
StdGeneric
from
Text
.
GenJSON
import
::
JSONNode
(..)
from
StdList
import
!!
from
StdMaybe
import
::
Maybe
from
StdInt
import
bitand
,
<<
from
StdClass
import
class
IncDec
(
inc
)
//Sending values server -> client
encodeOnServer
::
!
a
->
JSONNode
|
JSEncode
{|*|}
a
//Don't specialize JSEncode, it will break decoding
decodeOnClient
::
!(
JSVal
a
)
!*
JSWorld
->
*(!
a
,
!*
JSWorld
)
//Sending values client -> server
encodeOnClient
::
!
a
*
JSWorld
->
(!
JSVal
a
,
!*
JSWorld
)
decodeOnServer
::
!
JSONNode
->
(
Maybe
a
)
|
JSDecode
{|*|}
a
//Don't specialize JSDecode, it will break on the fixed encoding
generic
JSEncode
t
::
!
t
->
[
JSONNode
]
derive
JSEncode
Int
,
Real
,
Char
,
Bool
,
String
,
UNIT
,
[],
(),
(,),
(,,),
(,,,),
(,,,,),
(,,,,,),
(,,,,,,),
(,,,,,,,),
{},
{!},
(->),
EITHER
,
OBJECT
,
Maybe
,
JSONNode
JSEncode
{|
CONS
of
{
gcd_name
,
gcd_index
,
gcd_strict_arguments
}|}
fx
(
CONS
x
)
=
[
JSONArray
[
JSONInt
gcd_index
,
JSONString
gcd_name
:
[
if
(
gcd_strict_arguments
bitand
(
1
<<
i
)
==
0
)
arg
(
case
arg
of
JSONArray
[
arr
]
->
arr
;
arr
->
arr
)
\\
arg
<-
fx
x
&
i
<-
[
0
..]]]]
JSEncode
{|
RECORD
of
{
grd_name
}|}
fx
(
RECORD
x
)
=
[
JSONArray
[
JSONInt
0
,
JSONString
(
"_"
+++
grd_name
)
:
fx
x
]]
JSEncode
{|
FIELD
of
{
gfd_cons
,
gfd_index
}|}
fx
(
FIELD
x
)
|
gfd_cons
.
grd_strict_fields
bitand
(
1
<<
gfd_index
)
==
0
=
fx
x
=
case
fx
x
of
[
JSONArray
[
arr
]]
->
[
arr
]
arr
->
arr
JSEncode
{|
PAIR
|}
fx
fy
(
PAIR
x
y
)
=
fx
x
++
fy
y
where
(++)
infixr
5
::![.
a
]
!
u
:[.
a
]
->
u
:[.
a
]
(++)
[
hd
:
tl
]
list
=
[
hd
:
tl
++
list
]
(++)
nil
list
=
list
generic
JSDecode
t
::
![
JSONNode
]
->
(!
Maybe
t
,![
JSONNode
])
derive
JSDecode
Int
,
Real
,
Char
,
Bool
,
String
,
UNIT
,
EITHER
,
CONS
of
{
gcd_name
},
OBJECT
,
[],
(),
(,),
(,,),
(,,,),
(,,,,),
(,,,,,),
(,,,,,,),
(,,,,,,,),
{},
{!},
Maybe
,
JSONNode
JSDecode
{|
PAIR
|}
fx
fy
l
=
d1
fy
(
fx
l
)
l
where
d1
::
!([
JSONNode
]
->
(!
Maybe
b
,
![
JSONNode
]))
!(!
Maybe
a
,
![
JSONNode
])
![
JSONNode
]
->
(!
Maybe
(
PAIR
a
b
),
![
JSONNode
])
d1
fy
(
Just
x
,
xs
)
l
=
d2
x
(
fy
xs
)
l
d1
_
(
Nothing
,
_)
l
=
(
Nothing
,
l
)
d2
::
!
a
!(!
Maybe
b
,
![
JSONNode
])
![
JSONNode
]
->
(!
Maybe
(
PAIR
a
b
),
![
JSONNode
])
d2
x
(
Just
y
,
ys
)
l
=
(
Just
(
PAIR
x
y
),
ys
)
d2
x
(
Nothing
,
_)
l
=
(
Nothing
,
l
)
JSDecode
{|
RECORD
|}
fx
l
=:[
obj
=:
JSONObject
fields
:
xs
]
=
d
(
fx
[
obj
])
xs
l
where
d
::
!(
Maybe
a
,
b
)
![
JSONNode
]
![
JSONNode
]
->
(!
Maybe
(
RECORD
a
),
![
JSONNode
])
d
(
Just
x
,
_)
xs
l
=
(
Just
(
RECORD
x
),
xs
)
d
(
Nothing
,
_)
xs
l
=
(
Nothing
,
l
)
JSDecode
{|
RECORD
|}
fx
l
=:[
obj
=:
JSONArray
fields
:
xs
]
=
d
(
fx
[
obj
])
xs
l
where
d
::
!(
Maybe
a
,
b
)
![
JSONNode
]
![
JSONNode
]
->
(!
Maybe
(
RECORD
a
),
![
JSONNode
])
d
(
Just
x
,
_)
xs
l
=
(
Just
(
RECORD
x
),
xs
)
d
(
Nothing
,
_)
xs
l
=
(
Nothing
,
l
)
JSDecode
{|
RECORD
|}
fx
l
=
(
Nothing
,
l
)
JSDecode
{|
FIELD
of
{
gfd_name
}|}
fx
l
=:[
JSONObject
fields
]
#!
field
=
findField
gfd_name
fields
=
case
fx
field
of
(
Just
x
,
_)
=
(
Just
(
FIELD
x
),
l
)
(_,
_)
=
(
Nothing
,
l
)
where
findField
::
!
String
![(!
String
,
!
JSONNode
)]
->
[
JSONNode
]
findField
match
[(
l
,
x
):
xs
]
|
l
==
match
=
[
x
]
|
otherwise
=
findField
match
xs
findField
match
[]
=
[]
JSDecode
{|
FIELD
of
{
gfd_index
}|}
fx
l
=:[
JSONArray
fields
]
#!
field
=
fields
!!
gfd_index
=
case
fx
[
field
]
of
(
Just
x
,
_)
=
(
Just
(
FIELD
x
),
l
)
(_,
_)
=
(
Nothing
,
l
)
JSDecode
{|
FIELD
|}
fx
l
=
(
Nothing
,
l
)
Libraries/iTasks/UI/JS/Encoding.icl
deleted
100644 → 0
View file @
c7c36e69
implementation
module
iTasks
.
UI
.
JS
.
Encoding
import
iTasks
.
UI
.
JS
.
Interface
import
Text
.
GenJSON
import
Text
.
Encodings
.
Base64
import
StdMisc
,
StdArray
,
StdTuple
,
StdList
import
dynamic_string
/*
When we encode values on the server we directly encode to the representation used by the Sapl run-time such that
additional decoding on the client is not longer necessary.
*/
/*
* Format of sapl representation:
ADTs:
[<index of cons>,<name of cons>, <args ...>]
Records (same as ADT, record type with an underscore prepended is used as cons name):
[0, '_' + <name of type>, <args ...>]
Primitives:
[<boxed primitive>]
Thunks:
[<function ref>,[<args ...>]]
*/
encodeOnServer
::
!
a
->
JSONNode
|
JSEncode
{|*|}
a
encodeOnServer
x
=
case
JSEncode
{|*|}
x
of
[
node
]
=
node
_
=
JSONError
decodeOnClient
::
!(
JSVal
a
)
!*
JSWorld
->
*(!
a
,
!*
JSWorld
)
decodeOnClient
val
world
=
undef
//Implemented in iTasks/Sapl FFI
generic
JSEncode
t
::
!
t
->
[
JSONNode
]
JSEncode
{|
Int
|}
x
=
[
JSONArray
[
JSONInt
x
]]
JSEncode
{|
Real
|}
x
=
[
JSONArray
[
JSONReal
x
]]
JSEncode
{|
Char
|}
x
=
[
JSONArray
[
JSONString
{
x
}]]
JSEncode
{|
Bool
|}
x
=
[
JSONArray
[
JSONBool
x
]]
JSEncode
{|
String
|}
x
=
[
JSONArray
[
JSONString
x
]]
JSEncode
{|
UNIT
|}
(
UNIT
)
=
[]
JSEncode
{|
PAIR
|}
fx
fy
(
PAIR
x
y
)
=
fx
x
++
fy
y
where
(++)
infixr
5
::![.
a
]
!
u
:[.
a
]
->
u
:[.
a
]
(++)
[
hd
:
tl
]
list
=
[
hd
:
tl
++
list
]
(++)
nil
list
=
list
JSEncode
{|
EITHER
|}
fx
fy
(
LEFT
x
)
=
fx
x
JSEncode
{|
EITHER
|}
fx
fy
(
RIGHT
y
)
=
fy
y
JSEncode
{|
OBJECT
|}
fx
(
OBJECT
x
)
=
fx
x
JSEncode
{|
CONS
of
{
gcd_name
,
gcd_index
,
gcd_strict_arguments
}|}
fx
(
CONS
x
)
=
[
JSONArray
[
JSONInt
gcd_index
,
JSONString
gcd_name
:
[
if
(
gcd_strict_arguments
bitand
(
1
<<
i
)
==
0
)
arg
(
case
arg
of
JSONArray
[
arr
]
->
arr
;
arr
->
arr
)
\\
arg
<-
fx
x
&
i
<-
[
0
..]]]]
JSEncode
{|
RECORD
of
{
grd_name
}|}
fx
(
RECORD
x
)
=
[
JSONArray
[
JSONInt
0
,
JSONString
(
"_"
+++
grd_name
)
:
fx
x
]]
JSEncode
{|
FIELD
of
{
gfd_cons
,
gfd_index
}|}
fx
(
FIELD
x
)
|
gfd_cons
.
grd_strict_fields
bitand
(
1
<<
gfd_index
)
==
0
=
fx
x
=
case
fx
x
of
[
JSONArray
[
arr
]]
->
[
arr
]
arr
->
arr
JSEncode
{|{}|}
fx
x
=
[
JSONArray
(
flatten
[
fx
e
\\
e
<-:
x
])]
JSEncode
{|{!}|}
fx
x
=
[
JSONArray
(
flatten
[
fx
e
\\
e
<-:
x
])]
JSEncode
{|(->)|}
fx
fy
x
=
[
JSONString
"error"
]
JSEncode
{|
JSONNode
|}
node
=
[
node
]
derive
JSEncode
[],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),
Maybe
encodeOnClient
::
!
a
*
JSWorld
->
(!
JSVal
a
,
!*
JSWorld
)
encodeOnClient
val
world
=
undef
//Implemented in iTasks/Sapl FFI
decodeOnServer
::
!
JSONNode
->
(
Maybe
a
)
|
JSDecode
{|*|}
a
decodeOnServer
node
=
fst
(
JSDecode
{|*|}
[
node
])
//Currently, this is just a copy of JSONDecode without the special treatment of maybe values
//but the encoding could be further optimized for its use in editlets
generic
JSDecode
t
::
![
JSONNode
]
->
(!
Maybe
t
,
![
JSONNode
])
JSDecode
{|
Int
|}
[
JSONInt
i
:
xs
]
=
(
Just
i
,
xs
)
JSDecode
{|
Int
|}
l
=
(
Nothing
,
l
)
JSDecode
{|
Real
|}
[
JSONReal
r
:
xs
]
=
(
Just
r
,
xs
)
JSDecode
{|
Real
|}
[
JSONInt
i
:
xs
]
=
(
Just
(
toReal
i
),
xs
)
JSDecode
{|
Real
|}
l
=
(
Nothing
,
l
)
JSDecode
{|
Char
|}
l
=:[
JSONString
s
:
xs
]
|
size
s
==
1
=
(
Just
s
.[
0
],
xs
)
=
(
Nothing
,
l
)
JSDecode
{|
Char
|}
l
=
(
Nothing
,
l
)
JSDecode
{|
Bool
|}
[
JSONBool
b
:
xs
]
=
(
Just
b
,
xs
)
JSDecode
{|
Bool
|}
l
=
(
Nothing
,
l
)
JSDecode
{|
String
|}
[
JSONString
s
:
xs
]
=
(
Just
s
,
xs
)
JSDecode
{|
String
|}
l
=
(
Nothing
,
l
)
JSDecode
{|
UNIT
|}
l
=
(
Just
UNIT
,
l
)
JSDecode
{|
PAIR
|}
fx
fy
l
=
d1
fy
(
fx
l
)
l
where
d1
::
!([
JSONNode
]
->
(!
Maybe
b
,
![
JSONNode
]))
!(!
Maybe
a
,
![
JSONNode
])
![
JSONNode
]
->
(!
Maybe
(
PAIR
a
b
),
![
JSONNode
])
d1
fy
(
Just
x
,
xs
)
l
=
d2
x
(
fy
xs
)
l
d1
_
(
Nothing
,
_)
l
=
(
Nothing
,
l
)
d2
::
!
a
!(!
Maybe
b
,
![
JSONNode
])
![
JSONNode
]
->
(!
Maybe
(
PAIR
a
b
),
![
JSONNode
])
d2
x
(
Just
y
,
ys
)
l
=
(
Just
(
PAIR
x
y
),
ys
)
d2
x
(
Nothing
,
_)
l
=
(
Nothing
,
l
)
JSDecode
{|
EITHER
|}
fx
fy
l
=
case
fx
l
of
(
Just
x
,
xs
)
=
(
Just
(
LEFT
x
),
xs
)
(
Nothing
,
xs
)
=
case
fy
l
of
(
Just
y
,
ys
)
=
(
Just
(
RIGHT
y
),
ys
)
(
Nothing
,
ys
)
=
(
Nothing
,
l
)
JSDecode
{|
OBJECT
|}
fx
l
=
case
fx
l
of
(
Just
x
,
xs
)
=
(
Just
(
OBJECT
x
),
xs
)
_
=
(
Nothing
,
l
)
JSDecode
{|
CONS
of
{
gcd_name
}|}
fx
l
=:[
JSONArray
[
JSONString
name
:
fields
]
:
xs
]
|
name
==
gcd_name
=
case
fx
fields
of
(
Just
x
,
_)
=
(
Just
(
CONS
x
),
xs
)
_
=
(
Nothing
,
l
)
|
otherwise
=
(
Nothing
,
l
)
JSDecode
{|
CONS
|}
fx
l
=
(
Nothing
,
l
)
JSDecode
{|
RECORD
|}
fx
l
=:[
obj
=:
JSONObject
fields
:
xs
]
=
d
(
fx
[
obj
])
xs
l
where
d
::
!(!
Maybe
a
,
b
)
![
JSONNode
]
![
JSONNode
]
->
(!
Maybe
(
RECORD
a
),
![
JSONNode
])
d
(
Just
x
,
_)
xs
l
=
(
Just
(
RECORD
x
),
xs
)
d
(
Nothing
,
_)
xs
l
=
(
Nothing
,
l
)
JSDecode
{|
RECORD
|}
fx
l
=:[
obj
=:
JSONArray
fields
:
xs
]
=
d
(
fx
[
obj
])
xs
l
where
d
::
!(!
Maybe
a
,
b
)
![
JSONNode
]
![
JSONNode
]
->
(!
Maybe
(
RECORD
a
),
![
JSONNode
])
d
(
Just
x
,
_)
xs
l
=
(
Just
(
RECORD
x
),
xs
)
d
(
Nothing
,
_)
xs
l
=
(
Nothing
,
l
)
JSDecode
{|
RECORD
|}
fx
l
=
(
Nothing
,
l
)
JSDecode
{|
FIELD
of
{
gfd_name
}|}
fx
l
=:[
JSONObject
fields
]