import Control.Applicative
import Control.Monad
import Data.Char
import Data.Functor
import Data.List
import Data.List.Extra (stripSuffix)
import Data.List.Split
import Data.Maybe
import Debug.Trace
import Text.Read

data Attr
    = Byr
    | Iyr
    | Eyr
    | Hgt
    | Hcl
    | Ecl
    | Pid
    | Cid
    deriving (Show, Bounded, Enum, Eq, Ord)

type Passport = [Attr]

intval :: (Int, Int) -> Int -> Maybe Int
intval (lo, hi) = \n ->
    if n >= lo && n <= hi then Just n
    else Nothing

nDigits :: Int -> String -> Maybe String
nDigits n = \s ->
    if length s == n && all isDigit s then Just s
    else Nothing

hexColor :: String -> Maybe String
hexColor s =
    if length s == 7
        && s !! 0 == '#'
        && all (\c -> elem c "0123456789abcdef") (drop 1 s) then Just s
    else Nothing

validEcl :: String -> Bool
validEcl s = case s of
    "amb" -> True
    "blu" -> True
    "brn" -> True
    "gry" -> True
    "grn" -> True
    "hzl" -> True
    "oth" -> True
    _ -> False

parseAttr :: String -> Maybe Attr
parseAttr s =
    let parts = splitOn ":" s in
    let key = parts !! 0 in
    let value = parts !! 1 in
    case key of
        "byr" -> (readMaybe value >>= intval (1920, 2002)) $> Byr
        "iyr" -> (readMaybe value >>= intval (2010, 2020)) $> Iyr
        "eyr" -> (readMaybe value >>= intval (2020, 2030)) $> Eyr
        "hgt" ->
            ((stripSuffix "cm" value >>= readMaybe >>= intval (150, 193)) <|>
            (stripSuffix "in" value >>= readMaybe >>= intval(59, 76)))
            $> Hgt
        "hcl" -> hexColor value $> Hcl
        "ecl" -> if validEcl value then Just Ecl else Nothing
        "pid" -> nDigits 9 value $> Pid
        "cid" -> Just Cid
        _ -> Nothing

processLine :: String -> Maybe [Attr]
processLine line = sequence $ (map parseAttr $ splitOn " " line)

requiredAttrs :: [Attr]
requiredAttrs = enumFromTo Byr Pid

combineAttrs :: [Attr] -> Maybe Passport
combineAttrs attrs =
    let intersection = intersect attrs requiredAttrs in
    if sort intersection == sort requiredAttrs then Just attrs
    else Nothing

processPassport :: [String] -> Maybe Passport
processPassport lines = concat <$> (sequence $ map processLine lines) >>= combineAttrs

processLines :: [String] -> [Maybe Passport]
processLines lines = map processPassport $ splitWhen (== "") lines

countValid :: [Maybe Passport] -> Int
countValid = length . filter isJust

main :: IO ()
main = do
    content <- readFile "4.txt"
    let valid = countValid $ processLines $ lines content
    putStrLn (show valid)