module Main where

import Text.ParserCombinators.Parsec
import Text.Parsec.Char
import Data.Either
import Data.Maybe
import Control.Monad
import Data.List (sortOn)

right (Right a) = a
fields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ] 

block = cell `sepBy` oneOf " \n"
cell = do
    tag <- many lower
    char ':'
    rest <- many (alphaNum <|> char '#')
    return (tag, rest)

parseInput :: String -> Either ParseError [(String, String)]
parseInput = parse block "input"

assocGet s (l:ls) = if fst l == s
                       then snd l
                       else assocGet s ls

doCheck :: [(String, String)] -> Bool
doCheck ls = all (isJust . flip lookup ls) fields

checkNum lower up s = p >= lower && p <= up
    where p = read s :: Int
byr = checkNum 1920 2002
iyr = checkNum 2010 2020
eyr = checkNum 2020 2030

parseHeight :: Parser (Int, String)
parseHeight = do
    v <- many1 digit
    unit <- choice $ map string ["cm", "in"]
    return (read v, unit)
hgt s = case parse parseHeight "hgt" s of
          Right (v, "cm") -> v >= 150 && v <= 193
          Right (v, "in") -> v >= 59 && v <= 76
          _ -> False

parseColor = char '#' >> many hexDigit
hcl :: String -> Bool
hcl s = case parse parseColor "hcl" s of
          Right c -> length c == 6
          Left _ -> False


ecl :: String -> Bool
ecl = flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]

parsePid = replicateM 9 digit
pid :: String -> Bool
pid s = isRight $ parse parsePid "pid" s

doValidity :: [(String, String)] -> Bool
doValidity ls = all ((== True) . ($ ls)) [ byr . assocGet "byr"
                                         , iyr . assocGet "iyr"
                                         , eyr . assocGet "eyr"
                                         , hgt . assocGet "hgt"
                                         , hcl . assocGet "hcl"
                                         , ecl . assocGet "ecl"
                                         , pid . assocGet "pid"
                                         ]

parseLines :: [String] -> [String]
parseLines allLines = unwords first : next
  where (first, rest) = break null allLines
        next = if null rest then [] else parseLines (tail rest)

main :: IO ()
main = do
    n <- parseLines . lines <$> readFile "input/04"
    let blocks = map (right . parseInput) n
    print $ length $ filter (\p -> doCheck p && doValidity p) blocks
    -- mapM_ print $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks
    -- print $ length $ filter doCheck blocks
    -- print $ length $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks