{-# 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
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
w)
    pushWord16le :: Word16 -> m ()
    pushWord16le Word16
w = do
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
w)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
    pushWord32be :: Word32 -> m ()
    pushWord32be Word32
w = do
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w)
    pushWord32le :: Word32 -> m ()
    pushWord32le Word32
w = do
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
    pushWord64be :: Word64 -> m ()
    pushWord64be Word64
w = do
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
56)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w)
    pushWord64le :: Word64 -> m ()
    pushWord64le Word64
w = do
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
      forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
56)

instance Throws EncodingException PutM where
    throwException :: forall a. EncodingException -> PutM a
throwException = forall a e. 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 = 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 = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall (f :: * -> *) a. Applicative f => a -> f a
pure (),a
x)
  <*> :: forall a 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 = 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 = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ do
                        (PutM ()
m,a
r) <- Either EncodingException (PutM (), a)
x
                        let (PutME Either EncodingException (PutM (), b)
ng) = a -> PutME b
g a
r
                        case Either EncodingException (PutM (), b)
ng of
                          Left EncodingException
err -> forall a b. a -> Either a b
Left EncodingException
err
                          Right (PutM ()
m',b
nr) -> forall a b. b -> Either a b
Right (PutM ()
mforall (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 = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

instance ByteSink PutME where
    pushWord8 :: Word8 -> PutME ()
pushWord8 Word8
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word8 -> PutM ()
putWord8 Word8
w,())
    pushWord16be :: Word16 -> PutME ()
pushWord16be Word16
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word16 -> PutM ()
putWord16be Word16
w,())
    pushWord16le :: Word16 -> PutME ()
pushWord16le Word16
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word16 -> PutM ()
putWord16le Word16
w,())
    pushWord32be :: Word32 -> PutME ()
pushWord32be Word32
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word32 -> PutM ()
putWord32be Word32
w,())
    pushWord32le :: Word32 -> PutME ()
pushWord32le Word32
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word32 -> PutM ()
putWord32le Word32
w,())
    pushWord64be :: Word64 -> PutME ()
pushWord64be Word64
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word64 -> PutM ()
putWord64be Word64
w,())
    pushWord64le :: Word64 -> PutME ()
pushWord64le Word64
w = forall a. Either EncodingException (PutM (), a) -> PutME a
PutME forall a b. (a -> b) -> a -> b
$ 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Seq a -> a -> Seq a
|> (Int -> Char
chr forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall a.
(Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
-> StrictSink a
StrictS forall a b. (a -> b) -> a -> b
$ \Ptr Word8
cstr Int
pos Int
max -> 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
(<*>) = 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 = 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 = forall a.
(Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int))
-> StrictSink a
StrictS (\Ptr Word8
cstr Int
pos Int
max -> do
                                   (a
res,Ptr Word8
ncstr,Int
npos,Int
nmax) <- Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int)
f Ptr Word8
cstr Int
pos Int
max
                                   let StrictS Ptr Word8 -> Int -> Int -> IO (b, Ptr Word8, Int, Int)
g' = a -> StrictSink b
g a
res
                                   Ptr Word8 -> Int -> Int -> IO (b, Ptr Word8, Int, Int)
g' Ptr Word8
ncstr Int
npos Int
nmax
                                )

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

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

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

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

instance Applicative StrictSinkE where
  pure :: forall a. a -> StrictSinkE a
pure = forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
StrictSinkE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
  <*> :: forall a 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 = 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 = forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
StrictSinkE forall a b. (a -> b) -> a -> b
$ do
                              Either EncodingException a
res <- StrictSink (Either EncodingException a)
s
                              case Either EncodingException a
res of
                                Left EncodingException
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> 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 = forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
StrictSinkE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

instance ByteSink StrictSinkE where
    pushWord8 :: Word8 -> StrictSinkE ()
pushWord8 Word8
x = forall a. StrictSink (Either EncodingException a) -> StrictSinkE a
StrictSinkE forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ByteSink m => Word8 -> m ()
pushWord8 Word8
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
                                 Ptr Word8
ptr <- forall a. Int -> IO (Ptr a)
mallocBytes Int
max
                                 (a
r,Ptr Word8
nptr,Int
len,Int
_) <- Ptr Word8 -> Int -> Int -> IO (a, Ptr Word8, Int, Int)
f Ptr Word8
ptr Int
0 Int
max
                                 ByteString
str <- Ptr Word8 -> Int -> IO () -> IO ByteString
unsafePackCStringFinalizer Ptr Word8
nptr Int
len (forall a. Ptr a -> IO ()
free Ptr Word8
nptr)
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (a
r,ByteString
str)

createStrict :: StrictSink a -> (a,BS.ByteString)
createStrict :: forall a. StrictSink a -> (a, ByteString)
createStrict StrictSink a
sink = 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative StrictSinkExplicit where
  pure :: forall a. a -> StrictSinkExplicit a
pure = (forall a.
StrictSink (Either EncodingException a) -> StrictSinkExplicit a
StrictSinkExplicit)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. b -> Either a b
Right
  <*> :: forall a 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 = 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
        = forall a.
StrictSink (Either EncodingException a) -> StrictSinkExplicit a
StrictSinkExplicit (do
                               Either EncodingException a
res <- StrictSink (Either EncodingException a)
sink
                               case Either EncodingException a
res of
                                 Left EncodingException
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> 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 = forall a.
StrictSink (Either EncodingException a) -> StrictSinkExplicit a
StrictSinkExplicit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

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

instance ByteSink (ReaderT Handle IO) where
    pushWord8 :: Word8 -> ReaderT Handle IO ()
pushWord8 Word8
x = do
      Handle
h <- forall r (m :: * -> *). MonadReader r m => m r
ask
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Handle -> Char -> IO ()
hPutChar Handle
h (Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)