    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell #-}
    module DBus.Generation where

    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Reader
    import           DBus.Client as C
    import qualified DBus.Internal.Message as M
    import qualified DBus.Internal.Types as T
    import qualified DBus.Introspection.Parse as I
    import qualified DBus.Introspection.Types as I
    import qualified Data.ByteString as BS
    import qualified Data.Char as Char
    import           Data.Coerce
    import           Data.Int
    import           Data.List
    import qualified Data.Map as Map
    import           Data.Maybe
    import           Data.Monoid
    import           Data.String
    import qualified Data.Text.IO as Text
    import           Data.Traversable
    import           Data.Word
    import           Language.Haskell.TH
    import           Prelude hiding (mapM)
    import           System.Posix.Types (Fd(..))

    -- | Compatibility helper to create (total) tuple expressions
    mkTupE :: [Exp] -> Exp
    mkTupE :: [Exp] -> Exp
    mkTupE = [Maybe Exp] -> Exp
    TupE
    #if MIN_VERSION_template_haskell(2,16,0)
             ([Maybe Exp] -> Exp) -> ([Exp] -> [Maybe Exp]) -> [Exp] -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just
    #endif

    type ClientBusPathR a = ReaderT (Client, T.BusName, T.ObjectPath) IO a

    dbusInvoke :: (Client -> T.BusName -> T.ObjectPath -> a) -> ClientBusPathR a
    dbusInvoke :: forall a.
    (Client -> BusName -> ObjectPath -> a) -> ClientBusPathR a
    dbusInvoke Client -> BusName -> ObjectPath -> a
    fn = (\(Client
    c, BusName
    b, ObjectPath
    p) -> Client -> BusName -> ObjectPath -> a
    fn Client
    c BusName
    b ObjectPath
    p) ((Client, BusName, ObjectPath) -> a)
    -> ReaderT
         (Client, BusName, ObjectPath) IO (Client, BusName, ObjectPath)
    -> ReaderT (Client, BusName, ObjectPath) IO a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT
      (Client, BusName, ObjectPath) IO (Client, BusName, ObjectPath)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask

    -- Use these operators together with dbusInvoke to invoke functions of the form
    -- Client -> T.BusName -> T.ObjectPath
    infixl 4 ??
    (??) :: Functor f => f (a -> b) -> a -> f b
    f (a -> b)
    fab ?? :: forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
    ?? a
    a = ((a -> b) -> b) -> f (a -> b) -> f b
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    a) f (a -> b)
    fab
    {-# INLINE (??) #-}

    infixl 4 ?/?
    (?/?) :: ClientBusPathR (a -> IO b) -> a -> ClientBusPathR b
    ClientBusPathR (a -> IO b)
    soFar ?/? :: forall a b. ClientBusPathR (a -> IO b) -> a -> ClientBusPathR b
    ?/? a
    arg = do
      returnValue <- ((a -> IO b) -> IO b)
    -> ClientBusPathR (a -> IO b)
    -> ReaderT (Client, BusName, ObjectPath) IO (IO b)
    forall a b.
    (a -> b)
    -> ReaderT (Client, BusName, ObjectPath) IO a
    -> ReaderT (Client, BusName, ObjectPath) IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> IO b) -> a -> IO b
    forall a b. (a -> b) -> a -> b
    $ a
    arg) ClientBusPathR (a -> IO b)
    soFar
      lift returnValue

    data GenerationParams = GenerationParams
      { GenerationParams -> Maybe BusName
    genBusName :: Maybe T.BusName
      , GenerationParams -> Maybe ObjectPath
    genObjectPath :: Maybe T.ObjectPath
      , GenerationParams -> InterfaceName
    genInterfaceName :: T.InterfaceName
      , GenerationParams -> Bool
    genTakeSignalErrorHandler :: Bool
      , GenerationParams -> Type -> Type
    getTHType :: T.Type -> Type
      }

    defaultGetDictType :: Type -> Type -> Type
    defaultGetDictType :: Type -> Type -> Type
    defaultGetDictType Type
    k =
      Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT (Name -> Type
    ConT ''Map.Map) Type
    k)

    defaultGetTHType :: T.Type -> Type
    defaultGetTHType :: Type -> Type
    defaultGetTHType = (Type -> Type) -> (Type -> Type -> Type) -> Type -> Type
    buildGetTHType (Type -> Type -> Type
    AppT Type
    ListT) Type -> Type -> Type
    defaultGetDictType

    buildGetTHType ::
      (Type -> Type) -> (Type -> Type -> Type) -> T.Type -> Type
    buildGetTHType :: (Type -> Type) -> (Type -> Type -> Type) -> Type -> Type
    buildGetTHType Type -> Type
    arrayTypeBuilder Type -> Type -> Type
    dictTypeBuilder = Type -> Type
    fn
      where fn :: Type -> Type
    fn Type
    t =
              case Type
    t of
                -- Because of a quirk in how we unmarshal things, we currently HAVE
                -- to decorde arrays of Word8 in this way.
                T.TypeArray Type
    T.TypeWord8 -> Name -> Type
    ConT ''BS.ByteString
                Type
    T.TypeBoolean -> Name -> Type
    ConT ''Bool
                Type
    T.TypeWord8 -> Name -> Type
    ConT ''Word8
                Type
    T.TypeWord16 -> Name -> Type
    ConT ''Word16
                Type
    T.TypeWord32 -> Name -> Type
    ConT ''Word32
                Type
    T.TypeWord64 -> Name -> Type
    ConT ''Word64
                Type
    T.TypeInt16 -> Name -> Type
    ConT ''Int16
                Type
    T.TypeInt32 -> Name -> Type
    ConT ''Int32
                Type
    T.TypeInt64 -> Name -> Type
    ConT ''Int64
                Type
    T.TypeDouble -> Name -> Type
    ConT ''Double
                Type
    T.TypeUnixFd -> Name -> Type
    ConT ''Fd
                Type
    T.TypeString -> Name -> Type
    ConT ''String
                Type
    T.TypeSignature -> Name -> Type
    ConT ''T.Signature
                Type
    T.TypeObjectPath -> Name -> Type
    ConT ''T.ObjectPath
                Type
    T.TypeVariant -> Name -> Type
    ConT ''T.Variant
                T.TypeArray Type
    arrayType -> Type -> Type
    arrayTypeBuilder (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type
    fn Type
    arrayType
                T.TypeDictionary Type
    k Type
    v -> Type -> Type -> Type
    dictTypeBuilder (Type -> Type
    fn Type
    k) (Type -> Type
    fn Type
    v)
                T.TypeStructure [Type]
    ts -> (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT (Int -> Type
    TupleT (Int -> Type) -> Int -> Type
    forall a b. (a -> b) -> a -> b
    $ [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    ts) ([Type] -> Type) -> [Type] -> Type
    forall a b. (a -> b) -> a -> b
    $ (Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Type
    fn [Type]
    ts

    newNameDef :: String -> Q Name
    newNameDef :: String -> Q Name
    newNameDef String
    n =
      case String
    n of
        String
    "" -> String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "arg"
        String
    "data" -> String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "arg"
        String
    _ -> String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    n

    defaultGenerationParams :: GenerationParams
    defaultGenerationParams :: GenerationParams
    defaultGenerationParams =
      GenerationParams
      { genBusName :: Maybe BusName
    genBusName = Maybe BusName
    forall a. Maybe a
    Nothing
      , genInterfaceName :: InterfaceName
    genInterfaceName = String -> InterfaceName
    forall a. IsString a => String -> a
    fromString String
    ""
      , getTHType :: Type -> Type
    getTHType = Type -> Type
    defaultGetTHType
      , genObjectPath :: Maybe ObjectPath
    genObjectPath = Maybe ObjectPath
    forall a. Maybe a
    Nothing
      , genTakeSignalErrorHandler :: Bool
    genTakeSignalErrorHandler = Bool
    False
      }

    addTypeArg :: Type -> Type -> Type
    addTypeArg :: Type -> Type -> Type
    addTypeArg Type
    argT = Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT Type
    ArrowT Type
    argT)

    addTypeArgIf :: Bool -> Type -> Type -> Type
    addTypeArgIf :: Bool -> Type -> Type -> Type
    addTypeArgIf Bool
    condition Type
    theType = if Bool
    condition then Type -> Type -> Type
    addTypeArg Type
    theType else Type -> Type
    forall a. a -> a
    id

    unitIOType :: Type
    unitIOType :: Type
    unitIOType = Type -> Type -> Type
    AppT (Name -> Type
    ConT ''IO) (Int -> Type
    TupleT Int
    0)

    addArgIf :: Bool -> a -> [a] -> [a]
    addArgIf :: forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    condition a
    name = if Bool
    condition then (a
    namea -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) else [a] -> [a]
    forall a. a -> a
    id

    mkFunD :: Name -> [Name] -> Exp -> Dec
    mkFunD :: Name -> [Name] -> Exp -> Dec
    mkFunD Name
    name [Name]
    argNames Exp
    body =
      Name -> [Clause] -> Dec
    FunD Name
    name [[Pat] -> Body -> [Dec] -> Clause
    Clause ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    argNames) (Exp -> Body
    NormalB Exp
    body) []]

    generateClient :: GenerationParams -> I.Interface -> Q [Dec]
    generateClient :: GenerationParams -> Interface -> Q [Dec]
    generateClient GenerationParams
    params
                   I.Interface{ interfaceName :: Interface -> InterfaceName
    I.interfaceName = InterfaceName
    name
                              , interfaceProperties :: Interface -> [Property]
    I.interfaceProperties = [Property]
    properties
                              , interfaceMethods :: Interface -> [Method]
    I.interfaceMethods = [Method]
    methods
                              } =
      let params' :: GenerationParams
    params' = GenerationParams
    params { genInterfaceName = coerce name } in
      ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Dec]] -> [Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Q [[Dec]] -> Q [Dec])
    -> ([Q [Dec]] -> Q [[Dec]]) -> [Q [Dec]] -> Q [Dec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q [Dec]] -> Q [[Dec]]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
    sequenceA ([Q [Dec]] -> Q [Dec]) -> [Q [Dec]] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $
                      (Method -> Q [Dec]) -> [Method] -> [Q [Dec]]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenerationParams -> Method -> Q [Dec]
    generateClientMethod GenerationParams
    params') [Method]
    methods
                      [Q [Dec]] -> [Q [Dec]] -> [Q [Dec]]
    forall a. [a] -> [a] -> [a]
    ++
                      (Property -> Q [Dec]) -> [Property] -> [Q [Dec]]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenerationParams -> Property -> Q [Dec]
    generateClientProperty GenerationParams
    params') [Property]
    properties

    maybeName :: a -> Bool -> Maybe a
    maybeName :: forall a. a -> Bool -> Maybe a
    maybeName a
    name Bool
    condition = if Bool
    condition then a -> Maybe a
    forall a. a -> Maybe a
    Just a
    name else Maybe a
    forall a. Maybe a
    Nothing

    makeToVariantApp :: Name -> Exp
    makeToVariantApp :: Name -> Exp
    makeToVariantApp Name
    name = Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'T.toVariant) (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    name

    makeFromVariantApp :: Name -> Exp
    makeFromVariantApp :: Name -> Exp
    makeFromVariantApp Name
    name = Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'T.fromVariant) (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    name

    makeJustPattern :: Name -> Pat
    makeJustPattern :: Name -> Pat
    makeJustPattern Name
    name = Name -> [Type] -> [Pat] -> Pat
    ConP 'Just [] [Name -> Pat
    VarP Name
    name]

    mapOrHead ::
      (Num a, Eq a) => a -> (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead :: forall a t b.
    (Num a, Eq a) =>
    a -> (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead a
    outputLength t -> b
    fn [t]
    names [b] -> b
    cons =
      case a
    outputLength of
        a
    1 -> t -> b
    fn (t -> b) -> t -> b
    forall a b. (a -> b) -> a -> b
    $ [t] -> t
    forall a. HasCallStack => [a] -> a
    head [t]
    names
        a
    _ -> [b] -> b
    cons ([b] -> b) -> [b] -> b
    forall a b. (a -> b) -> a -> b
    $ (t -> b) -> [t] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map t -> b
    fn [t]
    names

    runGetFirst :: [Maybe a] -> Maybe a
    runGetFirst :: forall a. [Maybe a] -> Maybe a
    runGetFirst [Maybe a]
    options = First a -> Maybe a
    forall a. First a -> Maybe a
    getFirst (First a -> Maybe a) -> First a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $  [First a] -> First a
    forall a. Monoid a => [a] -> a
    mconcat ([First a] -> First a) -> [First a] -> First a
    forall a b. (a -> b) -> a -> b
    $ (Maybe a -> First a) -> [Maybe a] -> [First a]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe a -> First a
    forall a. Maybe a -> First a
    First [Maybe a]
    options

    buildGeneratedSignature :: Bool -> Bool -> Type -> Type
    buildGeneratedSignature :: Bool -> Bool -> Type -> Type
    buildGeneratedSignature Bool
    takeBusArg Bool
    takeObjectPathArg =
      Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''C.Client) (Type -> Type) -> (Type -> Type) -> Type -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Type -> Type -> Type
    addTypeArgIf Bool
    takeBusArg (Name -> Type
    ConT ''T.BusName) (Type -> Type) -> (Type -> Type) -> Type -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Bool -> Type -> Type -> Type
    addTypeArgIf Bool
    takeObjectPathArg (Name -> Type
    ConT ''T.ObjectPath)

    getSetMethodCallParams ::
      Name -> Maybe Name -> Maybe Name -> ExpQ -> ExpQ
    getSetMethodCallParams :: Name -> Maybe Name -> Maybe Name -> ExpQ -> ExpQ
    getSetMethodCallParams Name
    methodCallN Maybe Name
    mBusN Maybe Name
    mObjectPathN ExpQ
    variantsE =
      case (Maybe Name
    mBusN, Maybe Name
    mObjectPathN) of
        (Just Name
    busN, Just Name
    objectPathN) -> [|
                           $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN )
                              { M.methodCallDestination = Just $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    busN )
                              , M.methodCallPath = $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    objectPathN )
                              , M.methodCallBody = $( ExpQ
    variantsE )
                              }
                         |]
        (Just Name
    busN, Maybe Name
    Nothing) -> [|
                            $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN )
                              { M.methodCallDestination = Just $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    busN )
                              , M.methodCallBody = $( ExpQ
    variantsE )
                              }
                          |]
        (Maybe Name
    Nothing, Just Name
    objectPathN) -> [|
                            $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN )
                              { M.methodCallPath = $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    objectPathN )
                              , M.methodCallBody = $( ExpQ
    variantsE )
                              }
                          |]
        (Maybe Name
    Nothing, Maybe Name
    Nothing) -> [|
                             $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN ) { M.methodCallBody = $( ExpQ
    variantsE ) }
                          |]

    clientArgumentUnpackingMessage :: String
    clientArgumentUnpackingMessage :: String
    clientArgumentUnpackingMessage =
      String
    "The client method could not unpack the message that was received."

    clientArgumentUnpackingError :: [T.Variant] -> M.MethodError
    clientArgumentUnpackingError :: [Variant] -> MethodError
    clientArgumentUnpackingError [Variant]
    variants =
      M.MethodError
      { methodErrorName :: ErrorName
    M.methodErrorName = ErrorName
    C.errorFailed
      , methodErrorSerial :: Serial
    M.methodErrorSerial = Word32 -> Serial
    T.Serial Word32
    0
      , methodErrorSender :: Maybe BusName
    M.methodErrorSender = Maybe BusName
    forall a. Maybe a
    Nothing
      , methodErrorDestination :: Maybe BusName
    M.methodErrorDestination = Maybe BusName
    forall a. Maybe a
    Nothing
      , methodErrorBody :: [Variant]
    M.methodErrorBody = String -> Variant
    forall a. IsVariant a => a -> Variant
    T.toVariant String
    clientArgumentUnpackingMessage Variant -> [Variant] -> [Variant]
    forall a. a -> [a] -> [a]
    : [Variant]
    variants
      }

    generateClientMethod :: GenerationParams -> I.Method -> Q [Dec]
    generateClientMethod :: GenerationParams -> Method -> Q [Dec]
    generateClientMethod GenerationParams
                           { getTHType :: GenerationParams -> Type -> Type
    getTHType = Type -> Type
    getArgType
                           , genInterfaceName :: GenerationParams -> InterfaceName
    genInterfaceName = InterfaceName
    methodInterface
                           , genObjectPath :: GenerationParams -> Maybe ObjectPath
    genObjectPath = Maybe ObjectPath
    objectPathM
                           , genBusName :: GenerationParams -> Maybe BusName
    genBusName = Maybe BusName
    busNameM
                           }
                         I.Method
                           { methodArgs :: Method -> [MethodArg]
    I.methodArgs = [MethodArg]
    args
                           , methodName :: Method -> MemberName
    I.methodName = MemberName
    methodNameMN
                           } =
      do
        let ([MethodArg]
    inputArgs, [MethodArg]
    outputArgs) = (MethodArg -> Bool) -> [MethodArg] -> ([MethodArg], [MethodArg])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((Direction -> Direction -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction
    I.In) (Direction -> Bool)
    -> (MethodArg -> Direction) -> MethodArg -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MethodArg -> Direction
    I.methodArgDirection) [MethodArg]
    args
            outputLength :: Int
    outputLength = [MethodArg] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [MethodArg]
    outputArgs
            buildArgNames :: Q [Name]
    buildArgNames = (MethodArg -> Q Name) -> [MethodArg] -> Q [Name]
    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 (String -> Q Name
    newNameDef (String -> Q Name) -> (MethodArg -> String) -> MethodArg -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MethodArg -> String
    I.methodArgName) [MethodArg]
    inputArgs
            buildOutputNames :: Q [Name]
    buildOutputNames = (MethodArg -> Q Name) -> [MethodArg] -> Q [Name]
    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 (String -> Q Name
    newNameDef (String -> Q Name) -> (MethodArg -> String) -> MethodArg -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MethodArg -> String
    I.methodArgName) [MethodArg]
    outputArgs
            takeBusArg :: Bool
    takeBusArg = Maybe BusName -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe BusName
    busNameM
            takeObjectPathArg :: Bool
    takeObjectPathArg = Maybe ObjectPath -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ObjectPath
    objectPathM
            Char
    functionNameFirst:String
    functionNameRest = MemberName -> String
    forall a b. Coercible a b => a -> b
    coerce MemberName
    methodNameMN
            functionName :: String
    functionName = Char -> Char
    Char.toLower Char
    functionNameFirstChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    functionNameRest
            functionN :: Name
    functionN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ Char -> Char
    Char.toLower Char
    functionNameFirstChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    functionNameRest
            methodCallDefN :: Name
    methodCallDefN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    functionName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "MethodCall"
            defObjectPath :: ObjectPath
    defObjectPath = ObjectPath -> Maybe ObjectPath -> ObjectPath
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ObjectPath
    forall a. IsString a => String -> a
    fromString String
    "/") Maybe ObjectPath
    objectPathM
        clientN <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "client"
        busN <- newName "busName"
        objectPathN <- newName "objectPath"
        methodCallN <- newName "methodCall"
        callResultN <- newName "callResult"
        replySuccessN <- newName "replySuccess"
        methodArgNames <- buildArgNames
        fromVariantOutputNames <- buildOutputNames
        finalOutputNames <- buildOutputNames
        let variantListExp = (Name -> Exp) -> [Name] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Exp
    makeToVariantApp [Name]
    methodArgNames
            mapOrHead' = Int -> (t -> b) -> [t] -> ([b] -> b) -> b
    forall a t b.
    (Num a, Eq a) =>
    a -> (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead Int
    outputLength
            fromVariantExp = (Name -> Exp) -> [Name] -> ([Exp] -> Exp) -> Exp
    forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead' Name -> Exp
    makeFromVariantApp [Name]
    fromVariantOutputNames [Exp] -> Exp
    mkTupE
            finalResultTuple = (Name -> Exp) -> [Name] -> ([Exp] -> Exp) -> Exp
    forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead' Name -> Exp
    VarE [Name]
    finalOutputNames [Exp] -> Exp
    mkTupE
            maybeExtractionPattern = (Name -> Pat) -> [Name] -> ([Pat] -> Pat) -> Pat
    forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead' Name -> Pat
    makeJustPattern [Name]
    finalOutputNames [Pat] -> Pat
    TupP
            getMethodCallDefDec = [d|
                   $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    methodCallDefN ) =
                     M.MethodCall { M.methodCallPath = defObjectPath
                                  , M.methodCallInterface = Just methodInterface
                                  , M.methodCallMember = methodNameMN
                                  , M.methodCallDestination = busNameM
                                  , M.methodCallSender = Nothing
                                  , M.methodCallReplyExpected = True
                                  , M.methodCallAutoStart = True
                                  , M.methodCallBody = []
                                  }
                     |]
            setMethodCallParamsE = Name -> Maybe Name -> Maybe Name -> ExpQ -> ExpQ
    getSetMethodCallParams Name
    methodCallDefN
                                   (Name -> Bool -> Maybe Name
    forall a. a -> Bool -> Maybe a
    maybeName Name
    busN Bool
    takeBusArg)
                                   (Name -> Bool -> Maybe Name
    forall a. a -> Bool -> Maybe a
    maybeName Name
    objectPathN Bool
    takeObjectPathArg)
                                   (Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> ExpQ) -> Exp -> ExpQ
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    ListE [Exp]
    variantListExp)
            handleReplySuccess =
              if Int
    outputLength Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
              then
                [| Right () |]
              else
                [|
                   case M.methodReturnBody $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    replySuccessN ) of
                         $( Pat -> Q Pat
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat -> Q Pat) -> Pat -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Pat
    ListP ([Pat] -> Pat) -> [Pat] -> Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    fromVariantOutputNames ) ->
                           case $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    fromVariantExp ) of
                             $( Pat -> Q Pat
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Pat
    maybeExtractionPattern ) -> Right $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    finalResultTuple )
                             _ -> Left $ clientArgumentUnpackingError $
                                  M.methodReturnBody $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    replySuccessN )
                         _ -> Left $ clientArgumentUnpackingError $
                              M.methodReturnBody $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    replySuccessN )
                 |]
            getFunctionBody = [|
                 do
                   let $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    methodCallN ) = $( ExpQ
    setMethodCallParamsE )
                   $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    callResultN ) <- call $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> ExpQ) -> Exp -> ExpQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    clientN ) $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN )
                   return $ case $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    callResultN ) of
                     Right $( Pat -> Q Pat
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Pat
    rightPattern  ) -> $( ExpQ
    handleReplySuccess )
                     Left e -> Left e
                   |]
                        where rightPattern :: Pat
    rightPattern = if Int
    outputLength Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                                             then Pat
    WildP
                                             else Name -> Pat
    VarP Name
    replySuccessN
        functionBody <- getFunctionBody
        methodCallDef <- getMethodCallDefDec
        let methodSignature = (MethodArg -> Type -> Type) -> Type -> [MethodArg] -> Type
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr MethodArg -> Type -> Type
    addInArg Type
    fullOutputSignature [MethodArg]
    inputArgs
            addInArg MethodArg
    arg = Type -> Type -> Type
    addTypeArg (Type -> Type -> Type) -> Type -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type
    getArgType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ MethodArg -> Type
    I.methodArgType MethodArg
    arg
            fullOutputSignature = Type -> Type -> Type
    AppT (Name -> Type
    ConT ''IO) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                                  Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT (Name -> Type
    ConT ''Either)
                                             (Name -> Type
    ConT ''M.MethodError))
                                  Type
    outputSignature
            outputSignature =
              case Int
    outputLength of
                Int
    1 -> Type -> Type
    getArgType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ MethodArg -> Type
    I.methodArgType (MethodArg -> Type) -> MethodArg -> Type
    forall a b. (a -> b) -> a -> b
    $ [MethodArg] -> MethodArg
    forall a. HasCallStack => [a] -> a
    head [MethodArg]
    outputArgs
                Int
    _ -> (Type -> MethodArg -> Type) -> Type -> [MethodArg] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> MethodArg -> Type
    addOutArg (Int -> Type
    TupleT Int
    outputLength) [MethodArg]
    outputArgs
            addOutArg Type
    target MethodArg
    arg = Type -> Type -> Type
    AppT Type
    target (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type
    getArgType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ MethodArg -> Type
    I.methodArgType MethodArg
    arg
            fullSignature = Bool -> Bool -> Type -> Type
    buildGeneratedSignature Bool
    takeBusArg Bool
    takeObjectPathArg Type
    methodSignature
            fullArgNames =
              Name
    clientNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeBusArg Name
    busN
                       (Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeObjectPathArg Name
    objectPathN [Name]
    methodArgNames)
            definitionDec = Name -> Type -> Dec
    SigD Name
    functionN Type
    fullSignature
            function = Name -> [Name] -> Exp -> Dec
    mkFunD Name
    functionN [Name]
    fullArgNames Exp
    functionBody
            methodCallSignature = Name -> Type -> Dec
    SigD Name
    methodCallDefN (Type -> Dec) -> Type -> Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> Type
    ConT ''M.MethodCall
        return $ methodCallSignature:methodCallDef ++ [definitionDec, function]

    generateClientProperty :: GenerationParams -> I.Property -> Q [Dec]
    generateClientProperty :: GenerationParams -> Property -> Q [Dec]
    generateClientProperty GenerationParams
                             { getTHType :: GenerationParams -> Type -> Type
    getTHType = Type -> Type
    getArgType
                             , genInterfaceName :: GenerationParams -> InterfaceName
    genInterfaceName = InterfaceName
    propertyInterface
                             , genObjectPath :: GenerationParams -> Maybe ObjectPath
    genObjectPath = Maybe ObjectPath
    objectPathM
                             , genBusName :: GenerationParams -> Maybe BusName
    genBusName = Maybe BusName
    busNameM
                             }
                           I.Property
                             { propertyName :: Property -> String
    I.propertyName = String
    name
                             , propertyType :: Property -> Type
    I.propertyType = Type
    propType
                             , propertyRead :: Property -> Bool
    I.propertyRead = Bool
    readable
                             , propertyWrite :: Property -> Bool
    I.propertyWrite = Bool
    writable
                             } =
      do
        clientN <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "client"
        busN <- newName "busName"
        objectPathN <- newName "objectPath"
        methodCallN <- newName "methodCall"
        argN <- newName "arg"
        let takeBusArg = Maybe BusName -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe BusName
    busNameM
            takeObjectPathArg = Maybe ObjectPath -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ObjectPath
    objectPathM
            defObjectPath = ObjectPath -> Maybe ObjectPath -> ObjectPath
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ObjectPath
    forall a. IsString a => String -> a
    fromString String
    "/") Maybe ObjectPath
    objectPathM
            methodCallDefN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "methodCallFor" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name
            getMethodCallDefDec = [d|
                   $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    methodCallDefN ) =
                     M.MethodCall { M.methodCallPath = defObjectPath
                                  , M.methodCallInterface = Just propertyInterface
                                  , M.methodCallMember = fromString name
                                  , M.methodCallDestination = busNameM
                                  , M.methodCallSender = Nothing
                                  , M.methodCallReplyExpected = True
                                  , M.methodCallAutoStart = True
                                  , M.methodCallBody = []
                                  }
                     |]
            setMethodCallParamsE = Name -> Maybe Name -> Maybe Name -> ExpQ -> ExpQ
    getSetMethodCallParams Name
    methodCallDefN
                                       (Name -> Bool -> Maybe Name
    forall a. a -> Bool -> Maybe a
    maybeName Name
    busN Bool
    takeBusArg)
                                       (Name -> Bool -> Maybe Name
    forall a. a -> Bool -> Maybe a
    maybeName Name
    objectPathN Bool
    takeObjectPathArg)
                                       (Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> ExpQ) -> Exp -> ExpQ
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    ListE [])
            makeGetterBody = [|
              do
                let $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    methodCallN ) = $( ExpQ
    setMethodCallParamsE )
                getPropertyValue $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> ExpQ) -> Exp -> ExpQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    clientN )
                                 $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN )
              |]
            makeSetterBody = [|
              do
                let $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    methodCallN ) = $( ExpQ
    setMethodCallParamsE )
                setPropertyValue $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    clientN ) $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    methodCallN ) $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    argN )
              |]
        methodCallDefs <- getMethodCallDefDec
        getterBody <- makeGetterBody
        setterBody <- makeSetterBody
        let buildSignature = Bool -> Bool -> Type -> Type
    buildGeneratedSignature Bool
    takeBusArg Bool
    takeObjectPathArg
            getterSigType =
              Type -> Type
    buildSignature (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Type
    AppT (Name -> Type
    ConT ''IO) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                             Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT (Name -> Type
    ConT ''Either)
                                          (Name -> Type
    ConT ''M.MethodError)) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type
    getArgType Type
    propType
            setterSigType = Type -> Type
    buildSignature (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Type
    addTypeArg (Type -> Type
    getArgType Type
    propType) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                            Type -> Type -> Type
    AppT (Name -> Type
    ConT ''IO) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Type
    AppT (Name -> Type
    ConT ''Maybe) (Name -> Type
    ConT ''M.MethodError)
            buildArgs [Name]
    rest = Name
    clientNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeBusArg Name
    busN
                             (Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeObjectPathArg Name
    objectPathN [Name]
    rest)
            getterArgNames = [Name] -> [Name]
    buildArgs []
            setterArgNames = [Name] -> [Name]
    buildArgs [Name
    argN]
            propertyString = String -> String
    forall a b. Coercible a b => a -> b
    coerce String
    name
            getterName = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "get" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    propertyString
            setterName = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "set" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    propertyString
            getterFunction = Name -> [Name] -> Exp -> Dec
    mkFunD Name
    getterName [Name]
    getterArgNames Exp
    getterBody
            setterFunction = Name -> [Name] -> Exp -> Dec
    mkFunD Name
    setterName [Name]
    setterArgNames Exp
    setterBody
            getterSignature = Name -> Type -> Dec
    SigD Name
    getterName Type
    getterSigType
            setterSignature = Name -> Type -> Dec
    SigD Name
    setterName Type
    setterSigType
            getterDefs = if Bool
    readable then [Dec
    getterSignature, Dec
    getterFunction] else []
            setterDefs = if Bool
    writable then [Dec
    setterSignature, Dec
    setterFunction] else []
            methodCallSignature = Name -> Type -> Dec
    SigD Name
    methodCallDefN (Type -> Dec) -> Type -> Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> Type
    ConT ''M.MethodCall
        return $ methodCallSignature:methodCallDefs ++ getterDefs ++ setterDefs

    generateSignalsFromInterface :: GenerationParams -> I.Interface -> Q [Dec]
    generateSignalsFromInterface :: GenerationParams -> Interface -> Q [Dec]
    generateSignalsFromInterface GenerationParams
    params
                                 I.Interface{ interfaceName :: Interface -> InterfaceName
    I.interfaceName = InterfaceName
    name
                                            , interfaceSignals :: Interface -> [Signal]
    I.interfaceSignals = [Signal]
    signals
                                            } = GenerationParams -> InterfaceName -> [Signal] -> Q [Dec]
    generateSignals GenerationParams
    params InterfaceName
    name [Signal]
    signals

    generateSignals :: GenerationParams -> T.InterfaceName -> [I.Signal] -> Q [Dec]
    generateSignals :: GenerationParams -> InterfaceName -> [Signal] -> Q [Dec]
    generateSignals GenerationParams
    params InterfaceName
    name [Signal]
    signals =
      ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Dec]] -> [Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Q [[Dec]] -> Q [Dec])
    -> ([Q [Dec]] -> Q [[Dec]]) -> [Q [Dec]] -> Q [Dec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q [Dec]] -> Q [[Dec]]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
    sequenceA ([Q [Dec]] -> Q [Dec]) -> [Q [Dec]] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $
                    (Signal -> Q [Dec]) -> [Signal] -> [Q [Dec]]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenerationParams -> Signal -> Q [Dec]
    generateSignal GenerationParams
    params { genInterfaceName = coerce name })
                        [Signal]
    signals

    generateSignal :: GenerationParams -> I.Signal -> Q [Dec]
    generateSignal :: GenerationParams -> Signal -> Q [Dec]
    generateSignal GenerationParams
                     { getTHType :: GenerationParams -> Type -> Type
    getTHType = Type -> Type
    getArgType
                     , genInterfaceName :: GenerationParams -> InterfaceName
    genInterfaceName = InterfaceName
    signalInterface
                     , genObjectPath :: GenerationParams -> Maybe ObjectPath
    genObjectPath = Maybe ObjectPath
    objectPathM
                     , genBusName :: GenerationParams -> Maybe BusName
    genBusName = Maybe BusName
    busNameM
                     , genTakeSignalErrorHandler :: GenerationParams -> Bool
    genTakeSignalErrorHandler = Bool
    takeErrorHandler
                     }
                   I.Signal
                     { signalName :: Signal -> MemberName
    I.signalName = MemberName
    name
                     , signalArgs :: Signal -> [SignalArg]
    I.signalArgs = [SignalArg]
    args
                     } =
      do
        let buildArgNames :: Q [Name]
    buildArgNames = (SignalArg -> Q Name) -> [SignalArg] -> Q [Name]
    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 (String -> Q Name
    newNameDef (String -> Q Name) -> (SignalArg -> String) -> SignalArg -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SignalArg -> String
    I.signalArgName) [SignalArg]
    args

        argNames <- Q [Name]
    buildArgNames
        fromVariantOutputNames <- buildArgNames
        toHandlerOutputNames <- buildArgNames
        objectPathN <- newName "objectPath"
        variantsN <- newName "variants"
        signalN <- newName "signal"
        receivedSignalN <- newName "signal"
        clientN <- newName "client"
        handlerArgN <- newName "handlerArg"
        errorHandlerN <- newName "errorHandler"
        matchRuleN <- newName "matchRule"
        matchRuleArgN <- newName "matchRuleArg"

        let variantListExp = (Name -> Exp) -> [Name] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Exp
    makeToVariantApp [Name]
    argNames
            signalString = MemberName -> String
    forall a b. Coercible a b => a -> b
    coerce MemberName
    name
            signalDefN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "signalFor" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    signalString
            takeObjectPathArg = Maybe ObjectPath -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ObjectPath
    objectPathM
            defObjectPath = ObjectPath -> Maybe ObjectPath -> ObjectPath
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ObjectPath
    forall a. IsString a => String -> a
    fromString String
    "/") Maybe ObjectPath
    objectPathM
            argCount = [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    argNames
            getSignalDefDec = [d|
              $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    signalDefN ) =
                M.Signal { M.signalPath = defObjectPath
                         , M.signalInterface = signalInterface
                         , M.signalMember = name
                         , M.signalDestination = Nothing
                         , M.signalSender = Nothing
                         , M.signalBody = []
                         }
                     |]
        let mapOrHead' = Int -> (t -> b) -> [t] -> ([b] -> b) -> b
    forall a t b.
    (Num a, Eq a) =>
    a -> (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead Int
    argCount
            fromVariantExp = (Name -> Exp) -> [Name] -> ([Exp] -> Exp) -> Exp
    forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead' Name -> Exp
    makeFromVariantApp [Name]
    fromVariantOutputNames [Exp] -> Exp
    mkTupE
            maybeExtractionPattern = (Name -> Pat) -> [Name] -> ([Pat] -> Pat) -> Pat
    forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
    mapOrHead' Name -> Pat
    makeJustPattern [Name]
    toHandlerOutputNames [Pat] -> Pat
    TupP
            applyToName Exp
    toApply Name
    n = Exp -> Exp -> Exp
    AppE Exp
    toApply (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    n
            finalApplication = (Exp -> Name -> Exp) -> Exp -> [Name] -> Exp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Exp -> Name -> Exp
    applyToName (Name -> Exp
    VarE Name
    handlerArgN)
                               (Name
    receivedSignalNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :[Name]
    toHandlerOutputNames)
            makeHandlerN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "makeHandlerFor" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    signalString
            makeHandlerCall =
              if Bool
    takeErrorHandler
              then Exp -> Exp -> Exp
    AppE Exp
    base (Name -> Exp
    VarE Name
    errorHandlerN)
              else Exp
    base
                where base :: Exp
    base = Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE Name
    makeHandlerN) (Name -> Exp
    VarE Name
    handlerArgN)
            getSetSignal  =
              if Bool
    takeObjectPathArg
              then [|
                      $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    signalDefN )
                         { M.signalPath = $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    objectPathN )
                         , M.signalBody = $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    variantsN )
                         }
                     |]
              else [| $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    signalDefN )
                      { M.signalBody = $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    variantsN ) }
                    |]
            getEmitBody = [|
              let $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    variantsN ) = $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> ExpQ) -> Exp -> ExpQ
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    ListE [Exp]
    variantListExp )
                  $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    signalN ) = $( ExpQ
    getSetSignal )
              in
                emit $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    clientN ) $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    signalN )
              |]
            getErrorHandler =
              if Bool
    takeErrorHandler then
                [| $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    errorHandlerN  ) $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    receivedSignalN )|]
              else [| return () |]
            getMakeHandlerBody =
              if Int
    argCount Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
              then
                [| $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    finalApplication ) |]
              else
                [|
                   case M.signalBody $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    receivedSignalN ) of
                     $( Pat -> Q Pat
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat -> Q Pat) -> Pat -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Pat
    ListP ([Pat] -> Pat) -> [Pat] -> Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    fromVariantOutputNames ) ->
                       case $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    fromVariantExp ) of
                         $( Pat -> Q Pat
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Pat
    maybeExtractionPattern ) -> $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    finalApplication )
                         _ -> $( ExpQ
    getErrorHandler )
                     _ -> $( ExpQ
    getErrorHandler )
                       |]
            getRegisterBody = [|
              let $( Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    matchRuleN ) = $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    matchRuleArgN )
                                           { C.matchInterface = Just signalInterface
                                           , C.matchMember = Just name
                                           , C.matchSender =
                                             runGetFirst
                                             [ C.matchSender $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    matchRuleArgN )
                                             , busNameM
                                             ]
                                           , C.matchPath =
                                             runGetFirst
                                             [ C.matchPath $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    matchRuleArgN )
                                             , objectPathM
                                             ]
                                           }
              in
                C.addMatch $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    clientN ) $( Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    matchRuleN ) $ $( Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    makeHandlerCall )
                |]
        registerBody <- getRegisterBody
        makeHandlerBody <- getMakeHandlerBody
        signalDef <- getSignalDefDec
        emitBody <- getEmitBody
        let methodSignature = (SignalArg -> Type -> Type) -> Type -> [SignalArg] -> Type
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr SignalArg -> Type -> Type
    addInArg Type
    unitIOType [SignalArg]
    args
            addInArg SignalArg
    arg = Type -> Type -> Type
    addTypeArg (Type -> Type -> Type) -> Type -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type
    getArgType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ SignalArg -> Type
    I.signalArgType SignalArg
    arg
            fullArgNames = Name
    clientNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeObjectPathArg Name
    objectPathN [Name]
    argNames
            -- Never take bus arg because it is set automatically anyway
            fullSignature =
                Bool -> Bool -> Type -> Type
    buildGeneratedSignature Bool
    False Bool
    takeObjectPathArg Type
    methodSignature
            functionN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "emit" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    signalString
            emitSignature = Name -> Type -> Dec
    SigD Name
    functionN Type
    fullSignature
            emitFunction = Name -> [Name] -> Exp -> Dec
    mkFunD Name
    functionN [Name]
    fullArgNames Exp
    emitBody
            handlerType = Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''M.Signal) Type
    methodSignature
            errorHandlerType = Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''M.Signal) Type
    unitIOType
            registerN = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    "registerFor" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    signalString
            registerArgs = Name
    clientNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Name
    matchRuleArgNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Name
    handlerArgNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :
                           Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeErrorHandler Name
    errorHandlerN []
            registerFunction = Name -> [Name] -> Exp -> Dec
    mkFunD Name
    registerN [Name]
    registerArgs Exp
    registerBody
            registerType =
              Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''C.Client) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
              Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''C.MatchRule) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
              Type -> Type -> Type
    addTypeArg Type
    handlerType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
              Bool -> Type -> Type -> Type
    addTypeArgIf Bool
    takeErrorHandler (Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''M.Signal) Type
    unitIOType) (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
              Type -> Type -> Type
    AppT (Name -> Type
    ConT ''IO) (Name -> Type
    ConT ''C.SignalHandler)
            registerSignature = Name -> Type -> Dec
    SigD Name
    registerN Type
    registerType
            makeHandlerArgs =
              Name
    handlerArgNName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Bool -> Name -> [Name] -> [Name]
    forall a. Bool -> a -> [a] -> [a]
    addArgIf Bool
    takeErrorHandler Name
    errorHandlerN [Name
    receivedSignalN]
            makeHandlerFunction = Name -> [Name] -> Exp -> Dec
    mkFunD Name
    makeHandlerN [Name]
    makeHandlerArgs Exp
    makeHandlerBody
            makeHandlerType = Type -> Type -> Type
    addTypeArg Type
    handlerType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                              Bool -> Type -> Type -> Type
    addTypeArgIf Bool
    takeErrorHandler Type
    errorHandlerType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                              Type -> Type -> Type
    addTypeArg (Name -> Type
    ConT ''M.Signal) Type
    unitIOType
            makeHandlerSignature = Name -> Type -> Dec
    SigD Name
    makeHandlerN Type
    makeHandlerType
            signalSignature = Name -> Type -> Dec
    SigD Name
    signalDefN (Name -> Type
    ConT ''M.Signal)
        return $ signalSignature:
               signalDef ++ [ emitSignature, emitFunction
                            , makeHandlerSignature, makeHandlerFunction
                            , registerSignature, registerFunction
                            ]

    generateFromFilePath :: GenerationParams -> FilePath -> Q [Dec]
    generateFromFilePath :: GenerationParams -> String -> Q [Dec]
    generateFromFilePath GenerationParams
    generationParams String
    filepath = do
        xml <- IO Text -> Q Text
    forall a. IO a -> Q a
    runIO (IO Text -> Q Text) -> IO Text -> Q Text
    forall a b. (a -> b) -> a -> b
    $ String -> IO Text
    Text.readFile String
    filepath
        let obj = [Object] -> Object
    forall a. HasCallStack => [a] -> a
    head ([Object] -> Object) -> [Object] -> Object
    forall a b. (a -> b) -> a -> b
    $ Maybe Object -> [Object]
    forall a. Maybe a -> [a]
    maybeToList (Maybe Object -> [Object]) -> Maybe Object -> [Object]
    forall a b. (a -> b) -> a -> b
    $ ObjectPath -> Text -> Maybe Object
    I.parseXML ObjectPath
    "/" Text
    xml
            interface = [Interface] -> Interface
    forall a. HasCallStack => [a] -> a
    head ([Interface] -> Interface) -> [Interface] -> Interface
    forall a b. (a -> b) -> a -> b
    $ Object -> [Interface]
    I.objectInterfaces Object
    obj
            signals = GenerationParams -> Interface -> Q [Dec]
    generateSignalsFromInterface GenerationParams
    generationParams Interface
    interface
            client = GenerationParams -> Interface -> Q [Dec]
    generateClient GenerationParams
    generationParams Interface
    interface
         in fmap (++) signals <*> client