{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints #-}
#endif

{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013-2015
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: type-families
--
-- This module generalizes the @binary@ 'B.Get' and @cereal@ 'S.Get'
-- monads in an ad hoc fashion to permit code to be written that is
-- compatible across them.
--
-- Moreover, this class permits code to be written to be portable over
-- various monad transformers applied to these as base monads.
--------------------------------------------------------------------
module Data.Bytes.Get
  ( MonadGet(..)
  , runGetL
  , runGetS
  ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Except as Except
import Control.Monad.RWS.Lazy as Lazy
import Control.Monad.RWS.Strict as Strict
import Control.Monad.State.Lazy as Lazy
import Control.Monad.State.Strict as Strict
import Control.Monad.Writer.Lazy as Lazy
import Control.Monad.Writer.Strict as Strict
import qualified Data.Binary.Get as B
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString as Strict
import Data.Int
import qualified Data.Serialize.Get as S
import Data.Word

import Control.Monad.Trans.Instances ()
import Data.Binary.Orphans ()
import qualified Control.Monad.Fail as Fail
#if __GLASGOW_HASKELL__ >= 806
import Data.Coerce (Coercible)
#endif

class (
#if __GLASGOW_HASKELL__ >= 806
     -- This superclass exists for the benefit of Serial, which uses MonadGet
     -- in one of its methods. Giving MonadGet this superclass allows Serial to
     -- be derived using GeneralizedNewtypeDeriving/DerivingVia.
     forall a b. Coercible a b => Coercible (m a) (m b),
#endif
     Integral (Remaining m), Fail.MonadFail m, Applicative m) => MonadGet m where
  -- | An 'Integral' number type used for unchecked skips and counting.
  type Remaining m :: *

  -- | The underlying ByteString type used by this instance
  type Bytes m :: *

  -- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.
  skip :: Int -> m ()
#ifndef HLINT
  default skip :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m ()
  skip = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> t n ()) -> (Int -> n ()) -> Int -> t n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> n ()
forall (m :: * -> *). MonadGet m => Int -> m ()
skip
#endif

  -- | If at least @n@ bytes are available return at least that much of the current input.
  -- Otherwise fail.
  ensure :: Int -> m Strict.ByteString
#ifndef HLINT
  default ensure :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m Strict.ByteString
  ensure = n ByteString -> t n ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n ByteString -> t n ByteString)
-> (Int -> n ByteString) -> Int -> t n ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> n ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
ensure
#endif

  -- | Run @ga@, but return without consuming its input.
  -- Fails if @ga@ fails.
  lookAhead :: m a -> m a

  -- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.
  -- Fails if @gma@ fails.
  lookAheadM :: m (Maybe a) -> m (Maybe a)

  -- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'.
  -- Fails if @gea@ fails.
  lookAheadE :: m (Either a b) -> m (Either a b)

  -- | Pull @n@ bytes from the input, as a strict ByteString.
  getBytes :: Int -> m Strict.ByteString
#ifndef HLINT
  default getBytes :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m Strict.ByteString
  getBytes = n ByteString -> t n ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n ByteString -> t n ByteString)
-> (Int -> n ByteString) -> Int -> t n ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> n ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getBytes
#endif

  -- | Get the number of remaining unparsed bytes.
  -- Useful for checking whether all input has been consumed.
  -- Note that this forces the rest of the input.
  remaining :: m (Remaining m)
#ifndef HLINT
  default remaining :: (MonadTrans t, MonadGet n, m ~ t n, Remaining m ~ Remaining n)
                    => m (Remaining m)
  remaining = n (Remaining m) -> t n (Remaining m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n (Remaining m)
forall (m :: * -> *). MonadGet m => m (Remaining m)
remaining
#endif

  -- | Test whether all input has been consumed,
  -- i.e. there are no remaining unparsed bytes.
  isEmpty :: m Bool
#ifndef HLINT
  default isEmpty :: (MonadTrans t, MonadGet n, m ~ t n) => m Bool
  isEmpty = n Bool -> t n Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty
#endif

  -- | Read a Word8 from the monad state
  getWord8 :: m Word8
#ifndef HLINT
  default getWord8 :: (MonadTrans t, MonadGet n, m ~ t n) => m Word8
  getWord8 = n Word8 -> t n Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
#endif

  -- | An efficient 'get' method for strict ByteStrings. Fails if fewer
  -- than @n@ bytes are left in the input.
  getByteString :: Int -> m Strict.ByteString
#ifndef HLINT
  default getByteString :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m Strict.ByteString
  getByteString = n ByteString -> t n ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n ByteString -> t n ByteString)
-> (Int -> n ByteString) -> Int -> t n ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> n ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString
#endif

  -- | An efficient 'get' method for lazy ByteStrings. Does not fail if fewer than
  -- @n@ bytes are left in the input.
  getLazyByteString :: Int64 -> m Lazy.ByteString
#ifndef HLINT
  default getLazyByteString :: (MonadTrans t, MonadGet n, m ~ t n) => Int64 -> m Lazy.ByteString
  getLazyByteString = n ByteString -> t n ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n ByteString -> t n ByteString)
-> (Int64 -> n ByteString) -> Int64 -> t n ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> n ByteString
forall (m :: * -> *). MonadGet m => Int64 -> m ByteString
getLazyByteString
#endif

  -- | Read a 'Word16' in big endian format
  getWord16be   :: m Word16
