    {-# LANGUAGE FlexibleInstances,FlexibleContexts,MultiParamTypeClasses,CPP #-}
    module Data.Encoding.ByteSink where

    import Data.Encoding.Exception

    import Data.Binary.Put
    import Data.Bits
    import Data.Char
    import Data.Sequence
    import Data.Word
    import Data.Foldable (toList)
    import Control.Throws
    import Control.Exception.Extensible
    import Control.Applicative
    import Control.Monad (ap, liftM)
    import Control.Monad.IO.Class (liftIO)
    import Control.Monad.State (StateT, modify)
    import Control.Monad.Reader (ReaderT, ask)
    import Foreign.Ptr (Ptr,plusPtr,minusPtr)
    import Foreign.Marshal.Alloc (mallocBytes,reallocBytes,free)
    import Foreign.Storable (poke)
    import System.IO
    import System.IO.Unsafe (unsafePerformIO)

    import qualified Data.ByteString as BS
    import Data.ByteString.Unsafe (unsafePackCStringFinalizer)

    class (Monad m,Throws EncodingException m) => ByteSink m where
        pushWord8 :: Word8 -> m ()
        pushWord16be :: Word16 -> m ()
        pushWord16be Word16
    w = do
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Word8) -> Word16 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word16
    w Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Word8) -> Word16 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word16
    w)
        pushWord16le :: Word16 -> m ()
        pushWord16le Word16
    w = do
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Word8) -> Word16 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word16
    w)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Word8) -> Word16 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word16
    w Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)
        pushWord32be :: Word32 -> m ()
        pushWord32be Word32
    w = do
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR`  Int
    8)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w)
        pushWord32le :: Word32 -> m ()
        pushWord32le Word32
    w = do
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR`  Int
    8)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word8) -> Word32 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24)
        pushWord64be :: Word64 -> m ()
        pushWord64be Word64
    w = do
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    56)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    40)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR`  Int
    8)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w)
        pushWord64le :: Word64 -> m ()
        pushWord64le Word64
    w = do
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR`  Int
    8)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    40)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48)
          Word8 -> m ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    56)

    instance Throws EncodingException PutM where
        throwException :: forall a. EncodingException -> PutM a
    throwException = EncodingException -> PutM a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw

    instance ByteSink PutM where
        pushWord8 :: Word8 -> PutM ()
    pushWord8 = Word8 -> PutM ()
    putWord8
        pushWord16be :: Word16 -> PutM ()
    pushWord16be = Word16 -> PutM ()
    putWord16be
        pushWord16le :: Word16 -> PutM ()
    pushWord16le = Word16 -> PutM ()
    putWord16le
        pushWord32be :: Word32 -> PutM ()
    pushWord32be = Word32 -> PutM ()
    putWord32be
        pushWord32le :: Word32 -> PutM ()
    pushWord32le = Word32 -> PutM ()
    putWord32le
        pushWord64be :: Word64 -> PutM ()
    pushWord64be = Word64 -> PutM ()
    putWord64be
        pushWord64le :: Word64 -> PutM ()
    pushWord64le = Word64 -> PutM ()
    putWord64le

    newtype PutME a = PutME (Either EncodingException (PutM (),a))

    instance Functor PutME where
      fmap :: forall a b. (a -> b) -> PutME a -> PutME b
    fmap = (a -> b) -> PutME a -> PutME b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative PutME where
      pure :: forall a. a -> PutME a
    pure a
    x = Either EncodingException (PutM (), a) -> PutME a
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), a) -> PutME a)
    -> Either EncodingException (PutM (), a) -> PutME a
    forall a b. (a -> b) -> a -> b
    $ (PutM (), a) -> Either EncodingException (PutM (), a)
    forall a b. b -> Either a b
    Right (() -> PutM ()
    forall a. a -> PutM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (),a
    x)
      <*> :: forall a b. PutME (a -> b) -> PutME a -> PutME b
    (<*>) = PutME (a -> b) -> PutME a -> PutME b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad PutME where
        return :: forall a. a -> PutME a
    return = a -> PutME a
    forall a. a -> PutME a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        (PutME Either EncodingException (PutM (), a)
    x) >>= :: forall a b. PutME a -> (a -> PutME b) -> PutME b
    >>= a -> PutME b
    g = Either EncodingException (PutM (), b) -> PutME b
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), b) -> PutME b)
    -> Either EncodingException (PutM (), b) -> PutME b
    forall a b. (a -> b) -> a -> b
    $ do
                            (m,r) <- Either EncodingException (PutM (), a)
    x
                            let (PutME ng) = g r
                            case ng of
                              Left EncodingException
    err -> EncodingException -> Either EncodingException (PutM (), b)
    forall a b. a -> Either a b
    Left EncodingException
    err
                              Right (PutM ()
    m',b
    nr) -> (PutM (), b) -> Either EncodingException (PutM (), b)
    forall a b. b -> Either a b
    Right (PutM ()
    mPutM () -> PutM () -> PutM ()
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>PutM ()
    m',b
    nr)

    instance Throws EncodingException PutME where
        throwException :: forall a. EncodingException -> PutME a
    throwException = Either EncodingException (PutM (), a) -> PutME a
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), a) -> PutME a)
    -> (EncodingException -> Either EncodingException (PutM (), a))
    -> EncodingException
    -> PutME a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EncodingException -> Either EncodingException (PutM (), a)
    forall a b. a -> Either a b
    Left

    instance ByteSink PutME where
        pushWord8 :: Word8 -> PutME ()
    pushWord8 Word8
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word8 -> PutM ()
    putWord8 Word8
    w,())
        pushWord16be :: Word16 -> PutME ()
    pushWord16be Word16
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word16 -> PutM ()
    putWord16be Word16
    w,())
        pushWord16le :: Word16 -> PutME ()
    pushWord16le Word16
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word16 -> PutM ()
    putWord16le Word16
    w,())
        pushWord32be :: Word32 -> PutME ()
    pushWord32be Word32
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word32 -> PutM ()
    putWord32be Word32
    w,())
        pushWord32le :: Word32 -> PutME ()
    pushWord32le Word32
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word32 -> PutM ()
    putWord32le Word32
    w,())
        pushWord64be :: Word64 -> PutME ()
    pushWord64be Word64
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word64 -> PutM ()
    putWord64be Word64
    w,())
        pushWord64le :: Word64 -> PutME ()
    pushWord64le Word64
    w = Either EncodingException (PutM (), ()) -> PutME ()
    forall a. Either EncodingException (PutM (), a) -> PutME a
    PutME (Either EncodingException (PutM (), ()) -> PutME ())
    -> Either EncodingException (PutM (), ()) -> PutME ()
    forall a b. (a -> b) -> a -> b
    $ (PutM (), ()) -> Either EncodingException (PutM (), ())
    forall a b. b -> Either a b
    Right (Word64 -> PutM ()
    putWord64le Word64
    w,())

    #if MIN_VERSION_base(4,3,0)
    #else
    instance Monad (Either EncodingException) where
        return x = Right x
        Left err >>= g = Left err
        Right x >>= g = g x
    #endif

    instance (Monad m,Throws EncodingException m) => ByteSink (StateT (Seq Char) m) where
        pushWord8 :: Word8 -> StateT (Seq Char) m ()
    pushWord8 Word8
    x = (Seq Char -> Seq Char) -> StateT (Seq Char) m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (Seq Char -> Char -> Seq Char
    forall a. Seq a -> a -> Seq a
    |> (Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    x))

    newtype StrictSink a = StrictS (Ptr Word8 -> Int -> Int -> IO (a,Ptr Word8,Int,Int))

    instance Functor StrictSink where
      fmap :: forall a b. (a -> b) -> StrictSink a -> StrictSink b
    fmap = (a -> b) -> StrictSink a -> StrictSink b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative StrictSink where
      pure :: forall a. a -> StrictSink a
    pure a
    x = (Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
    -> StrictSink a
    forall a.
    (Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
    -> StrictSink a
    StrictS ((Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
     -> StrictSink a)
    -> (Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
    -> StrictSink a
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    cstr Int
    pos Int
    max -> (a, Ptr Word8, Int, Int) -> IO (a, Ptr Word8, Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    x,Ptr Word8
    cstr,Int
    pos,Int
    max)
      <*> :: forall a b. StrictSink (a -> b) -> StrictSink a -> StrictSink b
    (<*>) = StrictSink (a -> b) -> StrictSink a -> StrictSink b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad StrictSink where
        return :: forall a. a -> StrictSink a
    return = a -> StrictSink a
    forall a. a -> StrictSink a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        (StrictS Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int)
    f) >>= :: forall a b. StrictSink a -> (a -> StrictSink b) -> StrictSink b
    >>= a -> StrictSink b
    g = (Ptr Word8 -> Int -> Int -> IO (b, Ptr Word8, Int, Int))
    -> StrictSink b
    forall a.
    (Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
    -> StrictSink a
    StrictS (\Ptr Word8
    cstr Int
    pos Int
    max -> do
                                       (res,ncstr,npos,nmax) <- Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int)
    f Ptr Word8
    cstr Int
    pos Int
    max
                                       let StrictS g' = g res
                                       g' ncstr npos nmax
                                    )

    instance Throws EncodingException StrictSink where
        throwException :: forall a. EncodingException -> StrictSink a
    throwException = EncodingException -> StrictSink a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw

    instance ByteSink StrictSink where
        pushWord8 :: Word8 -> StrictSink ()
    pushWord8 Word8
    x = (Ptr Word8 -> Int -> Int -> IO ((), Ptr Word8, Int, Int))
    -> StrictSink ()
    forall a.
    (Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
    -> StrictSink a
    StrictS (\Ptr Word8
    cstr Int
    pos Int
    max -> do
                                 (ncstr,nmax) <- if Int
    pos Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    max
                                        then (Ptr Word8, Int) -> IO (Ptr Word8, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr Word8
    cstr,Int
    max)
                                        else (do
                                               let nmax :: Int
    nmax = Int
    max Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    32
                                               nptr <- Ptr Word8 -> Int -> IO (Ptr Word8)
    forall a. Ptr a -> Int -> IO (Ptr a)
    reallocBytes Ptr Word8
    cstr Int
    nmax
                                               return (nptr,nmax)
                                               )
                                 poke (ncstr `plusPtr` pos) x
                                 return ((),ncstr,pos+1,nmax)
                              )

    newtype StrictSinkE a = StrictSinkE (StrictSink (Either EncodingException a))

    instance Functor StrictSinkE where
      fmap :: forall a b. (a -> b) -> StrictSinkE a -> StrictSinkE b
    fmap = (a -> b) -> StrictSinkE a -> StrictSinkE b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative StrictSinkE where
      pure :: forall a. a -> StrictSinkE a
    pure = StrictSink (Either EncodingException a) -> StrictSinkE a
    forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
    StrictSinkE (StrictSink (Either EncodingException a) -> StrictSinkE a)
    -> (a -> StrictSink (Either EncodingException a))
    -> a
    -> StrictSinkE a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either EncodingException a
    -> StrictSink (Either EncodingException a)
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException a
     -> StrictSink (Either EncodingException a))
    -> (a -> Either EncodingException a)
    -> a
    -> StrictSink (Either EncodingException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either EncodingException a
    forall a b. b -> Either a b
    Right
      <*> :: forall a b. StrictSinkE (a -> b) -> StrictSinkE a -> StrictSinkE b
    (<*>) = StrictSinkE (a -> b) -> StrictSinkE a -> StrictSinkE b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad StrictSinkE where
        return :: forall a. a -> StrictSinkE a
    return = a -> StrictSinkE a
    forall a. a -> StrictSinkE a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        (StrictSinkE StrictSink (Either EncodingException a)
    s) >>= :: forall a b. StrictSinkE a -> (a -> StrictSinkE b) -> StrictSinkE b
    >>= a -> StrictSinkE b
    g = StrictSink (Either EncodingException b) -> StrictSinkE b
    forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
    StrictSinkE (StrictSink (Either EncodingException b) -> StrictSinkE b)
    -> StrictSink (Either EncodingException b) -> StrictSinkE b
    forall a b. (a -> b) -> a -> b
    $ do
                                  res <- StrictSink (Either EncodingException a)
    s
                                  case res of
                                    Left EncodingException
    err -> Either EncodingException b
    -> StrictSink (Either EncodingException b)
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException b
     -> StrictSink (Either EncodingException b))
    -> Either EncodingException b
    -> StrictSink (Either EncodingException b)
    forall a b. (a -> b) -> a -> b
    $ EncodingException -> Either EncodingException b
    forall a b. a -> Either a b
    Left EncodingException
    err
                                    Right a
    res' -> let StrictSinkE StrictSink (Either EncodingException b)
    g' = a -> StrictSinkE b
    g a
    res'
                                                 in StrictSink (Either EncodingException b)
    g'

    instance Throws EncodingException StrictSinkE where
        throwException :: forall a. EncodingException -> StrictSinkE a
    throwException = StrictSink (Either EncodingException a) -> StrictSinkE a
    forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
    StrictSinkE (StrictSink (Either EncodingException a) -> StrictSinkE a)
    -> (EncodingException -> StrictSink (Either EncodingException a))
    -> EncodingException
    -> StrictSinkE a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either EncodingException a
    -> StrictSink (Either EncodingException a)
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException a
     -> StrictSink (Either EncodingException a))
    -> (EncodingException -> Either EncodingException a)
    -> EncodingException
    -> StrictSink (Either EncodingException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EncodingException -> Either EncodingException a
    forall a b. a -> Either a b
    Left

    instance ByteSink StrictSinkE where
        pushWord8 :: Word8 -> StrictSinkE ()
    pushWord8 Word8
    x = StrictSink (Either EncodingException ()) -> StrictSinkE ()
    forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
    StrictSinkE (StrictSink (Either EncodingException ()) -> StrictSinkE ())
    -> StrictSink (Either EncodingException ()) -> StrictSinkE ()
    forall a b. (a -> b) -> a -> b
    $ Word8 -> StrictSink ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 Word8
    x StrictSink ()
    -> (() -> StrictSink (Either EncodingException ()))
    -> StrictSink (Either EncodingException ())
    forall a b. StrictSink a -> (a -> StrictSink b) -> StrictSink b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Either EncodingException ()
    -> StrictSink (Either EncodingException ())
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException ()
     -> StrictSink (Either EncodingException ()))
    -> (() -> Either EncodingException ())
    -> ()
    -> StrictSink (Either EncodingException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . () -> Either EncodingException ()
    forall a b. b -> Either a b
    Right

    createStrictWithLen :: StrictSink a -> Int -> (a,BS.ByteString)
    createStrictWithLen :: forall a. StrictSink a -> Int -> (a, ByteString)
    createStrictWithLen (StrictS Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int)
    f) Int
    max = IO (a, ByteString) -> (a, ByteString)
    forall a. IO a -> a
    unsafePerformIO (IO (a, ByteString) -> (a, ByteString))
    -> IO (a, ByteString) -> (a, ByteString)
    forall a b. (a -> b) -> a -> b
    $ do
                                     ptr <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    max
                                     (r,nptr,len,_) <- f ptr 0 max
                                     str <- unsafePackCStringFinalizer nptr len (free nptr)
                                     return (r,str)

    createStrict :: StrictSink a -> (a,BS.ByteString)
    createStrict :: forall a. StrictSink a -> (a, ByteString)
    createStrict StrictSink a
    sink = StrictSink a -> Int -> (a, ByteString)
    forall a. StrictSink a -> Int -> (a, ByteString)
    createStrictWithLen StrictSink a
    sink Int
    32

    newtype StrictSinkExplicit a = StrictSinkExplicit  (StrictSink (Either EncodingException a))

    instance Functor StrictSinkExplicit where
      fmap :: forall a b.
    (a -> b) -> StrictSinkExplicit a -> StrictSinkExplicit b
    fmap = (a -> b) -> StrictSinkExplicit a -> StrictSinkExplicit b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative StrictSinkExplicit where
      pure :: forall a. a -> StrictSinkExplicit a
    pure = (StrictSink (Either EncodingException a) -> StrictSinkExplicit a
    forall a.
    StrictSink (Either EncodingException a) -> StrictSinkExplicit a
    StrictSinkExplicit)(StrictSink (Either EncodingException a) -> StrictSinkExplicit a)
    -> (a -> StrictSink (Either EncodingException a))
    -> a
    -> StrictSinkExplicit a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Either EncodingException a
    -> StrictSink (Either EncodingException a)
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Either EncodingException a
     -> StrictSink (Either EncodingException a))
    -> (a -> Either EncodingException a)
    -> a
    -> StrictSink (Either EncodingException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .a -> Either EncodingException a
    forall a b. b -> Either a b
    Right
      <*> :: forall a b.
    StrictSinkExplicit (a -> b)
    -> StrictSinkExplicit a -> StrictSinkExplicit b
    (<*>) = StrictSinkExplicit (a -> b)
    -> StrictSinkExplicit a -> StrictSinkExplicit b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad StrictSinkExplicit where
        return :: forall a. a -> StrictSinkExplicit a
    return = a -> StrictSinkExplicit a
    forall a. a -> StrictSinkExplicit a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        (StrictSinkExplicit StrictSink (Either EncodingException a)
    sink) >>= :: forall a b.
    StrictSinkExplicit a
    -> (a -> StrictSinkExplicit b) -> StrictSinkExplicit b
    >>= a -> StrictSinkExplicit b
    f
            = StrictSink (Either EncodingException b) -> StrictSinkExplicit b
    forall a.
    StrictSink (Either EncodingException a) -> StrictSinkExplicit a
    StrictSinkExplicit (do
                                   res <- StrictSink (Either EncodingException a)
    sink
                                   case res of
                                     Left EncodingException
    err -> Either EncodingException b
    -> StrictSink (Either EncodingException b)
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException b
     -> StrictSink (Either EncodingException b))
    -> Either EncodingException b
    -> StrictSink (Either EncodingException b)
    forall a b. (a -> b) -> a -> b
    $ EncodingException -> Either EncodingException b
    forall a b. a -> Either a b
    Left EncodingException
    err
                                     Right a
    x -> let StrictSinkExplicit StrictSink (Either EncodingException b)
    sink2 = a -> StrictSinkExplicit b
    f a
    x
                                               in StrictSink (Either EncodingException b)
    sink2)

    instance Throws EncodingException StrictSinkExplicit where
        throwException :: forall a. EncodingException -> StrictSinkExplicit a
    throwException = StrictSink (Either EncodingException a) -> StrictSinkExplicit a
    forall a.
    StrictSink (Either EncodingException a) -> StrictSinkExplicit a
    StrictSinkExplicit (StrictSink (Either EncodingException a) -> StrictSinkExplicit a)
    -> (EncodingException -> StrictSink (Either EncodingException a))
    -> EncodingException
    -> StrictSinkExplicit a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either EncodingException a
    -> StrictSink (Either EncodingException a)
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException a
     -> StrictSink (Either EncodingException a))
    -> (EncodingException -> Either EncodingException a)
    -> EncodingException
    -> StrictSink (Either EncodingException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EncodingException -> Either EncodingException a
    forall a b. a -> Either a b
    Left

    instance ByteSink StrictSinkExplicit where
        pushWord8 :: Word8 -> StrictSinkExplicit ()
    pushWord8 Word8
    x = StrictSink (Either EncodingException ()) -> StrictSinkExplicit ()
    forall a.
    StrictSink (Either EncodingException a) -> StrictSinkExplicit a
    StrictSinkExplicit (StrictSink (Either EncodingException ()) -> StrictSinkExplicit ())
    -> StrictSink (Either EncodingException ())
    -> StrictSinkExplicit ()
    forall a b. (a -> b) -> a -> b
    $ do
                                           Word8 -> StrictSink ()
    forall (m :: * -> *). ByteSink m => Word8 -> m ()
    pushWord8 Word8
    x
                                           Either EncodingException ()
    -> StrictSink (Either EncodingException ())
    forall a. a -> StrictSink a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either EncodingException ()
     -> StrictSink (Either EncodingException ()))
    -> Either EncodingException ()
    -> StrictSink (Either EncodingException ())
    forall a b. (a -> b) -> a -> b
    $ () -> Either EncodingException ()
    forall a b. b -> Either a b
    Right ()

    instance ByteSink (ReaderT Handle IO) where
        pushWord8 :: Word8 -> ReaderT Handle IO ()
    pushWord8 Word8
    x = do
          h <- ReaderT Handle IO Handle
    forall r (m :: * -> *). MonadReader r m => m r
    ask
          liftIO $ do
            hPutChar h (chr $ fromIntegral x)