Commit 18dddf59 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 25809ea3
......@@ -7,8 +7,8 @@ import htmlTask
derive gForm []
derive gUpd []
Start world = doHtmlServer (multiUser list) world
//Start world = doHtmlServer (multiUser (Quotation myQuotation)) world
Start world = doHtmlServer (multiUser testTime) world
where
singleUser tasks hst
# (_,html,hst) = startTask 0 tasks hst
......@@ -16,7 +16,7 @@ where
multiUser tasks hst
# (idform,hst) = FuncMenu (Init,nFormId "pdm_chooseWorker"
(0,[("Worker " +++ toString i,\_ -> i) \\ i<-[0..5] ])) hst
(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..5] ])) hst
# currentWorker = snd idform.value
# (_,html,hst) = startTask currentWorker (persistent tasks) hst
= mkHtml "test" [idform.form <=> html] hst
......@@ -28,18 +28,16 @@ where
list tst
# (a,tst) = appIData (vertlistFormButs 1 True (Init,pFormId "list0" [0])) tst
# (a,tst) = (1 @: appIData (vertlistFormButs 1 True (Init,pFormId "list1" a))) tst
# (a,tst) = ((1,"Control List)") @: appIData (vertlistFormButs 1 True (Init,pFormId "list1" a))) tst
# (a,tst) = returnTask a tst
= (a,tst)
testMultiUser1 tst
# (v,tst) = STasks [("een",1 @: (simple 1)),("twee",2 @:(simple 2))] tst
//# (v,tst) = STasks [("een",(simple 1)),("twee",(simple 2))] tst
= STask "click" (sum v) tst
testEenTwee tst
# (v,tst) = STasks [ ("een", (1,"number1") @: simple 1 =>> \t -> returnTask t)
, ("twee",(2,"number2") @: simple 2 =>> \t -> returnTask t)
] tst
= STask "Klaar" (sum v) tst
testMultiUser tst
# (v,tst) = (1 @: (simple 0) =>> \t -> 2 @: (simple t)) tst
= STask "click" v tst
simple n = STask "OK" n
......@@ -49,19 +47,12 @@ infTask a tst
= mkTask (infTask a) tst
testTime tst
# (time,tst) = STask "SetTimer" (Date 0 0 0) tst
# (_,tst) = PTasks [ ("timer",waitForDateTask time)
, ("someone",STask "Done" 0 `bind` \_ -> returnV time)
] tst
= returnTask time tst
mytest tst = test (CBChecked "",CBChecked "") tst
where
test val tst
# (val,tst) = STask "Set" val tst
| False = returnTask val tst
= mkTask (test val) tst
# (time,tst) = STask "SetTimer" (Time 0 0 0) tst
# ((ok,estimation),tst) = PCTask2 ( waitForTimeTask time #>> returnV (False,0)
, (1,"Estimation") @: returnTask time #>> (STask "Confirm" 0 =>> \t -> returnV (True,t))
) tst
| ok = (estimation,returnF [Txt ("Received estimation is " <+++ estimation)] tst)
= mkTask testTime tst
:: Situation = Difficult Int | Easy
......@@ -132,8 +123,8 @@ derive gerda Situation
twotasks tst
# ((tbname,tname),tst) = mkRTask "name" (1 @: STask "name" "") tst // split name task
# ((tbnumber,tnumber),tst) = mkRTask "number" (2 @: STask "number" 0) tst // split number task
# ((tbname,tname),tst) = mkRTask "name" ((1,"give name") @: STask "name" "") tst // split name task
# ((tbnumber,tnumber),tst) = mkRTask "number" ((2,"geive number") @: STask "number" 0) tst // split number task
= PTasks
[( "employee1", tname `bind` void) // assign name task
,( "employee2", tnumber `bind` void) // assign number task
......@@ -169,7 +160,7 @@ where
agenda` date tst
# (date,tst) = STask "SetDate" date tst
# (who,tst) = STask "AskPerson" (PullDown (1,100) (0,[toString i \\ i <- [0..5]])) tst
# ((ok,date),tst) = (toInt (toString who) @: handle date) tst
# ((ok,date),tst) = ((toInt (toString who),"Meeting required") @: handle date) tst
| ok = returnTask date tst
# (ok,tst) = CTask_button [("Accept",returnV True),("Sorry",returnV False)] tst
| ok = returnV date tst
......@@ -190,7 +181,7 @@ where
# ((voorstel,acceptatie),tst) = mkRTaskCall "agenda" date datumbrief tst
# (afspraak,tst) = PTasks
[( "antwoorder"
, 1 @: acceptatie `bind`
, acceptatie `bind`
\t -> returnTask t
)
,( "vrager"
......@@ -217,25 +208,6 @@ where
= CTask_button [ ("geaccepteerd", returnTask (True,date))
, ("afgewezen", STask "kiesDatum" date `bind` \date -> returnTask (False,date))
] tst
test3 tst
# ((tboss,tsecr),tst) = mkRTaskCall "telop" 0 telop tst
# (result,tst) = PTasks
[( "secretary"
, tsecr
)
,( "boss"
, STask "waarde" 0 `bind` tboss
)
] tst
= returnTask result tst
where
telop b tst
# (_,tst) = returnTask b tst
# (a,tst) = STask "telop" 0 tst
= returnTask (a+b) tst
test2 tst
# ((tboss,tsecr),tst) = mkRTask "travel" travel tst
# (result,tst) = PTasks
......@@ -277,9 +249,9 @@ travel tst
# (booked,tst)= PCTask2
( STasks
[ ( "Choose Booking options"
, MCTask_ckbox [ ("Book_Flight",2 @: BookFlight)
, MCTask_ckbox [ ("Book_Flight",BookFlight)
, ("Book_Hotel", BookHotel)
, ("Book_Car", 1 @: BookCar)
, ("Book_Car", BookCar)
]
)
, ( "Booking confirmation"
......@@ -302,11 +274,11 @@ where
// quotation example
:: QForm = { fromComp :: String
, toComp :: String
:: QForm = { fromComp :: String
, toComp :: String
, startDate :: HtmlDate
, endDate :: HtmlDate
, estHours :: Int
, endDate :: HtmlDate
, estHours :: Int
}
:: QState = Submitted | Approved | Cancelled | Rework | Draft
......@@ -320,8 +292,9 @@ myQuotation :: (QState,QForm)
myQuotation = createDefault
Quotation (state,form) tst
# ((_,form),tst) = STask "Submit" (Dsp state, form) tst
# ((_,form),tst) = STask "Review" (Dsp Submitted,form) tst
# ((_,form),tst) = ((1,"Quotation") @: STask "Submit" (Dsp state, form)) tst
# ((_,form),tst) = ((2,"Review") @: STask "Review" (Dsp Submitted,form)) tst
# (_,tst) = returnTask form tst
= CTask_button
[ ("Rework",Quotation (Rework,form))
, ("Approved",returnTask Approved)
......
......@@ -27,9 +27,9 @@ class setTaskAttribute a :: !a *TSt -> *TSt
instance setTaskAttribute Lifespan, StorageFormat
/* Assign tasks to worker with indicated id
/* Assign tasks with informative name to user with indicated id
*/
(@:) infix 1 :: !Int (Task a) -> (Task a) | iData a
(@:) infix 0 :: !(!Int,!String) (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
......@@ -117,5 +117,5 @@ 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
(=>>) infix 2 :: w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w] // `bind`
(#>>) infix 1 :: w:(St .s .a) v:(St .s .b) -> u:(St .s .b), [u <= v, u <= w] // `bind` ignoring argument
......@@ -12,7 +12,7 @@ import dynamic_string, EncodeDecode
:: *TSt = { tasknr :: ![Int] // for generating unique form-id's
, activated :: !Bool // if true activate task, if set as result task completed
, myId :: !Int // id of worker to which task is assigned
, myId :: !Int // id of user to which task is assigned
, html :: !HtmlTree // accumulator for html code
, storageInfo :: !Storage // iData lifespan and storage format
, hst :: !HSt // iData state
......@@ -28,9 +28,11 @@ import dynamic_string, EncodeDecode
startTask :: !Int !(Task a) HSt -> (a,[BodyTag],HSt) | iData a
startTask thisUser taska hst
# (pversion,hst) = mkStoreForm (Init, pFormId ("Worker" <+++ thisUser <+++ "VrsNr") 0) id hst
# (refresh,hst) = simpleButton ("Task_" <+++ thisUser) "Refresh" id hst
# (sversion,hst) = mkStoreForm (Init, nFormId ("Session" <+++ thisUser <+++ "VrsNr") pversion.value) (if refresh.changed (\_ -> pversion.value) id) hst
# userVersionNr = "User" <+++ thisUser <+++ "VrsNr"
# sessionVersionNr = "Session" <+++ thisUser <+++ "VrsNr"
# (pversion,hst) = mkStoreForm (Init, pFormId userVersionNr 0) id hst
# (refresh,hst) = simpleButton ("Task_" <+++ userVersionNr) "Refresh" id hst
# (sversion,hst) = mkStoreForm (Init, nFormId sessionVersionNr pversion.value) (if refresh.changed (\_ -> pversion.value) id) hst
| sversion.value < pversion.value = (createDefault, refresh.form ++ [Br,Br, Hr [],Br] <|.|>
[Font [Fnt_Color (`Colorname Yellow)]
[B [] "Sorry, cannot apply command.",Br,
......@@ -41,8 +43,8 @@ startTask thisUser taska hst
, html = defaultUser @@: BT []
, hst = hst
, storageInfo = {tasklife = Session, taskstorage = PlainString }}
# (pversion,hst) = mkStoreForm (Init, pFormId ("Worker" <+++ thisUser <+++ "VrsNr") 0) inc hst
# (sversion,hst) = mkStoreForm (Init, nFormId ("Session" <+++ thisUser <+++ "VrsNr") pversion.value) inc hst
# (pversion,hst) = mkStoreForm (Init, pFormId userVersionNr 0) inc hst
# (sversion,hst) = mkStoreForm (Init, nFormId sessionVersionNr pversion.value) inc hst
= (a,refresh.form ++ [Br,Br, Hr [],Br] <|.|> Filter thisUser defaultUser html,hst)
where
Filter thisUser user (BT bdtg) = if (thisUser == user) bdtg []
......@@ -59,18 +61,18 @@ where setTaskAttribute lifespan tst = {tst & storageInfo.tasklife = lifespan}
instance setTaskAttribute StorageFormat
where setTaskAttribute storageformat tst = {tst & storageInfo.taskstorage = storageformat}
(@:) infix 1 :: !Int (Task a) -> (Task a) | iData a
(@:) userId taska = \tst -> mkTask assignTask` tst
(@:) infix 0 :: !(!Int,!String) (Task a) -> (Task a) | iData a
(@:) (userId,taskname) taska = \tst -> mkTask assignTask` tst
where
assignTask` tst=:{html,myId}
# (a,tst=:{html=nhtml,activated}) = taska {tst & html = BT [],myId = userId} // activate task of indicated worker
# (a,tst=:{html=nhtml,activated}) = taska {tst & html = BT [],myId = userId} // activate task of indicated user
| activated = (a,{tst & myId = myId // work is done
, html = html +|+ // clear screen
BT [Txt ("Worker " <+++ userId <+++ " finished task."),Br]})
BT [Txt ("User " <+++ userId <+++ " has finished task "),B [] taskname, Br]})
= (a,{tst & myId = myId // restore user Id
, html = html +|+
BT [Br, Txt ("Waiting for worker " <+++ userId <+++ "..."),Br] +|+
(userId @@: BT [Txt ("Worker " <+++ myId <+++ " has submitted the following task:"),Br] +|+ nhtml)}) // combine html code, filter later
BT [Br, Txt ("Waiting for task "), B [] taskname, Txt (" from User " <+++ userId <+++ "..."),Br] +|+
(userId @@: BT [Txt ("User " <+++ myId <+++ " waits for task "), B [] taskname,Br,Br] +|+ nhtml)}) // combine html code, filter later
mkTask :: (*TSt -> *(a,*TSt)) -> (Task a) | iData a
mkTask mytask = \tst -> mkTask` tst
......@@ -249,7 +251,9 @@ where
but i = LButton defpixel i
returnV :: a -> (Task a) | iData a
returnV a = \tst -> (a,tst) // return result task
returnV a = \tst -> mkTask returnV` tst
where
returnV` tst = (a,tst) // return result task
returnTask :: a -> (Task a) | iData a
returnTask a = \tst -> mkTask (returnTask` a) tst
......@@ -396,7 +400,7 @@ where
# taskId = "iTask_timer_" <+++ mkTaskNr tasknr
# (taskdone,hst) = mkStoreForm (Init,cFormId tst.storageInfo taskId (False,time)) id hst // remember time
# ((currtime,_),hst) = getTimeAndDate hst
| currtime < time = (time,{tst & activated = True, html = html +|+ BT [Txt ("Waiting for time " ):[toHtml time]], hst = hst})
| currtime < time = (time,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for time " ):[toHtml time]], hst = hst})
= (time,{tst & hst = hst})
waitForDateTask:: HtmlDate -> (Task HtmlDate)
......@@ -406,7 +410,7 @@ where
# taskId = "iTask_date_" <+++ mkTaskNr tasknr
# (taskdone,hst) = mkStoreForm (Init,cFormId tst.storageInfo taskId (False,date)) id hst // remember date
# ((_,currdate),hst) = getTimeAndDate hst
| currdate < date = (date,{tst & activated = True, html = html +|+ BT [Txt ("Waiting for date " ):[toHtml date]], hst = hst})
| currdate < date = (date,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for date " ):[toHtml date]], hst = hst})
= (date,{tst & hst = hst})
// lifting section
......@@ -443,10 +447,10 @@ showMine bool html more = if bool (html +|+ more) html
// monadic shorthands
(=>>) infix 0 :: w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w]
(=>>) infix 2 :: w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w]
(=>>) a b = a `bind` b
(#>>) infix 0 :: w:(St .s .a) v:(St .s .b) -> u:(St .s .b), [u <= v, u <= w]
(#>>) infix 1 :: w:(St .s .a) v:(St .s .b) -> u:(St .s .b), [u <= v, u <= w]
(#>>) a b = a `bind` (\_ -> b)
......
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