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/advent19b.txt"
34 let (rules, messages) = successfulParse text
35 let messagesT = map T.pack messages
38 print $ part1 rules messagesT
39 print $ part2 rules messagesT
43 do text <- TIO.readFile fname
44 let (rules, messages) = successfulParse text
45 let messagesT = map T.pack messages
46 let Right newRules = parse rulesP "rules" "8: 42 | 42 8\n11: 42 31 | 42 11 31"
47 let updatedRules = M.union newRules rules
48 let myParser = (makeParser updatedRules (See 0)) -- <* eof
49 return (myParser, updatedRules, messagesT)
55 part2 rules messages = countMatches updatedRules messages
56 where Right newRules = parse rulesP "rules" "8: 42 | 42 8\n11: 42 31 | 42 11 31"
57 updatedRules = M.union newRules rules
59 countMatches rules messages
62 $ map (parse myParser "message") messages
63 where myParser = (makeParser rules (See 0)) -- <* eof
65 prettyResults rs = map p rs
66 where p (Left e) = errorBundlePretty e
67 p (Right r) = "^" ++ show r
72 makeParser :: RuleSet -> Rule -> Parser ()
73 makeParser m (Letter c) = void $ char c
74 makeParser m (Then rs) = mapM_ (makeParser m) rs
75 makeParser m (Or a b) = (try (makeParser m a)) <|> (makeParser m b)
76 makeParser m (See i) = makeParser m (m!i)
81 type Parser = Parsec Void Text
84 sc = L.space (skipSome (char ' ')) CA.empty CA.empty
87 integer = lexeme L.decimal
94 rulesP = M.fromList <$> ruleP `sepEndBy` newline
95 ruleP = (,) <$> integer <* colonP <*> ruleBodyP
96 ruleBodyP = choice [(try letterRuleP), (try orRuleP), (try thenRuleP), (try seeRuleP)]
98 letterRuleP = Letter <$> between quoteP quoteP letterChar
99 orRuleP = Or <$> thenRuleP <* pipeP <*> thenRuleP
100 thenRuleP = Then <$> some seeRuleP
101 seeRuleP = See <$> integer
104 inputP = (,) <$> rulesP <* (some newline) <*> messagesP
106 messagesP = messageP `sepBy` newline
107 messageP = some letterChar
110 -- successfulParse :: Text -> (Integer, [Maybe Integer])
111 successfulParse input =
112 case parse inputP "input" input of
113 Left _err -> (M.empty, []) -- TIO.putStr $ T.pack $ parseErrorPretty err
114 Right expressions -> expressions