Skip to content

GitLab

Commit 962d4b29 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 994e352a
Hide whitespace changes
Inline Side-by-side
libraries/iData/iDataState.dcl
View file @ 962d4b29
......@@ -10,34 +10,34 @@ import iDataHtmlDef, EncodeDecode
:: *FormStates // collection of all states of all forms
emptyFormStates :: *FormStates // creates empty states
emptyFormStates :: !*FormStates // creates empty states
findState :: !(FormId a) !*FormStates *NWorld // find the state value given FormId and a correct type
-> (Bool, Maybe a,*FormStates,*NWorld) // true if form has not yet been previously inspected
findState :: !(FormId a) !*FormStates !*NWorld // find the state value given FormId and a correct type
-> (!Bool, !Maybe a,!*FormStates,!*NWorld) // true if form has not yet been previously inspected
| iPrint, iParse, iSpecialStore a
replaceState :: !(FormId a) a !*FormStates *NWorld // replace state given FormId
-> (*FormStates,*NWorld) | iPrint, iSpecialStore a
replaceState :: !(FormId a) a !*FormStates !*NWorld // replace state given FormId
-> (!*FormStates,!*NWorld) | iPrint, iSpecialStore a
getUpdateId :: !*FormStates -> ([String],!*FormStates) // id of previously changed form
getUpdateId :: !*FormStates -> (![String],!*FormStates) // id of previously changed form
deleteStates :: !String !*FormStates *NWorld -> (*FormStates,*NWorld) // delete iData administration of all iData with this prefix
deleteStates :: !String !*FormStates !*NWorld -> (!*FormStates,!*NWorld) // delete iData administration of all iData with this prefix
changeLifetimeStates :: !String !Lifespan !Lifespan !*FormStates *NWorld -> (*FormStates,*NWorld) // change lifespan of all iData with is prefix and given old lifespan
changeLifetimeStates :: !String !Lifespan !Lifespan !*FormStates !*NWorld -> (!*FormStates,!*NWorld) // change lifespan of all iData with is prefix and given old lifespan
// 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)
retrieveFormStates :: ![(!String, !String)] !*NWorld -> (!*FormStates,!*NWorld) // retrieves all form states hidden in the html page
storeFormStates :: !FormStates !*NWorld -> (!String, !String, !*NWorld)
getTriplets :: !String !*FormStates -> (Triplets,!*FormStates) // retrieve triplets matching given id
getAllTriplets :: !*FormStates -> (Triplets,!*FormStates) // retrieve all triplets
getTriplets :: !String !*FormStates -> (!Triplets,!*FormStates) // retrieve triplets matching given id
getAllTriplets :: !*FormStates -> (!Triplets,!*FormStates) // retrieve all triplets
// tracing all states ...
traceStates :: !*FormStates -> (BodyTag,!*FormStates)
traceStates :: !*FormStates -> (!BodyTag,!*FormStates)
// fstate handling used for testing only
initTestFormStates :: *NWorld -> (*FormStates,*NWorld) // creates initial empty form states
setTestFormStates :: [(Triplet,String)] String String *FormStates *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
initTestFormStates :: !*NWorld -> (!*FormStates,!*NWorld) // creates initial empty form states
setTestFormStates :: ![(!Triplet,!String)] !String !String !*FormStates !*NWorld -> (!*FormStates,!*NWorld) // retrieves all form states hidden in the html page
libraries/iData/iDataState.icl
View file @ 962d4b29
......@@ -23,14 +23,14 @@ import EstherBackend
// and new states (states of newly created forms and updated forms)
:: *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
, updateid :: String // which form has changed
, focusid :: String // which input has the focus
{ fstates :: !*FStates // internal tree of states
, triplets :: ![(!Triplet,!String)] // indicates what has changed: which form, which postion, which value
, updateid :: !String // which form has changed
, focusid :: !String // which input has the focus
}
:: FStates :== Tree_ (String,FormState) // each form needs a different string id
:: Tree_ a = Node_ (Tree_ a) a (Tree_ a) | Leaf_
:: FStates :== Tree_ !(!String,!FormState) // each form needs a different string id
:: Tree_ a = Node_ !(Tree_ !a) !a !(Tree_ !a) | Leaf_
:: FormState = OldState !FState // Old states are the states from the previous calculation
| NewState !FState // New states are newly created states or old states that have been inspected and updated
:: FState = { format :: !Format // Encoding method used for serialization
......@@ -38,8 +38,8 @@ import EstherBackend
}
:: Format = PlainStr !.String // Either a string is used for serialization
| StatDyn !Dynamic // Or a dynamic which enables serialization of functions defined in the application (no plug ins yet)
| DBStr !.String (*Gerda -> *Gerda) // In case a new value has to bestored in the relational database
| CLDBStr !.String (*DataFile -> *DataFile) // In case a new value has to bestored in a Cleans database file
| DBStr .String (*Gerda -> *Gerda) // In case a new value has to bestored in the relational database
| CLDBStr .String (*DataFile -> *DataFile) // In case a new value has to bestored in a Cleans database file
// Database OPTION
......@@ -82,19 +82,19 @@ where
emptyFormStates :: *FormStates
emptyFormStates = { fstates = Leaf_ , triplets = [], updateid = "", focusid = ""}
getTriplets :: !String !*FormStates -> (Triplets,!*FormStates)
getTriplets :: !String !*FormStates -> (!Triplets,!*FormStates)
getTriplets id formstates=:{triplets} = ([mytrips \\ mytrips=:((tripid,_,_),_) <- triplets | id == tripid] ,formstates)
getAllTriplets :: !*FormStates -> (Triplets,!*FormStates)
getAllTriplets :: !*FormStates -> (!Triplets,!*FormStates)
getAllTriplets formstates=:{triplets} = (triplets,formstates)
getUpdateId :: !*FormStates -> ([String],!*FormStates)
getUpdateId :: !*FormStates -> (![String],!*FormStates)
getUpdateId formStates=:{triplets} = (removeDup [tripid \\ ((tripid,_,_),_) <- triplets] ,formStates)
getUpdate :: !*FormStates -> (String,!*FormStates)
getUpdate formStates = ("",formStates)
findState :: !(FormId a) !*FormStates *NWorld -> (Bool,Maybe a,*FormStates,*NWorld) | iPrint, iParse, iSpecialStore a
findState :: !(FormId a) !*FormStates !*NWorld -> (!Bool,!Maybe a,!*FormStates,!*NWorld) | iPrint, iParse, iSpecialStore a
findState formid formstates=:{fstates} world
# (bool,ma,fstates,world) = findState` formid fstates world
= (bool,ma,{formstates & fstates = fstates},world)
......@@ -196,10 +196,10 @@ where
findState` _ Leaf_ world = (False,Nothing,Leaf_,world)
findState` _ _ world = (False,Nothing,Leaf_,world)
string_to_dynamic` :: {#Char} -> Dynamic // just to make a unique copy as requested by string_to_dynamic
string_to_dynamic` :: !{#Char} -> Dynamic // just to make a unique copy as requested by string_to_dynamic
string_to_dynamic` s = string_to_dynamic {s` \\ s` <-: s}
replaceState :: !(FormId a) a !*FormStates *NWorld -> (*FormStates,*NWorld) | iPrint,iSpecialStore a
replaceState :: !(FormId a) a !*FormStates !*NWorld -> (!*FormStates,!*NWorld) | iPrint,iSpecialStore a
replaceState formid val formstates=:{fstates} world
# (fstates,world) = replaceState` formid val fstates world
= ({formstates & fstates = fstates},world)
......@@ -232,14 +232,14 @@ where
order l1 l2 = if (l1 < l2) l2 l1 // longest lifetime chosen will be the final setting Database > DataFile > TxtFile > Session > Page > temp
deleteStates :: !String !*FormStates *NWorld -> (*FormStates,*NWorld)
deleteStates :: !String !*FormStates !*NWorld -> (!*FormStates,!*NWorld)
deleteStates prefix formstates=:{fstates} world
# (fstates,world) = deleteStates` fstates world
= ({formstates & fstates = fstates},world)
where
lprefix = size prefix
deleteStates` :: *FStates *NWorld -> (*FStates,*NWorld)
deleteStates` :: !*FStates !*NWorld -> (!*FStates,!*NWorld)
deleteStates` Leaf_ world = (Leaf_,world)
deleteStates` (Node_ left a=:(fid,_) right) world
# prefid = if (size fid <= lprefix) fid (fid%(0,lprefix-1)) // determine prefix of this form
......@@ -275,14 +275,14 @@ where
// change storage option
changeLifetimeStates :: !String !Lifespan !Lifespan !*FormStates *NWorld -> (*FormStates,*NWorld)
changeLifetimeStates :: !String !Lifespan !Lifespan !*FormStates !*NWorld -> (!*FormStates,!*NWorld)
changeLifetimeStates prefix oldlifespan newlifespan formstates=:{fstates} world
# (fstates,world) = changeLifetimeStates` fstates world
= ({formstates & fstates = fstates},world)
where
lprefix = size prefix
changeLifetimeStates` :: *FStates *NWorld -> (*FStates,*NWorld)
changeLifetimeStates` :: !*FStates !*NWorld -> (!*FStates,!*NWorld)
changeLifetimeStates` Leaf_ world = (Leaf_,world)
changeLifetimeStates` (Node_ left a=:(fid,_) right) world
# prefid = if (size fid <= lprefix) fid (fid%(0,lprefix-1)) // determine prefix of this form
......@@ -303,7 +303,7 @@ where
//
// De-serialize information from server to the internally used form states
retrieveFormStates :: [(String, String)] *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
retrieveFormStates :: ![(!String, !String)] !*NWorld -> (!*FormStates,!*NWorld) // retrieves all form states hidden in the html page
retrieveFormStates args world
= ({ fstates = retrieveFStates, triplets = triplets, updateid = calc_updateid triplets, focusid = focus},world)
where
......@@ -327,21 +327,21 @@ 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 :: !FormStates !*NWorld -> (!String, !String, !*NWorld)
storeFormStates {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
FStateToHtmlState :: !(Tree_ (String,.FormState)) *[HtmlState] -> *[HtmlState]
FStateToHtmlState :: !(Tree_ !(!String,!.FormState)) !*[HtmlState] -> *[HtmlState]
FStateToHtmlState Leaf_ accu = accu
FStateToHtmlState (Node_ left x right) accu
= case htmlStateOf x of
Just state = FStateToHtmlState left [state : FStateToHtmlState right accu]
nothing = FStateToHtmlState left (FStateToHtmlState right accu)
where
htmlStateOf :: !(String,.FormState) -> Maybe HtmlState
htmlStateOf :: !(!String,!.FormState) -> Maybe HtmlState
// old states which have not been used this time, but with lifespan session, are stored again in the page
// other old states will have lifespan page or are persistent; they need not to be stored
htmlStateOf (fid,OldState {life=Session,format=PlainStr stringval}) = Just (fid,Session,PlainString,stringval)
......@@ -360,7 +360,7 @@ where
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)
writeAllTxtFileStates :: !FStates *NWorld -> *NWorld // store states in persistent stores
writeAllTxtFileStates :: !FStates !*NWorld -> *NWorld // store states in persistent stores
writeAllTxtFileStates Leaf_ nworld = nworld
writeAllTxtFileStates (Node_ left st right) nworld
= writeAllTxtFileStates right (writeAllTxtFileStates left (writeTxtFileState st nworld))
......@@ -386,7 +386,7 @@ where
// trace States
traceStates :: !*FormStates -> (BodyTag,!*FormStates)
traceStates :: !*FormStates -> (!BodyTag,!*FormStates)
traceStates formstates=:{fstates}
# (bodytags,fstates) = traceStates` fstates
= (BodyTag [Br, B [] "State values when application ended:",Br,
......@@ -411,10 +411,10 @@ where
strip s = { ns \\ ns <-: s | ns >= '\020' && ns <= '\0200'}
ShowValueDynamic :: Dynamic -> String
ShowValueDynamic :: !Dynamic -> String
ShowValueDynamic d = strip (foldr (+++) "" (fst (toStringDynamic d)) +++ " ")
ShowTypeDynamic :: Dynamic -> String
ShowTypeDynamic :: !Dynamic -> String
ShowTypeDynamic d = strip (snd (toStringDynamic d) +++ " ")
// debugging code
......@@ -438,10 +438,10 @@ my_dynamic_to_string d
= abort ""
= s;
tohexstring :: {#Char} -> {#Char};
tohexstring :: !{#Char} -> {#Char};
tohexstring s = {tohexchar s i \\ i<-[0..2*size s-1]};
tohexchar :: {#Char} Int -> Char;
tohexchar :: !{#Char} !Int -> Char;
tohexchar s i
# c=((toInt s.[i>>1]) >> ((1-(i bitand 1))<<2)) bitand 15;
| c<10
......@@ -463,11 +463,11 @@ derive gMap Tree_
// interfaces added for testing:
initTestFormStates :: *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
initTestFormStates :: !*NWorld -> (!*FormStates,!*NWorld) // retrieves all form states hidden in the html page
initTestFormStates world
= ({ fstates = Leaf_, triplets = [], updateid = "", focusid = ""},world)
setTestFormStates :: [(Triplet,String)] String String *FormStates *NWorld -> (*FormStates,*NWorld) // retrieves all form states hidden in the html page
setTestFormStates :: ![(!Triplet,!String)] !String !String !*FormStates !*NWorld -> (!*FormStates,!*NWorld) // retrieves all form states hidden in the html page
setTestFormStates triplets updateid update states world
= ({ fstates = gMap{|*->*|} toOldState states.fstates, triplets = triplets, updateid = updateid, focusid = ""},world)
where
......
libraries/iTasks/InternaliTasksThreadHandling.dcl
View file @ 962d4b29
......@@ -32,7 +32,6 @@ instance == ThreadKind
// Setting of global information for a particular user
setPUser :: !Int !(GlobalInfo -> GlobalInfo) !*HSt -> (!GlobalInfo,!*HSt)
setPUserNr :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
clearIncPUser :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
......@@ -55,31 +54,16 @@ evalTaskThread :: !TaskThread -> Task a // execute the thr
// Thread table management
insertNewThread :: !TaskThread !*TSt -> *TSt // insert new thread in table
deleteThreads :: !TaskNr !*TSt -> *TSt
deleteSubTasksAndThreads :: !TaskNr !*TSt -> *TSt
deleteAllSubTasksAndThreads :: ![TaskNr] !*TSt -> *TSt
// Thread storages
ThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
ServerThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
ClientThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
ThreadTableStorageGen :: !String !Lifespan !(ThreadTable -> ThreadTable) -> (Task !ThreadTable) // used to store Tasknr of callbackfunctions / threads
// Copying thread tables from server to client and vica versa
copyThreadTableToClient :: !*TSt -> !*TSt // copies all threads for this user from server to client thread table
splitServerThreadsByUser :: !*TSt -> !(!(!ThreadTable,!ThreadTable),!*TSt)// get all threads from a given user from the server thread table
copyThreadTableFromClient :: !GlobalInfo !*TSt -> !*TSt // copies all threads for this user from client to server thread table
// Serialization an de-serialization of closures for Clean running on Server
serializeThread :: !.(Task .a) -> .String
deserializeThread :: !.String -> .(Task .a)
// Serialization an de-serialization of closures for Clean interpreted by Sapl on a Client
serializeThreadClient :: !(Task a) -> String
deserializeThreadClient :: !.String -> .(Task .a)
libraries/iTasks/iTasksHandler.icl
View file @ 962d4b29
......@@ -216,8 +216,10 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
# maintask = scheduleWorkflows maintask // schedule all active tasks, not only maintask
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated})
= ((IF_Ajax (startAjaxApplication thisUser pversion) startMainTask)
maintask) {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []}
= ((IF_Ajax
(startAjaxApplication thisUser pversion)
startMainTask
) maintask) {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []}
// epilogue
......
libraries/iTasks/iTasksProcessHandling.dcl
View file @ 962d4b29
......@@ -55,5 +55,5 @@ deleteMe :: (Task Void)
// internally used...
showWorkflows :: !Bool !*TSt -> (![BodyTag],*TSt)
showWorkflows :: !Bool !*TSt -> ([BodyTag],*TSt)
scheduleWorkflows :: !(Task a) -> (Task a) | iData a
libraries/iTasks/iTasksProcessHandling.icl
View file @ 962d4b29
......@@ -86,19 +86,35 @@ isDeletedWorkflow _ = False
workflowProcessStore :: !((!Int,![WorflowProcess]) -> (!Int,![WorflowProcess])) !*TSt -> (!(!Int,![WorflowProcess]),!*TSt)
workflowProcessStore wfs tst
= IF_ClientTasks
(abort "Cannot access workflow process table on cleint\n") // workflow table only on server site
= IF_Ajax
(IF_ClientServer // we running both client and server
(IF_ClientTasks
(abort "Cannot access workflow process table on client\n") // workflow table only on server site
(workflowProcessStore` wfs tst) // access workflow store
)
(workflowProcessStore` wfs tst)
)
(workflowProcessStore` wfs tst)
where
workflowProcessStore` wfs tst=:{hst}
# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName (0,[]) <@ NoForm) wfs hst
= (form.value,{tst & hst = hst})
scheduleWorkflows :: !(Task a) -> (Task a) | iData a
scheduleWorkflows maintask = scheduleWorkflows`
scheduleWorkflows maintask
# nmaintask = newTask defaultWorkflowName (assignTaskTo False 0 ("main",maintask))
= IF_Ajax
(IF_ClientServer // we running both client and server
(IF_ClientTasks
nmaintask // workflow table only on server site, do only maintask
(scheduleWorkflows` nmaintask) // access workflow store
)
(scheduleWorkflows` nmaintask)
)
(scheduleWorkflows` nmaintask)
where
scheduleWorkflows` tst
# (a,tst=:{activated}) = newTask defaultWorkflowName (assignTaskTo False 0 ("main",maintask)) tst // start maintask
scheduleWorkflows` nmaintask tst
# (a,tst=:{activated}) = nmaintask tst // start maintask
# ((_,wfls),tst) = workflowProcessStore id tst // read workflow process administration
# (done,tst) = scheduleWorkflowTable True wfls 0 {tst & activated = True} // all added workflows processes are inspected (THIS NEEDS TO BE OPTIMIZED AT SOME STAGE)
= (a,{tst & activated = activated && done}) // whole application ends when all processes have ended
......@@ -272,7 +288,7 @@ where
(DeletedWorkflow _) -> WflDeleted
= (status,tst) // if everything is fine it should always succeed
showWorkflows :: !Bool !*TSt -> (![BodyTag],*TSt)
showWorkflows :: !Bool !*TSt -> ([BodyTag],*TSt)
showWorkflows alldone tst
= IF_ClientTasks
(\tst -> ([],tst)) // workflow table not available on clients
......
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