    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 702
    {-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe
    #endif
    {-# LANGUAGE BangPatterns #-}

    -- |
    -- Module      :  Data.Attoparsec.Zepto
    -- Copyright   :  Bryan O'Sullivan 2007-2015
    -- License     :  BSD3
    --
    -- Maintainer  :  bos@serpentine.com
    -- Stability   :  experimental
    -- Portability :  unknown
    --
    -- A tiny, highly specialized combinator parser for 'B.ByteString'
    -- strings.
    --
    -- While the main attoparsec module generally performs well, this
    -- module is particularly fast for simple non-recursive loops that
    -- should not normally result in failed parses.
    --
    -- /Warning/: on more complex inputs involving recursion or failure,
    -- parsers based on this module may be as much as /ten times slower/
    -- than regular attoparsec! You should /only/ use this module when you
    -- have benchmarks that prove that its use speeds your code up.
    module Data.Attoparsec.Zepto
        (
          Parser
        , ZeptoT
        , parse
        , parseT
        , atEnd
        , string
        , take
        , takeWhile
        ) where

    import Control.Applicative
    import Control.Monad (MonadPlus(..), ap)
    import qualified Control.Monad.Fail as Fail
    import Control.Monad.IO.Class (MonadIO(..))
    import Data.ByteString (ByteString)
    import Data.Functor.Identity (Identity(runIdentity))
    import Data.Monoid as Mon (Monoid(..))
    import Data.Semigroup (Semigroup(..))
    import Data.Word (Word8)
    import Prelude hiding (take, takeWhile)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Unsafe as B

    newtype S = S {
          S -> ByteString
    input :: ByteString
        }

    data Result a = Fail String
                  | OK !a S

    -- | A simple parser.
    --
    -- This monad is strict in its state, and the monadic bind operator
    -- ('>>=') evaluates each result to weak head normal form before
    -- passing it along.
    newtype ZeptoT m a = Parser {
          forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser :: S -> m (Result a)
        }

    type Parser a = ZeptoT Identity a

    instance Monad m => Functor (ZeptoT m) where
        fmap :: forall a b. (a -> b) -> ZeptoT m a -> ZeptoT m b
    fmap a -> b
    f ZeptoT m a
    m = (S -> m (Result b)) -> ZeptoT m b
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result b)) -> ZeptoT m b)
    -> (S -> m (Result b)) -> ZeptoT m b
    forall a b. (a -> b) -> a -> b
    $ \S
    s -> do
          result <- ZeptoT m a -> S -> m (Result a)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser ZeptoT m a
    m S
    s
          case result of
            OK a
    a S
    s'  -> Result b -> m (Result b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> S -> Result b
    forall a. a -> S -> Result a
    OK (a -> b
    f a
    a) S
    s')
            Fail String
    err -> Result b -> m (Result b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Result b
    forall a. String -> Result a
    Fail String
    err)
        {-# INLINE fmap #-}

    instance MonadIO m => MonadIO (ZeptoT m) where
      liftIO :: forall a. IO a -> ZeptoT m a
    liftIO IO a
    act = (S -> m (Result a)) -> ZeptoT m a
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result a)) -> ZeptoT m a)
    -> (S -> m (Result a)) -> ZeptoT m a
    forall a b. (a -> b) -> a -> b
    $ \S
    s -> do
        result <- IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO a
    act
        return (OK result s)
      {-# INLINE liftIO #-}

    instance Monad m => Monad (ZeptoT m) where
        return :: forall a. a -> ZeptoT m a
    return = a -> ZeptoT m a
    forall a. a -> ZeptoT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        {-# INLINE return #-}

        ZeptoT m a
    m >>= :: forall a b. ZeptoT m a -> (a -> ZeptoT m b) -> ZeptoT m b
    >>= a -> ZeptoT m b
    k   = (S -> m (Result b)) -> ZeptoT m b
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result b)) -> ZeptoT m b)
    -> (S -> m (Result b)) -> ZeptoT m b
    forall a b. (a -> b) -> a -> b
    $ \S
    s -> do
          result <- ZeptoT m a -> S -> m (Result a)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser ZeptoT m a
    m S
    s
          case result of
            OK a
    a S
    s'  -> ZeptoT m b -> S -> m (Result b)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser (a -> ZeptoT m b
    k a
    a) S
    s'
            Fail String
    err -> Result b -> m (Result b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Result b
    forall a. String -> Result a
    Fail String
    err)
        {-# INLINE (>>=) #-}

    #if !(MIN_VERSION_base(4,13,0))
        fail = Fail.fail
        {-# INLINE fail #-}
    #endif

    instance Monad m => Fail.MonadFail (ZeptoT m) where
        fail :: forall a. String -> ZeptoT m a
    fail String
    msg = (S -> m (Result a)) -> ZeptoT m a
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result a)) -> ZeptoT m a)
    -> (S -> m (Result a)) -> ZeptoT m a
    forall a b. (a -> b) -> a -> b
    $ \S
    _ -> Result a -> m (Result a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Result a
    forall a. String -> Result a
    Fail String
    msg)
        {-# INLINE fail #-}

    instance Monad m => MonadPlus (ZeptoT m) where
        mzero :: forall a. ZeptoT m a
    mzero = String -> ZeptoT m a
    forall a. String -> ZeptoT m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "mzero"
        {-# INLINE mzero #-}

        mplus :: forall a. ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    mplus ZeptoT m a
    a ZeptoT m a
    b = (S -> m (Result a)) -> ZeptoT m a
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result a)) -> ZeptoT m a)
    -> (S -> m (Result a)) -> ZeptoT m a
    forall a b. (a -> b) -> a -> b
    $ \S
    s -> do
          result <- ZeptoT m a -> S -> m (Result a)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser ZeptoT m a
    a S
    s
          case result of
            ok :: Result a
    ok@(OK a
    _ S
    _) -> Result a -> m (Result a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result a
    ok
            Result a
    _           -> ZeptoT m a -> S -> m (Result a)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser ZeptoT m a
    b S
    s
        {-# INLINE mplus #-}

    instance (Monad m) => Applicative (ZeptoT m) where
        pure :: forall a. a -> ZeptoT m a
    pure a
    a = (S -> m (Result a)) -> ZeptoT m a
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result a)) -> ZeptoT m a)
    -> (S -> m (Result a)) -> ZeptoT m a
    forall a b. (a -> b) -> a -> b
    $ \S
    s -> Result a -> m (Result a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> S -> Result a
    forall a. a -> S -> Result a
    OK a
    a S
    s)
        {-# INLINE pure #-}
        <*> :: forall a b. ZeptoT m (a -> b) -> ZeptoT m a -> ZeptoT m b
    (<*>)  = ZeptoT m (a -> b) -> ZeptoT m a -> ZeptoT m b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
        {-# INLINE (<*>) #-}

    gets :: Monad m => (S -> a) -> ZeptoT m a
    gets :: forall (m :: * -> *) a. Monad m => (S -> a) -> ZeptoT m a
    gets S -> a
    f = (S -> m (Result a)) -> ZeptoT m a
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result a)) -> ZeptoT m a)
    -> (S -> m (Result a)) -> ZeptoT m a
    forall a b. (a -> b) -> a -> b
    $ \S
    s -> Result a -> m (Result a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> S -> Result a
    forall a. a -> S -> Result a
    OK (S -> a
    f S
    s) S
    s)
    {-# INLINE gets #-}

    put :: Monad m => S -> ZeptoT m ()
    put :: forall (m :: * -> *). Monad m => S -> ZeptoT m ()
    put S
    s = (S -> m (Result ())) -> ZeptoT m ()
    forall (m :: * -> *) a. (S -> m (Result a)) -> ZeptoT m a
    Parser ((S -> m (Result ())) -> ZeptoT m ())
    -> (S -> m (Result ())) -> ZeptoT m ()
    forall a b. (a -> b) -> a -> b
    $ \S
    _ -> Result () -> m (Result ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> S -> Result ()
    forall a. a -> S -> Result a
    OK () S
    s)
    {-# INLINE put #-}

    -- | Run a parser.
    parse :: Parser a -> ByteString -> Either String a
    parse :: forall a. Parser a -> ByteString -> Either String a
    parse Parser a
    p ByteString
    bs = case Identity (Result a) -> Result a
    forall a. Identity a -> a
    runIdentity (Parser a -> S -> Identity (Result a)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser Parser a
    p (ByteString -> S
    S ByteString
    bs)) of
                   (OK a
    a S
    _)   -> a -> Either String a
    forall a b. b -> Either a b
    Right a
    a
                   (Fail String
    err) -> String -> Either String a
    forall a b. a -> Either a b
    Left String
    err
    {-# INLINE parse #-}

    -- | Run a parser on top of the given base monad.
    parseT :: Monad m => ZeptoT m a -> ByteString -> m (Either String a)
    parseT :: forall (m :: * -> *) a.
    Monad m =>
    ZeptoT m a -> ByteString -> m (Either String a)
    parseT ZeptoT m a
    p ByteString
    bs = do
      result <- ZeptoT m a -> S -> m (Result a)
    forall (m :: * -> *) a. ZeptoT m a -> S -> m (Result a)
    runParser ZeptoT m a
    p (ByteString -> S
    S ByteString
    bs)
      case result of
        OK a
    a S
    _   -> Either String a -> m (Either String a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Either String a
    forall a b. b -> Either a b
    Right a
    a)
        Fail String
    err -> Either String a -> m (Either String a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String a
    forall a b. a -> Either a b
    Left String
    err)
    {-# INLINE parseT #-}

    instance Monad m => Semigroup (ZeptoT m a) where
        <> :: ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    (<>) = ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    forall a. ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    mplus
        {-# INLINE (<>) #-}

    instance Monad m => Mon.Monoid (ZeptoT m a) where
        mempty :: ZeptoT m a
    mempty  = String -> ZeptoT m a
    forall a. String -> ZeptoT m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "mempty"
        {-# INLINE mempty #-}
        mappend :: ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    mappend = ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    forall a. Semigroup a => a -> a -> a
    (<>)
        {-# INLINE mappend #-}

    instance Monad m => Alternative (ZeptoT m) where
        empty :: forall a. ZeptoT m a
    empty = String -> ZeptoT m a
    forall a. String -> ZeptoT m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "empty"
        {-# INLINE empty #-}
        <|> :: forall a. ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    (<|>) = ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    forall a. ZeptoT m a -> ZeptoT m a -> ZeptoT m a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    mplus
        {-# INLINE (<|>) #-}

    -- | Consume input while the predicate returns 'True'.
    takeWhile :: Monad m => (Word8 -> Bool) -> ZeptoT m ByteString
    takeWhile :: forall (m :: * -> *).
    Monad m =>
    (Word8 -> Bool) -> ZeptoT m ByteString
    takeWhile Word8 -> Bool
    p = do
      (h,t) <- (S -> (ByteString, ByteString))
    -> ZeptoT m (ByteString, ByteString)
    forall (m :: * -> *) a. Monad m => (S -> a) -> ZeptoT m a
    gets ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    B.span Word8 -> Bool
    p (ByteString -> (ByteString, ByteString))
    -> (S -> ByteString) -> S -> (ByteString, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . S -> ByteString
    input)
      put (S t)
      return h
    {-# INLINE takeWhile #-}

    -- | Consume @n@ bytes of input.
    take :: Monad m => Int -> ZeptoT m ByteString
    take :: forall (m :: * -> *). Monad m => Int -> ZeptoT m ByteString
    take !Int
    n = do
      s <- (S -> ByteString) -> ZeptoT m ByteString
    forall (m :: * -> *) a. Monad m => (S -> a) -> ZeptoT m a
    gets S -> ByteString
    input
      if B.length s >= n
        then put (S (B.unsafeDrop n s)) >> return (B.unsafeTake n s)
        else fail "insufficient input"
    {-# INLINE take #-}

    -- | Match a string exactly.
    string :: Monad m => ByteString -> ZeptoT m ()
    string :: forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
    string ByteString
    s = do
      i <- (S -> ByteString) -> ZeptoT m ByteString
    forall (m :: * -> *) a. Monad m => (S -> a) -> ZeptoT m a
    gets S -> ByteString
    input
      if s `B.isPrefixOf` i
        then put (S (B.unsafeDrop (B.length s) i)) >> return ()
        else fail "string"
    {-# INLINE string #-}

    -- | Indicate whether the end of the input has been reached.
    atEnd :: Monad m => ZeptoT m Bool
    atEnd :: forall (m :: * -> *). Monad m => ZeptoT m Bool
    atEnd = do
      i <- (S -> ByteString) -> ZeptoT m ByteString
    forall (m :: * -> *) a. Monad m => (S -> a) -> ZeptoT m a
    gets S -> ByteString
    input
      return $! B.null i
    {-# INLINE atEnd #-}