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