2020-19 part 2 in haskell

2020/19-Monster_Messages/example2

@@ -0,0 +1,47 @@
+42: 9 14 | 10 1
+9: 14 27 | 1 26
+10: 23 14 | 28 1
+1: "a"
+11: 42 31
+5: 1 14 | 15 1
+19: 14 1 | 14 14
+12: 24 14 | 19 1
+16: 15 1 | 14 14
+31: 14 17 | 1 13
+6: 14 14 | 1 14
+2: 1 24 | 14 4
+0: 8 11
+13: 14 3 | 1 12
+15: 1 | 14
+17: 14 2 | 1 7
+23: 25 1 | 22 14
+28: 16 1
+4: 1 1
+20: 14 14 | 1 15
+3: 5 14 | 16 1
+27: 1 6 | 14 18
+14: "b"
+21: 14 1 | 1 14
+25: 1 1 | 1 14
+22: 14 14
+8: 42
+26: 14 22 | 1 20
+18: 15 15
+7: 14 5 | 1 21
+24: 14 1
+
+abbbbbabbbaaaababbaabbbbabababbbabbbbbbabaaaa
+bbabbbbaabaabba
+babbbbaabbbbbabbbbbbaabaaabaaa
+aaabbbbbbaaaabaababaabababbabaaabbababababaaa
+bbbbbbbaaaabbbbaaabbabaaa
+bbbababbbbaaaaaaaabbababaaababaabab
+ababaaaaaabaaab
+ababaaaaabbbaba
+baabbaaaabbaaaababbaababb
+abbbbabbbbaaaababbbbbbaaaababb
+aaaaabbaabaaaaababaa
+aaaabbaaaabbaaa
+aaaabbaabbaaaaaaabbbabbbaaabbaabaaa
+babaaabbbaaabaababbaabababaaab
+aabbbbbaabbbaaaaaabbbbbababaaaaabbaaabba

2020/19-Monster_Messages/second.hs

@@ -0,0 +1,90 @@
+-- requires cabal install --lib megaparsec parser-combinators
+module Main (main) where
+import Control.Monad (void, when)
+import Data.Either
+import Data.List (any, foldl')
+import Data.Maybe (catMaybes)
+import Data.Map qualified as M
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Exit (die)
+
+exampleExpectedOutput = 12
+
+type Match = Char
+type RuleID = Int
+type Action = [RuleID]
+type Rule = Either Match [Action]
+type Message = String
+data Input = Input { rules :: M.Map RuleID Rule
+                   , messages :: [Message]
+                   } deriving (Show)
+
+type Parser = Parsec Void String
+
+parseInt :: Parser Int
+parseInt = do
+  n <- some digitChar
+  void $ optional (char ' ')
+  return $ read n
+
+parseMatch :: Parser Match
+parseMatch = do
+  void $ char '"'
+  c <- letterChar
+  void $ char '"'
+  return c
+
+parseAction :: Parser Action
+parseAction = some (parseInt <* optional (char ' '))
+
+parseRule :: Parser (RuleID, Rule)
+parseRule = do
+  id <- some digitChar
+  void $ string ": "
+  rule <- (Left <$> parseMatch) <|> (Right <$> some (parseAction <* optional (string "| ")))
+  void $ char '\n'
+  return $ (read id, rule)
+
+parseInput' :: Parser Input
+parseInput' = do
+  rules <- M.fromList <$> some parseRule
+  void $ char '\n'
+  messages <- some (some letterChar <* (optional $ char '\n'))
+  void eof
+  let rules' = M.insert 8 (Right $ reverse [take i (repeat 42)|i<-[1..5]]) rules
+      rules'' = M.insert 11 (Right $ reverse [take i (repeat 42) ++ take i (repeat 31)|i<-[1..5]]) rules'
+  return $ Input rules'' messages
+
+parseInput :: String -> IO Input
+parseInput filename = do
+  input <- readFile filename
+  case runParser parseInput' filename input of
+    Left bundle -> die $ errorBundlePretty bundle
+    Right input' -> return input'
+
+compute :: Input -> Int
+compute (Input rules messages) = length . filter id $ map isValid messages
+  where
+    isValid :: Message -> Bool
+    isValid msg = any (== "") $ matchAll 0 [msg]
+    matchAll :: RuleID -> [Message] -> [Message]
+    matchAll ruleId msgs = concat $ map (matches ruleId) msgs
+    matches :: RuleID -> Message -> [Message]
+    matches _ [] = []
+    matches ruleId msg = case rules M.! ruleId of
+      Left c -> if head msg == c then [tail msg] else []
+      Right actions -> concat $ map (processAction msg) actions
+    processAction :: Message -> Action -> [Message]
+    processAction msg action = foldl' step [msg] action
+    step :: [Message] -> RuleID -> [Message]
+    step msgs ruleID = matchAll ruleID msgs
+
+main :: IO ()
+main = do
+  example <- parseInput "example2"
+  let exampleOutput = compute example
+  when  (exampleOutput /= exampleExpectedOutput)  (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+  input <- parseInput "input"
+  print $ compute input