Commit 1e25e849 authored by Bas Lijnse's avatar Bas Lijnse

Further reorganization of the examples. Updated the broken marking example to a "Vote" example

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@499 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent b422279f
......@@ -2,6 +2,10 @@ module AllExamples
import iTasks
//Business examples
import Vote
//Miscellaneous examples
import Coffeemachine
import Newsgroups
......@@ -10,7 +14,8 @@ import ExceptionHandling
Start :: *World -> *World
Start world = startEngine workflows world
where
workflows = flatten [ coffeemachineExample
workflows = flatten [ voteExample
, coffeemachineExample
, newsgroupsExample
, exceptionHandlingExample
]
\ No newline at end of file
definition module Vote
import iTasks
voteExample :: [Workflow]
\ No newline at end of file
implementation module Vote
//This example lets users give a vote.
//Only the user with role "root" can view the votes
import iTasks, iDataTrivial
derive gForm Vote
derive gUpd Vote
derive gParse Vote
derive gPrint Vote
derive read Vote
derive write Vote
:: Vote = { userId :: Int
, vote :: Int
, comment :: String
}
voteExample :: [Workflow]
voteExample = [{ name = "Examples/Business/Vote/Show votes"
, label = "Show votes"
, roles = ["root"]
, mainTask = showVotes
}
,{ name = "Examples/Business/Vote/New vote"
, label = "Give vote"
, roles = []
, mainTask = giveVote
}
,{ name = "Examples/Business/Vote/New comment"
, label = "Give comment"
, roles = []
, mainTask = giveComment
}
]
showVotes :: Task Void
showVotes
= readVotesDB
>>= \votes -> getDisplayNamesTask [vote.Vote.userId \\ vote <- votes]
>>= \userNames -> [ Text "The following votes are given:", BrTag [], BrTag []
, formatVotes [(toString i) \\ i <- [0..10]]
[(toString (number i votes)) \\ i <- [0..10]]
, HrTag []
, formatComments [(u,v) \\ v <- votes & u <- userNames]
, HrTag []
] ?>> button "Ok" Void
where
number i votes = length [n \\ n <- votes | n.vote == i]
formatVotes header data = TableTag [StyleAttr "border: 1px solid #ccc"]
[TrTag [] [ThTag [] [BTag [] [Text th]] \\th <- header]
,TrTag [] [TdTag [] [Text td] \\ td <- data]
]
formatComments rows = TableTag []
[TrTag [] [TdTag [] [Text u,Text ":"],TdTag [] [Text v.comment]] \\ (u,v) <- rows]
giveVote :: Task Void
giveVote
= getCurrentUserId
>>= \currentUser -> readMyVoteDB currentUser
>>= \(vote,comment) -> chooseTask
[ Text ("Previous vote given:" <+++ if (vote == -1) "No vote given" (toString vote)), BrTag [], BrTag []
, Text "Give your new vote (0 = lowest, 10 = highest)", BrTag [], BrTag []]
[(toString i,return i) \\ i <- [0..10]]
>>= \vote -> readMyVoteDB currentUser
>>= \(_,comment) -> writeVotesDB {userId = currentUser, vote = vote, comment = comment}
>>| [Text ("Your vote " <+++ vote <+++ " has been stored!")]
?>> button "Ok" Void
giveComment :: Task Void
giveComment
= getCurrentUserId
>>= \currentUser -> readMyVoteDB currentUser
>>= \(vote,comment) -> [ Text "Previous comment given:", BrTag [], BrTag []
, Text (if (comment == "" ) "None" comment), BrTag [], BrTag []
, Text "Submit a new comment:", BrTag [], BrTag []]
?>> editTask "Ok" textBox <<@ Submit
>>= \(HtmlTextarea _ comment) -> readMyVoteDB currentUser
>>= \(vote,_) ->
writeVotesDB {userId = currentUser, vote = vote, comment = comment}
>>| [ Text "Your comment:", BrTag [], BrTag []
, Text comment, BrTag [], BrTag []
, Text "has been stored!"]
?>> button "Ok" Void
where
textBox :: HtmlTextarea
textBox = createDefault
//Simple votes database
votesId :: DBid [Vote]
votesId = mkDBid "votes" LSTxtFile
readVotesDB :: Task [Vote]
readVotesDB = readDB votesId
readMyVoteDB :: Int -> Task (Int,String)
readMyVoteDB id
= readVotesDB
>>= \votes -> return (case (filter (\vote -> vote.Vote.userId == id) votes) of
[] -> (-1,"")
[vote:_] -> (vote.vote, vote.comment)
)
writeVotesDB :: Vote -> Task [Vote]
writeVotesDB acc
= readVotesDB
>>= \accs -> writeDB votesId [acc:[oacc \\ oacc <- accs | oacc.Vote.userId <> acc.Vote.userId]]
This source diff could not be displayed because it is too large. You can view the blob instead.
module marking
// This example show how marks can be given by people logged in
// The marks are intended for user 0 who can show them
// (c) mjp 2007/2008
import iTasks, iDataTrivial
derive gForm Mark
derive gUpd Mark
derive gParse Mark
derive gPrint Mark
derive read Mark
derive write Mark
:: Mark = {userName :: String, loginId :: Int, mark :: Int, comment :: String}
Start world = startEngine (marking 0 "manager") world
marking i accountname = [Text ("Welcome user " <+++ accountname),BrTag [],BrTag []] !>> respond i accountname
where
respond uniqueId name
= spawnWorkflow uniqueId True ("Give Mark", foreverTask (giveMark uniqueId name))
#>> spawnWorkflow uniqueId True ("Give Comment", foreverTask (giveComment uniqueId name))
#>> foreverTask show
show
= readMarksDB
=>> \marks -> [ Text "Here are the scores given by the users:", BrTag [], BrTag []
, STable [BorderAttr (toString 1)] [[Text (toString (number i marks)) \\ i <- [0..10]]
,[BTag [] [Text (toString i)] \\ i <- [0..10]]
]
, BrTag [], BrTag []
, HrTag []
, Text (foldl (+++) "" [m.userName +++ " : " +++ m.comment +++ " +++ " \\ m <- marks ])
, HrTag []
] ?>> Confirm "Refresh"
where
number i marks = length [n\\n <- marks | n.mark == i]
giveMark uniqueId name
= readMyMarksDB uniqueId
=>> \(mark,comment) -> [ Text ("Previous mark given:" <+++ if (mark == -1) "No mark given" (toString mark)), BrTag [], BrTag []
, Text "Give your new mark (0 = lowest, 10 = highest)", BrTag [], BrTag []]
?>> chooseTask [] [(toString i,return_V i) \\ i <- [0..2]] -||-
chooseTask [] [(toString i,return_V i) \\ i <- [3..5]] -||-
chooseTask [] [(toString i,return_V i) \\ i <- [6..8]] -||-
chooseTask [] [(toString i,return_V i) \\ i <- [9..10]]
=>> \mark -> readMyMarksDB uniqueId
=>> \(_,comment) -> writeMarksDB {userName = name, loginId = uniqueId, mark = mark, comment = comment}
#>> [Text ("Your mark " <+++ mark <+++ " has been stored!"),BrTag [],BrTag []]
?>> OK
giveComment uniqueId name
= readMyMarksDB uniqueId
=>> \(mark,comment) -> [ Text "Previous comment given:", BrTag [], BrTag []
, Text (if (comment == "" ) "None" comment), BrTag [], BrTag []
, Text "Submit a new comment:", BrTag [], BrTag []]
?>> editTask "OK" textBox <<@ Submit
=>> \(HtmlTextarea _ comment) -> readMyMarksDB uniqueId
=>> \(mark,_) ->
writeMarksDB {userName = name, loginId = uniqueId, mark = mark, comment = comment}
#>> [ Text "Your comment:", BrTag [], BrTag []
, Text comment, BrTag [], BrTag []
, Text "has been stored!",BrTag [],BrTag []]
?>> OK
where
textBox :: HtmlTextarea
textBox = createDefault
Confirm name = buttonTask name (return_V Void)
OK = Confirm "OK"
STable atts table = TableTag atts (mktable table)
where
mktable table = [TrTag [] (mkrow rows) \\ rows <- table]
mkrow rows = [TdTag [ValignAttr "top"] [row] \\ row <- rows ]
// database specialized
marksId :: DBid [Mark]
marksId = mkDBid "marks" LSTxtFile
readMarksDB :: Task [Mark]
readMarksDB = readDB marksId
readMyMarksDB :: Int -> Task (Int,String)
readMyMarksDB id
= readMarksDB
=>> \marks -> return_V (case (filter (\mark -> mark.loginId == id) marks) of
[] -> (-1,"")
[mark:_] -> (mark.mark,mark.comment)
)
writeMarksDB :: Mark -> Task [Mark]
writeMarksDB acc
= readMarksDB
=>> \accs -> writeDB marksId [acc:[oacc \\ oacc <- accs | oacc.loginId <> acc.loginId]]
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -10,7 +10,7 @@ derive gPrint User
derive gParse User
initUsers :: [User]
initUsers = [ {User | userId = 0, username = "root", displayname = "Root", password = "", roles = ["president","manager","worker"]}
initUsers = [ {User | userId = 0, username = "root", displayname = "Root", password = "", roles = ["root", "president","manager","worker"]}
, {User | userId = 1, username = "president", displayname = "President", password = "", roles = ["president"]}
, {User | userId = 2, username = "manager", displayname = "Middle manager", password = "", roles = ["manager"]}
, {User | userId = 3, username = "worker1", displayname = "Office worker 1", password = "", roles = ["worker"]}
......
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