advent-of-code/2020/day4/day4.hs

98 lines
3.6 KiB
Haskell
Raw Normal View History

2020-12-05 09:53:27 +01:00
import AoC
2020-12-04 15:38:53 +01:00
import Control.Applicative ((<|>))
import Control.Monad (guard, mfilter)
import Data.Char (isDigit)
import Data.List (intercalate)
2020-12-04 15:38:53 +01:00
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)
2020-12-04 16:14:16 +01:00
, ("ecl", EyeColour <$> parseColourSpec)
2020-12-04 15:38:53 +01:00
, ("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
]
2020-12-04 16:14:16 +01:00
parseColourSpec :: ReadP ColourSpec
parseColourSpec = choice [ string "amb" >> return Amber
2020-12-04 15:38:53 +01:00
, 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
2020-12-05 09:53:27 +01:00
fieldNames = oneCompleteResult parseFieldNames
2020-12-04 15:38:53 +01:00
main = runAoC (filter hasAllRequiredFields . map (intercalate " ") . splitOnEmptyLines) (length) (length . mapMaybe (oneCompleteResult parsePassport))