#ifndef HLINT
  default getWord16be :: (MonadTrans t, MonadGet n, m ~ t n) => m Word16
  getWord16be = n Word16 -> t n Word16
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be
#endif

  -- | Read a 'Word16' in little endian format
  getWord16le   :: m Word16
#ifndef HLINT
  default getWord16le :: (MonadTrans t, MonadGet n, m ~ t n) => m Word16
  getWord16le = n Word16 -> t n Word16
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16le
#endif

  -- | /O(1)./ Read a 2 byte 'Word16' in native host order and host endianness.
  getWord16host :: m Word16
#ifndef HLINT
  default getWord16host :: (MonadTrans t, MonadGet n, m ~ t n) => m Word16
  getWord16host = n Word16 -> t n Word16
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16host
#endif

  -- | Read a 'Word32' in big endian format
  getWord32be   :: m Word32
#ifndef HLINT
  default getWord32be :: (MonadTrans t, MonadGet n, m ~ t n) => m Word32
  getWord32be = n Word32 -> t n Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
#endif

  -- | Read a 'Word32' in little endian format
  getWord32le   :: m Word32
#ifndef HLINT
  default getWord32le :: (MonadTrans t, MonadGet n, m ~ t n) => m Word32
  getWord32le = n Word32 -> t n Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
#endif

  -- | /O(1)./ Read a 'Word32' in native host order and host endianness.
  getWord32host :: m Word32
#ifndef HLINT
  default getWord32host :: (MonadTrans t, MonadGet n, m ~ t n) => m Word32
  getWord32host = n Word32 -> t n Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32host
#endif

  -- | Read a 'Word64' in big endian format
  getWord64be   :: m Word64
#ifndef HLINT
  default getWord64be :: (MonadTrans t, MonadGet n, m ~ t n) => m Word64
  getWord64be = n Word64 -> t n Word64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
#endif


  -- | Read a 'Word64' in little endian format
  getWord64le   :: m Word64
#ifndef HLINT
  default getWord64le :: (MonadTrans t, MonadGet n, m ~ t n) => m Word64
  getWord64le = n Word64 -> t n Word64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
#endif

  -- | /O(1)./ Read a 'Word64' in native host order and host endianness.
  getWord64host :: m Word64
#ifndef HLINT
  default getWord64host :: (MonadTrans t, MonadGet n, m ~ t n) => m Word64
  getWord64host = n Word64 -> t n Word64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64host
#endif

  -- | /O(1)./ Read a single native machine word. The word is read in
  -- host order, host endian form, for the machine you're on. On a 64 bit
  -- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.
  getWordhost :: m Word
#ifndef HLINT
  default getWordhost :: (MonadTrans t, MonadGet n, m ~ t n) => m Word
  getWordhost = n Word -> t n Word
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Word
forall (m :: * -> *). MonadGet m => m Word
getWordhost
#endif

instance MonadGet B.Get where
  type Remaining B.Get = Int64
  type Bytes B.Get = Lazy.ByteString
  skip :: Int -> Get ()
