GuessNumberCookie.hs

-- © 2001, 2002 Peter Thiemann
module Main where

import System.Random
import Prelude hiding (head, span, map, div)
import Data.List hiding (head, span, map)

import WASH.CGI.CGI
import qualified WASH.CGI.Persistent2 as P
import qualified WASH.CGI.Cookie as C

type Score = (Int, String)

highScoreStore :: CGI (P.T [Score])
highScoreStore = P.init "GuessNumber" []

setNumber :: Int -> CGI (C.T (Int, Int))
setNumber aNumber = C.create "theNumber" (0, aNumber)

main :: IO ()
main =
  run mainCGI

mainCGI = (once $
  do aNumber <- io (randomRIO (1,100))
     numHandle <- setNumber aNumber
     standardQuery "Guess a number" $
       do submit0 (play numHandle "I've thought of a number between 1 and 100.")
                      (fieldVALUE "Play the game")
	  submit0 admin (fieldVALUE "Check scores"))
  >> mainCGI

play aHandle aMessage =
  standardQuery "Guess a number" $
    do text aMessage
       text " Make a guess "
       activeInputField (processGuess aHandle) empty

processGuess aHandle aGuess =
  do mValue <- C.get aHandle
     case mValue of
       Just (nGuesses, aNumber) ->
         let nGuesses' = nGuesses + 1 in
	 if aNumber == aGuess 
         then C.delete aHandle >> youGotIt nGuesses' aNumber
	 else do Just aHandle' <- C.set aHandle (nGuesses', aNumber)
		 play aHandle' ("Your guess " ++
                                show aGuess ++ " was too " ++
				if aGuess < aNumber then "small."
		      		                    else "large.")
       Nothing ->
         standardQuery "Don't do that!" $ do
           text "You are trying to outwit me by playing with backbuttons and cloning windows!"
	   submit0 (return ()) (fieldVALUE "Restart")

youGotIt nGuesses aNumber =
  standardQuery "You got it!" $
  do text "CONGRATULATIONS!"
     br empty
     text "It took you "
     text $ show nGuesses
     text " tries to find out."
     br empty
     text "Enter your name for the hall of fame "
     activeInputField (addToHighScore nGuesses) empty

addToHighScore nGuesses nameF =
  let name = unText nameF in
  if name == "" then return () else
  do highScoreList <- highScoreStore
     P.add highScoreList (nGuesses, name)
     return ()

admin = 
  do highScoreList <- highScoreStore
     highScores <- P.get highScoreList
     standardQuery "GuessNumber - High Scores" $ do
       table $ do
         attr "border" "border"
	 tr (th (text "Name") ## th (text "# Guesses"))
	 mapM_ g (sort highScores)
       submit0 (return ()) (fieldVALUE "Continue")
  where
    g (guesses, name) =
      tr (td (text name) ## td (text (show guesses)))