diff --git a/src/Day4.hs b/src/Day4.hs index a1c50a0..8ab38b3 100644 --- a/src/Day4.hs +++ b/src/Day4.hs @@ -9,19 +9,23 @@ import qualified Data.Map as M import Data.Maybe (catMaybes) import qualified Data.Text as T -type BYR = T.Text +data Height = CM Integer | IN Integer deriving (Show, Eq) -type IYR = T.Text +data EyeColour = AMB | BLU | BRN | GRY | GRN | HZL | OTH deriving (Show, Eq) -type EYR = T.Text +type BYR = Either String Integer -type HGT = T.Text +type IYR = Either String Integer -type HCL = T.Text +type EYR = Either String Integer -type ECL = T.Text +type HGT = Either String Height -type PID = T.Text +type HCL = Either String String + +type ECL = Either String EyeColour + +type PID = Either String Integer type CID = T.Text @@ -47,16 +51,82 @@ parserPair = do parserEntry :: P.Parser (M.Map T.Text T.Text) parserEntry = M.fromList <$> parserPair `P.sepBy` (void P.space <|> P.endOfLine) +parseBYR :: T.Text -> BYR +parseBYR s = do + n <- P.eitherResult $ P.parse (P.count 4 P.digit) s + let n' = read n + if n' >= 1920 && n' <= 2002 then Right n' else Left (T.unpack s) + +parseIYR :: T.Text -> IYR +parseIYR s = do + n <- P.eitherResult $ P.parse (P.count 4 P.digit) s + let n' = read n + if n' >= 2010 && n' <= 2020 then Right n' else Left (T.unpack s) + +parseEYR :: T.Text -> EYR +parseEYR s = do + n <- P.eitherResult $ P.parse (P.count 4 P.digit) s + let n' = read n + if n' >= 2020 && n' <= 2030 then Right n' else Left (T.unpack s) + +parseCM :: P.Parser Height +parseCM = do + n <- P.count 3 P.digit + _ <- P.string "cm" + let n' = read n + if n' >= 150 && n' <= 193 + then return $ CM n' + else fail n + +parseIN :: P.Parser Height +parseIN = do + n <- P.count 2 P.digit + _ <- P.string "in" + let n' = read n + if n' >= 59 && n' <= 76 + then return $ IN n' + else fail n + +parseHGT :: T.Text -> HGT +parseHGT s = P.eitherResult $ P.parse (parseCM <|> parseIN) s + +parseHCL :: T.Text -> HCL +parseHCL s = + let p = P.char '#' *> P.count 6 (P.satisfy (P.inClass "a-f0-9")) + in P.eitherResult $ P.parse p s + +parseECL :: T.Text -> ECL +parseECL s = do + let pAMB = AMB <$ P.string "amb" + pBLU = BLU <$ P.string "blu" + pBRN = BRN <$ P.string "brn" + pGRY = GRY <$ P.string "gry" + pGRN = GRN <$ P.string "grn" + pHZL = HZL <$ P.string "hzl" + pOTH = OTH <$ P.string "oth" + p = pAMB <|> pBLU <|> pBRN <|> pGRY <|> pGRN <|> pHZL <|> pOTH + in P.eitherResult $ P.parse p s + +parsePID :: T.Text -> PID +parsePID s = fmap read (P.parseOnly (P.count 9 P.digit <* P.endOfInput) s) + fromMap :: M.Map T.Text T.Text -> Maybe Passport fromMap m = do byr <- m M.!? "byr" + let byr' = parseBYR byr iyr <- m M.!? "iyr" + let iyr' = parseIYR iyr eyr <- m M.!? "eyr" + let eyr' = parseEYR eyr hgt <- m M.!? "hgt" + let hgt' = parseHGT hgt hcl <- m M.!? "hcl" + let hcl' = parseHCL hcl ecl <- m M.!? "ecl" + let ecl' = parseECL ecl pid <- m M.!? "pid" - return $ Passport byr iyr eyr hgt hcl ecl pid (m M.!? "cid") + let pid' = parsePID pid + return $ Passport byr' iyr' eyr' hgt' hcl' ecl' pid' (m M.!? "cid") parserPassport :: P.Parser (Maybe Passport) parserPassport = fromMap <$> parserEntry @@ -68,8 +138,21 @@ parseList s = Left s -> error (show s) Right r -> r +validatePassport :: Passport -> Bool +validatePassport (Passport (Left _) _ _ _ _ _ _ _) = False +validatePassport (Passport _ (Left _) _ _ _ _ _ _) = False +validatePassport (Passport _ _ (Left _) _ _ _ _ _) = False +validatePassport (Passport _ _ _ (Left _) _ _ _ _) = False +validatePassport (Passport _ _ _ _ (Left _) _ _ _) = False +validatePassport (Passport _ _ _ _ _ (Left _) _ _) = False +validatePassport (Passport _ _ _ _ _ _ (Left _) _) = False +validatePassport _ = True + day4 :: IO () day4 = do r <- readFile "./input/day4" - putStr "[Day 4-1] # trees: " - print . length . catMaybes . parseList $ r \ No newline at end of file + putStr "[Day 4-1] # correct: " + let m = catMaybes . parseList $ r + print . length $ m + putStr "[Day 4-2] # more correct: " + print . length . filter validatePassport $ m \ No newline at end of file