Day04/Main.hs

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