Commit 32cfb4f9 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent d7d20b7b
......@@ -17,7 +17,7 @@ CoffeeMachine
?>> getCoins (toPay,0)
=>> \(cancel,returnMoney)-> let nproduct = if cancel "Cancelled" product
in
[Txt ("product = " <+++ nproduct <+++ ", returned money = " <+++ returnMoney),Br,Br]
[Txt ("product = " <+++ nproduct <+++ ", returned money = " <+++ returnMoney),Br,Br]
?>> STask_button "Thanks" (returnV Void)
#>> returnV (nproduct,returnMoney)
where
......
......@@ -7,19 +7,23 @@ derive gUpd []
npersons = 5
Start world = doHtmlServer (multiUserTask npersons (deadline mytask)) world
Start world = doHtmlServer (multiUserTask npersons (deadline mytask <<@ Persistent)) world
mytask = STask "Press" 0
deadline :: (Task a) -> (Task a) | iData a
deadline task
= [Txt "Choose person you want to shift work to:",Br,Br]
= [Txt "Choose person you want to delegate work to:",Br,Br]
?>> STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
=>> \whomPD -> [Txt "Until what time do you want to wait today?",Br,Br]
?>> STask "SetTimer" (Time 0 0 0)
=>> \time -> []
?>> shifttask (toInt(toString whomPD)) time task
=>> \(ok,value) -> if ok [Txt ("Result of task: " +++ printToString value),Br,Br] [Txt "Task Expired, default value chosen !",Br,Br]
=>> \time -> [Txt "Cancel delegated work if you are getting impatient:",Br,Br]
?>> PCTasks
[ ("Waiting", shifttask (toInt(toString whomPD)) time task)
, ("Cancel", returnV (False,createDefault))
]
=>> \(ok,value) -> if ok [Txt ("Result of task: " +++ printToString value),Br,Br]
[Txt "Task expired or canceled, default value chosen !",Br,Br]
?>> STask "OK" value
where
shifttask who time task
......
Version: 1.4
Global
Built: True
Built: False
Target: Web Applications
Exec: {Project}\deadline.exe
CodeGen
......@@ -56,10 +56,10 @@ MainModule
DclOpen: False
Icl
WindowPosition
X: 10
Y: 10
SizeX: 1131
SizeY: 624
X: 145
Y: 6
SizeX: 1023
SizeY: 481
IclOpen: True
LastModified: No 0 0 0 0 0 0
OtherModules
......@@ -77,7 +77,13 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
DclOpen: False
Dcl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 510
DclOpen: True
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
......
......@@ -8,8 +8,6 @@ derive gParse QForm, ReviewState
derive gPrint QForm, ReviewState
derive gerda QForm, ReviewState
derive gEq ReviewState
Start world = doHtmlServer (multiUserTask 2 Quotation) world
//Start world = doHtmlServer (multiUserTask 2 (Quotation <<@ Persistent)) world
......@@ -19,9 +17,9 @@ Start world = doHtmlServer (multiUserTask 2 Quotation) world
, endDate :: HtmlDate
, estimatedHours :: Int
, description :: TextArea
, price :: Int
, price :: Real
}
:: ReviewState = Approved | Cancelled | NeedsRework | Draft
:: ReviewState = Approved | Cancelled | NeedsRework TextArea | Draft
Quotation :: Task (QForm,ReviewState)
Quotation = reviewedTask 1 createDefault
......@@ -31,16 +29,16 @@ reviewedTask reviewer (form,state)
= [Txt "Fill in Form:",Br,Br]
?>> STask "TaskDone" form <<@ Submit
=>> \form -> reviewer @:: review (form,state)
=>> \state -> [Txt ("Reviewer " <+++ reviewer <+++ " says " <+++ printToString state),Br,Br] ?>> STask "OK" Void
=>> \state -> [Txt ("Reviewer " <+++ reviewer <+++ " says "),toHtml state,Br] ?>> STask "OK" Void
#>> case state of
NeedsRework -> mkTask (reviewedTask reviewer (form,state))
(NeedsRework _) -> mkTask (reviewedTask reviewer (form,state))
else -> returnV (form,state)
where
review :: (a,ReviewState) -> Task ReviewState | iData a
review (form,state)
= [toHtml form,Br,Br]?>>
CTask_button
[ ("Rework", returnV NeedsRework)
[ ("Rework", STask "Done" (NeedsRework createDefault) <<@ Submit)
, ("Approved", returnV Approved)
, ("Cancel", returnV Cancelled)
]
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