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

*** empty log message ***

parent 606cf9e2
......@@ -14,7 +14,7 @@ derive gUpd []
// Start world = doHtmlServer (mkflow (RecordSongs ["song 1","song 2","song 3"])) world
//Start world = doHtmlServer (mkflow CreateMusic) world
//Start world = doHtmlServer (mkflow (Quotation myQuotation)) world
Start world = doHtmlServer (mkflow travel) world
Start world = doHtmlServer (mkflow test) world
//Start world = doHtmlServer (mkflow test) world
where
mkflow tasks hst
......@@ -22,35 +22,35 @@ where
= mkHtml "test" html hst
test tst
= doPorTask
(doMCcheckTask [(txt, doSTask "Done" 0) \\ txt <- ["aap","noot","mies"]]
,buttonTask "Cancel" (returnTask [])
) tst
= PCTasks
[ ("travel",travel)
, ("keuze2",STask "Gereed" "")
] tst
// travel request
travel tst
# (booked,tst)= doPorTask
( doSTasks
# (booked,tst)= PCTask2
( STasks
[ ( "Choose Booking options"
, doMCcheckTask [ ("Book_Flight",BookFlight)
, MCTask_ckbox [ ("Book_Flight",BookFlight)
, ("Book_Hotel", BookHotel)
, ("Book_Car", BookCar)
]
)
, ( "Booking confirmation"
, buttonTask "Confirm" (returnTask [])
, STask_button "Confirm" (returnV [])
)
]
, buttonTask "Cancel" (returnV [])
, STask_button "Cancel" (returnV [])
) tst
| isNil booked = returnTask "Cancelled" tst
# (_,tst) = doSTask "Pay" (Dsp (calcCosts booked)) tst
# (_,tst) = STask "Pay" (Dsp (calcCosts booked)) tst
= returnTask "Paid" tst
where
BookFlight tst = doSTask "BookFlight" (Dsp "Flight Number","",Dsp "Costs",0) tst
BookHotel tst = doSTask "BookHotel" (Dsp "Hotel Name","",Dsp "Costs",0) tst
BookCar tst = doSTask "BookCar" (Dsp "Car Brand","",Dsp "Costs",0) tst
BookFlight tst = STask "BookFlight" (Dsp "Flight Number","",Dsp "Costs",0) tst
BookHotel tst = STask "BookHotel" (Dsp "Hotel Name","",Dsp "Costs",0) tst
BookCar tst = STask "BookCar" (Dsp "Car Brand","",Dsp "Costs",0) tst
Pay booked bookings tst = returnTask "OK" tst
......@@ -75,9 +75,9 @@ myQuotation :: (QState,QForm)
myQuotation = createDefault
Quotation (state,form) tst
# ((_,form),tst) = doSTask "Submit" (Dsp state, form) tst
# ((_,form),tst) = doSTask "Review" (Dsp Submitted,form) tst
= doCbuttonTask
# ((_,form),tst) = STask "Submit" (Dsp state, form) tst
# ((_,form),tst) = STask "Review" (Dsp Submitted,form) tst
= CTask_button
[ ("Rework",Quotation (Rework,form))
, ("Approved",returnTask Approved)
, ("Cancel",returnTask Cancelled)
......@@ -87,7 +87,7 @@ Quotation (state,form) tst
Coffeemachine tst
# (_,tst) = returnTask "Choose Product" tst
# ((toPay,product),tst) = doCbuttonTask
# ((toPay,product),tst) = CTask_button
[ ("Coffee", returnTask (100,"Coffee"))
, ("Cappucino",returnTask (150,"Cappucino"))
, ("Thee",returnTask (50,"Thee"))
......@@ -97,7 +97,7 @@ Coffeemachine tst
= returnTask (product,returnMoney) tst
where
getCoins (toPay,paid) tst
# (coin,tst) = doCbuttonTask [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] tst
# (coin,tst) = CTask_button [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] tst
| toPay - coin > 0 = mkTask (getCoins (toPay - coin,paid + coin)) tst
= returnV (coin - toPay) tst
......@@ -105,7 +105,7 @@ where
Coffeemachine2
= returnTask "Choose Product" `bind`
\_ -> doCbuttonTask
\_ -> CTask_button
[ ("Coffee", returnTask (100,"Coffee"))
, ("Cappucino",returnTask (150,"Cappucino"))
, ("Thee",returnTask (50,"Thee"))
......@@ -115,7 +115,7 @@ Coffeemachine2
\returnMoney -> returnTask (product,returnMoney)
where
getCoins (toPay,paid)
= doCbuttonTask [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] `bind`
= CTask_button [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] `bind`
\coin -> if (toPay - coin > 0)
(mkTask (getCoins (toPay - coin,paid + coin)))
(returnV (coin - toPay))
......@@ -124,7 +124,7 @@ where
Coffeemachine3 tst
# tst = returnF [Txt "Choose Product:", Br] tst
# ((toPay,product),tst) = doCpdmenuTask [ ("Coffee", returnTask (100,"Coffee"))
# ((toPay,product),tst) = CTask_pdmenu [ ("Coffee", returnTask (100,"Coffee"))
, ("Cappucino",returnTask (150,"Cappucino"))
, ("Thee",returnTask (50,"Thee"))
, ("Chocolate",returnTask (100,"Chocolate"))
......@@ -133,7 +133,7 @@ Coffeemachine3 tst
= returnTask (product,returnMoney) tst
where
getCoins (toPay,paid) tst
# (coin,tst) = doCpdmenuTask [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] tst
# (coin,tst) = CTask_pdmenu [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] tst
| toPay - coin > 0 = mkTask (getCoins (toPay - coin,paid + coin)) tst
= returnTask (coin - toPay) tst
......@@ -145,20 +145,20 @@ requestTask budget tst
where
requestTask` budget tst
# ((_,_,budget),tst) = handleRequest budget tst
= doCpdmenuTask [ ("More Requests?", requestTask` budget)
= CTask_pdmenu [ ("More Requests?", requestTask` budget)
, ("Stop",returnTask "End Request")
] tst
handleRequest budget tst
# (n,tst) = doSTask "request" 0 tst
# (n,tst) = STask "request" 0 tst
| n > budget = return "Not Authorized" budget tst
= doCpdmenuTask
= CTask_pdmenu
[ ("Approved", placeOrder budget n)
, ("Not Approved",return "Not Approved" budget)
] tst
placeOrder budget n tst
# (_,tst) = doSTask "Submit" (Dsp ("Submit Order","price = ",n)) tst
# (_,tst) = STask "Submit" (Dsp ("Submit Order","price = ",n)) tst
= return "Order Placed" (budget - n) tst
return s b tst = returnTask (s,"budget = ",b)tst
......@@ -167,12 +167,12 @@ where
CreateMusic tst
# (_,tst) = returnTask "In Music" tst
# (_,tst) = doSTask "Decide" (Dsp "Make music") tst
# (_,tst) = doPandTask (audition,learn) tst
# (_,tst) = STask "Decide" (Dsp "Make music") tst
# (_,tst) = PTask2 (audition,learn) tst
= returnTask "Out Music" tst
where
audition tst = doCpdmenuTask [("Audition passed",returnTask True),("Audition failed",returnTask False)] tst
learn tst = doSTask "Skill" 0 tst
audition tst = CTask_pdmenu [("Audition passed",returnTask True),("Audition failed",returnTask False)] tst
learn tst = STask "Skill" 0 tst
// record songs example (vd aalst)
......@@ -182,17 +182,17 @@ RecordSongs songs tst
where
RecordSongs` songs rsongs tst
# (rsongs,tst) = ChooseSongs songs rsongs tst
# (_,tst) = doSTask "Done" (Dsp "Record Songs") tst
= doCpdmenuTask [ ("More recordings?", RecordSongs` songs rsongs)
# (_,tst) = STask "Done" (Dsp "Record Songs") tst
= CTask_pdmenu [ ("More recordings?", RecordSongs` songs rsongs)
, ("No More",Market rsongs)
] tst
ChooseSongs songs rsongs tst
= doCpdmenuTask
= CTask_pdmenu
([(s,ChooseSongs songs [s:rsongs]) \\ s <- songs] ++ [("Stop",returnTask rsongs)]) tst
Market rsongs tst
# (_,tst) = doSTask "Send" (Dsp "to Market Dept") tst
# (_,tst) = STask "Send" (Dsp "to Market Dept") tst
= returnTask ("Out Make Record",rsongs) tst
......
......@@ -10,16 +10,22 @@ import StdHtml
/*
startTask :: lift iData to iTask domain
mkTask :: promote TSt state function to an interactive Task, i.e. task will only be called when it is its turn
doSTask :: a sequential iTask
doSTasks :: a list of sequential iTask that will be performed one after another
doCbuttonTask :: choose one iTask depending on button pressed
buttonTask :: do task when button pressed
doCpdmenuTask :: choose one iTask from the (pulldown) list
doPandTask :: do both iTasks in any order, finished if both done
doPorTask :: do both iTasks in any order, finished if first one done
STask :: an Sequential iTask
STask_button :: do iTask when when button pressed
STasks :: do all iTasks one after another, finished when all done
CTask_button :: Choose one iTask from list, depending on button pressed
CTask_pdmenu :: Choose one iTask from list, depending on pulldownmenu item selected
MCTask_ckbox :: Multiple Choice of iTasks, depending on chosen checkboxes
PTask2 :: do both iTasks in any order (paralel), finished when both done
PCTask2 :: do both iTasks in any order, finished as soon as first one done
PCTasks :: do all iTasks in any order, finished as soon as first one done
mkTask :: promote TSt state function to an interactive Task, i.e. task will only be called when it is its turn
returnTask :: return the value and show it, no IO action from the user required
returnVF :: return the value and show the code, no IO action from the user required
......@@ -30,17 +36,21 @@ appIData :: lift iData editors to iTask domain
*/
startTask :: (Task a) *HSt -> ([BodyTag],HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkTask :: (*TSt -> *(a,*TSt)) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doSTask :: String a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doSTasks :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doCbuttonTask :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
buttonTask :: String (Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doCpdmenuTask :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doMCcheckTask :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doPandTask :: (Task a,Task b) -> (Task (a,b)) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a & gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC b
doPorTask :: (Task a,Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STask :: String a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STask_button :: String (Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STasks :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkTask :: (*TSt -> *(a,*TSt)) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
CTask_button :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
CTask_pdmenu :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
MCTask_ckbox :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
PTask2 :: (Task a,Task b) -> (Task (a,b)) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a & gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC b
PCTask2 :: (Task a,Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
PCTasks :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
returnTask :: a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
returnVF :: a [BodyTag] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
......
......@@ -52,10 +52,10 @@ returnF :: [BodyTag] -> TSt -> TSt
returnF bodytag =
\tst=:((i,myturn,html),hst) -> ((i,myturn,html <|.|> bodytag),hst) // return result task
doSTask :: String a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doSTask prompt a = \tst -> mkTask (doTask` a) tst
STask :: String a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STask prompt a = \tst -> mkTask (STask` a) tst
where
doTask` a ((i,myturn,html),hst)
STask` a ((i,myturn,html),hst)
# taskId = "Stask_" <+++ mkTaskNr i
# editId = "Sedit_" <+++ mkTaskNr i
# buttonId = mkTaskNr i
......@@ -66,24 +66,23 @@ where
# (editor,hst) = mkEditForm (Init,sFormId editId a) hst // no, read out current value from active editor
# (finbut,hst) = simpleButton buttonId prompt (\_ -> True) hst // add button for marking task as done
# (taskdone,hst) = mkStoreForm (Init,sFormId taskId False) finbut.value hst // remember task status for next time
| taskdone.value = doTask` a ((i,myturn,html),hst) // task is now completed, handle as previously
| taskdone.value = STask` a ((i,myturn,html),hst) // task is now completed, handle as previously
= (a,((i,taskdone.value,html <|.|> (editor.form ++ finbut.form)),hst))
doCpdmenuTask :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doCpdmenuTask options = \tst -> mkTask (doCTask` options) tst
CTask_pdmenu :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
CTask_pdmenu options = \tst -> mkTask (doCTask` options) tst
where
doCTask` options tst=:((i,myturn,html),hst) // choose one subtask out of the list
# (choice,hst) = FuncMenu (Init,sFormId ("Cpd_task_" <+++ mkTaskNr i) (0,[(txt,id) \\ txt <- map fst options])) hst
# (_,((i,adone,ahtml),hst)) = doSTask "Cpd_Done" Niks ((i ++ [0],True,[]),hst)
# (_,((i,adone,ahtml),hst)) = STask "Cpd_Done" Niks ((i ++ [0],True,[]),hst)
| not adone = (createDefault,((i,False,html <|.|> choice.form <|.|> ahtml),hst))
# chosenIdx = snd choice.value
# chosenTask = snd (options!!chosenIdx)
# (a,((i,bdone,bhtml),hst)) = chosenTask ((i ++ [1],True,[]),hst)
= (a,((i,adone&&bdone,html <|.|> bhtml),hst))
doCbuttonTask :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doCbuttonTask options = \tst -> mkTask (doCTask` options) tst
CTask_button :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
CTask_button options = \tst -> mkTask (doCTask` options) tst
where
doCTask` options tst=:((i,myturn,html),hst) // choose one subtask out of the list
# (choice,hst) = TableFuncBut (Init,sFormId ("Cbt_task_" <+++ mkTaskNr i) [[(but txt,\_ -> n) \\ txt <- map fst options & n <- [0..]]]) hst
......@@ -95,40 +94,40 @@ where
but i = LButton defpixel i
doMCcheckTask :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doMCcheckTask options = \tst -> mkTask (doMCcheckTask` options) tst
MCTask_ckbox :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
MCTask_ckbox options = \tst -> mkTask (MCTask_ckbox options) tst
where
doMCcheckTask` options tst=:((i,myturn,html),hst) // choose one subtask out of the list
MCTask_ckbox`` options tst=:((i,myturn,html),hst) // choose one subtask out of the list
# (cboxes,hst) = ListFuncCheckBox (Init,sFormId ("MC_check" <+++ mkTaskNr i) initCheckboxes) hst
# optionsform = cboxes.form <=|> [Txt text \\ (text,_) <- options]
# (_,((i,adone,ahtml),hst)) = doSTask "OK" Niks ((i,True,[]),hst)
# (_,((i,adone,ahtml),hst)) = STask "OK" Niks ((i,True,[]),hst)
| not adone = (createDefault,((i,False,html <|.|> [optionsform] <|.|> ahtml),hst))
# mytasks = [option \\ option <- options & True <- snd cboxes.value]
= doSTasks mytasks ((i,True,html),hst)
= STasks mytasks ((i,True,html),hst)
initCheckboxes =
[(CBNotChecked text, \ b bs id -> id) \\ (text,_) <- options]
doSTasks :: [(String,Task a)] -> (Task [a])| gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doSTasks options = \tst -> mkTask (doSTasks` options []) tst
STasks :: [(String,Task a)] -> (Task [a])| gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STasks options = \tst -> mkTask (doSandTasks` options []) tst
where
doSTasks` [] accu tst = returnV (reverse accu) tst
doSTasks` [(txt,task):ts] accu tst=:((i,myturn,html),hst)
doSandTasks` [] accu tst = returnV (reverse accu) tst
doSandTasks` [(txt,task):ts] accu tst=:((i,myturn,html),hst)
# (a,((i,adone,ahtml),hst)) = task ((i,True,[]),hst)
| not adone = (reverse accu,((i,adone,html <|.|> [Txt ("Task: " +++ txt),Br] <|.|> ahtml),hst))
= mkTask (doSTasks` ts [a:accu]) ((i,adone,html <|.|> ahtml),hst)
= mkTask (doSandTasks` ts [a:accu]) ((i,adone,html <|.|> ahtml),hst)
doPandTask :: (Task a,Task b) -> (Task (a,b)) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a & gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC b
doPandTask (taska,taskb) = \tst -> mkTask (doPTask` (taska,taskb)) tst
PTask2 :: (Task a,Task b) -> (Task (a,b)) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a & gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC b
PTask2 (taska,taskb) = \tst -> mkTask (PTask2` (taska,taskb)) tst
where
doPTask` (taska,taskb) tst=:((i,myturn,html),hst)
PTask2` (taska,taskb) tst=:((i,myturn,html),hst)
# (a,((_,adone,ahtml),hst)) = taska ((i ++ [0],True,[]),hst)
# (b,((_,bdone,bhtml),hst)) = taskb ((i ++ [1],True,[]),hst)
= ((a,b),((i,adone&&bdone,html <|.|> ahtml <|.|> bhtml),hst))
doPorTask :: (Task a,Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
doPorTask (taska,taskb) = \tst -> mkTask (doPorTask` (taska,taskb)) tst
PCTask2 :: (Task a,Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
PCTask2 (taska,taskb) = \tst -> mkTask (doPorTask` (taska,taskb)) tst
where
doPorTask` (taska,taskb) tst=:((i,myturn,html),hst)
# (a,((_,adone,ahtml),hst)) = taska ((i ++ [0],True,[]),hst)
......@@ -136,8 +135,22 @@ where
# (aorb,aorbdone,myhtml) = if adone (a,adone,ahtml) (if bdone (b,bdone,bhtml) (a,False,ahtml <|.|> bhtml))
= (aorb,((i,aorbdone,html <|.|> myhtml),hst))
buttonTask :: String (Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
buttonTask s task = doCbuttonTask [(s,task)]
PCTasks :: [(String,Task a)] -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
PCTasks options = \tst -> mkTask (doPorTasks` options) tst
where
doPorTasks` tasks tst=:((i,myturn,html),hst)
# (choice,hst) = TableFuncBut (Init,sFormId ("Cbt_task_" <+++ mkTaskNr i) [[(but txt,\_ -> n)] \\ txt <- map fst options & n <- [0..]]) hst
# (chosen,hst) = mkStoreForm (Init,sFormId ("Cbt_chosen_" <+++ mkTaskNr i) 0) choice.value hst
# chosenTask = snd (options!!chosen.value)
# (a,((i,adone,ahtml),hst)) = chosenTask ((i ++ [chosen.value + 1],True,[]),hst)
| not adone = (a,((i,adone,html <|.|> [choice.form <=> ahtml]),hst))
= (a,((i,adone,html <|.|> ahtml),hst))
but i = LButton defpixel i
STask_button :: String (Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STask_button s task = CTask_button [(s,task)]
// utility section
mkTaskNr [] = ""
......@@ -149,7 +162,7 @@ appIData idatafun = \tst -> mkTask (appIData` idatafun) tst
where
appIData` idata tst=:((i,myturn,html),hst)
# (idata,hst) = idatafun hst
# (_,((i,adone,ahtml),hst)) = doSTask "Done" Niks ((i,True,[]),hst)
# (_,((i,adone,ahtml),hst)) = STask "Done" Niks ((i,True,[]),hst)
= (idata.value,((i,adone,html <|.|> if adone idata.form (idata.form <|.|> ahtml)),hst))
\ No newline at end of file
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