{-# LANGUAGE TupleSections #-}

import Control.Monad (liftM)
import Data.Char (toLower)
import Data.List (sort, foldl', find)
import Data.Tuple.HT (uncurry3)
import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
import System.Environment (getArgs)
import Text.HTML.TagSoup (Tag (TagClose, TagOpen, TagText), parseTags,
                          partitions, fromTagText)
import Text.Printf (printf)

main =
  getArgs >>= genStats . makeYears >>= uncurry3 (printf format)
  where
    format = "Percentage of seasons with controversies using\n" ++ 
             "Poll: %d%%, Game: %d%%, Plus 1: %d%%\n"

makeYears :: [String] -> [Int]
makeYears args =
  case length args of
    1 -> [read (head args)]
    2 -> (\l -> [head l .. head $ tail l]) $ map read args
    otherwise -> error "Arguments must be first and optional last year."

genStats :: [Int] -> IO (Int, Int, Int)
genStats years = do
  pages <- mapM loadYear years
  return $ percents (foldl' counts (0, 0, 0) pages)
                    (fromIntegral $ length pages)
  where
    percents (a, b, c) l = (a % l, b % l, c % l)
    (%) a b = round $ 100 * a / b
    counts (a, b, c) (ab, bb, cb) = (minc a ab, minc b bb, minc c cb)
    minc x xb = x + if xb then 1 else 0


loadYear :: Int -> IO (Bool, Bool, Bool)
loadYear =
  liftM getYear . (>>= getResponseBody) . simpleHTTP . getRequest . makeURL
          
makeURL :: Show a => a -> String
makeURL year = "http://www.jhowell.net/cf/cf" ++ show year ++ ".htm"

getYear :: String -> (Bool, Bool, Bool)
getYear = controversy . sort . (\ (t, r) -> map (getData t) r) . getRows . getTable . parseTags

controversy :: [(Int, Int)] -> (Bool, Bool, Bool)
controversy records = (records !! 0 == records !! 1,
                       records !! 1 == records !! 2,
                       records !! 3 == records !! 4)

getData :: Bool -> [Tag String] -> (Int, Int)
getData True = (\gs -> (head gs, head $ tail gs)) 
               . map getLosses . take 2 . dropToLosses
getData False = (,0) . getLosses . head . dropToLosses

dropToLosses :: [Tag String] -> [[Tag String]]
dropToLosses = drop 8 . partitions (isOpenTag "td")

getLosses :: [Tag String] -> Int
getLosses = read . fromTagText . head . tail

getRows :: [[Tag String]] -> (Bool, [[Tag String]])
getRows rs = (isTies (head rs), tail rs)
  where isTies r = maybe False (\_ -> True) (find (== TagText "Ties") r)

getTable :: [Tag String] -> [[Tag String]]
getTable = partitions (isOpenTag "tr") . drop 2 
           . takeWhile (not . isCloseTag "table")
           . dropWhile (not . isOpenTag "table")

isOpenTag :: String -> Tag String -> Bool
isOpenTag tag (TagOpen t _) = map toLower t == tag
isOpenTag _ _ = False

isCloseTag :: String -> Tag String -> Bool
isCloseTag tag (TagClose t) = map toLower t == tag
isCloseTag _ _ = False