aoc2020/4.hs

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 Text.Read
import Data.Set (Set, fromList, isSubsetOf)

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

intval :: Int -> Int -> Int -> Maybe Int
intval lo hi n = guard (lo <= n && n <= hi) $> n

nDigits :: Int -> String -> Maybe String
nDigits n s = guard (length s == n && all isDigit s) $> s

hexColor :: String -> Maybe String
hexColor s = guard (length s == 7 && s !! 0 == '#' && all (\c -> elem c "0123456789abcdef") (drop 1 s)) $> s

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

parseAttr :: String -> Maybe Attr
parseAttr s =
    case splitOn ":" s of
        [key, value] -> 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" ->
                let inch = stripSuffix "cm" value >>= readMaybe >>= intval 150 193 in
                let cm = stripSuffix "in" value >>= readMaybe >>= intval 59 76 in
                (inch <|> cm) $> Hgt
            "hcl" -> hexColor value $> Hcl
            "ecl" -> if validEcl value then Just Ecl else Nothing
            "pid" -> nDigits 9 value $> Pid
            "cid" -> Just Cid
            _ -> Nothing
        _ -> Nothing

processLine :: String -> Maybe [Attr]
processLine = mapM parseAttr . splitOn " "

requiredAttrs :: Set Attr
requiredAttrs = fromList $ enumFromTo Byr Pid

combineAttrs :: [Attr] -> Maybe [Attr]
combineAttrs attrs = guard (isSubsetOf requiredAttrs $ fromList $ attrs) $> attrs

processPassport :: [String] -> Maybe [Attr]
processPassport = combineAttrs . concat <=< mapM processLine

processLines :: [String] -> [Maybe [Attr]]
processLines = map processPassport . splitWhen (== "")

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

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