{-# LANGUAGE DeriveGeneric #-} | |
module Main where | |
import qualified Data.Char as Char | |
import qualified Data.HashMap.Strict as HM | |
import Data.Hashable | |
import qualified Data.List.Split as S | |
import Data.Maybe (mapMaybe) | |
import GHC.Generics (Generic) | |
main :: IO () | |
main = do | |
contents <- readFile "input.txt" | |
let entries = map parseEntry (S.splitOn "\n\n" contents) | |
print $ length $ mapMaybe entryToPassport entries | |
type PassportEntry = HM.HashMap PassportField String | |
data PassportField | |
= BirthYear | |
| IssueYear | |
| ExpirationYear | |
| Height | |
| HairColor | |
| EyeColor | |
| PassportId | |
| CountryId | |
deriving (Eq, Show, Generic) | |
instance Hashable PassportField | |
parseEntry :: String -> PassportEntry | |
parseEntry line = | |
HM.fromList $ | |
mapMaybe parseTag $ | |
S.splitWhen Char.isSpace line | |
parseTag :: String -> Maybe (PassportField, String) | |
parseTag value = | |
case S.splitOn ":" value of | |
["byr", byr] -> | |
Just (BirthYear, byr) | |
["iyr", iyr] -> | |
Just (IssueYear, iyr) | |
["eyr", eyr] -> | |
Just (ExpirationYear, eyr) | |
["hgt", height] -> | |
Just (Height, height) | |
["hcl", color] -> | |
Just (HairColor, color) | |
["ecl", color] -> | |
Just (EyeColor, color) | |
["pid", pid] -> | |
Just (PassportId, pid) | |
["cid", cid] -> | |
Just (CountryId, cid) | |
_ -> | |
Nothing | |
requiredFields :: [PassportField] | |
requiredFields = | |
[ BirthYear, | |
IssueYear, | |
ExpirationYear, | |
Height, | |
HairColor, | |
EyeColor, | |
PassportId | |
] | |
isEntryValid :: PassportEntry -> Bool | |
isEntryValid entry = | |
requiredFieldsPresent && allFieldsValid | |
where | |
requiredFieldsPresent = | |
all (`HM.member` entry) requiredFields | |
allFieldsValid = | |
all isFieldValid (HM.toList entry) | |
isFieldValid :: (PassportField, String) -> Bool | |
isFieldValid (field, value) = | |
case field of | |
BirthYear -> | |
let v = toInt value | |
in length value == 4 && v >= 1920 && v <= 2002 | |
IssueYear -> | |
let v = toInt value | |
in length value == 4 && v >= 2010 && v <= 2020 | |
ExpirationYear -> | |
let v = toInt value | |
in length value == 4 && v >= 2020 && v <= 2030 | |
Height -> | |
case span Char.isDigit value of | |
(num, "cm") -> | |
let n = toInt num | |
in n >= 150 && n <= 193 | |
(num, "in") -> | |
let n = toInt num | |
in n >= 59 && n <= 76 | |
_ -> | |
False | |
HairColor -> | |
case (length value, value) of | |
(7, '#' : rest) -> | |
all (`elem` allowedHexChars) rest | |
_ -> | |
False | |
EyeColor -> | |
value `elem` validEyeColors | |
PassportId -> | |
length value == 9 && all Char.isDigit value | |
CountryId -> | |
all Char.isDigit value | |
toInt :: String -> Int | |
toInt = read | |
validEyeColors :: [String] | |
validEyeColors = | |
["amb", "blu", "brn", "gry", "grn", "hzl", "oth"] | |
allowedHexChars :: [Char] | |
allowedHexChars = | |
['0' .. '9'] <> ['a' .. 'f'] | |
data Passport = Passport | |
{ birthYear :: Int, | |
issueYear :: Int, | |
expirationYear :: Int, | |
height :: String, | |
hairColor :: String, | |
eyeColor :: String, | |
passportId :: String, | |
countryId :: Maybe Int | |
} | |
parseField :: | |
(PassportField, String) -> Maybe (PassportField, String) | |
parseField tuple = | |
if isFieldValid tuple | |
then Just tuple | |
else Nothing | |
getAllRequiredFields :: PassportEntry -> Maybe [String] | |
getAllRequiredFields e = | |
traverse | |
( \field -> do | |
v <- HM.lookup field e | |
(_field, text) <- parseField (field, v) | |
return text | |
) | |
requiredFields | |
entryToPassport :: PassportEntry -> Maybe Passport | |
entryToPassport entry = do | |
case getAllRequiredFields entry of | |
Just [byr, iyr, eyr, hgt, hcl, ecl, pid] -> | |
Just $ | |
Passport | |
{ birthYear = toInt byr, | |
issueYear = toInt iyr, | |
expirationYear = toInt eyr, | |
height = hgt, | |
hairColor = hcl, | |
eyeColor = ecl, | |
passportId = pid, | |
countryId = toInt <$> HM.lookup CountryId entry | |
} | |
_ -> | |
Nothing |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment