    -- | Marshalling of structs and unions.
    module Data.GI.CodeGen.Struct ( genStructOrUnionFields
                                  , genZeroStruct
                                  , genZeroUnion
                                  , extractCallbacksInStruct
                                  , fixAPIStructs
                                  , ignoreStruct
                                  , genBoxed
                                  , genWrappedPtr
                                  ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    #endif
    import Control.Monad (forM, when)

    import Data.Maybe (mapMaybe, isJust, catMaybes)
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif
    import Data.Text (Text)
    import qualified Data.Text as T

    import Data.GI.CodeGen.API
    import Data.GI.CodeGen.Conversions
    import Data.GI.CodeGen.Code
    import Data.GI.CodeGen.Haddock (addSectionDocumentation, writeHaddock,
                                    RelativeDocPosition(DocBeforeSymbol))
    import Data.GI.CodeGen.ModulePath (dotModulePath)
    import Data.GI.CodeGen.SymbolNaming (upperName, lowerName,
                                         underscoresToCamelCase,
                                         qualifiedSymbol,
                                         callbackHaskellToForeign,
                                         callbackWrapperAllocator,
                                         haddockAttrAnchor, moduleLocation,
                                         hackageModuleLink,
                                         normalizedAPIName)

    import Data.GI.CodeGen.Type
    import Data.GI.CodeGen.Util

    -- | Whether (not) to generate bindings for the given struct.
    ignoreStruct :: Name -> Struct -> Bool
    ignoreStruct :: Name -> Struct -> Bool
    ignoreStruct (Name Text
    _ Text
    name) Struct
    s = (Maybe Name -> Bool
    forall a. Maybe a -> Bool
    isJust (Struct -> Maybe Name
    gtypeStructFor Struct
    s) Bool -> Bool -> Bool
    ||
                                   Text
    "Private" Text -> Text -> Bool
    `T.isSuffixOf` Text
    name) Bool -> Bool -> Bool
    &&
                                   (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Struct -> Bool
    structForceVisible Struct
    s)

    -- | Whether the given type corresponds to an ignored struct.
    isIgnoredStructType :: Type -> CodeGen e Bool
    isIgnoredStructType :: forall e. Type -> CodeGen e Bool
    isIgnoredStructType Type
    t =
      case Type
    t of
        TInterface Name
    n -> do
          api <- Type -> CodeGen e API
    forall e. HasCallStack => Type -> CodeGen e API
    getAPI Type
    t
          case api of
            APIStruct Struct
    s -> Bool -> CodeGen e Bool
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Struct -> Bool
    ignoreStruct Name
    n Struct
    s)
            API
    _ -> Bool -> CodeGen e Bool
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        Type
    _ -> Bool -> CodeGen e Bool
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | Canonical name for the type of a callback type embedded in a
    -- struct field.
    fieldCallbackType :: Text -> Field -> Text
    fieldCallbackType :: Text -> Field -> Text
    fieldCallbackType Text
    structName Field
    field =
        Text
    structName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (Text -> Text
    underscoresToCamelCase (Text -> Text) -> (Field -> Text) -> Field -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Field -> Text
    fieldName) Field
    field Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "FieldCallback"

    -- | Fix the interface names of callback fields in the struct to
    -- correspond to the ones that we are going to generate.
    fixCallbackStructFields :: Name -> Struct -> Struct
    fixCallbackStructFields :: Name -> Struct -> Struct
    fixCallbackStructFields (Name Text
    ns Text
    structName) Struct
    s = Struct
    s {structFields = fixedFields}
        where fixedFields :: [Field]
              fixedFields :: [Field]
    fixedFields = (Field -> Field) -> [Field] -> [Field]
    forall a b. (a -> b) -> [a] -> [b]
    map Field -> Field
    fixField (Struct -> [Field]
    structFields Struct
    s)

              fixField :: Field -> Field
              fixField :: Field -> Field
    fixField Field
    field =
                  case Field -> Maybe Callback
    fieldCallback Field
    field of
                    Maybe Callback
    Nothing -> Field
    field
                    Just Callback
    _ -> let n' :: Text
    n' = Text -> Field -> Text
    fieldCallbackType Text
    structName Field
    field
                              in Field
    field {fieldType = TInterface (Name ns n')}

    -- | Fix the interface names of callback fields in an APIStruct to
    -- correspond to the ones that we are going to generate. If something
    -- other than an APIStruct is passed in we don't touch it.
    fixAPIStructs :: (Name, API) -> (Name, API)
    fixAPIStructs :: (Name, API) -> (Name, API)
    fixAPIStructs (Name
    n, APIStruct Struct
    s) = (Name
    n, Struct -> API
    APIStruct (Struct -> API) -> Struct -> API
    forall a b. (a -> b) -> a -> b
    $ Name -> Struct -> Struct
    fixCallbackStructFields Name
    n Struct
    s)
    fixAPIStructs (Name, API)
    api = (Name, API)
    api

    -- | Extract the callback types embedded in the fields of structs, and
    -- at the same time fix the type of the corresponding fields. Returns
    -- the list of APIs associated to this struct, not including the
    -- struct itself.
    extractCallbacksInStruct :: (Name, API) -> [(Name, API)]
    extractCallbacksInStruct :: (Name, API) -> [(Name, API)]
    extractCallbacksInStruct (n :: Name
    n@(Name Text
    ns Text
    structName), APIStruct Struct
    s)
        | Name -> Struct -> Bool
    ignoreStruct Name
    n Struct
    s = []
        | Bool
    otherwise =
            (Field -> Maybe (Name, API)) -> [Field] -> [(Name, API)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Field -> Maybe (Name, API)
    callbackInField (Struct -> [Field]
    structFields Struct
    s)
                where callbackInField :: Field -> Maybe (Name, API)
                      callbackInField :: Field -> Maybe (Name, API)
    callbackInField Field
    field = do
                        callback <- Field -> Maybe Callback
    fieldCallback Field
    field
                        let n' = Text -> Field -> Text
    fieldCallbackType Text
    structName Field
    field
                        return (Name ns n', APICallback callback)
    extractCallbacksInStruct (Name, API)
    _ = []

    -- | The name of the type encoding the information for a field in a
    -- struct/union.
    infoType :: Name -> Field -> CodeGen e Text
    infoType :: forall e. Name -> Field -> CodeGen e Text
    infoType Name
    owner Field
    field = do
      let name :: Text
    name = Name -> Text
    upperName Name
    owner
      let fName :: Text
    fName = (Text -> Text
    underscoresToCamelCase (Text -> Text) -> (Field -> Text) -> Field -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Field -> Text
    fieldName) Field
    field
      Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text)
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall a b. (a -> b) -> a -> b
    $ Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    fName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "FieldInfo"

    -- | Whether a given field is an embedded struct/union.
    isEmbedded :: Field -> ExcCodeGen Bool
    isEmbedded :: Field -> ExcCodeGen Bool
    isEmbedded Field
    field = do
      api <- Type -> CodeGen CGError (Maybe API)
    forall e. HasCallStack => Type -> CodeGen e (Maybe API)
    findAPI (Field -> Type
    fieldType Field
    field)
      case api of
        Just (APIStruct Struct
    _) -> ExcCodeGen Bool
    checkEmbedding
        Just (APIUnion Union
    _) -> ExcCodeGen Bool
    checkEmbedding
        Maybe API
    _ -> Bool -> ExcCodeGen Bool
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where
        checkEmbedding :: ExcCodeGen Bool
        checkEmbedding :: ExcCodeGen Bool
    checkEmbedding = case Field -> Maybe Bool
    fieldIsPointer Field
    field of
          Maybe Bool
    Nothing -> Text -> ExcCodeGen Bool
    forall a. Text -> ExcCodeGen a
    badIntroError Text
    "Cannot determine whether the field is embedded."
          Just Bool
    isPtr -> Bool -> ExcCodeGen Bool
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Bool
    not Bool
    isPtr)

    -- | Name for the getter function
    fieldGetter :: Name -> Field -> Text
    fieldGetter :: Name -> Field -> Text
    fieldGetter Name
    name' Field
    field = Text
    "get" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    upperName Name
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    fName Field
    field

    -- | Generate documentation for the given getter.
    getterDoc :: Name -> Field -> Text
    getterDoc :: Name -> Field -> Text
    getterDoc Name
    n Field
    field = [Text] -> Text
    T.unlines [
        Text
    "Get the value of the “@" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    fieldName Field
    field Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "@” field."
      , Text
    "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"
      , Text
    ""
      , Text
    "@"
      , Text
    "'Data.GI.Base.Attributes.get' " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    lowerName Name
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " #" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    labelName Field
    field
      , Text
    "@"]

    -- Notice that when reading the field we return a copy of any embedded
    -- structs, so modifications of the returned struct will not affect
    -- the original struct. This is on purpose, in order to increase
    -- safety (otherwise the garbage collector may decide to free the
    -- parent structure while we are modifying the embedded one, and havoc
    -- will ensue).
    -- | Extract a field from a struct.
    buildFieldReader :: Name -> Field -> ExcCodeGen ()
    buildFieldReader :: Name -> Field -> ExcCodeGen ()
    buildFieldReader Name
    n Field
    field = ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n
          getter :: Text
    getter = Name -> Field -> Text
    fieldGetter Name
    n Field
    field

      embedded <- Field -> ExcCodeGen Bool
    isEmbedded Field
    field
      nullConvert <- if embedded
                     then return Nothing
                     else maybeNullConvert (fieldType field)
      hType <- typeShow <$> if isJust nullConvert
                            then maybeT <$> isoHaskellType (fieldType field)
                            else isoHaskellType (fieldType field)
      fType <- typeShow <$> foreignType (fieldType field)

      writeHaddock DocBeforeSymbol (getterDoc n field)

      line $ getter <> " :: MonadIO m => " <> name' <> " -> m " <>
                  if T.any (== ' ') hType
                  then parenthesize hType
                  else hType
      line $ getter <> " s = liftIO $ withManagedPtr s $ \\ptr -> do"
      indent $ do
        let peekedType = if (Char -> Bool) -> Text -> Bool
    T.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') Text
    fType
                         then Text -> Text
    parenthesize Text
    fType
                         else Text
    fType
        if embedded
        then line $ "let val = ptr `plusPtr` " <> tshow (fieldOffset field)
                 <> " :: " <> peekedType
        else line $ "val <- peek (ptr `plusPtr` " <> tshow (fieldOffset field)
                 <> ") :: IO " <> peekedType
        result <- case nullConvert of
                  Maybe Text
    Nothing -> Text
    -> CodeGen CGError Converter
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall e. Text -> CodeGen e Converter -> CodeGen e Text
    convert Text
    "val" (CodeGen CGError Converter
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text)
    -> CodeGen CGError Converter
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall a b. (a -> b) -> a -> b
    $ Type -> Transfer -> CodeGen CGError Converter
    fToH (Field -> Type
    fieldType Field
    field) Transfer
    TransferNothing
                  Just Text
    nullConverter -> do
                    Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "result <- " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    nullConverter Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " val $ \\val' -> do"
                    ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
                      val' <- Text
    -> CodeGen CGError Converter
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall e. Text -> CodeGen e Converter -> CodeGen e Text
    convert Text
    "val'" (CodeGen CGError Converter
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text)
    -> CodeGen CGError Converter
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall a b. (a -> b) -> a -> b
    $ Type -> Transfer -> CodeGen CGError Converter
    fToH (Field -> Type
    fieldType Field
    field) Transfer
    TransferNothing
                      line $ "return " <> val'
                    Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    "result"
        line $ "return " <> result

    -- | Name for the setter function
    fieldSetter :: Name -> Field -> Text
    fieldSetter :: Name -> Field -> Text
    fieldSetter Name
    name' Field
    field = Text
    "set" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    upperName Name
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    fName Field
    field

    -- | Generate documentation for the given setter.
    setterDoc :: Name -> Field -> Text
    setterDoc :: Name -> Field -> Text
    setterDoc Name
    n Field
    field = [Text] -> Text
    T.unlines [
        Text
    "Set the value of the “@" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    fieldName Field
    field Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "@” field."
      , Text
    "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"
      , Text
    ""
      , Text
    "@"
      , Text
    "'Data.GI.Base.Attributes.set' " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    lowerName Name
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " [ #" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    labelName Field
    field
        Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " 'Data.GI.Base.Attributes.:=' value ]"
      , Text
    "@"]

    -- | Write a field into a struct. Note that, since we cannot know for
    -- sure who will be deallocating the fields in the struct, we leave
    -- any conversions that involve pointers to the caller. What this
    -- means in practice is that scalar fields will get marshalled to/from
    -- Haskell, while anything that involves pointers will be returned in
    -- the C representation.
    buildFieldWriter :: Name -> Field -> ExcCodeGen ()
    buildFieldWriter :: Name -> Field -> ExcCodeGen ()
    buildFieldWriter Name
    n Field
    field = ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n
      let setter :: Text
    setter = Name -> Field -> Text
    fieldSetter Name
    n Field
    field

      isPtr <- Type -> ExcCodeGen Bool
    forall e. Type -> CodeGen e Bool
    typeIsPtr (Field -> Type
    fieldType Field
    field)

      fType <- typeShow <$> foreignType (fieldType field)
      hType <- if isPtr
               then return fType
               else typeShow <$> haskellType (fieldType field)

      writeHaddock DocBeforeSymbol (setterDoc n field)

      line $ setter <> " :: MonadIO m => " <> name' <> " -> "
               <> hType <> " -> m ()"
      line $ setter <> " s val = liftIO $ withManagedPtr s $ \\ptr -> do"
      indent $ do
        converted <- if isPtr
                     then return "val"
                     else convert "val" $ hToF (fieldType field) TransferNothing
        line $ "poke (ptr `plusPtr` " <> tshow (fieldOffset field)
             <> ") (" <> converted <> " :: " <> fType <> ")"

    -- | Name for the clear function
    fieldClear :: Name -> Field -> Text
    fieldClear :: Name -> Field -> Text
    fieldClear Name
    name' Field
    field = Text
    "clear" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    upperName Name
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    fName Field
    field

    -- | Documentation for the @clear@ method.
    clearDoc :: Field -> Text
    clearDoc :: Field -> Text
    clearDoc Field
    field = [Text] -> Text
    T.unlines [
      Text
    "Set the value of the “@" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    fieldName Field
    field Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "@” field to `Nothing`."
      , Text
    "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"
      , Text
    ""
      , Text
    "@"
      , Text
    "'Data.GI.Base.Attributes.clear'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " #" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    labelName Field
    field
      , Text
    "@"]

    -- | Write a @NULL@ into a field of a struct of type `Ptr`.
    buildFieldClear :: Name -> Field -> Text -> ExcCodeGen ()
    buildFieldClear :: Name -> Field -> Text -> ExcCodeGen ()
    buildFieldClear Name
    n Field
    field Text
    nullPtr = ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n
      let clear :: Text
    clear = Name -> Field -> Text
    fieldClear Name
    n Field
    field

      fType <- TypeRep -> Text
    typeShow (TypeRep -> Text)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         TypeRep
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         TypeRep
    forall e. Type -> CodeGen e TypeRep
    foreignType (Field -> Type
    fieldType Field
    field)

      writeHaddock DocBeforeSymbol (clearDoc field)

      line $ clear <> " :: MonadIO m => " <> name' <> " -> m ()"
      line $ clear <> " s = liftIO $ withManagedPtr s $ \\ptr -> do"
      indent $
        line $ "poke (ptr `plusPtr` " <> tshow (fieldOffset field)
             <> ") ("  <> nullPtr <> " :: " <> fType <> ")"

    -- | Return whether the given type corresponds to a callback that does
    -- not throw exceptions. If it is, return the callback itself. See
    -- [Note: Callables that throw] for the reason why we do not try to
    -- wrap callbacks that throw exceptions.
    isRegularCallback :: Type -> CodeGen e (Maybe Callback)
    isRegularCallback :: forall e. Type -> CodeGen e (Maybe Callback)
    isRegularCallback t :: Type
    t@(TInterface Name
    _) = do
      api <- Type -> CodeGen e API
    forall e. HasCallStack => Type -> CodeGen e API
    getAPI Type
    t
      case api of
        APICallback callback :: Callback
    callback@(Callback {cbCallable :: Callback -> Callable
    cbCallable = Callable
    callable}) ->
          if Callable -> Bool
    callableThrows Callable
    callable
          then Maybe Callback
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe Callback)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Callback
    forall a. Maybe a
    Nothing
          else Maybe Callback
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe Callback)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Callback -> Maybe Callback
    forall a. a -> Maybe a
    Just Callback
    callback)
        API
    _ -> Maybe Callback
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe Callback)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Callback
    forall a. Maybe a
    Nothing
    isRegularCallback Type
    _ = Maybe Callback
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe Callback)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Callback
    forall a. Maybe a
    Nothing

    -- | The types accepted by the allocating set function
    -- 'Data.GI.Base.Attributes.(:&=)'.
    fieldTransferTypeConstraint :: Type -> CodeGen e Text
    fieldTransferTypeConstraint :: forall e. Type -> CodeGen e Text
    fieldTransferTypeConstraint Type
    t = do
      isPtr <- Type -> CodeGen e Bool
    forall e. Type -> CodeGen e Bool
    typeIsPtr Type
    t
      maybeRegularCallback <- isRegularCallback t
      inType <- if isPtr && not (isJust maybeRegularCallback)
                then typeShow <$> foreignType t
                else typeShow <$> isoHaskellType t
      return $ "(~)" <> if T.any (== ' ') inType
                        then parenthesize inType
                        else inType

    -- | The type generated by 'Data.GI.Base.attrTransfer' for this
    -- field. This type should satisfy the
    -- 'Data.GI.Base.Attributes.AttrSetTypeConstraint' for the type.
    fieldTransferType :: Type -> CodeGen e Text
    fieldTransferType :: forall e. Type -> CodeGen e Text
    fieldTransferType Type
    t = do
      isPtr <- Type -> CodeGen e Bool
    forall e. Type -> CodeGen e Bool
    typeIsPtr Type
    t
      inType <- if isPtr
                then typeShow <$> foreignType t
                else typeShow <$> haskellType t
      return $ if T.any (== ' ') inType
               then parenthesize inType
               else inType

    -- | Generate the field transfer function, which marshals Haskell
    -- values to types that we can set, even if we need to allocate memory.
    genFieldTransfer :: Text -> Type -> CodeGen e ()
    genFieldTransfer :: forall e. Text -> Type -> CodeGen e ()
    genFieldTransfer Text
    var t :: Type
    t@(TInterface Name
    tn) = do
      maybeRegularCallback <- Type -> CodeGen e (Maybe Callback)
    forall e. Type -> CodeGen e (Maybe Callback)
    isRegularCallback Type
    t
      case maybeRegularCallback of
        Just Callback
    callback -> do
          let Name Text
    _ Text
    name' = API -> Name -> Name
    normalizedAPIName (Callback -> API
    APICallback Callback
    callback) Name
    tn
          wrapper <- Text -> Name -> CodeGen e Text
    forall e. Text -> Name -> CodeGen e Text
    qualifiedSymbol (Text -> Text
    callbackHaskellToForeign Text
    name') Name
    tn
          maker <- qualifiedSymbol (callbackWrapperAllocator name') tn
          line $ maker <> " " <>
            parenthesize (wrapper <> " Nothing " <> var)
        Maybe Callback
    Nothing -> 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
    "return " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    var
    genFieldTransfer Text
    var Type
    _ = 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
    "return " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    var

    -- | Haskell name for the field
    fName :: Field -> Text
    fName :: Field -> Text
    fName = Text -> Text
    underscoresToCamelCase (Text -> Text) -> (Field -> Text) -> Field -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Field -> Text
    fieldName

    -- | Label associated to the field.
    labelName :: Field -> Text
    labelName :: Field -> Text
    labelName = Text -> Text
    lcFirst  (Text -> Text) -> (Field -> Text) -> Field -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Field -> Text
    fName

    -- | Support for modifying fields as attributes. Returns a tuple with
    -- the name of the overloaded label to be used for the field, and the
    -- associated info type.
    genAttrInfo :: Name -> Field -> ExcCodeGen Text
    genAttrInfo :: Name
    -> Field
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    genAttrInfo Name
    owner Field
    field = do
      it <- Name
    -> Field
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) Text
    forall e. Name -> Field -> CodeGen e Text
    infoType Name
    owner Field
    field
      let on = Name -> Text
    upperName Name
    owner

      isPtr <- typeIsPtr (fieldType field)

      embedded <- isEmbedded field
      isNullable <- typeIsNullable (fieldType field)
      outType <- typeShow <$> if not embedded && isNullable
                              then maybeT <$> isoHaskellType (fieldType field)
                              else isoHaskellType (fieldType field)
      inType <- if isPtr
                then typeShow <$> foreignType (fieldType field)
                else typeShow <$> haskellType (fieldType field)
      transferType <- fieldTransferType (fieldType field)
      transferConstraint <- fieldTransferTypeConstraint (fieldType field)

      api <- findAPIByName owner
      hackageLink <- hackageModuleLink owner
      let qualifiedAttrName = ModulePath -> Text
    dotModulePath (Name -> API -> ModulePath
    moduleLocation Name
    owner API
    api)
                              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "." Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    labelName Field
    field
          attrInfoURL = Text
    hackageLink Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "#" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    haddockAttrAnchor Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Field -> Text
    labelName Field
    field

      line $ "data " <> it
      line $ "instance AttrInfo " <> it <> " where"
      indent $ do
        line $ "type AttrBaseTypeConstraint " <> it <> " = (~) " <> on
        line $ "type AttrAllowedOps " <> it <>
                 if embedded
                 then " = '[ 'AttrGet]"
                 else if isPtr
                      then " = '[ 'AttrSet, 'AttrGet, 'AttrClear]"
                      else " = '[ 'AttrSet, 'AttrGet]"
        line $ "type AttrSetTypeConstraint " <> it <> " = (~) "
                 <> if T.any (== ' ') inType
                    then parenthesize inType
                    else inType
        line $ "type AttrTransferTypeConstraint " <> it <> " = " <> transferConstraint
        line $ "type AttrTransferType " <> it <> " = " <> transferType
        line $ "type AttrGetType " <> it <> " = " <> outType
        line $ "type AttrLabel " <> it <> " = \"" <> fieldName field <> "\""
        line $ "type AttrOrigin " <> it <> " = " <> on
        line $ "attrGet = " <> fieldGetter owner field
        line $ "attrSet = " <> if not embedded
                                 then fieldSetter owner field
                                 else "undefined"
        line $ "attrConstruct = undefined"
        line $ "attrClear = " <> if not embedded && isPtr
                                   then fieldClear owner field
                                   else "undefined"
        if not embedded
          then do
              line $ "attrTransfer _ v = do"
              indent $ genFieldTransfer "v" (fieldType field)
          else line $ "attrTransfer = undefined"
        line $ "dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {"
        indent $ do
          line $ "O.resolvedSymbolName = \"" <> qualifiedAttrName <> "\""
          line $ ", O.resolvedSymbolURL = \"" <> attrInfoURL <> "\""
          line $ "})"

      blank

      group $ do
        let labelProxy = Text -> Text
    lcFirst Text
    on Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    lcFirst (Field -> Text
    fName Field
    field)
        line $ labelProxy <> " :: AttrLabelProxy \"" <> lcFirst (fName field) <> "\""
        line $ labelProxy <> " = AttrLabelProxy"

        export (NamedSubsection PropertySection $ lcFirst $ fName field) labelProxy

      return $ "'(\"" <> labelName field <> "\", " <> it <> ")"

    -- | Build code for a single field.
    buildFieldAttributes :: Name -> Field -> ExcCodeGen (Maybe Text)
    buildFieldAttributes :: Name
    -> Field
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    buildFieldAttributes Name
    n Field
    field
        | Bool -> Bool
    not (Field -> Bool
    fieldVisible Field
    field) = Maybe Text
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Text
    forall a. Maybe a
    Nothing
        | Type -> Bool
    privateType (Field -> Type
    fieldType Field
    field) = Maybe Text
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Text
    forall a. Maybe a
    Nothing
        | Bool
    otherwise = ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except CGError))
      (Maybe Text)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    forall e a. CodeGen e a -> CodeGen e a
    group (ReaderT
       CodeGenConfig
       (StateT (CGState, ModuleInfo) (Except CGError))
       (Maybe Text)
     -> ReaderT
          CodeGenConfig
          (StateT (CGState, ModuleInfo) (Except CGError))
          (Maybe Text))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ do

         -- We don't generate bindings for private and class structs, so
         -- do not generate bindings for fields pointing to class structs
         -- either.
         ignored <- Type -> ExcCodeGen Bool
    forall e. Type -> CodeGen e Bool
    isIgnoredStructType (Field -> Type
    fieldType Field
    field)
         when ignored $
          notImplementedError "Field type is an unsupported struct type"

         nullPtr <- nullPtrForType (fieldType field)

         embedded <- isEmbedded field

         addSectionDocumentation docSection (fieldDocumentation field)

         buildFieldReader n field
         export docSection (fieldGetter n field)

         when (not embedded) $ do
             buildFieldWriter n field
             export docSection (fieldSetter n field)

             case nullPtr of
               Just Text
    null -> do
                  Name -> Field -> Text -> ExcCodeGen ()
    buildFieldClear Name
    n Field
    field Text
    null
                  HaddockSection -> Text -> ExcCodeGen ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export HaddockSection
    docSection (Name -> Field -> Text
    fieldClear Name
    n Field
    field)
               Maybe Text
    Nothing -> () -> ExcCodeGen ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

         Just <$> cppIf CPPOverloading (genAttrInfo n field)

        where privateType :: Type -> Bool
              privateType :: Type -> Bool
    privateType (TInterface Name
    n) = Text
    "Private" Text -> Text -> Bool
    `T.isSuffixOf` Name -> Text
    name Name
    n
              privateType Type
    _ = Bool
    False

              docSection :: HaddockSection
    docSection = NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    PropertySection (Text -> HaddockSection) -> Text -> HaddockSection
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    lcFirst (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Field -> Text
    fName Field
    field

    -- | Generate code for the given list of fields.
    genStructOrUnionFields :: Name -> [Field] -> CodeGen e ()
    genStructOrUnionFields :: forall e. Name -> [Field] -> CodeGen e ()
    genStructOrUnionFields Name
    n [Field]
    fields = do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n

      attrs <- [Field]
    -> (Field
        -> ReaderT
             CodeGenConfig
             (StateT (CGState, ModuleInfo) (Except e))
             (Maybe Text))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         [Maybe Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Field]
    fields ((Field
      -> ReaderT
           CodeGenConfig
           (StateT (CGState, ModuleInfo) (Except e))
           (Maybe Text))
     -> ReaderT
          CodeGenConfig
          (StateT (CGState, ModuleInfo) (Except e))
          [Maybe Text])
    -> (Field
        -> ReaderT
             CodeGenConfig
             (StateT (CGState, ModuleInfo) (Except e))
             (Maybe Text))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         [Maybe Text]
    forall a b. (a -> b) -> a -> b
    $ \Field
    field ->
          (CGError
     -> ReaderT
          CodeGenConfig
          (StateT (CGState, ModuleInfo) (Except e))
          (Maybe Text))
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe Text)
    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 Skipped attribute for \"" 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
    <> Field -> Text
    fieldName Field
    field Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\"")
                          CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e
                          Maybe Text
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Maybe Text)
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Text
    forall a. Maybe a
    Nothing)
                      (Name
    -> Field
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         (Maybe Text)
    buildFieldAttributes Name
    n Field
    field)

      blank

      cppIf CPPOverloading $ do
        let attrListName = Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "AttributeList"
        line $ "instance O.HasAttributeList " <> name'
        line $ "type instance O.AttributeList " <> name' <> " = " <> attrListName
        line $ "type " <> attrListName <> " = ('[ " <>
             T.intercalate ", " (catMaybes attrs) <> "] :: [(Symbol, DK.Type)])"

    -- | Generate a constructor for a zero-filled struct/union of the given
    -- type, using the boxed (or GLib, for unboxed types) allocator.
    genZeroSU :: Name -> Int -> Bool -> CodeGen e ()
    genZeroSU :: forall e. Name -> Int -> Bool -> CodeGen e ()
    genZeroSU Name
    n Int
    size Bool
    isBoxed = 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
          let name :: Text
    name = Name -> Text
    upperName Name
    n
          let builder :: Text
    builder = Text
    "newZero" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name
              tsize :: Text
    tsize = Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    size

          RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol (Text
    "Construct a t'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                                         Text
    "' struct initialized to zero.")

          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    builder Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: MonadIO m => m " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name
          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    builder Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = liftIO $ " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
               if Bool
    isBoxed
               then Text
    "callocBoxedBytes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    tsize Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " >>= wrapBoxed " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name
               else Text
    "boxedPtrCalloc >>= wrapPtr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name
          Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    exportDecl Text
    builder

          CodeGen e ()
    forall e. CodeGen e ()
    blank

          -- Overloaded "new"
          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
    "instance tag ~ 'AttrSet => Constructible " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " tag 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
    $ do
               Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "new _ attrs = 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
    $ do
                  Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "o <- " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    builder
                  Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "GI.Attributes.set o attrs"
                  Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "return o"

    -- | Specialization for structs of `genZeroSU`.
    genZeroStruct :: Name -> Struct -> CodeGen e ()
    genZeroStruct :: forall e. Name -> Struct -> CodeGen e ()
    genZeroStruct 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 ()
    when (AllocationInfo -> AllocationOp
    allocCalloc (Struct -> AllocationInfo
    structAllocationInfo Struct
    s) AllocationOp -> AllocationOp -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text -> AllocationOp
    AllocationOp Text
    "none" Bool -> Bool -> Bool
    &&
              Struct -> Int
    structSize Struct
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0) (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
    -> Int
    -> Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> Int -> Bool -> CodeGen e ()
    genZeroSU Name
    n (Struct -> Int
    structSize Struct
    s) (Struct -> Bool
    structIsBoxed Struct
    s)

    -- | Specialization for unions of `genZeroSU`.
    genZeroUnion :: Name -> Union -> CodeGen e ()
    genZeroUnion :: forall e. Name -> Union -> CodeGen e ()
    genZeroUnion Name
    n Union
    u =
        Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (AllocationInfo -> AllocationOp
    allocCalloc (Union -> AllocationInfo
    unionAllocationInfo Union
    u ) AllocationOp -> AllocationOp -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text -> AllocationOp
    AllocationOp Text
    "none" Bool -> Bool -> Bool
    &&
              Union -> Int
    unionSize Union
    u Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0) (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
    -> Int
    -> Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Name -> Int -> Bool -> CodeGen e ()
    genZeroSU Name
    n (Union -> Int
    unionSize Union
    u) (Union -> Bool
    unionIsBoxed Union
    u)

    -- | Construct a import with the given prefix.
    prefixedForeignImport :: Text -> Text -> Text -> CodeGen e Text
    prefixedForeignImport :: forall e. Text -> Text -> Text -> CodeGen e Text
    prefixedForeignImport Text
    prefix Text
    symbol Text
    prototype = 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
      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
    symbol Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    prefix Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    symbol
               Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    prototype
      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
    prefix Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    symbol)

    -- | Generate a GValue instance for @GBoxed@ objects.
    genBoxedGValueInstance :: Name -> Text -> CodeGen e ()
    genBoxedGValueInstance :: forall e. Name -> Text -> CodeGen e ()
    genBoxedGValueInstance Name
    n Text
    get_type_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 '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 = B.GValue.set_boxed 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 (B.GValue.set_boxed 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 <- B.GValue.get_boxed 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 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 <$> B.ManagedPtr.newBoxed " 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"

    -- | Allocation and deallocation for types registered as `GBoxed` in
    -- the GLib type system.
    genBoxed :: Name -> Text -> CodeGen e ()
    genBoxed :: forall e. Name -> Text -> CodeGen e ()
    genBoxed Name
    n Text
    typeInit = do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n
          get_type_fn :: Text
    get_type_fn = Text
    "c_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeInit

      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
    "foreign import ccall \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeInit Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                Text
    get_type_fn 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
    "IO GType"

      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
    "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 -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance O.HasParentTypes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'

      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.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"
        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
    "glibType = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    get_type_fn

      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.Types.GBoxed " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'

      Name -> Text -> CodeGen e ()
    forall e. Name -> Text -> CodeGen e ()
    genBoxedGValueInstance Name
    n Text
    get_type_fn

    -- | Generate the typeclass with information for how to
    -- allocate/deallocate a given type which is not a `GBoxed`.
    genWrappedPtr :: Name -> AllocationInfo -> Int -> CodeGen e ()
    genWrappedPtr :: forall e. Name -> AllocationInfo -> Int -> CodeGen e ()
    genWrappedPtr Name
    n AllocationInfo
    info Int
    size = 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
      let prefix :: Text -> Text
    prefix = \Text
    op -> Text
    "_" 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
    op Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_"

      Bool -> CodeGen e () -> CodeGen e ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    size Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && AllocationInfo -> AllocationOp
    allocFree AllocationInfo
    info AllocationOp -> AllocationOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == AllocationOp
    AllocationOpUnknown) (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
    "-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?"

      copy <- case AllocationInfo -> AllocationOp
    allocCopy AllocationInfo
    info of
                AllocationOp Text
    op -> do
                    copy <- Text
    -> Text
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall e. Text -> Text -> Text -> CodeGen e Text
    prefixedForeignImport (Text -> Text
    prefix Text
    "copy") Text
    op Text
    "Ptr a -> IO (Ptr a)"
                    return ("\\p -> B.ManagedPtr.withManagedPtr p (" <> copy <>
                            " >=> B.ManagedPtr.wrapPtr " <> name' <> ")")
                AllocationOp
    AllocationOpUnknown ->
                    if Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                    then Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    "\\p -> B.ManagedPtr.withManagedPtr p (copyBytes "
                                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    size Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                                  Text
    " >=> B.ManagedPtr.wrapPtr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")")
                    else Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    "return"

      free <- case allocFree info of
                AllocationOp Text
    op -> do
                  free <- Text
    -> Text
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall e. Text -> Text -> Text -> CodeGen e Text
    prefixedForeignImport (Text -> Text
    prefix Text
    "free") Text
    op Text
    "Ptr a -> IO ()"
                  return $ "\\p -> B.ManagedPtr.withManagedPtr p " <> free
                AllocationOp
    AllocationOpUnknown ->
                    if Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                    then Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    "\\x -> SP.withManagedPtr x SP.freeMem"
                    else Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    "\\_x -> return ()"

      bline $ "instance BoxedPtr " <> name' <> " where"
      indent $ do
          line $ "boxedPtrCopy = " <> copy
          line $ "boxedPtrFree = " <> free

      case allocCalloc info of
        AllocationOp Text
    "none" -> () -> CodeGen e ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        AllocationOp Text
    op -> do
          calloc <- Text
    -> Text
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
    forall e. Text -> Text -> Text -> CodeGen e Text
    prefixedForeignImport (Text -> Text
    prefix Text
    "calloc") Text
    op Text
    "IO (Ptr a)"
          callocInstance calloc
        AllocationOp
    AllocationOpUnknown ->
          if Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
          then do
            let calloc :: Text
    calloc = Text
    "callocBytes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    size
            Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    callocInstance Text
    calloc
          else () -> CodeGen e ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      where name' :: Text
    name' = Name -> Text
    upperName Name
    n

            callocInstance :: Text -> CodeGen e ()
            callocInstance :: forall e. Text -> CodeGen e ()
    callocInstance Text
    calloc = 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 CallocPtr " 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
    $ do
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "boxedPtrCalloc = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    calloc