Attoparsec.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
module Parsers.Brainfuck.Attoparsec where

import Control.Applicative
import Data.Attoparsec.Combinator
import Data.ByteString as BS
import Data.Functor (($>))
import Data.Text as T
import qualified Data.Attoparsec.Internal.Types as AP

import Parsers.Utils.Attoparsec as AP
import Parsers.Brainfuck.Types

parser :: forall inp. AP.Inputable inp => AP.Parser inp [Instruction]
parser = whitespace *> bf <* endOfInput
  where
  whitespace = skipMany (AP.satisfy (AP.notInClass @inp "<>+-.,[]"))
  lexeme :: AP.Parser inp a -> AP.Parser inp a
  lexeme p = p <* whitespace
  bf = many (lexeme (AP.char '>' $> Forward)
    <|> lexeme (AP.char '<' $> Backward)
    <|> lexeme (AP.char '+' $> Increment)
    <|> lexeme (AP.char '-' $> Decrement)
    <|> lexeme (AP.char '.' $> Output)
    <|> lexeme (AP.char ',' $> Input)
    <|> between (lexeme (AP.char '[')) (lexeme (AP.char ']')) (Loop <$> bf))
-- Specializing is essential to keep best performances.
{-# SPECIALIZE parser :: AP.Parser T.Text [Instruction] #-}
{-# SPECIALIZE parser :: AP.Parser BS.ByteString [Instruction] #-}