Commit 151a8e52 authored by Bas Lijnse's avatar Bas Lijnse
Browse files

Added a new FormUpdate record type which will replace the triplets

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@259 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 1e81ddc2
......@@ -17,12 +17,6 @@ import FormId
:: TripletUpdate :== (Triplet,String)
:: Triplets :== [TripletUpdate]
:: UpdValue // the updates that can take place
= UpdI Int // new integer value
| UpdR Real // new real value
| UpdB Bool // new boolean value
| UpdC String // choose indicated constructor
| UpdS String // new piece of text
encodeTriplet :: !Triplet -> String // encoding of triplets
encodeInputId :: !Triplet -> String
......
......@@ -42,21 +42,21 @@ edit formid = HGC mkApplyEdit`
where
mkApplyEdit` ((initval,prevbody),ch,hst)
# (na,hst) = mkApplyEditForm (Init,setFormId formid initval) initval hst
= ((na.value,[(formid.id, DivTag [] na.form ):prevbody]),ch||na.changed,hst) // propagate change
= ((na.Form.value,[(formid.id, DivTag [] na.form ):prevbody]),ch||na.changed,hst) // propagate change
display :: (FormId a) -> GecCircuit a a | iData a
display formid = HGC mkEditForm`
where
mkEditForm` ((val,prevbody),ch,hst)
# (na,hst) = mkEditForm (Set,setFormId {formid & mode = Display} val) hst
= ((na.value,[(formid.id,DivTag [] na.form):prevbody]),ch||na.changed,hst)
= ((na.Form.value,[(formid.id,DivTag [] na.form):prevbody]),ch||na.changed,hst)
store :: (FormId s) -> GecCircuit (s -> s) s | iData s
store formid = HGC mkStoreForm`
where
mkStoreForm` ((fun,prevbody),ch,hst)
# (store,hst) = mkStoreForm (Init,formid) fun hst
= ((store.value,[(formid.id,DivTag [] store.form):prevbody]),ch||store.changed,hst)
= ((store.Form.value,[(formid.id,DivTag [] store.form):prevbody]),ch||store.changed,hst)
self :: (a -> a) !(GecCircuit a a) -> GecCircuit a a
self fun gecaa = feedback gecaa (arr fun)
......@@ -69,7 +69,7 @@ loops (HGC gec_abcb) = HGC loopForm
where
loopForm ((aval,prevbody),ch,hst)
# (bstore,hst) = mkStoreForm (Init,xsFormId "??" createDefault) id hst
# (((cval,bval),bodyac),ch,hst) = gec_abcb (((aval,bstore.value),prevbody),ch,hst)
# (((cval,bval),bodyac),ch,hst) = gec_abcb (((aval,bstore.Form.value),prevbody),ch,hst)
# (bstore,hst) = mkStoreForm (Set,xsFormId "??" createDefault) (\_ -> bval) hst
= ((cval,bodyac),ch,hst)
......@@ -95,9 +95,9 @@ lift (Set,formid) fun = HGC fun`
where
fun` ((a,body),ch,hst)
# (nb,hst) = fun (setID formid a) hst
= ((nb.value,[(formid.id,DivTag [] nb.form):body]),ch||nb.changed,hst)
= ((nb.Form.value,[(formid.id,DivTag [] nb.form):body]),ch||nb.changed,hst)
lift (Init,formid) fun = HGC fun`
where
fun` ((a,body),ch,hst)
# (nb,hst) = fun (Init, setFormId formid a) hst
= ((nb.value,[(formid.id,DivTag [] nb.form):body]),ch||nb.changed,hst)
= ((nb.Form.value,[(formid.id,DivTag [] nb.form):body]),ch||nb.changed,hst)
......@@ -8,9 +8,9 @@ import iDataExceptions, iDataFormlib
universalDB :: !(!Init,!Lifespan,!a,!String) !(String a -> Judgement) !*HSt -> (a,!*HSt) | iData a
universalDB (init,lifespan,value,filename) invariant hst
# (dbf,hst) = myDatabase Init (0,value) hst // create / read out database file
# (dbversion,dbvalue) = dbf.value // version number and value stored in database
# (dbversion,dbvalue) = dbf.Form.value // version number and value stored in database
# (versionf,hst) = myVersion Init dbversion hst // create / read out version number expected by this application
# version = versionf.value // current version number assumed in this application
# version = versionf.Form.value // current version number assumed in this application
| init == Init // we only want to read, no version conflict
# (_,hst) = myVersion Set dbversion hst // synchronize version number and
= (dbvalue,hst) // return current value stored in database
......@@ -24,7 +24,7 @@ universalDB (init,lifespan,value,filename) invariant hst
# (_,hst) = ExceptionStore ((+) exception) hst // report them
= (value,hst) // return disapproved value such that it can be improved
# (versionf,hst) = myVersion Set (dbversion + 1) hst // increment version number
# (_,hst) = myDatabase Set (versionf.value,value) hst // update database file
# (_,hst) = myDatabase Set (versionf.Form.value,value) hst // update database file
= (value,hst)
where
myDatabase init cntvalue hst // read the database
......
......@@ -29,4 +29,4 @@ instance + Judgement where
ExceptionStore :: !(Judgement -> Judgement) !*HSt -> (Judgement,!*HSt)
ExceptionStore judge hst
# (judgef,hst) = mkStoreForm (Init,nFormId "handle_exception" Ok <@ NoForm <@ Temp) judge hst
= (judgef.value,hst)
= (judgef.Form.value,hst)
......@@ -124,7 +124,7 @@ mkSubStateForm (init,formid) state upd hst
(nsubState, hst)
= ( commitBut.changed
, { changed = nsubState.changed || commitBut.changed || cancelBut.changed
, value = if commitBut.changed (upd nsubState.value state) state
, value = if commitBut.changed (upd nsubState.Form.value state) state
, form = [ DivTag [] nsubState.form
, BrTag []
, if commitBut.changed (DivTag [] [Text "Thanks for (re-)committing",BrTag [] ,BrTag []]) EmptyBody
......@@ -142,10 +142,10 @@ mkShowHideForm (init,formid) hst
| formid.mode == NoForm || formid.FormId.lifespan == Temp
= mkEditForm (init,formid) hst
# (hiding,hst) = mkStoreForm (Init,subFormId formid "ShowHideSore" True) id hst // True == Hide
# (switch,hst) = myfuncbut hiding.value hst
# hide = switch.value hiding.value
# (switch,hst) = myfuncbut hiding.Form.value hst
# hide = switch.Form.value hiding.Form.value
# (hiding,hst) = mkStoreForm (Set,subFormId formid "ShowHideSore" True) (const hide) hst // True == Hide
# (switch,hst) = myfuncbut hiding.value hst
# (switch,hst) = myfuncbut hiding.Form.value hst
| hide
# (info,hst) = mkEditForm (init,formid <@ NoForm) hst
= ({info & form = switch.form},hst)
......@@ -170,64 +170,64 @@ vertlistFormButs nbuts showbuts (init,formid=:{mode}) hst
# indexId = subFormId formid "idx" 0 <@ Display
# (index,hst) = mkEditForm (init,indexId) hst
# (olist,hst) = listForm (init,formid) hst
# lengthlist = length olist.value
# lengthlist = length olist.Form.value
# pdmenu = HtmlSelect [(toString lengthlist <+++ " More... ","0") : [("Show " <+++ i,toString i) \\ i <- [1 .. max 1 lengthlist]]] "0"
# pdmenuId = subFormId formid "pdm" pdmenu <@ Edit
# (pdbuts,hst) = mkEditForm (Init, pdmenuId) hst
# step = toInt pdbuts.value
| step == 0 = ({form=pdbuts.form,inputs=pdbuts.inputs, value=olist.value,changed=olist.changed || pdbuts.changed},hst)
# step = toInt pdbuts.Form.value
| step == 0 = ({form=pdbuts.form,inputs=pdbuts.inputs, value=olist.Form.value,changed=olist.changed || pdbuts.changed},hst)
# bbutsId = subFormId formid "bb" index.value <@ Edit
# bbutsId = subFormId formid "bb" index.Form.value <@ Edit
# (obbuts,hst) = browseButtons (Init,bbutsId) step lengthlist nbuts hst
# addId = subnFormId formid "add" addbutton
# (add, hst) = ListFuncBut (Init,addId) hst
# dellId = subnFormId formid "dell" (delbutton obbuts.value step)
# dellId = subnFormId formid "dell" (delbutton obbuts.Form.value step)
# (del, hst) = ListFuncBut (Init,dellId) hst
# insrtId = subnFormId formid "ins" (insertBtn createDefault obbuts.value step)
# insrtId = subnFormId formid "ins" (insertBtn createDefault obbuts.Form.value step)
# (ins, hst) = ListFuncBut (Init,insrtId) hst
# appId = subnFormId formid "app" (appendBtn createDefault obbuts.value step)
# appId = subnFormId formid "app" (appendBtn createDefault obbuts.Form.value step)
# (app, hst) = ListFuncBut (Init,appId) hst
# elemId = subFormId formid "copyelem" createDefault
# copyId = subnFormId formid "copy" (copyBtn obbuts.value step)
# copyId = subnFormId formid "copy" (copyBtn obbuts.Form.value step)
# (copy, hst) = ListFuncBut (Init,copyId) hst
# (elemstore,hst) = mkStoreForm (Init,elemId) (if copy.changed (const (olist.value!!copy.value 0)) id) hst
# (elemstore,hst) = mkStoreForm (Init,elemId) (if copy.changed (const (olist.Form.value!!copy.Form.value 0)) id) hst
# pasteId = subnFormId formid "paste" (pasteBtn obbuts.value step)
# pasteId = subnFormId formid "paste" (pasteBtn obbuts.Form.value step)
# (paste,hst) = ListFuncBut (Init,pasteId) hst
# newlist = olist.value
# newlist = if paste.changed (updateAt (paste.value 0) elemstore.value newlist) newlist
# newlist = ins.value newlist
# newlist = add.value newlist
# newlist = app.value newlist
# newlist = del.value newlist
# newlist = olist.Form.value
# newlist = if paste.changed (updateAt (paste.Form.value 0) elemstore.Form.value newlist) newlist
# newlist = ins.Form.value newlist
# newlist = add.Form.value newlist
# newlist = app.Form.value newlist
# newlist = del.Form.value newlist
# (list, hst) = listForm (Set,setFormId formid newlist <@ mode) hst
# lengthlist = length newlist
# (index,hst) = mkEditForm (setID indexId obbuts.value) hst
# (index,hst) = mkEditForm (setID indexId obbuts.Form.value) hst
# (bbuts,hst) = browseButtons (Init, bbutsId) step lengthlist nbuts hst
# betweenindex = (bbuts.value,bbuts.value + step - 1)
# betweenindex = (bbuts.Form.value,bbuts.Form.value + step - 1)
# pdmenu = HtmlSelect [(toString lengthlist <+++ " More... ", toString step): [("Show " <+++ i,toString i) \\ i <- [1 .. max 1 lengthlist]]] (toString step)
# (pdbuts,hst) = mkEditForm (setID pdmenuId pdmenu) hst
= ( { form = pdbuts.form ++ bbuts.form ++
[[ toHtml ("nr " <+++ (i+1) <+++ " / " <+++ length list.value)
[[ toHtml ("nr " <+++ (i+1) <+++ " / " <+++ length list.Form.value)
<.||.>
(onMode formid.mode (if showbuts (del <.=.> ins <.=.> app <.=.> copy <.=.> paste) EmptyBody)
(if showbuts (del <.=.> ins <.=.> app <.=.> copy <.=.> paste) EmptyBody)
EmptyBody
EmptyBody)
\\ del <- del.form & ins <- ins.form & app <- app.form & copy <- copy.form & paste <- paste.form & i <- [bbuts.value..]]
\\ del <- del.form & ins <- ins.form & app <- app.form & copy <- copy.form & paste <- paste.form & i <- [bbuts.Form.value..]]
<=|>
list.form % betweenindex
] ++ (if (lengthlist <= 0) add.form [])
, value = list.value
, value = list.Form.value
, changed = olist.changed || list.changed || obbuts.changed || del.changed || pdbuts.changed || ins.changed ||
add.changed || copy.changed || paste.changed || list.changed || index.changed || app.changed
, inputs = [] //TODO: FIX
......@@ -304,8 +304,8 @@ layoutListForm :: !([HtmlTag] [HtmlTag] -> [HtmlTag])
! (InIDataId [a]) !*HSt -> (Form [a],!*HSt) | iData a
layoutListForm layoutF formF (init,formid=:{mode}) hst
# (store, hst) = mkStoreForm (init,formid) id hst // enables to store list with different # elements
# (layout,hst) = layoutListForm` 0 store.value hst
# (store, hst) = mkStoreForm (init,formid) (const layout.value) hst
# (layout,hst) = layoutListForm` 0 store.Form.value hst
# (store, hst) = mkStoreForm (init,formid) (const layout.Form.value) hst
= (layout,hst)
where
layoutListForm` n [] hst
......@@ -318,7 +318,7 @@ where
# (nxs,hst) = layoutListForm` (n+1) xs hst
# (nx, hst) = formF (init,subFormId formid (toString (n+1)) x) hst
= ({ changed = nx.changed || nxs.changed
, value = [nx.value:nxs.value]
, value = [nx.Form.value:nxs.Form.value]
, form = layoutF nx.form nxs.form
, inputs = nx.inputs ++ nxs.inputs
},hst)
......@@ -363,7 +363,7 @@ where
# (rowfun,hst) = ListFuncBut` (n+1) xs hst
# (fun ,hst) = FuncButNr n (init,{formid & ival = (but,func)} <@ bmode) hst
= ({ changed = rowfun.changed || fun.changed
, value = fun.value o rowfun.value
, value = fun.Form.value o rowfun.Form.value
, form = [DivTag [] (fun.form ++ rowfun.form) ]
, inputs = fun.inputs ++ rowfun.inputs
},hst)
......@@ -382,7 +382,7 @@ where
# (nx, hSt) = ListFuncBut2 (init,subFormId formid (toString n) x) hSt
# (nxs,hSt) = TableFuncBut2` (n+1) xs hSt
= ({ changed = nx.changed || nxs.changed
, value = nx.value o nxs.value
, value = nx.Form.value o nxs.Form.value
, form = [ nx.form <||> nxs.form ]
, inputs = nx.inputs ++ nxs.inputs
},hSt)
......@@ -399,7 +399,7 @@ layoutIndexForm layoutF formF r combineF n (init,formid) hSt
# (xsF,hSt) = layoutIndexForm layoutF formF r combineF (n+1) (init,setFormId formid xs) hSt
# (xF, hSt) = formF n (init,reuseFormId formid x) hSt
= ({ changed = xsF.changed || xF.changed
, value = combineF xsF.value xF.value
, value = combineF xsF.Form.value xF.Form.value
, form = layoutF xF.form xsF.form
, inputs = xF.inputs ++ xsF.inputs
},hSt)
......@@ -411,7 +411,7 @@ ListFuncBut (init,formid) hSt
ListFuncCheckBox :: !(InIDataId [(HtmlCheckbox, Bool [Bool] a -> a)]) !*HSt -> (Form (a -> a,[Bool]),!*HSt)
ListFuncCheckBox (init,formid) hst
# (check,hst) = ListFuncCheckBox` formid.ival hst
# (f,bools) = check.value
# (f,bools) = check.Form.value
= ({ changed = False
, value = (f bools,bools)
, form = check.form
......@@ -428,8 +428,8 @@ where
ListFuncCheckBox` [x:xs] hst
# (rowfun,hst) = ListFuncCheckBox` xs hst
# (fun ,hst) = FuncCheckBox formid x hst
# (rowfunv,boolsv) = rowfun.value
# (funv,nboolv) = fun.value
# (rowfunv,boolsv) = rowfun.Form.value
# (funv,nboolv) = fun.Form.value
= ({ changed = rowfun.changed || fun.changed
, value = (funcomp funv rowfunv,[nboolv:boolsv])
, form = fun.form ++ rowfun.form
......@@ -475,11 +475,11 @@ where
browseButtons :: !(InIDataId Int) !Int !Int !Int !*HSt -> (Form Int,!*HSt)
browseButtons (init,formid) step length nbuttuns hst
# (nindex, hst) = mkStoreForm (init,formid) id hst
# (calcnext,hst) = browserForm nindex.value hst
# (nindex, hst) = mkStoreForm (init,formid) calcnext.value hst
# (shownext,hst) = browserForm nindex.value hst
# (calcnext,hst) = browserForm nindex.Form.value hst
# (nindex, hst) = mkStoreForm (init,formid) calcnext.Form.value hst
# (shownext,hst) = browserForm nindex.Form.value hst
= ({ changed = calcnext.changed
, value = nindex.value
, value = nindex.Form.value
, form = shownext.form
, inputs = shownext.inputs
},hst)
......
......@@ -13,7 +13,6 @@ import Html
derive gPrint UpdValue
derive gParse UpdValue
derive bimap Form, FormId
gParse{|(->)|} gArg gRes _ = Nothing
......@@ -63,9 +62,9 @@ where
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt request states world)
| 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
= calcnextView True (Just viewform.Form.value) states world
# (states,world) = replaceState` vformid viewform.value states world // store new value into the store of states
# (states,world) = replaceState` vformid viewform.Form.value states world // store new value into the store of states
= ( { changed = isupdated
, value = newval
......@@ -191,7 +190,7 @@ gForm{|PAIR|} gHa gHb (init,formid) hst
# (na,hst) = gHa (init, reuseFormId formid a) hst
# (nb,hst) = gHb (init, reuseFormId formid b) hst
= ({ changed = na.changed || nb.changed
, value = PAIR na.value nb.value
, value = PAIR na.Form.value nb.Form.value
, form = na.form ++ nb.form
, inputs = na.inputs ++ nb.inputs
},hst)
......@@ -202,14 +201,14 @@ gForm{|EITHER|} gHa gHb (init,formid) hst
= case formid.ival of
(LEFT a)
# (na,hst) = gHa (init, reuseFormId formid a) hst
= ({na & value = LEFT na.value},hst)
= ({Form | na & value = LEFT na.Form.value},hst)
(RIGHT b)
# (nb,hst) = gHb (init, reuseFormId formid b) hst
= ({nb & value = RIGHT nb.value},hst)
= ({Form | nb & value = RIGHT nb.Form.value},hst)
gForm{|OBJECT|} gHo (init,formid) hst
# (no,hst) = gHo (init, reuseFormId formid o) hst
= ({no & value = OBJECT no.value},hst)
= ({Form | no & value = OBJECT no.Form.value},hst)
where
(OBJECT o) = formid.ival
......@@ -217,21 +216,21 @@ gForm{|CONS of t|} gHc (init,formid) hst=:{cntr}
| not (isEmpty t.gcd_fields)
# (nc,hst) = gHc (init,reuseFormId formid c) (setHStCntr (cntr+1) hst) // don't display record constructor, but wrap the content in a table tag
= ({ changed = nc.changed
, value = CONS nc.value
, value = CONS nc.Form.value
, form = [TableTag [] nc.form]
, inputs = nc.inputs
},hst)
| t.gcd_type_def.gtd_num_conses == 1
# (nc,hst) = gHc (init,reuseFormId formid c) (setHStCntr (cntr+1) hst) // don't display constructors that have no alternative
= ({nc & value = CONS nc.value},hst)
= ({Form | nc & value = CONS nc.Form.value},hst)
| t.gcd_name.[(size t.gcd_name) - 1] == '_' // don't display constructor names which end with an underscore
# (nc,hst) = gHc (init,reuseFormId formid c) (setHStCntr (cntr+1) hst)
= ({nc & value = CONS nc.value},hst)
= ({Form | nc & value = CONS nc.Form.value},hst)
# (selHtml,selInputs,hst) = mkSelect (init, formid) myname options hst
# (nc,hst) = gHc (init,reuseFormId formid c) hst
= ({ changed = nc.changed
, value = CONS nc.value
, value = CONS nc.Form.value
, form = selHtml ++ nc.form
, inputs = selInputs ++ nc.inputs
},hst)
......@@ -250,7 +249,7 @@ gForm{|FIELD of d |} gHx (init,formid) hst
},hst)
| otherwise
= ({ changed = nx.changed
, value = FIELD nx.value
, value = FIELD nx.Form.value
, form = [TrTag [] [ThTag [] [Text fieldname],TdTag [] nx.form]]
, inputs = nx.inputs
},hst)
......@@ -275,7 +274,7 @@ gForm{|(,)|} gHa gHb (init,formid) hst
# (na,hst) = gHa (init,reuseFormId formid a) (incrHStCntr 1 hst) // one more for the now invisible (,) constructor
# (nb,hst) = gHb (init,reuseFormId formid b) hst
= ( { changed = na.changed || nb.changed
, value = (na.value,nb.value)
, value = (na.Form.value,nb.Form.value)
, form = [SpanTag [] na.form, SpanTag [] nb.form]
, inputs = na.inputs ++ nb.inputs
},hst)
......@@ -287,7 +286,7 @@ gForm{|(,,)|} gHa gHb gHc (init,formid) hst
# (nb,hst) = gHb (init,reuseFormId formid b) hst
# (nc,hst) = gHc (init,reuseFormId formid c) hst
= ( { changed = na.changed || nb.changed || nc.changed
, value = (na.value,nb.value,nc.value)
, value = (na.Form.value,nb.Form.value,nc.Form.value)
, form = [SpanTag [] na.form, SpanTag [] nb.form, SpanTag [] nc.form]
, inputs = na.inputs ++ nb.inputs ++ nc.inputs
},hst)
......@@ -300,7 +299,7 @@ gForm{|(,,,)|} gHa gHb gHc gHd (init,formid) hst
# (nc,hst) = gHc (init,reuseFormId formid c) hst
# (nd,hst) = gHd (init,reuseFormId formid d) hst
= ( { changed = na.changed || nb.changed || nc.changed || nd.changed
, value = (na.value,nb.value,nc.value,nd.value)
, value = (na.Form.value,nb.Form.value,nc.Form.value,nd.Form.value)
, form = [SpanTag [] na.form, SpanTag [] nb.form, SpanTag [] nc.form, SpanTag [] nd.form]
, inputs = na.inputs ++ nb.inputs ++ nc.inputs ++ nd.inputs
},hst)
......
......@@ -16,7 +16,7 @@ instance == (Ref2 a) where (==) (Ref2 file1) (Ref2 file2) = file1 == file2
invokeRefEditor :: !((InIDataId b) *HSt -> (Form d,*HSt)) !(InIDataId b) !*HSt -> (!Form b,!*HSt)
invokeRefEditor editor (init,formid) hst
# (idata,hst) = editor (init,formid) hst
= ({idata & value = formid.ival},hst)
= ({Form | idata & value = formid.ival},hst)
// iData for destructively shared model data:
......@@ -24,9 +24,9 @@ universalRefEditor :: !Lifespan !(InIDataId (Ref2 a)) !(a -> Judgement) !*HSt ->
universalRefEditor lifespan (init,formid=:{ival=Ref2 filename}) invariant hst
| filename == "" = mkEditForm (Init,xtFormId "ure_TEMP" createDefault) hst
# (dbf,hst) = myDatabase Init filename (0,createDefault) hst // create / read out current value in file file
# (dbversion,dbvalue) = dbf.value // version number and value stored in database
# (dbversion,dbvalue) = dbf.Form.value // version number and value stored in database
# (versionf,hst) = myVersion Init filename dbversion hst // create / read out version number expected by this application
# version = versionf.value // current version number assumed in this application
# version = versionf.Form.value // current version number assumed in this application
| init == Init && isMember formid.mode [Display,NoForm] // we only want to read, no version conflict
= myEditor Init filename dbvalue hst // synchronize with latest value
| dbversion > version // we have a version conflict and want to write
......@@ -35,12 +35,12 @@ universalRefEditor lifespan (init,formid=:{ival=Ref2 filename}) invariant hst
# (_,hst) = myVersion Set filename dbversion hst // synchronize with new version
= myEditor Set filename dbvalue hst // return current version stored in database
# (valuef,hst) = myEditor Init filename dbvalue hst // editor is in sync; create / read out current value
# exception = invariant valuef.value // check invariants // check invariants
# exception = invariant valuef.Form.value // check invariants // check invariants
| isJust exception // we want to write, but invariants don't hold
# (_,hst) = ExceptionStore ((+) exception) hst // report them
= (valuef,hst) // return wrong value such that it can be improved
# (versionf,hst) = myVersion Set filename (dbversion + 1) hst // increment version number
# (_,hst) = myDatabase Set filename (dbversion + 1,valuef.value) hst // update database file
# (_,hst) = myDatabase Set filename (dbversion + 1,valuef.Form.value) hst // update database file
= ({valuef & changed = True},hst)
where
myDatabase init filename cntvalue hst // write the database
......
......@@ -31,6 +31,17 @@ derive gerda (,), (,,), (,,,)
, format :: !StorageFormat // Format of the serialized state
}
:: FormUpdate = { formid :: !String // The unique identifier of the form
, inputid :: !Int // The index of the changed input in the form
, value :: !UpdValue // The new value of the input (TODO: See if this can be replaced by a String)
}
:: UpdValue // the updates that can take place
= UpdI Int // new integer value
| UpdR Real // new real value
| UpdB Bool // new boolean value
| UpdC String // choose indicated constructor
| UpdS String // new piece of text
/*
* Create an empty initial FormStates value
......
......@@ -19,7 +19,7 @@ gForm{|(<->)|} gHa gHb (init,formid) hst
# (na,hst) = gHa (init,reuseFormId formid a) (incrHStCntr 1 hst) // one more for the now invisible <-> constructor
# (nb,hst) = gHb (init,reuseFormId formid b) hst
= ( { changed = na.changed || nb.changed
, value = na.value <-> nb.value
, value = na.Form.value <-> nb.Form.value
, form = [SpanTag [] na.form, SpanTag [] nb.form]
, inputs = na.inputs ++ nb.inputs
},hst)
......@@ -31,7 +31,7 @@ gForm{|(<|>)|} gHa gHb (init,formid) hst
# (na,hst) = gHa (init,reuseFormId formid a) (incrHStCntr 1 hst) // one more for the now invisible <|> constructor
# (nb,hst) = gHb (init,reuseFormId formid b) hst
= ( { changed = na.changed || nb.changed
, value = na.value <|> nb.value
, value = na.Form.value <|> nb.Form.value
, form = [DivTag [] na.form, DivTag [] nb.form]
, inputs = na.inputs ++ nb.inputs
},hst)
......@@ -44,21 +44,21 @@ gForm{|DisplayMode|} gHa (init,formid) hst
(HideMode a)
# (na,hst) = gHa (init,reuseFormId formid a <@ Display) (incrHStCntr 1 hst)
= ( { changed = na.changed
, value = HideMode na.value
, value = HideMode na.Form.value
, form = []
, inputs = []
},hst)
(DisplayMode a)
# (na,hst) = gHa (init,reuseFormId formid a <@ Display) (incrHStCntr 1 hst)
= ( { changed = False
, value = DisplayMode na.value
, value = DisplayMode na.Form.value
, form = na.form
, inputs = []
},hst)
(EditMode a)
# (na,hst) = gHa (init,reuseFormId formid a <@ Edit) (incrHStCntr 1 hst)
= ( { changed = na.changed
, value = EditMode na.value
, value = EditMode na.Form.value
, form = na.form
, inputs = na.inputs
},hst)
......
......@@ -26,7 +26,7 @@ readDB2 name=:(idn,_) = appHSt ("readDB2 " +++ idn) (DB name id)
DB :: !(DBid a) !(a -> a) !*HSt -> (!a,!*HSt) | iData a
DB (name,storageKind) fun hst
# (form,hst) = mkStoreForm (Init,nFormId (db_prefix +++ name) createDefault <@ storageKind <@ NoForm) fun hst
= (form.value,hst)
= (form.Form.value,hst)
mkDBid :: !String !Lifespan -> (DBid a)
mkDBid s Database
......
......@@ -25,14 +25,14 @@ editTask` prompt a tst=:{tasknr,html,hst,userId}
# editId = iTaskId userId tasknr "EdVal"
# buttonId = iTaskId userId tasknr "EdBut"
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) id hst // remember if the task has been done
| taskdone.value // test if task has completed
| taskdone.Form.value // test if task has completed
# (editor,hst) = (mkEditForm (Init,cFormId tst.options editId a <@ Display) hst) // yes, read out current value, make editor passive
= (editor.value,{tst & activated = True, html = html +|+ BT editor.form editor.inputs, hst = hst}) // return result task
= (editor.Form.value,{tst & activated = True, html = html +|+ BT editor.form editor.inputs, hst = hst}) // return result task
# (editor,hst) = mkEditForm (Init,cFormId tst.options editId a) hst // no, read out current value from active editor
# (finbut,hst) = mySimpleButton tst.options buttonId prompt (\_ -> True) hst // add button for marking task as done
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) finbut.value hst // remember task status for next time
| taskdone.value = editTask` prompt a {tst & hst = hst} // task is now completed, handle as previously
= (editor.value,{tst & activated = taskdone.value, html = html +|+ BT (editor.form ++ finbut.form) (editor.inputs ++ finbut.inputs), hst = hst})
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) finbut.Form.value hst // remember task status for next time
| taskdone.Form.value = editTask` prompt a {tst & hst = hst} // task is now completed, handle as previously
= (editor.Form.value,{tst & activated = taskdone.Form.value, html = html +|+ BT (editor.form ++ finbut.form) (editor.inputs ++ finbut.inputs), hst = hst})
editTaskPred :: !a !(a -> (Bool, [HtmlTag]))-> (Task a) | iData a
editTaskPred a pred = mkTask "editTask" (editTaskPred` a)
......@@ -41,16 +41,16 @@ where
# taskId = iTaskId userId tasknr "EdFin"
# editId = iTaskId userId tasknr "EdVal"
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) id hst // remember if the task has been done
| taskdone.value // test if task has completed
| taskdone.Form.value // test if task has completed
# (editor,hst) = (mkEditForm (Init,cFormId tst.options editId a <@ Display) hst) // yes, read out current value, make editor passive
= (editor.value,{tst & activated = True, html = html +|+ BT editor.form editor.inputs, hst = hst}) // return result task
= (editor.Form.value,{tst & activated = True, html = html +|+ BT editor.form editor.inputs, hst = hst}) // return result task
# (editor,hst) = mkEditForm (Init,cFormId tst.options editId a <@ Submit)<