    {-# Language LambdaCase #-}
    -- Copyright (C) 2009-2012 John Millikin <john@john-millikin.com>
    --
    -- This program is free software: you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation, either version 3 of the License, or
    -- any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program.  If not, see <http://www.gnu.org/licenses/>.

    module DBus.Internal.Wire
        ( Endianness(..)
        , MarshalError
        , marshalErrorMessage

        , UnmarshalError
        , unmarshalErrorMessage

        , marshalMessage
        , unmarshalMessage
        , unmarshalMessageM
        ) where

    import qualified Control.Applicative
    import           Control.Monad (ap, liftM, when, unless)
    import qualified Data.ByteString
    import           Data.ByteString (ByteString)
    import qualified Data.ByteString.Builder as Builder
    import qualified Data.ByteString.Char8
    import qualified Data.ByteString.Lazy as Lazy
    import           Data.Int (Int16, Int32, Int64)
    import           Data.List (sortOn)
    import qualified Data.Map
    import           Data.Map (Map)
    import           Data.Maybe (fromJust, listToMaybe, fromMaybe)
    import           Data.Monoid
    import           Data.Text (Text)
    import qualified Data.Text.Encoding
    import qualified Data.Vector
    import           Data.Vector (Vector)
    import           Data.Word (Word8, Word16, Word32, Word64)
    import           System.Posix.Types (Fd(..))
    import           Prelude

    import qualified Data.Serialize.Get as Get
    import           Data.Serialize.IEEE754 (getFloat64be, getFloat64le, putFloat64be, putFloat64le)
    import           Data.Serialize.Put (runPut)

    import           DBus.Internal.Message
    import           DBus.Internal.Types

    data Endianness = LittleEndian | BigEndian
        deriving (Int -> Endianness -> ShowS
    [Endianness] -> ShowS
    Endianness -> String
    (Int -> Endianness -> ShowS)
    -> (Endianness -> String)
    -> ([Endianness] -> ShowS)
    -> Show Endianness
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Endianness -> ShowS
    showsPrec :: Int -> Endianness -> ShowS
    $cshow :: Endianness -> String
    show :: Endianness -> String
    $cshowList :: [Endianness] -> ShowS
    showList :: [Endianness] -> ShowS
    Show, Endianness -> Endianness -> Bool
    (Endianness -> Endianness -> Bool)
    -> (Endianness -> Endianness -> Bool) -> Eq Endianness
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Endianness -> Endianness -> Bool
    == :: Endianness -> Endianness -> Bool
    $c/= :: Endianness -> Endianness -> Bool
    /= :: Endianness -> Endianness -> Bool
    Eq)

    encodeEndianness :: Endianness -> Word8
    encodeEndianness :: Endianness -> Word8
    encodeEndianness Endianness
    LittleEndian = Word8
    0x6C
    encodeEndianness Endianness
    BigEndian    = Word8
    0x42

    decodeEndianness :: Word8 -> Maybe Endianness
    decodeEndianness :: Word8 -> Maybe Endianness
    decodeEndianness Word8
    0x6C = Endianness -> Maybe Endianness
    forall a. a -> Maybe a
    Just Endianness
    LittleEndian
    decodeEndianness Word8
    0x42 = Endianness -> Maybe Endianness
    forall a. a -> Maybe a
    Just Endianness
    BigEndian
    decodeEndianness Word8
    _    = Maybe Endianness
    forall a. Maybe a
    Nothing

    alignment :: Type -> Word8
    alignment :: Type -> Word8
    alignment Type
    TypeBoolean = Word8
    4
    alignment Type
    TypeWord8 = Word8
    1
    alignment Type
    TypeWord16 = Word8
    2
    alignment Type
    TypeWord32 = Word8
    4
    alignment Type
    TypeWord64 = Word8
    8
    alignment Type
    TypeInt16 = Word8
    2
    alignment Type
    TypeInt32 = Word8
    4
    alignment Type
    TypeInt64 = Word8
    8
    alignment Type
    TypeDouble = Word8
    8
    alignment Type
    TypeUnixFd = Word8
    4
    alignment Type
    TypeString = Word8
    4
    alignment Type
    TypeObjectPath = Word8
    4
    alignment Type
    TypeSignature = Word8
    1
    alignment (TypeArray Type
    _) = Word8
    4
    alignment (TypeDictionary Type
    _ Type
    _) = Word8
    4
    alignment (TypeStructure [Type]
    _) = Word8
    8
    alignment Type
    TypeVariant = Word8
    1

    {-# INLINE padding #-}
    padding :: Word64 -> Word8 -> Word64
    padding :: Word64 -> Word8 -> Word64
    padding Word64
    current Word8
    count = Word64
    required where
        count' :: Word64
    count' = Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    count
        missing :: Word64
    missing = Word64 -> Word64 -> Word64
    forall a. Integral a => a -> a -> a
    mod Word64
    current Word64
    count'
        required :: Word64
    required = if Word64
    missing Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word64
    0
            then Word64
    count' Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    missing
            else Word64
    0

    data WireR s a
        = WireRL String
        | WireRR a !s

    newtype Wire s a = Wire
        { forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire :: Endianness -> s -> WireR s a
        }

    instance Functor (Wire s) where
        {-# INLINE fmap #-}
        fmap :: forall a b. (a -> b) -> Wire s a -> Wire s b
    fmap = (a -> b) -> Wire s a -> Wire s b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Control.Applicative.Applicative (Wire s) where
        {-# INLINE pure #-}
        pure :: forall a. a -> Wire s a
    pure a
    a = (Endianness -> s -> WireR s a) -> Wire s a
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire (\Endianness
    _ s
    s -> a -> s -> WireR s a
    forall s a. a -> s -> WireR s a
    WireRR a
    a s
    s)

        {-# INLINE (*>) #-}
        Wire s a
    m *> :: forall a b. Wire s a -> Wire s b -> Wire s b
    *> Wire s b
    k = (Endianness -> s -> WireR s b) -> Wire s b
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire ((Endianness -> s -> WireR s b) -> Wire s b)
    -> (Endianness -> s -> WireR s b) -> Wire s b
    forall a b. (a -> b) -> a -> b
    $ \Endianness
    e s
    s -> case Wire s a -> Endianness -> s -> WireR s a
    forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire Wire s a
    m Endianness
    e s
    s of
            WireRL String
    err -> String -> WireR s b
    forall s a. String -> WireR s a
    WireRL String
    err
            WireRR a
    _ s
    s' -> Wire s b -> Endianness -> s -> WireR s b
    forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire Wire s b
    k Endianness
    e s
    s'

        {-# INLINE (<*>) #-}
        <*> :: forall a b. Wire s (a -> b) -> Wire s a -> Wire s b
    (<*>) = Wire s (a -> b) -> Wire s a -> Wire s b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad (Wire s) where
        {-# INLINE (>>=) #-}
        Wire s a
    m >>= :: forall a b. Wire s a -> (a -> Wire s b) -> Wire s b
    >>= a -> Wire s b
    k = (Endianness -> s -> WireR s b) -> Wire s b
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire ((Endianness -> s -> WireR s b) -> Wire s b)
    -> (Endianness -> s -> WireR s b) -> Wire s b
    forall a b. (a -> b) -> a -> b
    $ \Endianness
    e s
    s -> case Wire s a -> Endianness -> s -> WireR s a
    forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire Wire s a
    m Endianness
    e s
    s of
            WireRL String
    err -> String -> WireR s b
    forall s a. String -> WireR s a
    WireRL String
    err
            WireRR a
    a s
    s' -> Wire s b -> Endianness -> s -> WireR s b
    forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire (a -> Wire s b
    k a
    a) Endianness
    e s
    s'

    throwError :: String -> Wire s a
    throwError :: forall s a. String -> Wire s a
    throwError String
    err = (Endianness -> s -> WireR s a) -> Wire s a
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire (\Endianness
    _ s
    _ -> String -> WireR s a
    forall s a. String -> WireR s a
    WireRL String
    err)

    {-# INLINE getState #-}
    getState :: Wire s s
    getState :: forall s. Wire s s
    getState = (Endianness -> s -> WireR s s) -> Wire s s
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire (\Endianness
    _ s
    s -> s -> s -> WireR s s
    forall s a. a -> s -> WireR s a
    WireRR s
    s s
    s)

    {-# INLINE putState #-}
    putState :: s -> Wire s ()
    putState :: forall s. s -> Wire s ()
    putState s
    s = (Endianness -> s -> WireR s ()) -> Wire s ()
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire (\Endianness
    _ s
    _ -> () -> s -> WireR s ()
    forall s a. a -> s -> WireR s a
    WireRR () s
    s)

    {-# INLINE chooseEndian #-}
    chooseEndian :: a -> a -> Wire s a
    chooseEndian :: forall a s. a -> a -> Wire s a
    chooseEndian a
    big a
    little = (Endianness -> s -> WireR s a) -> Wire s a
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire (\Endianness
    e s
    s -> case Endianness
    e of
        Endianness
    BigEndian -> a -> s -> WireR s a
    forall s a. a -> s -> WireR s a
    WireRR a
    big s
    s
        Endianness
    LittleEndian -> a -> s -> WireR s a
    forall s a. a -> s -> WireR s a
    WireRR a
    little s
    s)

    type Marshal = Wire MarshalState

    newtype MarshalError = MarshalError String
        deriving (Int -> MarshalError -> ShowS
    [MarshalError] -> ShowS
    MarshalError -> String
    (Int -> MarshalError -> ShowS)
    -> (MarshalError -> String)
    -> ([MarshalError] -> ShowS)
    -> Show MarshalError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> MarshalError -> ShowS
    showsPrec :: Int -> MarshalError -> ShowS
    $cshow :: MarshalError -> String
    show :: MarshalError -> String
    $cshowList :: [MarshalError] -> ShowS
    showList :: [MarshalError] -> ShowS
    Show, MarshalError -> MarshalError -> Bool
    (MarshalError -> MarshalError -> Bool)
    -> (MarshalError -> MarshalError -> Bool) -> Eq MarshalError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MarshalError -> MarshalError -> Bool
    == :: MarshalError -> MarshalError -> Bool
    $c/= :: MarshalError -> MarshalError -> Bool
    /= :: MarshalError -> MarshalError -> Bool
    Eq)

    marshalErrorMessage :: MarshalError -> String
    marshalErrorMessage :: MarshalError -> String
    marshalErrorMessage (MarshalError String
    s) = String
    s

    data MarshalState = MarshalState
        !Builder.Builder
        {-# UNPACK #-} !Word64
        !(Map Fd Word32)

    marshal :: Value -> Marshal ()
    marshal :: Value -> Marshal ()
    marshal (ValueAtom Atom
    x) = Atom -> Marshal ()
    marshalAtom Atom
    x
    marshal (ValueBytes ByteString
    xs) = ByteString -> Marshal ()
    marshalStrictBytes ByteString
    xs
    marshal (ValueVector Type
    t Vector Value
    xs) = Type -> Vector Value -> Marshal ()
    marshalVector Type
    t Vector Value
    xs
    marshal (ValueMap Type
    kt Type
    vt Map Atom Value
    xs) = Type -> Type -> Map Atom Value -> Marshal ()
    marshalMap Type
    kt Type
    vt Map Atom Value
    xs
    marshal (ValueStructure [Value]
    xs) = [Value] -> Marshal ()
    marshalStructure [Value]
    xs
    marshal (ValueVariant Variant
    x) = Variant -> Marshal ()
    marshalVariant Variant
    x

    marshalAtom :: Atom -> Marshal ()
    marshalAtom :: Atom -> Marshal ()
    marshalAtom (AtomWord8 Word8
    x) = Word8 -> Marshal ()
    marshalWord8 Word8
    x
    marshalAtom (AtomWord16 Word16
    x) = Word16 -> Marshal ()
    marshalWord16 Word16
    x
    marshalAtom (AtomWord32 Word32
    x) = Word32 -> Marshal ()
    marshalWord32 Word32
    x
    marshalAtom (AtomWord64 Word64
    x) = Word64 -> Marshal ()
    marshalWord64 Word64
    x
    marshalAtom (AtomInt16 Int16
    x) = Int16 -> Marshal ()
    marshalInt16 Int16
    x
    marshalAtom (AtomInt32 Int32
    x) = Int32 -> Marshal ()
    marshalInt32 Int32
    x
    marshalAtom (AtomInt64 Int64
    x) = Int64 -> Marshal ()
    marshalInt64 Int64
    x
    marshalAtom (AtomDouble Double
    x) = Double -> Marshal ()
    marshalDouble Double
    x
    marshalAtom (AtomUnixFd Fd
    x) = Fd -> Marshal ()
    marshalUnixFd Fd
    x
    marshalAtom (AtomBool Bool
    x) = Bool -> Marshal ()
    marshalBool Bool
    x
    marshalAtom (AtomText Text
    x) = Text -> Marshal ()
    marshalText Text
    x
    marshalAtom (AtomObjectPath ObjectPath
    x) = ObjectPath -> Marshal ()
    marshalObjectPath ObjectPath
    x
    marshalAtom (AtomSignature Signature
    x) = Signature -> Marshal ()
    marshalSignature Signature
    x

    appendB :: Word64 -> Builder.Builder -> Marshal ()
    appendB :: Word64 -> Builder -> Marshal ()
    appendB Word64
    size Builder
    bytes = (Endianness -> MarshalState -> WireR MarshalState ()) -> Marshal ()
    forall s a. (Endianness -> s -> WireR s a) -> Wire s a
    Wire (\Endianness
    _ (MarshalState Builder
    builder Word64
    count Map Fd Word32
    fds) -> let
        builder' :: Builder
    builder' = Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    mappend Builder
    builder Builder
    bytes
        count' :: Word64
    count' = Word64
    count Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + Word64
    size
        in () -> MarshalState -> WireR MarshalState ()
    forall s a. a -> s -> WireR s a
    WireRR () (Builder -> Word64 -> Map Fd Word32 -> MarshalState
    MarshalState Builder
    builder' Word64
    count' Map Fd Word32
    fds))

    appendS :: ByteString -> Marshal ()
    appendS :: ByteString -> Marshal ()
    appendS ByteString
    bytes = Word64 -> Builder -> Marshal ()
    appendB
        (Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    Data.ByteString.length ByteString
    bytes))
        (ByteString -> Builder
    Builder.byteString ByteString
    bytes)

    appendL :: Lazy.ByteString -> Marshal ()
    appendL :: ByteString -> Marshal ()
    appendL ByteString
    bytes = Word64 -> Builder -> Marshal ()
    appendB
        (Int64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int64
    Lazy.length ByteString
    bytes))
        (ByteString -> Builder
    Builder.lazyByteString ByteString
    bytes)

    pad :: Word8 -> Marshal ()
    pad :: Word8 -> Marshal ()
    pad Word8
    count = do
        (MarshalState _ existing _) <- Wire MarshalState MarshalState
    forall s. Wire s s
    getState
        let padding' = Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8 -> Word64
    padding Word64
    existing Word8
    count)
        appendS (Data.ByteString.replicate padding' 0)

    marshalBuilder :: Word8
                   -> (a -> Builder.Builder)
                   -> (a -> Builder.Builder)
                   -> a -> Marshal ()
    marshalBuilder :: forall a.
    Word8 -> (a -> Builder) -> (a -> Builder) -> a -> Marshal ()
    marshalBuilder Word8
    size a -> Builder
    be a -> Builder
    le a
    x = do
        builder <- Builder -> Builder -> Wire MarshalState Builder
    forall a s. a -> a -> Wire s a
    chooseEndian (a -> Builder
    be a
    x) (a -> Builder
    le a
    x)
        pad size
        appendB (fromIntegral size) builder

    type Unmarshal = Wire UnmarshalState

    newtype UnmarshalError = UnmarshalError String
        deriving (Int -> UnmarshalError -> ShowS
    [UnmarshalError] -> ShowS
    UnmarshalError -> String
    (Int -> UnmarshalError -> ShowS)
    -> (UnmarshalError -> String)
    -> ([UnmarshalError] -> ShowS)
    -> Show UnmarshalError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnmarshalError -> ShowS
    showsPrec :: Int -> UnmarshalError -> ShowS
    $cshow :: UnmarshalError -> String
    show :: UnmarshalError -> String
    $cshowList :: [UnmarshalError] -> ShowS
    showList :: [UnmarshalError] -> ShowS
    Show, UnmarshalError -> UnmarshalError -> Bool
    (UnmarshalError -> UnmarshalError -> Bool)
    -> (UnmarshalError -> UnmarshalError -> Bool) -> Eq UnmarshalError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnmarshalError -> UnmarshalError -> Bool
    == :: UnmarshalError -> UnmarshalError -> Bool
    $c/= :: UnmarshalError -> UnmarshalError -> Bool
    /= :: UnmarshalError -> UnmarshalError -> Bool
    Eq)

    unmarshalErrorMessage :: UnmarshalError -> String
    unmarshalErrorMessage :: UnmarshalError -> String
    unmarshalErrorMessage (UnmarshalError String
    s) = String
    s

    data UnmarshalState = UnmarshalState
        {-# UNPACK #-} !ByteString
        {-# UNPACK #-} !Word64
        ![Fd]

    unmarshal :: Type -> Unmarshal Value
    unmarshal :: Type -> Unmarshal Value
    unmarshal Type
    TypeWord8 = (Word8 -> Value) -> Wire UnmarshalState Word8 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word8 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Word8
    unmarshalWord8
    unmarshal Type
    TypeWord16 = (Word16 -> Value) -> Wire UnmarshalState Word16 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word16 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Word16
    unmarshalWord16
    unmarshal Type
    TypeWord32 = (Word32 -> Value) -> Wire UnmarshalState Word32 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word32 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Word32
    unmarshalWord32
    unmarshal Type
    TypeWord64 = (Word64 -> Value) -> Wire UnmarshalState Word64 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word64 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Word64
    unmarshalWord64
    unmarshal Type
    TypeInt16 = (Int16 -> Value) -> Wire UnmarshalState Int16 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int16 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Int16
    unmarshalInt16
    unmarshal Type
    TypeInt32 = (Int32 -> Value) -> Wire UnmarshalState Int32 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int32 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Int32
    unmarshalInt32
    unmarshal Type
    TypeInt64 = (Int64 -> Value) -> Wire UnmarshalState Int64 -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int64 -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Int64
    unmarshalInt64
    unmarshal Type
    TypeDouble = (Double -> Value) -> Wire UnmarshalState Double -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Double -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Double
    unmarshalDouble
    unmarshal Type
    TypeUnixFd = (Fd -> Value) -> Wire UnmarshalState Fd -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Fd -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Fd
    unmarshalUnixFd
    unmarshal Type
    TypeBoolean = (Bool -> Value) -> Wire UnmarshalState Bool -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Bool -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Bool
    unmarshalBool
    unmarshal Type
    TypeString = (Text -> Value) -> Wire UnmarshalState Text -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Text -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Text
    unmarshalText
    unmarshal Type
    TypeObjectPath = (ObjectPath -> Value)
    -> Wire UnmarshalState ObjectPath -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ObjectPath -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState ObjectPath
    unmarshalObjectPath
    unmarshal Type
    TypeSignature = (Signature -> Value)
    -> Wire UnmarshalState Signature -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Signature -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState Signature
    unmarshalSignature
    unmarshal (TypeArray Type
    TypeWord8) = (ByteString -> Value)
    -> Wire UnmarshalState ByteString -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ByteString -> Value
    forall a. IsValue a => a -> Value
    toValue Wire UnmarshalState ByteString
    unmarshalByteArray
    unmarshal (TypeArray Type
    t) = (Vector Value -> Value)
    -> Wire UnmarshalState (Vector Value) -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Type -> Vector Value -> Value
    ValueVector Type
    t) (Type -> Wire UnmarshalState (Vector Value)
    unmarshalArray Type
    t)
    unmarshal (TypeDictionary Type
    kt Type
    vt) = Type -> Type -> Unmarshal Value
    unmarshalDictionary Type
    kt Type
    vt
    unmarshal (TypeStructure [Type]
    ts) = [Type] -> Unmarshal Value
    unmarshalStructure [Type]
    ts
    unmarshal Type
    TypeVariant = Unmarshal Value
    unmarshalVariant

    {-# INLINE consume #-}
    consume :: Word64 -> Unmarshal ByteString
    consume :: Word64 -> Wire UnmarshalState ByteString
    consume Word64
    count = do
        (UnmarshalState bytes offset fds) <- Wire UnmarshalState UnmarshalState
    forall s. Wire s s
    getState
        let count' = Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    count
        let (x, bytes') = Data.ByteString.splitAt count' bytes
        let lenConsumed = ByteString -> Int
    Data.ByteString.length ByteString
    x
        if lenConsumed == count'
            then do
                putState (UnmarshalState bytes' (offset + count) fds)
                return x
            else throwError ("Unexpected EOF at offset " ++ show (offset + fromIntegral lenConsumed))

    skipPadding :: Word8 -> Unmarshal ()
    skipPadding :: Word8 -> Wire UnmarshalState ()
    skipPadding Word8
    count = do
        (UnmarshalState _ offset _) <- Wire UnmarshalState UnmarshalState
    forall s. Wire s s
    getState
        bytes <- consume (padding offset count)
        unless (Data.ByteString.all (== 0) bytes)
            (throwError ("Value padding " ++ show bytes ++ " contains invalid bytes."))

    skipTerminator :: Unmarshal ()
    skipTerminator :: Wire UnmarshalState ()
    skipTerminator = do
        byte <- Wire UnmarshalState Word8
    unmarshalWord8
        when (byte /= 0) (throwError "Textual value is not NUL-terminated.")

    fromMaybeU :: Show a => String -> (a -> Maybe b) -> a -> Unmarshal b
    fromMaybeU :: forall a b. Show a => String -> (a -> Maybe b) -> a -> Unmarshal b
    fromMaybeU String
    label a -> Maybe b
    f a
    x = case a -> Maybe b
    f a
    x of
        Just b
    x' -> b -> Unmarshal b
    forall a. a -> Wire UnmarshalState a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    x'
        Maybe b
    Nothing -> String -> Unmarshal b
    forall s a. String -> Wire s a
    throwError (String
    "Invalid " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    label String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x)

    unmarshalGet :: Word8 -> Get.Get a -> Get.Get a -> Unmarshal a
    unmarshalGet :: forall a. Word8 -> Get a -> Get a -> Unmarshal a
    unmarshalGet Word8
    count Get a
    be Get a
    le = do
        Word8 -> Wire UnmarshalState ()
    skipPadding Word8
    count
        bytes <- Word64 -> Wire UnmarshalState ByteString
    consume (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    count)
        get <- chooseEndian be le
        let Right ret = Get.runGet get bytes
        return ret

    marshalWord8 :: Word8 -> Marshal ()
    marshalWord8 :: Word8 -> Marshal ()
    marshalWord8 Word8
    x = Word64 -> Builder -> Marshal ()
    appendB Word64
    1 (Word8 -> Builder
    Builder.word8 Word8
    x)

    unmarshalWord8 :: Unmarshal Word8
    unmarshalWord8 :: Wire UnmarshalState Word8
    unmarshalWord8 = (ByteString -> Word8)
    -> Wire UnmarshalState ByteString -> Wire UnmarshalState Word8
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM HasCallStack => ByteString -> Word8
    ByteString -> Word8
    Data.ByteString.head (Word64 -> Wire UnmarshalState ByteString
    consume Word64
    1)

    marshalWord16 :: Word16 -> Marshal ()
    marshalWord16 :: Word16 -> Marshal ()
    marshalWord16 = Word8
    -> (Word16 -> Builder)
    -> (Word16 -> Builder)
    -> Word16
    -> Marshal ()
    forall a.
    Word8 -> (a -> Builder) -> (a -> Builder) -> a -> Marshal ()
    marshalBuilder Word8
    2
        Word16 -> Builder
    Builder.word16BE
        Word16 -> Builder
    Builder.word16LE

    marshalWord32 :: Word32 -> Marshal ()
    marshalWord32 :: Word32 -> Marshal ()
    marshalWord32 = Word8
    -> (Word32 -> Builder)
    -> (Word32 -> Builder)
    -> Word32
    -> Marshal ()
    forall a.
    Word8 -> (a -> Builder) -> (a -> Builder) -> a -> Marshal ()
    marshalBuilder Word8
    4
        Word32 -> Builder
    Builder.word32BE
        Word32 -> Builder
    Builder.word32LE

    marshalWord64 :: Word64 -> Marshal ()
    marshalWord64 :: Word64 -> Marshal ()
    marshalWord64 = Word8
    -> (Word64 -> Builder)
    -> (Word64 -> Builder)
    -> Word64
    -> Marshal ()
    forall a.
    Word8 -> (a -> Builder) -> (a -> Builder) -> a -> Marshal ()
    marshalBuilder Word8
    8
        Word64 -> Builder
    Builder.word64BE
        Word64 -> Builder
    Builder.word64LE

    marshalInt16 :: Int16 -> Marshal ()
    marshalInt16 :: Int16 -> Marshal ()
    marshalInt16 = Word16 -> Marshal ()
    marshalWord16 (Word16 -> Marshal ()) -> (Int16 -> Word16) -> Int16 -> Marshal ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int16 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    marshalInt32 :: Int32 -> Marshal ()
    marshalInt32 :: Int32 -> Marshal ()
    marshalInt32 = Word32 -> Marshal ()
    marshalWord32 (Word32 -> Marshal ()) -> (Int32 -> Word32) -> Int32 -> Marshal ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    marshalInt64 :: Int64 -> Marshal ()
    marshalInt64 :: Int64 -> Marshal ()
    marshalInt64 = Word64 -> Marshal ()
    marshalWord64 (Word64 -> Marshal ()) -> (Int64 -> Word64) -> Int64 -> Marshal ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    unmarshalWord16 :: Unmarshal Word16
    unmarshalWord16 :: Wire UnmarshalState Word16
    unmarshalWord16 = Word8 -> Get Word16 -> Get Word16 -> Wire UnmarshalState Word16
    forall a. Word8 -> Get a -> Get a -> Unmarshal a
    unmarshalGet Word8
    2
        Get Word16
    Get.getWord16be
        Get Word16
    Get.getWord16le

    unmarshalWord32 :: Unmarshal Word32
    unmarshalWord32 :: Wire UnmarshalState Word32
    unmarshalWord32 = Word8 -> Get Word32 -> Get Word32 -> Wire UnmarshalState Word32
    forall a. Word8 -> Get a -> Get a -> Unmarshal a
    unmarshalGet Word8
    4
        Get Word32
    Get.getWord32be
        Get Word32
    Get.getWord32le

    unmarshalWord64 :: Unmarshal Word64
    unmarshalWord64 :: Wire UnmarshalState Word64
    unmarshalWord64 = Word8 -> Get Word64 -> Get Word64 -> Wire UnmarshalState Word64
    forall a. Word8 -> Get a -> Get a -> Unmarshal a
    unmarshalGet Word8
    8
        Get Word64
    Get.getWord64be
        Get Word64
    Get.getWord64le

    unmarshalInt16 :: Unmarshal Int16
    unmarshalInt16 :: Wire UnmarshalState Int16
    unmarshalInt16 = (Word16 -> Int16)
    -> Wire UnmarshalState Word16 -> Wire UnmarshalState Int16
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word16 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Wire UnmarshalState Word16
    unmarshalWord16

    unmarshalInt32 :: Unmarshal Int32
    unmarshalInt32 :: Wire UnmarshalState Int32
    unmarshalInt32 = (Word32 -> Int32)
    -> Wire UnmarshalState Word32 -> Wire UnmarshalState Int32
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Wire UnmarshalState Word32
    unmarshalWord32

    unmarshalInt64 :: Unmarshal Int64
    unmarshalInt64 :: Wire UnmarshalState Int64
    unmarshalInt64 = (Word64 -> Int64)
    -> Wire UnmarshalState Word64 -> Wire UnmarshalState Int64
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Word64 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Wire UnmarshalState Word64
    unmarshalWord64

    marshalDouble :: Double -> Marshal ()
    marshalDouble :: Double -> Marshal ()
    marshalDouble Double
    x = do
        put <- (Double -> Put)
    -> (Double -> Put) -> Wire MarshalState (Double -> Put)
    forall a s. a -> a -> Wire s a
    chooseEndian Double -> Put
    putFloat64be Double -> Put
    putFloat64le
        pad 8
        appendS (runPut (put x))

    unmarshalDouble :: Unmarshal Double
    unmarshalDouble :: Wire UnmarshalState Double
    unmarshalDouble = Word8 -> Get Double -> Get Double -> Wire UnmarshalState Double
    forall a. Word8 -> Get a -> Get a -> Unmarshal a
    unmarshalGet Word8
    8
        Get Double
    getFloat64be
        Get Double
    getFloat64le

    marshalUnixFd :: Fd -> Marshal ()
    marshalUnixFd :: Fd -> Marshal ()
    marshalUnixFd fd :: Fd
    fd@(Fd CInt
    x)
        | CInt
    x CInt -> CInt -> Bool
    forall a. Ord a => a -> a -> Bool
    < CInt
    0 = String -> Marshal ()
    forall s a. String -> Wire s a
    throwError (String
    "Invalid file descriptor: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ CInt -> String
    forall a. Show a => a -> String
    show CInt
    x)
        | CInt -> Integer
    forall a. Integral a => a -> Integer
    toInteger CInt
    x Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Word32
    forall a. Bounded a => a
    maxBound :: Word32) = String -> Marshal ()
    forall s a. String -> Wire s a
    throwError (String
    "D-Bus forbids file descriptors exceeding UINT32_MAX: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ CInt -> String
    forall a. Show a => a -> String
    show CInt
    x)
        | Bool
    otherwise = do
            MarshalState builder count fds <- Wire MarshalState MarshalState
    forall s. Wire s s
    getState
            case Data.Map.lookup fd fds of
                Just Word32
    i -> Word32 -> Marshal ()
    marshalWord32 Word32
    i
                Maybe Word32
    Nothing -> do
                    let i :: Word32
    i = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Map Fd Word32 -> Int
    forall k a. Map k a -> Int
    Data.Map.size Map Fd Word32
    fds)
                    MarshalState -> Marshal ()
    forall s. s -> Wire s ()
    putState (Builder -> Word64 -> Map Fd Word32 -> MarshalState
    MarshalState Builder
    builder Word64
    count (Fd -> Word32 -> Map Fd Word32 -> Map Fd Word32
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Data.Map.insert Fd
    fd Word32
    i Map Fd Word32
    fds))
                    Word32 -> Marshal ()
    marshalWord32 Word32
    i

    unmarshalUnixFd :: Unmarshal Fd
    unmarshalUnixFd :: Wire UnmarshalState Fd
    unmarshalUnixFd = do
        x <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int)
    -> Wire UnmarshalState Word32 -> Wire UnmarshalState Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Wire UnmarshalState Word32
    unmarshalWord32
        UnmarshalState _ _ fds <- getState
        when (x >= length fds) $ do
            throwError ("File descriptor index " ++ show x ++ " out of bounds - only " ++ show (length fds) ++ " file descriptors in message header.")
        return (fds !! x)

    marshalBool :: Bool -> Marshal ()
    marshalBool :: Bool -> Marshal ()
    marshalBool Bool
    False = Word32 -> Marshal ()
    marshalWord32 Word32
    0
    marshalBool Bool
    True  = Word32 -> Marshal ()
    marshalWord32 Word32
    1

    unmarshalBool :: Unmarshal Bool
    unmarshalBool :: Wire UnmarshalState Bool
    unmarshalBool = do
        word <- Wire UnmarshalState Word32
    unmarshalWord32
        case word of
            Word32
    0 -> Bool -> Wire UnmarshalState Bool
    forall a. a -> Wire UnmarshalState a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            Word32
    1 -> Bool -> Wire UnmarshalState Bool
    forall a. a -> Wire UnmarshalState a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            Word32
    _ -> String -> Wire UnmarshalState Bool
    forall s a. String -> Wire s a
    throwError (String
    "Invalid boolean: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word32 -> String
    forall a. Show a => a -> String
    show Word32
    word)

    marshalText :: Text -> Marshal ()
    marshalText :: Text -> Marshal ()
    marshalText Text
    text = do
        let bytes :: ByteString
    bytes = Text -> ByteString
    Data.Text.Encoding.encodeUtf8 Text
    text
        Bool -> Marshal () -> Marshal ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Word8 -> Bool) -> ByteString -> Bool
    Data.ByteString.any (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0) ByteString
    bytes)
            (String -> Marshal ()
    forall s a. String -> Wire s a
    throwError (String
    "String " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    text String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " contained forbidden character: '\\x00'"))
        Word32 -> Marshal ()
    marshalWord32 (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    Data.ByteString.length ByteString
    bytes))
        ByteString -> Marshal ()
    appendS ByteString
    bytes
        Word8 -> Marshal ()
    marshalWord8 Word8
    0

    unmarshalText :: Unmarshal Text
    unmarshalText :: Wire UnmarshalState Text
    unmarshalText = do
        byteCount <- Wire UnmarshalState Word32
    unmarshalWord32
        bytes <- consume (fromIntegral byteCount)
        skipTerminator
        fromMaybeU "text" maybeDecodeUtf8 bytes

    maybeDecodeUtf8 :: ByteString -> Maybe Text
    maybeDecodeUtf8 :: ByteString -> Maybe Text
    maybeDecodeUtf8 ByteString
    bs = case ByteString -> Either UnicodeException Text
    Data.Text.Encoding.decodeUtf8' ByteString
    bs of
        Right Text
    text -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    text
        Either UnicodeException Text
    _ -> Maybe Text
    forall a. Maybe a
    Nothing

    marshalObjectPath :: ObjectPath -> Marshal ()
    marshalObjectPath :: ObjectPath -> Marshal ()
    marshalObjectPath ObjectPath
    p = do
        let bytes :: ByteString
    bytes = String -> ByteString
    Data.ByteString.Char8.pack (ObjectPath -> String
    formatObjectPath ObjectPath
    p)
        Word32 -> Marshal ()
    marshalWord32 (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    Data.ByteString.length ByteString
    bytes))
        ByteString -> Marshal ()
    appendS ByteString
    bytes
        Word8 -> Marshal ()
    marshalWord8 Word8
    0

    unmarshalObjectPath :: Unmarshal ObjectPath
    unmarshalObjectPath :: Wire UnmarshalState ObjectPath
    unmarshalObjectPath = do
        byteCount <- Wire UnmarshalState Word32
    unmarshalWord32
        bytes <- consume (fromIntegral byteCount)
        skipTerminator
        fromMaybeU "object path" parseObjectPath (Data.ByteString.Char8.unpack bytes)

    signatureBytes :: Signature -> ByteString
    signatureBytes :: Signature -> ByteString
    signatureBytes (Signature [Type]
    ts) = String -> ByteString
    Data.ByteString.Char8.pack ((Type -> String) -> [Type] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Type -> String
    typeCode [Type]
    ts)

    marshalSignature :: Signature -> Marshal ()
    marshalSignature :: Signature -> Marshal ()
    marshalSignature Signature
    x = do
        let bytes :: ByteString
    bytes = Signature -> ByteString
    signatureBytes Signature
    x
        Word8 -> Marshal ()
    marshalWord8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    Data.ByteString.length ByteString
    bytes))
        ByteString -> Marshal ()
    appendS ByteString
    bytes
        Word8 -> Marshal ()
    marshalWord8 Word8
    0

    unmarshalSignature :: Unmarshal Signature
    unmarshalSignature :: Wire UnmarshalState Signature
    unmarshalSignature = do
        byteCount <- Wire UnmarshalState Word8
    unmarshalWord8
        bytes <- consume (fromIntegral byteCount)
        skipTerminator
        fromMaybeU "signature" parseSignatureBytes bytes

    arrayMaximumLength :: Int64
    arrayMaximumLength :: Int64
    arrayMaximumLength = Int64
    67108864

    marshalVector :: Type -> Vector Value -> Marshal ()
    marshalVector :: Type -> Vector Value -> Marshal ()
    marshalVector Type
    t Vector Value
    x = do
        (arrayPadding, arrayBytes) <- Type -> Vector Value -> Marshal (Int, ByteString)
    getArrayBytes Type
    t Vector Value
    x
        let arrayLen = ByteString -> Int64
    Lazy.length ByteString
    arrayBytes
        when (arrayLen > arrayMaximumLength) (throwError ("Marshaled array size (" ++ show arrayLen ++ " bytes) exceeds maximum limit of (" ++ show arrayMaximumLength ++ " bytes)."))
        marshalWord32 (fromIntegral arrayLen)
        appendS (Data.ByteString.replicate arrayPadding 0)
        appendL arrayBytes

    marshalStrictBytes :: ByteString -> Marshal ()
    marshalStrictBytes :: ByteString -> Marshal ()
    marshalStrictBytes ByteString
    bytes = do
        let arrayLen :: Int64
    arrayLen = ByteString -> Int64
    Lazy.length (ByteString -> ByteString
    Lazy.fromStrict ByteString
    bytes)
        Bool -> Marshal () -> Marshal ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int64 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    arrayLen Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    arrayMaximumLength) (String -> Marshal ()
    forall s a. String -> Wire s a
    throwError (String
    "Marshaled array size (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int64 -> String
    forall a. Show a => a -> String
    show Int64
    arrayLen String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " bytes) exceeds maximum limit of (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int64 -> String
    forall a. Show a => a -> String
    show Int64
    arrayMaximumLength String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " bytes)."))
        Word32 -> Marshal ()
    marshalWord32 (Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    arrayLen)
        ByteString -> Marshal ()
    appendS ByteString
    bytes

    getArrayBytes :: Type -> Vector Value -> Marshal (Int, Lazy.ByteString)
    getArrayBytes :: Type -> Vector Value -> Marshal (Int, ByteString)
    getArrayBytes Type
    itemType Vector Value
    vs = do
        (MarshalState bytes count fds) <- Wire MarshalState MarshalState
    forall s. Wire s s
    getState
        (MarshalState _ afterLength _) <- marshalWord32 0 >> getState
        (MarshalState _ afterPadding _) <- pad (alignment itemType) >> getState

        putState (MarshalState mempty afterPadding fds)
        (MarshalState itemBuilder _ fds') <- Data.Vector.mapM_ marshal vs >> getState

        let itemBytes = Builder -> ByteString
    Builder.toLazyByteString Builder
    itemBuilder
            paddingSize = Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    afterPadding Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    afterLength)

        putState (MarshalState bytes count fds')
        return (paddingSize, itemBytes)

    unmarshalByteArray :: Unmarshal ByteString
    unmarshalByteArray :: Wire UnmarshalState ByteString
    unmarshalByteArray = do
        byteCount <- Wire UnmarshalState Word32
    unmarshalWord32
        consume (fromIntegral byteCount)

    unmarshalArray :: Type -> Unmarshal (Vector Value)
    unmarshalArray :: Type -> Wire UnmarshalState (Vector Value)
    unmarshalArray Type
    itemType = do
        let getOffset :: Wire UnmarshalState Word64
    getOffset = do
                (UnmarshalState _ o _) <- Wire UnmarshalState UnmarshalState
    forall s. Wire s s
    getState
                return o
        byteCount <- Wire UnmarshalState Word32
    unmarshalWord32
        skipPadding (alignment itemType)
        start <- getOffset
        let end = Word64
    start Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + Word32 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    byteCount
        vs <- untilM (liftM (>= end) getOffset) (unmarshal itemType)
        end' <- getOffset
        when (end' > end) (throwError ("Array data size exeeds array size of " ++ show end))
        return (Data.Vector.fromList vs)

    dictionaryToArray :: Map Atom Value -> Vector Value
    dictionaryToArray :: Map Atom Value -> Vector Value
    dictionaryToArray = [Value] -> Vector Value
    forall a. [a] -> Vector a
    Data.Vector.fromList ([Value] -> Vector Value)
    -> (Map Atom Value -> [Value]) -> Map Atom Value -> Vector Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Atom, Value) -> Value) -> [(Atom, Value)] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map (Atom, Value) -> Value
    step ([(Atom, Value)] -> [Value])
    -> (Map Atom Value -> [(Atom, Value)]) -> Map Atom Value -> [Value]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Atom Value -> [(Atom, Value)]
    forall k a. Map k a -> [(k, a)]
    Data.Map.toList where
        step :: (Atom, Value) -> Value
    step (Atom
    k, Value
    v) = [Value] -> Value
    ValueStructure [Atom -> Value
    ValueAtom Atom
    k, Value
    v]

    arrayToDictionary :: Vector Value -> Map Atom Value
    arrayToDictionary :: Vector Value -> Map Atom Value
    arrayToDictionary = [(Atom, Value)] -> Map Atom Value
    forall k a. Ord k => [(k, a)] -> Map k a
    Data.Map.fromList ([(Atom, Value)] -> Map Atom Value)
    -> (Vector Value -> [(Atom, Value)])
    -> Vector Value
    -> Map Atom Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> (Atom, Value)) -> [Value] -> [(Atom, Value)]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> (Atom, Value)
    step ([Value] -> [(Atom, Value)])
    -> (Vector Value -> [Value]) -> Vector Value -> [(Atom, Value)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Value -> [Value]
    forall a. Vector a -> [a]
    Data.Vector.toList where
        step :: Value -> (Atom, Value)
    step (ValueStructure [ValueAtom Atom
    k, Value
    v]) = (Atom
    k, Value
    v)
        step Value
    _ = String -> (Atom, Value)
    forall a. HasCallStack => String -> a
    error String
    "arrayToDictionary: internal error"

    marshalMap :: Type -> Type -> Map Atom Value -> Marshal ()
    marshalMap :: Type -> Type -> Map Atom Value -> Marshal ()
    marshalMap Type
    kt Type
    vt Map Atom Value
    x = let
        structType :: Type
    structType = [Type] -> Type
    TypeStructure [Type
    kt, Type
    vt]
        array :: Vector Value
    array = Map Atom Value -> Vector Value
    dictionaryToArray Map Atom Value
    x
        in Type -> Vector Value -> Marshal ()
    marshalVector Type
    structType Vector Value
    array

    unmarshalDictionary :: Type -> Type -> Unmarshal Value
    unmarshalDictionary :: Type -> Type -> Unmarshal Value
    unmarshalDictionary Type
    kt Type
    vt = do
        let pairType :: Type
    pairType = [Type] -> Type
    TypeStructure [Type
    kt, Type
    vt]
        array <- Type -> Wire UnmarshalState (Vector Value)
    unmarshalArray Type
    pairType
        return (ValueMap kt vt (arrayToDictionary array))

    marshalStructure :: [Value] -> Marshal ()
    marshalStructure :: [Value] -> Marshal ()
    marshalStructure [Value]
    vs = do
        Word8 -> Marshal ()
    pad Word8
    8
        (Value -> Marshal ()) -> [Value] -> Marshal ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Value -> Marshal ()
    marshal [Value]
    vs

    unmarshalStructure :: [Type] -> Unmarshal Value
    unmarshalStructure :: [Type] -> Unmarshal Value
    unmarshalStructure [Type]
    ts = do
        Word8 -> Wire UnmarshalState ()
    skipPadding Word8
    8
        ([Value] -> Value)
    -> Wire UnmarshalState [Value] -> Unmarshal Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [Value] -> Value
    ValueStructure ((Type -> Unmarshal Value) -> [Type] -> Wire UnmarshalState [Value]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> Unmarshal Value
    unmarshal [Type]
    ts)

    marshalVariant :: Variant -> Marshal ()
    marshalVariant :: Variant -> Marshal ()
    marshalVariant var :: Variant
    var@(Variant Value
    val) = do
        sig <- case [Type] -> Maybe Signature
    forall (m :: * -> *). MonadThrow m => [Type] -> m Signature
    signature [Value -> Type
    valueType Value
    val] of
            Just Signature
    x' -> Signature -> Wire MarshalState Signature
    forall a. a -> Wire MarshalState a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Signature
    x'
            Maybe Signature
    Nothing -> String -> Wire MarshalState Signature
    forall s a. String -> Wire s a
    throwError (String
    "Signature " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show (Type -> String
    typeCode (Value -> Type
    valueType Value
    val)) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " for variant " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Variant -> String
    forall a. Show a => a -> String
    show Variant
    var String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " is malformed or too large.")
        marshalSignature sig
        marshal val

    unmarshalVariant :: Unmarshal Value
    unmarshalVariant :: Unmarshal Value
    unmarshalVariant = do
        let getType :: Signature -> Maybe Type
    getType Signature
    sig = case Signature -> [Type]
    signatureTypes Signature
    sig of
                [Type
    t] -> Type -> Maybe Type
    forall a. a -> Maybe a
    Just Type
    t
                [Type]
    _   -> Maybe Type
    forall a. Maybe a
    Nothing

        t <- String -> (Signature -> Maybe Type) -> Signature -> Unmarshal Type
    forall a b. Show a => String -> (a -> Maybe b) -> a -> Unmarshal b
    fromMaybeU String
    "variant signature" Signature -> Maybe Type
    getType (Signature -> Unmarshal Type)
    -> Wire UnmarshalState Signature -> Unmarshal Type
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Wire UnmarshalState Signature
    unmarshalSignature
        (toValue . Variant) `liftM` unmarshal t

    protocolVersion :: Word8
    protocolVersion :: Word8
    protocolVersion = Word8
    1

    messageMaximumLength :: Integer
    messageMaximumLength :: Integer
    messageMaximumLength = Integer
    134217728

    encodeField :: HeaderField -> Value
    encodeField :: HeaderField -> Value
    encodeField (HeaderPath ObjectPath
    x)        = Word8 -> ObjectPath -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    1 ObjectPath
    x
    encodeField (HeaderInterface InterfaceName
    x)   = Word8 -> InterfaceName -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    2 InterfaceName
    x
    encodeField (HeaderMember MemberName
    x)      = Word8 -> MemberName -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    3 MemberName
    x
    encodeField (HeaderErrorName ErrorName
    x)   = Word8 -> ErrorName -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    4 ErrorName
    x
    encodeField (HeaderReplySerial Serial
    x) = Word8 -> Serial -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    5 Serial
    x
    encodeField (HeaderDestination BusName
    x) = Word8 -> BusName -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    6 BusName
    x
    encodeField (HeaderSender BusName
    x)      = Word8 -> BusName -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    7 BusName
    x
    encodeField (HeaderSignature Signature
    x)   = Word8 -> Signature -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    8 Signature
    x
    encodeField (HeaderUnixFds Word32
    x)     = Word8 -> Word32 -> Value
    forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    9 Word32
    x

    encodeField' :: IsVariant a => Word8 -> a -> Value
    encodeField' :: forall a. IsVariant a => Word8 -> a -> Value
    encodeField' Word8
    code a
    x = (Word8, Variant) -> Value
    forall a. IsValue a => a -> Value
    toValue (Word8
    code, a -> Variant
    forall a. IsVariant a => a -> Variant
    toVariant a
    x)

    decodeField :: (Word8, Variant)
                -> ErrorM UnmarshalError [HeaderField]
    decodeField :: (Word8, Variant) -> ErrorM UnmarshalError [HeaderField]
    decodeField (Word8, Variant)
    struct = case (Word8, Variant)
    struct of
        (Word8
    1, Variant
    x) -> Variant
    -> (ObjectPath -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x ObjectPath -> HeaderField
    HeaderPath String
    "path"
        (Word8
    2, Variant
    x) -> Variant
    -> (InterfaceName -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x InterfaceName -> HeaderField
    HeaderInterface String
    "interface"
        (Word8
    3, Variant
    x) -> Variant
    -> (MemberName -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x MemberName -> HeaderField
    HeaderMember String
    "member"
        (Word8
    4, Variant
    x) -> Variant
    -> (ErrorName -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x ErrorName -> HeaderField
    HeaderErrorName String
    "error name"
        (Word8
    5, Variant
    x) -> Variant
    -> (Serial -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x Serial -> HeaderField
    HeaderReplySerial String
    "reply serial"
        (Word8
    6, Variant
    x) -> Variant
    -> (BusName -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x BusName -> HeaderField
    HeaderDestination String
    "destination"
        (Word8
    7, Variant
    x) -> Variant
    -> (BusName -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x BusName -> HeaderField
    HeaderSender String
    "sender"
        (Word8
    8, Variant
    x) -> Variant
    -> (Signature -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x Signature -> HeaderField
    HeaderSignature String
    "signature"
        (Word8
    9, Variant
    x) -> Variant
    -> (Word32 -> HeaderField)
    -> String
    -> ErrorM UnmarshalError [HeaderField]
    forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x Word32 -> HeaderField
    HeaderUnixFds String
    "unix fds"
        (Word8, Variant)
    _      -> [HeaderField] -> ErrorM UnmarshalError [HeaderField]
    forall a. a -> ErrorM UnmarshalError a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    decodeField' :: IsVariant a => Variant -> (a -> b) -> String
                 -> ErrorM UnmarshalError [b]
    decodeField' :: forall a b.
    IsVariant a =>
    Variant -> (a -> b) -> String -> ErrorM UnmarshalError [b]
    decodeField' Variant
    x a -> b
    f String
    label = case Variant -> Maybe a
    forall a. IsVariant a => Variant -> Maybe a
    fromVariant Variant
    x of
        Just a
    x' -> [b] -> ErrorM UnmarshalError [b]
    forall a. a -> ErrorM UnmarshalError a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a -> b
    f a
    x']
        Maybe a
    Nothing -> UnmarshalError -> ErrorM UnmarshalError [b]
    forall e a. e -> ErrorM e a
    throwErrorM (String -> UnmarshalError
    UnmarshalError (String
    "Header field " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    label String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " contains invalid value " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Variant -> String
    forall a. Show a => a -> String
    show Variant
    x))

    marshalMessage :: Message a => Endianness -> Serial -> a
                   -> Either MarshalError (ByteString, [Fd])
    marshalMessage :: forall a.
    Message a =>
    Endianness -> Serial -> a -> Either MarshalError (ByteString, [Fd])
    marshalMessage Endianness
    e Serial
    serial a
    msg = Either MarshalError (ByteString, [Fd])
    runMarshal where
        body :: [Variant]
    body = a -> [Variant]
    forall a. Message a => a -> [Variant]
    messageBody a
    msg
        marshaler :: Marshal ()
    marshaler = do
            sig <- [Variant] -> Wire MarshalState Signature
    checkBodySig [Variant]
    body
            MarshalState emptyBytes emptyCount _ <- getState
            mapM_ (marshal . (\(Variant Value
    x) -> Value
    x)) body
            (MarshalState bodyBytesB _ fds) <- getState
            putState (MarshalState emptyBytes emptyCount fds)
            marshal (toValue (encodeEndianness e))
            let bodyBytes = Builder -> ByteString
    Builder.toLazyByteString Builder
    bodyBytesB
            marshalHeader msg serial sig (fromIntegral (Lazy.length bodyBytes)) (Data.Map.size fds)
            pad 8
            appendL bodyBytes
            checkMaximumSize
        emptyState :: MarshalState
    emptyState = Builder -> Word64 -> Map Fd Word32 -> MarshalState
    MarshalState Builder
    forall a. Monoid a => a
    mempty Word64
    0 Map Fd Word32
    forall a. Monoid a => a
    mempty
        runMarshal :: Either MarshalError (ByteString, [Fd])
    runMarshal = case Marshal () -> Endianness -> MarshalState -> WireR MarshalState ()
    forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire Marshal ()
    marshaler Endianness
    e MarshalState
    emptyState of
            WireRL String
    err -> MarshalError -> Either MarshalError (ByteString, [Fd])
    forall a b. a -> Either a b
    Left (String -> MarshalError
    MarshalError String
    err)
            WireRR ()
    _ (MarshalState Builder
    builder Word64
    _ Map Fd Word32
    fds) ->
                let fdList :: [Fd]
    fdList = (((Fd, Word32) -> Fd) -> [(Fd, Word32)] -> [Fd]
    forall a b. (a -> b) -> [a] -> [b]
    map (Fd, Word32) -> Fd
    forall a b. (a, b) -> a
    fst ([(Fd, Word32)] -> [Fd])
    -> (Map Fd Word32 -> [(Fd, Word32)]) -> Map Fd Word32 -> [Fd]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Fd, Word32) -> Word32) -> [(Fd, Word32)] -> [(Fd, Word32)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Fd, Word32) -> Word32
    forall a b. (a, b) -> b
    snd ([(Fd, Word32)] -> [(Fd, Word32)])
    -> (Map Fd Word32 -> [(Fd, Word32)])
    -> Map Fd Word32
    -> [(Fd, Word32)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Fd Word32 -> [(Fd, Word32)]
    forall k a. Map k a -> [(k, a)]
    Data.Map.toList) Map Fd Word32
    fds
                in (ByteString, [Fd]) -> Either MarshalError (ByteString, [Fd])
    forall a b. b -> Either a b
    Right (ByteString -> ByteString
    Lazy.toStrict (Builder -> ByteString
    Builder.toLazyByteString Builder
    builder), [Fd]
    fdList)

    checkBodySig :: [Variant] -> Marshal Signature
    checkBodySig :: [Variant] -> Wire MarshalState Signature
    checkBodySig [Variant]
    vs = case [Type] -> Maybe Signature
    forall (m :: * -> *). MonadThrow m => [Type] -> m Signature
    signature ((Variant -> Type) -> [Variant] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Variant -> Type
    variantType [Variant]
    vs) of
        Just Signature
    x -> Signature -> Wire MarshalState Signature
    forall a. a -> Wire MarshalState a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Signature
    x
        Maybe Signature
    Nothing -> String -> Wire MarshalState Signature
    forall s a. String -> Wire s a
    throwError (String
    "Message body " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Variant] -> String
    forall a. Show a => a -> String
    show [Variant]
    vs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " has too many items")

    marshalHeader :: Message a => a -> Serial -> Signature -> Word32 -> Int
                  -> Marshal ()
    marshalHeader :: forall a.
    Message a =>
    a -> Serial -> Signature -> Word32 -> Int -> Marshal ()
    marshalHeader a
    msg Serial
    serial Signature
    bodySig Word32
    bodyLength Int
    numFds = do
        let fields :: [HeaderField]
    fields = Signature -> HeaderField
    HeaderSignature Signature
    bodySig HeaderField -> [HeaderField] -> [HeaderField]
    forall a. a -> [a] -> [a]
    : Int -> [HeaderField] -> [HeaderField]
    consUnixFdsField Int
    numFds (a -> [HeaderField]
    forall a. Message a => a -> [HeaderField]
    messageHeaderFields a
    msg)
        Word8 -> Marshal ()
    marshalWord8 (a -> Word8
    forall a. Message a => a -> Word8
    messageTypeCode a
    msg)
        Word8 -> Marshal ()
    marshalWord8 (a -> Word8
    forall a. Message a => a -> Word8
    messageFlags a
    msg)
        Word8 -> Marshal ()
    marshalWord8 Word8
    protocolVersion
        Word32 -> Marshal ()
    marshalWord32 Word32
    bodyLength
        Word32 -> Marshal ()
    marshalWord32 (Serial -> Word32
    serialValue Serial
    serial)
        let fieldType :: Type
    fieldType = [Type] -> Type
    TypeStructure [Type
    TypeWord8, Type
    TypeVariant]
        Type -> Vector Value -> Marshal ()
    marshalVector Type
    fieldType ([Value] -> Vector Value
    forall a. [a] -> Vector a
    Data.Vector.fromList ((HeaderField -> Value) -> [HeaderField] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map HeaderField -> Value
    encodeField [HeaderField]
    fields))

    consUnixFdsField :: Int -> [HeaderField] -> [HeaderField]
    consUnixFdsField :: Int -> [HeaderField] -> [HeaderField]
    consUnixFdsField Int
    numFds [HeaderField]
    headers =
        if Int
    numFds Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
            then [HeaderField]
    filteredHeaders
            else Word32 -> HeaderField
    HeaderUnixFds (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    numFds) HeaderField -> [HeaderField] -> [HeaderField]
    forall a. a -> [a] -> [a]
    : [HeaderField]
    filteredHeaders
        where
            filteredHeaders :: [HeaderField]
    filteredHeaders = (HeaderField -> Bool) -> [HeaderField] -> [HeaderField]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (HeaderField -> Bool) -> HeaderField -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderField -> Bool
    isHeaderUnixFds) [HeaderField]
    headers
            isHeaderUnixFds :: HeaderField -> Bool
    isHeaderUnixFds = \case
                HeaderUnixFds Word32
    _ -> Bool
    True
                HeaderField
    _ -> Bool
    False

    checkMaximumSize :: Marshal ()
    checkMaximumSize :: Marshal ()
    checkMaximumSize = do
        (MarshalState _ messageLength _) <- Wire MarshalState MarshalState
    forall s. Wire s s
    getState
        when (toInteger messageLength > messageMaximumLength)
            (throwError ("Marshaled message size (" ++ show messageLength ++ " bytes) exeeds maximum limit of (" ++ show messageMaximumLength ++ " bytes)."))

    unmarshalMessageM :: Monad m => (Int -> m (ByteString, [Fd]))
                      -> m (Either UnmarshalError ReceivedMessage)
    unmarshalMessageM :: forall (m :: * -> *).
    Monad m =>
    (Int -> m (ByteString, [Fd]))
    -> m (Either UnmarshalError ReceivedMessage)
    unmarshalMessageM Int -> m (ByteString, [Fd])
    getBytes' = ErrorT UnmarshalError m ReceivedMessage
    -> m (Either UnmarshalError ReceivedMessage)
    forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
    runErrorT (ErrorT UnmarshalError m ReceivedMessage
     -> m (Either UnmarshalError ReceivedMessage))
    -> ErrorT UnmarshalError m ReceivedMessage
    -> m (Either UnmarshalError ReceivedMessage)
    forall a b. (a -> b) -> a -> b
    $ do
        let getBytes :: Int -> ErrorT UnmarshalError m (ByteString, [Fd])
    getBytes Int
    count = do
                (bytes, fds) <- m (Either UnmarshalError (ByteString, [Fd]))
    -> ErrorT UnmarshalError m (ByteString, [Fd])
    forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
    ErrorT (((ByteString, [Fd]) -> Either UnmarshalError (ByteString, [Fd]))
    -> m (ByteString, [Fd])
    -> m (Either UnmarshalError (ByteString, [Fd]))
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (ByteString, [Fd]) -> Either UnmarshalError (ByteString, [Fd])
    forall a b. b -> Either a b
    Right (Int -> m (ByteString, [Fd])
    getBytes' Int
    count))
                if Data.ByteString.length bytes < count
                    then throwErrorT (UnmarshalError "Unexpected end of input while parsing message header.")
                    else return (bytes, fds)

        let Just Signature
    fixedSig = String -> Maybe Signature
    forall (m :: * -> *). MonadThrow m => String -> m Signature
    parseSignature String
    "yyyyuuu"
        (fixedBytes, fixedFds) <- Int -> ErrorT UnmarshalError m (ByteString, [Fd])
    getBytes Int
    16

        let messageVersion = HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    Data.ByteString.index ByteString
    fixedBytes Int
    3
        when (messageVersion /= protocolVersion) (throwErrorT (UnmarshalError ("Unsupported protocol version: " ++ show messageVersion)))

        let eByte = HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    Data.ByteString.index ByteString
    fixedBytes Int
    0
        endianness <- case decodeEndianness eByte of
            Just Endianness
    x' -> Endianness -> ErrorT UnmarshalError m Endianness
    forall a. a -> ErrorT UnmarshalError m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    x'
            Maybe Endianness
    Nothing -> UnmarshalError -> ErrorT UnmarshalError m Endianness
    forall (m :: * -> *) e a. Monad m => e -> ErrorT e m a
    throwErrorT (String -> UnmarshalError
    UnmarshalError (String
    "Invalid endianness: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String
    forall a. Show a => a -> String
    show Word8
    eByte))

        let unmarshalSig = (Type -> Unmarshal Value) -> [Type] -> Wire UnmarshalState [Value]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> Unmarshal Value
    unmarshal ([Type] -> Wire UnmarshalState [Value])
    -> (Signature -> [Type])
    -> Signature
    -> Wire UnmarshalState [Value]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Signature -> [Type]
    signatureTypes
        let unmarshal' Signature
    x ByteString
    bytes [Fd]
    fds = case Wire UnmarshalState [Value]
    -> Endianness -> UnmarshalState -> WireR UnmarshalState [Value]
    forall s a. Wire s a -> Endianness -> s -> WireR s a
    unWire (Signature -> Wire UnmarshalState [Value]
    unmarshalSig Signature
    x) Endianness
    endianness (ByteString -> Word64 -> [Fd] -> UnmarshalState
    UnmarshalState ByteString
    bytes Word64
    0 [Fd]
    fds) of
                WireRR [Value]
    x' UnmarshalState
    _ -> [Value] -> ErrorT UnmarshalError m [Value]
    forall a. a -> ErrorT UnmarshalError m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Value]
    x'
                WireRL String
    err  -> UnmarshalError -> ErrorT UnmarshalError m [Value]
    forall (m :: * -> *) e a. Monad m => e -> ErrorT e m a
    throwErrorT (String -> UnmarshalError
    UnmarshalError String
    err)
        fixed <- unmarshal' fixedSig fixedBytes []
        let messageType = Maybe Word8 -> Word8
    forall a. HasCallStack => Maybe a -> a
    fromJust (Value -> Maybe Word8
    forall a. IsValue a => Value -> Maybe a
    fromValue ([Value]
    fixed [Value] -> Int -> Value
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    1))
        let flags = Maybe Word8 -> Word8
    forall a. HasCallStack => Maybe a -> a
    fromJust (Value -> Maybe Word8
    forall a. IsValue a => Value -> Maybe a
    fromValue ([Value]
    fixed [Value] -> Int -> Value
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    2))
        let bodyLength = Maybe Word32 -> Word32
    forall a. HasCallStack => Maybe a -> a
    fromJust (Value -> Maybe Word32
    forall a. IsValue a => Value -> Maybe a
    fromValue ([Value]
    fixed [Value] -> Int -> Value
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    4)) :: Word32
        let serial = Maybe Serial -> Serial
    forall a. HasCallStack => Maybe a -> a
    fromJust (Variant -> Maybe Serial
    forall a. IsVariant a => Variant -> Maybe a
    fromVariant (Value -> Variant
    Variant ([Value]
    fixed [Value] -> Int -> Value
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    5)))

        let fieldByteCount = Maybe Word32 -> Word32
    forall a. HasCallStack => Maybe a -> a
    fromJust (Value -> Maybe Word32
    forall a. IsValue a => Value -> Maybe a
    fromValue ([Value]
    fixed [Value] -> Int -> Value
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    6)) :: Word32
        let bodyPadding = Word64 -> Word8 -> Word64
    padding (Word32 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    fieldByteCount Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + Word64
    16) Word8
    8

        -- Forbid messages larger than 'messageMaximumLength'
        let messageLength = Integer
    16 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger Word32
    fieldByteCount Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Word64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger Word64
    bodyPadding Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger Word32
    bodyLength
        when (messageLength > messageMaximumLength) $
            throwErrorT (UnmarshalError ("Message size " ++ show messageLength ++ " exceeds limit of " ++ show messageMaximumLength))

        let Just headerSig  = parseSignature "yyyyuua(yv)"
        (fieldBytes, fieldFds) <- getBytes (fromIntegral fieldByteCount)
        let headerBytes = ByteString -> ByteString -> ByteString
    Data.ByteString.append ByteString
    fixedBytes ByteString
    fieldBytes
        header <- unmarshal' headerSig headerBytes []

        let fieldArray = Vector (Word8, Variant) -> [(Word8, Variant)]
    forall a. Vector a -> [a]
    Data.Vector.toList (Maybe (Vector (Word8, Variant)) -> Vector (Word8, Variant)
    forall a. HasCallStack => Maybe a -> a
    fromJust (Value -> Maybe (Vector (Word8, Variant))
    forall a. IsValue a => Value -> Maybe a
    fromValue ([Value]
    header [Value] -> Int -> Value
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    6)))
        fields <- case runErrorM $ concat `liftM` mapM decodeField fieldArray of
            Left UnmarshalError
    err -> UnmarshalError -> ErrorT UnmarshalError m [HeaderField]
    forall (m :: * -> *) e a. Monad m => e -> ErrorT e m a
    throwErrorT UnmarshalError
    err
            Right [HeaderField]
    x -> [HeaderField] -> ErrorT UnmarshalError m [HeaderField]
    forall a. a -> ErrorT UnmarshalError m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [HeaderField]
    x
        (_, paddingFds) <- getBytes (fromIntegral bodyPadding)
        let bodySig = [HeaderField] -> Signature
    findBodySignature [HeaderField]
    fields
        (bodyBytes, bodyFds) <- getBytes (fromIntegral bodyLength)
        let fds = [Fd]
    fixedFds [Fd] -> [Fd] -> [Fd]
    forall a. Semigroup a => a -> a -> a
    <> [Fd]
    fieldFds [Fd] -> [Fd] -> [Fd]
    forall a. Semigroup a => a -> a -> a
    <> [Fd]
    paddingFds [Fd] -> [Fd] -> [Fd]
    forall a. Semigroup a => a -> a -> a
    <> [Fd]
    bodyFds
        checkUnixFdsHeader fields fds
        body <- unmarshal' bodySig bodyBytes fds
        y <- case runErrorM (buildReceivedMessage messageType fields) of
            Right Serial -> Word8 -> [Variant] -> ReceivedMessage
    x -> (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    -> ErrorT
         UnmarshalError m (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    forall a. a -> ErrorT UnmarshalError m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Serial -> Word8 -> [Variant] -> ReceivedMessage
    x
            Left String
    err -> UnmarshalError
    -> ErrorT
         UnmarshalError m (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    forall (m :: * -> *) e a. Monad m => e -> ErrorT e m a
    throwErrorT (String -> UnmarshalError
    UnmarshalError (String
    "Header field " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    err String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " is required, but missing"))
        return (y serial flags (map Variant body))

    checkUnixFdsHeader :: Monad m => [HeaderField] -> [Fd] -> ErrorT UnmarshalError m ()
    checkUnixFdsHeader :: forall (m :: * -> *).
    Monad m =>
    [HeaderField] -> [Fd] -> ErrorT UnmarshalError m ()
    checkUnixFdsHeader [HeaderField]
    fields [Fd]
    fds = do
        let headerCount :: Int
    headerCount = [HeaderField] -> Int
    findUnixFds [HeaderField]
    fields
        Bool -> ErrorT UnmarshalError m () -> ErrorT UnmarshalError m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    headerCount Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Fd] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Fd]
    fds) (ErrorT UnmarshalError m () -> ErrorT UnmarshalError m ())
    -> ErrorT UnmarshalError m () -> ErrorT UnmarshalError m ()
    forall a b. (a -> b) -> a -> b
    $
            UnmarshalError -> ErrorT UnmarshalError m ()
    forall (m :: * -> *) e a. Monad m => e -> ErrorT e m a
    throwErrorT (String -> UnmarshalError
    UnmarshalError (String
    "File descriptor count in message header"
              String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " (" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    headerCount String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ") does not match the number of file descriptors"
              String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " received from the socket (" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show ([Fd] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Fd]
    fds) String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ")."))

    findBodySignature :: [HeaderField] -> Signature
    findBodySignature :: [HeaderField] -> Signature
    findBodySignature [HeaderField]
    fields = Signature -> Maybe Signature -> Signature
    forall a. a -> Maybe a -> a
    fromMaybe ([Type] -> Signature
    signature_ []) ([Signature] -> Maybe Signature
    forall a. [a] -> Maybe a
    listToMaybe [Signature
    x | HeaderSignature Signature
    x <- [HeaderField]
    fields])

    findUnixFds :: [HeaderField] -> Int
    findUnixFds :: [HeaderField] -> Int
    findUnixFds [HeaderField]
    fields = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 ([Int] -> Maybe Int
    forall a. [a] -> Maybe a
    listToMaybe [Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    n | HeaderUnixFds Word32
    n <- [HeaderField]
    fields])

    buildReceivedMessage :: Word8 -> [HeaderField] -> ErrorM String (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    buildReceivedMessage :: Word8
    -> [HeaderField]
    -> ErrorM String (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    buildReceivedMessage Word8
    1 [HeaderField]
    fields = do
        path <- String -> [ObjectPath] -> ErrorM String ObjectPath
    forall a. String -> [a] -> ErrorM String a
    require String
    "path" [ObjectPath
    x | HeaderPath ObjectPath
    x <- [HeaderField]
    fields]
        member <- require "member name" [x | HeaderMember x <- fields]
        return $ \Serial
    serial Word8
    flags [Variant]
    body -> let
            iface :: Maybe InterfaceName
    iface = [InterfaceName] -> Maybe InterfaceName
    forall a. [a] -> Maybe a
    listToMaybe [InterfaceName
    x | HeaderInterface InterfaceName
    x <- [HeaderField]
    fields]
            dest :: Maybe BusName
    dest = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderDestination BusName
    x <- [HeaderField]
    fields]
            sender :: Maybe BusName
    sender = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderSender BusName
    x <- [HeaderField]
    fields]
            msg :: MethodCall
    msg = ObjectPath
    -> Maybe InterfaceName
    -> MemberName
    -> Maybe BusName
    -> Maybe BusName
    -> Bool
    -> Bool
    -> [Variant]
    -> MethodCall
    MethodCall ObjectPath
    path Maybe InterfaceName
    iface MemberName
    member Maybe BusName
    sender Maybe BusName
    dest Bool
    True Bool
    True [Variant]
    body
            in Serial -> MethodCall -> ReceivedMessage
    ReceivedMethodCall Serial
    serial (MethodCall -> Word8 -> MethodCall
    setMethodCallFlags MethodCall
    msg Word8
    flags)

    buildReceivedMessage Word8
    2 [HeaderField]
    fields = do
        replySerial <- String -> [Serial] -> ErrorM String Serial
    forall a. String -> [a] -> ErrorM String a
    require String
    "reply serial" [Serial
    x | HeaderReplySerial Serial
    x <- [HeaderField]
    fields]
        return $ \Serial
    serial Word8
    _ [Variant]
    body -> let
            dest :: Maybe BusName
    dest = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderDestination BusName
    x <- [HeaderField]
    fields]
            sender :: Maybe BusName
    sender = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderSender BusName
    x <- [HeaderField]
    fields]
            msg :: MethodReturn
    msg = Serial
    -> Maybe BusName -> Maybe BusName -> [Variant] -> MethodReturn
    MethodReturn Serial
    replySerial Maybe BusName
    sender Maybe BusName
    dest [Variant]
    body
            in Serial -> MethodReturn -> ReceivedMessage
    ReceivedMethodReturn Serial
    serial MethodReturn
    msg

    buildReceivedMessage Word8
    3 [HeaderField]
    fields = do
        name <- String -> [ErrorName] -> ErrorM String ErrorName
    forall a. String -> [a] -> ErrorM String a
    require String
    "error name" [ErrorName
    x | HeaderErrorName ErrorName
    x <- [HeaderField]
    fields]
        replySerial <- require "reply serial" [x | HeaderReplySerial x <- fields]
        return $ \Serial
    serial Word8
    _ [Variant]
    body -> let
            dest :: Maybe BusName
    dest = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderDestination BusName
    x <- [HeaderField]
    fields]
            sender :: Maybe BusName
    sender = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderSender BusName
    x <- [HeaderField]
    fields]
            msg :: MethodError
    msg = ErrorName
    -> Serial
    -> Maybe BusName
    -> Maybe BusName
    -> [Variant]
    -> MethodError
    MethodError ErrorName
    name Serial
    replySerial Maybe BusName
    sender Maybe BusName
    dest [Variant]
    body
            in Serial -> MethodError -> ReceivedMessage
    ReceivedMethodError Serial
    serial MethodError
    msg

    buildReceivedMessage Word8
    4 [HeaderField]
    fields = do
        path <- String -> [ObjectPath] -> ErrorM String ObjectPath
    forall a. String -> [a] -> ErrorM String a
    require String
    "path" [ObjectPath
    x | HeaderPath ObjectPath
    x <- [HeaderField]
    fields]
        member <- require "member name" [x | HeaderMember x <- fields]
        iface <- require "interface" [x | HeaderInterface x <- fields]
        return $ \Serial
    serial Word8
    _ [Variant]
    body -> let
            dest :: Maybe BusName
    dest = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderDestination BusName
    x <- [HeaderField]
    fields]
            sender :: Maybe BusName
    sender = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderSender BusName
    x <- [HeaderField]
    fields]
            msg :: Signal
    msg = ObjectPath
    -> InterfaceName
    -> MemberName
    -> Maybe BusName
    -> Maybe BusName
    -> [Variant]
    -> Signal
    Signal ObjectPath
    path InterfaceName
    iface MemberName
    member Maybe BusName
    sender Maybe BusName
    dest [Variant]
    body
            in Serial -> Signal -> ReceivedMessage
    ReceivedSignal Serial
    serial Signal
    msg

    buildReceivedMessage Word8
    messageType [HeaderField]
    fields = (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    -> ErrorM String (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    forall a. a -> ErrorM String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Serial -> Word8 -> [Variant] -> ReceivedMessage)
     -> ErrorM String (Serial -> Word8 -> [Variant] -> ReceivedMessage))
    -> (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    -> ErrorM String (Serial -> Word8 -> [Variant] -> ReceivedMessage)
    forall a b. (a -> b) -> a -> b
    $ \Serial
    serial Word8
    _ [Variant]
    body -> let
        sender :: Maybe BusName
    sender = [BusName] -> Maybe BusName
    forall a. [a] -> Maybe a
    listToMaybe [BusName
    x | HeaderSender BusName
    x <- [HeaderField]
    fields]
        msg :: UnknownMessage
    msg = Word8 -> Maybe BusName -> [Variant] -> UnknownMessage
    UnknownMessage Word8
    messageType Maybe BusName
    sender [Variant]
    body
        in Serial -> UnknownMessage -> ReceivedMessage
    ReceivedUnknown Serial
    serial UnknownMessage
    msg

    require :: String -> [a] -> ErrorM String a
    require :: forall a. String -> [a] -> ErrorM String a
    require String
    _     (a
    x:[a]
    _) = a -> ErrorM String a
    forall a. a -> ErrorM String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
    require String
    label [a]
    _     = String -> ErrorM String a
    forall e a. e -> ErrorM e a
    throwErrorM String
    label

    unmarshalMessage :: ByteString -> [Fd] -> Either UnmarshalError ReceivedMessage
    unmarshalMessage :: ByteString -> [Fd] -> Either UnmarshalError ReceivedMessage
    unmarshalMessage ByteString
    bytes [Fd]
    fds = Either String (Either UnmarshalError ReceivedMessage)
    -> Either UnmarshalError ReceivedMessage
    forall {b}.
    Either String (Either UnmarshalError b) -> Either UnmarshalError b
    checkError (Get (Either UnmarshalError ReceivedMessage)
    -> ByteString
    -> Either String (Either UnmarshalError ReceivedMessage)
    forall a. Get a -> ByteString -> Either String a
    Get.runGet Get (Either UnmarshalError ReceivedMessage)
    get ByteString
    bytes) where
        get :: Get (Either UnmarshalError ReceivedMessage)
    get = (Int -> Get (ByteString, [Fd]))
    -> Get (Either UnmarshalError ReceivedMessage)
    forall (m :: * -> *).
    Monad m =>
    (Int -> m (ByteString, [Fd]))
    -> m (Either UnmarshalError ReceivedMessage)
    unmarshalMessageM Int -> Get (ByteString, [Fd])
    getBytes

        -- wrap getByteString, so it will behave like transportGet and return
        -- a truncated result on EOF instead of throwing an exception.
        getBytes :: Int -> Get (ByteString, [Fd])
    getBytes Int
    count = do
            remaining <- Get Int
    Get.remaining
            buf <- Get.getByteString (min remaining count)
            return (buf, if remaining == Data.ByteString.length bytes then fds else [])

        checkError :: Either String (Either UnmarshalError b) -> Either UnmarshalError b
    checkError (Left String
    err) = UnmarshalError -> Either UnmarshalError b
    forall a b. a -> Either a b
    Left (String -> UnmarshalError
    UnmarshalError String
    err)
        checkError (Right Either UnmarshalError b
    x) = Either UnmarshalError b
    x

    untilM :: Monad m => m Bool -> m a -> m [a]
    untilM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
    untilM m Bool
    test m a
    comp = do
        done <- m Bool
    test
        if done
            then return []
            else do
                x <- comp
                xs <- untilM test comp
                return (x:xs)

    -------------------------------------------------------------------------------
    -- local ErrorT and MonadError, which don't have the silly Error => dependency
    -- found in the "transformers" package.
    -------------------------------------------------------------------------------

    newtype ErrorM e a = ErrorM { forall e a. ErrorM e a -> Either e a
    runErrorM :: Either e a }

    instance Functor (ErrorM e) where
        fmap :: forall a b. (a -> b) -> ErrorM e a -> ErrorM e b
    fmap a -> b
    f ErrorM e a
    m = Either e b -> ErrorM e b
    forall e a. Either e a -> ErrorM e a
    ErrorM (Either e b -> ErrorM e b) -> Either e b -> ErrorM e b
    forall a b. (a -> b) -> a -> b
    $ case ErrorM e a -> Either e a
    forall e a. ErrorM e a -> Either e a
    runErrorM ErrorM e a
    m of
            Left e
    err -> e -> Either e b
    forall a b. a -> Either a b
    Left e
    err
            Right a
    x -> b -> Either e b
    forall a b. b -> Either a b
    Right (a -> b
    f a
    x)

    instance Control.Applicative.Applicative (ErrorM e) where
        pure :: forall a. a -> ErrorM e a
    pure = Either e a -> ErrorM e a
    forall e a. Either e a -> ErrorM e a
    ErrorM (Either e a -> ErrorM e a) -> (a -> Either e a) -> a -> ErrorM e a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either e a
    forall a b. b -> Either a b
    Right
        <*> :: forall a b. ErrorM e (a -> b) -> ErrorM e a -> ErrorM e b
    (<*>) = ErrorM e (a -> b) -> ErrorM e a -> ErrorM e b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad (ErrorM e) where
        >>= :: forall a b. ErrorM e a -> (a -> ErrorM e b) -> ErrorM e b
    (>>=) ErrorM e a
    m a -> ErrorM e b
    k = case ErrorM e a -> Either e a
    forall e a. ErrorM e a -> Either e a
    runErrorM ErrorM e a
    m of
            Left e
    err -> Either e b -> ErrorM e b
    forall e a. Either e a -> ErrorM e a
    ErrorM (e -> Either e b
    forall a b. a -> Either a b
    Left e
    err)
            Right a
    x -> a -> ErrorM e b
    k a
    x

    throwErrorM :: e -> ErrorM e a
    throwErrorM :: forall e a. e -> ErrorM e a
    throwErrorM = Either e a -> ErrorM e a
    forall e a. Either e a -> ErrorM e a
    ErrorM (Either e a -> ErrorM e a) -> (e -> Either e a) -> e -> ErrorM e a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> Either e a
    forall a b. a -> Either a b
    Left

    newtype ErrorT e m a = ErrorT { forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
    runErrorT :: m (Either e a) }

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

    instance Monad m => Control.Applicative.Applicative (ErrorT e m) where
        pure :: forall a. a -> ErrorT e m a
    pure = m (Either e a) -> ErrorT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
    ErrorT (m (Either e a) -> ErrorT e m a)
    -> (a -> m (Either e a)) -> a -> ErrorT e m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either e a -> m (Either e a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either e a -> m (Either e a))
    -> (a -> Either e a) -> a -> m (Either e a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either e a
    forall a b. b -> Either a b
    Right
        <*> :: forall a b. ErrorT e m (a -> b) -> ErrorT e m a -> ErrorT e m b
    (<*>) = ErrorT e m (a -> b) -> ErrorT e m a -> ErrorT e m b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad m => Monad (ErrorT e m) where
        >>= :: forall a b. ErrorT e m a -> (a -> ErrorT e m b) -> ErrorT e m b
    (>>=) ErrorT e m a
    m a -> ErrorT e m b
    k = m (Either e b) -> ErrorT e m b
    forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
    ErrorT (m (Either e b) -> ErrorT e m b) -> m (Either e b) -> ErrorT e m b
    forall a b. (a -> b) -> a -> b
    $ do
            x <- ErrorT e m a -> m (Either e a)
    forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
    runErrorT ErrorT e m a
    m
            case x of
                Left e
    l -> Either e b -> m (Either e b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (e -> Either e b
    forall a b. a -> Either a b
    Left e
    l)
                Right a
    r -> ErrorT e m b -> m (Either e b)
    forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
    runErrorT (a -> ErrorT e m b
    k a
    r)

    throwErrorT :: Monad m => e -> ErrorT e m a
    throwErrorT :: forall (m :: * -> *) e a. Monad m => e -> ErrorT e m a
    throwErrorT = m (Either e a) -> ErrorT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
    ErrorT (m (Either e a) -> ErrorT e m a)
    -> (e -> m (Either e a)) -> e -> ErrorT e m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either e a -> m (Either e a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either e a -> m (Either e a))
    -> (e -> Either e a) -> e -> m (Either e a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> Either e a
    forall a b. a -> Either a b
    Left