Day04/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-} -- for building Text strings
   2 module Main where
   3 import Control.Applicative (Alternative((<|>)))
   4 import Control.Monad (guard)
   5 import Data.Maybe (catMaybes)
   6 import Data.Text.Lazy (Text)
   7 import Data.Void (Void)
   8 import Prelude
   9 import qualified Control.Applicative.Permutations as P
  10 import qualified Data.Char as Char
  11 import qualified Data.List as List
  12 import qualified Data.Text.Lazy.Encoding as Text
  13 import qualified Text.Megaparsec as P
  14 import qualified Text.Megaparsec.Char as P
  15 -- import qualified Text.Megaparsec.Debug as P
  16 import qualified Data.ByteString.Lazy as BSL
  17 import Paths_AoC2020
  18
  19 -- | See https://adventofcode.com/2020/day/4 for the problem statements
  20 data Day04Results = Day04Results
  21   { example1 :: Int
  22   , batch1 :: Int
  23   , example2 :: Int
  24   , batch2 :: Int
  25   } deriving (Show)
  26
  27 main :: IO ()
  28 main = do
  29   putStr "Day04Inputs: " >> getDataFileName "" >>= putStrLn
  30   print =<< Day04Results
  31     <$> parsePassports parserPassport "example"
  32     <*> parsePassports parserPassport "batch"
  33     <*> parsePassports parserValidPassport "example"
  34     <*> parsePassports parserValidPassport "batch"
  35
  36 data Passport = Passport {
  37   pp_byr :: Text, -- Birth Year
  38   pp_iyr :: Text, -- Issue Year
  39   pp_eyr :: Text, -- Expiration Year
  40   pp_hgt :: Text, -- Height
  41   pp_hcl :: Text, -- Hair Color
  42   pp_ecl :: Text, -- Eye Color
  43   pp_pid :: Text, -- Passport ID
  44   pp_cid :: Maybe Text -- Country ID
  45 } deriving (Show)
  46
  47 type Parser output = P.Parsec {-error-}Void {-input-}Text output
  48
  49 parserPassportEntry :: Text -> Parser Text
  50 parserPassportEntry key = -- P.dbg "PassportEntry" $
  51   P.string key
  52   *> P.char ':'
  53   *> P.takeWhileP (Just "value") (\c -> c /= ' ' && c /= '\n')
  54
  55 parserPassport :: Parser Passport
  56 parserPassport = -- P.dbg "Passport" $
  57   P.intercalateEffect (P.char ' ' <|> P.try (P.char '\n' <* P.notFollowedBy (P.char '\n'))) $
  58     Passport
  59       <$> P.toPermutation (parserPassportEntry "byr")
  60       <*> P.toPermutation (parserPassportEntry "iyr")
  61       <*> P.toPermutation (parserPassportEntry "eyr")
  62       <*> P.toPermutation (parserPassportEntry "hgt")
  63       <*> P.toPermutation (parserPassportEntry "hcl")
  64       <*> P.toPermutation (parserPassportEntry "ecl")
  65       <*> P.toPermutation (parserPassportEntry "pid")
  66       <*> P.toPermutationWithDefault Nothing (Just <$> parserPassportEntry "cid")
  67
  68 parserPassports :: Show passport => Parser passport -> Parser [passport]
  69 parserPassports passportParser = (catMaybes <$>) $
  70   -- P.dbg "parserPassports" $
  71   P.sepBy (
  72       Just <$> P.try (passportParser <* (() <$ P.char '\n' <|> P.eof)) <|>
  73       Nothing <$ P.some (P.takeWhile1P (Just "line") (/= '\n') <* P.char '\n')
  74     ) (P.char '\n')
  75
  76 parsePassports :: Show passport => Parser passport -> FilePath -> IO Int
  77 parsePassports passportParser input = do
  78   content <- Text.decodeUtf8 <$> (BSL.readFile =<< getDataFileName input)
  79   case P.parse (parserPassports passportParser <* P.eof) input content of
  80     Left err -> error (P.errorBundlePretty err)
  81     Right passports -> return $ length passports
  82
  83 -- byr (Birth Year) - four digits; at least 1920 and at most 2002.
  84 -- iyr (Issue Year) - four digits; at least 2010 and at most 2020.
  85 -- eyr (Expiration Year) - four digits; at least 2020 and at most 2030.
  86 -- hgt (Height) - a number followed by either cm or in:
  87 --     If cm, the number must be at least 150 and at most 193.
  88 --     If in, the number must be at least 59 and at most 76.
  89 -- hcl (Hair Color) - a # followed by exactly six characters 0-9 or a-f.
  90 -- ecl (Eye Color) - exactly one of: amb blu brn gry grn hzl oth.
  91 -- pid (Passport ID) - a nine-digit number, including leading zeroes.
  92 -- cid (Country ID) - ignored, missing or not.
  93 data ValidPassport = ValidPassport {
  94   vp_byr :: Int,
  95   vp_iyr :: Int,
  96   vp_eyr :: Int,
  97   vp_hgt :: Height,
  98   vp_hcl :: String,
  99   vp_ecl :: Eye,
 100   vp_pid :: Int,
 101   vp_cid :: Maybe Text
 102 } deriving (Show)
 103 data Height = Cm Int | In Int deriving (Show)
 104 data Eye = Amb | Blu | Brn | Gry | Grn | Hzl | Oth deriving (Show)
 105
 106 parserValidPassport :: Parser ValidPassport
 107 parserValidPassport = -- P.dbg "ValidPassport" $
 108   P.intercalateEffect (P.char ' ' <|> P.try (P.char '\n' <* P.notFollowedBy (P.char '\n'))) $
 109     ValidPassport
 110       <$> P.toPermutation (mkNum <$ P.string "byr:" <*> P.count 4 P.digitChar >>= \x -> do
 111        guard (1920 <= x && x <= 2002)
 112        return x)
 113       <*> P.toPermutation (mkNum <$ P.string "iyr:" <*> P.count 4 P.digitChar >>= \x -> do
 114        guard (2010 <= x && x <= 2020)
 115        return x)
 116       <*> P.toPermutation (mkNum <$ P.string "eyr:" <*> P.count 4 P.digitChar >>= \x -> do
 117        guard (2020 <= x && x <= 2030)
 118        return x)
 119       <*> P.toPermutation (P.string "hgt:" *> do
 120         x <- mkNum <$> P.some P.digitChar
 121         P.choice
 122           [ Cm <$ P.string "cm" <* guard (150 <= x && x <= 193) <*> pure x
 123           , In <$ P.string "in" <* guard (59 <= x && x <= 76) <*> pure x
 124           ]
 125         )
 126       <*> P.toPermutation (P.string "hcl:#" *> P.count 6 (P.digitChar <|> P.satisfy (\c -> 'a' <= c && c <= 'f')))
 127       <*> P.toPermutation (P.string "ecl:" *> P.choice
 128             [ Amb <$ P.string "amb"
 129             , Blu <$ P.string "blu"
 130             , Brn <$ P.string "brn"
 131             , Gry <$ P.string "gry"
 132             , Grn <$ P.string "grn"
 133             , Hzl <$ P.string "hzl"
 134             , Oth <$ P.string "oth"
 135             ])
 136       <*> P.toPermutation (mkNum <$ P.string "pid:" <*> P.count 9 P.digitChar)
 137       <*> P.toPermutationWithDefault Nothing (Just <$> parserPassportEntry "cid")
 138   where
 139   mkNum :: [Char] -> Int
 140   mkNum = List.foldl' step 0
 141     where step a c = a * 10 + fromIntegral (Char.digitToInt c)