{-# 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.Functor ((<$>))
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)
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
  IO b
returnValue <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
arg) ClientBusPathR (a -> IO b)
soFar
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO b
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 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 -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
TupleT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) forall a b. (a -> b) -> a -> b
$ 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
"" -> forall (m :: * -> *). Quote m => String -> m Name
newName String
"arg"
    String
"data" -> forall (m :: * -> *). Quote m => String -> m Name
newName String
"arg"
    String
_ -> forall (m :: * -> *). Quote m => String -> m Name
newName String
n

defaultGenerationParams :: GenerationParams
defaultGenerationParams :: GenerationParams
defaultGenerationParams =
  GenerationParams
  { genBusName :: Maybe BusName
genBusName = forall a. Maybe a
Nothing
  , genInterfaceName :: InterfaceName
genInterfaceName = forall a. IsString a => String -> a
fromString String
""
  , getTHType :: Type -> Type
getTHType = Type -> Type
defaultGetTHType
  , genObjectPath :: Maybe ObjectPath
genObjectPath = 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 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
nameforall a. a -> [a] -> [a]
:) else 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 (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 :: InterfaceName
genInterfaceName = coerce :: forall a b. Coercible a b => a -> b
coerce InterfaceName
name } in
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
                  forall a b. (a -> b) -> [a] -> [b]
map (GenerationParams -> Method -> Q [Dec]
generateClientMethod GenerationParams
params') [Method]
methods
                  forall a. [a] -> [a] -> [a]
++
                  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 forall a. a -> Maybe a
Just a
name else forall a. Maybe a
Nothing

makeToVariantApp :: Name -> Exp
makeToVariantApp :: Name -> Exp
makeToVariantApp Name
name = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'T.toVariant) 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) 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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [t]
names
    a
_ -> [b] -> b
cons forall a b. (a -> b) -> a -> 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 = forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Type -> Type -> Type
addTypeArgIf Bool
takeBusArg (Name -> Type
ConT ''T.BusName) 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) -> [|
                       $( varE methodCallN )
                          { M.methodCallDestination = Just $( varE busN )
                          , M.methodCallPath = $( varE objectPathN )
                          , M.methodCallBody = $( variantsE )
                          }
                     |]
    (Just Name
busN, Maybe Name
Nothing) -> [|
                        $( varE methodCallN )
                          { M.methodCallDestination = Just $( varE busN )
                          , M.methodCallBody = $( variantsE )
                          }
                      |]
    (Maybe Name
Nothing, Just Name
objectPathN) -> [|
                        $( varE methodCallN )
                          { M.methodCallPath = $( varE objectPathN )
                          , M.methodCallBody = $( variantsE )
                          }
                      |]
    (Maybe Name
Nothing, Maybe Name
Nothing) -> [|
                         $( varE methodCallN ) { M.methodCallBody = $( 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 = forall a. Maybe a
Nothing
  , methodErrorDestination :: Maybe BusName
M.methodErrorDestination = forall a. Maybe a
Nothing
  , methodErrorBody :: [Variant]
M.methodErrorBody = forall a. IsVariant a => a -> Variant
T.toVariant String
clientArgumentUnpackingMessage 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== Direction
I.In) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodArg -> Direction
I.methodArgDirection) [MethodArg]
args
        outputLength :: Int
outputLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [MethodArg]
outputArgs
        buildArgNames :: Q [Name]
buildArgNames = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Q Name
newNameDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodArg -> String
I.methodArgName) [MethodArg]
inputArgs
        buildOutputNames :: Q [Name]
buildOutputNames = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Q Name
newNameDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodArg -> String
I.methodArgName) [MethodArg]
outputArgs
        takeBusArg :: Bool
takeBusArg = forall a. Maybe a -> Bool
isNothing Maybe BusName
busNameM
        takeObjectPathArg :: Bool
takeObjectPathArg = forall a. Maybe a -> Bool
isNothing Maybe ObjectPath
objectPathM
        Char
functionNameFirst:String
functionNameRest = coerce :: forall a b. Coercible a b => a -> b
coerce MemberName
methodNameMN
        functionName :: String
functionName = Char -> Char
Char.toLower Char
functionNameFirstforall a. a -> [a] -> [a]
:String
functionNameRest
        functionN :: Name
