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