Commit 2aa340b8 authored by Bas Lijnse's avatar Bas Lijnse

Added double buffering mechanism for hiding slow form updates

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@345 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 3ce7d50a
This diff is collapsed.
......@@ -11,6 +11,7 @@ from Http import :: HTTPRequest
from StdFile import class FileSystem
:: *HSt = { cntr :: !Int // counts position in expression
, prefix :: !String // global prefix used in all generated html id's
, request :: !HTTPRequest // to enable access to the current HTTP request
, states :: !*FormStates // all form states are collected here ...
, world :: *NWorld // to enable all kinds of I/O
......@@ -23,13 +24,14 @@ appWorldHSt :: !.(*World -> *World) !*HSt -> *HSt // enabling World
accWorldHSt :: !.(*World -> *(.a,*World)) !*HSt -> (.a,!*HSt) // enabling World operations on HSt
// Create a new HSt
mkHSt :: HTTPRequest *FormStates *NWorld -> *HSt
mkHSt :: String HTTPRequest *FormStates *NWorld -> *HSt
// Access on the HSt structure
getHStCntr :: !*HSt -> (!Int,!*HSt) // HSt.cntr
setHStCntr :: !Int !*HSt -> *HSt // HSt.cntr := HSt.cntr
incrHStCntr :: !Int !*HSt -> *HSt // HSt.cntr := HSt.cntr + n
setHStPrefix :: !String !*HSt -> *HSt
// Explicit removal of all (Persistent) IData for with the same prefix IData form id
// Change lifespan of all IData with the same prefix IData form id
......
......@@ -35,8 +35,8 @@ accWorldHSt f hst=:{world}
= (a,{hst & world=world})
// Create a new HSt
mkHSt :: HTTPRequest *FormStates *NWorld -> *HSt
mkHSt request states nworld = {cntr=0, states=states, request= request, world=nworld }
mkHSt :: String HTTPRequest *FormStates *NWorld -> *HSt
mkHSt prefix request states nworld = {cntr=0, prefix = prefix, states=states, request= request, world=nworld }
// Access on the HSt structure
getHStCntr :: !*HSt -> (!Int,!*HSt)
......@@ -48,6 +48,10 @@ setHStCntr i hst = {hst & cntr = i}
incrHStCntr :: !Int !*HSt -> *HSt
incrHStCntr i hst = {hst & cntr = hst.cntr + i}
setHStPrefix :: !String !*HSt -> *HSt
setHStPrefix s hst = {hst & prefix = s}
// It can be convenient to explicitly delete IData, in particular for persistent IData object
// or to optimize iTasks
// All IData objects administrated in the state satisfying the predicate will be deleted, no matter where they are stored.
......
......@@ -26,7 +26,7 @@ gPrint{|(->)|} gArg gRes _ _ = abort "functions can only be used with dynamic st
// TODO: Try to make it do just a little less :)
mkViewForm :: !(InIDataId d) !(HBimap d v) !*HSt -> (Form d,!*HSt) | iData v
mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{request,states,world}
mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{prefix, request,states,world}
| init == Const && formid.FormId.lifespan <> LSTemp
= mkViewForm (init,{FormId| formid & lifespan = LSTemp}) bm hst // constant i-data are never stored
| init == Const // constant i-data, no look up of previous value
......@@ -52,10 +52,10 @@ where
, form = []
, inputs = []
}
, mkHSt request states world)
, mkHSt prefix request states world)
# (viewform,{states,world}) // make a form for it
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt request states world)
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt prefix 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.Form.value) states world
......@@ -67,7 +67,7 @@ where
, form = viewform.form
, inputs = viewform.inputs
}
,mkHSt request states world)
,mkHSt prefix request states world)
replaceState` vformid view states world
| init <> Const = setState vformid view states world
......@@ -418,19 +418,19 @@ derive gUpd (,), (,,), (,,,), Void
// gForm: automatically derives a Html form for any Clean type
mkForm :: !(InIDataId a) *HSt -> *(Form a, !*HSt) | gForm {|*|} a
mkForm (init, formid =: {issub}) hst
mkForm (init, formid =: {issub}) hst =:{prefix}
# (form, hst) = gForm{|*|} (init, formid) hst
| issub = (form, hst) //Subforms are contained in the <form> tags of their parent
| otherwise = ({form &
form = [FormTag [IdAttr formid.id] form.form]
form = [FormTag [IdAttr (prefix +++ formid.id)] form.form]
}, hst)
//The basic building blocks for creating inputs
mkInput :: !(InIDataId d) String String !*HSt -> ([HtmlTag], [InputId],*HSt)
mkInput (init,formid=:{mode}) type val hst=:{cntr}
mkInput (init,formid=:{mode}) type val hst=:{cntr,prefix}
| mode == Edit || mode == Submit
# inputid = (formid.id +++ "-" +++ toString cntr)
# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
= ( [InputTag [ TypeAttr "text"
, ValueAttr val
, NameAttr inputid
......@@ -449,8 +449,8 @@ mkInput (init,formid=:{mode}) type val hst=:{cntr}
mkButton :: !(InIDataId d) String String !*HSt -> ([HtmlTag],[InputId],*HSt)
mkButton (init, formid =: {mode}) type label hst =: {cntr}
# inputid = (formid.id +++ "-" +++ toString cntr)
mkButton (init, formid =: {mode}) type label hst =: {cntr,prefix}
# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
= ( [ButtonTag [ NameAttr inputid
, IdAttr inputid
, TypeAttr "button"
......@@ -460,8 +460,8 @@ mkButton (init, formid =: {mode}) type label hst =: {cntr}
, setHStCntr (cntr + 1) hst)
mkSelect :: !(InIDataId d) String String [(String,String)] !*HSt -> ([HtmlTag],[InputId],*HSt)
mkSelect (init, formid=:{mode}) type val options hst =:{cntr}
# inputid = (formid.id +++ "-" +++ toString cntr)
mkSelect (init, formid=:{mode}) type val options hst =:{cntr,prefix}
# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
= ( [SelectTag [ NameAttr inputid
, IdAttr inputid
: if (mode == Display) [DisabledAttr] []
......@@ -470,8 +470,8 @@ mkSelect (init, formid=:{mode}) type val options hst =:{cntr}
, setHStCntr (cntr + 1) hst)
mkCheckBox :: !(InIDataId d) String Bool !*HSt -> ([HtmlTag],[InputId],*HSt)
mkCheckBox (init, formid=:{mode}) type val hst =:{cntr}
# inputid = (formid.id +++ "-" +++ toString cntr)
mkCheckBox (init, formid=:{mode}) type val hst =:{cntr,prefix}
# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
= ( [InputTag [ NameAttr inputid
, IdAttr inputid
, TypeAttr "checkbox"
......@@ -483,7 +483,7 @@ mkCheckBox (init, formid=:{mode}) type val hst =:{cntr}
// The following two functions are not an example of decent Clean programming, but it works thanks to lazy evaluation...
toHtml :: a -> HtmlTag | gForm {|*|} a
toHtml a
# (na,_) = mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt http_emptyRequest (mkFormStates [] []) dummy)
# (na,_) = mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt "" http_emptyRequest (mkFormStates [] []) dummy)
= BodyTag [] na.form
where
dummy = { worldC = abort "dummy world for toHtml!\n"
......@@ -493,7 +493,7 @@ where
toHtmlForm :: !(*HSt -> *(Form a,*HSt)) -> [HtmlTag] | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
toHtmlForm anyform
# (na,hst) = anyform (mkHSt http_emptyRequest (mkFormStates [] []) (abort "illegal call to toHtmlForm!\n"))
# (na,hst) = anyform (mkHSt "" http_emptyRequest (mkFormStates [] []) (abort "illegal call to toHtmlForm!\n"))
= na.form
where
dummy = { worldC = abort "dummy world for toHtmlForm!\n"
......
......@@ -79,8 +79,8 @@ gForm{|HtmlButton|} (init,formid) hst
where
(HtmlButton l t) = formid.ival
gForm{|HtmlCheckbox|} (init,formid =: {mode}) hst =:{cntr}
# inputid = formid.id +++ "-" +++ toString cntr
gForm{|HtmlCheckbox|} (init,formid =: {mode}) hst =:{cntr,prefix}
# inputid = prefix +++ formid.id +++ "-" +++ toString cntr
= ({ changed = False
, value = formid.ival
, form = [InputTag [ TypeAttr "checkbox"
......@@ -104,8 +104,8 @@ gForm{|HtmlSelect|} (init,formid) hst
where
(HtmlSelect o v) = formid.ival
gForm{|HtmlTextarea|} (init,formid =: {mode}) hst =:{cntr}
# inputid = formid.id +++ "-" +++ toString cntr
gForm{|HtmlTextarea|} (init,formid =: {mode}) hst =:{cntr,prefix}
# inputid = prefix +++ formid.id +++ "-" +++ toString cntr
= ( { changed = False
, value = formid.ival
, form = [TextareaTag [ NameAttr inputid
......@@ -119,8 +119,8 @@ gForm{|HtmlTextarea|} (init,formid =: {mode}) hst =:{cntr}
where
(HtmlTextarea rows val) = formid.ival
gForm{|HtmlPassword|} (init,formid =: {mode}) hst =: {cntr}
#inputid = formid.id +++ "-" +++ toString cntr
gForm{|HtmlPassword|} (init,formid =: {mode}) hst =: {cntr,prefix}
#inputid = prefix +++ formid.id +++ "-" +++ toString cntr
= ({ changed = False
, value = formid.ival
......
......@@ -13,6 +13,7 @@ derive JSONEncode TabContent, TaskStatus, InputId, UpdateEvent, HtmlState, Stora
, error :: Maybe String //Optional error if something went wrong on the server
, html :: String //The HTML content of the tab
, inputs :: [InputId] //The interactive inputs in the tab
, prefix :: String //The prefix string which is prepended to all html id's of the inputs in the tab
, state :: [HtmlState] //The task state that must be stored in the tab
, activeTasks :: Maybe [String] //Optional list of task id's to sync the open tabs with the known states on the server
, stateTrace :: Maybe String //Optional state trace info
......@@ -25,6 +26,7 @@ derive JSONEncode TabContent, TaskStatus, InputId, UpdateEvent, HtmlState, Stora
*/
handleWorkTabRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleWorkTabRequest mainTask request session hst
# hst = setHStPrefix prefix hst
# (toServer, htmlTree, maybeError, _, _, hst) = calculateTaskTree thisUserId traceOn False False mainTask hst // calculate the TaskTree given the id of the current user
# (taskStatus,html,inputs) = determineTaskForTab thisUserId taskId htmlTree // filter out the code and inputs to display in this tab
# (htmlstates,hst) = getPageStates hst // Collect states that must be temporarily stored in the browser
......@@ -50,6 +52,7 @@ handleWorkTabRequest mainTask request session hst
, error = maybeError
, html = toString (DivTag [IdAttr ("itasks-tab-" +++ taskId)] html)
, inputs = inputs
, prefix = prefix
, state = htmlstates
, activeTasks = activeTasks
, stateTrace = stateTrace
......@@ -62,6 +65,7 @@ where
thisUserId = session.Session.userId // fetch user id from the session
taskId = http_getValue "taskid" request.arg_get "error" // fetch task id of the tab selecetd
traceOn = http_getValue "trace" request.arg_post "" == "1"
prefix = http_getValue "prefix" request.arg_post "" // prepend a prefix to inputs when asked
mbStateTrace req states
| traceOn
......
......@@ -131,7 +131,7 @@ initHSt request world
# updates = decodeFormUpdates request.arg_post // Get the form updates from the post
# states = decodeHtmlStates request.arg_post // Fetch stored states from the post
# fstates = mkFormStates states updates
= mkHSt request fstates nworld
= mkHSt "" request fstates nworld
where
decodeFormUpdates :: ![(!String, !String)] -> [FormUpdate]
decodeFormUpdates args = [update \\ (Just update) <- map mbUpdate args]
......
Markdown is supported
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