Commit 78692c54 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

first working version of submit (modulo many bugs)

parent f0564f6f
......@@ -9,7 +9,7 @@ import GenPrint, GenParse
import dynamic_string
import EstherBackend
derive gParse UpdValue, (,,)
derive gParse UpdValue, (,,), (,)
derive gPrint UpdValue, (,,), (,)
......@@ -142,7 +142,10 @@ DecodeHtmlStatesAndUpdate serverkind args
DecodeArguments :: !ServerKind (Maybe [(String, String)]) -> (!String,!Triplets,!String)
DecodeArguments External _ = DecodePhpArguments
where
// DecodePhpArguments :: (!String,!String,!String,!String) // executable, id + update , new , state
// decode PHP will NOT work any more: either repair or kick it out !
// DecodePhpArguments :: (!String,!String,!String,!String) R // executable, id + update , new , state
DecodePhpArguments
# input = [c \\ c <-: GetArgs | not (isControl c) ] // get rid of communication noise
# (thisexe,input) = mscan '#' input // get rid of garbage
......@@ -154,7 +157,7 @@ where
=: case toString update of
// "CS" = (toString thisexe, decodeChars new, "", toString state)
// else = (toString thisexe, decodeChars triplet, toString new, toString state)
else = ("clean", [(calcTriplet (decodeChars triplet) "", toString new)], toString state)
else = ("clean", []/*[(fromJust (parseString (decodeChars triplet)), toString new)]*/, toString state)
GetArgs :: String
GetArgs =: foldl (+++) "" [strings \\ strings <-: getCommandLine]
......@@ -163,17 +166,18 @@ where
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)
| nargs == 0 = ("clean",[],"")
| nargs == 1 = DecodeCleanServerArguments (foldl (+++) "" [name +++ "=" +++ value +++ ";" \\ (name,value) <- args])
# tripargs = reverse args // state hidden in last field, rest are triplets
# (state,tripargs) = (urlDecode (snd (hd tripargs)),tl tripargs) // decode state, get triplets highest positions first
# constriplets = filter (\(name,_) -> name == "CS") tripargs // select constructor triplets
# nconstriplets = [(constrip,"") \\ (_,codedtrip) <- constriplets, (Just constrip) <- [parseString (decodeString (urlDecode codedtrip))]] // and decode
# valtriplets = filter (\(name,_) -> name <> "CS") tripargs // select all other triplets
# nvaltriplets = [(mytrip,new) \\ (codedtrip,new) <- valtriplets, (Just mytrip) <- [parseString (decodeString (urlDecode codedtrip))]] // and decode
= ("clean",reverse nconstriplets ++ nvaltriplets,state) // order is important, first the structure than the values ...
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
......@@ -185,22 +189,13 @@ where
# state = if found (take index input) ['']
= case toString triplet of
"" = ("clean", [], toString state)
"CS" = ("clean", [(calcTriplet (decodeChars new) "", "")], toString state)
else = ("clean", [(calcTriplet (decodeChars triplet) (toString new), toString new)], toString state)
calcTriplet:: String String -> Triplet
calcTriplet s newstring
= case parseString s of
Just (id,pos,UpdS _) = (id,pos,UpdS newstring)
Just triplet = triplet
_ = ("Parse Error!",0,UpdS s)
"CS" = ("clean", [(fromJust (parseString (decodeChars new)), "")], toString state)
else = ("clean", [(fromJust (parseString (decodeChars triplet)) , toString new)], toString state)
// traceHtmlInput utility used to see what kind of rubbish is received
// traceHtmlInput utility used to see what kind of rubbish is received from client
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
......@@ -211,10 +206,9 @@ traceHtmlInput serverkind args=:(Just input)
]
, Br
, STable [] [[Txt name,Txt value] \\ (name,value) <- input]
// , Txt (decodeString string)
]
where
(htmlState,triplets) = DecodeHtmlStatesAndUpdate serverkind args
(htmlState,triplets) = DecodeHtmlStatesAndUpdate serverkind args
showTriplet triplets = [STable [] [[Txt (printToString triplet)] \\ triplet <- triplets]]
showl life = toString life
......
......@@ -162,7 +162,7 @@ gForm{|CheckBox|} (init,formid) hst
, Inp_Value (SV name)
, Inp_Name (encodeTriplet (formid.id,cntr,UpdS name))
, Inp_Checked Checked
, `Inp_Events (callClean OnClick Edit "")
, `Inp_Events (callClean OnClick formid.mode "")
]) ""]
},incrHSt 1 hst)
v=:(CBNotChecked name)
......@@ -172,7 +172,7 @@ gForm{|CheckBox|} (init,formid) hst
[ Inp_Type Inp_Checkbox
, Inp_Value (SV name)
, Inp_Name (encodeTriplet (formid.id,cntr,UpdS name))
, `Inp_Events (callClean OnClick Edit "")
, `Inp_Events (callClean OnClick formid.mode "")
]) ""]
},incrHSt 1 hst)
......@@ -187,7 +187,7 @@ gForm{|RadioButton|} (init,formid) hst
, Inp_Value (SV name)
, Inp_Name (encodeTriplet (formid.id,cntr,UpdS name))
, Inp_Checked Checked
, `Inp_Events (callClean OnClick Edit "")
, `Inp_Events (callClean OnClick formid.mode "")
]) ""]
},incrHSt 1 hst)
v=:(RBNotChecked name)
......@@ -197,7 +197,7 @@ gForm{|RadioButton|} (init,formid) hst
[ Inp_Type Inp_Radio
, Inp_Value (SV name)
, Inp_Name (encodeTriplet (formid.id,cntr,UpdS name))
, `Inp_Events (callClean OnClick Edit "")
, `Inp_Events (callClean OnClick formid.mode "")
]) ""]
},incrHSt 1 hst)
......@@ -211,7 +211,7 @@ gForm{|PullDownMenu|} (init,formid) hst
[ Sel_Name ("CS")
, Sel_Size size
, `Sel_Std [Std_Style ("width:" <+++ width <+++ "px")]
, `Sel_Events (callClean OnChange Edit "")
, `Sel_Events (callClean OnChange formid.mode formid.id)
])
[ Option
[ Opt_Value (encodeTriplet (formid.id,cntr,UpdC (itemlist!!j)))
......
......@@ -42,7 +42,7 @@ import GenEq
}
:: Changed
= { isChanged :: Bool // is this form changed
, changedId :: String // id of changed form
, changedId :: [String] // id's of changed forms
}
:: StorageFormat // Serialization method:
= StaticDynamic // + higher order types, fast, NO dynamic linker needed; - works only for a specific application !
......
......@@ -490,7 +490,7 @@ where
, resetForm = Nothing
}
otherradio b v
| stripname b.changedId == formid.id
| stripname (hd b.changedId) == formid.id // REPAIR TO NEW
= RBNotChecked formid.id
| otherwise = v
......
......@@ -14,10 +14,11 @@ 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
:: *HSt = { cntr :: Int // counts position in expression
, states :: *FormStates // all form states are collected here ...
, world :: *NWorld // to enable file I/O, database I/O, ...
}
:: *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
}
// doHtml main wrapper for generating & handling of a Html form
......@@ -72,7 +73,7 @@ runUserApplication :: .(*HSt -> *(.a,*HSt)) *FormStates *NWorld -> *(.a,*FormSta
incrHSt :: Int !*HSt -> *HSt // Cntr := Cntr + 1
CntrHSt :: !*HSt -> (Int,*HSt) // Hst.Cntr
mkInput :: !Int !(InIDataId d) Value UpdValue !*HSt -> (BodyTag,*HSt) // Html Form Creation utility
getChangedId :: !*HSt -> (String,!*HSt) // id of form that has been changed by user
getChangedId :: !*HSt -> ([String],!*HSt) // id's of form(s) that has been changed by user
:: UpdMode = UpdSearch UpdValue Int // search for indicated postion and update it
| UpdCreate [ConsPos] // create new values if necessary
......
......@@ -19,6 +19,7 @@ gParse{|(->)|} gArg gRes _ = Nothing
gPrint{|(->)|} gArg gRes _ _ = abort "functions can only be used with dynamic storage option!\n"
:: *HSt = { cntr :: Int // counts position in expression
, submits :: Bool // True if we are in submit form
, states :: *FormStates // all form states are collected here ...
, world :: *NWorld // to enable all other kinds of I/O
}
......@@ -26,7 +27,7 @@ gPrint{|(->)|} gArg gRes _ _ = abort "functions can only be used with dynamic st
:: FormUpdate :== (InputId,UpdValue) // info obtained when form is updated
mkHSt :: *FormStates *NWorld -> *HSt
mkHSt states nworld = { cntr=0, states=states, world=nworld }
mkHSt states nworld = { cntr=0, states=states, world=nworld, submits = False }
// OPTIONS
......@@ -125,7 +126,7 @@ where
// swiss army knife editor that makes coffee too ...
mkViewForm :: !(InIDataId d) !(HBimap d v) !*HSt -> (Form d,!*HSt) | iData v
mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{states,world}
mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{states,world,submits}
| init == Const && formid.lifespan <> Temp
= mkViewForm (init,{formid & lifespan = Temp}) bm hst // constant i-data are never stored
| init == Const // constant i-data, no look up of previous value
......@@ -136,8 +137,8 @@ where
vformid = reuseFormId formid (toForm init formid.ival Nothing)
calcnextView isupdated view states world
# (changedid,states) = getUpdateId states
# changed = {isChanged = isupdated, changedId = changedid}
# (changedids,states) = getUpdateId states
# changed = {isChanged = isupdated, changedId = changedids}
# view = toForm init formid.ival view // map value to view domain, given previous view value
# view = updForm changed view // apply update function telling user if an update has taken place
# newval = fromForm changed view // convert back to data domain
......@@ -154,7 +155,7 @@ where
,mkHSt states world)
# (viewform,{states,world}) // make a form for it
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt states world)
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) ({mkHSt states world & submits = submits})
| viewform.changed && not isupdated // important: redo it all to handle the case that a user defined specialisation is updated !!
= calcnextView True (Just viewform.value) states world
......@@ -173,11 +174,11 @@ where
// findFormInfo :: FormId *FormStates *NWorld -> (Bool,Maybe a,*FormStates,*NWorld) | gUpd{|*|} a & gParse{|*|} a & TC a
findFormInfo formid formStates world
# (updateid,formStates) = getUpdateId formStates
| updateid <> formid.id
# (bool,justcurstate,formStates,world) = findState formid formStates world // the current form is not updated
# (updateids,formStates) = getUpdateId formStates // get list of updated id's
| not (isMember formid.id updateids)
# (bool,justcurstate,formStates,world) = findState formid formStates world // the current form is not updated
= (False,justcurstate,formStates,world)
# (alltriplets,formStates) = getTriplets formStates
# (alltriplets,formStates) = getTriplets formid.id formStates // get my update triplets
= 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
......@@ -221,10 +222,10 @@ where
// The value might have been changed with this editor, so the value returned might differ from the value you started with!
specialize :: !((InIDataId a) *HSt -> (Form a,*HSt)) !(InIDataId a) !*HSt -> (!Form a,!*HSt) | gUpd {|*|} a
specialize editor (init,formid) hst=:{cntr = inidx,states = formStates,world}
specialize editor (init,formid) hst=:{cntr = inidx,states = formStates,world,submits}
# nextidx = incrIndex inidx formid.ival // this value will be repesented differently, so increment counter
# (nv,hst) = editor (init,nformid) (setCntr 0 hst)
= (nv,setCntr nextidx hst)
# (nv,hst) = editor (init,nformid) {setCntr 0 hst & submits = True}
= (nv,{setCntr nextidx hst & submits = submits})
where
nformid = {formid & id = formid.id <+++ "_specialize_" <+++ inidx <+++ "_"}
......@@ -236,8 +237,8 @@ where
// gForm: automatically derives a Html form for any Clean type
mkForm :: !(InIDataId a) !*HSt -> *(Form a, !*HSt) | gForm {|*|} a
mkForm (init,formid=:{mode = Submit}) hst
# (form,hst) = gForm{|*|} (init,formid) hst
mkForm (init,formid=:{mode = Submit}) hst=:{submits = False}
# (form,hst) = gForm{|*|} (init,formid) {hst & submits = True}
# hidden = Input [ Inp_Name "hidden"
, Inp_Type Inp_Hidden
, Inp_Value (SV "")
......@@ -317,7 +318,7 @@ gForm{|OBJECT|} gHo (init,formid) hst
= ({no & value=OBJECT no.value},hst)
where
(OBJECT o) = formid.ival
gForm{|CONS of t|} gHc (init,formid) hst=:{cntr}
gForm{|CONS of t|} gHc (init,formid) hst=:{cntr,submits}
| not (isEmpty t.gcd_fields)
# (nc,hst) = gHc (init,reuseFormId formid c) (setCntr (cntr+1) hst) // don't display record constructor
= ({nc & value=CONS nc.value},hst)
......@@ -355,13 +356,16 @@ where
where
styles = case formid.mode of
Edit -> [ `Sel_Std [Std_Style width, EditBoxStyle]
, `Sel_Events (callClean OnChange Edit "")
, `Sel_Events (if submits [] (callClean OnChange Edit formid.id))
]
Submit -> [ `Sel_Std [Std_Style width, EditBoxStyle]
]
_ -> [ `Sel_Std [Std_Style width, DisplayBoxStyle]
, Sel_Disabled Disabled
]
optionstyle = case formid.mode of
Edit -> []
Submit -> []
_ -> [`Opt_Std [DisplayBoxStyle]]
width = "width:" <+++ defpixel <+++ "px"
......@@ -497,14 +501,14 @@ gUpd{|(->)|} gUpdArg gUpdRes mode f
// small utility functions
mkInput :: !Int !(InIDataId d) Value UpdValue !*HSt -> (BodyTag,*HSt)
mkInput size (init,formid=:{mode}) val updval hst=:{cntr}
mkInput size (init,formid=:{mode}) val updval hst=:{cntr,submits}
| mode == Edit || mode == Submit
= ( Input [ Inp_Type Inp_Text
, Inp_Value val
, Inp_Name (encodeTriplet (formid.id,cntr,updval))
, Inp_Size size
, `Inp_Std [EditBoxStyle, Std_Title (showType val)]
, `Inp_Events if (mode == Edit) (callClean OnChange formid.mode "") []
, `Inp_Events if (mode == Edit && not submits) (callClean OnChange formid.mode "") []
] ""
, setCntr (cntr+1) hst)
| mode == Display
......@@ -561,10 +565,10 @@ incrHSt i hst = {hst & cntr = hst.cntr + i} // BUG ??????
CntrHSt :: !*HSt -> (Int,*HSt)
CntrHSt hst=:{cntr} = (cntr,hst)
getChangedId :: !*HSt -> (String,!*HSt) // id of form that has been changed by user
getChangedId :: !*HSt -> ([String],!*HSt) // id of form that has been changed by user
getChangedId hst=:{states}
# (id,states) = getUpdateId states
= (id,{hst & states = states })
# (ids,states) = getUpdateId states
= (ids,{hst & states = states })
// Enabling file IO on HSt
......
......@@ -18,7 +18,7 @@ findState :: !(FormId a) !*FormStates *NWorld // find the state value given
replaceState :: !(FormId a) a !*FormStates *NWorld // replace state given FormId
-> (*FormStates,*NWorld) | iDataSerialize a
getUpdateId :: !*FormStates -> (String,!*FormStates) // id of previously changed form
getUpdateId :: !*FormStates -> ([String],!*FormStates) // id of previously changed form
// storage and retrieval of FormStates
......@@ -26,9 +26,7 @@ retrieveFormStates :: ServerKind (Maybe [(String, String)]) *NWorld -> (*FormSt
storeFormStates :: !FormStates *NWorld -> (BodyTag,*NWorld)
getTriplets :: !*FormStates -> (Triplets,!*FormStates) // retrieve triplets
//getTriplet :: !*FormStates -> (!Maybe Triplet,!Maybe b,!*FormStates) | gParse{|*|} b // inspect triplet
getTriplets :: !String !*FormStates -> (Triplets,!*FormStates) // retrieve triplets
// tracing all states ...
......
......@@ -25,7 +25,6 @@ import EstherBackend
:: *FormStates = // collection of states of all forms
{ fstates :: *FStates // internal tree of states
, triplets :: [(Triplet,String)] // indicates what has changed: which form, which postion, which value
// , update :: String // what is the new value created by the end user
, updateid :: String // which form has changed
, server :: ServerKind // is an external server required
}
......@@ -61,17 +60,11 @@ where
emptyFormStates :: *FormStates
emptyFormStates = { fstates = Leaf_ , triplets = [], updateid = "", server = Internal}
getTriplets :: !*FormStates -> (Triplets,!*FormStates)
getTriplets formstates=:{triplets} = (triplets,formstates)
getTriplets :: !String !*FormStates -> (Triplets,!*FormStates)
getTriplets id formstates=:{triplets} = ([mytrips \\ mytrips=:((tripid,_,_),_) <- triplets | id == tripid] ,formstates)
getTriplet :: !*FormStates -> (!Maybe Triplet, !Maybe b, !*FormStates) | gParse{|*|} b
getTriplet formstates=:{triplets}
= case triplets of
[] = (Nothing,Nothing,formstates)
[(triplet,update):xs] = (Just triplet, parseString update, formstates)
getUpdateId :: !*FormStates -> (String,!*FormStates)
getUpdateId formStates=:{updateid} = (updateid,formStates)
getUpdateId :: !*FormStates -> ([String],!*FormStates)
getUpdateId formStates=:{triplets} = (removeDup [tripid \\ ((tripid,_,_),_) <- triplets] ,formStates)
getUpdate :: !*FormStates -> (String,!*FormStates)
//getUpdate formStates=:{update} = (update,formStates)
......@@ -255,10 +248,6 @@ where
| isMember life [Database,Persistent,PersistentRO,Temp] = Nothing
htmlStateOf (fid,NewState {format = PlainStr string,life}) = Just (fid,life,PlainString,string)
htmlStateOf (fid,NewState {format = StatDyn dynval, life}) = Just (fid,life,StaticDynamic,dynamic_to_string dynval)
writeAllPersistentStates :: !FStates *NWorld -> *NWorld // store states in persistent stores
writeAllPersistentStates Leaf_ nworld = nworld
......@@ -340,9 +329,6 @@ tohexchar s i
= toChar (48+c);
= toChar (55+c);
// create balanced storage tree:
Balance :: ![a] -> .(Tree_ a)
......
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