functionN = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Char -> Char
Char.toLower Char
functionNameFirstforall a. a -> [a] -> [a]
:String
functionNameRest
        methodCallDefN :: Name
methodCallDefN = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
functionName forall a. [a] -> [a] -> [a]
++ String
"MethodCall"
        defObjectPath :: ObjectPath
defObjectPath = forall a. a -> Maybe a -> a
fromMaybe (forall a. IsString a => String -> a
fromString String
"/") Maybe ObjectPath
objectPathM
    Name
clientN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"client"
    Name
busN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"busName"
    Name
objectPathN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"objectPath"
    Name
methodCallN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"methodCall"
    Name
callResultN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"callResult"
    Name
replySuccessN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"replySuccess"
    [Name]
methodArgNames <- Q [Name]
buildArgNames
    [Name]
fromVariantOutputNames <- Q [Name]
buildOutputNames
    [Name]
finalOutputNames <- Q [Name]
buildOutputNames
    let variantListExp :: [Exp]
variantListExp = forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
makeToVariantApp [Name]
methodArgNames
        mapOrHead' :: (t -> b) -> [t] -> ([b] -> b) -> b
mapOrHead' = forall a t b.
(Num a, Eq a) =>
a -> (t -> b) -> [t] -> ([b] -> b) -> b
mapOrHead Int
outputLength
        fromVariantExp :: Exp
fromVariantExp = forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
mapOrHead' Name -> Exp
makeFromVariantApp [Name]
fromVariantOutputNames [Exp] -> Exp
mkTupE
        finalResultTuple :: Exp
finalResultTuple = forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
mapOrHead' Name -> Exp
VarE [Name]
finalOutputNames [Exp] -> Exp
mkTupE
        maybeExtractionPattern :: Pat
maybeExtractionPattern = forall {t} {b}. (t -> b) -> [t] -> ([b] -> b) -> b
mapOrHead' Name -> Pat
makeJustPattern [Name]
finalOutputNames [Pat] -> Pat
TupP
        getMethodCallDefDec :: Q [Dec]
