Commit cc57c5aa authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

Fixed a bug in the calculation of the contents of a tasktab: forgot to prune...

Fixed a bug in the calculation of the contents of a tasktab: forgot to prune the subtrees not belonging to this specific task; added a first version of new "real world" example: a simple Internet shop; got the example from the net, but it is straightforward...

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@311 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 6cf49100
module internetShop
import StdEnv, StdiTasks, iDataTrivial
/*
The scenario contains a number of different events and activities:
The customer places an order and fills out her credit card number.
Your web system checks that the credit card is valid and sends a request to the bank for the money.
After a while a confirmation arrives from the bank telling the system that there are sufficient funds in the account.
The system sends a notification to storage with the customers address along with information on what the customer ordered.
The storage personnel package the order and send it off with the delivery service. They also log into the system and confirm that the order has been sent.
The system sends an email with the confirmation to the customer.
*/
// high level
Start :: *World -> *World
Start world = startTaskEngine (orderPlacement user) world
orderPlacement user
= (user @: ("Shopping", selectFromShop))
-&&-
(user @: ("Credit Card Information", fillInAndCheckCreditCard createDefault))
=>> \(basket,cardInfo) -> user @: ("Order Confirmation", confirmOrder basket cardInfo)
=>> \_ -> bank @: ("Cash Request", cashRequest bank cardInfo (amountFrom basket))
=>> \granted -> if granted
(storage @: ("Order Delivery Request", deliverOrder user basket (deliveryAddress cardInfo)) #>>
user @: ("Delivery Notice", deliverOKNotice user basket (deliveryAddress cardInfo)))
(user @: ("Delivery Failure", deliverFailureNotice user basket (amountFrom basket)))
fillInAndCheckCreditCard :: CardInfo -> Task CardInfo
fillInAndCheckCreditCard cardInfo
= fillInCreditCard cardInfo
=>> \cardInfo -> webSystem @: ("Validate CreditCard",validateCreditCard cardInfo)
=>> \valid -> if valid
(return_V cardInfo)
(invalidCreditcard cardInfo #>> fillInAndCheckCreditCard cardInfo)
// low level
:: CardInfo :== String
user :== 0
bank :== 0
storage :== 0
webSystem :== 0
items = [("Appels", 1.0,3.50),("Peren", 1.0,2.50)]
instance toString (a,b,c) | toString a & toString b & toString c
where
toString (a,b,c) = "(" <+++ a <+++ "," <+++ b <+++ "," <+++ c <+++ ")"
amountFrom (item,amount,price) = amount * price
deliveryAddress cardInfo = "delivery address " +++ cardInfo
selectFromShop
= [Text "Please select an item from our shop"]
?>> editTask "OK" ("Appels", 1.0,3.50)
fillInCreditCard cardInfo
= [Text "Please fill in your credit card number"]
?>> editTask "OK" cardInfo
validateCreditCard cardInfo
= [Text "Please validate credit card"]
?>> editTask "OK" True
invalidCreditcard cardInfo
= [Text "Your credit card was invalid!"]
?>> editTask "OK" Void
confirmOrder basket cardInfo
= [Text "Your order will be processed!"]
?>> editTask "OK" Void
cashRequest bank cardInfo amount
= [Text ("Can we get " <+++ amount <+++ " from " <+++ cardInfo)]
?>> editTask "OK" True
deliverOrder user basket address
= [Text ("Please deliver " <+++ basket <+++ " to " <+++ address)]
?>> editTask "OK" Void
deliverOKNotice user basket address
= [Text ("Your order " <+++ basket <+++ " will be delivered to " <+++ address)]
?>> editTask "OK" Void
deliverFailureNotice user basket address
= [Text ("Your order " <+++ basket <+++ " cannot be delivered to " <+++ address)]
?>> editTask "OK" Void
......@@ -113,7 +113,7 @@ where
| not activated = (createDefault,tst)
# (currtime,tst) = appTaskTSt (appWorldOnce ("Task: " +++ taskname +++ " For: " +++ toString nuserId) time) tst
# tst = IF_Ajax (administrateNewThread userId tst) tst
# (a,tst=:{html=nhtml,activated}) = appTaskTSt (IF_Ajax (UseAjax @>> taska) taska) {tst & /*html = BT [] [],*/userId = nuserId} // activate task of indicated user NEWTRACE
# (a,tst=:{html=nhtml,activated}) = appTaskTSt (IF_Ajax (UseAjax @>> taska) taska) {tst & html = BT [] [],userId = nuserId} // activate task of indicated user NEWTRACE
| activated = (a,{tst & activated = True // work is done
, userId = userId // restore previous user id
, html = ohtml +|+ ( { delegatorId = userId
......
......@@ -51,7 +51,7 @@ determineTaskForTab thisuser thistaskid tree
determineTaskTree :: !UserId !TaskNrId !HtmlTree -> Maybe HtmlTree
determineTaskTree thisuser thistaskid (taskdescr @@: tree)
| taskdescr.taskNrId == thistaskid = Just (taskdescr @@: tree)
| taskdescr.taskNrId == thistaskid = Just (taskdescr @@: (pruneTree tree))
= determineTaskTree thisuser thistaskid tree
determineTaskTree thisuser thistaskid (ntaskuser -@: tree)
| thisuser == ntaskuser = Nothing
......@@ -71,6 +71,16 @@ determineTaskTree thisuser thistaskid (DivCode id tree)
determineTaskTree thisuser thistaskid (TaskTrace traceinfo tree)
= determineTaskTree thisuser thistaskid tree
pruneTree :: !HtmlTree -> HtmlTree // delete all sub trees not belonging to this task
pruneTree (taskdescr @@: tree) = BT [] []
pruneTree (ntaskuser -@: tree) = ntaskuser -@: pruneTree tree
pruneTree (tree1 +|+ tree2) = pruneTree tree1 +|+ pruneTree tree2
pruneTree (tree1 +-+ tree2) = pruneTree tree1 +-+ pruneTree tree2
pruneTree (BT bdtg inputs) = (BT bdtg inputs)
pruneTree (DivCode id tree) = (DivCode id (pruneTree tree))
pruneTree (TaskTrace traceinfo tree) = (TaskTrace traceinfo (pruneTree tree))
mkFilteredTaskTree :: !UserId !UserId !HtmlTree -> (![HtmlTag],![InputId])
mkFilteredTaskTree thisuser taskuser (description @@: tree)
# (html,inputs) = mkFilteredTaskTree thisuser description.taskWorkerId tree
......
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