97 lines
3.6 KiB
Haskell
97 lines
3.6 KiB
Haskell
import AoC
|
|
|
|
import Control.Applicative ((<|>))
|
|
import Control.Monad (guard, mfilter)
|
|
import Data.Char (isDigit)
|
|
import Data.List (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
|
|
|
|
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 . map unwords . splitOnEmptyLines) length (length . mapMaybe (oneCompleteResult parsePassport))
|