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

iTasks Examples/AllExamples.icl

@@ -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

iTasks Examples/Business tasks/Vote.dcl

+definition module Vote
+
+import iTasks
+
+voteExample :: [Workflow]
\ No newline at end of file

iTasks Examples/Business tasks/Vote.icl

+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]] 
+

iTasks Examples/test examples/marking/marking.icl

-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]] 
-

iTasks/Framework/Data/UserDB.icl

@@ -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"]}