Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-libraries
Commits
a03eb145
Commit
a03eb145
authored
Nov 14, 2006
by
Peter Achten
Browse files
refactoring modules
parent
e14033b3
Changes
12
Expand all
Hide whitespace changes
Inline
Side-by-side
libraries/htmlGEC/EncodeDecode.icl
View file @
a03eb145
...
...
@@ -87,7 +87,7 @@ where
DecodeHtmlStatesAndUpdate
::
ServerKind
(
Maybe
String
)
->
([
HtmlState
],
String
,
String
)
DecodeHtmlStatesAndUpdate
serverkind
args
#
(_,
triplet
,
update
,
state
)
=
DecodeArguments
serverkind
args
=
([
states
\\
states
=:(
id
,_,_,
nstate
)
<-
DecodeHtmlStates
state
|
id
<>
""
||
nstate
<>
""
],
triplet
,
update
)
// to be sure that no rubis
c
h is passed on
=
([
states
\\
states
=:(
id
,_,_,
nstate
)
<-
DecodeHtmlStates
state
|
id
<>
""
||
nstate
<>
""
],
triplet
,
update
)
// to be sure that no rub
b
ish is passed on
// Parse and decode low level information obtained from server
// In case of using a php script and external server:
...
...
libraries/htmlGEC/PrintUtil.dcl
View file @
a03eb145
definition
module
PrintUtil
// a collection of
handy
print routines to write html to Std Output
// a collection of print routines to write html to Std Output
// (c) MJP 2005
import
StdGeneric
...
...
@@ -8,38 +8,39 @@ import StdFile
import
StdStrictLists
import
Gerda
::
*
HtmlStream
:==
[#
String
!]
::
*
HtmlStream
:==
[#
String
!]
::
FoF
:==
(*
HtmlStream
->
*
HtmlStream
)
::
FoF
:==
(*
HtmlStream
->
*
HtmlStream
)
::
*
NWorld
// io interface
=
{
worldC
::
!*
World
// world for any io
,
inout
::
!*
HtmlStream
// to read from stdin and write to stdout
,
gerda
::
*
Gerda
// to read and write to the database
=
{
worldC
::
!*
World
// world for any io
,
inout
::
!*
HtmlStream
// to read from stdin and write to stdout
,
gerda
::
*
Gerda
// to read and write to the database
}
instance
FileSystem
NWorld
appWorldNWorld
::
!.(*
World
->
*
World
)
!*
NWorld
->
*
NWorld
accWorldNWorld
::
!.(*
World
->
*(.
a
,*
World
))
!*
NWorld
->
(.
a
,!*
NWorld
)
appWorldNWorld
::
!.(*
World
->
*
World
)
!*
NWorld
->
*
NWorld
accWorldNWorld
::
!.(*
World
->
*(.
a
,*
World
))
!*
NWorld
->
(.
a
,!*
NWorld
)
// generic function for printing tags
// Constructors are converted to html tag strings
// prefix Name_ of Name_Attrname is removed, and Name is converted to lowercase string
generic
gHpr
a
::
!*
HtmlStream
!
a
->
*
HtmlStream
generic
gHpr
a
::
!*
HtmlStream
!
a
->
*
HtmlStream
derive
gHpr
UNIT
,
PAIR
,
EITHER
,
CONS
,
OBJECT
derive
gHpr
Int
,
Real
,
Bool
,
String
,
Char
,
[]
// the main print routine
print_to_stdout
::
a
*
NWorld
->
*
NWorld
|
gHpr
{|*|}
a
print_to_stdout
::
!
a
!
*
NWorld
->
*
NWorld
|
gHpr
{|*|}
a
// handy utility print routines
print
::
!
String
->
FoF
(<+)
infixl
::
!*
HtmlStream
!
a
->
*
HtmlStream
|
gHpr
{|*|}
a
(<+>)
infixl
::
!*
HtmlStream
FoF
->
*
HtmlStream
(<+)
infixl
::
!*
HtmlStream
!
a
->
*
HtmlStream
|
gHpr
{|*|}
a
(<+>)
infixl
::
!*
HtmlStream
!
FoF
->
*
HtmlStream
htmlAttrCmnd
::
!
hdr
!
tag
!
body
->
FoF
|
gHpr
{|*|}
hdr
&
gHpr
{|*|}
tag
&
gHpr
{|*|}
body
openCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
styleCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
...
...
libraries/htmlGEC/PrintUtil.icl
View file @
a03eb145
...
...
@@ -9,18 +9,18 @@ import Gerda
generic
gHpr
a
::
!*
HtmlStream
!
a
->
*
HtmlStream
gHpr
{|
String
|}
file
s
=
[|
s
:
file
]
// the only entry that actualy prints something
gHpr
{|
String
|}
file
s
=
[|
s
:
file
]
// the only entry that actual
l
y prints something
// all others eventually come here converted to string
gHpr
{|
Int
|}
file
i
=
[|
toString
i
:
file
]
gHpr
{|
Real
|}
file
r
=
[|
toString
r
:
file
]
gHpr
{|
Bool
|}
file
b
=
[|
toString
b
:
file
]
gHpr
{|
Char
|}
file
c
=
[|
toString
c
:
file
]
gHpr
{|
UNIT
|}
file
_
=
file
gHpr
{|
PAIR
|}
gHpra
gHprb
file
(
PAIR
a
b
)
=
gHprb
(
gHpra
file
a
)
b
gHpr
{|
EITHER
|}
gHprl
gHprr
file
(
LEFT
left
)
=
gHprl
file
left
gHpr
{|
EITHER
|}
gHprl
gHprr
file
(
RIGHT
right
)
=
gHprr
file
right
gHpr
{|
OBJECT
|}
gHpro
file
(
OBJECT
object
)=
gHpro
file
object
gHpr
{|
Int
|}
file
i
=
[|
toString
i
:
file
]
gHpr
{|
Real
|}
file
r
=
[|
toString
r
:
file
]
gHpr
{|
Bool
|}
file
b
=
[|
toString
b
:
file
]
gHpr
{|
Char
|}
file
c
=
[|
toString
c
:
file
]
gHpr
{|
UNIT
|}
file
_
=
file
gHpr
{|
PAIR
|}
gHpra
gHprb
file
(
PAIR
a
b
)
=
gHprb
(
gHpra
file
a
)
b
gHpr
{|
EITHER
|}
gHprl
gHprr
file
(
LEFT
left
)
=
gHprl
file
left
gHpr
{|
EITHER
|}
gHprl
gHprr
file
(
RIGHT
right
)
=
gHprr
file
right
gHpr
{|
OBJECT
|}
gHpro
file
(
OBJECT
object
)=
gHpro
file
object
gHpr
{|
CONS
of
t
|}
gPrHtmlc
prev
(
CONS
c
)
// constructor names are printed, prefix Foo_ is stripped
=
case
t
.
gcd_name
.[
0
]
of
...
...
@@ -46,60 +46,53 @@ where
myfold
file
[
x
:
xs
]
=
myfold
(
gHlist
file
x
)
xs
myfold
file
[]
=
file
//
o
utility print functions based on gHpr
// utility print functions based on gHpr
print
::
!
String
->
FoF
print
a
=
\
f
->
[|
a
:
f
]
print
::
!
String
->
FoF
print
a
=
\
f
->
[|
a
:
f
]
(<+)
infixl
::
!*
HtmlStream
!
a
->
*
HtmlStream
|
gHpr
{|*|}
a
(<+)
file
new
=
gHpr
{|*|}
file
new
(<+)
infixl
::
!*
HtmlStream
!
a
->
*
HtmlStream
|
gHpr
{|*|}
a
(<+)
file
new
=
gHpr
{|*|}
file
new
(<+>)
infixl
::
!*
HtmlStream
FoF
->
*
HtmlStream
(<+>)
file
new
=
new
file
(<+>)
infixl
::
!*
HtmlStream
!
FoF
->
*
HtmlStream
(<+>)
file
new
=
new
file
print_to_stdout
::
a
*
NWorld
->
*
NWorld
|
gHpr
{|*|}
a
print_to_stdout
::
!
a
!
*
NWorld
->
*
NWorld
|
gHpr
{|*|}
a
print_to_stdout
value
nw
=:{
worldC
,
inout
}
#
inout
=
inout
<+
value
=
{
nw
&
inout
=
inout
}
htmlCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
htmlCmnd
hdr
txt
=
\
file
->
closeCmnd
hdr
(
openCmnd
hdr
""
file
<+
txt
)
htmlCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
htmlCmnd
hdr
txt
=
\
file
->
closeCmnd
hdr
(
openCmnd
hdr
""
file
<+
txt
)
openCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
openCmnd
hdr
attr
=
\
file
->
[|
"<"
:
file
]
<+
hdr
<+
attr
<+
">"
openCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
openCmnd
hdr
attr
=
\
file
->
[|
"<"
:
file
]
<+
hdr
<+
attr
<+
">"
closeCmnd
::
!
a
->
FoF
|
gHpr
{|*|}
a
closeCmnd
hdr
=
\
file
->
print
"</"
file
<+
hdr
<+
">"
closeCmnd
::
!
a
->
FoF
|
gHpr
{|*|}
a
closeCmnd
hdr
=
\
file
->
print
"</"
file
<+
hdr
<+
">"
htmlAttrCmnd
::
!
hdr
!
attr
!
body
->
FoF
|
gHpr
{|*|}
hdr
&
gHpr
{|*|}
attr
&
gHpr
{|*|}
body
htmlAttrCmnd
hdr
attr
txt
=
\
file
->
closeCmnd
hdr
(
openCmnd
hdr
attr
file
<+
txt
)
htmlAttrCmnd
::
!
hdr
!
attr
!
body
->
FoF
|
gHpr
{|*|}
hdr
&
gHpr
{|*|}
attr
&
gHpr
{|*|}
body
htmlAttrCmnd
hdr
attr
txt
=
\
file
->
closeCmnd
hdr
(
openCmnd
hdr
attr
file
<+
txt
)
styleCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
styleCmnd
stylename
attr
=
\
file
->
print
"."
file
<+
stylename
<+
"{"
<+
attr
<+
"}"
styleCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
style
Cmnd
stylename
attr
=
\
file
->
print
"
.
"
file
<+
style
name
<+
"
{
"
<+
attr
<+
"
}
"
style
Attr
Cmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
style
AttrCmnd
name
value
=
\
file
->
print
""
file
<+
name
<+
"
:
"
<+
value
<+
"
;
"
styleAttrCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
styleAttrCmnd
name
value
=
\
file
->
print
""
file
<+
name
<+
": "
<+
value
<+
";"
instance
FileSystem
NWorld
where
fopen
::
!{#
Char
}
!
Int
!*
NWorld
->
(!
Bool
,!*
File
,!*
NWorld
)
instance
FileSystem
NWorld
where
fopen
string
int
nworld
=:{
worldC
}
#
(
bool
,
file
,
worldC
)
=
fopen
string
int
worldC
=
(
bool
,
file
,{
nworld
&
worldC
=
worldC
})
fclose
::
!*
File
!*
NWorld
->
(!
Bool
,!*
NWorld
)
fclose
file
nworld
=:{
worldC
}
#
(
bool
,
worldC
)
=
fclose
file
worldC
=
(
bool
,{
nworld
&
worldC
=
worldC
})
stdio
::
!*
NWorld
->
(!*
File
,!*
NWorld
)
stdio
nworld
=:{
worldC
}
#
(
file
,
worldC
)
=
stdio
worldC
=
(
file
,{
nworld
&
worldC
=
worldC
})
sfopen
::
!{#
Char
}
!
Int
!*
NWorld
->
(!
Bool
,!
File
,!*
NWorld
)
sfopen
string
int
nworld
=:{
worldC
}
#
(
bool
,
file
,
worldC
)
=
sfopen
string
int
worldC
=
(
bool
,
file
,{
nworld
&
worldC
=
worldC
})
...
...
libraries/htmlGEC/StdHtml.dcl
View file @
a03eb145
...
...
@@ -12,8 +12,8 @@ import
,
htmlHandler
// the kernel module for iData creation and handling
,
htmlButtons
// basic collections of buttons, data types for lay-out control
,
htmlFormlib
//
handy
collection of advanced iData creating functions
,
htmlRefFormlib
//
handy
collection of persistent idata maintaining sharing
,
htmlFormlib
// collection of advanced iData creating functions
,
htmlRefFormlib
// collection of persistent idata maintaining sharing
,
htmlArrow
// arrow instantiations for iData forms
...
...
libraries/htmlGEC/htmlArrow.dcl
View file @
a03eb145
...
...
@@ -24,17 +24,15 @@ edit :: (FormId a) -> GecCircuit a a | iData a
display
::
(
FormId
a
)
->
GecCircuit
a
a
|
iData
a
store
::
(
FormId
a
)
->
GecCircuit
(
a
->
a
)
a
|
iData
a
feedback
::
(
GecCircuit
a
b
)
(
GecCircuit
b
a
)
->
(
GecCircuit
a
b
)
feedback
::
!
(
GecCircuit
a
b
)
!
(
GecCircuit
b
a
)
->
GecCircuit
a
b
self
::
(
a
->
a
)
(
GecCircuit
a
a
)
->
GecCircuit
a
a
self
::
(
a
->
a
)
!
(
GecCircuit
a
a
)
->
GecCircuit
a
a
loops
::
(
GecCircuit
(
a
,
b
)
(
c
,
b
))
->
GecCircuit
a
c
|
iData
b
loops
::
!
(
GecCircuit
(
a
,
b
)
(
c
,
b
))
->
GecCircuit
a
c
|
iData
b
(
`
bindC`
)
infix
0
::
(
GecCircuit
a
b
)
(
b
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindCI`
)
infix
0
::
(
GecCircuit
a
b
)
((
Form
b
)
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindC`
)
infix
0
::
!
(
GecCircuit
a
b
)
(
b
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindCI`
)
infix
0
::
!
(
GecCircuit
a
b
)
((
Form
b
)
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
// to lift library functions to the circuit domain
lift
::
!(
InIDataId
a
)
(!(
InIDataId
a
)
!*
HSt
->
(!
Form
b
,!*
HSt
))
->
(
GecCircuit
a
b
)
//lift :: !(FormId a) (!(InIDataId a) !*HSt -> (!Form b,!*HSt)) -> (GecCircuit a b)
lift
::
!(
InIDataId
a
)
(!(
InIDataId
a
)
!*
HSt
->
(!
Form
b
,!*
HSt
))
->
GecCircuit
a
b
libraries/htmlGEC/htmlArrow.icl
View file @
a03eb145
...
...
@@ -23,17 +23,13 @@ where
::
GecCircuitChanged
:==
Bool
instance
Arrow
GecCircuit
where
arr
::
(
a
->
b
)
->
GecCircuit
a
b
instance
Arrow
GecCircuit
where
arr
fun
=
HGC
fun`
where
fun`
((
a
,
body
),
ch
,
hst
)
=
((
fun
a
,
body
),
ch
,
hst
)
(>>>)
infixr
1
::
(
GecCircuit
a
b
)
(
GecCircuit
b
c
)
->
GecCircuit
a
c
(>>>)
(
HGC
gec_ab
)
(
HGC
gec_bc
)
=
HGC
(
gec_bc
o
gec_ab
)
first
::
(
GecCircuit
a
b
)
->
GecCircuit
(
a
,
c
)
(
b
,
c
)
first
(
HGC
gec_ab
)
=
HGC
first`
where
first`
(((
a
,
c
),
prevbody
),
ch
,
hst
)
...
...
@@ -61,13 +57,13 @@ where
#
(
store
,
hst
)
=
mkStoreForm
(
Init
,
formid
)
fun
hst
=
((
store
.
value
,[(
formid
.
id
,
BodyTag
store
.
form
):
prevbody
]),
ch
||
store
.
changed
,
hst
)
self
::
(
a
->
a
)
(
GecCircuit
a
a
)
->
GecCircuit
a
a
self
::
(
a
->
a
)
!
(
GecCircuit
a
a
)
->
GecCircuit
a
a
self
fun
gecaa
=
feedback
gecaa
(
arr
fun
)
feedback
::
(
GecCircuit
a
b
)
(
GecCircuit
b
a
)
->
(
GecCircuit
a
b
)
feedback
::
!
(
GecCircuit
a
b
)
!
(
GecCircuit
b
a
)
->
(
GecCircuit
a
b
)
feedback
(
HGC
gec_ab
)
(
HGC
gec_ba
)
=
HGC
(
gec_ab
o
gec_ba
o
gec_ab
)
loops
::
(
GecCircuit
(
a
,
b
)
(
c
,
b
))
->
GecCircuit
a
c
|
iData
b
loops
::
!
(
GecCircuit
(
a
,
b
)
(
c
,
b
))
->
GecCircuit
a
c
|
iData
b
loops
(
HGC
gec_abcb
)
=
HGC
loopForm
where
loopForm
((
aval
,
prevbody
),
ch
,
hst
)
...
...
@@ -75,13 +71,9 @@ where
#
(((
cval
,
bval
),
bodyac
),
ch
,
hst
)
=
gec_abcb
(((
aval
,
bstore
.
value
),
prevbody
),
ch
,
hst
)
#
(
bstore
,
hst
)
=
mkStoreForm
(
Set
,
xsFormId
"??"
createDefault
)
(\_
->
bval
)
hst
=
((
cval
,
bodyac
),
ch
,
hst
)
//self fun gecaa = feedback gecaa (arr fun)
(
`
bindC`
)
infix
0
::
(
GecCircuit
a
b
)
(
b
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindC`
)
infix
0
::
!(
GecCircuit
a
b
)
(
b
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindC`
)
(
HGC
gecab
)
bgecbc
=
HGC
binds
where
binds
((
a
,
abody
),
ach
,
hst
)
...
...
@@ -89,7 +81,7 @@ where
#
(
HGC
gecbc
)
=
bgecbc
b
=
gecbc
((
b
,
bbody
++
abody
),
ach
||
bch
,
hst
)
(
`
bindCI`
)
infix
0
::
(
GecCircuit
a
b
)
((
Form
b
)
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindCI`
)
infix
0
::
!
(
GecCircuit
a
b
)
((
Form
b
)
->
GecCircuit
b
c
)
->
(
GecCircuit
a
c
)
(
`
bindCI`
)
(
HGC
gecab
)
bgecbc
=
HGC
binds
where
binds
((
a
,
abody
),
ach
,
hst
)
...
...
@@ -97,7 +89,7 @@ where
#
(
HGC
gecbc
)
=
bgecbc
{
changed
=
bch
,
value
=
b
,
form
=
map
snd
bbody
}
=
gecbc
((
b
,
bbody
++
abody
),
ach
||
bch
,
hst
)
lift
::
!(
InIDataId
a
)
(!(
InIDataId
a
)
!*
HSt
->
(!
Form
b
,!*
HSt
))
->
(
GecCircuit
a
b
)
lift
::
!(
InIDataId
a
)
(!(
InIDataId
a
)
!*
HSt
->
(!
Form
b
,!*
HSt
))
->
GecCircuit
a
b
lift
(
Set
,
formid
)
fun
=
HGC
fun`
where
fun`
((
a
,
body
),
ch
,
hst
)
...
...
@@ -108,12 +100,3 @@ where
fun`
((
a
,
body
),
ch
,
hst
)
#
(
nb
,
hst
)
=
fun
(
Init
,
setFormId
formid
a
)
hst
=
((
nb
.
value
,[(
formid
.
id
,
BodyTag
nb
.
form
):
body
]),
ch
||
nb
.
changed
,
hst
)
/*
lift :: !(FormId a) (!(InIDataId a) !*HSt -> (!Form b,!*HSt)) -> (GecCircuit a b)
lift formid fun = HGC fun`
where
fun` ((a,body),ch,hst)
# (nb,hst) = fun (setID formid a) hst
= ((nb.value,[(formid.id,BodyTag nb.form):body]),ch||nb.changed,hst)
*/
libraries/htmlGEC/htmlButtons.dcl
View file @
a03eb145
...
...
@@ -4,6 +4,7 @@ definition module htmlButtons
// (c) 2005 MJP
import
htmlHandler
import
GenLexOrd
derive
gForm
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
derive
gUpd
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
...
...
@@ -11,12 +12,16 @@ derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Bu
derive
gParse
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
derive
gerda
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
PasswordBox
instance
toBool
CheckBox
,
Button
,
RadioButton
// True if checkbox checked, button pressed
instance
toInt
PullDownMenu
// Current index in pull down list
instance
toString
PullDownMenu
// Corresponding element in pull down list
instance
==
PasswordBox
,
HtmlDate
,
HtmlTime
instance
<
HtmlDate
,
HtmlTime
instance
toString
HtmlDate
,
HtmlTime
instance
toBool
CheckBox
,
Button
,
RadioButton
// True if checkbox checked, button pressed
instance
toInt
PullDownMenu
// Current index in pull down list
instance
toString
PullDownMenu
// Corresponding element in pull down list
derive
gEq
HtmlDate
,
HtmlTime
,
PasswordBox
instance
==
HtmlDate
,
HtmlTime
,
PasswordBox
derive
gLexOrd
HtmlDate
,
HtmlTime
instance
<
HtmlDate
,
HtmlTime
instance
toString
HtmlDate
,
HtmlTime
// lay out
::
<->
a
b
=
(<->)
infixl
5
a
b
// place b to the left of a
...
...
libraries/htmlGEC/htmlButtons.icl
View file @
a03eb145
This diff is collapsed.
Click to expand it.
libraries/htmlGEC/htmlDataDef.dcl
View file @
a03eb145
This diff is collapsed.
Click to expand it.
libraries/htmlGEC/htmlFormData.icl
View file @
a03eb145
...
...
@@ -55,50 +55,50 @@ dbdDFormId :: !String !d -> FormId d; dbdDFormId s d = dbDFormId s d <@ Displa
// create id's
(++/)
infixr
5
(++/)
s1
s2
=
s1
+++
iDataIdSeparator
+++
s2
(++/)
s1
s2
=
s1
+++
iDataIdSeparator
+++
s2
extidFormId
::
!(
FormId
d
)
!
String
->
FormId
d
extidFormId
formid
s
=
formid
<@
formid
.
id
++/
s
extidFormId
formid
s
=
formid
<@
formid
.
id
++/
s
subFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subFormId
formid
s
d
=
reuseFormId
(
extidFormId
formid
s
)
d
subFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subFormId
formid
s
d
=
reuseFormId
(
extidFormId
formid
s
)
d
subnFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subnFormId
formid
s
d
=
subFormId
formid
s
d
<@
Page
subnFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subnFormId
formid
s
d
=
subFormId
formid
s
d
<@
Page
subsFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subsFormId
formid
s
d
=
subFormId
formid
s
d
<@
Session
subsFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subsFormId
formid
s
d
=
subFormId
formid
s
d
<@
Session
subpFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subpFormId
formid
s
d
=
subFormId
formid
s
d
<@
Persistent
subpFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subpFormId
formid
s
d
=
subFormId
formid
s
d
<@
Persistent
subtFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subtFormId
formid
s
d
=
subFormId
formid
s
d
<@
Temp
subtFormId
::
!(
FormId
a
)
!
String
!
d
->
FormId
d
// make new formid of new type copying other old settinf
subtFormId
formid
s
d
=
subFormId
formid
s
d
<@
Temp
setFormId
::
!(
FormId
d
)
!
d
->
FormId
d
// set new initial value in formid
setFormId
formid
d
=
{
f
orm
i
d
&
ival
=
d
}
setFormId
::
!(
FormId
d
)
!
d
->
FormId
d
// set new initial value in formid
setFormId
formid
d
=
reuseF
orm
I
d
formid
d
reuseFormId
::
!(
FormId
d
)
!
v
->
FormId
v
reuseFormId
formid
v
=
{
formid
&
ival
=
v
}
reuseFormId
formid
v
=
{
formid
&
ival
=
v
}
initID
::
!(
FormId
d
)
->
InIDataId
d
// (Init,FormId a)
initID
formid
=
(
Init
,
formid
)
initID
formid
=
(
Init
,
formid
)
setID
::
!(
FormId
d
)
!
d
->
InIDataId
d
// (Set,FormId a)
setID
formid
na
=
(
Set
,
setFormId
formid
na
)
setID
formid
na
=
(
Set
,
setFormId
formid
na
)
onMode
::
!
Mode
a
a
a
->
a
onMode
Edit
e1
e2
e3
=
e1
onMode
Display
e1
e2
e3
=
e2
onMode
NoForm
e1
e2
e3
=
e3
onMode
Edit
e1
e2
e3
=
e1
onMode
Display
e1
e2
e3
=
e2
onMode
NoForm
e1
e2
e3
=
e3
toViewId
::
!
Init
!
d
!(
Maybe
d
)
->
d
toViewId
Init
d
Nothing
=
d
toViewId
Init
d
(
Just
v
)
=
v
toViewId
_
d
_
=
d
toViewId
Init
d
Nothing
=
d
toViewId
Init
d
(
Just
v
)=
v
toViewId
_
d
_
=
d
toViewMap
::
!(
d
->
v
)
!
Init
!
d
!(
Maybe
v
)
->
v
toViewMap
f
init
d
mv
=
toViewId
init
(
f
d
)
mv
toViewMap
f
init
d
mv
=
toViewId
init
(
f
d
)
mv
derive
gEq
Mode
,
Init
,
Lifespan
instance
==
Mode
where
==
m1
m2
=
m1
===
m2
...
...
libraries/htmlGEC/htmlTrivial.dcl
View file @
a03eb145
...
...
@@ -6,10 +6,10 @@ derive bimap Maybe, (,)
// utility
mkString
::
[
Char
]
->
*
String
mkList
::
String
->
[
Char
]
mkString
::
[
Char
]
->
*
String
mkList
::
String
->
[
Char
]
// Useful string concatenation function
(<+++)
infixl
::
!
String
!
a
->
String
|
toString
a
(<+++)
infixl
::
!
String
!
a
->
String
|
toString
a
isNil
::
[
a
]
->
Bool
(??)
infixl
9
::
!
[
a
]
!
a
->
Int
|
==
a
libraries/htmlGEC/htmlTrivial.icl
View file @
a03eb145
...
...
@@ -16,8 +16,9 @@ mkList string = [c \\ c <-: string ]
(<+++)
infixl
::
!
String
!
a
->
String
|
toString
a
(<+++)
str
x
=
str
+++
toString
x
isNil
::
[
a
]
->
Bool
isNil
[]
=
True
isNil
_
=
False
(??)
infixl
9
::
![
a
]
!
a
->
Int
|
==
a
(??)
[
a
:
as
]
b
|
a
==
b
=
0
|
otherwise
=
1
+
as
??
b
(??)
[]
_
=
-1
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment