module DBus.Introspection.Types where

import qualified DBus as T

data Object = Object
    { Object -> ObjectPath
objectPath :: T.ObjectPath
    , Object -> [Interface]
objectInterfaces :: [Interface]
    , Object -> [Object]
objectChildren :: [Object]
    }
    deriving (Int -> Object -> ShowS
[Object] -> ShowS
Object -> String
(Int -> Object -> ShowS)
-> (Object -> String) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> String
$cshow :: Object -> String
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Show, Object -> Object -> Bool
(Object -> Object -> Bool)
-> (Object -> Object -> Bool) -> Eq Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c== :: Object -> Object -> Bool
Eq)

data Interface = Interface
    { Interface -> InterfaceName
interfaceName :: T.InterfaceName
    , Interface -> [Method]
interfaceMethods :: [Method]
    , Interface -> [Signal]
interfaceSignals :: [Signal]
    , Interface -> [Property]
interfaceProperties :: [Property]
    }
    deriving (Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
(Int -> Interface -> ShowS)
-> (Interface -> String)
-> ([Interface] -> ShowS)
-> Show Interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interface] -> ShowS
$cshowList :: [Interface] -> ShowS
show :: Interface -> String
$cshow :: Interface -> String
showsPrec :: Int -> Interface -> ShowS
$cshowsPrec :: Int -> Interface -> ShowS
Show, Interface -> Interface -> Bool
(Interface -> Interface -> Bool)
-> (Interface -> Interface -> Bool) -> Eq Interface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interface -> Interface -> Bool
$c/= :: Interface -> Interface -> Bool
== :: Interface -> Interface -> Bool
$c== :: Interface -> Interface -> Bool
Eq)

data Method = Method
    { Method -> MemberName
methodName :: T.MemberName
    , Method -> [MethodArg]
methodArgs :: [MethodArg]
    }
    deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show, Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq)

data MethodArg = MethodArg
    { MethodArg -> String
methodArgName :: String
    , MethodArg -> Type
methodArgType :: T.Type
    , MethodArg -> Direction
methodArgDirection :: Direction
    }
    deriving (Int -> MethodArg -> ShowS
[MethodArg] -> ShowS
MethodArg -> String
(Int -> MethodArg -> ShowS)
-> (MethodArg -> String)
-> ([MethodArg] -> ShowS)
-> Show MethodArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodArg] -> ShowS
$cshowList :: [MethodArg] -> ShowS
show :: MethodArg -> String
$cshow :: MethodArg -> String
showsPrec :: Int -> MethodArg -> ShowS
$cshowsPrec :: Int -> MethodArg -> ShowS
Show, MethodArg -> MethodArg -> Bool
(MethodArg -> MethodArg -> Bool)
-> (MethodArg -> MethodArg -> Bool) -> Eq MethodArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodArg -> MethodArg -> Bool
$c/= :: MethodArg -> MethodArg -> Bool
== :: MethodArg -> MethodArg -> Bool
$c== :: MethodArg -> MethodArg -> Bool
Eq)

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

data Signal = Signal
    { Signal -> MemberName
signalName :: T.MemberName
    , Signal -> [SignalArg]
signalArgs :: [SignalArg]
    }
    deriving (Int -> Signal -> ShowS
[Signal] -> ShowS
Signal -> String
(Int -> Signal -> ShowS)
-> (Signal -> String) -> ([Signal] -> ShowS) -> Show Signal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signal] -> ShowS
$cshowList :: [Signal] -> ShowS
show :: Signal -> String
$cshow :: Signal -> String
showsPrec :: Int -> Signal -> ShowS
$cshowsPrec :: Int -> Signal -> ShowS
Show, Signal -> Signal -> Bool
(Signal -> Signal -> Bool)
-> (Signal -> Signal -> Bool) -> Eq Signal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c== :: Signal -> Signal -> Bool
Eq)

data SignalArg = SignalArg
    { SignalArg -> String
signalArgName :: String
    , SignalArg -> Type
signalArgType :: T.Type
    }
    deriving (Int -> SignalArg -> ShowS
[SignalArg] -> ShowS
SignalArg -> String
(Int -> SignalArg -> ShowS)
-> (SignalArg -> String)
-> ([SignalArg] -> ShowS)
-> Show SignalArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalArg] -> ShowS
$cshowList :: [SignalArg] -> ShowS
show :: SignalArg -> String
$cshow :: SignalArg -> String
showsPrec :: Int -> SignalArg -> ShowS
$cshowsPrec :: Int -> SignalArg -> ShowS
Show, SignalArg -> SignalArg -> Bool
(SignalArg -> SignalArg -> Bool)
-> (SignalArg -> SignalArg -> Bool) -> Eq SignalArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalArg -> SignalArg -> Bool
$c/= :: SignalArg -> SignalArg -> Bool
== :: SignalArg -> SignalArg -> Bool
$c== :: SignalArg -> SignalArg -> Bool
Eq)

data Property = Property
    { Property -> String
propertyName :: String
    , Property -> Type
propertyType :: T.Type
    , Property -> Bool
propertyRead :: Bool
    , Property -> Bool
propertyWrite :: Bool
    }
    deriving (Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq)