    {-# LANGUAGE Trustworthy, BangPatterns #-}
    {-# LANGUAGE CPP, NoImplicitPrelude #-}
    {-# OPTIONS_GHC -funbox-strict-fields #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.IO.Buffer
    -- Copyright   :  (c) The University of Glasgow 2008
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  cvs-ghc@haskell.org
    -- Stability   :  internal
    -- Portability :  non-portable (GHC Extensions)
    --
    -- Buffers used in the IO system
    --
    -----------------------------------------------------------------------------

    module GHC.IO.Buffer (
        -- * Buffers of any element
        Buffer(..), BufferState(..), CharBuffer, CharBufElem,

        -- ** Creation
        newByteBuffer,
        newCharBuffer,
        newBuffer,
        emptyBuffer,

        -- ** Insertion/removal
        bufferRemove,
        bufferAdd,
        slideContents,
        bufferAdjustL,
        bufferAddOffset,
        bufferAdjustOffset,

        -- ** Inspecting
        isEmptyBuffer,
        isFullBuffer,
        isFullCharBuffer,
        isWriteBuffer,
        bufferElems,
        bufferAvailable,
        bufferOffset,
        summaryBuffer,

        -- ** Operating on the raw buffer as a Ptr
        withBuffer,
        withRawBuffer,

        -- ** Assertions
        checkBuffer,

        -- * Raw buffers
        RawBuffer,
        readWord8Buf,
        writeWord8Buf,
        RawCharBuffer,
        peekCharBuf,
        readCharBuf,
        writeCharBuf,
        readCharBufPtr,
        writeCharBufPtr,
        charSize,
     ) where

    import GHC.Base
    -- import GHC.IO
    import GHC.Num
    import GHC.Ptr
    import GHC.Word
    import GHC.Show
    import GHC.Real
    import GHC.List
    import GHC.ForeignPtr  (unsafeWithForeignPtr)
    import Foreign.C.Types
    import Foreign.ForeignPtr
    import Foreign.Storable

    -- Char buffers use either UTF-16 or UTF-32, with the endianness matching
    -- the endianness of the host.
    --
    -- Invariants:
    --   * a Char buffer consists of *valid* UTF-16 or UTF-32
    --   * only whole characters: no partial surrogate pairs

    #define CHARBUF_UTF32

    -- #define CHARBUF_UTF16
    --
    -- NB. it won't work to just change this to CHARBUF_UTF16.  Some of
    -- the code to make this work is there, and it has been tested with
    -- the Iconv codec, but there are some pieces that are known to be
    -- broken.  In particular, the built-in codecs
    -- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or
    -- similar in place of the ow >= os comparisons.
    --
    -- Tamar: We need to do this eventually for Windows, as we have to re-encode
    -- the text as UTF-16 anyway, so if we can avoid it it would be great.

    -- ---------------------------------------------------------------------------
    -- Raw blocks of data

    type RawBuffer e = ForeignPtr e

    readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8
    readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8
    readWord8Buf RawBuffer Word8
    fp Int
    ix = RawBuffer Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr RawBuffer Word8
    fp ((Ptr Word8 -> IO Word8) -> IO Word8)
    -> (Ptr Word8 -> IO Word8) -> IO Word8
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p -> Ptr Word8 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Word8
    p Int
    ix

    writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    fp Int
    ix Word8
    w = RawBuffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr RawBuffer Word8
    fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p -> Ptr Word8 -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr Word8
    p Int
    ix Word8
    w

    #if defined(CHARBUF_UTF16)
    type CharBufElem = Word16
    #else
    type CharBufElem = Char
    #endif

    type RawCharBuffer = RawBuffer CharBufElem

    peekCharBuf :: RawCharBuffer -> Int -> IO Char
    peekCharBuf :: RawCharBuffer -> Int -> IO Char
    peekCharBuf RawCharBuffer
    arr Int
    ix = RawCharBuffer -> (Ptr Char -> IO Char) -> IO Char
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr RawCharBuffer
    arr ((Ptr Char -> IO Char) -> IO Char)
    -> (Ptr Char -> IO Char) -> IO Char
    forall a b. (a -> b) -> a -> b
    $ \Ptr Char
    p -> do
                            (Char
    c,Int
    _) <- Ptr Char -> Int -> IO (Char, Int)
    readCharBufPtr Ptr Char
    p Int
    ix
                            Char -> IO Char
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Char
    c

    {-# INLINE readCharBuf #-}
    readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
    readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
    readCharBuf RawCharBuffer
    arr Int
    ix = RawCharBuffer -> (Ptr Char -> IO (Char, Int)) -> IO (Char, Int)
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr RawCharBuffer
    arr ((Ptr Char -> IO (Char, Int)) -> IO (Char, Int))
    -> (Ptr Char -> IO (Char, Int)) -> IO (Char, Int)
    forall a b. (a -> b) -> a -> b
    $ \Ptr Char
    p -> Ptr Char -> Int -> IO (Char, Int)
    readCharBufPtr Ptr Char
    p Int
    ix

    {-# INLINE writeCharBuf #-}
    writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
    writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
    writeCharBuf RawCharBuffer
    arr Int
    ix Char
    c = RawCharBuffer -> (Ptr Char -> IO Int) -> IO Int
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr RawCharBuffer
    arr ((Ptr Char -> IO Int) -> IO Int) -> (Ptr Char -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Ptr Char
    p -> Ptr Char -> Int -> Char -> IO Int
    writeCharBufPtr Ptr Char
    p Int
    ix Char
    c

    {-# INLINE readCharBufPtr #-}
    readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)
    #if defined(CHARBUF_UTF16)
    readCharBufPtr p ix = do
      c1 <- peekElemOff p ix
      if (c1 < 0xd800 || c1 > 0xdbff)
         then return (chr (fromIntegral c1), ix+1)
         else do c2 <- peekElemOff p (ix+1)
                 return (unsafeChr ((fromIntegral c1 - 0xd800)*0x400 +
                                    (fromIntegral c2 - 0xdc00) + 0x10000), ix+2)
    #else
    readCharBufPtr :: Ptr Char -> Int -> IO (Char, Int)
    readCharBufPtr Ptr Char
    p Int
    ix = do Char
    c <- Ptr Char -> Int -> IO Char
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff (Ptr Char -> Ptr Char
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Char
    p) Int
    ix; (Char, Int) -> IO (Char, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    c, Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
    #endif

    {-# INLINE writeCharBufPtr #-}
    writeCharBufPtr :: Ptr CharBufElem -> Int -> Char -> IO Int
    #if defined(CHARBUF_UTF16)
    writeCharBufPtr p ix ch
      | c < 0x10000 = do pokeElemOff p ix (fromIntegral c)
                         return (ix+1)
      | otherwise   = do let c' = c - 0x10000
                         pokeElemOff p ix (fromIntegral (c' `div` 0x400 + 0xd800))
                         pokeElemOff p (ix+1) (fromIntegral (c' `mod` 0x400 + 0xdc00))
                         return (ix+2)
      where
        c = ord ch
    #else
    writeCharBufPtr :: Ptr Char -> Int -> Char -> IO Int
    writeCharBufPtr Ptr Char
    p Int
    ix Char
    ch = do Ptr Char -> Int -> Char -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff (Ptr Char -> Ptr Char
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Char
    p) Int
    ix Char
    ch; Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
    #endif

    charSize :: Int
    #if defined(CHARBUF_UTF16)
    charSize = 2
    #else
    charSize :: Int
    charSize = Int
    4
    #endif

    -- ---------------------------------------------------------------------------
    -- Buffers

    -- | A mutable array of bytes that can be passed to foreign functions.
    --
    -- The buffer is represented by a record, where the record contains
    -- the raw buffer and the start/end points of the filled portion.  The
    -- buffer contents itself is mutable, but the rest of the record is
    -- immutable.  This is a slightly odd mix, but it turns out to be
    -- quite practical: by making all the buffer metadata immutable, we
    -- can have operations on buffer metadata outside of the IO monad.
    --
    -- The "live" elements of the buffer are those between the 'bufL' and
    -- 'bufR' offsets.  In an empty buffer, 'bufL' is equal to 'bufR', but
    -- they might not be zero: for example, the buffer might correspond to
    -- a memory-mapped file and in which case 'bufL' will point to the
    -- next location to be written, which is not necessarily the beginning
    -- of the file.
    --
    -- On Posix systems the I/O manager has an implicit reliance on doing a file
    -- read moving the file pointer.  However on Windows async operations the kernel
    -- object representing a file does not use the file pointer offset.  Logically
    -- this makes sense since operations can be performed in any arbitrary order.
    -- OVERLAPPED operations don't respect the file pointer offset as their
    -- intention is to support arbitrary async reads to anywhere at a much lower
    -- level.  As such we should explicitly keep track of the file offsets of the
    -- target in the buffer.  Any operation to seek should also update this entry.
    --
    -- In order to keep us sane we try to uphold the invariant that any function
    -- being passed a Handle is responsible for updating the handles offset unless
    -- other behaviour is documented.
    data Buffer e
      = Buffer {
            forall e. Buffer e -> RawBuffer e
    bufRaw    :: !(RawBuffer e),
            forall e. Buffer e -> BufferState
    bufState  :: BufferState,
            forall e. Buffer e -> Int
    bufSize   :: !Int,          -- in elements, not bytes
            forall e. Buffer e -> Word64
    bufOffset :: !Word64,       -- start location for next read/write
            forall e. Buffer e -> Int
    bufL      :: !Int,          -- offset of first item in the buffer
            forall e. Buffer e -> Int
    bufR      :: !Int           -- offset of last item + 1
      }

    #if defined(CHARBUF_UTF16)
    type CharBuffer = Buffer Word16
    #else
    type CharBuffer = Buffer Char
    #endif

    data BufferState = ReadBuffer | WriteBuffer
      deriving BufferState -> BufferState -> Bool
    (BufferState -> BufferState -> Bool)
    -> (BufferState -> BufferState -> Bool) -> Eq BufferState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BufferState -> BufferState -> Bool
    == :: BufferState -> BufferState -> Bool
    $c/= :: BufferState -> BufferState -> Bool
    /= :: BufferState -> BufferState -> Bool
    Eq -- ^ @since 4.2.0.0

    withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a
    withBuffer :: forall e a. Buffer e -> (Ptr e -> IO a) -> IO a
    withBuffer Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer e
    raw } Ptr e -> IO a
    f = RawBuffer e -> (Ptr e -> IO a) -> IO a
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr (RawBuffer e -> RawBuffer e
    forall a b. ForeignPtr a -> ForeignPtr b
    castForeignPtr RawBuffer e
    raw) Ptr e -> IO a
    f

    withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a
    withRawBuffer :: forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withRawBuffer RawBuffer e
    raw Ptr e -> IO a
    f = RawBuffer e -> (Ptr e -> IO a) -> IO a
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr (RawBuffer e -> RawBuffer e
    forall a b. ForeignPtr a -> ForeignPtr b
    castForeignPtr RawBuffer e
    raw) Ptr e -> IO a
    f

    isEmptyBuffer :: Buffer e -> Bool
    isEmptyBuffer :: forall e. Buffer e -> Bool
    isEmptyBuffer Buffer{ bufL :: forall e. Buffer e -> Int
    bufL=Int
    l, bufR :: forall e. Buffer e -> Int
    bufR=Int
    r } = Int
    l Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    r

    isFullBuffer :: Buffer e -> Bool
    isFullBuffer :: forall e. Buffer e -> Bool
    isFullBuffer Buffer{ bufR :: forall e. Buffer e -> Int
    bufR=Int
    w, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    s } = Int
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    w

    -- if a Char buffer does not have room for a surrogate pair, it is "full"
    isFullCharBuffer :: Buffer e -> Bool
    #if defined(CHARBUF_UTF16)
    isFullCharBuffer buf = bufferAvailable buf < 2
    #else
    isFullCharBuffer :: forall e. Buffer e -> Bool
    isFullCharBuffer = Buffer e -> Bool
    forall e. Buffer e -> Bool
    isFullBuffer
    #endif

    isWriteBuffer :: Buffer e -> Bool
    isWriteBuffer :: forall e. Buffer e -> Bool
    isWriteBuffer Buffer e
    buf = case Buffer e -> BufferState
    forall e. Buffer e -> BufferState
    bufState Buffer e
    buf of
                            BufferState
    WriteBuffer -> Bool
    True
                            BufferState
    ReadBuffer  -> Bool
    False

    bufferElems :: Buffer e -> Int
    bufferElems :: forall e. Buffer e -> Int
    bufferElems Buffer{ bufR :: forall e. Buffer e -> Int
    bufR=Int
    w, bufL :: forall e. Buffer e -> Int
    bufL=Int
    r } = Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    r

    bufferAvailable :: Buffer e -> Int
    bufferAvailable :: forall e. Buffer e -> Int
    bufferAvailable Buffer{ bufR :: forall e. Buffer e -> Int
    bufR=Int
    w, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    s } = Int
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    w

    bufferRemove :: Int -> Buffer e -> Buffer e
    bufferRemove :: forall e. Int -> Buffer e -> Buffer e
    bufferRemove Int
    i buf :: Buffer e
    buf@Buffer{ bufL :: forall e. Buffer e -> Int
    bufL=Int
    r } = Int -> Buffer e -> Buffer e
    forall e. Int -> Buffer e -> Buffer e
    bufferAdjustL (Int
    rInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    i) Buffer e
    buf

    bufferAdjustL :: Int -> Buffer e -> Buffer e
    bufferAdjustL :: forall e. Int -> Buffer e -> Buffer e
    bufferAdjustL Int
    l buf :: Buffer e
    buf@Buffer{ bufR :: forall e. Buffer e -> Int
    bufR=Int
    w }
      | Int
    l Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    w    = Buffer e
    buf{ bufL=0, bufR=0 }
      | Bool
    otherwise = Buffer e
    buf{ bufL=l, bufR=w }

    bufferAdd :: Int -> Buffer e -> Buffer e
    bufferAdd :: forall e. Int -> Buffer e -> Buffer e
    bufferAdd Int
    i buf :: Buffer e
    buf@Buffer{ bufR :: forall e. Buffer e -> Int
    bufR=Int
    w } = Buffer e
    buf{ bufR=w+i }

    bufferOffset :: Buffer e -> Word64
    bufferOffset :: forall e. Buffer e -> Word64
    bufferOffset Buffer{ bufOffset :: forall e. Buffer e -> Word64
    bufOffset=Word64
    off } = Word64
    off

    bufferAdjustOffset :: Word64 -> Buffer e -> Buffer e
    bufferAdjustOffset :: forall e. Word64 -> Buffer e -> Buffer e
    bufferAdjustOffset Word64
    offs Buffer e
    buf = Buffer e
    buf{ bufOffset=offs }

    -- The adjustment to the offset can be 32bit int on 32 platforms.
    -- This is fine, we only use this after reading into/writing from
    -- the buffer so we will never overflow here.
    bufferAddOffset :: Int -> Buffer e -> Buffer e
    bufferAddOffset :: forall e. Int -> Buffer e -> Buffer e
    bufferAddOffset Int
    offs buf :: Buffer e
    buf@Buffer{ bufOffset :: forall e. Buffer e -> Word64
    bufOffset=Word64
    w } =
      Buffer e
    buf{ bufOffset=w+(fromIntegral offs) }

    emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e
    emptyBuffer :: forall e. RawBuffer e -> Int -> BufferState -> Buffer e
    emptyBuffer RawBuffer e
    raw Int
    sz BufferState
    state =
      Buffer{ bufRaw :: RawBuffer e
    bufRaw=RawBuffer e
    raw, bufState :: BufferState
    bufState=BufferState
    state, bufOffset :: Word64
    bufOffset=Word64
    0, bufR :: Int
    bufR=Int
    0, bufL :: Int
    bufL=Int
    0, bufSize :: Int
    bufSize=Int
    sz }

    newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)
    newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)
    newByteBuffer Int
    c BufferState
    st = Int -> Int -> BufferState -> IO (Buffer Word8)
    forall e. Int -> Int -> BufferState -> IO (Buffer e)
    newBuffer Int
    c Int
    c BufferState
    st

    newCharBuffer :: Int -> BufferState -> IO CharBuffer
    newCharBuffer :: Int -> BufferState -> IO CharBuffer
    newCharBuffer Int
    c BufferState
    st = Int -> Int -> BufferState -> IO CharBuffer
    forall e. Int -> Int -> BufferState -> IO (Buffer e)
    newBuffer (Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    charSize) Int
    c BufferState
    st

    newBuffer :: Int -> Int -> BufferState -> IO (Buffer e)
    newBuffer :: forall e. Int -> Int -> BufferState -> IO (Buffer e)
    newBuffer Int
    bytes Int
    sz BufferState
    state = do
      ForeignPtr e
    fp <- Int -> IO (ForeignPtr e)
    forall a. Int -> IO (ForeignPtr a)
    mallocForeignPtrBytes Int
    bytes
      Buffer e -> IO (Buffer e)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ForeignPtr e -> Int -> BufferState -> Buffer e
    forall e. RawBuffer e -> Int -> BufferState -> Buffer e
    emptyBuffer ForeignPtr e
    fp Int
    sz BufferState
    state)

    -- | slides the contents of the buffer to the beginning
    slideContents :: Buffer Word8 -> IO (Buffer Word8)
    slideContents :: Buffer Word8 -> IO (Buffer Word8)
    slideContents buf :: Buffer Word8
    buf@Buffer{ bufL :: forall e. Buffer e -> Int
    bufL=Int
    l, bufR :: forall e. Buffer e -> Int
    bufR=Int
    r, bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Word8
    raw } = do
      let elems :: Int
    elems = Int
    r Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    l
      RawBuffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withRawBuffer RawBuffer Word8
    raw ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p ->
          do Ptr Word8
    _ <- Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
    forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    memmove Ptr Word8
    p (Ptr Word8
    p Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    l) (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    elems)
             () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      Buffer Word8 -> IO (Buffer Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Buffer Word8
    buf{ bufL=0, bufR=elems }

    foreign import ccall unsafe "memmove"
       memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)

    summaryBuffer :: Buffer a -> String
    summaryBuffer :: forall a. Buffer a -> String
    summaryBuffer !Buffer a
    buf  -- Strict => slightly better code
       = String -> String
    ppr (RawBuffer a -> String
    forall a. Show a => a -> String
    show (RawBuffer a -> String) -> RawBuffer a -> String
    forall a b. (a -> b) -> a -> b
    $ Buffer a -> RawBuffer a
    forall e. Buffer e -> RawBuffer e
    bufRaw Buffer a
    buf) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "@buf" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Buffer a -> Int
    forall e. Buffer e -> Int
    bufSize Buffer a
    buf)
       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Buffer a -> Int
    forall e. Buffer e -> Int
    bufL Buffer a
    buf) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Buffer a -> Int
    forall e. Buffer e -> Int
    bufR Buffer a
    buf) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (>=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> String
    forall a. Show a => a -> String
    show (Buffer a -> Word64
    forall e. Buffer e -> Word64
    bufOffset Buffer a
    buf) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
      where ppr :: String -> String
            ppr :: String -> String
    ppr (Char
    '0':Char
    'x':String
    xs) = let p :: String
    p = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '0') String
    xs
                               in if String -> Bool
    forall a. [a] -> Bool
    null String
    p then String
    "0x0" else Char
    '0'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Char
    'x'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    p
            ppr String
    x = String
    x

    -- Note [INVARIANTS on Buffers]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --   * r <= w
    --   * if r == w, and the buffer is for reading, then r == 0 && w == 0
    --   * a write buffer is never full.  If an operation
    --     fills up the buffer, it will always flush it before
    --     returning.
    --   * a read buffer may be full as a result of hLookAhead.  In normal
    --     operation, a read buffer always has at least one character of space.

    checkBuffer :: Buffer a -> IO ()
    checkBuffer :: forall a. Buffer a -> IO ()
    checkBuffer buf :: Buffer a
    buf@Buffer{ bufState :: forall e. Buffer e -> BufferState
    bufState = BufferState
    state, bufL :: forall e. Buffer e -> Int
    bufL=Int
    r, bufR :: forall e. Buffer e -> Int
    bufR=Int
    w, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    size } =
         Buffer a -> Bool -> IO ()
    forall a. Buffer a -> Bool -> IO ()
    check Buffer a
    buf (
            Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
            Bool -> Bool -> Bool
    && Int
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    w
            Bool -> Bool -> Bool
    && Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    size
            Bool -> Bool -> Bool
    && ( Int
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    w Bool -> Bool -> Bool
    || BufferState
    state BufferState -> BufferState -> Bool
    forall a. Eq a => a -> a -> Bool
    == BufferState
    WriteBuffer Bool -> Bool -> Bool
    || (Int
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) )
            Bool -> Bool -> Bool
    && ( BufferState
    state BufferState -> BufferState -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BufferState
    WriteBuffer Bool -> Bool -> Bool
    || Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    size ) -- write buffer is never full
          )

    check :: Buffer a -> Bool -> IO ()
    check :: forall a. Buffer a -> Bool -> IO ()
    check Buffer a
    _   Bool
    True  = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    check Buffer a
    buf Bool
    False = String -> IO ()
    forall a. String -> a
    errorWithoutStackTrace (String
    "buffer invariant violation: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Buffer a -> String
    forall a. Buffer a -> String
    summaryBuffer Buffer a
    buf)