Solve day 4, part 2

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
+  putStr "[Day 4-1] # correct: "
+  let m = catMaybes . parseList $ r
+  print . length $ m
+  putStr "[Day 4-2] # more correct: "
+  print . length . filter validatePassport $ m