Commit 9eb93aae authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

added trace options for fstates

parent 462fc8d7
......@@ -122,9 +122,10 @@ where
traceHtmlInput :: !ServerKind !(Maybe String) -> BodyTag
traceHtmlInput serverkind args=:(Just string)
= BodyTag [ STable [] [ [B [] "Triplet:", Txt triplet]
= BodyTag [ Br, B [] "State values received from client when application started:", Br,
STable [] [ [B [] "Triplet:", Txt triplet]
,[B [] "Update:", Txt update]
,[B [] "Identifier:", B [] "Lifetime:", B [] "Format:", B [] "Value:"]
,[B [] "Id:", B [] "Lifespan:", B [] "Format:", B [] "Value:"]
: [ [Txt id, Txt (showl life), Txt (showf storage), Txt (shows storage state)]
\\ (id,life,storage,state) <- htmlState
]
......@@ -135,13 +136,8 @@ traceHtmlInput serverkind args=:(Just string)
where
(htmlState,triplet,update) = DecodeHtmlStatesAndUpdate serverkind args
showl life = case life of
Persistent = "Persistent"
PersistentRO = "Persistent Read Only"
Session = "Session"
Database = "Database"
_ = "Page"
showf storage = case storage of PlainString -> "String"; _ -> "Dynamic"
showl life = toString life
showf storage = case storage of PlainString -> "String"; _ -> "S_Dynamic"
shows PlainString s = s
shows _ d = d // "cannot show dynamic value"
......@@ -172,7 +168,7 @@ writeState directory filename serializedstate env
(_,env) = (NoDirError,env)
# (ok,file,env) = fopen (directory +++ "/" +++ filename +++ ".txt") FWriteData env
| not ok = env
# file = fwrites serializedstate file
# file = fwrites serializedstate file // DEBUG
# (ok,env) = fclose file env
= env
where
......
......@@ -14,14 +14,20 @@ derive gParse Record
derive gPrint Record
derive gerda Record
Start world = doHtmlServer MyPage world
//Start world = doHtmlServer testdb world
//Start world = doHtmlSubServer (4,0,1,"tree") MyPage5 world
Start world = doHtmlServer MyPage5 world
MyPage5 hst
# (balancedtree,hst) = mkEditForm (Init,pDFormId "test" [0]) hst
# (n1,hst) = mkEditForm (Init,nDFormId "test1" [0]) hst
# (n2,hst) = mkEditForm (Init,pDFormId "test2" [0]) hst
# (n3,hst) = mkEditForm (Set, pDFormId "test2" n1.value) hst
= mkHtml "Balanced Tree"
[ H1 [] "Balanced Tree"
, BodyTag balancedtree.form
, BodyTag n1.form
, Br
, toHtml n1.value, Br
, toHtml n2.value, Br
, toHtml n3.value, Br
] hst
:: Record = {name :: String, address :: String, zipcode :: Int}
......
......@@ -21,7 +21,8 @@ where
= mkHtml "test" [idform.form <=> html] hst
where
persistent tasks tst
# tst = setTaskAttribute Database tst
# tst = setTaskAttribute Persistent tst
// # tst = setTaskAttribute Database tst
= tasks tst
......
......@@ -128,5 +128,6 @@ toViewMap :: !(d -> v) !Init !d !(Maybe v) -> v // same, but convert to view do
instance toBool Init
instance < Lifespan
instance toString Lifespan
instance == Init, Mode, Lifespan
derive gEq Init, Mode, Lifespan
......@@ -116,3 +116,12 @@ instance toInt Lifespan where toInt Temp = 0
toInt PersistentRO = 3
toInt Persistent = 4
toInt Database = 5
instance toString Lifespan where
toString Temp = "Temp"
toString Page = "Page"
toString Session = "Session"
toString PersistentRO = "PersistentRO"
toString Persistent = "Persistent"
toString Database = "Database"
......@@ -21,8 +21,11 @@ derive bimap Form, FormId
// doHtml main wrapper for generating & handling of a Html form
doHtml :: !.(*HSt -> (Html,!*HSt)) !*World -> *World // use this application with some external server and php
doHtmlServer :: ! (*HSt -> (Html,!*HSt)) !*World -> *World // use this application with the built-in Clean server: http://localhost/clean
doHtmlServer :: !(*HSt -> (Html,!*HSt)) !*World -> *World // use this application with the built-in Clean server
// it will combine both into one application : http://localhost/clean;
doHtmlSubServer :: !(!Int,!Int,!Int,!String) !(*HSt -> (Html,!*HSt)) // priority (higher number = higher prio), min number, max number of subservers, location, html code
!*World -> *World // use this application as a subserver in combination with an external (Clean) server;
doHtml :: !.(*HSt -> (Html,!*HSt)) !*World -> *World // use this application with some external server using a php script;
// mkViewForm is the *swiss army knife* function creating stateful interactive forms with a view v of data d.
// Make sure that all editors have a unique identifier!
......
......@@ -52,29 +52,53 @@ doHtmlServer userpage world
where
conv args = foldl (+++) "" (map snd args)
doHtmlServer2 :: String .(*HSt -> (Html,!*HSt)) *World -> ([String],String,*World)
doHtmlServer2 args userpage world
# (inout,world) = doHtmlPage Internal (Just args) userpage [|] world
# n_chars = count_chars inout 0
with
count_chars [|] n = n
count_chars [|s:l] n = count_chars l (n+size s)
# allhtmlcode = copy_strings inout n_chars (createArray n_chars '\0')
with
copy_strings [|e:l] i s
# size_e = size e
# i = i-size_e
= copy_strings l i (copy_chars e 0 i size_e s)
copy_strings [|] 0 s
= s
copy_chars :: !{#Char} !Int !Int !Int !*{#Char} -> *{#Char}
copy_chars s_s s_i d_i n d_s
| s_i<n
# d_s = {d_s & [d_i]=s_s.[s_i]}
= copy_chars s_s (s_i+1) (d_i+1) n d_s
= d_s
= ([],allhtmlcode,world)
doHtmlServer2 :: String .(*HSt -> (Html,!*HSt)) *World -> ([String],String,*World)
doHtmlServer2 args userpage world
# (inout,world) = doHtmlPage Internal (Just args) userpage [|] world
# n_chars = count_chars inout 0
with
count_chars [|] n = n
count_chars [|s:l] n = count_chars l (n+size s)
# allhtmlcode = copy_strings inout n_chars (createArray n_chars '\0')
with
copy_strings [|e:l] i s
# size_e = size e
# i = i-size_e
= copy_strings l i (copy_chars e 0 i size_e s)
copy_strings [|] 0 s
= s
copy_chars :: !{#Char} !Int !Int !Int !*{#Char} -> *{#Char}
copy_chars s_s s_i d_i n d_s
| s_i<n
# d_s = {d_s & [d_i]=s_s.[s_i]}
= copy_chars s_s (s_i+1) (d_i+1) n d_s
= d_s
= ([],allhtmlcode,world)
import SUBSERVER
doHtmlSubServer :: !(!Int,!Int,!Int,!String) !(*HSt -> (Html,!*HSt)) !*World -> *World
doHtmlSubServer (prio,min,max,location) userpage world
# (console,world) = stdio world
# result = RegisterSubProcToServer prio min max ".*" "\location"
| result==1
# (_,world) = fclose (fwrites ("Error: SubServer \"" +++ location +++ "\" could *NOT* registered to an HTTP 1.1 main server\n") console) world
= world
| result==2
# (_,world) = fclose (fwrites ("SubServer \"" +++ location +++ "\" successfully registered to an HTTP 1.1 main server\n") console) world
= world
# world = WaitForMessageLoop mycallbackfun 0 world
# (_,world) = fclose console world
= world
where
mycallbackfun :: [String] Int Socket *World -> (Socket,*World)
mycallbackfun header contentlength socket world
# (_,datafromclient,socket,world) = ReceiveString 0 contentlength socket world
| socket==0 = (0,world) //socket closed or timed out
# (_,htmlcode,world) = doHtmlServer2 datafromclient userpage world
= SendString htmlcode "text/html" header socket world
doHtmlPage :: !ServerKind !(Maybe String) !.(*HSt -> (Html,!*HSt)) !*HtmlStream !*World -> (!*HtmlStream,!*World)
doHtmlPage serverkind args userpage inout world
......@@ -83,10 +107,11 @@ doHtmlPage serverkind args userpage inout world
# (initforms,nworld) = retrieveFormStates serverkind args nworld
# (Html (Head headattr headtags) (Body attr bodytags),{states,world})
= userpage (mkHSt initforms nworld)
# (debufOutput,states) = if TraceOutput (traceStates states) (EmptyBody,states)
# (allformbodies,world) = storeFormStates states world
# {worldC,gerda,inout} = print_to_stdout
(Html (Head headattr [extra_style:headtags])
(Body (extra_body_attr ++ attr) [debugInput,allformbodies:bodytags]))
(Body (extra_body_attr ++ attr) [debugInput,debufOutput,allformbodies:bodytags]))
world
# world = closeGerda` gerda worldC
= (inout,world)
......@@ -95,6 +120,7 @@ where
extra_style = Hd_Style [] CleanStyles
debugInput = if TraceInput (traceHtmlInput serverkind args) EmptyBody
// swiss army knife editor that makes coffee too ...
mkViewForm :: !(InIDataId d) !(HBimap d v) !*HSt -> (Form d,!*HSt) | iData v
......
......@@ -18,7 +18,8 @@ class iDataSerAndDeSerialize a
| gParse{|*|} // To de-serialize a string back to a value
, iDataSerialize a
TraceInput :== False // set it to True if you want to see what kind of information is stored
TraceInput :== True // show what kind of information is received from Client
TraceOutput :== True // show what kind of information is stored
MyDataBase :== "iDataDatabase" // name of database being used by iData applications
......
......@@ -44,6 +44,10 @@ getTriplet :: !*FormStates -> (!Maybe Triplet,!Maybe b,!*FormStates) | gPars
callClean :: Script // script that takes care of sending the required input to this application
// tracing all states ...
traceStates :: !*FormStates -> !(BodyTag,!*FormStates)
// fstate handling used for testing only
initTestFormStates :: *NWorld -> (*FormStates,*NWorld) // creates initial empty form states
......
......@@ -307,7 +307,73 @@ where
writePersistentState _ nworld
= nworld
// trace States
import EstherBackend
traceStates :: !*FormStates -> !(BodyTag,!*FormStates)
traceStates formstates=:{fstates}
# (bodytags,fstates) = traceStates` fstates
= (BodyTag [Br, B [] "State values when application ended:",Br,
STable [] ([[B [] "Id:", B[] "Inspected:", B [] "Lifespan:", B [] "Format:", B [] "Value:"]] ++
bodytags)
],{formstates & fstates = fstates})
where
traceStates` Leaf_ = ([],Leaf_)
traceStates` (Node_ left a right)
# (leftTrace,left) = traceStates` left
# nodeTrace = nodeTrace a
# (rightTrace,right) = traceStates` right
= (leftTrace ++ nodeTrace ++ rightTrace,Node_ left a right)
nodeTrace (id,OldState fstate=:{format,life}) = [[Txt id,Txt "No", Txt (toString life):toStr format]]
nodeTrace (id,NewState fstate=:{format,life}) = [[Txt id,Txt "Yes",Txt (toString life):toStr format]]
toStr (PlainStr str) = [Txt "String", Txt str]
toStr (StatDyn dyn) = [Txt "S_Dynamic", Txt (ShowValueDynamic dyn <+++ " :: " <+++ ShowTypeDynamic dyn )]
toStr (DBStr str _) = [Txt "Database", Txt str]
strip s = { ns \\ ns <-: s | ns >= '\020' && ns <= '\0200'}
ShowValueDynamic :: Dynamic -> String
ShowValueDynamic d = strip (foldr (+++) "" (fst (toStringDynamic d)) +++ " ")
ShowTypeDynamic :: Dynamic -> String
ShowTypeDynamic d = strip (snd (toStringDynamic d) +++ " ")
// debugging code
print_graph :: !a -> Bool;
print_graph a = code {
.d 1 0
jsr _print_graph
.o 0 0
pushB TRUE
}
my_dynamic_to_string :: !Dynamic -> {#Char};
my_dynamic_to_string d
| not (print_graph d)
= abort ""
#! s=dynamic_to_string d;
| not (print_graph (tohexstring s))
= abort ""
# d2 = string_to_dynamic {c \\ c <-: s};
| not (print_graph d2)
= abort ""
= s;
tohexstring :: {#Char} -> {#Char};
tohexstring s = {tohexchar s i \\ i<-[0..2*size s-1]};
tohexchar :: {#Char} Int -> Char;
tohexchar s i
# c=((toInt s.[i>>1]) >> ((1-(i bitand 1))<<2)) bitand 15;
| c<10
= toChar (48+c);
= toChar (55+c);
// traceLife Lifespan
// to encode triplets in htmlpages
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment