-- © 2001, 2002 Peter Thiemann
module Main where

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

import HTMLMonad
import CGI
import qualified Persistent2 as P

import Score

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

main :: IO ()
main =
  run mainCGI

mainCGI =
  io (randomRIO (1,100)) >>= \ aNumber ->
  standardQuery "Guess a number" $
    do submit F0 (play 0 (aNumber :: Int) "I've thought of a number between 1 and 100.")
                   (fieldVALUE "Play the game")
       submit F0 admin (fieldVALUE "Check scores")

play nGuesses aNumber aMessage F0 =
  standardQuery "Guess a number" $
    do text aMessage
       text_T " Make a guess "
       activeInputField (processGuess (nGuesses + 1) aNumber) empty

processGuess nGuesses aNumber aGuess =
  if aNumber == aGuess then
    youGotIt nGuesses aNumber
  else if aGuess < aNumber then
    play nGuesses aNumber ("Your guess " ++ show aGuess ++ " was too small.") F0
  else
    play nGuesses aNumber ("Your guess " ++ show aGuess ++ " was too large.") F0

youGotIt nGuesses aNumber =
  standardQuery "You got it!" $ 
  do text_S "CONGRATULATIONS!"
     br_S empty
     text_S "It took you "
     text (show nGuesses)
     text_S " tries to find out."
     br_S empty
     text_S "Enter your name for the hall of fame "
     nameF <- textInputField empty
     br_S empty
     defaultSubmit nameF (addToHighScore nGuesses) (fieldVALUE "ENTER")

addToHighScore nGuesses nameF =
  let name = value nameF in
  if name == "" then admin F0 else
  do highScoreList <- highScoreStore
     P.add highScoreList (Score name nGuesses)
     admin F0

admin F0 = 
  do highScoreList <- highScoreStore
     highScores <- P.get highScoreList
     standardQuery "GuessNumber - High Scores" $ table_T $
       (tr_S (th_S (text_S "Name") ## th_S (text_S "# Guesses")) ##
        foldr g empty (sort highScores) ##
	attr_SS "border" "border")
  where
    g (Score name guesses) elems =
      tr_T (td_S (text name) ## td_S (text (show guesses))) ## elems