-- © 2001, 2002 Peter Thiemann
module Main where

import Random
import Prelude hiding (head, span, map, div)
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 "GuessNumberNoCheating" []

main :: IO ()
main =
  run mainCGI

mainCGI =
  standardQuery "Guess a number" $
    do submit F0
	 (play 0 ((1,100) :: (Int,Int)) "I've thought of a number between 1 and 100.")
         (fieldVALUE "Play the game")
       submit F0 admin (fieldVALUE "Hall of Fame")

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

processGuess nGuesses ivl@(low,hi) aGuess =
  io (randomRIO ivl) >>= \ aNumber ->
  if aNumber == aGuess then
    youGotIt nGuesses
  else if aGuess < aNumber then
    play nGuesses (max low aGuess + 1, hi) ("Your guess " ++ show aGuess ++ " was too small.") F0
  else
    play nGuesses (low, min aGuess hi - 1) ("Your guess " ++ show aGuess ++ " was too large.") F0

youGotIt nGuesses =
  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) empty

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