parsers/Parsers/Brainfuck/Attoparsec.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 module Parsers.Brainfuck.Attoparsec where
   3
   4 import Control.Applicative
   5 import Data.Attoparsec.Combinator
   6 import Data.ByteString as BS
   7 import Data.Functor (($>))
   8 import Data.Text as T
   9 import qualified Data.Attoparsec.Internal.Types as AP
  10
  11 import Parsers.Utils.Attoparsec as AP
  12 import Parsers.Brainfuck.Types
  13
  14 parser :: forall inp. AP.Inputable inp => AP.Parser inp [Instruction]
  15 parser = whitespace *> bf <* endOfInput
  16   where
  17   whitespace = skipMany (AP.satisfy (AP.notInClass @inp "<>+-.,[]"))
  18   lexeme :: AP.Parser inp a -> AP.Parser inp a
  19   lexeme p = p <* whitespace
  20   bf = many (lexeme (AP.char '>' $> Forward)
  21     <|> lexeme (AP.char '<' $> Backward)
  22     <|> lexeme (AP.char '+' $> Increment)
  23     <|> lexeme (AP.char '-' $> Decrement)
  24     <|> lexeme (AP.char '.' $> Output)
  25     <|> lexeme (AP.char ',' $> Input)
  26     <|> between (lexeme (AP.char '[')) (lexeme (AP.char ']')) (Loop <$> bf))
  27 -- Specializing is essential to keep best performances.
  28 {-# SPECIALIZE parser :: AP.Parser T.Text [Instruction] #-}
  29 {-# SPECIALIZE parser :: AP.Parser BS.ByteString [Instruction] #-}