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)
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)
import Data.GI.CodeGen.Type
import Data.GI.CodeGen.Util (tshow)

genFunction :: Name -> Function -> CodeGen ()
genFunction :: Name -> Function -> CodeGen ()
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. BaseCodeGen e a -> BaseCodeGen 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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 -> CodeGen ()) -> ExcCodeGen () -> CodeGen ()
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc (\CGError
e -> do
                        Text -> CodeGen ()
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 -> CodeGen ()
printCGError CGError
e)
                        (do
                          Name -> Text -> Callable -> ExcCodeGen ()
genCCallableWrapper Name
n Text
symbol Callable
callable
                          HaddockSection -> Text -> CodeGen ()
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 ()
genNewtype :: Text -> CodeGen ()
genNewtype Text
name' = do
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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
")"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"deriving (Eq)"

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
genStruct :: Name -> Struct -> CodeGen ()
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 -> CodeGen ()
writeHaddock RelativeDocPosition
DocBeforeSymbol (Text
"Memory-managed wrapper type.")
   Text -> CodeGen ()
genNewtype Text
name'
   Text -> CodeGen ()
exportDecl (Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"(..)"))

   HaddockSection -> Documentation -> CodeGen ()
addSectionDocumentation HaddockSection
ToplevelSection (Struct -> Documentation
structDocumentation Struct
s)

   if Struct -> Bool
structIsBoxed Struct
s
   then Name -> Text -> CodeGen ()
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 -> CodeGen ()
genWrappedPtr Name
n (Struct -> AllocationInfo
structAllocationInfo Struct
s) (Struct -> Int
structSize Struct
s)

   -- Generate a builder for a structure filled with zeroes.
   Name -> Struct -> CodeGen ()
genZeroStruct Name
n Struct
s

   -- Generate code for fields.
   Name -> [Field] -> CodeGen ()
genStructOrUnionFields Name
n (Struct -> [Field]
structFields Struct
s)

   -- Methods
   [Maybe (Name, Method)]
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
       Bool
isFunction <- Text -> CodeGen Bool
symbolFromFunction (Method -> Text
methodSymbol Method
f)
       if Bool -> Bool
not Bool
isFunction
       then (CGError -> CodeGen (Maybe (Name, Method)))
-> ExcCodeGen (Maybe (Name, Method))
-> CodeGen (Maybe (Name, Method))
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc
               (\CGError
e -> do Text -> CodeGen ()
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 ()
printCGError CGError
e
                         Maybe (Name, Method) -> BaseCodeGen e (Maybe (Name, Method))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Name, Method)
forall a. Maybe a
Nothing)
               (Name -> Method -> ExcCodeGen ()
genMethod Name
n Method
f ExcCodeGen ()
-> ExcCodeGen (Maybe (Name, Method))
-> ExcCodeGen (Maybe (Name, Method))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Name, Method) -> ExcCodeGen (Maybe (Name, Method))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name, Method) -> Maybe (Name, Method)
forall a. a -> Maybe a
Just (Name
n, Method
f)))
       else Maybe (Name, Method)
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe (Name, Method))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Name, Method)
forall a. Maybe a
Nothing

   -- Overloaded methods
   CPPGuard
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (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
$
        Name -> [(Name, Method)] -> CodeGen ()
genMethodList Name
n ([Maybe (Name, Method)] -> [(Name, Method)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Name, Method)]
methods)

-- | Generated wrapper for unions.
genUnion :: Name -> Union -> CodeGen ()
genUnion :: Name -> Union -> CodeGen ()
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 ()
writeHaddock RelativeDocPosition
DocBeforeSymbol (Text
"Memory-managed wrapper type.")
  Text -> CodeGen ()
genNewtype Text
name'
  Text -> CodeGen ()
