graveyard/aoc2020/4.hs
2022-05-09 11:58:15 -05:00

67 lines
2.2 KiB
Haskell

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 (flip elem "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