Commit dbdfee4d authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 8770f61c
......@@ -70,7 +70,7 @@ getAllMyReports :: !ConfAccount !ConfAccounts !*HSt -> ([(Int,[(Person, Maybe Re
// global setting to store either in files or in a database
//storageOption :== Persistent // Choose this one to store in files
storageOption :== Database // Choose this one to store in a database
storageOption :== Persistent // Choose this one to store in files
//storageOption :== Database // Choose this one to store in a database
storeFormId :== if (storageOption == Persistent) pFormId dbFormId
......@@ -8,24 +8,49 @@ derive gForm []
import tree
//Start world = doHtml MyPage world
Start world = doHtmlServer MyPageArr world
//Start world = doHtml MyPage world
//Start world = doHtmlServer MyPage world
Start world = Start3 world
myListId = nFormId "list" []
myTreeId = nFormId "tree" Leaf
import dynamic_string
//Start3 :: *World -> Dynamic
Start3 world
# inout = [|]
# (gerda,world) = openGerda "bla" world
# nworld = { worldC = world, inout = inout, gerda = gerda}
# nworld = writeState (MyDir Internal) "mylist" mydynamic nworld
# (string,nworld) = readDynamicState (MyDir Internal) "mylist" nworld
= string_to_dynamic` string
where
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}
mydynamic = dynamic_to_string (dynamic [1..10])
Start2 :: *World -> Dynamic
Start2 world
# (ok,file,world) = fopen "bla.txt" FWriteData world
| not ok = dynamic 0
# file = fwrites (dynamic_to_string (dynamic [1..10])) file
# (ok,world) = fclose file world
# (ok,file,world) = fopen "bla.txt" FReadData world
# (string,file) = freads file 10000
= string_to_dynamic string
MyPage hst
# (iList,hst) = mkEditForm (Init, nFormId "mylist" initVal) hst
# (iTree,hst) = mkEditForm (Set, ndFormId "mytree" (fromListToBalTree iList.value)) hst
# (iList,hst) = mkEditForm (Init, pDFormId "mylist" initVal) hst
= mkHtml "Balancing Tree From List"
[ Txt "Converting a list:", Br, Br
, BodyTag iList.form
, Txt "to a balanced tree:", Br, Br
, BodyTag iTree.form
// , BodyTag iTree.form
] hst
initVal :: [Int]
initVal = createDefault
initVal = [1..10]
MyPageArr hst
# (mycircuitf,hst) = startCircuit mycircuit [1,5,2] hst
......
......@@ -8,12 +8,32 @@ derive gForm []
derive gUpd []
Start world = doHtmlServer (mkflow twotasks3) world
Start world = doHtmlServer (mkpflow testMultiUser) world
where
mkflow tasks hst
# (html,hst) = startTask tasks hst
# (_,html,hst) = startTask 0 tasks hst
= mkHtml "test" html hst
mkpflow tasks hst
# (idform,hst) = mkEditForm (Init,nFormId "intro" 0) hst
# (_,html,hst) = startTask idform.value (persistent tasks) hst
= mkHtml "test" (idform.form <|.|> html) hst
where
persistent tasks tst
# tst = setTaskAttribute Persistent tst
= tasks tst
testMultiUser tst
# (i1,tst) = STask "Set1" 0 tst
# (i2,tst) = assignTask 1 (STask "Set1" 0 o returnF [Txt ("werkgever 0 heeft bedrag " +++ (toString i1) +++ " opgegeven")] ) tst
# (i3,tst) = (STask "Set1" 0) tst
= returnTask (i1+i2+i3) tst
infTask a tst
# (_,tst) = STask "Update" Void tst
| False = returnV a tst
= mkTask (infTask a) tst
testTime tst
# (time,tst) = STask "SetTimer" (Date 0 0 0) tst
# (_,tst) = PTasks [ ("timer",waitForDateTask time)
......@@ -32,7 +52,6 @@ where
:: Situation = Difficult Int | Easy
twotasks3 tst
# tst = setTaskAttribute Persistent tst
# ((forSecr,fromBoss),tst) = mkRDynTaskCall "boss-secr" 0 tst // split name task
# ((forAssist,fromSecr),tst) = mkRDynTaskCall "secr-assist" 0 tst // split name task
= PTasks
......@@ -134,8 +153,16 @@ optelTaak tst
| c > 1000 = returnTask c tst
= mkTask optelTaak tst
:: Single a = Single a
derive gForm Single
derive gUpd Single
derive gParse Single
derive gPrint Single
derive gerda Single
//agenda :: (Task Bool)
agenda = \tst -> agenda` (22) tst
agenda = \tst -> agenda` (PullDown (1,30) (0,[toString i \\ i <- [0..10]]) ) tst
where
agenda` date tst
# ((voorstel,acceptatie),tst) = mkRTaskCall "agenda" date datumbrief tst
......
......@@ -16,9 +16,9 @@ derive gPrint Void
derive gerda Void
/* Initiating the iTask library:
startTask :: start function for iTasks
startTask :: start function for iTasks for user with indicated id
*/
startTask :: (Task a) *HSt -> ([BodyTag],HSt) | iData a
startTask :: !Int !(Task a) HSt -> (a,[BodyTag],HSt) | iData a
/* Global Attribute settings: iTask are by default Lifespan = Session, StorageFormt = PlainString
*/
......@@ -26,6 +26,10 @@ class setTaskAttribute a :: !a *TSt -> *TSt
instance setTaskAttribute Lifespan, StorageFormat
/* Assign tasks to worker with indicated id
*/
assignTask :: !Int (Task a) -> (Task a) | iData a
/* Promote any TSt state transition function to an iTask:
mkTask :: function will only be called when it is its turn to be activated
Also needed for defining recursive tasks
......@@ -109,3 +113,8 @@ appHSt :: lift HSt domain to TSt domain
appIData :: (IDataFun a) -> (Task a) | iData a
appHSt :: (HSt -> (a,HSt)) TSt -> (a,TSt)
/* monadic shorthands
*/
(=>>) infix 0 :: w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w] // `bind`
(#>>) infix 0 :: w:(St .s .a) v:(St .s .b) -> u:(St .s .b), [u <= v, u <= w] // `bind` ignoring argument
This diff is collapsed.
Supports Markdown
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