{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints #-}
#endif
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Data.Bytes.Get
( MonadGet(..)
, runGetL
, runGetS
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad (liftM, unless)
import Control.Monad.Reader (ReaderT(..))
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
forall a b. Coercible a b => Coercible (m a) (m b),
#endif
Integral (Remaining m), Fail.MonadFail m, Applicative m) => MonadGet m where
type Remaining m :: *
type Bytes m :: *
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
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
lookAhead :: m a -> m a
lookAheadM :: m (Maybe a) -> m (Maybe a)
lookAheadE :: m (Either a b) -> m (Either a b)
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 #-}
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
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