    {-# LANGUAGE BangPatterns #-}
    -- |
    -- Module      :  Data.Attoparsec.ByteString.Buffer
    -- Copyright   :  Bryan O'Sullivan 2007-2015
    -- License     :  BSD3
    --
    -- Maintainer  :  bos@serpentine.com
    -- Stability   :  experimental
    -- Portability :  GHC
    --
    -- An "immutable" buffer that supports cheap appends.
    --
    -- A Buffer is divided into an immutable read-only zone, followed by a
    -- mutable area that we've preallocated, but not yet written to.
    --
    -- We overallocate at the end of a Buffer so that we can cheaply
    -- append.  Since a user of an existing Buffer cannot see past the end
    -- of its immutable zone into the data that will change during an
    -- append, this is safe.
    --
    -- Once we run out of space at the end of a Buffer, we do the usual
    -- doubling of the buffer size.
    --
    -- The fact of having a mutable buffer really helps with performance,
    -- but it does have a consequence: if someone misuses the Partial API
    -- that attoparsec uses by calling the same continuation repeatedly
    -- (which never makes sense in practice), they could overwrite data.
    --
    -- Since the API *looks* pure, it should *act* pure, too, so we use
    -- two generation counters (one mutable, one immutable) to track the
    -- number of appends to a mutable buffer. If the counters ever get out
    -- of sync, someone is appending twice to a mutable buffer, so we
    -- duplicate the entire buffer in order to preserve the immutability
    -- of its older self.
    --
    -- While we could go a step further and gain protection against API
    -- abuse on a multicore system, by use of an atomic increment
    -- instruction to bump the mutable generation counter, that would be
    -- very expensive, and feels like it would also be in the realm of the
    -- ridiculous.  Clients should never call a continuation more than
    -- once; we lack a linear type system that could enforce this; and
    -- there's only so far we should go to accommodate broken uses.

    module Data.Attoparsec.ByteString.Buffer
        (
          Buffer
        , buffer
        , unbuffer
        , pappend
        , length
        , unsafeIndex
        , substring
        , unsafeDrop
        ) where

    import Control.Exception (assert)
    import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
    import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
    import Data.Attoparsec.Internal.Compat
    import Data.List (foldl1')
    import Data.Monoid as Mon (Monoid(..))
    import Data.Semigroup (Semigroup(..))
    import Data.Word (Word8)
    import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
    import Foreign.Ptr (castPtr, plusPtr)
    import Foreign.Storable (peek, peekByteOff, poke, sizeOf)
    import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
    import Prelude hiding (length)

    -- If _cap is zero, this buffer is empty.
    data Buffer = Buf {
          Buffer -> ForeignPtr Word8
    _fp  :: {-# UNPACK #-} !(ForeignPtr Word8)
        , Buffer -> Int
    _off :: {-# UNPACK #-} !Int
        , Buffer -> Int
    _len :: {-# UNPACK #-} !Int
        , Buffer -> Int
    _cap :: {-# UNPACK #-} !Int
        , Buffer -> Int
    _gen :: {-# UNPACK #-} !Int
        }

    instance Show Buffer where
        showsPrec :: Int -> Buffer -> ShowS
    showsPrec Int
    p = Int -> ByteString -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p (ByteString -> ShowS) -> (Buffer -> ByteString) -> Buffer -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Buffer -> ByteString
    unbuffer

    -- | The initial 'Buffer' has no mutable zone, so we can avoid all
    -- copies in the (hopefully) common case of no further input being fed
    -- to us.
    buffer :: ByteString -> Buffer
    buffer :: ByteString -> Buffer
    buffer ByteString
    bs = ByteString -> (ForeignPtr Word8 -> Int -> Int -> Buffer) -> Buffer
    forall r. ByteString -> (ForeignPtr Word8 -> Int -> Int -> r) -> r
    withPS ByteString
    bs ((ForeignPtr Word8 -> Int -> Int -> Buffer) -> Buffer)
    -> (ForeignPtr Word8 -> Int -> Int -> Buffer) -> Buffer
    forall a b. (a -> b) -> a -> b
    $ \ForeignPtr Word8
    fp Int
    off Int
    len -> ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Buffer
    Buf ForeignPtr Word8
    fp Int
    off Int
    len Int
    len Int
    0

    unbuffer :: Buffer -> ByteString
    unbuffer :: Buffer -> ByteString
    unbuffer (Buf ForeignPtr Word8
    fp Int
    off Int
    len Int
    _ Int
    _) = ForeignPtr Word8 -> Int -> Int -> ByteString
    mkPS ForeignPtr Word8
    fp Int
    off Int
    len

    instance Semigroup Buffer where
        (Buf ForeignPtr Word8
    _ Int
    _ Int
    _ Int
    0 Int
    _) <> :: Buffer -> Buffer -> Buffer
    <> Buffer
    b                    = Buffer
    b
        Buffer
    a               <> (Buf ForeignPtr Word8
    _ Int
    _ Int
    _ Int
    0 Int
    _)      = Buffer
    a
        Buffer
    buf             <> (Buf ForeignPtr Word8
    fp Int
    off Int
    len Int
    _ Int
    _) = Buffer -> ForeignPtr Word8 -> Int -> Int -> Buffer
    forall a. Buffer -> ForeignPtr a -> Int -> Int -> Buffer
    append Buffer
    buf ForeignPtr Word8
    fp Int
    off Int
    len

    instance Monoid Buffer where
        mempty :: Buffer
    mempty = ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Buffer
    Buf ForeignPtr Word8
    nullForeignPtr Int
    0 Int
    0 Int
    0 Int
    0

        mappend :: Buffer -> Buffer -> Buffer
    mappend = Buffer -> Buffer -> Buffer
    forall a. Semigroup a => a -> a -> a
    (<>)

        mconcat :: [Buffer] -> Buffer
    mconcat [] = Buffer
    forall a. Monoid a => a
    Mon.mempty
        mconcat [Buffer]
    xs = (Buffer -> Buffer -> Buffer) -> [Buffer] -> Buffer
    forall a. (?callStack::CallStack) => (a -> a -> a) -> [a] -> a
    foldl1' Buffer -> Buffer -> Buffer
    forall a. Monoid a => a -> a -> a
    mappend [Buffer]
    xs

    pappend :: Buffer -> ByteString -> Buffer
    pappend :: Buffer -> ByteString -> Buffer
    pappend (Buf ForeignPtr Word8
    _ Int
    _ Int
    _ Int
    0 Int
    _) ByteString
    bs  = ByteString -> Buffer
    buffer ByteString
    bs
    pappend Buffer
    buf             ByteString
    bs  = ByteString -> (ForeignPtr Word8 -> Int -> Int -> Buffer) -> Buffer
    forall r. ByteString -> (ForeignPtr Word8 -> Int -> Int -> r) -> r
    withPS ByteString
    bs ((ForeignPtr Word8 -> Int -> Int -> Buffer) -> Buffer)
    -> (ForeignPtr Word8 -> Int -> Int -> Buffer) -> Buffer
    forall a b. (a -> b) -> a -> b
    $ \ForeignPtr Word8
    fp Int
    off Int
    len -> Buffer -> ForeignPtr Word8 -> Int -> Int -> Buffer
    forall a. Buffer -> ForeignPtr a -> Int -> Int -> Buffer
    append Buffer
    buf ForeignPtr Word8
    fp Int
    off Int
    len

    append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer
    append :: forall a. Buffer -> ForeignPtr a -> Int -> Int -> Buffer
    append (Buf ForeignPtr Word8
    fp0 Int
    off0 Int
    len0 Int
    cap0 Int
    gen0) !ForeignPtr a
    fp1 !Int
    off1 !Int
    len1 =
      IO Buffer -> Buffer
    forall a. IO a -> a
    inlinePerformIO (IO Buffer -> Buffer)
    -> ((Ptr Word8 -> IO Buffer) -> IO Buffer)
    -> (Ptr Word8 -> IO Buffer)
    -> Buffer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ForeignPtr Word8 -> (Ptr Word8 -> IO Buffer) -> IO Buffer
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fp0 ((Ptr Word8 -> IO Buffer) -> Buffer)
    -> (Ptr Word8 -> IO Buffer) -> Buffer
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr0 ->
        ForeignPtr a -> (Ptr a -> IO Buffer) -> IO Buffer
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr a
    fp1 ((Ptr a -> IO Buffer) -> IO Buffer)
    -> (Ptr a -> IO Buffer) -> IO Buffer
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr1 -> do
          let genSize :: Int
    genSize = Int -> Int
    forall a. Storable a => a -> Int
    sizeOf (Int
    0::Int)
              newlen :: Int
    newlen  = Int
    len0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len1
          gen <- if Int
    gen0 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                 then Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0
                 else Ptr Int -> IO Int
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr Word8 -> Ptr Int
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    ptr0)
          if gen == gen0 && newlen <= cap0
            then do
              let newgen = Int
    gen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
              poke (castPtr ptr0) newgen
              memcpy (ptr0 `plusPtr` (off0+len0))
                     (ptr1 `plusPtr` off1)
                     (fromIntegral len1)
              return (Buf fp0 off0 newlen cap0 newgen)
            else do
              let newcap = Int
    newlen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2
              fp <- mallocPlainForeignPtrBytes (newcap + genSize)
              withForeignPtr fp $ \Ptr Word8
    ptr_ -> do
                let ptr :: Ptr b
    ptr    = Ptr Word8
    ptr_ Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    genSize
                    newgen :: Int
    newgen = Int
    1
                Ptr Int -> Int -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8 -> Ptr Int
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    ptr_) Int
    newgen
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memcpy Ptr Word8
    forall {b}. Ptr b
    ptr (Ptr Word8
    ptr0 Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off0) (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len0)
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memcpy (Ptr (ZonkAny 0)
    forall {b}. Ptr b
    ptr Ptr (ZonkAny 0) -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    len0) (Ptr a
    ptr1 Ptr a -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off1)
                       (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len1)
                Buffer -> IO Buffer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Buffer
    Buf ForeignPtr Word8
    fp Int
    genSize Int
    newlen Int
    newcap Int
    newgen)

    length :: Buffer -> Int
    length :: Buffer -> Int
    length (Buf ForeignPtr Word8
    _ Int
    _ Int
    len Int
    _ Int
    _) = Int
    len
    {-# INLINE length #-}

    unsafeIndex :: Buffer -> Int -> Word8
    unsafeIndex :: Buffer -> Int -> Word8
    unsafeIndex (Buf ForeignPtr Word8
    fp Int
    off Int
    len Int
    _ Int
    _) Int
    i = Bool -> Word8 -> Word8
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len) (Word8 -> Word8)
    -> ((Ptr Word8 -> IO Word8) -> Word8)
    -> (Ptr Word8 -> IO Word8)
    -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        IO Word8 -> Word8
    forall a. IO a -> a
    inlinePerformIO (IO Word8 -> Word8)
    -> ((Ptr Word8 -> IO Word8) -> IO Word8)
    -> (Ptr Word8 -> IO Word8)
    -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fp ((Ptr Word8 -> IO Word8) -> Word8)
    -> (Ptr Word8 -> IO Word8) -> Word8
    forall a b. (a -> b) -> a -> b
    $ (Ptr Word8 -> Int -> IO Word8) -> Int -> Ptr Word8 -> IO Word8
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Ptr Word8 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    i)
    {-# INLINE unsafeIndex #-}

    substring :: Int -> Int -> Buffer -> ByteString
    substring :: Int -> Int -> Buffer -> ByteString
    substring Int
    s Int
    l (Buf ForeignPtr Word8
    fp Int
    off Int
    len Int
    _ Int
    _) =
      Bool -> ByteString -> ByteString
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    len) (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Bool -> ByteString -> ByteString
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    s) (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      ForeignPtr Word8 -> Int -> Int -> ByteString
    mkPS ForeignPtr Word8
    fp (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    s) Int
    l
    {-# INLINE substring #-}

    unsafeDrop :: Int -> Buffer -> ByteString
    unsafeDrop :: Int -> Buffer -> ByteString
    unsafeDrop Int
    s (Buf ForeignPtr Word8
    fp Int
    off Int
    len Int
    _ Int
    _) =
      Bool -> ByteString -> ByteString
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    len) (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      ForeignPtr Word8 -> Int -> Int -> ByteString
    mkPS ForeignPtr Word8
    fp (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    s) (Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    s)
    {-# INLINE unsafeDrop #-}