    module Data.GI.CodeGen.CodeGen
        ( genConstant
        , genFunction
        , genModule
        ) where

    import Control.Monad (forM, forM_, when, unless, filterM)
    import Data.List (nub)
    import Data.Maybe (fromJust, fromMaybe, catMaybes, mapMaybe)
    #if !MIN_VERSION_base(4,13,0)
    import Data.Monoid ((<>))
    #endif
    import qualified Data.Map as M
    import qualified Data.Text as T
    import Data.Text (Text)

    import Data.GI.CodeGen.API
    import Data.GI.CodeGen.Callable (genCCallableWrapper)
    import Data.GI.CodeGen.Constant (genConstant)
    import Data.GI.CodeGen.Code
    import Data.GI.CodeGen.EnumFlags (genEnum, genFlags)
    import Data.GI.CodeGen.Fixups (dropMovedItems, guessPropertyNullability,
                                   detectGObject, dropDuplicatedFields,
                                   checkClosureDestructors, fixSymbolNaming,
                                   fixClosures, fixCallbackUserData)
    import Data.GI.CodeGen.GObject
    import Data.GI.CodeGen.Haddock (deprecatedPragma, addSectionDocumentation,
                                    writeHaddock,
                                    RelativeDocPosition(DocBeforeSymbol))
    import Data.GI.CodeGen.Inheritance (instanceTree, fullObjectMethodList,
                           fullInterfaceMethodList)
    import Data.GI.CodeGen.Properties (genInterfaceProperties, genObjectProperties,
                          genNamespacedPropLabels)
    import Data.GI.CodeGen.OverloadedSignals (genInterfaceSignals, genObjectSignals)
    import Data.GI.CodeGen.OverloadedMethods (genMethodList, genMethodInfo,
                                 genUnsupportedMethodInfo)
    import Data.GI.CodeGen.Signal (genSignal, genCallback)
    import Data.GI.CodeGen.Struct (genStructOrUnionFields, extractCallbacksInStruct,
                      fixAPIStructs, ignoreStruct, genZeroStruct, genZeroUnion,
                      genBoxed, genWrappedPtr)
    import Data.GI.CodeGen.SymbolNaming (upperName, classConstraint,
                                         submoduleLocation, lowerName, qualifiedAPI,
                                         normalizedAPIName, safeCast)
    import Data.GI.CodeGen.Type
    import Data.GI.CodeGen.Util (tshow)

    genFunction :: Name -> Function -> CodeGen e ()
    genFunction :: forall e. Name -> Function -> CodeGen e ()
    genFunction Name
    n (Function Text
    symbol Maybe Text
    fnMovedTo Callable
    callable) =
        -- Only generate the function if it has not been moved.
        Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe Text
    forall a. Maybe a
    Nothing Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Text
    fnMovedTo) (ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b. (a -> b) -> a -> b
    $
          ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b. (a -> b) -> a -> b
    $ do
            Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Text -> CodeGen e ()
    line (Text
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- function " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    name Name
    n
            (CGError
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> ExcCodeGen ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (\CGError
    e -> do
                            Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Text -> CodeGen e ()
    line (Text
    "-- XXX Could not generate function "
                                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    name Name
    n
                                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n")
                            CGError
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e)
                            (do
                              Name -> Text -> Callable -> ExcCodeGen ()
    genCCallableWrapper Name
    n Text
    symbol Callable
    callable
                              HaddockSection -> Text -> ExcCodeGen ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    MethodSection (Text -> HaddockSection) -> Text -> HaddockSection
    forall a b. (a -> b) -> a -> b
    $ Name -> Text
    lowerName Name
    n) (Name -> Text
    lowerName Name
    n)
                            )

    -- | Create the newtype wrapping the ManagedPtr for the given type.
    genNewtype :: Text -> CodeGen e ()
    genNewtype :: forall e. Text -> CodeGen e ()
    genNewtype Text
    name' = do
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "newtype " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " (SP.ManagedPtr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "deriving (Eq)"

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance SP.ManagedPtrNewtype " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " where"
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "toManagedPtr (" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " p) = p"

    -- | Generate wrapper for structures.
    genStruct :: Name -> Struct -> CodeGen e ()
    genStruct :: forall e. Name -> Struct -> CodeGen e ()
    genStruct Name
    n Struct
    s = Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Name -> Struct -> Bool
    ignoreStruct Name
    n Struct
    s) (ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b. (a -> b) -> a -> b
    $ do
       let Name Text
    _ Text
    name' = API -> Name -> Name
    normalizedAPIName (Struct -> API
    APIStruct Struct
    s) Name
    n

       RelativeDocPosition
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol (Text
    "Memory-managed wrapper type.")
       Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Text -> CodeGen e ()
    genNewtype Text
    name'
       Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Text -> CodeGen e ()
    exportDecl (Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (Text
    "(..)"))

       HaddockSection
    -> Documentation
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. HaddockSection -> Documentation -> CodeGen e ()
    addSectionDocumentation HaddockSection
    ToplevelSection (Struct -> Documentation
    structDocumentation Struct
    s)

       if Struct -> Bool
    structIsBoxed Struct
    s
       then Name
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> Text -> CodeGen e ()
    genBoxed Name
    n (Maybe Text -> Text
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Struct -> Maybe Text
    structTypeInit Struct
    s)
       else Name
    -> AllocationInfo
    -> Int
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> AllocationInfo -> Int -> CodeGen e ()
    genWrappedPtr Name
    n (Struct -> AllocationInfo
    structAllocationInfo Struct
    s) (Struct -> Int
    structSize Struct
    s)

       -- Generate a builder for a structure filled with zeroes.
       Name
    -> Struct
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> Struct -> CodeGen e ()
    genZeroStruct Name
    n Struct
    s

       -- Generate code for fields.
       Name
    -> [Field]
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> [Field] -> CodeGen e ()
    genStructOrUnionFields Name
    n (Struct -> [Field]
    structFields Struct
    s)

       -- Methods
       methods <- [Method]
    -> (Method
        -> ReaderT
             CodeGenConfig
             (StateT (CGState, ModuleInfo) (Except e))
             (Maybe (Name, Method)))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         [Maybe (Name, Method)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (Struct -> [Method]
    structMethods Struct
    s) ((Method
      -> ReaderT
           CodeGenConfig
           (StateT (CGState, ModuleInfo) (Except e))
           (Maybe (Name, Method)))
     -> ReaderT
          CodeGenConfig
          (StateT (CGState, ModuleInfo) (Except e))
          [Maybe (Name, Method)])
    -> (Method
        -> ReaderT
             CodeGenConfig
             (StateT (CGState, ModuleInfo) (Except e))
             (Maybe (Name, Method)))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         [Maybe (Name, Method)]
    forall a b. (a -> b) -> a -> b
    $ \Method
    f -> do
           let mn :: Name
    mn = Method -> Name
    methodName Method
    f
           isFunction <- Text -> CodeGen e Bool
    forall e. Text -> CodeGen e Bool
    symbolFromFunction (Method -> Text
    methodSymbol Method
    f)
           if not isFunction
           then handleCGExc
                   (\CGError
    e -> do Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Text -> CodeGen e ()
    line (Text
    "-- XXX Could not generate method "
                                   Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    name Name
    mn)
                             CGError
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e
                             Maybe (Name, Method)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe (Name, Method))
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Name, Method)
    forall a. Maybe a
    Nothing)
                   (genMethod n f >> return (Just (n, f)))
           else return Nothing

       -- Overloaded methods
       cppIf CPPOverloading (genMethodList n (catMaybes methods))

    -- | Generated wrapper for unions.
    genUnion :: Name -> Union -> CodeGen e ()
    genUnion :: forall e. Name -> Union -> CodeGen e ()
    genUnion Name
    n Union
    u = do
      let Name Text
    _ Text
    name' = API -> Name -> Name
    normalizedAPIName (Union -> API
    APIUnion Union
    u) Name
    n

      RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol (Text
    "Memory-managed wrapper type.")
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    genNewtype Text
    name'
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    exportDecl (Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "(..)")

      HaddockSection -> Documentation -> CodeGen e ()
    forall e. HaddockSection -> Documentation -> CodeGen e ()
    addSectionDocumentation HaddockSection
    ToplevelSection (Union -> Documentation
    unionDocumentation Union
    u)

      if Union -> Bool
    unionIsBoxed Union
    u
      then Name -> Text -> CodeGen e ()
    forall e. Name -> Text -> CodeGen e ()
    genBoxed Name
    n (Maybe Text -> Text
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Union -> Maybe Text
    unionTypeInit Union
    u)
      else Name -> AllocationInfo -> Int -> CodeGen e ()
    forall e. Name -> AllocationInfo -> Int -> CodeGen e ()
    genWrappedPtr Name
    n (Union -> AllocationInfo
    unionAllocationInfo Union
    u) (Union -> Int
    unionSize Union
    u)

      -- Generate a builder for a structure filled with zeroes.
      Name -> Union -> CodeGen e ()
    forall e. Name -> Union -> CodeGen e ()
    genZeroUnion Name
    n Union
    u

      -- Generate code for fields.
      Name -> [Field] -> CodeGen e ()
    forall e. Name -> [Field] -> CodeGen e ()
    genStructOrUnionFields Name
    n (Union -> [Field]
    unionFields Union
    u)

      -- Methods
      methods <- [Method]
    -> (Method
        -> ReaderT
             CodeGenConfig
             (StateT (CGState, ModuleInfo) (Except e))
             (Maybe (Name, Method)))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         [Maybe (Name, Method)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (Union -> [Method]
    unionMethods Union
    u) ((Method
      -> ReaderT
           CodeGenConfig
           (StateT (CGState, ModuleInfo) (Except e))
           (Maybe (Name, Method)))
     -> ReaderT
          CodeGenConfig
          (StateT (CGState, ModuleInfo) (Except e))
          [Maybe (Name, Method)])
    -> (Method
        -> ReaderT
             CodeGenConfig
             (StateT (CGState, ModuleInfo) (Except e))
             (Maybe (Name, Method)))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         [Maybe (Name, Method)]
    forall a b. (a -> b) -> a -> b
    $ \Method
    f -> do
          let mn :: Name
    mn = Method -> Name
    methodName Method
    f
          isFunction <- Text -> CodeGen e Bool
    forall e. Text -> CodeGen e Bool
    symbolFromFunction (Method -> Text
    methodSymbol Method
    f)
          if not isFunction
          then handleCGExc
                    (\CGError
    e -> do Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text
    "-- XXX Could not generate method "
                                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    name Name
    mn)
                              CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e
                              Maybe (Name, Method)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe (Name, Method))
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Name, Method)
    forall a. Maybe a
    Nothing)
                    (genMethod n f >> return (Just (n, f)))
          else return Nothing

      -- Overloaded methods
      cppIf CPPOverloading $ genMethodList n (catMaybes methods)

    -- | When parsing the GIR file we add the implicit object argument to
    -- methods of an object.  Since we are prepending an argument we need
    -- to adjust the offset of the length arguments of CArrays, and
    -- closure and destroyer offsets.
    fixMethodArgs :: Callable -> Callable
    fixMethodArgs :: Callable -> Callable
    fixMethodArgs Callable
    c = Callable
    c {  args = args'' , returnType = returnType' }
        where
          returnType' :: Maybe Type
    returnType' = Maybe Type -> (Type -> Maybe Type) -> Maybe Type -> Maybe Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe Type
    forall a. Maybe a
    Nothing (Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Type -> Maybe Type) -> (Type -> Type) -> Type -> Maybe Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Type
    fixCArrayLength) (Callable -> Maybe Type
    returnType Callable
    c)
          args' :: [Arg]
    args' = (Arg -> Arg) -> [Arg] -> [Arg]
    forall a b. (a -> b) -> [a] -> [b]
    map (Arg -> Arg
    fixDestroyers (Arg -> Arg) -> (Arg -> Arg) -> Arg -> Arg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg -> Arg
    fixClosures (Arg -> Arg) -> (Arg -> Arg) -> Arg -> Arg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg -> Arg
    fixLengthArg) (Callable -> [Arg]
    args Callable
    c)
          args'' :: [Arg]
    args'' = case [Arg]
    args' of
            Arg
    inst:[Arg]
    rest -> Arg -> Arg
    fixInstanceDirection Arg
    inst Arg -> [Arg] -> [Arg]
    forall a. a -> [a] -> [a]
    : [Arg]
    rest
            [] -> []

          fixLengthArg :: Arg -> Arg
          fixLengthArg :: Arg -> Arg
    fixLengthArg Arg
    arg = Arg
    arg { argType = fixCArrayLength (argType arg)}

          fixCArrayLength :: Type -> Type
          fixCArrayLength :: Type -> Type
    fixCArrayLength (TCArray Bool
    zt Int
    fixed Int
    length Type
    t) =
              if Int
    length Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > -Int
    1
              then Bool -> Int -> Int -> Type -> Type
    TCArray Bool
    zt Int
    fixed (Int
    lengthInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Type
    t
              else Bool -> Int -> Int -> Type -> Type
    TCArray Bool
    zt Int
    fixed Int
    length Type
    t

          fixCArrayLength Type
    t = Type
    t

          fixDestroyers :: Arg -> Arg
          fixDestroyers :: Arg -> Arg
    fixDestroyers Arg
    arg = let destroy :: Int
    destroy = Arg -> Int
    argDestroy Arg
    arg in
                              if Int
    destroy Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > -Int
    1
                              then Arg
    arg {argDestroy = destroy + 1}
                              else Arg
    arg

          fixClosures :: Arg -> Arg
          fixClosures :: Arg -> Arg
    fixClosures Arg
    arg = let closure :: Int
    closure = Arg -> Int
    argClosure Arg
    arg in
                            if Int
    closure Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > -Int
    1
                            then Arg
    arg {argClosure = closure + 1}
                            else Arg
    arg

          -- We always treat the instance argument of a method as "in",
          -- even if the introspection data says otherwise (this is
          -- generally an erroneous annotation, meaning that the structure
          -- is modified).
          fixInstanceDirection :: Arg -> Arg
          fixInstanceDirection :: Arg -> Arg
    fixInstanceDirection Arg
    arg = Arg
    arg { direction = DirectionIn}

    -- For constructors we want to return the actual type of the object,
    -- rather than a generic superclass (so Gtk.labelNew returns a
    -- Gtk.Label, rather than a Gtk.Widget)
    fixConstructorReturnType :: Bool -> Name -> Callable -> Callable
    fixConstructorReturnType :: Bool -> Name -> Callable -> Callable
    fixConstructorReturnType Bool
    returnsGObject Name
    cn Callable
    c = Callable
    c { returnType = returnType' }
        where
          returnType' :: Maybe Type
    returnType' = if Bool
    returnsGObject then
                            Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Name -> Type
    TInterface Name
    cn)
                        else
                            Callable -> Maybe Type
    returnType Callable
    c

    genMethod :: Name -> Method -> ExcCodeGen ()
    genMethod :: Name -> Method -> ExcCodeGen ()
    genMethod Name
    cn m :: Method
    m@(Method {
                      methodName :: Method -> Name
    methodName = Name
    mn,
                      methodSymbol :: Method -> Text
    methodSymbol = Text
    sym,
                      methodCallable :: Method -> Callable
    methodCallable = Callable
    c,
                      methodType :: Method -> MethodType
    methodType = MethodType
    t
                    }) = do
        let name' :: Text
    name' = Name -> Text
    upperName Name
    cn
        returnsGObject <- ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Bool
    -> (Type
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Bool)
    -> Maybe Type
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Bool
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False) Type
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Bool
    forall e. Type -> CodeGen e Bool
    isGObject (Callable -> Maybe Type
    returnType Callable
    c)
        line $ "-- method " <> name' <> "::" <> name mn
        line $ "-- method type : " <> tshow t
        let -- Mangle the name to namespace it to the class.
            mn' = Name
    mn { name = name cn <> "_" <> name mn }
        let c'  = if MethodType
    Constructor MethodType -> MethodType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MethodType
    t
                  then Bool -> Name -> Callable -> Callable
    fixConstructorReturnType Bool
    returnsGObject Name
    cn Callable
    c
                  else Callable
    c
            c'' = if MethodType
    OrdinaryMethod MethodType -> MethodType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MethodType
    t
                  then Callable -> Callable
    fixMethodArgs Callable
    c'
                  else Callable
    c'
        genCCallableWrapper mn' sym c''
        export (NamedSubsection MethodSection $ lowerName mn) (lowerName mn')

        cppIf CPPOverloading $
          genMethodInfo cn (m {methodCallable = c''})

    -- | Generate an import for the gvalue getter for the given type. It
    -- returns the name of the function on the Haskell side.
    genGValueGetter :: Text -> Text -> CodeGen e Text
    genGValueGetter :: forall e. Text -> Text -> CodeGen e Text
    genGValueGetter Text
    name' Text
    get_value_fn = CodeGen e Text -> CodeGen e Text
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e Text -> CodeGen e Text)
    -> CodeGen e Text -> CodeGen e Text
    forall a b. (a -> b) -> a -> b
    $ do
      let symb :: Text
    symb = Text
    "gv_get_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    get_value_fn
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "foreign import ccall \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    get_value_fn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    symb Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ::"
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "FP.Ptr B.GValue.GValue -> IO (FP.Ptr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
      Text -> CodeGen e Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    symb

    -- | Generate an import for the gvalue setter for the given type. It
    -- returns the name of the function on the Haskell side.
    genGValueSetter :: Text -> Text -> CodeGen e Text
    genGValueSetter :: forall e. Text -> Text -> CodeGen e Text
    genGValueSetter Text
    name' Text
    set_value_fn = CodeGen e Text -> CodeGen e Text
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e Text -> CodeGen e Text)
    -> CodeGen e Text -> CodeGen e Text
    forall a b. (a -> b) -> a -> b
    $ do
      let symb :: Text
    symb = Text
    "gv_set_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    set_value_fn
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "foreign import ccall \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    set_value_fn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    symb Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ::"
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "FP.Ptr B.GValue.GValue -> FP.Ptr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> IO ()"
      Text -> CodeGen e Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    symb

    -- | Generate the GValue instances for the given GObject.
    genGValueInstance :: Name -> Text -> Text -> Text -> Text -> CodeGen e ()
    genGValueInstance :: forall e. Name -> Text -> Text -> Text -> Text -> CodeGen e ()
    genGValueInstance Name
    n Text
    get_type_fn Text
    newFn Text
    get_value_fn Text
    set_value_fn = do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n
          doc :: Text
    doc = Text
    "Convert t'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."

      RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    doc

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance B.GValue.IsGValue (Maybe " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ") where"
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "gvalueGType_ = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    get_type_fn
          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "gvalueSet_ gv P.Nothing = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    set_value_fn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " gv (FP.nullPtr :: FP.Ptr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "gvalueSet_ gv (P.Just obj) = B.ManagedPtr.withManagedPtr obj (" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    set_value_fn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " gv)"
          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "gvalueGet_ gv = do"
          CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
            Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "ptr <- " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    get_value_fn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " gv :: IO (FP.Ptr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
            Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "if ptr /= FP.nullPtr"
            Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "then P.Just <$> " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    newFn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ptr"
            Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "else return P.Nothing"

    -- | Type casting with type checking, returns the function returning the
    -- GType for the oject.
    genCasts :: Name -> Text -> [Name] -> CodeGen e Text
    genCasts :: forall e. Name -> Text -> [Name] -> CodeGen e Text
    genCasts Name
    n Text
    ti [Name]
    parents = do
      isGO <- Type -> CodeGen e Bool
    forall e. Type -> CodeGen e Bool
    isGObject (Name -> Type
    TInterface Name
    n)
      let name' = Name -> Text
    upperName Name
    n

      get_type_fn <- do
        let cn_ = Text
    "c_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ti
        group $ do
          line $ "foreign import ccall \"" <> ti <> "\""
          indent $ line $ cn_ <> " :: IO B.Types.GType"
        return cn_

      group $ do
        bline $ "instance B.Types.TypedObject " <> name' <> " where"
        indent $ do
          line $ "glibType = " <> get_type_fn

      when isGO $ group $ do
          bline $ "instance B.Types.GObject " <> name'

      className <- classConstraint n
      group $ do
        exportDecl className
        writeHaddock DocBeforeSymbol (classDoc name')

        -- Create the IsX constraint. We cannot simply say
        --
        -- > type IsX o = (GObject o, ...)
        --
        -- since we sometimes need to refer to @IsX@ itself, without
        -- applying it. We instead use the trick of creating a class with
        -- a universal instance.
        let constraints = if Bool
    isGO
                          then Text
    "(SP.GObject o, O.IsDescendantOf " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " o)"
                          else Text
    "(SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " o)"
        bline $ "class " <> constraints <> " => " <> className <> " o"
        bline $ "instance " <> constraints <> " => " <> className <> " o"

        blank

        parentAPIs <- mapM (\Name
    n -> Type
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) API
    forall e. HasCallStack => Type -> CodeGen e API
    getAPI (Name -> Type
    TInterface Name
    n)) parents
        qualifiedParents <- mapM (uncurry qualifiedAPI) (zip parentAPIs parents)
        bline $ "instance O.HasParentTypes " <> name'
        line $ "type instance O.ParentTypes " <> name' <> " = '["
          <> T.intercalate ", " qualifiedParents <> "]"

      -- Safe downcasting.
      group $ do
        cast <- safeCast n
        exportDecl cast
        writeHaddock DocBeforeSymbol (castDoc name')
        bline $ cast <> " :: (MIO.MonadIO m, " <> className <> " o) => o -> m " <> name'
        line $ cast <> " = MIO.liftIO . B.ManagedPtr.unsafeCastTo " <> name'

      return get_type_fn

      where castDoc :: Text -> Text
            castDoc :: Text -> Text
    castDoc Text
    name' = Text
    "Cast to t'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                            Text
    "', for types for which this is known to be safe. " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                            Text
    "For general casts, use 'Data.GI.Base.ManagedPtr.castTo'."

            classDoc :: Text -> Text
            classDoc :: Text -> Text
    classDoc Text
    name' = Text
    "Type class for types which can be safely cast to t'"
                             Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "', for instance with `to" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "`."

    -- | Wrap a given Object. We enforce that every Object that we wrap is a
    -- GObject. This is the case for everything except the ParamSpec* set
    -- of objects, we deal with these separately.
    genObject :: Name -> Object -> CodeGen e ()
    genObject :: forall e. Name -> Object -> CodeGen e ()
    genObject Name
    n Object
    o = do
      let Name Text
    _ Text
    name' = API -> Name -> Name
    normalizedAPIName (Object -> API
    APIObject Object
    o) Name
    n
      let t :: Type
    t = Name -> Type
    TInterface Name
    n
      isGO <- Type -> CodeGen e Bool
    forall e. Type -> CodeGen e Bool
    isGObject Type
    t

      writeHaddock DocBeforeSymbol ("Memory-managed wrapper type.")
      genNewtype name'
      exportDecl (name' <> "(..)")

      addSectionDocumentation ToplevelSection (objDocumentation o)

      -- Type safe casting to parent objects, and implemented interfaces.
      parents <- instanceTree n
      get_type_fn <- genCasts n (objTypeInit o) (parents <> objInterfaces o)

      if isGO
        then genGValueInstance n get_type_fn "B.ManagedPtr.newObject" "B.GValue.get_object" "B.GValue.set_object"
        else case (objGetValueFunc o, objSetValueFunc o) of
               (Just Text
    get_value_fn, Just Text
    set_value_fn) -> do
                 getter <- Text -> Text -> CodeGen e Text
    forall e. Text -> Text -> CodeGen e Text
    genGValueGetter Text
    name' Text
    get_value_fn
                 setter <- genGValueSetter name' set_value_fn
                 genGValueInstance n get_type_fn "B.ManagedPtr.newPtr" getter setter
               (Maybe Text, Maybe Text)
    _ -> Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "--- XXX Missing getter and/or setter, so no GValue instance could be generated."

      cppIf CPPOverloading $ fullObjectMethodList n o >>= genMethodList n

      if isGO
        then do
          forM_ (objSignals o) $ \Signal
    s -> Signal -> Name -> CodeGen e ()
    forall e. Signal -> Name -> CodeGen e ()
    genSignal Signal
    s Name
    n

          genObjectProperties n o
          cppIf CPPOverloading $
            genNamespacedPropLabels n (objProperties o) (objMethods o)
          cppIf CPPOverloading $
            genObjectSignals n o
        else group $ do
          let allocInfo = AllocationInfo {
                allocCalloc :: AllocationOp
    allocCalloc = AllocationOp
    AllocationOpUnknown,
                allocCopy :: AllocationOp
    allocCopy = case Object -> Maybe Text
    objRefFunc Object
    o of
                              Just Text
    ref -> Text -> AllocationOp
    AllocationOp Text
    ref
                              Maybe Text
    Nothing -> AllocationOp
    AllocationOpUnknown,
                allocFree :: AllocationOp
    allocFree = case Object -> Maybe Text
    objUnrefFunc Object
    o of
                              Just Text
    unref -> Text -> AllocationOp
    AllocationOp Text
    unref
                              Maybe Text
    Nothing -> AllocationOp
    AllocationOpUnknown
                }
          genWrappedPtr n allocInfo 0

      -- Methods
      forM_ (objMethods o) $ \Method
    f -> do
        let mn :: Name
    mn = Method -> Name
    methodName Method
    f
        (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (\CGError
    e -> do Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text
    "-- XXX Could not generate method "
                                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    name Name
    mn)
                              CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e
                              CPPGuard -> CodeGen e () -> CodeGen e ()
    forall e a. CPPGuard -> CodeGen e a -> CodeGen e a
    cppIf CPPGuard
    CPPOverloading (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $
                                Name -> Method -> CodeGen e ()
    forall e. Name -> Method -> CodeGen e ()
    genUnsupportedMethodInfo Name
    n Method
    f)
                    (Name -> Method -> ExcCodeGen ()
    genMethod Name
    n Method
    f)

    genInterface :: Name -> Interface -> CodeGen e ()
    genInterface :: forall e. Name -> Interface -> CodeGen e ()
    genInterface Name
    n Interface
    iface = do
      let Name Text
    _ Text
    name' = API -> Name -> Name
    normalizedAPIName (Interface -> API
    APIInterface Interface
    iface) Name
    n

      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- interface " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " "
      RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol (Text
    "Memory-managed wrapper type.")
      Text -> Maybe DeprecationInfo -> CodeGen e ()
    forall e. Text -> Maybe DeprecationInfo -> CodeGen e ()
    deprecatedPragma Text
    name' (Maybe DeprecationInfo -> CodeGen e ())
    -> Maybe DeprecationInfo -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Interface -> Maybe DeprecationInfo
    ifDeprecated Interface
    iface
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    genNewtype Text
    name'
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    exportDecl (Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "(..)")

      HaddockSection -> Documentation -> CodeGen e ()
    forall e. HaddockSection -> Documentation -> CodeGen e ()
    addSectionDocumentation HaddockSection
    ToplevelSection (Interface -> Documentation
    ifDocumentation Interface
    iface)

      isGO <- Name -> API -> CodeGen e Bool
    forall e. Name -> API -> CodeGen e Bool
    apiIsGObject Name
    n (Interface -> API
    APIInterface Interface
    iface)
      if isGO
      then do
        let cn_ = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Text
    forall a. HasCallStack => String -> a
    error String
    "GObject derived interface without a type!") (Interface -> Maybe Text
    ifTypeInit Interface
    iface)
        gobjectPrereqs <- filterM nameIsGObject (ifPrerequisites iface)
        allParents <- forM gobjectPrereqs $ \Name
    p -> (Name
    p Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : ) ([Name] -> [Name])
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name]
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name]
    forall e. Name -> CodeGen e [Name]
    instanceTree Name
    p
        let uniqueParents = [Name] -> [Name]
    forall a. Eq a => [a] -> [a]
    nub ([[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Name]]
    allParents)
        get_type_fn <- genCasts n cn_ uniqueParents
        genGValueInstance n get_type_fn "B.ManagedPtr.newObject" "B.GValue.get_object" "B.GValue.set_object"

        genInterfaceProperties n iface
        cppIf CPPOverloading $
           genNamespacedPropLabels n (ifProperties iface) (ifMethods iface)

      else group $ do
        cls <- classConstraint n
        exportDecl cls
        writeHaddock DocBeforeSymbol ("Type class for types which implement t'"
                                      <> name' <> "'.")

        -- Create the IsX constraint. We cannot simply say
        --
        -- > type IsX o = (ManagedPtrNewtype o, O.IsDescendantOf X o)
        --
        -- since we sometimes need to refer to @IsX@ itself, without
        -- applying it. We instead use the trick of creating a class with
        -- a universal instance.
        let constraints = Text
    "(ManagedPtrNewtype o, O.IsDescendantOf " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " o)"
        bline $ "class " <> constraints <> " => " <> cls <> " o"
        bline $ "instance " <> constraints <> " => " <> cls <> " o"

        genWrappedPtr n (ifAllocationInfo iface) 0

        when (not . null . ifProperties $ iface) $ group $ do
           comment $ "XXX Skipping property generation for non-GObject interface"

      -- Methods
      cppIf CPPOverloading $ fullInterfaceMethodList n iface >>= genMethodList n

      forM_ (ifMethods iface) $ \Method
    f -> do
          let mn :: Name
    mn = Method -> Name
    methodName Method
    f
          isFunction <- Text -> CodeGen e Bool
    forall e. Text -> CodeGen e Bool
    symbolFromFunction (Method -> Text
    methodSymbol Method
    f)
          unless isFunction $
                 handleCGExc
                 (\CGError
    e -> do Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    comment (Text
    "XXX Could not generate method "
                                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    name Name
    mn)
                           CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e
                           CPPGuard -> CodeGen e () -> CodeGen e ()
    forall e a. CPPGuard -> CodeGen e a -> CodeGen e a
    cppIf CPPGuard
    CPPOverloading (Name -> Method -> CodeGen e ()
    forall e. Name -> Method -> CodeGen e ()
    genUnsupportedMethodInfo Name
    n Method
    f))
                 (genMethod n f)

      -- Signals
      forM_ (ifSignals iface) $ \Signal
    s -> (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc
         (\CGError
    e -> do Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat [Text
    "-- XXX Could not generate signal ", Text
    name', Text
    "::"
                                   , Signal -> Text
    sigName Signal
    s]
                   CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e)
         (Signal -> Name -> ExcCodeGen ()
    forall e. Signal -> Name -> CodeGen e ()
    genSignal Signal
    s Name
    n)

      cppIf CPPOverloading $
         genInterfaceSignals n iface

    -- Some type libraries include spurious interface/struct methods,
    -- where a method Mod.Foo::func also appears as an ordinary function
    -- in the list of APIs. If we find a matching function (without the
    -- "moved-to" annotation), we don't generate the method.
    --
    -- It may be more expedient to keep a map of symbol -> function.
    symbolFromFunction :: Text -> CodeGen e Bool
    symbolFromFunction :: forall e. Text -> CodeGen e Bool
    symbolFromFunction Text
    sym = do
        apis <- CodeGen e (Map Name API)
    forall e. CodeGen e (Map Name API)
    getAPIs
        return $ any (hasSymbol sym . snd) $ M.toList apis
        where
            hasSymbol :: Text -> API -> Bool
    hasSymbol Text
    sym1 (APIFunction (Function { fnSymbol :: Function -> Text
    fnSymbol = Text
    sym2,
                                                    fnMovedTo :: Function -> Maybe Text
    fnMovedTo = Maybe Text
    movedTo })) =
                Text
    sym1 Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    sym2 Bool -> Bool -> Bool
    && Maybe Text
    movedTo Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Text
    forall a. Maybe a
    Nothing
            hasSymbol Text
    _ API
    _ = Bool
    False

    genAPI :: Name -> API -> CodeGen e ()
    genAPI :: forall e. Name -> API -> CodeGen e ()
    genAPI Name
    n (APIConst Constant
    c) = Name -> Constant -> CodeGen e ()
    forall e. Name -> Constant -> CodeGen e ()
    genConstant Name
    n Constant
    c
    genAPI Name
    n (APIFunction Function
    f) = Name -> Function -> CodeGen e ()
    forall e. Name -> Function -> CodeGen e ()
    genFunction Name
    n Function
    f
    genAPI Name
    n (APIEnum Enumeration
    e) = Name -> Enumeration -> CodeGen e ()
    forall e. Name -> Enumeration -> CodeGen e ()
    genEnum Name
    n Enumeration
    e
    genAPI Name
    n (APIFlags Flags
    f) = Name -> Flags -> CodeGen e ()
    forall e. Name -> Flags -> CodeGen e ()
    genFlags Name
    n Flags
    f
    genAPI Name
    n (APICallback Callback
    c) = Name -> Callback -> CodeGen e ()
    forall e. Name -> Callback -> CodeGen e ()
    genCallback Name
    n Callback
    c
    genAPI Name
    n (APIStruct Struct
    s) = Name -> Struct -> CodeGen e ()
    forall e. Name -> Struct -> CodeGen e ()
    genStruct Name
    n Struct
    s
    genAPI Name
    n (APIUnion Union
    u) = Name -> Union -> CodeGen e ()
    forall e. Name -> Union -> CodeGen e ()
    genUnion Name
    n Union
    u
    genAPI Name
    n (APIObject Object
    o) = Name -> Object -> CodeGen e ()
    forall e. Name -> Object -> CodeGen e ()
    genObject Name
    n Object
    o
    genAPI Name
    n (APIInterface Interface
    i) = Name -> Interface -> CodeGen e ()
    forall e. Name -> Interface -> CodeGen e ()
    genInterface Name
    n Interface
    i

    -- | Generate the code for a given API in the corresponding module.
    genAPIModule :: Name -> API -> CodeGen e ()
    genAPIModule :: forall e. Name -> API -> CodeGen e ()
    genAPIModule Name
    n API
    api = ModulePath -> CodeGen e () -> CodeGen e ()
    forall e. ModulePath -> CodeGen e () -> CodeGen e ()
    submodule (Name -> API -> ModulePath
    submoduleLocation Name
    n API
    api) (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Name -> API -> CodeGen e ()
    forall e. Name -> API -> CodeGen e ()
    genAPI Name
    n API
    api

    genModule' :: M.Map Name API -> CodeGen e ()
    genModule' :: forall e. Map Name API -> CodeGen e ()
    genModule' Map Name API
    apis = do
      ((Name, API)
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> [(Name, API)]
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Name
     -> API
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> (Name, API)
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Name
    -> API
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> API -> CodeGen e ()
    genAPIModule)
        -- We provide these ourselves
        ([(Name, API)]
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> [(Name, API)]
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> Bool) -> [(Name, API)] -> [(Name, API)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ((Name, API) -> Bool) -> (Name, API) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, API) -> Bool
    handWritten)
        -- Some callback types are defined inside structs
        ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    fixAPIStructs
        -- Some APIs contain duplicated fields by mistake, drop
        -- the duplicates.
        ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    dropDuplicatedFields
        ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> Maybe (Name, API))
    -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((API -> Maybe API) -> (Name, API) -> Maybe (Name, API)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> (Name, a) -> f (Name, b)
    traverse API -> Maybe API
    dropMovedItems)
        ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ Map Name API -> [(Name, API)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Name API
    apis

      -- Make sure we generate a "Callbacks" module, since it is imported
      -- by other modules. It is fine if it ends up empty.
      ModulePath
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. ModulePath -> CodeGen e () -> CodeGen e ()
    submodule ModulePath
    "Callbacks" (()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
      where
        -- Whether we provide hand-written bindings for the given API,
        -- replacing the ones that would be autogenerated from the
        -- introspection data.
        handWritten :: (Name, API) -> Bool
        handWritten :: (Name, API) -> Bool
    handWritten (Name Text
    "GLib" Text
    "Array", API
    _) = Bool
    True
        handWritten (Name Text
    "GLib" Text
    "Error", API
    _) = Bool
    True
        handWritten (Name Text
    "GLib" Text
    "HashTable", API
    _) = Bool
    True
        handWritten (Name Text
    "GLib" Text
    "List", API
    _) = Bool
    True
        handWritten (Name Text
    "GLib" Text
    "SList", API
    _) = Bool
    True
        handWritten (Name Text
    "GLib" Text
    "Variant", API
    _) = Bool
    True
        handWritten (Name Text
    "GObject" Text
    "Value", API
    _) = Bool
    True
        handWritten (Name Text
    "GObject" Text
    "Closure", API
    _) = Bool
    True
        handWritten (Name, API)
    _ = Bool
    False

    genModule :: M.Map Name API -> CodeGen e ()
    genModule :: forall e. Map Name API -> CodeGen e ()
    genModule Map Name API
    apis = do
      -- Reexport Data.GI.Base for convenience (so it does not need to be
      -- imported separately).
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line Text
    "import Data.GI.Base"
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    exportModule Text
    "Data.GI.Base"

      -- Some API symbols are embedded into structures, extract these and
      -- inject them into the set of APIs loaded and being generated.
      let embeddedAPIs :: Map Name API
    embeddedAPIs = (Map Name API -> Map Name API
    fixAPIs (Map Name API -> Map Name API)
    -> (Map Name API -> Map Name API) -> Map Name API -> Map Name API
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Name, API)] -> Map Name API
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList
                         ([(Name, API)] -> Map Name API)
    -> (Map Name API -> [(Name, API)]) -> Map Name API -> Map Name API
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Name, API) -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Name, API) -> [(Name, API)]
    extractCallbacksInStruct
                         ([(Name, API)] -> [(Name, API)])
    -> (Map Name API -> [(Name, API)]) -> Map Name API -> [(Name, API)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Name API -> [(Name, API)]
    forall k a. Map k a -> [(k, a)]
    M.toList) Map Name API
    apis
      allAPIs <- CodeGen e (Map Name API)
    forall e. CodeGen e (Map Name API)
    getAPIs
      let contextAPIs = Map Name API -> Map Name API -> Map Name API
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union (Map Name API -> Map Name API
    fixAPIs Map Name API
    allAPIs) Map Name API
    embeddedAPIs
          targetAPIs = Map Name API -> Map Name API -> Map Name API
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union (Map Name API -> Map Name API
    fixAPIs Map Name API
    apis) Map Name API
    embeddedAPIs

      recurseWithAPIs contextAPIs (genModule' targetAPIs)

      where
        fixAPIs :: M.Map Name API -> M.Map Name API
        fixAPIs :: Map Name API -> Map Name API
    fixAPIs Map Name API
    apis = [(Name, API)] -> Map Name API
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList
          -- Try to guess nullability of properties when there is no
          -- nullability info in the GIR.
          ([(Name, API)] -> Map Name API) -> [(Name, API)] -> Map Name API
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    guessPropertyNullability
          -- Not every interface providing signals or properties is
          -- correctly annotated as descending from GObject, fix this.
          ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    detectGObject
          -- Make sure that every argument marked as being a
          -- destructor for a user_data argument has an associated
          -- user_data argument.
          ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    checkClosureDestructors
          -- Make sure that the argClosure argument refers to a callback,
          -- not to the user_data field.
          ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    fixClosures
          -- Make sure that the user_data argument of callbacks is
          -- annotated as such.
          ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    fixCallbackUserData
          -- Make sure that the symbols to be generated are valid
          -- Haskell identifiers, when necessary.
          ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, API) -> (Name, API)
    fixSymbolNaming
          ([(Name, API)] -> [(Name, API)]) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> a -> b
    $ Map Name API -> [(Name, API)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Name API
    apis