Commit 0ec6eaf0 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent b231efa5
.comp 920 000110010
.start _nostart_
.depend "_SystemEnum" "20061218140208"
.depend "StdEnum" "20061218140208"
.depend "StdMisc" "20061218140208"
.depend "StdFunc" "20061218140208"
.depend "StdCharList" "20061218140208"
.depend "StdTuple" "20061218140208"
.depend "StdOrdList" "20061218140208"
.depend "StdList" "20061218140208"
.depend "StdFile" "20061218140208"
.depend "StdString" "20061218140208"
.depend "_SystemArray" "20061218140208"
.depend "StdArray" "20061218140208"
.depend "StdChar" "20061218140208"
.depend "StdReal" "20061218140208"
.depend "StdInt" "20061218140208"
.depend "StdEnv" "20061218140208"
.depend "StdBool" "20061218140208"
.depend "StdClass" "20061218140208"
.depend "StdDynamic" "20061208183212"
.depend "StdOverloaded" "20061218140208"
.depend "_SystemDynamic" "20061208183212"
.depend "StdCleanTypes" "20061208183212"
.depend "dynamic_string" "20070709113944"
.impobj "copy_graph_to_string_interface.obj"
.impobj "copy_graph_to_string.obj"
.impobj "copy_string_to_graph_interface.obj"
.impobj "copy_string_to_graph.obj"
.module m_dynamic_string "dynamic_string" "20070709114033"
.endinfo
.implab _cycle_in_spine
.implab _type_error
.implab _hnf
.impdesc _ind
.implab _indirection _eaind
.impdesc e_system_dif
.implab e_system_nif e_system_eaif
.implab e_system_sif
.impdesc e_system_dAP
.implab e_system_nAP e_system_eaAP
.implab e_system_sAP
.impdesc _Nil
.impdesc _Cons
.impdesc _Conss
.implab n_Conss ea_Conss
.impdesc _Consts
.implab n_Consts ea_Consts
.impdesc _Conssts
.implab n_Conssts ea_Conssts
.impdesc _Tuple
.impdesc d_S.1
.implab n_S.1 ea_S.1
.impdesc d_S.2
.implab n_S.2 ea_S.2
.impdesc d_S.3
.implab n_S.3 ea_S.3
.impdesc d_S.4
.implab n_S.4 ea_S.4
.impdesc d_S.5
.implab n_S.5 ea_S.5
.impdesc d_S.6
.implab n_S.6 ea_S.6
.implab _driver
.export e_dynamic_string_sstring_to_dynamic
.descexp e_dynamic_string_dstring_to_dynamic e_dynamic_string_nstring_to_dynamic e_dynamic_string_lstring_to_dynamic 1 0 "string_to_dynamic"
.pb "string_to_dynamic"
.pld
.o 2 0
e_dynamic_string_lstring_to_dynamic
pop_a 1
.d 1 0
jsr ea2
.o 2 0
build_r e__SystemDynamic_rDynamicTemp 2 0 0 0
updatepop_a 0 2
.d 1 0
rtn
.pd
.n 1 e_dynamic_string_dstring_to_dynamic
.o 1 0
e_dynamic_string_nstring_to_dynamic
push_node _cycle_in_spine 1
.d 1 0
jsr ea2
.o 2 0
fill_r e__SystemDynamic_rDynamicTemp 2 0 2 0 0
pop_a 2
.d 1 0
rtn
.o 1 0
e_dynamic_string_sstring_to_dynamic
.pd
.d 1 0
.pn
jmp ea2
.o 1 0
.pn
ea2
jsr_eval 0
push_array 0
update_a 0 1
pop_a 1
.o 1 0
s2
push_a 0
updatepop_a 0 1
.d 1 0
jsr s4
.o 1 1 i
pop_b 1
jsr_eval 0
repl_r_args 2 0
.d 2 0
rtn
.pe
.export e_dynamic_string_scopy_from_string
.descexp e_dynamic_string_dcopy_from_string e_dynamic_string_ncopy_from_string e_dynamic_string_lcopy_from_string 1 0 "copy_from_string"
.pb "copy_from_string"
.pld
.o 2 0
e_dynamic_string_lcopy_from_string
pop_a 1
.d 1 0
jsr ea4
.o 1 1 i
buildI_b 0
push_a 1
buildh _Tuple 2
updatepop_a 0 1
pop_b 1
.d 1 0
rtn
.pd
.n 1 e_dynamic_string_dcopy_from_string
.o 1 0
e_dynamic_string_ncopy_from_string
push_node _cycle_in_spine 1
.d 1 0
jsr ea4
.o 1 1 i
buildI_b 0
push_a 1
fillh _Tuple 2 3
pop_a 1
pop_b 1
.d 1 0
rtn
.o 1 0
.pn
ea4
jsr_eval 0
push_array 0
update_a 0 1
pop_a 1
.o 1 0
e_dynamic_string_scopy_from_string
.o 1 0
s4
.d 1 0
jsr _copy_string_to_graph
.o 1 0
pushI 0
.d 1 1 i
rtn
.pe
.export e_dynamic_string_sdynamic_to_string
.descexp e_dynamic_string_ddynamic_to_string e_dynamic_string_ndynamic_to_string e_dynamic_string_ldynamic_to_string 1 0 "dynamic_to_string"
.pb "dynamic_to_string"
.pld
.o 2 0
e_dynamic_string_ldynamic_to_string
pop_a 1
.d 1 0
jsr ea1
.o 1 0
push_a 0
buildh ARRAY 1
updatepop_a 0 1
.d 1 0
rtn
.pd
.n 1 e_dynamic_string_ddynamic_to_string
.o 1 0
e_dynamic_string_ndynamic_to_string
push_node _cycle_in_spine 1
.d 1 0
jsr ea1
.o 1 0
push_a 0
fillh ARRAY 1 2
pop_a 1
.d 1 0
rtn
.o 1 0
.pn
ea1
jsr_eval 0
repl_r_args 2 0
.o 2 0
e_dynamic_string_sdynamic_to_string
.o 2 0
s1
build_r e__SystemDynamic_rDynamicTemp 2 0 0 0
updatepop_a 0 2
.d 1 0
jmp s3
.pe
.export e_dynamic_string_scopy_to_string
.descexp e_dynamic_string_dcopy_to_string e_dynamic_string_ncopy_to_string e_dynamic_string_lcopy_to_string 1 0 "copy_to_string"
.pb "copy_to_string"
.pld
.o 2 0
e_dynamic_string_lcopy_to_string
pop_a 1
.d 1 0
jsr ea3
.o 1 0
push_a 0
buildh ARRAY 1
updatepop_a 0 1
.d 1 0
rtn
.pd
.n 1 e_dynamic_string_dcopy_to_string
.o 1 0
e_dynamic_string_ncopy_to_string
push_node _cycle_in_spine 1
.d 1 0
jsr ea3
.o 1 0
push_a 0
fillh ARRAY 1 2
pop_a 1
.d 1 0
rtn
.o 1 0
.pn
ea3
jsr_eval 0
.o 1 0
e_dynamic_string_scopy_to_string
.o 1 0
s3
.d 1 0
jsr _copy_graph_to_string
.o 1 0
.d 1 0
rtn
.pe
definition module dynamic_string;
definition module dynamic_string
import StdDynamic;
import StdDynamic
dynamic_to_string :: !Dynamic -> *{#Char};
string_to_dynamic :: *{#Char} -> Dynamic;
dynamic_to_string :: !Dynamic -> *{#Char}
string_to_dynamic :: *{#Char} -> Dynamic
copy_to_string :: !a -> *{#Char}
copy_from_string :: !*{#Char} -> (a,!Int)
implementation module dynamic_string;
implementation module dynamic_string
import StdDynamic;
import StdDynamic
import StdEnv
import code from "copy_graph_to_string_interface.obj";
import code from "copy_graph_to_string.obj";
import code from "copy_string_to_graph_interface.obj";
import code from "copy_string_to_graph.obj";
import code from "copy_graph_to_string_interface.obj"
import code from "copy_graph_to_string.obj"
import code from "copy_string_to_graph_interface.obj"
import code from "copy_string_to_graph.obj"
copy_to_string :: !a -> *{#Char};
copy_to_string :: !a -> *{#Char}
copy_to_string g = code {
.d 1 0
jsr _copy_graph_to_string
.o 1 0
}
copy_from_string :: !*{#Char} -> (a,!Int);
copy_from_string :: !*{#Char} -> (a,!Int)
copy_from_string g = code {
.d 1 0
jsr _copy_string_to_graph
......@@ -22,11 +23,15 @@ copy_from_string g = code {
pushI 0
}
dynamic_to_string :: !Dynamic -> *{#Char};
dynamic_to_string :: !Dynamic -> *{#Char}
dynamic_to_string d
= copy_to_string d;
= copy_to_string d
string_to_dynamic :: *{#Char} -> Dynamic;
string_to_dynamic :: *{#Char} -> Dynamic
string_to_dynamic s
# (d,_) = copy_from_string s;
= d;
# (d,_) = copy_from_string s
= d
mk_unique :: !{#Char} -> *{#Char}
mk_unique s = {s` \\ s` <-: s}
......@@ -81,13 +81,13 @@ where
fromLivetime Session PlainString = "S"
fromLivetime TxtFile PlainString = "P"
fromLivetime TxtFileRO PlainString = "R"
// fromLivetime DataFile PlainString = "F"
fromLivetime DataFile PlainString = "F"
fromLivetime Database PlainString = "D"
fromLivetime Page StaticDynamic = "n"
fromLivetime Session StaticDynamic = "s"
fromLivetime TxtFile StaticDynamic = "p"
fromLivetime TxtFileRO StaticDynamic = "r"
// fromLivetime DataFile StaticDynamic = "f"
fromLivetime DataFile StaticDynamic = "f"
fromLivetime Database StaticDynamic = "d"
// de-serialize Html State
......@@ -114,12 +114,14 @@ where
['n':_] = (Page, StaticDynamic)
['S':_] = (Session, PlainString )
['s':_] = (Session, StaticDynamic)
['P':_] = (TxtFile, PlainString )
['p':_] = (TxtFile, StaticDynamic)
['R':_] = (TxtFileRO,PlainString )
['r':_] = (TxtFileRO,StaticDynamic)
['P':_] = (TxtFile, PlainString )
['p':_] = (TxtFile, StaticDynamic)
['R':_] = (TxtFileRO, PlainString )
['r':_] = (TxtFileRO, StaticDynamic)
['D':_] = (Database, PlainString )
['d':_] = (Database, StaticDynamic)
['F':_] = (DataFile, PlainString )
['f':_] = (DataFile, StaticDynamic)
_ = (Page, PlainString )
// reconstruct HtmlState out of the information obtained from browser
......@@ -196,7 +198,7 @@ traceHtmlInput args=:(Just input)
STable [] [ [B [] "Triplets:",Br]
, showTriplet triplets
,[B [] "Id:", B [] "Lifespan:", B [] "Format:", B [] "Value:"]
: [ [Txt id, Txt (showl life), Txt (showf storage), Txt (shows storage state)]
: [ [Txt id, Txt (showl life), Txt ( showf storage), Txt (shows storage state)]
\\ (id,life,storage,state) <- htmlState
]
]
......
......@@ -6,17 +6,20 @@ definition module PrintUtil
import StdGeneric
import StdFile
import Gerda
import DataFile
:: *HtmlStream :== [# String !]
:: 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
:: *NWorld // io states...
= { worldC :: !*World // world for any io
, inout :: !*HtmlStream // to read from stdin and write to stdout
, gerda :: !*Gerda // to read and write to a relational database
, datafile :: !*DataFile // to read and write to a Clean database in a file
}
instance FileSystem NWorld
appWorldNWorld :: !.(*World -> *World) !*NWorld -> *NWorld
accWorldNWorld :: !.(*World -> *(.a,*World)) !*NWorld -> (.a,!*NWorld)
......
......@@ -4,6 +4,7 @@ import StdArray, StdFile, StdList, StdString, ArgEnv
import StdGeneric
import StdStrictLists
import Gerda
import DataFile
:: Url :== String
......
......@@ -11,6 +11,8 @@ derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, But
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
derive gerda (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
derive read (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
derive write (<->), <|>, 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
......
......@@ -7,6 +7,8 @@ derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode/*, B
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
derive gerda (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
derive read (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
derive write (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
:: TextInput = TI Int Int // Input box of size Size for Integers
| TR Int Real // Input box of size Size for Reals
......
......@@ -7,6 +7,9 @@ derive gForm Maybe
derive gUpd Maybe
derive gPrint Maybe
derive gParse Maybe
derive read Maybe
derive write Maybe
derive bimap Maybe, (,)
// Exception handling
......
......@@ -24,7 +24,7 @@ import GenEq
= Database // persistent form stored in Database using generic db functions from Gerda
| TxtFile // persistent form stored in a file in StorageFormat
| TxtFileRO // persistent form stored in a file in StorageFormat, which is used Read-Only
// | DataFile // persistent form stored in a file using the Poor-Mans-Database-Format
| DataFile // persistent form stored in a file using the Poor-Mans-Database-Format
| Session // form in StorageFormat will live as long as one browses between the pages offered by the application
| Page // form in StorageFormat will be automatically garbage collected when no reference is made to it in a page
| Temp // form setting is not stored at all, only lives temporaly in the Clean application
......
......@@ -116,7 +116,7 @@ instance toInt Lifespan where toInt Temp = 0
toInt Session = 2
toInt TxtFileRO = 3
toInt TxtFile = 4
// toInt DataFile = 5
toInt DataFile = 5
toInt Database = 6
instance toString Lifespan where
......@@ -125,6 +125,6 @@ instance toString Lifespan where
toString Session = "Session"
toString TxtFileRO = "TxtFileRO"
toString TxtFile = "TxtFile"
// toString DataFile = "DataFile"
toString DataFile = "DataFile"
toString Database = "Database"
......@@ -13,12 +13,22 @@ derive gForm Int, Real, Bool, String, UNIT, PAIR, EITHER, OBJECT, CONS, FIELD
derive gUpd Int, Real, Bool, String, UNIT, PAIR, EITHER, OBJECT, CONS, FIELD
derive bimap Form, FormId
derive gForm Inline
derive gUpd Inline
derive gParse Inline
derive gPrint Inline
derive gerda Inline
derive read Inline
derive write Inline
:: *HSt = { cntr :: Int // counts position in expression
, submits :: Bool // True if we are in submitting mode
, states :: *FormStates // all form states are collected here ...
, world :: *NWorld // to enable all other kinds of I/O
}
:: Inline = Inline String
// doHtml main wrapper for generating & handling of a Html form
// depending on the option set (see iDataSettings) it will either
// - link in an http 1.0 server
......@@ -51,13 +61,6 @@ toHtmlForm :: !(*HSt -> *(Form a,*HSt)) -> [BodyTag] // toHtmlForm disp
toBody :: (Form a) -> BodyTag // just (BodyTag form.body)
createDefault :: a | gUpd{|*|} a // creates a default value of requested type
:: Inline = Inline String
derive gForm Inline
derive gUpd Inline
derive gParse Inline
derive gPrint Inline
derive gerda Inline
showHtml :: [BodyTag] -> Inline // enabling to show Html code in Clean data
// definitions on HSt
......
......@@ -27,16 +27,19 @@ gPrint{|(->)|} gArg gRes _ _ = abort "functions can only be used with dynamic st
:: Inline = Inline String
// OPTIONS
// Database OPTION
openGerda` database world
:== IF_GERDA (openGerda database world) (abort "Trying to open database while options are switched off",world)
closeGerda` gerda world
:== IF_GERDA (closeGerda gerda world) world
openDatabase database world
:== IF_Database (openGerda database world) (abort "Trying to open a relational database while this option is switched off",world)
closeDatabase database world
:== IF_Database (closeGerda database world) world
// DataFile OPTION
mkHSt :: *FormStates *NWorld -> *HSt
mkHSt states nworld = { cntr=0, states=states, world=nworld, submits = False }
openmDataFile datafile world
:== IF_DataFile (openDataFile datafile world) (abort "Trying to open a dataFile while this option is switched off",world)
closemDataFile datafile world
:== IF_DataFile (closeDataFile datafile world) world
////////////////// EXPERIMENTAL
......@@ -85,18 +88,21 @@ doHtmlPageAndPrint args userpage world
where
doHtmlPage :: !(Maybe [(String, String)]) !.(*HSt -> (Html,!*HSt)) !*HtmlStream !*World -> (!*HtmlStream,!*World)
doHtmlPage args userpage inout world
# (gerda,world) = openGerda` ODCBDataBase world // open the relational database if option chosen
# nworld = { worldC = world, inout = inout, gerda = gerda}
# (gerda,world) = openDatabase ODCBDataBaseName world // open the relational database if option chosen
# (datafile,world) = openmDataFile DataFileName world // open the datafile if option chosen
# nworld = {worldC = world, inout = inout, gerda = gerda, datafile = datafile}
# (initforms,nworld) = retrieveFormStates args nworld // Retrieve the state information stored in an html page, other state information is collected lazily
# (Html (Head headattr headtags) (Body attr bodytags),{states,world})
= userpage (mkHSt initforms nworld) // Call the user application
# (debugOutput,states) = if TraceOutput (traceStates states) (EmptyBody,states) // Optional show debug information
# (allformbodies,world) = storeFormStates states world // Store all state information
# {worldC,gerda,inout} = print_to_stdout // Print out all html code
# (allformbodies,nworld) = storeFormStates states world // Store all state information
# {worldC,gerda,inout,datafile}
= print_to_stdout // Print out all html code
(Html (Head headattr [extra_style:headtags])
(Body (extra_body_attr ++ attr) [allformbodies:bodytags++[debugInput,debugOutput]]))
world
# world = closeGerda` gerda worldC // close the relational database if option chosen
nworld
# world = closeDatabase gerda worldC // close the relational database if option chosen
# world = closemDataFile datafile world // close the datafile if option chosen
= (inout,world)
where
extra_body_attr = [Batt_background (ThisExe +++ "/back35.jpg"),`Batt_Std [CleanStyle]]
......@@ -120,6 +126,9 @@ where
= copy_chars s_s (s_i+1) (d_i+1) n d_s
= d_s
mkHSt :: *FormStates *NWorld -> *HSt
mkHSt states nworld = {cntr=0, states=states, world=nworld, submits = False }
// Create subserver(s) talking to an http 1.1 server.
// One needs to create several copies of the same subserver to handle parallel request issues by an http 1.1 server.
// To prevent race conditions, calls to such a subserver copy is serialized using a semaphore.
......@@ -606,6 +615,8 @@ derive gUpd Inline
derive gParse Inline
derive gPrint Inline
derive gerda Inline
derive read Inline
derive write Inline
gForm{|Inline|} (init,formid) hst
# (Inline string) = formid.ival
......
......@@ -3,8 +3,10 @@ definition module iDataSettings
// iData & iTask Library
// Concept & Programming (c) 2005 - 2007 Rinus Plasmeijer
import iDataHandler, PMDB
import Gerda // Clean's GEneRic Database Access
import iDataHandler
import Gerda // OPTION: GEneRic Database Access to a standard relational database, made by Arjen van Weelden
import DataFile // OPTION: A fast generic database stored in a file, made by Arjen van Weelden
// Global settings of iData applications
......@@ -29,10 +31,14 @@ class iParse a
class iSpecialStore a
| TC // To be able to store values in a dynamic
// OPTION: Comment out the next two lines if you do not have access to an ODCB database on your machine !!!!
// and enable the third line
// , pmdb {|*|} // To store and retrieve a value in a poor mans database DataFile
// , gerda {|*|} // To store and retrieve a value in a database
// OPTION: Comment out the next line if you do not have access to an ODCB database on your machine !!!!
// -or- if you do not want to make use of the Database option
, gerda {|*|} // To store and retrieve any Clean value in a standard relational database (slow but standard)