added trace options for fstates

libraries/htmlGEC/EncodeDecode.icl

@@ -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

libraries/htmlGEC/Examples/Simple Examples/balanceTree.icl

@@ -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}

libraries/htmlGEC/Examples/Simple Workflows/workflowExamples.icl

@@ -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
 
 

libraries/htmlGEC/htmlFormData.dcl

@@ -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

libraries/htmlGEC/htmlFormData.icl

@@ -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"
+

libraries/htmlGEC/htmlHandler.dcl

@@ -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!

libraries/htmlGEC/htmlHandler.icl

@@ -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

libraries/htmlGEC/htmlSettings.dcl

@@ -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
 

libraries/htmlGEC/iDataState.dcl

@@ -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

libraries/htmlGEC/iDataState.icl

@@ -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