Commit c2fad3d3 authored by Bas Lijnse's avatar Bas Lijnse

Migrated the date/meeting example

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@507 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent c591bbea
......@@ -7,6 +7,7 @@ import Vote
import Purchase
import TravelBooking
import OrderProcessing
import ScheduleMeeting
//Higher order examples
import MovingTask
......@@ -26,6 +27,7 @@ where
, purchaseExample
, travelBookingExample
, orderProcessingExample
, scheduleMeetingExample
, movingTaskExample
, deadlineTaskExample
, delegateTaskExample
......
definition module ScheduleMeeting
import iTasks
scheduleMeetingExample :: [Workflow]
\ No newline at end of file
module date
implementation module ScheduleMeeting
import StdList, iTasks, iDataTrivial
import iTasks, iDataTrivial, iDataFormlib
import StdMisc
// (c) MJP 2007
......@@ -11,38 +12,37 @@ import StdList, iTasks, iDataTrivial
npersons = 5
Start world = startEngine [appointmentFlow] world
appointmentFlow :: Workflow
appointmentFlow
= { name = "make appointment"
, label = "make appointment"
, roles = []
, mainTask = findDate #>> return_V Void
}
scheduleMeetingExample :: [Workflow]
scheduleMeetingExample
= [ { name = "Examples/Business/Schedule meeting"
, label = "Schedule meeting"
, roles = []
, mainTask = findDate >>| return Void
}
]
findDate :: Task (HtmlDate,HtmlTime)
findDate
= [Text "Choose person you want to date:",BrTag []]
?>> editTask "Set" (HtmlSelect [(toString i,toString i) \\ i <- [1..npersons - 1]] (toString 1))
=>> \(HtmlSelect _ sel) -> let whom = toInt sel
= [Text "Choose person you want to schedule a meeting with:",BrTag []]
?>> editTask "Set" (HtmlSelect [(toString i,toString i) \\ i <- [1..npersons - 1]] (toString 1))
=>> \(HtmlSelect _ whomPD) ->
let whom = toInt whomPD
in
[Text "Determining date:",BrTag [],BrTag []]
?>> findDate` whom (HtmlDate 1 1 2007,HtmlTime 9 0 0)
=>> \datetime -> []
?>> confirm 0 whom datetime -&&- confirm whom 0 datetime
#>> return_V datetime
#>> return datetime
where
findDate` :: Int (HtmlDate,HtmlTime) -> Task (HtmlDate,HtmlTime)
findDate` whom daytime
= proposeDateTime daytime
=>> \daytime -> whom @: ("Meeting Request",determineDateTime daytime)
=>> \(ok,daytime) -> if ok
(return_V daytime)
(return daytime)
( isOkDateTime daytime
=>> \ok -> if ok
(return_V daytime)
(return daytime)
(newTask "findDate`" (findDate` whom daytime))
)
where
......@@ -50,28 +50,27 @@ where
proposeDateTime (date,time)
= [Text "Propose a new date and time for meeting:",BrTag [],BrTag []]
?>> editTask "Set" input
=>> \(_,date,_,time) -> return_V (date,time)
=>> \(_,date,_,time) -> return (date,time)
where
input = (HtmlLabel [Text "date: "], date, HtmlLabel [Text "time: "], time)
input = (toString (Text "date: "), date, toString (Text "time: "), time)
determineDateTime :: (HtmlDate,HtmlTime) -> Task (Bool,(HtmlDate,HtmlTime))
determineDateTime daytime
= isOkDateTime daytime
=>> \ok -> if ok
(return_V (ok,daytime))
(return (ok,daytime))
( proposeDateTime daytime
=>> \daytime -> return_V (ok,daytime)
=>> \daytime -> return (ok,daytime)
)
isOkDateTime :: (HtmlDate,HtmlTime) -> Task Bool
isOkDateTime (date,time)
= chooseTask [Text ("Can we meet on the " <+++ date <+++ " at " <+++ time <+++ "?"),BrTag []]
[ ("Accept",return_V True)
, ("Sorry", return_V False)
[ ("Accept",return True)
, ("Sorry", return False)
]
confirm :: Int Int (HtmlDate,HtmlTime) -> Task Void
confirm me you (date,time)
= me @:: [Text ("User " <+++ me <+++ " and " <+++ you <+++ " have a meeting on " <+++ date <+++ " at " <+++ time),BrTag [],BrTag []]
?>> editTask "OK" Void
This diff is collapsed.
module meeting
import StdEnv, iTasks, iDataTrivial, iDataFormlib
// (c) MJP 2007
// findDate will settle a date and time between two persons that want to meet
// first a person is chosen by the person taken the initiative, person 0
// then a date is settled by the two persons by repeatedly asking each other for a convenient date
// if such a date is found both have to confirm the date and the task is finished
npersons = 5
Start world = startEngine [myWorkflow] world
myWorkflow
= { name = "orderPlacement"
, label = "orderPlacement"
, roles = []
, mainTask = findDate #>> return_V Void
}
//setupDates :: Task (FixedList [Int])
setupDates :: Task (FixedList (HtmlDate,HtmlTime))
setupDates
= [Text "Initialize dates:",BrTag []]
?>> editTask "Set" (VerList [(createDefault,createDefault) \\ i <- [1..2]])
taskClosure :: (Task a) -> Task (Task a) | iData a
taskClosure task
= return_V (Task task)
findDate :: Task (HtmlDate,HtmlTime)
findDate
= [Text "Choose person you want to date:",BrTag []]
?>> editTask "Set" (HtmlSelect [(toString i,toString i) \\ i <- [1..npersons - 1]] (toString 1))
=>> \(HtmlSelect _ whomPD) ->
let whom = toInt whomPD
in
[Text "Determining date:",BrTag [],BrTag []]
?>> findDate` whom (HtmlDate 1 1 2007,HtmlTime 9 0 0)
=>> \datetime -> []
?>> confirm 0 whom datetime -&&- confirm whom 0 datetime
#>> return_V datetime
where
findDate` :: Int (HtmlDate,HtmlTime) -> Task (HtmlDate,HtmlTime)
findDate` whom daytime
= proposeDateTime daytime
=>> \daytime -> whom @: ("Meeting Request",determineDateTime daytime)
=>> \(ok,daytime) -> if ok
(return_V daytime)
( isOkDateTime daytime
=>> \ok -> if ok
(return_V daytime)
(newTask "findDate`" (findDate` whom daytime))
)
where
proposeDateTime :: (HtmlDate,HtmlTime) -> Task (HtmlDate,HtmlTime)
proposeDateTime (date,time)
= [Text "Propose a new date and time for meeting:",BrTag [],BrTag []]
?>> editTask "Set" input
=>> \(_,date,_,time) -> return_V (date,time)
where
input = (toString (Text "date: "), date, toString (Text "time: "), time)
determineDateTime :: (HtmlDate,HtmlTime) -> Task (Bool,(HtmlDate,HtmlTime))
determineDateTime daytime
= isOkDateTime daytime
=>> \ok -> if ok
(return_V (ok,daytime))
( proposeDateTime daytime
=>> \daytime -> return_V (ok,daytime)
)
isOkDateTime :: (HtmlDate,HtmlTime) -> Task Bool
isOkDateTime (date,time)
= chooseTask [Text ("Can we meet on the " <+++ date <+++ " at " <+++ time <+++ "?"),BrTag []]
[ ("Accept",return_V True)
, ("Sorry", return_V False)
]
confirm :: Int Int (HtmlDate,HtmlTime) -> Task Void
confirm me you (date,time)
= me @:: [Text ("User " <+++ me <+++ " and " <+++ you <+++ " have a meeting on " <+++ date <+++ " at " <+++ time),BrTag [],BrTag []]
?>> editTask "OK" Void
:: FixedList a = HorList [a]
| VerList [a]
gForm{|FixedList|} gFormA (init, formId) hst # (form, hst) = gFormList xs hst
= ({Form | form & value = constr form.Form.value}, hst)
where (f, constr, xs) = case formId.ival of
HorList xs -> ((<=>) , HorList, xs)
VerList xs -> ((<||>), VerList, xs)
gFormList :: [] *HSt -> (Form [Int],*HSt)
gFormList [] hst = ( { changed = False
, value = []
, form = []
, inputs = [] }
, hst)
gFormList [x] hst # (formx, hst) = gFormA (init, reuseFormId formId x) hst
= ( { changed = formx.changed
, value = [formx.Form.value]
, inputs = []
, form = formx.form
}
, hst)
gFormList [x:xs] hst # (formx, hst) = gFormA (init, reuseFormId formId x) hst
# (formxs, hst) = gFormList xs hst
= ( { changed = formx.changed || formxs.changed
, value = [formx.Form.value : formxs.Form.value]
, form = [f [f formx.form [BrTag [], HrTag [], BrTag []]] formxs.form]
, inputs = []
}
, hst)
gUpd{|FixedList|} gUpdA (UpdCreate x) _
# (mode,nlist) = gUpd{|* -> *|} gUpdA (UpdCreate x) undef
= (mode, VerList nlist)
gUpd{|FixedList|} gUpdA mode val # (mode, xs) = gFormList mode xs
= (mode, constr xs)
where (constr, xs) = case val of
HorList xs -> (HorList, xs)
VerList xs -> (VerList, xs)
gFormList mode [] = (mode, [])
gFormList mode [x:xs] # (mode, x) = gUpdA mode x
# (mode, xs) = gFormList mode xs
= (mode, [x:xs])
derive gParse FixedList
derive gPrint FixedList
\ No newline at end of file
This diff is collapsed.
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