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

#if !MIN_VERSION_base(4,13,0)
import Data.Monoid ((<>))
#endif

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 -> ParseError
objTypeInit :: Text,
    Object -> ParseError
objTypeName :: Text,
    Object -> Maybe ParseError
objCType :: Maybe Text,
    Object -> Maybe ParseError
objRefFunc :: Maybe Text,
    Object -> Maybe ParseError
objUnrefFunc :: Maybe Text,
    Object -> Maybe ParseError
objSetValueFunc :: Maybe Text,
    Object -> Maybe ParseError
objGetValueFunc :: 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
$cshowsPrec :: Int -> Object -> ShowS
showsPrec :: Int -> Object -> ShowS
$cshow :: Object -> String
show :: Object -> String
$cshowList :: [Object] -> ShowS
showList :: [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 <- ParseError -> Parser Method -> Parser [Method]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"method" (MethodType -> Parser Method
parseMethod MethodType
OrdinaryMethod)
  [Method]
constructors <- ParseError -> Parser Method -> Parser [Method]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"constructor" (MethodType -> Parser Method
parseMethod MethodType
Constructor)
  [Method]
functions <- ParseError -> Parser Method -> Parser [Method]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"function" (MethodType -> Parser Method
parseMethod MethodType
MemberFunction)
  Maybe Name
parent <- Name
-> Maybe Name
-> (ParseError -> Parser (Maybe Name))
-> Parser (Maybe Name)
forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"parent" Maybe Name
forall a. Maybe a
Nothing ((Name -> Maybe Name) -> Parser Name -> Parser (Maybe Name)
forall a b.
(a -> b)
-> ReaderT ParseContext (Except ParseError) a
-> ReaderT ParseContext (Except ParseError) b
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))
-> (ParseError -> Parser Name) -> ParseError -> Parser (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Parser Name
qualifyName)
  [Name]
interfaces <- ParseError -> Parser Name -> Parser [Name]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"implements" Parser Name
parseName
  [Property]
props <- ParseError -> Parser Property -> Parser [Property]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"property" Parser Property
parseProperty
  ParseError
typeInitFn <- GIRXMLNamespace -> Name -> Parser ParseError
getAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"get-type"
  ParseError
typeInit <- case ParseError
typeInitFn of
                ParseError
"intern" -> Name -> Parser ParseError
resolveInternalType Name
name
                ParseError
fn -> ParseError -> Parser ParseError
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ParseError
fn
  ParseError
typeName <- GIRXMLNamespace -> Name -> Parser ParseError
getAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"type-name"
  [Signal]
signals <- GIRXMLNamespace -> ParseError -> Parser Signal -> Parser [Signal]
forall a. GIRXMLNamespace -> ParseError -> Parser a -> Parser [a]
parseChildrenWithNSName GIRXMLNamespace
GLibGIRNS ParseError
"signal" Parser Signal
parseSignal
  Maybe ParseError
refFunc <- GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"ref-func"
  Maybe ParseError
unrefFunc <- GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"unref-func"
  Maybe ParseError
setValueFunc <- GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"set-value-func"
  Maybe ParseError
getValueFunc <- GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"get-value-func"

  Maybe ParseError
ctype <- Parser (Maybe ParseError)
queryCType
  (Name, Object) -> Parser (Name, Object)
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name,
         Object {
            objParent :: Maybe Name
objParent = Maybe Name
parent
          , objTypeInit :: ParseError
objTypeInit = ParseError
typeInit
          , objCType :: Maybe ParseError
objCType = Maybe ParseError
ctype
          , objRefFunc :: Maybe ParseError
objRefFunc = Maybe ParseError
refFunc
          , objUnrefFunc :: Maybe ParseError
objUnrefFunc = Maybe ParseError
unrefFunc
          , objSetValueFunc :: Maybe ParseError
objSetValueFunc = Maybe ParseError
setValueFunc
          , objGetValueFunc :: Maybe ParseError
objGetValueFunc = Maybe ParseError
getValueFunc
          , objTypeName :: ParseError
objTypeName = ParseError
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 ParseError
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpec") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecBoolean") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecBoxed") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecChar") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecDouble") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecEnum") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecFlags") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecFloat") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecGType") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecInt") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecInt64") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecLong") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecObject") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecOverride") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecParam") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecPointer") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecString") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecUChar") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecUInt") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecUInt64") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecULong") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecUnichar") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecVariant") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
"GObject" p :: ParseError
p@ParseError
"ParamSpecValueArray") = ParseError -> Parser ParseError
pspec_type_init ParseError
p
resolveInternalType (Name ParseError
ns ParseError
n) =
  ParseError -> Parser ParseError
forall a. ParseError -> Parser a
parseError (ParseError -> Parser ParseError)
-> ParseError -> Parser ParseError
forall a b. (a -> b) -> a -> b
$ ParseError
"Unknown internal type: " ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
<> ParseError
ns ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
<> ParseError
"." ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
<> ParseError
n ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
<> ParseError
"\n"
                ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
<> ParseError
"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 :: ParseError -> Parser ParseError
pspec_type_init ParseError
p = ParseError -> Parser ParseError
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Parser ParseError)
-> ParseError -> Parser ParseError
forall a b. (a -> b) -> a -> b
$ ParseError
"haskell_gi_pspec_type_init_" ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
<> ParseError
p