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

import StdEnv, iTasks, iDataTrivial

import iTaskUtil

derive gForm Mark, []

derive gUpd Mark, Maybe, [], Account, Login

derive gParse Mark

derive gPrint Mark, Maybe

derive gerda Mark

:: Mark = {userName :: String, loginId :: Int, mark :: Int, comment :: String}

Start world = doHtmlServer (singleUserTask -1 True (assignWork False welcome admin marking)) world

welcome

= [ Txt "This is an application where all users can give a marking or comment to some event they watch together.",Br,Br

, Txt "If you are administrated, simply login.",Br

, Txt "If not, you can create a login.",Br,Br,Br]

?>> OK

admin v = return_V Void

marking all=:(name,uniqueId,state)

| uniqueId == 0 = [Txt "Welcome Root",Br,Br] !>> foreverTask show

| otherwise = [Txt ("Welcome user " <+++ name <+++ ", you have id " <+++ uniqueId),Br,Br] !>> foreverTask (respond all)

show

= readMarksDB

=>> \marks -> [ Txt "Here are the scores given by the users:", Br, Br

, STable [Tbl_Border 1] [[Txt (toString (number i marks)) \\ i <- [0..10]]

,[B [] (toString i) \\ i <- [0..10]]

]

, Br, Br

, Hr []

, Marquee [] (foldl (+++) "" [m.userName +++ " : " +++ m.comment +++ " +++ " \\ m <- marks ])

, Hr []

] ?>> Confirm "Refresh"

where number i marks = length [n\\n <- marks | n.mark == i]

respond acc=:(name,uniqueId,state)

= readMarksDB

=>> \marks -> return_V (case [m \\ m <- marks | m.loginId == uniqueId] of

[] -> (-1,"")

[{mark,comment}:_] -> (mark, comment)

)

=>> \mc-> orTasks [ ("Show Opinions",show)

, ("Give a Mark",giveMark mc)

, ("Give Comment",giveComment mc)

]

where

giveMark (mark,comment)

= [ Txt ("Previous mark given:" <+++ if (mark == -1) "No mark given" (toString mark)), Br, Br

, Txt "Give your new mark (0 = lowest, 10 = highest)", Br, Br

]

?>> 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 -> writeMarksDB {userName = name, loginId = uniqueId, mark = mark, comment = comment}

#>> [Txt ("Your mark " <+++ mark <+++ " has been stored!"),Br,Br]

?>> OK

giveComment (mark,comment)

= [ Txt "Previous comment given:", Br, Br

, Txt (if (comment == "" ) "None" comment), Br, Br

, Txt "Submit a new comment:", Br, Br]

?>> editTask "OK" textBox <<@ Submit

=>> \(TextArea _ _ comment) -> writeMarksDB {userName = name, loginId = uniqueId, mark = mark, comment = comment}

#>> [ Txt "Your comment:", Br, Br

, Txt comment, Br, Br

, Txt "has been stored!",Br,Br

]

?>> OK

textBox :: TextArea

textBox = createDefault

Confirm name = chooseTask [(name,return_V Void)]

OK = chooseTask [("OK",return_V Void)]

// database specialized

marksId :: DBid [Mark]

marksId = mkDBid "marks"

readMarksDB :: (Task [Mark])

readMarksDB = readDB marksId

readMarksDB2 :: (Task [Mark])

readMarksDB2 = readDB2 marksId

writeMarksDB :: Mark -> (Task [Mark])

writeMarksDB acc

= readMarksDB

=>> \accs -> writeDB marksId [acc:[oacc \\ oacc <- accs | oacc.loginId <> acc.loginId]]