{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Bits.Coding
( Coding(..)
, getAligned, getBit, getBits, getBitsFrom
, putAligned, putUnaligned, putBit, putBits, putBitsFrom
) where
import Control.Applicative
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.State.Class
import Control.Monad.Reader.Class
import Control.Monad.Trans
import Data.Bits
import Data.Bits.Extras
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Word
{-# ANN module "hlint: ignore Redundant $!" #-}
newtype Coding m a = Coding
{ Coding m a
-> forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
runCoding :: forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
}
instance Functor (Coding m) where
fmap :: (a -> b) -> Coding m a -> Coding m b
fmap a -> b
f (Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m) = (forall r. (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m b
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m b)
-> (forall r. (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m b
forall a b. (a -> b) -> a -> b
$ \ b -> Int -> Word8 -> m r
k -> (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m (b -> Int -> Word8 -> m r
k (b -> Int -> Word8 -> m r) -> (a -> b) -> a -> Int -> Word8 -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE fmap #-}
instance Monad m => Applicative (Coding m) where
pure :: a -> Coding m a
pure a
a = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k -> a -> Int -> Word8 -> m r
k a
a
{-# INLINE pure #-}
<*> :: Coding m (a -> b) -> Coding m a -> Coding m b
(<*>) = Coding m (a -> b) -> Coding m a -> Coding m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (<*>) #-}
instance Monad m => Monad (Coding m) where
return :: a -> Coding m a
return = a -> Coding m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m >>= :: Coding m a -> (a -> Coding m b) -> Coding m b
>>= a -> Coding m b
f = (forall r. (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m b
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m b)
-> (forall r. (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m b
forall a b. (a -> b) -> a -> b
$ \ b -> Int -> Word8 -> m r
k -> (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m ((a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$ \a
a -> Coding m b -> (b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall (m :: * -> *) a.
Coding m a
-> forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
runCoding (a -> Coding m b
f a
a) b -> Int -> Word8 -> m r
k
{-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
fail e = Coding $ \_ _ _ -> fail e
{-# INLINE fail #-}
#endif
instance Fail.MonadFail m => Fail.MonadFail (Coding m) where
fail :: String -> Coding m a
fail String
e = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
_ Int
_ Word8
_ -> String -> m r
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
e
{-# INLINE fail #-}
instance (Monad m, Alternative m) => Alternative (Coding m) where
empty :: Coding m a
empty = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
_ Int
_ Word8
_ -> m r
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE empty #-}
Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m <|> :: Coding m a -> Coding m a -> Coding m a
<|> Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
n = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k Int
i Word8
b -> do
(a
a,Int
i',Word8
b') <- (a -> Int -> Word8 -> m (a, Int, Word8))
-> Int -> Word8 -> m (a, Int, Word8)
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m (\a
a Int
i' Word8
b' -> (a, Int, Word8) -> m (a, Int, Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,Int
i',Word8
b')) Int
i Word8
b m (a, Int, Word8) -> m (a, Int, Word8) -> m (a, Int, Word8)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Int -> Word8 -> m (a, Int, Word8))
-> Int -> Word8 -> m (a, Int, Word8)
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
n (\a
a Int
i' Word8
b' -> (a, Int, Word8) -> m (a, Int, Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,Int
i',Word8
b')) Int
i Word8
b
a -> Int -> Word8 -> m r
k a
a Int
i' Word8
b'
{-# INLINE (<|>) #-}
instance MonadPlus m => MonadPlus (Coding m) where
mzero :: Coding m a
mzero = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
_ Int
_ Word8
_ -> m r
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE mzero #-}
mplus :: Coding m a -> Coding m a -> Coding m a
mplus (Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m) (Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
n) = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k Int
i Word8
b -> do
(a
a,Int
i',Word8
b') <- (a -> Int -> Word8 -> m (a, Int, Word8))
-> Int -> Word8 -> m (a, Int, Word8)
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m (\a
a Int
i' Word8
b' -> (a, Int, Word8) -> m (a, Int, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Int
i',Word8
b')) Int
i Word8
b m (a, Int, Word8) -> m (a, Int, Word8) -> m (a, Int, Word8)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (a -> Int -> Word8 -> m (a, Int, Word8))
-> Int -> Word8 -> m (a, Int, Word8)
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
n (\a
a Int
i' Word8
b' -> (a, Int, Word8) -> m (a, Int, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Int
i',Word8
b')) Int
i Word8
b
a -> Int -> Word8 -> m r
k a
a Int
i' Word8
b'
{-# INLINE mplus #-}
instance MonadTrans Coding where
lift :: m a -> Coding m a
lift m a
m = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k Int
i Word8
w -> do
a
a <- m a
m
a -> Int -> Word8 -> m r
k a
a Int
i Word8
w
{-# INLINE lift #-}
instance MonadState s m => MonadState s (Coding m) where
get :: Coding m s
get = m s -> Coding m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE get #-}
put :: s -> Coding m ()
put = m () -> Coding m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Coding m ()) -> (s -> m ()) -> s -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# INLINE put #-}
instance MonadReader e m => MonadReader e (Coding m) where
ask :: Coding m e
ask = m e -> Coding m e
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m e
forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE ask #-}
local :: (e -> e) -> Coding m a -> Coding m a
local e -> e
f (Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m) = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k Int
i Word8
b -> do
(a
a,Int
i',Word8
b') <- (e -> e) -> m (a, Int, Word8) -> m (a, Int, Word8)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
f (m (a, Int, Word8) -> m (a, Int, Word8))
-> m (a, Int, Word8) -> m (a, Int, Word8)
forall a b. (a -> b) -> a -> b
$ (a -> Int -> Word8 -> m (a, Int, Word8))
-> Int -> Word8 -> m (a, Int, Word8)
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m (\a
a Int
i' Word8
b' -> (a, Int, Word8) -> m (a, Int, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Int
i', Word8
b')) Int
i Word8
b
a -> Int -> Word8 -> m r
k a
a Int
i' Word8
b'
{-# INLINE local #-}
getAligned :: MonadGet m => m a -> Coding m a
getAligned :: m a -> Coding m a
getAligned m a
m = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k Int
_ Word8
_ -> m a
m m a -> (a -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
a -> a -> Int -> Word8 -> m r
k a
a Int
0 Word8
0
{-# INLINE getAligned #-}
getBit :: MonadGet m => Coding m Bool
getBit :: Coding m Bool
getBit = (forall r. (Bool -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m Bool
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (Bool -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m Bool)
-> (forall r. (Bool -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m Bool
forall a b. (a -> b) -> a -> b
$ \ Bool -> Int -> Word8 -> m r
k Int
i Word8
b ->
if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
b' -> ((Bool -> Int -> Word8 -> m r
k (Bool -> Int -> Word8 -> m r) -> Bool -> Int -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b' Int
7) (Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Int
7) (Word8 -> m r) -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftL Word8
b' Int
1
else ((Bool -> Int -> Word8 -> m r
k (Bool -> Int -> Word8 -> m r) -> Bool -> Int -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b Int
7) (Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8 -> m r) -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftL Word8
b Int
1
{-# INLINE getBit #-}
getBits :: (MonadGet m, Bits b) => Int -> Int -> b -> Coding m b
getBits :: Int -> Int -> b -> Coding m b
getBits Int
from Int
to b
bits | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
to = b -> Coding m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
bits
| Bool
otherwise = do Bool
b <- Coding m Bool
forall (m :: * -> *). MonadGet m => Coding m Bool
getBit
Int -> Int -> b -> Coding m b
forall (m :: * -> *) b.
(MonadGet m, Bits b) =>
Int -> Int -> b -> Coding m b
getBits (Int -> Int
forall a. Enum a => a -> a
pred Int
from) Int
to (b -> Coding m b) -> b -> Coding m b
forall a b. (a -> b) -> a -> b
$ b -> Int -> Bool -> b
forall b. Bits b => b -> Int -> Bool -> b
assignBit b
bits Int
from Bool
b
{-# INLINE getBits #-}
getBitsFrom :: (MonadGet m, Bits b) => Int -> b -> Coding m b
getBitsFrom :: Int -> b -> Coding m b
getBitsFrom Int
from = Int -> Int -> b -> Coding m b
forall (m :: * -> *) b.
(MonadGet m, Bits b) =>
Int -> Int -> b -> Coding m b
getBits Int
from Int
0
{-# INLINE getBitsFrom #-}
instance MonadGet m => MonadGet (Coding m) where
type Remaining (Coding m) = Remaining m
type Bytes (Coding m) = Bytes m
skip :: Int -> Coding m ()
skip = m () -> Coding m ()
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned (m () -> Coding m ()) -> (Int -> m ()) -> Int -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadGet m => Int -> m ()
skip
{-# INLINE skip #-}
lookAhead :: Coding m a -> Coding m a
lookAhead (Coding forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m) = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \a -> Int -> Word8 -> m r
k Int
i Word8
b -> m r -> m r
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead ((a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m a -> Int -> Word8 -> m r
k Int
i Word8
b)
{-# INLINE lookAhead #-}
lookAheadM :: Coding m (Maybe a) -> Coding m (Maybe a)
lookAheadM (Coding forall r. (Maybe a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m) = (forall r. (Maybe a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m (Maybe a)
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r.
(Maybe a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m (Maybe a))
-> (forall r.
(Maybe a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Maybe a -> Int -> Word8 -> m r
k Int
i Word8
b -> m (Either (m r) (m r)) -> m (Either (m r) (m r))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE ((Maybe a -> Int -> Word8 -> m (Either (m r) (m r)))
-> Int -> Word8 -> m (Either (m r) (m r))
forall r. (Maybe a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m ((Maybe a -> Int -> Word8 -> m r)
-> Maybe a -> Int -> Word8 -> m (Either (m r) (m r))
forall (m :: * -> *) a t t b.
Monad m =>
(Maybe a -> t -> t -> b) -> Maybe a -> t -> t -> m (Either b b)
distribute Maybe a -> Int -> Word8 -> m r
k) Int
i Word8
b) m (Either (m r) (m r)) -> (Either (m r) (m r) -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (m r) (m r) -> m r
forall c. Either c c -> c
factor
where
distribute :: (Maybe a -> t -> t -> b) -> Maybe a -> t -> t -> m (Either b b)
distribute Maybe a -> t -> t -> b
k Maybe a
Nothing t
i' t
b' = Either b b -> m (Either b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b b -> m (Either b b)) -> Either b b -> m (Either b b)
forall a b. (a -> b) -> a -> b
$ b -> Either b b
forall a b. a -> Either a b
Left (b -> Either b b) -> b -> Either b b
forall a b. (a -> b) -> a -> b
$ Maybe a -> t -> t -> b
k Maybe a
forall a. Maybe a
Nothing t
i' t
b'
distribute Maybe a -> t -> t -> b
k (Just a
a) t
i' t
b' = Either b b -> m (Either b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b b -> m (Either b b)) -> Either b b -> m (Either b b)
forall a b. (a -> b) -> a -> b
$ b -> Either b b
forall a b. b -> Either a b
Right (b -> Either b b) -> b -> Either b b
forall a b. (a -> b) -> a -> b
$ Maybe a -> t -> t -> b
k (a -> Maybe a
forall a. a -> Maybe a
Just a
a) t
i' t
b'
factor :: Either c c -> c
factor = (c -> c) -> (c -> c) -> Either c c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either c -> c
forall a. a -> a
id c -> c
forall a. a -> a
id
{-# INLINE lookAheadM #-}
lookAheadE :: Coding m (Either a b) -> Coding m (Either a b)
lookAheadE (Coding forall r.
(Either a b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m) = (forall r.
(Either a b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m (Either a b)
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r.
(Either a b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m (Either a b))
-> (forall r.
(Either a b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m (Either a b)
forall a b. (a -> b) -> a -> b
$ \Either a b -> Int -> Word8 -> m r
k Int
i Word8
b -> m (Either (m r) (m r)) -> m (Either (m r) (m r))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE ((Either a b -> Int -> Word8 -> m (Either (m r) (m r)))
-> Int -> Word8 -> m (Either (m r) (m r))
forall r.
(Either a b -> Int -> Word8 -> m r) -> Int -> Word8 -> m r
m ((Either a b -> Int -> Word8 -> m r)
-> Either a b -> Int -> Word8 -> m (Either (m r) (m r))
forall (m :: * -> *) a b t t b.
Monad m =>
(Either a b -> t -> t -> b)
-> Either a b -> t -> t -> m (Either b b)
distribute Either a b -> Int -> Word8 -> m r
k) Int
i Word8
b) m (Either (m r) (m r)) -> (Either (m r) (m r) -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (m r) (m r) -> m r
forall c. Either c c -> c
factor
where
distribute :: (Either a b -> t -> t -> b)
-> Either a b -> t -> t -> m (Either b b)
distribute Either a b -> t -> t -> b
k (Left a
e) t
i' t
b' = Either b b -> m (Either b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b b -> m (Either b b)) -> Either b b -> m (Either b b)
forall a b. (a -> b) -> a -> b
$ b -> Either b b
forall a b. a -> Either a b
Left (b -> Either b b) -> b -> Either b b
forall a b. (a -> b) -> a -> b
$ Either a b -> t -> t -> b
k (a -> Either a b
forall a b. a -> Either a b
Left a
e) t
i' t
b'
distribute Either a b -> t -> t -> b
k (Right b
a) t
i' t
b' = Either b b -> m (Either b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b b -> m (Either b b)) -> Either b b -> m (Either b b)
forall a b. (a -> b) -> a -> b
$ b -> Either b b
forall a b. b -> Either a b
Right (b -> Either b b) -> b -> Either b b
forall a b. (a -> b) -> a -> b
$ Either a b -> t -> t -> b
k (b -> Either a b
forall a b. b -> Either a b
Right b
a) t
i' t
b'
factor :: Either c c -> c
factor = (c -> c) -> (c -> c) -> Either c c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either c -> c
forall a. a -> a
id c -> c
forall a. a -> a
id
{-# INLINE lookAheadE #-}
getBytes :: Int -> Coding m ByteString
getBytes = m ByteString -> Coding m ByteString
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned (m ByteString -> Coding m ByteString)
-> (Int -> m ByteString) -> Int -> Coding m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
remaining :: Coding m (Remaining (Coding m))
remaining = m (Remaining m) -> Coding m (Remaining m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Remaining m)
forall (m :: * -> *). MonadGet m => m (Remaining m)
remaining
{-# INLINE remaining #-}
isEmpty :: Coding m Bool
isEmpty = m Bool -> Coding m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty
{-# INLINE isEmpty #-}
getWord8 :: Coding m Word8
getWord8 = m Word8 -> Coding m Word8
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
{-# INLINE getWord8 #-}
getByteString :: Int -> Coding m ByteString
getByteString = m ByteString -> Coding m ByteString
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned (m ByteString -> Coding m ByteString)
-> (Int -> m ByteString) -> Int -> Coding m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString
{-# INLINE getByteString #-}
getLazyByteString :: Int64 -> Coding m ByteString
getLazyByteString = m ByteString -> Coding m ByteString
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned (m ByteString -> Coding m ByteString)
-> (Int64 -> m ByteString) -> Int64 -> Coding m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> m ByteString
forall (m :: * -> *). MonadGet m => Int64 -> m ByteString
getLazyByteString
{-# INLINE getLazyByteString #-}
getWord16le :: Coding m Word16
getWord16le = m Word16 -> Coding m Word16
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16le
{-# INLINE getWord16le #-}
getWord32le :: Coding m Word32
getWord32le = m Word32 -> Coding m Word32
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
{-# INLINE getWord32le #-}
getWord64le :: Coding m Word64
getWord64le = m Word64 -> Coding m Word64
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
{-# INLINE getWord64le #-}
getWord16be :: Coding m Word16
getWord16be = m Word16 -> Coding m Word16
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be
{-# INLINE getWord16be #-}
getWord32be :: Coding m Word32
getWord32be = m Word32 -> Coding m Word32
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
{-# INLINE getWord32be #-}
getWord64be :: Coding m Word64
getWord64be = m Word64 -> Coding m Word64
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
{-# INLINE getWord64be #-}
getWord16host :: Coding m Word16
getWord16host = m Word16 -> Coding m Word16
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16host
{-# INLINE getWord16host #-}
getWord32host :: Coding m Word32
getWord32host = m Word32 -> Coding m Word32
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32host
{-# INLINE getWord32host #-}
getWord64host :: Coding m Word64
getWord64host = m Word64 -> Coding m Word64
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64host
{-# INLINE getWord64host #-}
getWordhost :: Coding m Word
getWordhost = m Word -> Coding m Word
forall (m :: * -> *) a. MonadGet m => m a -> Coding m a
getAligned m Word
forall (m :: * -> *). MonadGet m => m Word
getWordhost
{-# INLINE getWordhost #-}
putAligned :: MonadPut m => m a -> Coding m a
putAligned :: m a -> Coding m a
putAligned m a
m = (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a)
-> (forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
forall a b. (a -> b) -> a -> b
$ \ a -> Int -> Word8 -> m r
k Int
i Word8
b ->
if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then do
a
a <- m a
m
a -> Int -> Word8 -> m r
k a
a Int
0 Word8
0
else do
Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
b
a
a <- m a
m
a -> Int -> Word8 -> m r
k a
a Int
0 Word8
0
putUnaligned :: (MonadPut m, FiniteBits b) => b -> Coding m ()
putUnaligned :: b -> Coding m ()
putUnaligned b
b = Int -> b -> Coding m ()
forall (m :: * -> *) b.
(MonadPut m, Bits b) =>
Int -> b -> Coding m ()
putBitsFrom (Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize b
b) b
b
{-# INLINE putUnaligned #-}
putBit :: MonadPut m => Bool -> Coding m ()
putBit :: Bool -> Coding m ()
putBit Bool
v = (forall r. (() -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m ()
forall (m :: * -> *) a.
(forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m a
Coding ((forall r. (() -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m ())
-> (forall r. (() -> Int -> Word8 -> m r) -> Int -> Word8 -> m r)
-> Coding m ()
forall a b. (a -> b) -> a -> b
$ \() -> Int -> Word8 -> m r
k Int
i Word8
b ->
if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7
then do
Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> Int -> Bool -> Word8
forall b. Bits b => b -> Int -> Bool -> b
pushBit Word8
b Int
i Bool
v)
() -> Int -> Word8 -> m r
k () Int
0 Word8
0
else (() -> Int -> Word8 -> m r
k () (Int -> Word8 -> m r) -> Int -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8 -> m r) -> Word8 -> m r
forall a b. (a -> b) -> a -> b
$! Word8 -> Int -> Bool -> Word8
forall b. Bits b => b -> Int -> Bool -> b
pushBit Word8
b Int
i Bool
v
where
pushBit :: a -> Int -> Bool -> a
pushBit a
w Int
i Bool
False = a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit a
w (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
pushBit a
w Int
i Bool
True = a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
w (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
{-# INLINE putBit #-}
putBits :: (MonadPut m, Bits b) => Int -> Int -> b -> Coding m ()
putBits :: Int -> Int -> b -> Coding m ()
putBits Int
from Int
to b
b | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
to = () -> Coding m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = Bool -> Coding m ()
forall (m :: * -> *). MonadPut m => Bool -> Coding m ()
putBit (b
b b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
from) Coding m () -> Coding m () -> Coding m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> b -> Coding m ()
forall (m :: * -> *) b.
(MonadPut m, Bits b) =>
Int -> Int -> b -> Coding m ()
putBits (Int -> Int
forall a. Enum a => a -> a
pred Int
from) Int
to b
b
{-# INLINE putBits #-}
putBitsFrom :: (MonadPut m, Bits b) => Int -> b -> Coding m ()
putBitsFrom :: Int -> b -> Coding m ()
putBitsFrom Int
from = Int -> Int -> b -> Coding m ()
forall (m :: * -> *) b.
(MonadPut m, Bits b) =>
Int -> Int -> b -> Coding m ()
putBits Int
from Int
0
{-# INLINE putBitsFrom #-}
instance MonadPut m => MonadPut (Coding m) where
putWord8 :: Word8 -> Coding m ()
putWord8 = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word8 -> m ()) -> Word8 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8
{-# INLINE putWord8 #-}
putByteString :: ByteString -> Coding m ()
putByteString = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ())
-> (ByteString -> m ()) -> ByteString -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString
{-# INLINE putByteString #-}
putLazyByteString :: ByteString -> Coding m ()
putLazyByteString = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ())
-> (ByteString -> m ()) -> ByteString -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLazyByteString
{-# INLINE putLazyByteString #-}
flush :: Coding m ()
flush = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned m ()
forall (m :: * -> *). MonadPut m => m ()
flush
{-# INLINE flush #-}
putWord16le :: Word16 -> Coding m ()
putWord16le = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word16 -> m ()) -> Word16 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16le
{-# INLINE putWord16le #-}
putWord32le :: Word32 -> Coding m ()
putWord32le = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word32 -> m ()) -> Word32 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le
{-# INLINE putWord32le #-}
putWord64le :: Word64 -> Coding m ()
putWord64le = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word64 -> m ()) -> Word64 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le
{-# INLINE putWord64le #-}
putWord16be :: Word16 -> Coding m ()
putWord16be = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word16 -> m ()) -> Word16 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be
{-# INLINE putWord16be #-}
putWord32be :: Word32 -> Coding m ()
putWord32be = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word32 -> m ()) -> Word32 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be
{-# INLINE putWord32be #-}
putWord64be :: Word64 -> Coding m ()
putWord64be = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word64 -> m ()) -> Word64 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be
{-# INLINE putWord64be #-}
putWord16host :: Word16 -> Coding m ()
putWord16host = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word16 -> m ()) -> Word16 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16host
{-# INLINE putWord16host #-}
putWord32host :: Word32 -> Coding m ()
putWord32host = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word32 -> m ()) -> Word32 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32host
{-# INLINE putWord32host #-}
putWord64host :: Word64 -> Coding m ()
putWord64host = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word64 -> m ()) -> Word64 -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64host
{-# INLINE putWord64host #-}
putWordhost :: Word -> Coding m ()
putWordhost = m () -> Coding m ()
forall (m :: * -> *) a. MonadPut m => m a -> Coding m a
putAligned (m () -> Coding m ()) -> (Word -> m ()) -> Word -> Coding m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> m ()
forall (m :: * -> *). MonadPut m => Word -> m ()
putWordhost
{-# INLINE putWordhost #-}