exportDecl (Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(..)")

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

  if Union -> Bool
unionIsBoxed Union
u
  then Name -> Text -> CodeGen ()
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 ()
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 ()
genZeroUnion Name
n Union
u

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

  -- Methods
  [Maybe (Name, Method)]
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
      Bool
isFunction <- Text -> CodeGen Bool
symbolFromFunction (Method -> Text
methodSymbol Method
f)
      if Bool -> Bool
not Bool
isFunction
      then (CGError -> CodeGen (Maybe (Name, Method)))
-> ExcCodeGen (Maybe (Name, Method))
-> CodeGen (Maybe (Name, Method))
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc
                (\CGError
e -> do Text -> CodeGen ()
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 ()
printCGError CGError
e
                          Maybe (Name, Method) -> BaseCodeGen e (Maybe (Name, Method))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Name, Method)
forall a. Maybe a
Nothing)
                (Name -> Method -> ExcCodeGen ()
genMethod Name
n Method
f ExcCodeGen ()
-> ExcCodeGen (Maybe (Name, Method))
-> ExcCodeGen (Maybe (Name, Method))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Name, Method) -> ExcCodeGen (Maybe (Name, Method))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name, Method) -> Maybe (Name, Method)
forall a. a -> Maybe a
Just (Name
n, Method
f)))
      else Maybe (Name, Method)
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe (Name, Method))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Name, Method)
forall a. Maybe a
Nothing

  -- Overloaded methods
  CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
       Name -> [(Name, Method)] -> CodeGen ()
