advent04/src/advent04.hs

   1 -- import Debug.Trace
   2
   3 import Data.Text (Text)
   4 import qualified Data.Text as T
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Void (Void)
   8
   9 import Text.Megaparsec hiding (State)
  10 import Text.Megaparsec.Char
  11 import qualified Text.Megaparsec.Char.Lexer as L
  12 import qualified Control.Applicative as CA
  13
  14 import qualified Data.Map.Strict as M
  15 import qualified Data.Set as S
  16 import Data.Char
  17 -- import Data.List
  18
  19 -- import Text.Megaparsec.Debug
  20
  21 type Passport = M.Map String String
  22
  23 requiredFields = S.fromList ["byr", "iyr", "eyr", "hgt", "hcl",
  24     "ecl", "pid"]
  25 expectedFields = S.union requiredFields $ S.singleton "cid"
  26
  27
  28 main :: IO ()
  29 main =
  30   do  text <- TIO.readFile "data/advent04.txt"
  31       let passports = successfulParse text
  32       print $ length passports
  33       putStrLn $ runTests
  34       print $ part1 passports
  35       print $ part2 passports
  36
  37 part1 = length . filter hasRequiredFields
  38 part2 = length . filter validPassport
  39
  40 hasRequiredFields passport = S.null $ requiredFields `S.difference` (M.keysSet passport)
  41
  42 validPassport :: Passport -> Bool
  43 validPassport passport = (hasRequiredFields passport) && (all validField $ M.assocs passport)
  44
  45 validField :: (String, String) -> Bool
  46 validField (key, value) =
  47   case key of
  48     "byr" -> validRanged 1920 2002 value
  49     "iyr" -> validRanged 2010 2020 value
  50     "eyr" -> validRanged 2020 2030 value
  51     "hgt" -> validHeight value
  52     "hcl" -> validHex value
  53     "ecl" -> validEye value
  54     "pid" -> validPid value
  55     "cid" -> True
  56     _ -> False
  57
  58 validRanged lower upper value =
  59   if all isDigit value
  60   then v >= lower && v <= upper
  61   else False
  62   where v = read @Int value
  63
  64 validHeight value =
  65   if u == "cm"
  66   then validRanged 150 193 v
  67   else if u == "in"
  68        then validRanged 59 76 v
  69        else False
  70   where (v, u) = span isDigit value
  71
  72 validHex value = (length value == 7) && (head value == '#') && (all isHexDigit $ tail value)
  73
  74 validEye value = value `S.member` eyeColours
  75 eyeColours = S.fromList ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
  76
  77 validPid value = (length value == 9) && (all isDigit value)
  78
  79 runTests :: String -- [(Text, Bool)]
  80 runTests = if null failures
  81            then "All tests passed"
  82            else show failures
  83   where failures = filter failedTest testCases
  84
  85 failedTest :: (Text, Bool) -> Bool
  86 failedTest (passportText, expected) = actual /= expected
  87   where passport = parseTestCase passportText
  88         actual = validPassport passport
  89
  90 parseTestCase :: Text -> Passport
  91 parseTestCase input =
  92   case parse passportP "test" input of
  93     Left  _err -> M.empty
  94     Right p -> p
  95
  96 testCases =
  97   [ ("eyr:1972 cid:100 hcl:#18171d ecl:amb hgt:170 pid:186cm iyr:2018 byr:1926", False)
  98   , ("iyr:2019\nhcl:#602927 eyr:1967 hgt:170cm\necl:grn pid:012533040 byr:1946", False)
  99   , ("hcl:dab227 iyr:2012\necl:brn hgt:182cm pid:021572410 eyr:2020 byr:1992 cid:277", False)
 100   , ("hgt:59cm ecl:zzz\neyr:2038 hcl:74454a iyr:2023\npid:3556412378 byr:2007", False)
 101   , ("pid:087499704 hgt:74in ecl:grn iyr:2012 eyr:2030 byr:1980\nhcl:#623a2f", True)
 102   , ("eyr:2029 ecl:blu cid:129 byr:1989\niyr:2014 pid:896056539 hcl:#a97842 hgt:165cm", True)
 103   , ("hcl:#888785\nhgt:164cm byr:2001 iyr:2015 cid:88\npid:545766238 ecl:hzl\neyr:2022", True)
 104   , ("iyr:2010 hgt:158cm hcl:#b6652a ecl:blu byr:1944 eyr:2021 pid:093154719", True)
 105   ]
 106
 107
 108 -- Parse the input file
 109 type Parser = Parsec Void Text
 110
 111 sc :: Parser ()
 112 sc = L.space (skipSome (    char ' '
 113                        <|> char '\t'
 114                        <|> (try (newline <* notFollowedBy newline))
 115                        )
 116              ) CA.empty CA.empty
 117
 118 blankLines = skipSome newline
 119
 120 symb = L.symbol sc
 121 colonP = symb ":"
 122 hashChar = char '#'
 123 stringP = some (alphaNumChar <|> hashChar) <* sc
 124
 125 kvP = (,) <$> stringP <* colonP <*> stringP
 126
 127 passportsP = passportP `sepBy` blankLines
 128 passportP = M.fromList <$> many kvP
 129
 130 successfulParse :: Text -> [Passport]
 131 successfulParse input =
 132   case parse passportsP "input" input of
 133     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 134     Right passports -> passports