3 import Data.Text (Text)
4 import qualified Data.Text as T
5 import qualified Data.Text.IO as TIO
7 import Data.Void (Void)
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
14 import qualified Data.Map.Strict as M
15 import qualified Data.Set as S
19 -- import Text.Megaparsec.Debug
21 type Passport = M.Map String String
23 requiredFields = S.fromList ["byr", "iyr", "eyr", "hgt", "hcl",
25 expectedFields = S.union requiredFields $ S.singleton "cid"
30 do text <- TIO.readFile "data/advent04.txt"
31 let passports = successfulParse text
32 print $ length passports
34 print $ part1 passports
35 print $ part2 passports
37 part1 = length . filter hasRequiredFields
38 part2 = length . filter validPassport
40 hasRequiredFields passport = S.null $ requiredFields `S.difference` (M.keysSet passport)
42 validPassport :: Passport -> Bool
43 validPassport passport = (hasRequiredFields passport) && (all validField $ M.assocs passport)
45 validField :: (String, String) -> Bool
46 validField (key, value) =
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
58 validRanged lower upper value =
60 then v >= lower && v <= upper
62 where v = read @Int value
66 then validRanged 150 193 v
68 then validRanged 59 76 v
70 where (v, u) = span isDigit value
72 validHex value = (length value == 7) && (head value == '#') && (all isHexDigit $ tail value)
74 validEye value = value `S.member` eyeColours
75 eyeColours = S.fromList ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
77 validPid value = (length value == 9) && (all isDigit value)
79 runTests :: String -- [(Text, Bool)]
80 runTests = if null failures
81 then "All tests passed"
83 where failures = filter failedTest testCases
85 failedTest :: (Text, Bool) -> Bool
86 failedTest (passportText, expected) = actual /= expected
87 where passport = parseTestCase passportText
88 actual = validPassport passport
90 parseTestCase :: Text -> Passport
92 case parse passportP "test" input of
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)
108 -- Parse the input file
109 type Parser = Parsec Void Text
112 sc = L.space (skipSome ( char ' '
114 <|> (try (newline <* notFollowedBy newline))
118 blankLines = skipSome newline
123 stringP = some (alphaNumChar <|> hashChar) <* sc
125 kvP = (,) <$> stringP <* colonP <*> stringP
127 passportsP = passportP `sepBy` blankLines
128 passportP = M.fromList <$> many kvP
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