genMethodList Name
n ([Maybe (Name, Method)] -> [(Name, Method)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Name, Method)]
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 :: [Arg]
args = [Arg]
args'' , returnType :: Maybe Type
returnType = Maybe Type
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'' = Arg -> Arg
fixInstance ([Arg] -> Arg
forall a. [a] -> a
head [Arg]
args') Arg -> [Arg] -> [Arg]
forall a. a -> [a] -> [a]
: [Arg] -> [Arg]
forall a. [a] -> [a]
tail [Arg]
args'

      fixLengthArg :: Arg -> Arg
      fixLengthArg :: Arg -> Arg
fixLengthArg Arg
arg = Arg
arg { argType :: Type
argType = Type -> Type
fixCArrayLength (Arg -> Type
argType Arg
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 :: Int
argDestroy = Int
destroy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Int
argClosure = Int
closure Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
                        else Arg
arg

      -- We always treat the instance argument of a method as non-null
      -- and "in", even if sometimes the introspection data may say
      -- otherwise.
      fixInstance :: Arg -> Arg
      fixInstance :: Arg -> Arg
fixInstance Arg
arg = Arg
arg { mayBeNull :: Bool
mayBeNull = Bool
False
                            , direction :: Direction
direction = 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 :: Maybe Type
returnType = Maybe Type
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
    Bool
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False) Type
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Bool
Type -> CodeGen Bool
isGObject (Callable -> Maybe Type
returnType Callable
c)
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"-- 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
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"-- method type : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MethodType -> Text
forall a. Show a => a -> Text
tshow MethodType
t
    let -- Mangle the name to namespace it to the class.
        mn' :: Name
mn' = Name
mn { name :: Text
name = Name -> Text
name Name
cn 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 }
    let c' :: Callable
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'' :: Callable
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'
    Name -> Text -> Callable -> ExcCodeGen ()
genCCallableWrapper Name
mn' Text
sym Callable
c''
    HaddockSection -> Text -> CodeGen ()
export (NamedSection -> Text -> HaddockSection
NamedSubsection NamedSection
MethodSection (Text -> HaddockSection) -> Text -> HaddockSection
forall a b. (a -> b) -> a -> b
$ Name -> Text
lowerName Name
mn) (Name -> Text
lowerName Name
mn')

    CPPGuard -> ExcCodeGen () -> ExcCodeGen ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$
         Name -> Method -> ExcCodeGen ()
genMethodInfo Name
cn (Method
m {methodCallable :: Callable
methodCallable = Callable
c''})

-- | Generate the GValue instances for the given GObject.
genGObjectGValueInstance :: Name -> Text -> CodeGen ()
genGObjectGValueInstance :: Name -> Text -> CodeGen ()
genGObjectGValueInstance Name
n Text
get_type_fn = do
  let name' :: Text
name' = Name -> Text
upperName Name
n
      doc :: Text
doc = Text
"Convert '" 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 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."

  RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
DocBeforeSymbol Text
doc

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance B.GValue.IsGValue " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"toGValue o = do"
      BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"gtype <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
get_type_fn
        Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"B.ManagedPtr.withManagedPtr o (B.GValue.buildGValue gtype B.GValue.set_object)"
      Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"fromGValue gv = do"
      BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"ptr <- B.GValue.get_object gv :: IO (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 ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"B.ManagedPtr.newObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ptr"

-- Type casting with type checking
genCasts :: Name -> Text -> [Name] -> CodeGen ()
genCasts :: Name -> Text -> [Name] -> CodeGen ()
genCasts Name
n Text
ti [Name]
parents = do
  Bool
isGO <- Type -> CodeGen Bool
isGObject (Name -> Type
TInterface Name
n)
  let name' :: Text
name' = Name -> Text
upperName Name
n

  Text
get_type_fn <- do
    let cn_ :: Text
cn_ = Text
"c_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ti
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"foreign import ccall \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ti Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
      BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
cn_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: IO B.Types.GType"
    Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
cn_

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance B.Types.TypedObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"glibType = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
get_type_fn

  Bool -> BaseCodeGen e () -> BaseCodeGen e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGO (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance B.Types.GObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'

  Bool -> BaseCodeGen e () -> BaseCodeGen e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGO (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Name -> Text -> CodeGen ()
genGObjectGValueInstance Name
n Text
get_type_fn

  Text
className <- Name -> CodeGen Text
classConstraint Name
n
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
exportDecl Text
className
    RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
DocBeforeSymbol (Text -> Text
classDoc Text
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 :: Text
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)"
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"class " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
className Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" o"
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
className Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" o"

    BaseCodeGen e ()
CodeGen ()
blank

    [API]
parentAPIs <- (Name
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) API)
-> [Name]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [API]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Name
n -> HasCallStack => Type -> CodeGen API
Type -> CodeGen API
getAPI (Name -> Type
TInterface Name
n)) [Name]
parents
    [Text]
qualifiedParents <- ((API, Name)
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text)
-> [(API, Name)]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((API
 -> Name
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text)
-> (API, Name)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry API
-> Name
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
API -> Name -> CodeGen Text
qualifiedAPI) ([API] -> [Name] -> [(API, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip [API]
parentAPIs [Name]
parents)
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance O.HasParentTypes " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"type instance O.ParentTypes " 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 -> [Text] -> Text
T.intercalate Text
", " [Text]
qualifiedParents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

  -- Safe downcasting.
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    let safeCast :: Text
safeCast = Text
"to" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'
    Text -> CodeGen ()
exportDecl Text
safeCast
    RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
DocBeforeSymbol (Text -> Text
castDoc Text
name')
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
safeCast Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: (MonadIO m, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
className Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" o) => o -> m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
safeCast Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = liftIO . unsafeCastTo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'

  where castDoc :: Text -> Text
        castDoc :: Text -> Text
castDoc Text
name' = Text
"Cast to `" 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 `"
                         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 ()
genObject :: Name -> Object -> CodeGen ()
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
  Bool
isGO <- Type -> CodeGen Bool
isGObject Type
t

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

  HaddockSection -> Documentation -> CodeGen ()
addSectionDocumentation HaddockSection
ToplevelSection (Object -> Documentation
objDocumentation Object
o)

  -- Type safe casting to parent objects, and implemented interfaces.
  [Name]
parents <- Name -> CodeGen [Name]
instanceTree Name
n
  Name -> Text -> [Name] -> CodeGen ()
genCasts Name
n (Object -> Text
objTypeInit Object
o) ([Name]
parents [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Object -> [Name]
objInterfaces Object
o)

  CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
       Name -> Object -> CodeGen [(Name, Method)]
fullObjectMethodList Name
n Object
o BaseCodeGen e [(Name, Method)]
-> ([(Name, Method)] -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> [(Name, Method)] -> CodeGen ()
genMethodList Name
n

  if Bool
isGO
    then do
      [Signal] -> (Signal -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Object -> [Signal]
objSignals Object
o) ((Signal -> BaseCodeGen e ()) -> BaseCodeGen e ())
-> (Signal -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ \Signal
s -> Signal -> Name -> CodeGen ()
genSignal Signal
s Name
n

      Name -> Object -> CodeGen ()
genObjectProperties Name
n Object
o
      CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
        Name -> [Property] -> [Method] -> CodeGen ()
genNamespacedPropLabels Name
n (Object -> [Property]
objProperties Object
o) (Object -> [Method]
objMethods Object
o)
      CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
        Name -> Object -> CodeGen ()
genObjectSignals Name
n Object
o
    else BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
      let allocInfo :: AllocationInfo
allocInfo = AllocationInfo :: AllocationOp -> AllocationOp -> AllocationOp -> AllocationInfo
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
            }
      Name -> AllocationInfo -> Int -> CodeGen ()
genWrappedPtr Name
n AllocationInfo
allocInfo Int
0

  -- Methods
  [Method] -> (Method -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Object -> [Method]
objMethods Object
o) ((Method -> BaseCodeGen e ()) -> BaseCodeGen e ())
-> (Method -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ \Method
f -> do
    let mn :: Name
mn = Method -> Name
methodName Method
f
    (CGError -> CodeGen ()) -> ExcCodeGen () -> CodeGen ()
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc (\CGError
e -> do Text -> CodeGen ()
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 ()
printCGError CGError
e
                          CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
                            Name -> Method -> CodeGen ()
genUnsupportedMethodInfo Name
n Method
f)
                (Name -> Method -> ExcCodeGen ()
genMethod Name
n Method
f)

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

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

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

  Bool
isGO <- Name -> API -> CodeGen Bool
apiIsGObject Name
n (Interface -> API
APIInterface Interface
iface)
  if Bool
isGO
  then do
    let cn_ :: Text
cn_ = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"GObject derived interface without a type!") (Interface -> Maybe Text
ifTypeInit Interface
iface)
    [Name]
gobjectPrereqs <- (Name -> BaseCodeGen e Bool)
-> [Name]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Name -> BaseCodeGen e Bool
Name -> CodeGen Bool
nameIsGObject (Interface -> [Name]
ifPrerequisites Interface
iface)
    [[Name]]
allParents <- [Name]
-> (Name
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name])
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Name]
gobjectPrereqs ((Name
  -> ReaderT
       CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name])
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [[Name]])
-> (Name
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Name])
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [[Name]]
forall a b. (a -> b) -> a -> b
$ \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 -> CodeGen [Name]
instanceTree Name
p
    let uniqueParents :: [Name]
uniqueParents = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
allParents)
    Name -> Text -> [Name] -> CodeGen ()
genCasts Name
n Text
cn_ [Name]
uniqueParents

    Name -> Interface -> CodeGen ()
genInterfaceProperties Name
n Interface
iface
    CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
       Name -> [Property] -> [Method] -> CodeGen ()
genNamespacedPropLabels Name
n (Interface -> [Property]
ifProperties Interface
iface) (Interface -> [Method]
ifMethods Interface
iface)

  else BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text
cls <- Name -> CodeGen Text
classConstraint Name
n
    Text -> CodeGen ()
exportDecl Text
cls
    RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
DocBeforeSymbol (Text
"Type class for types which implement `"
                                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`.")

    -- 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
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)"
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"class " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" o"
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" o"

    Name -> AllocationInfo -> Int -> CodeGen ()
genWrappedPtr Name
n (Interface -> AllocationInfo
ifAllocationInfo Interface
iface) Int
0

    Bool -> BaseCodeGen e () -> BaseCodeGen e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> (Interface -> Bool) -> Interface -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Property] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Property] -> Bool)
-> (Interface -> [Property]) -> Interface -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> [Property]
ifProperties (Interface -> Bool) -> Interface -> Bool
forall a b. (a -> b) -> a -> b
$ Interface
iface) (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
       Text -> CodeGen ()
comment (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"XXX Skipping property generation for non-GObject interface"

  -- Methods
  CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
       Name -> Interface -> CodeGen [(Name, Method)]
fullInterfaceMethodList Name
n Interface
iface BaseCodeGen e [(Name, Method)]
-> ([(Name, Method)] -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> [(Name, Method)] -> CodeGen ()
genMethodList Name
n

  [Method] -> (Method -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Interface -> [Method]
ifMethods Interface
iface) ((Method -> BaseCodeGen e ()) -> BaseCodeGen e ())
-> (Method -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ \Method
f -> do
      let mn :: Name
mn = Method -> Name
methodName Method
f
      Bool
isFunction <- Text -> CodeGen Bool
symbolFromFunction (Method -> Text
methodSymbol Method
f)
      Bool -> BaseCodeGen e () -> BaseCodeGen e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFunction (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
             (CGError -> CodeGen ()) -> ExcCodeGen () -> CodeGen ()
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc
             (\CGError
e -> do Text -> CodeGen ()
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 ()
printCGError CGError
e
                       CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (Name -> Method -> CodeGen ()
genUnsupportedMethodInfo Name
n Method
f))
             (Name -> Method -> ExcCodeGen ()
genMethod Name
n Method
f)

  -- Signals
  [Signal] -> (Signal -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Interface -> [Signal]
ifSignals Interface
iface) ((Signal -> BaseCodeGen e ()) -> BaseCodeGen e ())
-> (Signal -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ \Signal
s -> (CGError -> CodeGen ()) -> ExcCodeGen () -> CodeGen ()
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc
     (\CGError
e -> do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
printCGError CGError
e)
     (Signal -> Name -> CodeGen ()
genSignal Signal
s Name
n)

  CPPGuard -> BaseCodeGen e () -> BaseCodeGen e ()
forall e a. CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
cppIf CPPGuard
CPPOverloading (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$
     Name -> Interface -> CodeGen ()
genInterfaceSignals Name
n Interface
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 Bool
symbolFromFunction :: Text -> CodeGen Bool
symbolFromFunction Text
sym = do
    Map Name API
apis <- BaseCodeGen e (Map Name API)
CodeGen (Map Name API)
getAPIs
    Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> BaseCodeGen e Bool) -> Bool -> BaseCodeGen e Bool
forall a b. (a -> b) -> a -> b
$ ((Name, API) -> Bool) -> [(Name, API)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> API -> Bool
hasSymbol Text
sym (API -> Bool) -> ((Name, API) -> API) -> (Name, API) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, API) -> API
forall a b. (a, b) -> b
snd) ([(Name, API)] -> Bool) -> [(Name, API)] -> Bool
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
    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 ()
genAPI :: Name -> API -> CodeGen ()
genAPI Name
n (APIConst Constant
c) = Name -> Constant -> CodeGen ()
genConstant Name
n Constant
c
genAPI Name
n (APIFunction Function
f) = Name -> Function -> CodeGen ()
genFunction Name
n Function
f
genAPI Name
n (APIEnum Enumeration
e) = Name -> Enumeration -> CodeGen ()
genEnum Name
n Enumeration
e
genAPI Name
n (APIFlags Flags
f) = Name -> Flags -> CodeGen ()
genFlags Name
n Flags
f
genAPI Name
n (APICallback Callback
c) = Name -> Callback -> CodeGen ()
genCallback Name
n Callback
c
genAPI Name
n (APIStruct Struct
s) = Name -> Struct -> CodeGen ()
genStruct Name
n Struct
s
genAPI Name
n (APIUnion Union
u) = Name -> Union -> CodeGen ()
genUnion Name
n Union
u
genAPI Name
n (APIObject Object
o) = Name -> Object -> CodeGen ()
genObject Name
n Object
o
genAPI Name
n (APIInterface Interface
i) = Name -> Interface -> CodeGen ()
genInterface Name
n Interface
i

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

genModule' :: M.Map Name API -> CodeGen ()
genModule' :: Map Name API -> CodeGen ()
genModule' Map Name API
apis = do
  ((Name, API) -> BaseCodeGen e ())
-> [(Name, API)] -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Name -> API -> BaseCodeGen e ())
-> (Name, API) -> BaseCodeGen e ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> API -> BaseCodeGen e ()
Name -> API -> CodeGen ()
genAPIModule)
    -- We provide these ourselves
    ([(Name, API)] -> BaseCodeGen e ())
-> [(Name, API)] -> BaseCodeGen 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)
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 -> BaseCodeGen e () -> BaseCodeGen e ()
forall e. ModulePath -> BaseCodeGen e () -> BaseCodeGen e ()
submodule ModulePath
"Callbacks" (() -> BaseCodeGen e ()
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 ()
genModule :: Map Name API -> CodeGen ()
genModule Map Name API
apis = do
  -- Reexport Data.GI.Base for convenience (so it does not need to be
  -- imported separately).
  Text -> CodeGen ()
line Text
"import Data.GI.Base"
  Text -> CodeGen ()
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
  Map Name API
allAPIs <- BaseCodeGen e (Map Name API)
CodeGen (Map Name API)
getAPIs
  let contextAPIs :: Map Name API
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
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

  Map Name API -> CodeGen () -> CodeGen ()
recurseWithAPIs Map Name API
contextAPIs (Map Name API -> CodeGen ()
genModule' Map Name API
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 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