-- | 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 <- Parser Name
parseName
  deprecated <- parseDeprecation
  doc <- parseDocumentation
  methods <- parseChildrenWithLocalName "method" (parseMethod OrdinaryMethod)
  constructors <- parseChildrenWithLocalName "constructor" (parseMethod Constructor)
  functions <- parseChildrenWithLocalName "function" (parseMethod MemberFunction)
  parent <- optionalAttr "parent" Nothing (fmap Just . qualifyName)
  interfaces <- parseChildrenWithLocalName "implements" parseName
  props <- parseChildrenWithLocalName "property" parseProperty
  typeInitFn <- getAttrWithNamespace GLibGIRNS "get-type"
  typeInit <- case 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
  typeName <- getAttrWithNamespace GLibGIRNS "type-name"
  signals <- parseChildrenWithNSName GLibGIRNS "signal" parseSignal
  refFunc <- queryAttrWithNamespace GLibGIRNS "ref-func"
  unrefFunc <- queryAttrWithNamespace GLibGIRNS "unref-func"
  setValueFunc <- queryAttrWithNamespace GLibGIRNS "set-value-func"
  getValueFunc <- queryAttrWithNamespace GLibGIRNS "get-value-func"

  ctype <- queryCType
  return (name,
         Object {
            objParent = parent
          , objTypeInit = typeInit
          , objCType = ctype
          , objRefFunc = refFunc
          , objUnrefFunc = unrefFunc
          , objSetValueFunc = setValueFunc
          , objGetValueFunc = getValueFunc
          , objTypeName = typeName
          , objInterfaces = interfaces
          , objDeprecated = deprecated
          , objDocumentation = doc
          , objMethods = constructors ++ methods ++ functions
          , objProperties = props
          , objSignals = 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