Commit 2b78ef73 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@112 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 2938fad5
definition module iTaskDB
// super simple database creation and access based on iData
// (c) mjp 2007
// choose the kind of storage you want to use
db_prefix :== "iDBase-"
:: DBid a
import iTasks
/*
mkDBid :: create a typed database identificator
only Database and TxtFile are currently supported
readDB :: read the database
writeDB :: write the database
readDB2 :: read the database, each and everytime the application is evaluated
dangerous: not referential transparent, only use it if you know what you are doing !
*/
mkDBid :: String Lifespan -> (DBid a)
readDB :: (DBid a) -> Task a | iData a
writeDB :: (DBid a) a -> Task a | iData a
readDB2 :: (DBid a) -> Task a | iData a
implementation module iTaskDB
// super simple database creation and access based on iData
// (c) mjp 2007
import iTasks, iDataFormlib, StdEnv, iDataTrivial
::DBid a :== (String,Lifespan)
// Common db access
readDB :: (DBid a) -> Task a | iData a
readDB name=:(idn,_) = appHSt ("readDB " +++ idn) (DB name id)
writeDB :: (DBid a) a -> Task a | iData a
writeDB name=:(idn,_) value = appHSt ("writeDB " +++ idn) (DB name (const value))
readDB2 :: (DBid a) -> Task a | iData a
readDB2 name=:(idn,_) = appHSt2 ("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)
mkDBid :: String Lifespan -> (DBid a)
mkDBid s Database
| and (map isControl (mkList s)) = abort (s <+++ " contains control characters which is illegal!...\n\n")
mkDBid s attr = (s,attr)
......@@ -66,6 +66,14 @@ workFlowTask :: ![StartUpOptions] !(Task (Int,a))
| VersionCheck | NoVersionCheck // for single & multiUser: default = VersionNoCheck
| MyHeader HtmlCode // wil replace standard iTask information line
// *********************************************************************************************************************************
/* Important for optimizations
newTask :: promote a function to a task, final result will be remembered
Once :: task will be done only once, the value of the task will be remembered, maybe useful for some lifted iData
*/
newTask :: !String !(Task a) -> Task a | iData a
Once :: (Task a) -> Task a | iData a
// *********************************************************************************************************************************
// Here follow the iTasks combinators:
......@@ -92,10 +100,8 @@ return_V :: !a -> Task a | iCreateAndPrint a
(?>>) :: prompt as long as task is active but not finished
(!>>) :: prompt when task is activated
(<<?) :: same as ?>>, except that prompt is displayed *after* task
(<<!) :: same as !>>, except that prompt is displayed *after* task
(<|) :: repeat task (recursively) as long as predicate does not hold, and give error message otherwise
(<!) :: repeat task (as a loop) as long as predicate does not hold; also works for tasks that don't require any user interactions (e.g. database access)
(<<?) :: as ?>>, except that prompt is displayed *after* task
(<<!) :: as !>>, except that prompt is displayed *after* task
return_VF :: return the value and show the Html code specified
return_D :: return the value and show it in iData display format
*/
......@@ -104,28 +110,34 @@ return_D :: return the value and show it in iData display format
(!>>) infixr 5 :: !HtmlCode !(Task a) -> Task a | iCreate a
(<<?) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
(<<!) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
(<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iCreate a
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a
return_VF :: !HtmlCode !a -> Task a | iCreateAndPrint a
return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a
/* Assign tasks to user with indicated id:
(@:) :: will prompt who is waiting for task with give name
(@::) :: same, default task name given
(@::) :: as @:, a default task name is chosen as label
(@:>) :: as @:, no prompting
(@::>) :: as @::, no prompting
*/
(@:) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@::) infix 3 :: !Int !(Task a) -> Task a | iData a
(@:) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@::) infix 3 :: !Int !(Task a) -> Task a | iData a
(@:>) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@::>) infix 3 :: !Int !(Task a) -> Task a | iData a
/* Handling recursion and loops:
newTask :: use the to promote a (recursively) defined user function to as task
foreverTask :: infinitely repeating Task
repeatTask :: repeat Task until predicate is valid
(<|) :: repeat task (recursively) as long as predicate does not hold, and give error message otherwise
(<!) :: repeat task (as a loop) as long as predicate does not hold; also works for tasks that don't require any user interactions (e.g. database access)
*/
newTask :: !String !(Task a) -> Task a | iData a
foreverTask :: !(Task a) -> Task a | iData a
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
(<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iCreate a
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a
/* Sequencing Tasks:
......@@ -262,11 +274,6 @@ appIData2 :: (String *HSt -> *(Form a,*HSt)) -> Task a | iData a
appHSt :: !String (HSt -> (a,HSt)) -> Task a | iData a
appHSt2 :: !String (HSt -> (a,HSt)) -> Task a | iData a
/* Controlling side effects
Once :: task will be done only once, the value of the task will be remembered, maybe useful for some lifted iData
*/
Once :: (Task a) -> Task a | iData a
/* Operations on Task state
taskId :: give id of user assigned to task
......
......@@ -298,7 +298,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor
[showLowLight thrinfo, showText " - "] ++
if multiuser
[showText "#User Queries: " , showTrace sversion, showText " - "] [] ++
if versionsOn [showText "#Server Queries: ", showTrace appversion] [showText "#Server Queries: - "] ++
if versionsOn [showText "#Server Queries: ", showTrace appversion] [] ++
IF_Ajax
( [showText " - Task#: ", showTrace (showTaskNr event)] ++
if (isNil threads || showCompletePage) [] [showText " - Thread(s)#: ", showTrace threadsText]
......@@ -1182,10 +1182,16 @@ where
// Assigning tasks to users, each user has to be identified by an unique number >= 0
(@:) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:) nuserId (taskname,taska) = \tst=:{userId} -> assignTaskTo False taskname userId taska {tst & userId = nuserId}
(@:) nuserId (taskname,taska) = \tst=:{userId} -> assignTaskTo True taskname userId taska {tst & userId = nuserId}
(@::) infix 3 :: !Int !(Task a) -> (Task a) | iData a // force thread if Ajax is used
(@::) nuserId taska = \tst=:{userId} -> assignTaskTo False ("Task for " <+++ userId) userId taska {tst & userId = nuserId}
(@::) nuserId taska = \tst=:{userId} -> assignTaskTo True ("Task for " <+++ userId) userId taska {tst & userId = nuserId}
(@:>) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:>) nuserId (taskname,taska) = \tst=:{userId} -> assignTaskTo False taskname userId taska {tst & userId = nuserId}
(@::>) infix 3 :: !Int !(Task a) -> (Task a) | iData a // force thread if Ajax is used
(@::>) nuserId taska = \tst=:{userId} -> assignTaskTo False ("Task for " <+++ userId) userId taska {tst & userId = nuserId}
assignTaskTo :: !Bool !String !Int !(Task a) !*TSt -> (a,!*TSt) | iData a
assignTaskTo verbose taskname userId taska tst=:{html=ohtml,activated,userId = nuserId}
......@@ -1198,7 +1204,7 @@ assignTaskTo verbose taskname userId taska tst=:{html=ohtml,activated,userId = n
= (a,{tst & userId = userId // restore user Id
, html = ohtml +|+ // show old code
if verbose
( BT [Br, showText ("Waiting for Task "), showLabel taskname, showText " from ", showUser nuserId,Br] +|+ // show waiting for
( BT [showText ("Waiting for Task "), showLabel taskname, showText " from ", showUser nuserId,Br] +|+ // show waiting for
((nuserId,taskname) @@: BT [showText "Requested by ", showUser userId,Br,Br] +|+ nhtml))
((nuserId,taskname) @@: nhtml)
})
......
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