Commit 0393a2d6 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

submit simple version works

parent dddacfd5
......@@ -30,7 +30,6 @@ import htmlFormData
| UpdS String // new piece of text
encodeTriplet :: !Triplet -> String // encoding of triplets
decodeTriplet :: !String -> Maybe Triplet
// Form submission handling
......@@ -38,15 +37,10 @@ callClean :: !(Script -> ElementEvents) !Mode !String -> [ElementEvents]
submitscript :: BodyTag
globalstateform :: !Value -> BodyTag
// type driven encoding of strings, used to encode triplets
encodeInfo :: !a -> String | gPrint{|*|} a
decodeInfo :: !String -> Maybe a | gParse{|*|} a
// serializing, de-serializing of iData states to strings stored in the html page
EncodeHtmlStates :: ![HtmlState] -> String
DecodeHtmlStatesAndUpdate :: !ServerKind (Maybe String) -> (![HtmlState],!Triplets) // hidden state stored in Client + triplets
DecodeHtmlStatesAndUpdate :: !ServerKind (Maybe [(String, String)]) -> (![HtmlState],!Triplets) // hidden state stored in Client + triplets
// serializing, de-serializing of iData state stored in files
......@@ -59,9 +53,5 @@ ThisExe :: !ServerKind -> String // name of this executable
MyPhP :: !ServerKind -> String // name of php script interface between server and this executable
MyDir :: !ServerKind -> String // name of directory in which persistent form info is stored
traceHtmlInput :: !ServerKind !(Maybe String) -> BodyTag // for debugging showing the information received from browser
// low level encoding and decoding
traceHtmlInput :: !ServerKind !(Maybe [(String, String)]) -> BodyTag // for debugging showing the information received from browser
encodeString :: !String -> String
decodeString :: !String -> *String
......@@ -131,7 +131,7 @@ where
// reconstruct HtmlState out of the information obtained from browser
DecodeHtmlStatesAndUpdate :: !ServerKind (Maybe String) -> (![HtmlState],!Triplets)
DecodeHtmlStatesAndUpdate :: !ServerKind (Maybe [(String, String)]) -> (![HtmlState],!Triplets)
DecodeHtmlStatesAndUpdate serverkind args
# (_,triplets,state) = DecodeArguments serverkind args
= ([states \\states=:(id,_,_,nstate) <- DecodeHtmlStates state | id <> "" || nstate <> ""],triplets) // to be sure that no rubbish is passed on
......@@ -139,7 +139,7 @@ DecodeHtmlStatesAndUpdate serverkind args
// Parse and decode low level information obtained from server
// In case of using a php script and external server:
DecodeArguments :: !ServerKind (Maybe String) -> (!String,!Triplets,!String)
DecodeArguments :: !ServerKind (Maybe [(String, String)]) -> (!String,!Triplets,!String)
DecodeArguments External _ = DecodePhpArguments
where
// DecodePhpArguments :: (!String,!String,!String,!String) // executable, id + update , new , state
......@@ -161,10 +161,19 @@ where
// In case of using the internal server written in Clean:
DecodeArguments Internal (Just args) = DecodeCleanServerArguments args
DecodeArguments Internal (Just args)
# nargs = length args
| nargs == 0 = ("clean",[],"")
| nargs == 1 = DecodeCleanServerArguments (foldl (+++) "" [name +++ "=" +++ value +++ ";" \\ (name,value) <- args])
//= ("clean",[],snd (last args))
# state = urlDecode (snd (last args))
= ("clean",[(calcTriplet (decodeString triplet) "",new) \\ (triplet,new) <- tl (reverse args)],state)
where
DecodeCleanServerArguments :: !String -> (!String,!Triplets,!String) // executable, id + update , new , state
DecodeCleanServerArguments args
// # nargs = foldl (+++) "" [name +++ "=" +++ value +++ ";" \\ (name,value) <- args]
# input = [c \\ c <-: args | not (isControl c) ] // get rid of communication noise
# (thisexe,input) = mscan '\"' input // get rid of garbage
# input = skipping ['UD\"'] input
......@@ -188,8 +197,10 @@ calcTriplet s newstring
// traceHtmlInput utility used to see what kind of rubbish is received
traceHtmlInput :: !ServerKind !(Maybe String) -> BodyTag
traceHtmlInput serverkind args=:(Just string)
traceHtmlInput :: !ServerKind !(Maybe [(String, String)]) -> BodyTag
traceHtmlInput serverkind args=:(Just input)
# nargs = foldl (+++) "" [name +++ "=" +++ value +++ ";" \\ (name,value) <- input]
= BodyTag [ Br, B [] "State values received from client when application started:", Br,
STable [] [ [B [] "Triplets:",Br]
, showTriplet triplets
......@@ -199,15 +210,13 @@ traceHtmlInput serverkind args=:(Just string)
]
]
, Br
, Txt string
, STable [] [[Txt name,Txt value] \\ (name,value) <- input]
// , Txt (decodeString string)
]
where
(htmlState,triplets) = DecodeHtmlStatesAndUpdate serverkind args
showTriplet [] = []
showTriplet [triplet:triplets]
= [Txt (printToString triplet),Br:showTriplet triplets]
showTriplet triplets = [STable [] [[Txt (printToString triplet)] \\ triplet <- triplets]]
showl life = toString life
showf storage = case storage of PlainString -> "String"; _ -> "S_Dynamic"
shows PlainString s = s
......
......@@ -48,12 +48,13 @@ doHtml userpage world
doHtmlServer :: !(*HSt -> (Html,!*HSt)) !*World -> *World
doHtmlServer userpage world
= StartServer 80 [("clean", \_ _ a -> doHtmlServer2 (conv a) userpage)] world
= StartServer 80 [("clean", \_ _ args -> doHtmlServer2 args userpage)] world
//= StartServer 80 [("clean", \_ _ a -> doHtmlServer2 (conv a) userpage)] world
where
conv args = foldl (+++) "" [name +++ "=" +++ value +++ ";" \\ (name,value) <- args]
// conv args = foldl (+++) "" (map snd args)
doHtmlServer2 :: String .(*HSt -> (Html,!*HSt)) *World -> ([String],String,*World)
doHtmlServer2 :: [(String, 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
......@@ -95,11 +96,12 @@ where
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
// # (_,htmlcode,world) = doHtmlServer2 datafromclient userpage world
# (_,htmlcode,world) = doHtmlServer2 [] userpage world
= SendString htmlcode "text/html" header socket world
doHtmlPage :: !ServerKind !(Maybe String) !.(*HSt -> (Html,!*HSt)) !*HtmlStream !*World -> (!*HtmlStream,!*World)
doHtmlPage :: !ServerKind !(Maybe [(String, String)]) !.(*HSt -> (Html,!*HSt)) !*HtmlStream !*World -> (!*HtmlStream,!*World)
doHtmlPage serverkind args userpage inout world
# (gerda,world) = openGerda` MyDataBase world
# nworld = { worldC = world, inout = inout, gerda = gerda}
......@@ -171,7 +173,49 @@ where
// findFormInfo :: FormId *FormStates *NWorld -> (Bool,Maybe a,*FormStates,*NWorld) | gUpd{|*|} a & gParse{|*|} a & TC a
findFormInfo formid formStates world
= case (decodeInput1 formid formStates world) of
# (updateid,formStates) = getUpdateId formStates
| updateid <> formid.id
# (bool,justcurstate,formStates,world) = findState formid formStates world // the current form is not updated
= (False,justcurstate,formStates,world)
# (alltriplets,formStates) = getTriplets formStates
= case (findState formid formStates world) of
(False,Just currentState,formStates,world) -> (False, Just currentState,formStates,world) // yes, but update already handled
(True, Just currentState,formStates,world) -> updateState alltriplets currentState formStates world // yes, handle update
(_, Nothing,formStates,world) -> (False, Nothing,formStates,world) // cannot find previously stored state
updateState alltriplets currentState formStates world
# allUpdates = [update \\ tripletupd <- alltriplets, (Just update) <- [examineTriplet tripletupd]]
# newState = applyUpdates allUpdates currentState
= (True,Just newState,formStates,world)
applyUpdates [] currentState = currentState
applyUpdates [(pos,upd):updates] currentState = applyUpdates updates (snd (gUpd{|*|} (UpdSearch upd pos) currentState))
examineTriplet :: TripletUpdate -> Maybe (Int,UpdValue)
examineTriplet tripletupd
= case parseTriplet tripletupd of
((sid,pos,UpdC s), Just "") = (Just (pos,UpdC s) )
((sid,pos,UpdC s), _) = (Just (pos,UpdC s) )
(_,_)= case parseTriplet tripletupd of
((sid,pos,UpdI i), Just ni) = (Just (pos,UpdI ni))
((sid,pos,UpdI i), _) = (Just (pos,UpdI i) )
(_,_) = case parseTriplet tripletupd of
((sid,pos,UpdR r), Just nr) = (Just (pos,UpdR nr))
((sid,pos,UpdR r), _) = (Just (pos,UpdR r) )
(_,_) = case parseTriplet tripletupd of
((sid,pos,UpdB b), Just nb) = (Just (pos,UpdB nb))
((sid,pos,UpdB b), _) = (Just (pos,UpdB b) )
(_,_) = case parseTriplet tripletupd of
((sid,pos,UpdS s), Just ns) = (Just (pos,UpdS ns))
((sid,pos,UpdS s), _) = (Just (pos,UpdS s) )
(upd,new) = (Nothing )
where
parseTriplet :: TripletUpdate -> (Triplet,Maybe b) | gParse {|*|} b
parseTriplet (triplet,update) = (triplet,parseString update)
/* = case (decodeInput1 formid formStates world) of
// an update for this form is detected
......@@ -188,11 +232,12 @@ where
// no update, no state stored, the current value is taken as (new) state
(_,(_,_,formStates,world)) -> (False, Nothing,formStates,world)
where
// decodeInput1 :: (FormId b) *FormStates *NWorld-> (Maybe FormUpdate, (Bool,Maybe b, *FormStates,*NWorld)) | gParse{|*|} b & TC b
decodeInput1 formid fs world
# (updateid,fs) = getUpdateId fs
# (anyInput,fs) = getUpdate fs
// # (anyInput,fs) = getUpdate fs
| updateid == formid.id // this state is updated
= case getTriplet fs of
(Just (sid,pos,UpdC s), Just "",fs) = (Just (pos,UpdC s), findState (nformid sid) fs world)
......@@ -208,12 +253,14 @@ where
(Just (sid,pos,UpdB b), _,fs) = (Just (pos,UpdB b), findState (nformid sid) fs world)
(_,_,fs) = case getTriplet fs of
(Just (sid,pos,UpdS s), Just ns,fs) = (Just (pos,UpdS ns), findState (nformid sid) fs world)
(Just (sid,pos,UpdS s), _,fs) = (Just (pos,UpdS s),findState (nformid sid) fs world)
(Just (sid,pos,UpdS s), _,fs) = (Just (pos,UpdS s), findState (nformid sid) fs world)
// (Just (sid,pos,UpdS s), _,fs) = (Just (pos,UpdS anyInput),findState (nformid sid) fs world)
(upd,new,fs) = (Nothing, findState formid fs world)
| otherwise = (Nothing, findState formid fs world)
nformid sid = {formid & id = sid}
*/
// specialize has to be used if a programmer wants to specialize gForm.
// It remembers the current value of the index in the expression and creates an editor to show this value.
......
......@@ -18,8 +18,8 @@ class iDataSerAndDeSerialize a
| gParse{|*|} // To de-serialize a string back to a value
, iDataSerialize a
TraceInput :== False // show what kind of information is received from Client
TraceOutput :== False // show 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
......
......@@ -19,15 +19,15 @@ replaceState :: !(FormId a) a !*FormStates *NWorld // replace state given Fo
-> (*FormStates,*NWorld) | iDataSerialize a
getUpdateId :: !*FormStates -> (String,!*FormStates) // id of previously changed form
getUpdate :: !*FormStates -> (String,!*FormStates) // value typed in by user as string
// storage and retrieval of FormStates
retrieveFormStates :: ServerKind (Maybe String) *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
retrieveFormStates :: ServerKind (Maybe [(String, String)]) *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
storeFormStates :: !FormStates *NWorld -> (BodyTag,*NWorld)
getTriplet :: !*FormStates -> (!Maybe Triplet,!Maybe b,!*FormStates) | gParse{|*|} b // inspect triplet
getTriplets :: !*FormStates -> (Triplets,!*FormStates) // retrieve triplets
//getTriplet :: !*FormStates -> (!Maybe Triplet,!Maybe b,!*FormStates) | gParse{|*|} b // inspect triplet
// tracing all states ...
......
......@@ -61,6 +61,9 @@ where
emptyFormStates :: *FormStates
emptyFormStates = { fstates = Leaf_ , triplets = [], updateid = "", server = Internal}
getTriplets :: !*FormStates -> (Triplets,!*FormStates)
getTriplets formstates=:{triplets} = (triplets,formstates)
getTriplet :: !*FormStates -> (!Maybe Triplet, !Maybe b, !*FormStates) | gParse{|*|} b
getTriplet formstates=:{triplets}
= case triplets of
......@@ -197,7 +200,7 @@ where
//
// De-serialize information from server to the internally used form states
retrieveFormStates :: ServerKind (Maybe String) *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
retrieveFormStates :: ServerKind (Maybe [(String, String)]) *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
retrieveFormStates serverkind args world
= ({ fstates = retrieveFStates, triplets = triplets, updateid = calc_updateid triplets, server = serverkind },world)
where
......
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