import AoC import Control.Applicative ((<|>)) import Control.Monad (guard, mfilter) import Data.Char (isDigit) import Data.Function (on) import Data.List (groupBy, intercalate) import Data.Maybe (mapMaybe) import Text.ParserCombinators.ReadP import Text.Read (readMaybe) data HeightUnit = Centimeter | Inch deriving (Show, Eq) data ColourSpec = Amber | Blue | Brown | Gray | Green | Hazel | Other deriving (Show, Eq) data Field = BirthYear Int | IssueYear Int | ExpirationYear Int | Height Int HeightUnit | HairColour String | EyeColour ColourSpec | PassportID String | CountryID String deriving (Show, Eq) fieldSpecs :: [(String, ReadP Field)] fieldSpecs = [ ("byr", BirthYear <$> parseYearIn 1920 2002) , ("iyr", IssueYear <$> parseYearIn 2010 2020) , ("eyr", ExpirationYear <$> parseYearIn 2020 2030) , ("hgt", do h <- parseNumber 2 <|> parseNumber 3 u <- parseHeightUnit case u of Inch -> guard $ within 59 76 h Centimeter -> guard $ within 150 193 h return $ Height h u) , ("hcl", char '#' >> HairColour <$> count 6 parseHexDigit) , ("ecl", EyeColour <$> parseColourSpec) , ("pid", PassportID <$> count 9 (satisfy $ const True)) , ("cid", CountryID <$> munch1 (/= ' ')) ] where parseYearIn = flip mfilter (parseNumber 4) .: within parseHexDigit = choice . map char $ ['0'..'9']++['a'..'f'] within :: Ord a => a -> a -> a -> Bool within a b x = a <= x && x <= b parseNumber :: (Num a, Read a) => Int -> ReadP a parseNumber n = do Just digits <- readMaybe <$> count n (satisfy isDigit) return digits parseHeightUnit :: ReadP HeightUnit parseHeightUnit = choice [ string "cm" >> return Centimeter , string "in" >> return Inch ] parseColourSpec :: ReadP ColourSpec parseColourSpec = choice [ string "amb" >> return Amber , string "blu" >> return Blue , string "brn" >> return Brown , string "gry" >> return Gray , string "grn" >> return Green , string "hzl" >> return Hazel , string "oth" >> return Other ] parseKeyValue :: ReadP k -> ReadP v -> ReadP (k, v) parseKeyValue kp vp = do k <- kp char ':' v <- vp return (k, v) parseFieldName :: ReadP String parseFieldName = fmap fst $ choice $ map (\(k, _) -> parseKeyValue (string k) (munch1 (/= ' '))) $ fieldSpecs parseField :: ReadP Field parseField = fmap snd $ choice $ map (\(k, v) -> parseKeyValue (string k) v) $ fieldSpecs spaceSeparated :: ReadP a -> ReadP [a] spaceSeparated = flip sepBy (many1 $ char ' ') parseFieldNames :: ReadP [String] parseFieldNames = spaceSeparated parseFieldName parsePassport :: ReadP [Field] parsePassport = spaceSeparated parseField oneCompleteResult :: ReadP a -> String -> Maybe a oneCompleteResult p s = case readP_to_S (p <* eof) s of [(x, "")] -> Just x _ -> Nothing splitOnEmptyLines :: String -> [String] splitOnEmptyLines = map (intercalate " ") . filter (not . any null) . groupBy ((==) `on` null) . lines hasAllRequiredFields :: String -> Bool hasAllRequiredFields = maybe False containsAllFields . fieldNames where requiredFieldNames = ["byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid"] containsAllFields fields = all (`elem` fields) requiredFieldNames fieldNames = oneCompleteResult parseFieldNames main = runAoC (filter hasAllRequiredFields . splitOnEmptyLines) (length) (length . mapMaybe (oneCompleteResult parsePassport))