Commit 56be1567 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 962d4b29
......@@ -7,10 +7,10 @@ import iDataButtons
// **** easy creation of a simple html page ****
mkHtml :: String [BodyTag] *HSt -> (!Bool,Html,*HSt) // string is used for the title of the page
mkHtmlExcep :: String !Bool [BodyTag] *HSt -> (!Bool,Html,*HSt) // same, passes on possible exception for client
mkHtmlB :: String [BodyAttr] [BodyTag] *HSt -> (!Bool,Html,*HSt) // same, with bodytags options
simpleHtml :: String [BodyAttr] [BodyTag] -> Html // as above, without HSt
mkHtml :: !String ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt) // string is used for the title of the page
mkHtmlExcep :: !String !(!Bool,!String) ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt) // same, passes on possible exception for client
mkHtmlB :: !String ![BodyAttr] ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt) // same, with bodytags options
simpleHtml :: !String ![BodyAttr] ![BodyTag] -> Html // as above, without HSt
// **** LayOut support ****
......
......@@ -12,20 +12,20 @@ derive gForm []; derive gUpd []
// easy creation of an html page
mkHtml :: String [BodyTag] *HSt -> (!Bool,Html,*HSt)
mkHtml s tags hst = (False,simpleHtml s [] tags,hst)
mkHtml :: !String ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt)
mkHtml s tags hst = ((False,""),simpleHtml s [] tags,hst)
mkHtmlExcep :: String !Bool [BodyTag] *HSt -> (!Bool,Html,*HSt)
mkHtmlExcep s exception tags hst = (exception,simpleHtml s [] tags,hst)
mkHtmlExcep :: !String !(!Bool,!String) ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt)
mkHtmlExcep s (exception,prefix) tags hst = ((exception,prefix),simpleHtml s [] tags,hst)
simpleHtml :: String [BodyAttr] [BodyTag] -> Html
simpleHtml :: !String ![BodyAttr] ![BodyTag] -> Html
simpleHtml s ba tags = Html (header s) (body tags)
where
header s = Head [`Hd_Std [Std_Title s]] []
body tags = Body ba tags
mkHtmlB :: String [BodyAttr] [BodyTag] *HSt -> (!Bool,Html,*HSt)
mkHtmlB s attr tags hst = (False, simpleHtml s attr tags,hst)
mkHtmlB :: !String ![BodyAttr] ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt)
mkHtmlB s attr tags hst = ((False,""), simpleHtml s attr tags,hst)
// operators for lay-out of html bodys ...
......
......@@ -31,11 +31,11 @@ derive write Inline
:: Inline = Inline String
:: UserPage :== .(*HSt -> .(!Bool,Html,!*HSt))
:: UserPage :== .(*HSt -> .((!Bool,!String),Html,!*HSt))
// doHtmlServer & doHtmlClient main wrappers for generating & handling of Html forms
doHtmlWrapper :: UserPage !*World -> *World //Combined wrapper which starts the server or client wrapper
doHtmlWrapper :: !UserPage !*World -> *World //Combined wrapper which starts the server or client wrapper
// 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!
......
......@@ -49,13 +49,13 @@ closemDataFile datafile world
//doHtmlServer. It switches between doHtmlServer and doHtmlClient depending on which compile option
//is selected.
doHtmlWrapper :: UserPage !*World -> *World
doHtmlWrapper :: !UserPage !*World -> *World
doHtmlWrapper userpage world = IF_Client (doHtmlClient userpage world) (doHtmlServer userpage world)
// doHtmlServer: top level function given to end user.
// It sets up the communication with a (sub)server or client, depending on the option chosen.
doHtmlServer :: UserPage !*World -> *World
doHtmlServer :: !UserPage !*World -> *World
doHtmlServer userpage world
| ServerKind == Internal
# world = instructions world
......@@ -117,18 +117,18 @@ doDynamicResource userpage request world
= ({http_emptyResponse & rsp_data = (toString html)}, world)
// General entry used by all servers and client to calculate the next page
doHtmlPage :: !HTTPRequest !.(*HSt -> (!Bool,Html,!*HSt)) !*HtmlStream !*World -> (!Bool,!*HtmlStream,!*World)
doHtmlPage :: !HTTPRequest !.UserPage !*HtmlStream !*World -> (!Bool,!*HtmlStream,!*World)
doHtmlPage request userpage inout world
# (gerda,world) = openDatabase ODCBDataBaseName world // open the relational database if option chosen
# (datafile,world) = openmDataFile DataFileName world // open the datafile if option chosen
# nworld = {worldC = world, inout = inout, gerda = gerda, datafile = datafile}
# (initforms,nworld) = retrieveFormStates request.arg_post nworld // Retrieve the state information stored in an html page, other state information is collected lazily
# hst = {(mkHSt initforms nworld) & request = request} // Create the HSt
# (toServer,Html (Head headattr headtags) (Body bodyattr bodytags),{states,world})
# ((toServer,prefix),Html (Head headattr headtags) (Body bodyattr bodytags),{states,world})
= userpage hst // Call the user application
# (debugOutput,states) = if TraceOutput (traceStates states) (EmptyBody,states) // Optional show debug information
# (pagestate, focus, world=:{worldC,gerda,inout,datafile})
= storeFormStates states world // Store all state information
= storeFormStates prefix states world // Store all state information
# worldC = closeDatabase gerda worldC // close the relational database if option chosen
# worldC = closemDataFile datafile worldC // close the datafile if option chosen
# inout = IF_Ajax
......@@ -336,7 +336,7 @@ where
// gForm: automatically derives a Html form for any Clean type
mkForm :: !(InIDataId a) !*HSt -> *(Form a, !*HSt) | gForm {|*|} a
mkForm :: !(InIDataId a) *HSt -> *(Form a, !*HSt) | gForm {|*|} a
mkForm (init,formid) hst =: {issub}
# (form,hst) = gForm{|*|} (init,formid) {hst & submits = (formid.mode == Submit), issub = True} //Use gForm to create the html form
# buttons = if (formid.mode == Submit) //Add submit and clear buttons to a form in submit mode.
......@@ -635,12 +635,12 @@ where
toHtml :: a -> BodyTag | gForm {|*|} a
toHtml a
# (na,_) = mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt emptyFormStates (abort "illegal call to toHtml"))
# (na,_) = mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt emptyFormStates (abort "illegal call to toHtml!\n"))
= BodyTag na.form
toHtmlForm :: !(*HSt -> *(Form a,*HSt)) -> [BodyTag] | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
toHtmlForm anyform
# (na,hst) = anyform (mkHSt emptyFormStates undef)
# (na,hst) = anyform (mkHSt emptyFormStates (abort "illegal call to toHtmlForm!\n"))
= na.form
toBody :: (Form a) -> BodyTag
......
......@@ -27,7 +27,7 @@ changeLifetimeStates :: !String !Lifespan !Lifespan !*FormStates !*NWorld -> (!*
// storage and retrieval of FormStates
retrieveFormStates :: ![(!String, !String)] !*NWorld -> (!*FormStates,!*NWorld) // retrieves all form states hidden in the html page
storeFormStates :: !FormStates !*NWorld -> (!String, !String, !*NWorld)
storeFormStates :: !String !FormStates !*NWorld -> (!String, !String, !*NWorld)
getTriplets :: !String !*FormStates -> (!Triplets,!*FormStates) // retrieve triplets matching given id
......
......@@ -327,13 +327,15 @@ where
// Serialize all states in FormStates that have to be remembered to either hidden encoded Html Code
// or store them in a persistent file, all depending on the kind of states
storeFormStates :: !FormStates !*NWorld -> (!String, !String, !*NWorld)
storeFormStates {fstates = allFormStates, focusid = focus} world
storeFormStates :: !String !FormStates !*NWorld -> (!String, !String, !*NWorld)
storeFormStates prefix {fstates = allFormStates, focusid = focus} world
# world = writeAllTxtFileStates allFormStates world // first write all persistens states
# encodedpagestate = EncodeHtmlStates (FStateToHtmlState allFormStates []) // encode states in the page
= (encodedpagestate, focus, world)
where
sprefix = size prefix
FStateToHtmlState :: !(Tree_ !(!String,!.FormState)) !*[HtmlState] -> *[HtmlState]
FStateToHtmlState Leaf_ accu = accu
FStateToHtmlState (Node_ left x right) accu
......@@ -350,6 +352,10 @@ where
htmlStateOf (fid,OldState {life=Client, format=PlainStr stringval}) = Just (fid,Client, PlainString,stringval)
htmlStateOf (fid,OldState {life=Client, format=StatDyn dynval}) = Just (fid,Client, StaticDynamic,dynamic_to_string dynval)
htmlStateOf (fid,OldState {life=Page, format=PlainStr stringval})
| prefix <> fid%(0,sprefix) = Just (fid,Client, PlainString,stringval) // for Ajax calls, remember states not belonging to this thread
htmlStateOf (fid,OldState {life=Page, format=StatDyn dynval})
| prefix <> fid%(0,sprefix) = Just (fid,Client, StaticDynamic,dynamic_to_string dynval)
htmlStateOf (fid,OldState s) = Nothing
// persistent stores (either old or new) have already been stored in files and can be skipped here
......
......@@ -19,7 +19,6 @@ derive gerda Void
derive read Void
derive write Void
// iTask main task types:
:: LabeledTask a :== !(!TaskLabel,!Task a) // a Task with a label used for labeling buttons, pull down menu, and the like
......@@ -61,17 +60,15 @@ instance <<@ Lifespan // default: Session
instance @>> SubPage // default: the *whole* page will be updated when a form has been modified
// Initiate the iTask library with an iData server wrapper such as doHtmlServer in combination with one of the following functions:
/*
singleUserTask :: iTask start function for defining tasks for one, single user; intended for developing and testing
*/
singleUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
singleUserTask :: ![StartUpOptions] !(Task a) !*World -> *World | iData a
/*
multiUserTask :: iTask start function for multiple -users; intended for developing and testing
*/
multiUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
multiUserTask :: ![StartUpOptions] !(Task a) !*World -> *World | iData a
/*
workFlowTask :: iTask start function to create a real life workflow
......@@ -79,12 +76,10 @@ workFlowTask :: iTask start function to create a real life workflow
Bool: True, is the user a new one: if so the second argument is spawned as a separate task for that user
UserId: the id of that user
- the second argument is workflow that will spawned as a task
(True if we have new user,user id of the user, has ) :
- the second one is the actual function for that user
a predefined login task is defined as an example in iTaskLogin.dcl
*/
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a))
!(UserId a -> LabeledTask b) !*HSt -> (!Bool,Html,*HSt) | iData b
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b) !*World -> *World | iData b
/*
......
......@@ -119,44 +119,51 @@ where (@>>) UseAjax task = \tst -> IF_Ajax
// *** wrappers for the end user, to be used in combination with an iData wrapper...
// ******************************************************************************************************
singleUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
singleUserTask startUpOptions maintask hst
# userOptions = determineUserOptions [ThreadStorage TxtFile:startUpOptions]
# tst = initTst 0 Session userOptions.threadStorageLoc hst
# (exception,html,hst) = startTstTask 0 False (False,[]) userOptions maintask tst
= mkHtmlExcep "singleUser" exception html hst
multiUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
multiUserTask startUpOptions maintask hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# nusers = case userOptions.showUsersOn of
Nothing -> 0
Just n -> n
| nusers == 0 = singleUserTask startUpOptions maintask hst
# (idform,hst) = FuncMenu (Init,nFormId "User_Selected"
(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
# currentWorker = snd idform.value
# tst = initTst currentWorker TxtFile userOptions.threadStorageLoc hst
# (exception,html,hst) = startTstTask currentWorker True
(if userOptions.traceOn (idform.changed,idform.form) (False,[])) userOptions maintask tst
= mkHtmlExcep "multiUser" exception html hst
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b) !*HSt -> (!Bool,Html,*HSt) | iData b
workFlowTask startUpOptions taska userTask hst
# userOptions = determineUserOptions startUpOptions
# tst = initTst -1 Session userOptions.threadStorageLoc hst
# (((new,i),a),tst=:{activated,html,hst})
= taska tst // for doing the login
| not activated
# iTaskHeader = [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
# iTaskInfo = mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
= mkHtmlExcep "workFlow" True [Ajax [ ("thePage",iTaskHeader ++ iTaskInfo ++ noFilter html) // Login ritual cannot be handled by client
]] hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# tst = initTst i Session userOptions.threadStorageLoc hst
# (exception,body,hst) = startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
= mkHtmlExcep "workFlow" exception body hst
//singleUserTask :: ![StartUpOptions] !(Task a) -> UserPage | iData a
singleUserTask :: ![StartUpOptions] !(Task a) !*World -> *World | iData a
singleUserTask startUpOptions maintask world = doHtmlWrapper singleUserTask` world
where
singleUserTask` hst
# userOptions = determineUserOptions [ThreadStorage TxtFile:startUpOptions]
# tst = initTst 0 Session userOptions.threadStorageLoc hst
# (toserver_prefix,html,hst) = startTstTask 0 False (False,[]) userOptions maintask tst
= mkHtmlExcep "singleUser" (toserver_prefix) html hst
multiUserTask :: ![StartUpOptions] !(Task a) !*World -> *World | iData a
multiUserTask startUpOptions maintask world = doHtmlWrapper multiUserTask` world
where
multiUserTask` hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# nusers = case userOptions.showUsersOn of
Nothing -> 0
Just n -> n
// | nusers == 0 = singleUserTask startUpOptions maintask hst
# (idform,hst) = FuncMenu (Init,nFormId "User_Selected"
(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
# currentWorker = snd idform.value
# tst = initTst currentWorker TxtFile userOptions.threadStorageLoc hst
# (toserver_prefix,html,hst) = startTstTask currentWorker True
(if userOptions.traceOn (idform.changed,idform.form) (False,[])) userOptions maintask tst
= mkHtmlExcep "multiUser" (toserver_prefix) html hst
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b)!*World -> *World | iData b
workFlowTask startUpOptions taska userTask world = doHtmlWrapper workFlowTask` world
where
workFlowTask` hst
# userOptions = determineUserOptions startUpOptions
# tst = initTst -1 Session userOptions.threadStorageLoc hst
# (((new,i),a),tst=:{activated,html,hst})
= taska tst // for doing the login
| not activated
# iTaskHeader = [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
# iTaskInfo = mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
= mkHtmlExcep "workFlow" (True,"") [Ajax [ ("thePage",iTaskHeader ++ iTaskInfo ++ noFilter html) // Login ritual cannot be handled by client
]] hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# tst = initTst i Session userOptions.threadStorageLoc hst
# (toserver_prefix,body,hst) = startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
= mkHtmlExcep "workFlow" (toserver_prefix) body hst
noFilter :: HtmlTree -> HtmlCode
noFilter (BT body) = body
noFilter (_ @@: html) = noFilter html
......@@ -186,7 +193,7 @@ where
// *THE* main routine for the determination of the current state and the creation of a new workflow page
// ******************************************************************************************************
startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) | iData a
startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!(!Bool,!String),!HtmlCode,!*HSt) | iData a
startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff, testModeOn} maintask tst=:{hst,tasknr,staticInfo}
// prologue
......@@ -210,7 +217,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
[Hr []]
| versionconflict
# iTaskInfo = mkDiv "iTaskInfo" [showLabel "Cannot apply request. Version conflict. Please refresh the page!", Hr []]
= (True,[Ajax [("thePage",iTaskHeader ++ iTaskInfo)]],hst)
= ((True,""),[Ajax [("thePage",iTaskHeader ++ iTaskInfo)]],hst)
// Here the iTasks are evaluated ...
......@@ -228,6 +235,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
# (sversion,hst) = setSVersionNr thisUser (\_ -> newUserVersionNr) hst // store in persistent memory
# showCompletePage = IF_Ajax (hd threads == [-1]) True
# prefix = if showCompletePage "" (determine_prefix thisUser threads)
# (threadtrace,tst)
= if TraceThreads showThreadTable nilTable {tst & hst = hst}
# threadsText = if showCompletePage "" (foldl (+++) "" [showThreadNr tasknrs +++ " + " \\ tasknrs <- reverse threads])
......@@ -246,13 +254,13 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
[showText "Query " , showTrace ((sversion +++> " / " )<+++ appversion)] [] ++
IF_Ajax
( [showText " - Task#: ", showTrace (showTaskNr event)] ++
if (isEmpty threads || showCompletePage) [] [showText " - Thread(s)#: ", showTrace threadsText]
if (isEmpty threads || showCompletePage) [] [showText (" - Thread(s)#: "/* +++ prefix*/), showTrace threadsText]
) [] ++
[Br,Hr []]
)
Just userInfo -> userInfo
# iTaskTraceInfo = showOptions staticInfo.threadTableLoc ++ processadmin ++ threadtrace ++ [printTrace2 trace ]
| showCompletePage = (toServer,[Ajax [("thePage", iTaskHeader ++
| showCompletePage = ((toServer,""),[Ajax [("thePage", iTaskHeader ++
iTaskInfo ++
if (doTrace && traceOn)
iTaskTraceInfo
......@@ -263,7 +271,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
]
,hst)
# (newthread,oldthreads)= (hd threads, tl threads)
| otherwise = (toServer,[Ajax ( [("iTaskInfo", iTaskInfo)] ++ // header ino
| otherwise = ((toServer,""),[Ajax ( [("iTaskInfo", iTaskInfo)] ++ // header ino
[(showTaskNr childthreads,[showText " "]) \\ childthreads <- oldthreads] ++ //clear childthreads, since parent thread don't need to be on this page
[(showTaskNr newthread, if (isEmpty threadcode) seltask threadcode)] // task info
)
......@@ -276,6 +284,13 @@ where
// # world = if testModeOn deleteAllStateFiles id world
// = (Void,{hst & world = world})
determine_prefix:: !UserId ![TaskNr] -> String
determine_prefix user [] = ""
determine_prefix user [[-1]] = ""
determine_prefix user threads
# smallest = hd (sortBy (\l1 l2 -> length l1 < length l2) (map tl threads))
= iTaskId user smallest ""
leftright left right
= Table [Tbl_Width (Percent 100)]
[Tr [] [ Td [] left
......
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