src/advent18/Advent18Parser.hs

   1 module Advent18Parser (successfulParse, Location(..), Instruction(..)) where
   2
   3 import Data.Text (Text)
   4 import Text.Megaparsec hiding (State)
   5 import qualified Text.Megaparsec.Lexer as L
   6 import Text.Megaparsec.Text (Parser)
   7 import qualified Control.Applicative as CA
   8
   9 data Location = Literal Integer | Register Char deriving (Show, Eq)
  10 data Instruction =   Snd Location
  11                    | Set Location Location
  12                    | Add Location Location
  13                    | Mul Location Location
  14                    | Mod Location Location
  15                    | Rcv Location
  16                    | Jgz Location Location
  17                    deriving (Show, Eq)
  18
  19
  20 sc :: Parser ()
  21 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  22
  23 lexeme  = L.lexeme sc
  24
  25 integer       = lexeme L.integer
  26 signedInteger = L.signed sc integer
  27
  28 symb = L.symbol sc
  29 reg = lexeme (some letterChar)
  30
  31 location = (Literal <$> signedInteger) <|> register
  32 register = (Register . head) <$> reg
  33
  34 instructionsP = instructionP `sepBy` space
  35 instructionP = choice [sndP, setP, addP, mulP, modP, rcvP, jgzP]
  36
  37 sndP = Snd <$> (try (symb "snd") *> location)
  38 setP = Set <$> (try (symb "set") *> register) <*> location
  39 addP = Add <$> (try (symb "add") *> register) <*> location
  40 mulP = Mul <$> (try (symb "mul") *> register) <*> location
  41 modP = Mod <$> (try (symb "mod") *> register) <*> location
  42 rcvP = Rcv <$> (try (symb "rcv") *> location)
  43 jgzP = Jgz <$> (try (symb "jgz") *> location) <*> location
  44
  45 successfulParse :: Text -> [Instruction]
  46 successfulParse input =
  47         case parse instructionsP "input" input of
  48                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  49                 Right instructions  -> instructions