{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Data.Bits.Coding
  ( Coding(..)
  -- * Get
  , getAligned, getBit, getBits, getBitsFrom
  -- * Put
  , 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 $!" #-}

------------------------------------------------------------------------------
-- Coding
------------------------------------------------------------------------------

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 #-}

-- Binary.Get is strangely missing MonadPlus
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 #-}

------------------------------------------------------------------------------
-- Get
------------------------------------------------------------------------------

-- | 'Get' something from byte-aligned storage, starting on the next byte
-- and discarding any left over bits in the buffer.
--
-- /NB:/ Using any operation from 'MonadGet' other than checking 'remaining' or
-- 'isEmpty' will implicitly perform this operation.
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 #-}

-- | 'Get' a single bit, consuming an entire 'byte' if the bit buffer is empty
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 #-}

------------------------------------------------------------------------------
-- Put
------------------------------------------------------------------------------

-- | Emit any remaining contents from the bit buffer.
--
-- Any use of the combinators from 'MonadPut' (including 'flush') will cause
-- this to happen.
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

-- | 'Put' all the bits without a 'flush'
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 #-}

-- | 'Put' a single bit, emitting an entire 'byte' if the bit buffer is full
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 #-}

-- TODO: Make putBits less stupid
-- | 'Put' a (closed) range of bits
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 from b = putBits from 0 b@
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 #-}