getMethodCallDefDec = [d|
               $( varP 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 :: ExpQ
setMethodCallParamsE = Name -> Maybe Name -> Maybe Name -> ExpQ -> ExpQ
getSetMethodCallParams Name
methodCallDefN
                               (forall a. a -> Bool -> Maybe a
maybeName Name
busN Bool
takeBusArg)
                               (forall a. a -> Bool -> Maybe a
maybeName Name
objectPathN Bool
takeObjectPathArg)
                               (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE [Exp]
variantListExp)
        handleReplySuccess :: ExpQ
handleReplySuccess =
          if Int
outputLength forall a. Eq a => a -> a -> Bool
== Int
0
          then
            [| Right () |]
          else
            [|
               case M.methodReturnBody $( varE replySuccessN ) of
                     $( return $ ListP $ map VarP fromVariantOutputNames ) ->
                       case $( return fromVariantExp ) of
                         $( return maybeExtractionPattern ) -> Right $( return finalResultTuple )
                         _ -> Left $ clientArgumentUnpackingError $
                              M.methodReturnBody $( varE replySuccessN )
                     _ -> Left $ clientArgumentUnpackingError $
                          M.methodReturnBody $( varE replySuccessN )
             |]
        getFunctionBody :: ExpQ
getFunctionBody = [|
             do
               let $( varP methodCallN ) = $( setMethodCallParamsE )
               $( varP callResultN ) <- call $( return $ VarE clientN ) $( varE methodCallN )
               return $ case $( varE callResultN ) of
                 Right $( return rightPattern  ) -> $( handleReplySuccess )
                 Left e -> Left e
               |]
                    where rightPattern :: Pat
rightPattern = if Int
outputLength forall a. Eq a => a -> a -> Bool
== Int
0
                                         then Pat
WildP
                                         else Name -> Pat
VarP Name
replySuccessN
    Exp
functionBody <- ExpQ
getFunctionBody
    [Dec]
methodCallDef <- Q [Dec]
getMethodCallDefDec
    let methodSignature :: Type
methodSignature = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MethodArg -> Type -> Type
addInArg Type
fullOutputSignature [MethodArg]
inputArgs
        addInArg :: MethodArg -> Type -> Type
addInArg MethodArg
arg = Type -> Type -> Type
addTypeArg forall a b. (a -> b) -> a -> b
$ Type -> Type
getArgType forall a b. (a -> b) -> a -> b
$ MethodArg -> Type
I.methodArgType MethodArg
arg
        fullOutputSignature :: Type
fullOutputSignature = Type -> Type -> Type
AppT (Name -> Type
ConT ''IO) 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 :: Type
outputSignature =
          case Int
outputLength of
            Int
1 -> Type -> Type
getArgType forall a b. (a -> b) -> a -> b
$ MethodArg -> Type
I.methodArgType forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [MethodArg]
outputArgs
            Int
_ -> 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 -> MethodArg -> Type
addOutArg Type
target MethodArg
arg = Type -> Type -> Type
AppT Type
target forall a b. (a -> b) -> a -> b
$ Type -> Type
getArgType forall a b. (a -> b) -> a -> b
$ MethodArg -> Type
I.methodArgType MethodArg
arg
        fullSignature :: Type
fullSignature = Bool -> Bool -> Type -> Type
buildGeneratedSignature Bool
takeBusArg Bool
takeObjectPathArg Type
methodSignature
        fullArgNames :: [Name]
fullArgNames =
          Name
clientNforall a. a -> [a] -> [a]
:forall a. Bool -> a -> [a] -> [a]
addArgIf Bool
takeBusArg Name
busN
                   (forall a. Bool -> a -> [a] -> [a]
addArgIf Bool
takeObjectPathArg Name
objectPathN [Name]
methodArgNames)
        definitionDec :: Dec
definitionDec = Name -> Type -> Dec
SigD Name
functionN Type
fullSignature
        function :: Dec
function = Name -> [Name] -> Exp -> Dec
mkFunD Name
functionN [Name]
fullArgNames Exp
functionBody
        methodCallSignature :: Dec
methodCallSignature = Name -> Type -> Dec
SigD Name
methodCallDefN forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT ''M.MethodCall
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Dec
methodCallSignatureforall a. a -> [a] -> [a]
:[Dec]
methodCallDef forall a. [a] -> [a] -> [a]
++ [Dec
definitionDec, Dec
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
    Name
clientN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"client"
    Name
busN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"busName"
    Name
objectPathN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"objectPath"
    Name
methodCallN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"methodCall"
    Name
argN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"arg"
    let takeBusArg :: Bool
takeBusArg = forall a. Maybe a -> Bool
isNothing Maybe BusName
busNameM
        takeObjectPathArg :: Bool
takeObjectPathArg = forall a. Maybe a -> Bool
isNothing Maybe ObjectPath
objectPathM
        defObjectPath :: ObjectPath
defObjectPath = forall a. a -> Maybe a -> a
fromMaybe (forall a. IsString a => String -> a
fromString String
"/") Maybe ObjectPath
objectPathM
        methodCallDefN :: Name
methodCallDefN = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"methodCallFor" forall a. [a] -> [a] -> [a]
++ String
name
        getMethodCallDefDec :: Q [Dec]
getMethodCallDefDec = [d|
               $( varP 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 :: ExpQ
setMethodCallParamsE = Name -> Maybe Name -> Maybe Name -> ExpQ -> ExpQ
getSetMethodCallParams Name
methodCallDefN
                                   (forall a. a -> Bool -> Maybe a
maybeName Name
busN Bool
takeBusArg)
                                   (forall a. a -> Bool -> Maybe a
maybeName Name
objectPathN Bool
takeObjectPathArg)
                                   (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE [])
        makeGetterBody :: ExpQ
makeGetterBody = [|
          do
            let $( varP methodCallN ) = $( setMethodCallParamsE )
            getPropertyValue $( return $ VarE clientN )
                             $( varE methodCallN )
          |]
        makeSetterBody :: ExpQ
makeSetterBody = [|
          do
            let $( varP methodCallN ) = $( setMethodCallParamsE )
            setPropertyValue $( varE clientN ) $( varE methodCallN ) $( varE argN )
          |]
    [Dec]
methodCallDefs <- Q [Dec]
getMethodCallDefDec
    Exp
getterBody <- ExpQ
makeGetterBody
    Exp
setterBody <- ExpQ
makeSetterBody
    let buildSignature :: Type -> Type
buildSignature = Bool -> Bool -> Type -> Type
buildGeneratedSignature Bool
takeBusArg Bool
takeObjectPathArg
        getterSigType :: Type
getterSigType =
          Type -> Type
buildSignature forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
AppT (Name -> Type
ConT ''IO) forall a b. (a -> b) -> a -> b
$
                         Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
ConT ''Either)
                                      (Name -> Type
ConT ''M.MethodError)) forall a b. (a -> b) -> a -> b
$ Type -> Type
getArgType Type
propType
        setterSigType :: Type
setterSigType = Type -> Type
buildSignature forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
addTypeArg (Type -> Type
getArgType Type
propType) forall a b. (a -> b) -> a -> b
$
                        Type -> Type -> Type
AppT (Name -> Type
ConT ''IO) forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
AppT (Name -> Type
ConT ''Maybe) (Name -> Type
ConT ''M.MethodError)
        buildArgs :: [Name] -> [Name]
buildArgs [Name]
rest = Name
clientNforall a. a -> [a] -> [a]
:forall a. Bool -> a -> [a] -> [a]
addArgIf Bool
takeBusArg Name
busN
                         (forall a. Bool -> a -> [a] -> [a]
addArgIf Bool
takeObjectPathArg Name
objectPathN [Name]
rest)
        getterArgNames :: [Name]
getterArgNames = [Name] -> [Name]
buildArgs []
        setterArgNames :: [Name]
setterArgNames = [Name] -> [Name]
buildArgs [Name
argN]
        propertyString :: String
propertyString = coerce :: forall a b. Coercible a b => a -> b
coerce String
name
        getterName :: Name
getterName = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"get" forall a. [a] -> [a] -> [a]
++ String
propertyString
        setterName :: Name
setterName = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"set" forall a. [a] -> [a] -> [a]
++ String
propertyString
        getterFunction :: Dec
getterFunction = Name -> [Name] -> Exp -> Dec
mkFunD Name
getterName [Name]
getterArgNames Exp
getterBody
        setterFunction :: Dec
setterFunction = Name -> [Name] -> Exp -> Dec
mkFunD Name
setterName [Name]
setterArgNames Exp
setterBody
        getterSignature :: Dec
getterSignature = Name -> Type -> Dec
SigD Name
getterName Type
getterSigType
        setterSignature :: Dec
setterSignature = Name -> Type -> Dec
SigD Name
setterName Type
setterSigType
        getterDefs :: [Dec]
getterDefs = if Bool
readable then [Dec
getterSignature, Dec
getterFunction] else []
        setterDefs :: [Dec]
setterDefs = if Bool
writable then [Dec
setterSignature, Dec
setterFunction] else []
        methodCallSignature :: Dec
methodCallSignature = Name -> Type -> Dec
SigD Name
methodCallDefN forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT ''M.MethodCall
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Dec
methodCallSignatureforall a. a -> [a] -> [a]
:[Dec]
methodCallDefs forall a. [a] -> [a] -> [a]
++ [Dec]
getterDefs forall a. [a] -> [a] -> [a]
++ [Dec]
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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> b) -> [a] -> [b]
map (GenerationParams -> Signal -> Q [Dec]
generateSignal GenerationParams
params { genInterfaceName :: InterfaceName
genInterfaceName = coerce :: forall a b. Coercible a b => a -> b
coerce InterfaceName
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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Q Name
newNameDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalArg -> String
I.signalArgName) [SignalArg]
args

    [Name]
argNames <- Q [Name]
buildArgNames
    [Name]
fromVariantOutputNames <- Q [Name]
buildArgNames
    [Name]
toHandlerOutputNames <- Q [Name]
buildArgNames
    Name
objectPathN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"objectPath"
    Name
variantsN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"variants"
    Name
signalN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"signal"
    Name
receivedSignalN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"signal"
    Name
clientN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"client"
    Name
handlerArgN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"handlerArg"
    Name
errorHandlerN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"errorHandler"
    Name
matchRuleN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"matchRule"
    Name
matchRuleArgN <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"matchRuleArg"

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

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