advent19/src/advent19atto.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.Attoparsec.Text
   8 -- import Data.Attoparsec.Combinator
   9 import Control.Applicative
  10 -- import Control.Applicative.Combinators
  11
  12 import qualified Data.IntMap.Strict as M
  13 import Data.IntMap.Strict ((!))
  14 import Data.Functor (void)
  15 import Prelude hiding (take)
  16 import Data.Either
  17
  18
  19 data Rule = Letter Char
  20           | Then [Rule]
  21           | Or Rule Rule
  22           | See Int
  23           deriving (Show, Eq)
  24
  25 type RuleSet = M.IntMap Rule
  26
  27
  28 main :: IO ()
  29 main =
  30   do  text <- TIO.readFile "data/advent19.txt"
  31       -- print text
  32       let (rules, messages) = successfulParse inputP text
  33       let messagesT = map T.pack messages
  34       -- TIO.writeFile "rules19.atto.txt" $ T.pack $ show rules
  35       print $ length rules
  36       print $ length messages
  37       print $ part1 rules messagesT
  38       print $ part2 rules messagesT
  39
  40 setup fname =
  41   do text <- TIO.readFile fname
  42      let (rules, messages) = successfulParse inputP text
  43      let messagesT = map T.pack messages
  44      let Right newRules = parseOnly rulesP "8: 42 | 42 8\n11: 42 31 | 42 11 31"
  45      let updatedRules = M.union newRules rules
  46      let myParser = (makeParser updatedRules (See 0)) <* endOfInput
  47      return (myParser, updatedRules, messagesT)
  48
  49
  50
  51 part1 = countMatches
  52
  53 part2 rules messages = countMatches updatedRules messages
  54   where Right newRules = parseOnly rulesP "8: 42 | 42 8\n11: 42 31 | 42 11 31"
  55         updatedRules = M.union newRules rules
  56
  57 countMatches rules messages
  58   = length
  59   $ filter isRight
  60   $ map (parseOnly myParser) messages
  61   where myParser = ((makeParser rules (See 0)) <* endOfInput)
  62
  63
  64 -- Generate the rules
  65
  66 makeParser :: RuleSet -> Rule -> Parser ()
  67 makeParser m (Letter c) = void $ char c
  68 makeParser m (Then rs) = mapM_ (\r -> try (makeParser m r)) rs
  69 makeParser m (Or a b) = (try (makeParser m a)) <|> (makeParser m b)
  70 makeParser m (See i) = makeParser m (m!i)
  71
  72
  73 -- Parse the input
  74
  75 rulesP = M.fromList <$> ruleP `sepBy` endOfLine
  76 ruleP = (,) <$> decimal <* ": " <*> ruleBodyP
  77 ruleBodyP = choice [letterRuleP, orRuleP, thenRuleP, seeRuleP]
  78
  79 letterRuleP = Letter <$> ("\"" *> anyChar) <* "\""
  80 orRuleP = Or <$> thenRuleP <* " | " <*> thenRuleP
  81 thenRuleP = Then <$> seeRuleP `sepBy` (string " ")
  82 seeRuleP = See <$> decimal
  83
  84
  85 inputP = (,) <$> rulesP <* blankLines <*> messagesP
  86
  87 messagesP = (many1 letter) `sepBy` endOfLine
  88
  89 blankLines = skipMany1 endOfLine
  90
  91
  92 -- successfulParse :: Text -> (Integer, [Maybe Integer])
  93 successfulParse parser input =
  94   case parseOnly parser input of
  95     Left  _err -> (M.empty, []) -- TIO.putStr $ T.pack $ parseErrorPretty err
  96     Right expressions -> expressions