-- | Parsing of objects.
module Data.GI.GIR.Object
    ( Object(..)
    , parseObject
    ) where

import Data.Text (Text)

import Data.GI.GIR.Method (Method, parseMethod, MethodType(..))
import Data.GI.GIR.Property (Property, parseProperty)
import Data.GI.GIR.Signal (Signal, parseSignal)
import Data.GI.GIR.Parser
import Data.GI.GIR.Type (queryCType)

data Object = Object {
    Object -> Maybe Name
objParent :: Maybe Name,
    Object -> Text
objTypeInit :: Text,
    Object -> Text
objTypeName :: Text,
    Object -> Maybe Text
objCType :: Maybe Text,
    Object -> Maybe Text
objRefFunc :: Maybe Text,
    Object -> Maybe Text
objUnrefFunc :: Maybe Text,
    Object -> [Name]
objInterfaces :: [Name],
    Object -> Maybe DeprecationInfo
objDeprecated :: Maybe DeprecationInfo,
    Object -> Documentation
objDocumentation :: Documentation,
    Object -> [Method]
objMethods :: [Method],
    Object -> [Property]
objProperties :: [Property],
    Object -> [Signal]
objSignals :: [Signal]
    } 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

parseObject :: Parser (Name, Object)
parseObject :: Parser (Name, Object)
parseObject = do
  Name
name <- Parser Name
parseName
  Maybe DeprecationInfo
deprecated <- Parser (Maybe DeprecationInfo)
parseDeprecation
  Documentation
doc <- Parser Documentation
parseDocumentation
  [Method]
methods <- Text -> Parser Method -> Parser [Method]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"method" (MethodType -> Parser Method
parseMethod MethodType
OrdinaryMethod)
  [Method]
constructors <- Text -> Parser Method -> Parser [Method]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"constructor" (MethodType -> Parser Method
parseMethod MethodType
Constructor)
  [Method]
functions <- Text -> Parser Method -> Parser [Method]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"function" (MethodType -> Parser Method
parseMethod MethodType
MemberFunction)
  Maybe Name
parent <- Name
-> Maybe Name
-> (Text -> Parser (Maybe Name))
-> Parser (Maybe Name)
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"parent" Maybe Name
forall a. Maybe a
Nothing ((Name -> Maybe Name) -> Parser Name -> Parser (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Maybe Name
forall a. a -> Maybe a
Just (Parser Name -> Parser (Maybe Name))
-> (Text -> Parser Name) -> Text -> Parser (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser Name
qualifyName)
  [Name]
interfaces <- Text -> Parser Name -> Parser [Name]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"implements" Parser Name
parseName
  [Property]
props <- Text -> Parser Property -> Parser [Property]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"property" Parser Property
parseProperty
  Text
typeInitFn <- GIRXMLNamespace -> Name -> Parser Text
getAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"get-type"
  Text
typeInit <- case Text
typeInitFn of
                Text
"intern" -> Name -> Parser Text
resolveInternalType Name
name
                Text
fn -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
fn
  Text
typeName <- GIRXMLNamespace -> Name -> Parser Text
getAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"type-name"
  [Signal]
signals <- GIRXMLNamespace -> Text -> Parser Signal -> Parser [Signal]
forall a. GIRXMLNamespace -> Text -> Parser a -> Parser [a]
parseChildrenWithNSName GIRXMLNamespace
GLibGIRNS Text
"signal" Parser Signal
parseSignal
  Maybe Text
refFunc <- GIRXMLNamespace -> Name -> Parser (Maybe Text)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"ref-func"
  Maybe Text
unrefFunc <- GIRXMLNamespace -> Name -> Parser (Maybe Text)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"unref-func"

  Maybe Text
ctype <- Parser (Maybe Text)
queryCType
  (Name, Object) -> Parser (Name, Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name,
         Object :: Maybe Name
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [Name]
-> Maybe DeprecationInfo
-> Documentation
-> [Method]
-> [Property]
-> [Signal]
-> Object
Object {
            objParent :: Maybe Name
objParent = Maybe Name
parent
          , objTypeInit :: Text
objTypeInit = Text
typeInit
          , objCType :: Maybe Text
objCType = Maybe Text
ctype
          , objRefFunc :: Maybe Text
objRefFunc = Maybe Text
refFunc
          , objUnrefFunc :: Maybe Text
objUnrefFunc = Maybe Text
unrefFunc
          , objTypeName :: Text
objTypeName = Text
typeName
          , objInterfaces :: [Name]
objInterfaces = [Name]
interfaces
          , objDeprecated :: Maybe DeprecationInfo
objDeprecated = Maybe DeprecationInfo
deprecated
          , objDocumentation :: Documentation
objDocumentation = Documentation
doc
          , objMethods :: [Method]
objMethods = [Method]
constructors [Method] -> [Method] -> [Method]
forall a. [a] -> [a] -> [a]
++ [Method]
methods [Method] -> [Method] -> [Method]
forall a. [a] -> [a] -> [a]
++ [Method]
functions
          , objProperties :: [Property]
objProperties = [Property]
props
          , objSignals :: [Signal]
objSignals = [Signal]
signals
          })

-- | Some basic types do not list a type init function, and instead
-- mention "intern". Provide the explicit numerical value of the GType
-- in these cases.
resolveInternalType :: Name -> Parser Text
resolveInternalType :: Name -> Parser Text
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpec") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecBoolean") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecBoxed") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecChar") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecDouble") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecEnum") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecFlags") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecFloat") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecGType") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecInt") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecInt64") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecLong") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecObject") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecOverride") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecParam") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecPointer") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecString") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecUChar") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecUInt") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecUInt64") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecULong") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecUnichar") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecVariant") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
"GObject" p :: Text
p@Text
"ParamSpecValueArray") = Text -> Parser Text
pspec_type_init Text
p
resolveInternalType (Name Text
ns Text
n) =
  Text -> Parser Text
forall a. Text -> Parser a
parseError (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text
"Unknown internal type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"This is a bug, please report at https://github.com/haskell-gi/haskell-gi/issues"

-- | The name of the function we provide for querying ParamSpec types
-- at runtime.
pspec_type_init :: Text -> Parser Text
pspec_type_init :: Text -> Parser Text
pspec_type_init Text
p = Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text
"haskell_gi_pspec_type_init_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p