skip = Int -> Get ()
B.skip
  {-# INLINE skip #-}
  lookAhead :: Get a -> Get a
lookAhead = Get a -> Get a
forall a. Get a -> Get a
B.lookAhead
  {-# INLINE lookAhead #-}
  lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM = Get (Maybe a) -> Get (Maybe a)
forall a. Get (Maybe a) -> Get (Maybe a)
B.lookAheadM
  {-# INLINE lookAheadM #-}
  lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE = Get (Either a b) -> Get (Either a b)
forall a b. Get (Either a b) -> Get (Either a b)
B.lookAheadE
  {-# INLINE lookAheadE #-}
  ensure :: Int -> Get ByteString
ensure Int
n = do
    ByteString
bs <- Get ByteString -> Get ByteString
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (Get ByteString -> Get ByteString)
-> Get ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
n
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
Strict.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
"ensure: Required more bytes"
    ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  {-# INLINE ensure #-}
  getBytes :: Int -> Get ByteString
getBytes = Int -> Get ByteString
B.getByteString
  {-# INLINE getBytes #-}
  remaining :: Get (Remaining Get)
remaining = Get Int64
Get (Remaining Get)
B.remaining
  {-# INLINE remaining #-}
  isEmpty :: Get Bool
isEmpty = Get Bool
B.isEmpty
  {-# INLINE isEmpty #-}
  getWord8 :: Get Word8
getWord8 = Get Word8
B.getWord8
  {-# INLINE getWord8 #-}
  getByteString :: Int -> Get ByteString
getByteString = Int -> Get ByteString
B.getByteString
  {-# INLINE getByteString #-}
  getLazyByteString :: Int64 -> Get ByteString
getLazyByteString = Int64 -> Get ByteString
B.getLazyByteString
  {-# INLINE getLazyByteString #-}
  getWord16be :: Get Word16
getWord16be   = Get Word16
B.getWord16be
  {-# INLINE getWord16be #-}
  getWord16le :: Get Word16
getWord16le   = Get Word16
B.getWord16le
  {-# INLINE getWord16le #-}
  getWord16host :: Get Word16
getWord16host = Get Word16
B.getWord16host
  {-# INLINE getWord16host #-}
  getWord32be :: Get Word32
getWord32be   = Get Word32
B.getWord32be
  {-# INLINE getWord32be #-}
  getWord32le :: Get Word32
getWord32le   = Get Word32
B.getWord32le
  {-# INLINE getWord32le #-}
  getWord32host :: Get Word32
getWord32host = Get Word32
B.getWord32host
  {-# INLINE getWord32host #-}
  getWord64be :: Get Word64
getWord64be   = Get Word64
B.getWord64be
  {-# INLINE getWord64be #-}
  getWord64le :: Get Word64
getWord64le   = Get Word64
B.getWord64le
  {-# INLINE getWord64le #-}
  getWord64host :: Get Word64
getWord64host = Get Word64
B.getWord64host
  {-# INLINE getWord64host #-}
  getWordhost :: Get Word
getWordhost   = Get Word
B.getWordhost
  {-# INLINE getWordhost #-}

instance MonadGet S.Get where
  type Remaining S.Get = Int
  type Bytes S.Get = Strict.ByteString
  skip :: Int -> Get ()
skip = Int -> Get ()
S.skip
  {-# INLINE skip #-}
  lookAhead :: Get a -> Get a
lookAhead = Get a -> Get a
forall a. Get a -> Get a
S.lookAhead
  {-# INLINE lookAhead #-}
  lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM = Get (Maybe a) -> Get (Maybe a)
forall a. Get (Maybe a) -> Get (Maybe a)
S.lookAheadM
  {-# INLINE lookAheadM #-}
  lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE = Get (Either a b) -> Get (Either a b)
forall a b. Get (Either a b) -> Get (Either a b)
S.lookAheadE
  {-# INLINE lookAheadE #-}
  getBytes :: Int -> Get ByteString
getBytes = Int -> Get ByteString
S.getBytes
  {-# INLINE getBytes #-}
  ensure :: Int -> Get ByteString
ensure = Int -> Get ByteString
S.ensure
  {-# INLINE ensure #-}
  remaining :: Get (Remaining Get)
remaining = Get Int
Get (Remaining Get)
S.remaining
  {-# INLINE remaining #-}
  isEmpty :: Get Bool
isEmpty = Get Bool
S.isEmpty
  {-# INLINE isEmpty #-}
  getWord8 :: Get Word8
getWord8 = Get Word8
S.getWord8
  {-# INLINE getWord8 #-}
  getByteString :: Int -> Get ByteString
getByteString = Int -> Get ByteString
S.getByteString
  {-# INLINE getByteString #-}
  getLazyByteString :: Int64 -> Get ByteString
getLazyByteString = Int64 -> Get ByteString
S.getLazyByteString
  {-# INLINE getLazyByteString #-}
  getWord16be :: Get Word16
getWord16be   = Get Word16
S.getWord16be
  {-# INLINE getWord16be #-}
  getWord16le :: Get Word16
getWord16le   = Get Word16
S.getWord16le
  {-# INLINE getWord16le #-}
  getWord16host :: Get Word16
getWord16host = Get Word16
S.getWord16host
  {-# INLINE getWord16host #-}
  getWord32be :: Get Word32
getWord32be   = Get Word32
S.getWord32be
  {-# INLINE getWord32be #-}
  getWord32le :: Get Word32
getWord32le   = Get Word32
S.getWord32le
  {-# INLINE getWord32le #-}
  getWord32host :: Get Word32
getWord32host = Get Word32
S.getWord32host
  {-# INLINE getWord32host #-}
  getWord64be :: Get Word64
getWord64be   = Get Word64
S.getWord64be
  {-# INLINE getWord64be #-}
  getWord64le :: Get Word64
getWord64le   = Get Word64
S.getWord64le
  {-# INLINE getWord64le #-}
  getWord64host :: Get Word64
getWord64host = Get Word64
S.getWord64host
  {-# INLINE getWord64host #-}
  getWordhost :: Get Word
getWordhost   = Get Word
S.getWordhost
  {-# INLINE getWordhost #-}

instance MonadGet m => MonadGet (Lazy.StateT s m) where
  type Remaining (Lazy.StateT s m) = Remaining m
  type Bytes (Lazy.StateT s m) = Bytes m
  lookAhead :: StateT s m a -> StateT s m a
lookAhead (Lazy.StateT s -> m (a, s)
m) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT (m (a, s) -> m (a, s)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
m)
  {-# INLINE lookAhead #-}
  lookAheadM :: StateT s m (Maybe a) -> StateT s m (Maybe a)
lookAheadM (Lazy.StateT s -> m (Maybe a, s)
m) = (s -> m (Maybe a, s)) -> StateT s m (Maybe a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((Either (Maybe a, s) (Maybe a, s) -> (Maybe a, s))
-> m (Either (Maybe a, s) (Maybe a, s)) -> m (Maybe a, s)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Maybe a, s) (Maybe a, s) -> (Maybe a, s)
forall c. Either c c -> c
factor (m (Either (Maybe a, s) (Maybe a, s)) -> m (Maybe a, s))
-> (s -> m (Either (Maybe a, s) (Maybe a, s)))
-> s
-> m (Maybe a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (Maybe a, s) (Maybe a, s))
-> m (Either (Maybe a, s) (Maybe a, s))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Maybe a, s) (Maybe a, s))
 -> m (Either (Maybe a, s) (Maybe a, s)))
-> (s -> m (Either (Maybe a, s) (Maybe a, s)))
-> s
-> m (Either (Maybe a, s) (Maybe a, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe a, s) -> Either (Maybe a, s) (Maybe a, s))
-> m (Maybe a, s) -> m (Either (Maybe a, s) (Maybe a, s))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a, s) -> Either (Maybe a, s) (Maybe a, s)
forall a b a. (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute (m (Maybe a, s) -> m (Either (Maybe a, s) (Maybe a, s)))
-> (s -> m (Maybe a, s))
-> s
-> m (Either (Maybe a, s) (Maybe a, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Maybe a, s)
m)
    where
    distribute :: (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute (Maybe a
Nothing, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. a -> Either a b
Left (Maybe a
forall a. Maybe a
Nothing, b
s')
    distribute (Just a
a, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
s')
    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 :: StateT s m (Either a b) -> StateT s m (Either a b)
lookAheadE (Lazy.StateT s -> m (Either a b, s)
m) = (s -> m (Either a b, s)) -> StateT s m (Either a b)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((Either (Either a b, s) (Either a b, s) -> (Either a b, s))
-> m (Either (Either a b, s) (Either a b, s)) -> m (Either a b, s)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either a b, s) (Either a b, s) -> (Either a b, s)
forall c. Either c c -> c
factor (m (Either (Either a b, s) (Either a b, s)) -> m (Either a b, s))
-> (s -> m (Either (Either a b, s) (Either a b, s)))
-> s
-> m (Either a b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (Either a b, s) (Either a b, s))
-> m (Either (Either a b, s) (Either a b, s))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either a b, s) (Either a b, s))
 -> m (Either (Either a b, s) (Either a b, s)))
-> (s -> m (Either (Either a b, s) (Either a b, s)))
-> s
-> m (Either (Either a b, s) (Either a b, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either a b, s) -> Either (Either a b, s) (Either a b, s))
-> m (Either a b, s) -> m (Either (Either a b, s) (Either a b, s))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a b, s) -> Either (Either a b, s) (Either a b, s)
forall a b b b a.
(Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute (m (Either a b, s) -> m (Either (Either a b, s) (Either a b, s)))
-> (s -> m (Either a b, s))
-> s
-> m (Either (Either a b, s) (Either a b, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Either a b, s)
m)
    where
    distribute :: (Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute (Left a
a, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a, b
s')
    distribute (Right b
b, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
b, b
s')
    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 #-}

instance MonadGet m => MonadGet (Strict.StateT s m) where
  type Remaining (Strict.StateT s m) = Remaining m
  type Bytes (Strict.StateT s m) = Bytes m
  lookAhead :: StateT s m a -> StateT s m a
lookAhead (Strict.StateT s -> m (a, s)
m) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT (m (a, s) -> m (a, s)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
m)
  {-# INLINE lookAhead #-}
  lookAheadM :: StateT s m (Maybe a) -> StateT s m (Maybe a)
lookAheadM (Strict.StateT s -> m (Maybe a, s)
m) = (s -> m (Maybe a, s)) -> StateT s m (Maybe a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((Either (Maybe a, s) (Maybe a, s) -> (Maybe a, s))
-> m (Either (Maybe a, s) (Maybe a, s)) -> m (Maybe a, s)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Maybe a, s) (Maybe a, s) -> (Maybe a, s)
forall c. Either c c -> c
factor (m (Either (Maybe a, s) (Maybe a, s)) -> m (Maybe a, s))
-> (s -> m (Either (Maybe a, s) (Maybe a, s)))
-> s
-> m (Maybe a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (Maybe a, s) (Maybe a, s))
-> m (Either (Maybe a, s) (Maybe a, s))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Maybe a, s) (Maybe a, s))
 -> m (Either (Maybe a, s) (Maybe a, s)))
-> (s -> m (Either (Maybe a, s) (Maybe a, s)))
-> s
-> m (Either (Maybe a, s) (Maybe a, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe a, s) -> Either (Maybe a, s) (Maybe a, s))
-> m (Maybe a, s) -> m (Either (Maybe a, s) (Maybe a, s))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a, s) -> Either (Maybe a, s) (Maybe a, s)
forall a b a. (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute (m (Maybe a, s) -> m (Either (Maybe a, s) (Maybe a, s)))
-> (s -> m (Maybe a, s))
-> s
-> m (Either (Maybe a, s) (Maybe a, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Maybe a, s)
m)
    where
    distribute :: (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute (Maybe a
Nothing, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. a -> Either a b
Left (Maybe a
forall a. Maybe a
Nothing, b
s')
    distribute (Just a
a, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
s')
    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 :: StateT s m (Either a b) -> StateT s m (Either a b)
lookAheadE (Strict.StateT s -> m (Either a b, s)
m) = (s -> m (Either a b, s)) -> StateT s m (Either a b)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((Either (Either a b, s) (Either a b, s) -> (Either a b, s))
-> m (Either (Either a b, s) (Either a b, s)) -> m (Either a b, s)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either a b, s) (Either a b, s) -> (Either a b, s)
forall c. Either c c -> c
factor (m (Either (Either a b, s) (Either a b, s)) -> m (Either a b, s))
-> (s -> m (Either (Either a b, s) (Either a b, s)))
-> s
-> m (Either a b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (Either a b, s) (Either a b, s))
-> m (Either (Either a b, s) (Either a b, s))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either a b, s) (Either a b, s))
 -> m (Either (Either a b, s) (Either a b, s)))
-> (s -> m (Either (Either a b, s) (Either a b, s)))
-> s
-> m (Either (Either a b, s) (Either a b, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either a b, s) -> Either (Either a b, s) (Either a b, s))
-> m (Either a b, s) -> m (Either (Either a b, s) (Either a b, s))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a b, s) -> Either (Either a b, s) (Either a b, s)
forall a b b b a.
(Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute (m (Either a b, s) -> m (Either (Either a b, s) (Either a b, s)))
-> (s -> m (Either a b, s))
-> s
-> m (Either (Either a b, s) (Either a b, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Either a b, s)
m)
    where
    distribute :: (Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute (Left a
a, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a, b
s')
    distribute (Right b
b, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
b, b
s')
    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 #-}

instance MonadGet m => MonadGet (ReaderT e m) where
  type Remaining (ReaderT e m) = Remaining m
  type Bytes (ReaderT e m) = Bytes m
  lookAhead :: ReaderT e m a -> ReaderT e m a
lookAhead (ReaderT e -> m a
m) = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (m a -> m a) -> (e -> m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
m)
  {-# INLINE lookAhead #-}
  lookAheadM :: ReaderT e m (Maybe a) -> ReaderT e m (Maybe a)
lookAheadM (ReaderT e -> m (Maybe a)
m) = (e -> m (Maybe a)) -> ReaderT e m (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadGet m => m (Maybe a) -> m (Maybe a)
lookAheadM (m (Maybe a) -> m (Maybe a))
-> (e -> m (Maybe a)) -> e -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m (Maybe a)
m)
  {-# INLINE lookAheadM #-}
  lookAheadE :: ReaderT e m (Either a b) -> ReaderT e m (Either a b)
lookAheadE (ReaderT e -> m (Either a b)
m) = (e -> m (Either a b)) -> ReaderT e m (Either a b)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m (Either a b) -> m (Either a b)
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either a b) -> m (Either a b))
-> (e -> m (Either a b)) -> e -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m (Either a b)
m)
  {-# INLINE lookAheadE #-}

instance (MonadGet m, Monoid w) => MonadGet (Lazy.WriterT w m) where
  type Remaining (Lazy.WriterT w m) = Remaining m
  type Bytes (Lazy.WriterT w m) = Bytes m
  lookAhead :: WriterT w m a -> WriterT w m a
lookAhead (Lazy.WriterT m (a, w)
m) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> m (a, w)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead m (a, w)
m)
  {-# INLINE lookAhead #-}
  lookAheadM :: WriterT w m (Maybe a) -> WriterT w m (Maybe a)
lookAheadM (Lazy.WriterT m (Maybe a, w)
m) = m (Maybe a, w) -> WriterT w m (Maybe a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT ((Either (Maybe a, w) (Maybe a, w) -> (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w)) -> m (Maybe a, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Maybe a, w) (Maybe a, w) -> (Maybe a, w)
forall c. Either c c -> c
factor (m (Either (Maybe a, w) (Maybe a, w)) -> m (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w)) -> m (Maybe a, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Maybe a, w) (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Maybe a, w) (Maybe a, w))
 -> m (Either (Maybe a, w) (Maybe a, w)))
-> m (Either (Maybe a, w) (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w))
forall a b. (a -> b) -> a -> b
$ ((Maybe a, w) -> Either (Maybe a, w) (Maybe a, w))
-> m (Maybe a, w) -> m (Either (Maybe a, w) (Maybe a, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a, w) -> Either (Maybe a, w) (Maybe a, w)
forall a b a. (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute m (Maybe a, w)
m)
    where
    distribute :: (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute (Maybe a
Nothing, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. a -> Either a b
Left (Maybe a
forall a. Maybe a
Nothing, b
s')
    distribute (Just a
a, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
s')
    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 :: WriterT w m (Either a b) -> WriterT w m (Either a b)
lookAheadE (Lazy.WriterT m (Either a b, w)
m) = m (Either a b, w) -> WriterT w m (Either a b)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT ((Either (Either a b, w) (Either a b, w) -> (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w)) -> m (Either a b, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either a b, w) (Either a b, w) -> (Either a b, w)
forall c. Either c c -> c
factor (m (Either (Either a b, w) (Either a b, w)) -> m (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w)) -> m (Either a b, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Either a b, w) (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either a b, w) (Either a b, w))
 -> m (Either (Either a b, w) (Either a b, w)))
-> m (Either (Either a b, w) (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w))
forall a b. (a -> b) -> a -> b
$ ((Either a b, w) -> Either (Either a b, w) (Either a b, w))
-> m (Either a b, w) -> m (Either (Either a b, w) (Either a b, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a b, w) -> Either (Either a b, w) (Either a b, w)
forall a b b b a.
(Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute m (Either a b, w)
m)
    where
    distribute :: (Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute (Left a
a, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a, b
s')
    distribute (Right b
b, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
b, b
s')
    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 #-}

instance (MonadGet m, Monoid w) => MonadGet (Strict.WriterT w m) where
  type Remaining (Strict.WriterT w m) = Remaining m
  type Bytes (Strict.WriterT w m) = Bytes m
  lookAhead :: WriterT w m a -> WriterT w m a
lookAhead (Strict.WriterT m (a, w)
m) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> m (a, w)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead m (a, w)
m)
  {-# INLINE lookAhead #-}
  lookAheadM :: WriterT w m (Maybe a) -> WriterT w m (Maybe a)
lookAheadM (Strict.WriterT m (Maybe a, w)
m) = m (Maybe a, w) -> WriterT w m (Maybe a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT ((Either (Maybe a, w) (Maybe a, w) -> (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w)) -> m (Maybe a, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Maybe a, w) (Maybe a, w) -> (Maybe a, w)
forall c. Either c c -> c
factor (m (Either (Maybe a, w) (Maybe a, w)) -> m (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w)) -> m (Maybe a, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Maybe a, w) (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Maybe a, w) (Maybe a, w))
 -> m (Either (Maybe a, w) (Maybe a, w)))
-> m (Either (Maybe a, w) (Maybe a, w))
-> m (Either (Maybe a, w) (Maybe a, w))
forall a b. (a -> b) -> a -> b
$ ((Maybe a, w) -> Either (Maybe a, w) (Maybe a, w))
-> m (Maybe a, w) -> m (Either (Maybe a, w) (Maybe a, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a, w) -> Either (Maybe a, w) (Maybe a, w)
forall a b a. (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute m (Maybe a, w)
m)
    where
    distribute :: (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
distribute (Maybe a
Nothing, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. a -> Either a b
Left (Maybe a
forall a. Maybe a
Nothing, b
s')
    distribute (Just a
a, b
s') = (Maybe a, b) -> Either (Maybe a, b) (Maybe a, b)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
s')
    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 :: WriterT w m (Either a b) -> WriterT w m (Either a b)
lookAheadE (Strict.WriterT m (Either a b, w)
m) = m (Either a b, w) -> WriterT w m (Either a b)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT ((Either (Either a b, w) (Either a b, w) -> (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w)) -> m (Either a b, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either a b, w) (Either a b, w) -> (Either a b, w)
forall c. Either c c -> c
factor (m (Either (Either a b, w) (Either a b, w)) -> m (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w)) -> m (Either a b, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Either a b, w) (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either a b, w) (Either a b, w))
 -> m (Either (Either a b, w) (Either a b, w)))
-> m (Either (Either a b, w) (Either a b, w))
-> m (Either (Either a b, w) (Either a b, w))
forall a b. (a -> b) -> a -> b
$ ((Either a b, w) -> Either (Either a b, w) (Either a b, w))
-> m (Either a b, w) -> m (Either (Either a b, w) (Either a b, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a b, w) -> Either (Either a b, w) (Either a b, w)
forall a b b b a.
(Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute m (Either a b, w)
m)
    where
    distribute :: (Either a b, b) -> Either (Either a b, b) (Either a b, b)
distribute (Left a
a, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a, b
s')
    distribute (Right b
b, b
s') = (Either a b, b) -> Either (Either a b, b) (Either a b, b)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
b, b
s')
    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 #-}

instance (MonadGet m, Monoid w) => MonadGet (Strict.RWST r w s m) where
  type Remaining (Strict.RWST r w s m) = Remaining m
  type Bytes (Strict.RWST r w s m) = Bytes m
  lookAhead :: RWST r w s m a -> RWST r w s m a
lookAhead (Strict.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (r -> s -> m (a, s, w)
m r
r s
s)
  {-# INLINE lookAhead #-}
  lookAheadM :: RWST r w s m (Maybe a) -> RWST r w s m (Maybe a)
lookAheadM (Strict.RWST r -> s -> m (Maybe a, s, w)
m) = (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST (\r
r s
s -> (Either (Maybe a, s, w) (Maybe a, s, w) -> (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w)) -> m (Maybe a, s, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Maybe a, s, w) (Maybe a, s, w) -> (Maybe a, s, w)
forall c. Either c c -> c
factor (m (Either (Maybe a, s, w) (Maybe a, s, w)) -> m (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w)) -> m (Maybe a, s, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Maybe a, s, w) (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Maybe a, s, w) (Maybe a, s, w))
 -> m (Either (Maybe a, s, w) (Maybe a, s, w)))
-> m (Either (Maybe a, s, w) (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall a b. (a -> b) -> a -> b
$ ((Maybe a, s, w) -> Either (Maybe a, s, w) (Maybe a, s, w))
-> m (Maybe a, s, w) -> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a, s, w) -> Either (Maybe a, s, w) (Maybe a, s, w)
forall a b c a.
(Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
distribute (m (Maybe a, s, w) -> m (Either (Maybe a, s, w) (Maybe a, s, w)))
-> m (Maybe a, s, w) -> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall a b. (a -> b) -> a -> b
$ r -> s -> m (Maybe a, s, w)
m r
r s
s )
    where
    distribute :: (Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
distribute (Maybe a
Nothing, b
s',c
w') = (Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
forall a b. a -> Either a b
Left (Maybe a
forall a. Maybe a
Nothing, b
s', c
w')
    distribute (Just a
a, b
s',c
w') = (Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
s', c
w')
    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 :: RWST r w s m (Either a b) -> RWST r w s m (Either a b)
lookAheadE (Strict.RWST r -> s -> m (Either a b, s, w)
m) = (r -> s -> m (Either a b, s, w)) -> RWST r w s m (Either a b)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST (\r
r s
s -> (Either (Either a b, s, w) (Either a b, s, w)
 -> (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either a b, s, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either a b, s, w) (Either a b, s, w) -> (Either a b, s, w)
forall c. Either c c -> c
factor (m (Either (Either a b, s, w) (Either a b, s, w))
 -> m (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either a b, s, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either a b, s, w) (Either a b, s, w))
 -> m (Either (Either a b, s, w) (Either a b, s, w)))
-> m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall a b. (a -> b) -> a -> b
$ ((Either a b, s, w)
 -> Either (Either a b, s, w) (Either a b, s, w))
-> m (Either a b, s, w)
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a b, s, w) -> Either (Either a b, s, w) (Either a b, s, w)
forall a b b c b a.
(Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
distribute (m (Either a b, s, w)
 -> m (Either (Either a b, s, w) (Either a b, s, w)))
-> m (Either a b, s, w)
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall a b. (a -> b) -> a -> b
$ r -> s -> m (Either a b, s, w)
m r
r s
s)
    where
    distribute :: (Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
distribute (Left a
a, b
s', c
w') = (Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a, b
s', c
w')
    distribute (Right b
b, b
s', c
w') = (Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
b, b
s', c
w')
    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 #-}

instance (MonadGet m, Monoid w) => MonadGet (Lazy.RWST r w s m) where
  type Remaining (Lazy.RWST r w s m) = Remaining m
  type Bytes (Lazy.RWST r w s m) = Bytes m
  lookAhead :: RWST r w s m a -> RWST r w s m a
lookAhead (Lazy.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (r -> s -> m (a, s, w)
m r
r s
s)
  {-# INLINE lookAhead #-}
  lookAheadM :: RWST r w s m (Maybe a) -> RWST r w s m (Maybe a)
lookAheadM (Lazy.RWST r -> s -> m (Maybe a, s, w)
m) = (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST (\r
r s
s -> (Either (Maybe a, s, w) (Maybe a, s, w) -> (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w)) -> m (Maybe a, s, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Maybe a, s, w) (Maybe a, s, w) -> (Maybe a, s, w)
forall c. Either c c -> c
factor (m (Either (Maybe a, s, w) (Maybe a, s, w)) -> m (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w)) -> m (Maybe a, s, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Maybe a, s, w) (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Maybe a, s, w) (Maybe a, s, w))
 -> m (Either (Maybe a, s, w) (Maybe a, s, w)))
-> m (Either (Maybe a, s, w) (Maybe a, s, w))
-> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall a b. (a -> b) -> a -> b
$ ((Maybe a, s, w) -> Either (Maybe a, s, w) (Maybe a, s, w))
-> m (Maybe a, s, w) -> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a, s, w) -> Either (Maybe a, s, w) (Maybe a, s, w)
forall a b c a.
(Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
distribute (m (Maybe a, s, w) -> m (Either (Maybe a, s, w) (Maybe a, s, w)))
-> m (Maybe a, s, w) -> m (Either (Maybe a, s, w) (Maybe a, s, w))
forall a b. (a -> b) -> a -> b
$ r -> s -> m (Maybe a, s, w)
m r
r s
s )
    where
    distribute :: (Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
distribute (Maybe a
Nothing, b
s',c
w') = (Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
forall a b. a -> Either a b
Left (Maybe a
forall a. Maybe a
Nothing, b
s', c
w')
    distribute (Just a
a, b
s',c
w') = (Maybe a, b, c) -> Either (Maybe a, b, c) (Maybe a, b, c)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b
s', c
w')
    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 :: RWST r w s m (Either a b) -> RWST r w s m (Either a b)
lookAheadE (Lazy.RWST r -> s -> m (Either a b, s, w)
m) = (r -> s -> m (Either a b, s, w)) -> RWST r w s m (Either a b)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST (\r
r s
s -> (Either (Either a b, s, w) (Either a b, s, w)
 -> (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either a b, s, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either a b, s, w) (Either a b, s, w) -> (Either a b, s, w)
forall c. Either c c -> c
factor (m (Either (Either a b, s, w) (Either a b, s, w))
 -> m (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either a b, s, w)
forall a b. (a -> b) -> a -> b
$ m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either a b, s, w) (Either a b, s, w))
 -> m (Either (Either a b, s, w) (Either a b, s, w)))
-> m (Either (Either a b, s, w) (Either a b, s, w))
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall a b. (a -> b) -> a -> b
$ ((Either a b, s, w)
 -> Either (Either a b, s, w) (Either a b, s, w))
-> m (Either a b, s, w)
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a b, s, w) -> Either (Either a b, s, w) (Either a b, s, w)
forall a b b c b a.
(Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
distribute (m (Either a b, s, w)
 -> m (Either (Either a b, s, w) (Either a b, s, w)))
-> m (Either a b, s, w)
-> m (Either (Either a b, s, w) (Either a b, s, w))
forall a b. (a -> b) -> a -> b
$ r -> s -> m (Either a b, s, w)
m r
r s
s)
    where
    distribute :: (Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
distribute (Left a
a, b
s', c
w') = (Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a, b
s', c
w')
    distribute (Right b
b, b
s', c
w') = (Either a b, b, c) -> Either (Either a b, b, c) (Either a b, b, c)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
b, b
s', c
w')
    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 #-}

instance MonadGet m => MonadGet (ExceptT e m) where
  type Remaining (ExceptT e m) = Remaining m
  type Bytes (ExceptT e m) = Bytes m
  lookAhead :: ExceptT e m a -> ExceptT e m a
lookAhead = (m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either e a) -> m (Either e a)
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead
  {-# INLINE lookAhead #-}
  lookAheadM :: ExceptT e m (Maybe a) -> ExceptT e m (Maybe a)
lookAheadM (ExceptT m (Either e (Maybe a))
m) = m (Either e (Maybe a)) -> ExceptT e m (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((Either (Either e (Maybe a)) (Either e (Maybe a))
 -> Either e (Maybe a))
-> m (Either (Either e (Maybe a)) (Either e (Maybe a)))
-> m (Either e (Maybe a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either e (Maybe a)) (Either e (Maybe a))
-> Either e (Maybe a)
forall c. Either c c -> c
factor (m (Either (Either e (Maybe a)) (Either e (Maybe a)))
 -> m (Either e (Maybe a)))
-> m (Either (Either e (Maybe a)) (Either e (Maybe a)))
-> m (Either e (Maybe a))
forall a b. (a -> b) -> a -> b
$ m (Either (Either e (Maybe a)) (Either e (Maybe a)))
-> m (Either (Either e (Maybe a)) (Either e (Maybe a)))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either e (Maybe a)) (Either e (Maybe a)))
 -> m (Either (Either e (Maybe a)) (Either e (Maybe a))))
-> m (Either (Either e (Maybe a)) (Either e (Maybe a)))
-> m (Either (Either e (Maybe a)) (Either e (Maybe a)))
forall a b. (a -> b) -> a -> b
$ (Either e (Maybe a)
 -> Either (Either e (Maybe a)) (Either e (Maybe a)))
-> m (Either e (Maybe a))
-> m (Either (Either e (Maybe a)) (Either e (Maybe a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either e (Maybe a)
-> Either (Either e (Maybe a)) (Either e (Maybe a))
forall a b b a. Either a b -> Either (Either a b) (Either a b)
distribute m (Either e (Maybe a))
m)
    where
    distribute :: Either a b -> Either (Either a b) (Either a b)
distribute (Left a
e) = (Either a b -> Either (Either a b) (Either a b)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
e))
    distribute (Right b
j) = (Either a b -> Either (Either a b) (Either a b)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
j))
    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 :: ExceptT e m (Either a b) -> ExceptT e m (Either a b)
lookAheadE (ExceptT m (Either e (Either a b))
m) = m (Either e (Either a b)) -> ExceptT e m (Either a b)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((Either (Either e (Either a b)) (Either e (Either a b))
 -> Either e (Either a b))
-> m (Either (Either e (Either a b)) (Either e (Either a b)))
-> m (Either e (Either a b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (Either e (Either a b)) (Either e (Either a b))
-> Either e (Either a b)
forall c. Either c c -> c
factor (m (Either (Either e (Either a b)) (Either e (Either a b)))
 -> m (Either e (Either a b)))
-> m (Either (Either e (Either a b)) (Either e (Either a b)))
-> m (Either e (Either a b))
forall a b. (a -> b) -> a -> b
$ m (Either (Either e (Either a b)) (Either e (Either a b)))
-> m (Either (Either e (Either a b)) (Either e (Either a b)))
forall (m :: * -> *) a b.
MonadGet m =>
m (Either a b) -> m (Either a b)
lookAheadE (m (Either (Either e (Either a b)) (Either e (Either a b)))
 -> m (Either (Either e (Either a b)) (Either e (Either a b))))
-> m (Either (Either e (Either a b)) (Either e (Either a b)))
-> m (Either (Either e (Either a b)) (Either e (Either a b)))
forall a b. (a -> b) -> a -> b
$ (Either e (Either a b)
 -> Either (Either e (Either a b)) (Either e (Either a b)))
-> m (Either e (Either a b))
-> m (Either (Either e (Either a b)) (Either e (Either a b)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either e (Either a b)
-> Either (Either e (Either a b)) (Either e (Either a b))
forall a b b a. Either a b -> Either (Either a b) (Either a b)
distribute m (Either e (Either a b))
m)
    where
    distribute :: Either a b -> Either (Either a b) (Either a b)
distribute (Left a
e) = (Either a b -> Either (Either a b) (Either a b)
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
e))
    distribute (Right b
a) = (Either a b -> Either (Either a b) (Either a b)
forall a b. b -> Either a b
Right (b -> Either a b
forall a b. b -> Either a b
Right b
a))
    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 #-}

-- | Get something from a lazy 'Lazy.ByteString' using 'B.runGet'.
runGetL :: B.Get a -> Lazy.ByteString -> a
runGetL :: Get a -> ByteString -> a
runGetL = Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
B.runGet

-- | Get something from a strict 'Strict.ByteString' using 'S.runGet'.
runGetS :: S.Get a -> Strict.ByteString -> Either String a
runGetS :: Get a -> ByteString -> Either String a
runGetS = Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
S.runGet