Commit c57e56e6 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@115 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 6d79f9ef
definition module StdiTasks
// Main iTask pass thru module exporting all End User iTask modules
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
import
// iTask End User modules:
iTasks // iTask main module and core engine
, iTasks2 // commonly used iTask combinators
, iTasksDB // iTask simple DB access
, iTasksSettings // font settings
implementation module StdiTasks
\ No newline at end of file
This diff is collapsed.
This diff is collapsed.
definition module iTasks2
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
// *********************************************************************************************************************************
// a collection of handy iTasks combinators defined in terms of primitive iTask combinators
// *********************************************************************************************************************************
import iTasks
/* standard monadic combinators on iTasks:
(#>>) :: for sequencing: bind, but no argument passed
*/
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
/* Assign tasks to user with indicated id:
(@:) :: will prompt who is waiting for task with give name
(@::) :: 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
/* Handling recursion and loops:
repeatTask :: repeat Task until predicate is valid
*/
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
/* Choose out the tasks you want to do one forehand, labels are used to make the choice:
buttonTask :: do the iTask when button pressed
chooseTask :: Choose ONE iTask from list, depending on button pressed, button horizontal displayed
chooseTaskV :: as chooseTask, buttons vertical displayed
mchoiceTask :: Checked tasks will be done SEQUENTIALLY
mchoiceTask2 :: as mchoiceTask, boolean used for initial setting of the checks
mchoiceTask3 :: as mchoiceTask2, function can be used to (re)set the checkboxes
mchoiceTask :: Checked tasks can be done in INTERLEAVED
mchoiceTask2 :: as mchoiceTask, boolean used for initial setting of the checks
mchoiceTask3 :: as mchoiceTask2, function can be used to (re)set the checkboxes
*/
buttonTask :: !String !(Task a) -> Task a | iCreateAndPrint a
chooseTask :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTaskV :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
mchoiceTasks :: !HtmlCode ![LabeledTask a] -> Task [a] | iData a
mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a
mchoiceAndTasks :: !HtmlCode ![LabeledTask a] -> Task [a] | iData a
mchoiceAndTasks2:: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a
/* Do m Tasks parallel / interleaved and FINISH as soon as SOME Task completes:
(-||-) :: do both iTasks in any order, combined task completed as soon as any subtask is done
(-&&-) :: do both iTasks in any order (interleaved), task completed when both done
orTasks :: do all iTasks in any order (interleaved), task completed as soon as any subtask is done
andTasks :: do all iTasks in any order (interleaved), task completed when all done
andTasks_mu :: assign task to indicated users, task completed when all done
*/
(-||-) infixr 3 :: !(Task a) !(Task a) -> Task a | iData a
(-&&-) infixr 4 :: !(Task a) !(Task b) -> Task (a,b) | iData a & iData b
orTasks :: ![LabeledTask a] -> (Task a) | iData a
andTasks :: ![LabeledTask a] -> Task [a] | iData a
andTasks_mu :: !String ![(Int,Task a)] -> Task [a] | iData a
/* Time and Date management:
waitForTimerTask:: Task is done when specified amount of time has passed
*/
waitForTimerTask:: !HtmlTime -> Task HtmlTime
implementation module iTasks2
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
// Definition of non-primitive iTask combinators defined in terms of primitive iTask combinators
import StdEnv
import iTasks
import iDataTrivial
derive gForm []
derive gUpd []
// ******************************************************************************************************
// monads for combining iTasks
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
(#>>) taska taskb
= taska
=>> \_ -> taskb
// ******************************************************************************************************
// repetition
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
repeatTask task pred a = dorepeatTask a
where
dorepeatTask a
= newTask "doReapeatTask" dorepeatTask`
where
dorepeatTask` tst
| pred a = (a,tst)
# (na,tst) = task a tst
= dorepeatTask na tst
// ******************************************************************************************************
// 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 ltask = assignTaskTo True nuserId ltask
(@::) infix 3 :: !Int !(Task a) -> (Task a) | iData a
(@::) nuserId taska = assignTaskTo True nuserId ("Task for " <+++ nuserId,taska)
(@:>) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:>) nuserId ltask = assignTaskTo False nuserId ltask
(@::>) infix 3 :: !Int !(Task a) -> (Task a) | iData a
(@::>) nuserId taska = assignTaskTo False nuserId ("Task for " <+++ nuserId,taska)
// ******************************************************************************************************
// choose one or more tasks on forehand out of a set
buttonTask :: !String !(Task a) -> (Task a) | iCreateAndPrint a
buttonTask s task = mkTask "buttonTask" (chooseTask_btn [] True [(s,task)])
chooseTask :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTask prompt options = mkTask "chooseTask" (chooseTask_btn prompt True options)
chooseTaskV :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTaskV prompt options = mkTask "chooseTask" (chooseTask_btn prompt False options)
mchoiceTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceTasks prompt taskOptions
= mpchoiceTasks seqTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceTasks2 prompt taskOptions
= mpchoiceTasks seqTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceTasks3 prompt taskOptions
= mpchoiceTasks seqTasks prompt taskOptions
mchoiceAndTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceAndTasks prompt taskOptions
= mpchoiceTasks andTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceAndTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks2 prompt taskOptions
= mpchoiceTasks andTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceAndTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks3 prompt taskOptions
= mpchoiceTasks andTasks prompt taskOptions
// ******************************************************************************************************
// Speculative OR-tasks: task ends as soon as one of its subtasks completes
(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iData a
(-||-) taska taskb = newTask "-||-" (doOrTask (taska,taskb))
where
doOrTask :: !(Task a,Task a) -> (Task a) | iCreateAndPrint a
doOrTask (taska,taskb)
= orTask2 (taska,taskb)
=>> \at -> case at of
(LEFT a) -> return_V a
(RIGHT b) -> return_V b
(-&&-) infixr 4 :: !(Task a) !(Task b) -> (Task (a,b)) | iData a & iData b
(-&&-) taska taskb = newTask "-&&-" (andTask2 (taska,taskb))
orTasks :: ![LabeledTask a] -> (Task a) | iData a
orTasks [] = return createDefault
orTasks taskCollection = newTask "orTasks" (andTasksCond "or Tasks" (\list -> length list >= 1) taskCollection)
=>> \list -> return (hd list)
andTasks :: ![LabeledTask a] -> (Task [a]) | iData a
andTasks taskCollection = newTask "andTasks" (andTasksCond "and Tasks" (\_ -> False) taskCollection)
andTasks_mu :: !String ![(Int,Task a)] -> (Task [a]) | iData a
andTasks_mu label tasks = newTask "andTasks_mu" (domu_andTasks tasks)
where
domu_andTasks list = andTasks [(label <+++ " " <+++ i, i @:: task) \\ (i,task) <- list]
// ******************************************************************************************************
// Timer Tasks ending when timed out
waitForTimerTask:: !HtmlTime -> (Task HtmlTime)
waitForTimerTask time = waitForTimerTask`
where
waitForTimerTask`
= appHSt2 "getTimeAndDate" getTimeAndDate
=>> \(ctime,_) -> waitForTimeTask (ctime + time)
definition module iTasksDB
// 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 iTasksDB
// 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)
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