content: -- | Minimal parser definition.
  
  {-# LANGUAGE UnboxedTuples #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE DataKinds #-} -- needed for manual ZeroBitType def (unsure why)
  {-# LANGUAGE FlexibleInstances #-}
  
  module FlatParse.Stateful.Parser
    (
    -- * Parser
      ParserT(..)
    , Parser, ParserIO, ParserST
    , pureLazy
  
    -- ** Result
    , type Res#
    , pattern OK#, pattern Err#, pattern Fail#
  
    -- *** Internal
    , type ResI#
  
    -- * Choice operator (defined with right associativity)
    , (<|>)
    ) where
  
  import FlatParse.Common.GHCExts ( Addr#, unsafeCoerce#, ZeroBitType, Int# )
  import FlatParse.Common.Parser
  
  import GHC.ForeignPtr ( ForeignPtrContents )
  
  import qualified Control.Applicative
  import Control.Monad ( MonadPlus(..) )
  import Control.Monad.IO.Class ( MonadIO(..) )
  import GHC.IO ( IO(IO) )
  
  -- | @ParserT st r e a@ is a parser with a state token type @st@, a reader
  --   environment @r@, an error type @e@ and a return type @a@. The different
  --   state token types support different embedded effects; see `Parser`,
  --   `ParserIO` and `ParserST` below.
  newtype ParserT (st :: ZeroBitType) r e a =
      ParserT { runParserT# :: ForeignPtrContents -> r -> Addr# -> Addr# -> Int# -> st -> Res# st e a }
  
  -- | The type of pure parsers.
  type Parser     = ParserT PureMode
  
  -- | The type of parsers which can embed `IO` actions.
  type ParserIO   = ParserT IOMode
  
  -- | The type of parsers which can embed `ST` actions.
  type ParserST s = ParserT (STMode s)
  
  -- | You may lift IO actions into a 'ParserIO' using `liftIO`.
  instance MonadIO (ParserT IOMode r e) where
    liftIO (IO a) = ParserT \fp !r eob s n rw ->
      case a rw of (# rw', a #) -> OK# rw' a s n
    {-# inline liftIO #-}
  
  instance Functor (ParserT st r e) where
    fmap f (ParserT g) = ParserT \fp !r eob s n st -> case g fp r eob s n st of
      OK# st' a s n -> let !b = f a in OK# st' b s n
      x             -> unsafeCoerce# x
    {-# inline fmap #-}
  
    (<$) a' (ParserT g) = ParserT \fp !r eob s n st -> case g fp r eob s n st of
      OK# st' _a s n -> OK# st' a' s n
      x              -> unsafeCoerce# x
    {-# inline (<$) #-}
  
  instance Applicative (ParserT st r e) where
    pure !a = ParserT \_fp !_r _eob s n st -> OK# st a s n
    {-# inline pure #-}
    ParserT ff <*> ParserT fa = ParserT \fp !r eob s n st -> case ff fp r eob s n st of
      OK# st' f s n -> case fa fp r eob s n st' of
        OK# st'' a s n -> let b = f a in OK# st'' b s n
        x              -> unsafeCoerce# x
      x             -> unsafeCoerce# x
    {-# inline (<*>) #-}
    ParserT fa <* ParserT fb = ParserT \fp !r eob s n st -> case fa fp r eob s n st of
      OK# st' a s n -> case fb fp r eob s n st' of
        OK# st'' _b s n -> OK# st'' a s n
        x               -> unsafeCoerce# x
      x             -> unsafeCoerce# x
    {-# inline (<*) #-}
    ParserT fa *> ParserT fb = ParserT \fp !r eob s n st -> case fa fp r eob s n st of
      OK# st' _a s n -> fb fp r eob s n st'
      x              -> unsafeCoerce# x
    {-# inline (*>) #-}
  
  -- | Same as `pure` for `ParserT` except that it does not force the returned value.
  pureLazy :: a -> ParserT st r e a
  pureLazy a = ParserT \_fp !_r _eob s n st -> OK# st a s n
  {-# inline pureLazy #-}
  
  instance Monad (ParserT st r e) where
    return = pure
    {-# inline return #-}
    ParserT fa >>= f = ParserT \fp !r eob s n st -> case fa fp r eob s n st of
      OK# st' a s n -> runParserT# (f a) fp r eob s n st'
      x             -> unsafeCoerce# x
    {-# inline (>>=) #-}
    (>>) = (*>)
    {-# inline (>>) #-}
  
  instance Control.Applicative.Alternative (ParserT st r e) where
    empty = ParserT \fp !r eob s n st -> Fail# st
    {-# inline empty #-}
  
    (<|>) = (<|>)
    {-# inline (Control.Applicative.<|>) #-}
  
    many (ParserT f) = ParserT go where
      go fp !r eob s n st =
          case f fp r eob s n st of
            OK# st a s n ->
              case go fp r eob s n st of
                OK# st as s n -> OK# st (a:as) s n
                x             -> x
            Fail# st'    -> OK# st [] s n
            Err# st' e   -> Err# st e
    {-# inline many #-}
  
    some p = (:) <$> p <*> Control.Applicative.many p
    {-# inline some #-}
  
  infixr 6 <|>
  -- | Choose between two parsers. If the first parser fails, try the second one,
  --   but if the first one throws an error, propagate the error. This operation
  --   can arbitrarily backtrack.
  --
  -- Note: this exported operator has different fixity than the same operator in
  -- `Control.Applicative`. Hide this operator if you want to use the
  -- `Alternative` version.
  (<|>) :: ParserT st r e a -> ParserT st r e a -> ParserT st r e a
  (<|>) (ParserT f) (ParserT g) = ParserT \fp !r eob s n st ->
    case f fp r eob s n st of
      Fail# st' -> g fp r eob s n st'
      x         -> x
  {-# inline[1] (<|>) #-}
  
  {-# RULES
  
  "flatparse/reassoc-alt" forall l m r. (l <|> m) <|> r = l <|> (m <|> r)
  
  #-}
  
  instance MonadPlus (ParserT st r e) where
    mzero = Control.Applicative.empty
    {-# inline mzero #-}
    mplus = (<|>)
    {-# inline mplus #-}
  
  --------------------------------------------------------------------------------
  
  -- | Primitive parser result wrapped with a state token.
  --
  -- You should rarely need to manipulate values of this type directly. Use the
  -- provided bidirectional pattern synonyms 'OK#', 'Fail#' and 'Err#'.
  type Res# (st :: ZeroBitType) e a =
    (# st, ResI# e a #)
  
  -- | Primitive parser result.
  type ResI# e a =
    (#
      (# a, Addr#, Int# #)
    | (# #)
    | (# e #)
    #)
  
  -- | 'Res#' constructor for a successful parse.
  --   Contains the return value, a pointer to the rest of the input buffer, and
  --   the next 'Int' state, plus a state token.
  pattern OK# :: (st :: ZeroBitType) -> a -> Addr# -> Int# -> Res# st e a
  pattern OK# st a s n = (# st, (# (# a, s, n #) | | #) #)
  
  -- | 'Res#' constructor for recoverable failure.
  --   Contains only a state token.
  pattern Fail# :: (st :: ZeroBitType) -> Res# st e a
  pattern Fail# st = (# st, (# | (# #) | #) #)
  
  -- | 'Res#' constructor for errors which are by default non-recoverable.
  --    Contains the error, plus a state token.
  pattern Err# :: (st :: ZeroBitType) -> e -> Res# st e a
  pattern Err# st e = (# st, (# | | (# e #) #) #)
  {-# complete OK#, Fail#, Err# #-}
  