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.IntMap.Strict as M
15 import Data.IntMap.Strict ((!))
16 import Data.Functor (void)
17 import Prelude hiding (take)
21 data Rule = Letter Char
27 type RuleSet = M.IntMap Rule
32 do text <- TIO.readFile "data/advent19.txt"
33 let (rules, messages) = successfulParse text
34 let messagesT = map T.pack messages
35 -- TIO.writeFile "rules19.mega.txt" $ T.pack $ show rules
37 print $ length messages
38 print $ part1 rules messagesT
39 print $ part2 rules messagesT
42 do text <- TIO.readFile fname
43 let (rules, messages) = successfulParse text
44 let messagesT = map T.pack messages
45 let Right newRules = parse rulesP "rules" "8: 42 | 42 8\n11: 42 31 | 42 11 31"
46 let updatedRules = M.union newRules rules
47 let myParser = (makeParser updatedRules (See 0)) -- <* eof
48 return (myParser, updatedRules, messagesT)
53 part2 rules messages = countMatches updatedRules messages
54 where Right newRules = parse rulesP "rules" "8: 42 | 42 8\n11: 42 31 | 42 11 31"
55 updatedRules = M.union newRules rules
57 countMatches rules messages
60 $ map (parse myParser "message") messages
61 where myParser = (makeParser rules (See 0)) <* eof
63 prettyResults rs = map p rs
64 where p (Left e) = errorBundlePretty e
65 p (Right r) = "^" ++ show r
69 makeParser :: RuleSet -> Rule -> Parser ()
70 makeParser m (Letter c) = void $ char c
71 makeParser m (Then rs) = mapM_ (\r -> try (makeParser m r)) rs
72 makeParser m (Or a b) = (try (makeParser m a)) <|> (makeParser m b)
73 makeParser m (See i) = makeParser m (m!i)
78 type Parser = Parsec Void Text
81 sc = L.space (skipSome (char ' ')) CA.empty CA.empty
84 integer = lexeme L.decimal
91 rulesP = M.fromList <$> ruleP `sepEndBy` newline
92 ruleP = (,) <$> integer <* colonP <*> ruleBodyP
93 ruleBodyP = choice [(try letterRuleP), (try orRuleP), (try thenRuleP), (try seeRuleP)]
95 letterRuleP = Letter <$> between quoteP quoteP letterChar
96 orRuleP = Or <$> thenRuleP <* pipeP <*> thenRuleP
97 thenRuleP = Then <$> some seeRuleP
98 seeRuleP = See <$> integer
101 inputP = (,) <$> rulesP <* (some newline) <*> messagesP
103 messagesP = messageP `sepBy` newline
104 messageP = some letterChar
107 -- successfulParse :: Text -> (Integer, [Maybe Integer])
108 successfulParse input =
109 case parse inputP "input" input of
110 Left _err -> (M.empty, []) -- TIO.putStr $ T.pack $ parseErrorPretty err
111 Right expressions -> expressions