    module Data.GI.CodeGen.Signal
        ( genSignal
        , genCallback
        , signalHaskellName
        ) where

    import Control.Monad (forM, forM_, when, unless)

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

    import Text.Show.Pretty (ppShow)

    import Data.GI.CodeGen.API
    import Data.GI.CodeGen.Callable (hOutType, wrapMaybe,
                                     fixupCallerAllocates,
                                     genDynamicCallableWrapper,
                                     callableHInArgs, callableHOutArgs)
    import Data.GI.CodeGen.Code
    import Data.GI.CodeGen.Conversions
    import Data.GI.CodeGen.Haddock (deprecatedPragma,
                                    RelativeDocPosition(..), writeHaddock,
                                    writeDocumentation,
                                    writeArgDocumentation, writeReturnDocumentation)
    import Data.GI.CodeGen.ModulePath (dotModulePath)
    import Data.GI.CodeGen.SymbolNaming
    import Data.GI.CodeGen.Transfer (freeContainerType)
    import Data.GI.CodeGen.Type
    import Data.GI.CodeGen.Util (parenthesize, withComment, tshow, terror,
                                 lcFirst, ucFirst, prime)
    import Data.GI.GIR.Documentation (Documentation)

    -- | The prototype of the callback on the Haskell side (what users of
    -- the binding will see)
    genHaskellCallbackPrototype :: Text -> Callable -> Text -> ExposeClosures ->
                                   Bool -> Documentation -> ExcCodeGen ()
    genHaskellCallbackPrototype :: Text
    -> Callable
    -> Text
    -> ExposeClosures
    -> Bool
    -> Documentation
    -> ExcCodeGen ()
    genHaskellCallbackPrototype Text
    subsec Callable
    cb Text
    htype ExposeClosures
    expose Bool
    isSignal Documentation
    doc = 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' = case ExposeClosures
    expose of
                      ExposeClosures
    WithClosures -> Text -> Text
    callbackHTypeWithClosures Text
    htype
                      ExposeClosures
    WithoutClosures -> Text
    htype
            ([Arg]
    hInArgs, [Arg]
    _) = Callable -> ExposeClosures -> ([Arg], [Arg])
    callableHInArgs Callable
    cb ExposeClosures
    expose
            inArgsWithArrows :: [(Text, Arg)]
    inArgsWithArrows = [Text] -> [Arg] -> [(Text, Arg)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Text
    "" Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : Text -> [Text]
    forall a. a -> [a]
    repeat Text
    "-> ") [Arg]
    hInArgs
            hOutArgs :: [Arg]
    hOutArgs = Callable -> [Arg]
    callableHOutArgs Callable
    cb

        HaddockSection -> Text -> ExcCodeGen ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) Text
    name'
        RelativeDocPosition -> Documentation -> ExcCodeGen ()
    forall e. RelativeDocPosition -> Documentation -> CodeGen e ()
    writeDocumentation RelativeDocPosition
    DocBeforeSymbol Documentation
    doc
        Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ="
        ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
          [(Text, Arg)] -> ((Text, Arg) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Text, Arg)]
    inArgsWithArrows (((Text, Arg) -> ExcCodeGen ()) -> ExcCodeGen ())
    -> ((Text, Arg) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    arrow, Arg
    arg) -> do
            ht <- Type -> CodeGen CGError TypeRep
    forall e. Type -> CodeGen e TypeRep
    isoHaskellType (Arg -> Type
    argType Arg
    arg)
            isMaybe <- wrapMaybe arg
            let formattedType = if Bool
    isMaybe
                                then TypeRep -> Text
    typeShow (TypeRep -> TypeRep
    maybeT TypeRep
    ht)
                                else TypeRep -> Text
    typeShow TypeRep
    ht
            line $ arrow <> formattedType
            writeArgDocumentation arg
          ret <- Callable -> [Arg] -> CodeGen CGError TypeRep
    hOutType Callable
    cb [Arg]
    hOutArgs
          let returnArrow = if [Arg] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Arg]
    hInArgs
                            then Text
    ""
                            else Text
    "-> "
          line $ returnArrow <> typeShow (io ret)
          writeReturnDocumentation cb False

        Bool -> ExcCodeGen () -> ExcCodeGen ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    isSignal) (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
          ExcCodeGen ()
    forall e. CodeGen e ()
    blank

          -- For optional parameters, in case we want to pass Nothing.
          HaddockSection -> Text -> ExcCodeGen ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) (Text
    "no" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name')
          RelativeDocPosition -> Text -> ExcCodeGen ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol (Text -> Text
    noCallbackDoc Text
    name')
          Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "no" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: Maybe " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'
          Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "no" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = Nothing"

      where noCallbackDoc :: Text -> Text
            noCallbackDoc :: Text -> Text
    noCallbackDoc Text
    typeName =
              Text
    "A convenience synonym for @`Nothing` :: `Maybe` `" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
              Text
    "`@."

    -- | Generate the type synonym for the prototype of the callback on
    -- the C side. Returns the name given to the type synonym.
    genCCallbackPrototype :: Text -> Callable -> Text ->
                             Maybe Text -> CodeGen e Text
    genCCallbackPrototype :: forall e. Text -> Callable -> Text -> Maybe Text -> CodeGen e Text
    genCCallbackPrototype Text
    subsec Callable
    cb Text
    name' Maybe Text
    maybeOwner = CodeGen e Text -> CodeGen e Text
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e Text -> CodeGen e Text)
    -> CodeGen e Text -> CodeGen e Text
    forall a b. (a -> b) -> a -> b
    $ do
        let ctypeName :: Text
    ctypeName = Text -> Text
    callbackCType Text
    name'
            isSignal :: Bool
    isSignal = Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Text
    maybeOwner

        Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    isSignal) (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
          HaddockSection
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) Text
    ctypeName
          RelativeDocPosition
    -> Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    ccallbackDoc

        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
    "type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ctypeName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ="
        ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (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
          ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> (Text
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> Maybe Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
            (\Text
    owner -> 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 -> Text -> Text
    withComment (Text
    "Ptr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    owner Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ->") Text
    "object")
            Maybe Text
    maybeOwner
          [Arg]
    -> (Arg
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Callable -> [Arg]
    args Callable
    cb) ((Arg
      -> ReaderT
           CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
     -> ReaderT
          CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> (Arg
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall a b. (a -> b) -> a -> b
    $ \Arg
    arg -> do
            ht <- Type -> CodeGen e TypeRep
    forall e. Type -> CodeGen e TypeRep
    foreignType (Type -> CodeGen e TypeRep) -> Type -> CodeGen e TypeRep
    forall a b. (a -> b) -> a -> b
    $ Arg -> Type
    argType Arg
    arg
            let ht' = if Arg -> Direction
    direction Arg
    arg Direction -> Direction -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Direction
    DirectionIn Bool -> Bool -> Bool
    &&
                         Bool -> Bool
    not (Arg -> Bool
    argCallerAllocates Arg
    arg)
                      then TypeRep -> TypeRep
    ptr TypeRep
    ht
                      else TypeRep
    ht
            line $ typeShow ht' <> " ->"
          Bool
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Callable -> Bool
    callableThrows Callable
    cb) (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
    $
            Text
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
    forall e. Text -> CodeGen e ()
    line Text
    "Ptr (Ptr GError) ->"
          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 -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Text
    maybeOwner) (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
    $ 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 -> Text -> Text
    withComment Text
    "Ptr () ->" Text
    "user_data"
          ret <- TypeRep -> TypeRep
    io (TypeRep -> TypeRep) -> CodeGen e TypeRep -> CodeGen e TypeRep
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> case Callable -> Maybe Type
    returnType Callable
    cb of
                          Maybe Type
    Nothing -> TypeRep -> CodeGen e TypeRep
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeRep -> CodeGen e TypeRep) -> TypeRep -> CodeGen e TypeRep
    forall a b. (a -> b) -> a -> b
    $ Text -> TypeRep
    con0 Text
    "()"
                          Just Type
    t -> Type -> CodeGen e TypeRep
    forall e. Type -> CodeGen e TypeRep
    foreignType Type
    t
          line $ typeShow ret
        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
    ctypeName

      where
        ccallbackDoc :: Text
        ccallbackDoc :: Text
    ccallbackDoc = Text
    "Type for the callback on the (unwrapped) C side."

    -- | Generator for wrappers callable from C
    genCallbackWrapperFactory :: Text -> Text -> Bool -> CodeGen e ()
    genCallbackWrapperFactory :: forall e. Text -> Text -> Bool -> CodeGen e ()
    genCallbackWrapperFactory Text
    subsec Text
    name' Bool
    isSignal = 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 factoryName :: Text
    factoryName = Text -> Text
    callbackWrapperAllocator Text
    name'
        RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    factoryDoc
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line Text
    "foreign import ccall \"wrapper\""
        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
    factoryName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackCType Text
    name'
                   Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> IO (FunPtr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackCType Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
        Bool -> CodeGen e () -> CodeGen e ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    isSignal) (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
          HaddockSection -> Text -> CodeGen e ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) Text
    factoryName

      where factoryDoc :: Text
            factoryDoc :: Text
    factoryDoc = Text
    "Generate a function pointer callable from C code, from a `"
                         Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackCType Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "`."

    -- | Wrap the Haskell `cb` callback into a foreign function of the
    -- right type. Returns the name of the wrapped value.
    genWrappedCallback :: Callable -> Text -> Text -> Bool -> CodeGen e Text
    genWrappedCallback :: forall e. Callable -> Text -> Text -> Bool -> CodeGen e Text
    genWrappedCallback Callable
    cb Text
    cbArg Text
    callback Bool
    isSignal = do
      drop <- if Callable -> Bool
    callableHasClosures Callable
    cb
              then do
                let arg' :: Text
    arg' = Text -> Text
    prime Text
    cbArg
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "let " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    arg' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = "
                         Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackDropClosures Text
    callback Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    cbArg
                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
    arg'
              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
    cbArg
      line $ "let " <> prime drop <> " = " <> callbackHaskellToForeign callback <>
           if isSignal
           then " " <> drop
           else " Nothing " <> drop
      return (prime drop)

    -- | Generator of closures
    genClosure :: Text -> Callable -> Text -> Text -> CodeGen e ()
    genClosure :: forall e. Text -> Callable -> Text -> Text -> CodeGen e ()
    genClosure Text
    subsec Callable
    cb Text
    callback 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
      let closure :: Text
    closure = Text -> Text
    callbackClosureGenerator Text
    name
      HaddockSection -> Text -> CodeGen e ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) Text
    closure
      RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    closureDoc
      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
    closure Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: MonadIO m => " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    callback Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> m (GClosure "
                         Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackCType Text
    callback 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
    closure Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " cb = liftIO $ 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
                wrapped <- Callable -> Text -> Text -> Bool -> CodeGen e Text
    forall e. Callable -> Text -> Text -> Bool -> CodeGen e Text
    genWrappedCallback Callable
    cb Text
    "cb" Text
    callback Bool
    False
                line $ callbackWrapperAllocator callback <> " " <> wrapped
                         <> " >>= B.GClosure.newGClosure"
      where
        closureDoc :: Text
        closureDoc :: Text
    closureDoc = Text
    "Wrap the callback into a `GClosure`."

    -- | Wrap a conversion of a nullable object into "Maybe" object, by
    -- checking whether the pointer is NULL.
    convertNullable :: Text -> CodeGen e Text -> Type -> CodeGen e Text
    convertNullable :: forall e. Text -> CodeGen e Text -> Type -> CodeGen e Text
    convertNullable Text
    aname CodeGen e Text
    c Type
    t = do
      nullPtr <- Type -> CodeGen e (Maybe Text)
    forall e. Type -> CodeGen e (Maybe Text)
    nullPtrForType Type
    t CodeGen e (Maybe Text)
    -> (Maybe Text -> CodeGen e Text) -> CodeGen e Text
    forall a b.
    ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    -> (a
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b)
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Maybe Text
    Nothing -> Text -> CodeGen e Text
    forall a. HasCallStack => Text -> a
    terror (Text -> CodeGen e Text) -> Text -> CodeGen e Text
    forall a b. (a -> b) -> a -> b
    $ Text
    "Unexpected non-pointer type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Type -> Text
    forall a. Show a => a -> Text
    tshow Type
    t
        Just Text
    null -> Text -> CodeGen e Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Text
    null
      line $ "maybe" <> ucFirst aname <> " <-"
      indent $ do
        line $ "if " <> aname <> " == " <> nullPtr
        line   "then return Nothing"
        line   "else do"
        indent $ do
                 unpacked <- c
                 line $ "return $ Just " <> unpacked
        return $ "maybe" <> ucFirst aname

    -- Convert a non-zero terminated out array, stored in a variable
    -- named "aname", into the corresponding Haskell object.
    convertCallbackInCArray :: Callable -> Arg -> Type -> Text -> ExcCodeGen Text
    convertCallbackInCArray :: Callable -> Arg -> Type -> Text -> ExcCodeGen Text
    convertCallbackInCArray Callable
    callable Arg
    arg t :: Type
    t@(TCArray Bool
    False (-1) Int
    length Type
    _) Text
    aname =
      if Int
    length Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > -Int
    1
      then Arg -> CodeGen CGError Bool
    forall e. Arg -> CodeGen e Bool
    wrapMaybe Arg
    arg CodeGen CGError Bool
    -> (Bool -> ExcCodeGen Text) -> ExcCodeGen Text
    forall a b.
    ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    -> (a
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) b)
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ExcCodeGen Text -> ExcCodeGen Text -> Bool -> ExcCodeGen Text
    forall a. a -> a -> Bool -> a
    bool ExcCodeGen Text
    convertAndFree
                             (Text -> ExcCodeGen Text -> Type -> ExcCodeGen Text
    forall e. Text -> CodeGen e Text -> Type -> CodeGen e Text
    convertNullable Text
    aname ExcCodeGen Text
    convertAndFree Type
    t)
      else
        -- Not much we can do, we just pass the pointer along, and let
        -- the callback deal with it.
        Text -> ExcCodeGen Text
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    aname
      where
        lname :: Text
    lname = Arg -> Text
    escapedArgName (Arg -> Text) -> Arg -> Text
    forall a b. (a -> b) -> a -> b
    $ Callable -> [Arg]
    args Callable
    callable [Arg] -> Int -> Arg
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    length

        convertAndFree :: ExcCodeGen Text
        convertAndFree :: ExcCodeGen Text
    convertAndFree = do
          unpacked <- Text -> CodeGen CGError Converter -> ExcCodeGen Text
    forall e. Text -> CodeGen e Converter -> CodeGen e Text
    convert Text
    aname (CodeGen CGError Converter -> ExcCodeGen Text)
    -> CodeGen CGError Converter -> ExcCodeGen Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Type -> Transfer -> CodeGen CGError Converter
    unpackCArray Text
    lname Type
    t (Arg -> Transfer
    transfer Arg
    arg)
          -- Free the memory associated with the array
          freeContainerType (transfer arg) t aname lname
          return unpacked

    -- Remove the warning, this should never be reached.
    convertCallbackInCArray Callable
    _ Arg
    t Type
    _ Text
    _ =
        Text -> ExcCodeGen Text
    forall a. HasCallStack => Text -> a
    terror (Text -> ExcCodeGen Text) -> Text -> ExcCodeGen Text
    forall a b. (a -> b) -> a -> b
    $ Text
    "convertOutCArray : unexpected " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Arg -> Text
    forall a. Show a => a -> Text
    tshow Arg
    t

    -- Prepare an argument for passing into the Haskell side.
    prepareArgForCall :: Callable -> Arg -> ExcCodeGen Text
    prepareArgForCall :: Callable -> Arg -> ExcCodeGen Text
    prepareArgForCall Callable
    cb Arg
    arg = case Arg -> Direction
    direction Arg
    arg of
      Direction
    DirectionIn -> Callable -> Arg -> ExcCodeGen Text
    prepareInArg Callable
    cb Arg
    arg
      Direction
    DirectionInout -> Arg -> ExcCodeGen Text
    prepareInoutArg Arg
    arg
      Direction
    DirectionOut -> Text -> ExcCodeGen Text
    forall a. HasCallStack => Text -> a
    terror Text
    "Unexpected DirectionOut!"

    prepareInArg :: Callable -> Arg -> ExcCodeGen Text
    prepareInArg :: Callable -> Arg -> ExcCodeGen Text
    prepareInArg Callable
    cb Arg
    arg = do
      let name :: Text
    name = Arg -> Text
    escapedArgName Arg
    arg
      case Arg -> Type
    argType Arg
    arg of
        t :: Type
    t@(TCArray Bool
    False Int
    _ Int
    _ Type
    _) -> Callable -> Arg -> Type -> Text -> ExcCodeGen Text
    convertCallbackInCArray Callable
    cb Arg
    arg Type
    t Text
    name
        Type
    _ -> do
          let c :: ExcCodeGen Text
    c = Text -> CodeGen CGError Converter -> ExcCodeGen Text
    forall e. Text -> CodeGen e Converter -> CodeGen e Text
    convert Text
    name (CodeGen CGError Converter -> ExcCodeGen Text)
    -> CodeGen CGError Converter -> ExcCodeGen Text
    forall a b. (a -> b) -> a -> b
    $ Type -> Transfer -> CodeGen CGError Converter
    transientToH (Arg -> Type
    argType Arg
    arg) (Arg -> Transfer
    transfer Arg
    arg)
          Arg -> CodeGen CGError Bool
    forall e. Arg -> CodeGen e Bool
    wrapMaybe Arg
    arg CodeGen CGError Bool
    -> (Bool -> ExcCodeGen Text) -> ExcCodeGen Text
    forall a b.
    ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    -> (a
        -> ReaderT
             CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) b)
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ExcCodeGen Text -> ExcCodeGen Text -> Bool -> ExcCodeGen Text
    forall a. a -> a -> Bool -> a
    bool ExcCodeGen Text
    c (Text -> ExcCodeGen Text -> Type -> ExcCodeGen Text
    forall e. Text -> CodeGen e Text -> Type -> CodeGen e Text
    convertNullable Text
    name ExcCodeGen Text
    c (Arg -> Type
    argType Arg
    arg))

    prepareInoutArg :: Arg -> ExcCodeGen Text
    prepareInoutArg :: Arg -> ExcCodeGen Text
    prepareInoutArg Arg
    arg = do
      let name :: Text
    name = Arg -> Text
    escapedArgName Arg
    arg
      name' <- Text -> Converter -> ExcCodeGen Text
    forall e. Text -> Converter -> CodeGen e Text
    genConversion Text
    name (Converter -> ExcCodeGen Text) -> Converter -> ExcCodeGen Text
    forall a b. (a -> b) -> a -> b
    $ Constructor -> Converter
    apply (Constructor -> Converter) -> Constructor -> Converter
    forall a b. (a -> b) -> a -> b
    $ Text -> Constructor
    M Text
    "peek"
      convert name' $ fToH (argType arg) (transfer arg)

    saveOutArg :: Arg -> ExcCodeGen ()
    saveOutArg :: Arg -> ExcCodeGen ()
    saveOutArg Arg
    arg = do
      let name :: Text
    name = Arg -> Text
    escapedArgName Arg
    arg
          name' :: Text
    name' = Text
    "out" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name
      Bool -> ExcCodeGen () -> ExcCodeGen ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Arg -> Transfer
    transfer Arg
    arg Transfer -> Transfer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Transfer
    TransferEverything) (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $
           Text -> ExcCodeGen ()
    forall a. Text -> ExcCodeGen a
    notImplementedError (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Unexpected transfer type for \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\""
      isMaybe <- Arg -> CodeGen CGError Bool
    forall e. Arg -> CodeGen e Bool
    wrapMaybe Arg
    arg
      name'' <- if isMaybe
                then do
                  let name'' = Text -> Text
    prime Text
    name'
                  line $ name'' <> " <- case " <> name' <> " of"
                  indent $ do
                       line "Nothing -> return nullPtr"
                       line $ "Just " <> name'' <> " -> do"
                       indent $ do
                             converted <- convert name'' $ hToF (argType arg) TransferEverything
                             line $ "return " <> converted
                  return name''
                else convert name' $ hToF (argType arg) TransferEverything
      line $ "poke " <> name <> " " <> name''

    -- | A simple wrapper that drops every closure argument.
    genDropClosures :: Text -> Callable -> Text -> CodeGen e ()
    genDropClosures :: forall e. Text -> Callable -> Text -> CodeGen e ()
    genDropClosures Text
    subsec Callable
    cb 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
      let dropper :: Text
    dropper = Text -> Text
    callbackDropClosures Text
    name'
          ([Arg]
    inWithClosures, [Arg]
    _) = Callable -> ExposeClosures -> ([Arg], [Arg])
    callableHInArgs Callable
    cb ExposeClosures
    WithClosures
          ([Arg]
    inWithoutClosures, [Arg]
    _) = Callable -> ExposeClosures -> ([Arg], [Arg])
    callableHInArgs Callable
    cb ExposeClosures
    WithoutClosures
          passOrIgnore :: Arg -> Maybe Text
    passOrIgnore = \Arg
    arg -> if Arg
    arg Arg -> [Arg] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Arg]
    inWithoutClosures
                                 then Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Arg -> Text
    escapedArgName Arg
    arg)
                                 else Maybe Text
    forall a. Maybe a
    Nothing
          argNames :: [Text]
    argNames = (Arg -> Text) -> [Arg] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> (Text -> Text) -> Maybe Text -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "_" Text -> Text
    forall a. a -> a
    id (Maybe Text -> Text) -> (Arg -> Maybe Text) -> Arg -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg -> Maybe Text
    passOrIgnore) [Arg]
    inWithClosures

      HaddockSection -> Text -> CodeGen e ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) Text
    dropper
      RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    dropperDoc

      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    dropper 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
    " -> " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackHTypeWithClosures 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
    dropper Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " _f " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.unwords [Text]
    argNames Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = _f "
               Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.unwords ([Maybe Text] -> [Text]
    forall a. [Maybe a] -> [a]
    catMaybes ((Arg -> Maybe Text) -> [Arg] -> [Maybe Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg -> Maybe Text
    passOrIgnore [Arg]
    inWithClosures))

      where dropperDoc :: Text
            dropperDoc :: Text
    dropperDoc = Text
    "A simple wrapper that ignores the closure arguments."

    -- | The wrapper itself, marshalling to and from Haskell. The `Callable`
    -- argument is possibly a pointer to a FunPtr to free (via
    -- freeHaskellFunPtr) once the callback is run once, or Nothing if the
    -- FunPtr will be freed by someone else (the function registering the
    -- callback for ScopeTypeCall, or a destroy notifier for
    -- ScopeTypeNotified).
    genCallbackWrapper :: Text -> Callable -> Text ->
                          Maybe Text -> CodeGen e ()
    genCallbackWrapper :: forall e. Text -> Callable -> Text -> Maybe Text -> CodeGen e ()
    genCallbackWrapper Text
    subsec Callable
    cb Text
    name' Maybe Text
    maybeOwner = 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 wrapperName :: Text
    wrapperName = Text -> Text
    callbackHaskellToForeign Text
    name'
          ([Arg]
    hInArgs, [Arg]
    _) = Callable -> ExposeClosures -> ([Arg], [Arg])
    callableHInArgs Callable
    cb ExposeClosures
    WithClosures
          hOutArgs :: [Arg]
    hOutArgs = Callable -> [Arg]
    callableHOutArgs Callable
    cb
          wrapperDoc :: Text
    wrapperDoc = Text
    "Wrap a `" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "` into a `" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                       Text -> Text
    callbackCType Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "`."
          isSignal :: Bool
    isSignal = Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Text
    maybeOwner

      Bool -> CodeGen e () -> CodeGen e ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    isSignal) (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        HaddockSection -> Text -> CodeGen e ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export (NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection Text
    subsec) Text
    wrapperName
        RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    wrapperDoc

      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
    wrapperName 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
    $ do
          if Bool
    isSignal
            then Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "GObject a => (a -> " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ") ->"
            else do
               Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Maybe (Ptr (FunPtr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    callbackCType Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")) ->"
               let hType :: Text
    hType = if Callable -> Bool
    callableHasClosures Callable
    cb
                           then Text -> Text
    callbackHTypeWithClosures Text
    name'
                           else 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
    hType 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 -> Text
    callbackCType Text
    name'

        let cArgNames :: [Text]
    cArgNames = (Arg -> Text) -> [Arg] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg -> Text
    escapedArgName (Callable -> [Arg]
    args Callable
    cb)
            allArgs :: Text
    allArgs = if Bool
    isSignal
                      then [Text] -> Text
    T.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text
    "gi'cb", Text
    "gi'selfPtr"] [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> [Text]
    cArgNames [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> [Text
    "_"]
                      else [Text] -> Text
    T.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text
    "gi'funptrptr", Text
    "gi'cb"] [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> [Text]
    cArgNames
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    wrapperName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    allArgs Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = do"
        (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (\CGError
    e -> 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
    "-- XXX Could not generate callback wrapper for "
                              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'
                       CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e
                       Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "P.error \"The bindings for " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    wrapperName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " could not be generated, function unsupported.\""
                    ) (ExcCodeGen () -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
          hInNames <- [Arg]
    -> (Arg -> ExcCodeGen Text)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except CGError))
         [Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Arg]
    hInArgs (Callable -> Arg -> ExcCodeGen Text
    prepareArgForCall Callable
    cb)

          let maybeReturn = case Callable -> Maybe Type
    returnType Callable
    cb of
                              Maybe Type
    Nothing -> []
                              Maybe Type
    _       -> [Text
    "result"]
              returnVars = [Text]
    maybeReturn [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> (Arg -> Text) -> [Arg] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text
    "out"Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) (Text -> Text) -> (Arg -> Text) -> Arg -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg -> Text
    escapedArgName) [Arg]
    hOutArgs
              mkTuple = Text -> Text
    parenthesize (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text] -> Text
    T.intercalate Text
    ", "
              returnBind = case [Text]
    returnVars of
                             []  -> Text
    ""
                             [Text
    r] -> Text
    r Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " <- "
                             [Text]
    _   -> [Text] -> Text
    mkTuple [Text]
    returnVars Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " <- "

          if isSignal
          then line $ returnBind
                      <> "B.ManagedPtr.withNewObject"
                      <> " gi'selfPtr $ \\gi'self -> "
                      <> "gi'cb (Coerce.coerce gi'self) "
                      <> T.concat (map (" " <>) hInNames)
          else line $ returnBind <> "gi'cb " <> T.concat (map (" " <>) hInNames)

          forM_ hOutArgs saveOutArg

          unless isSignal $ line "maybeReleaseFunPtr gi'funptrptr"

          case returnType cb of
            Maybe Type
    Nothing -> () -> ExcCodeGen ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just Type
    r -> do
               nullableReturnType <- Type -> CodeGen CGError Bool
    forall e. Type -> CodeGen e Bool
    typeIsNullable Type
    r
               if returnMayBeNull cb && nullableReturnType
               then do
                 line "maybeM FP.nullPtr result $ \\result' -> do"
                 indent $ unwrapped "result'"
               else unwrapped "result"
               where
                 unwrapped :: Text -> ExcCodeGen ()
    unwrapped Text
    rname = do
                   result' <- Text -> CodeGen CGError Converter -> ExcCodeGen Text
    forall e. Text -> CodeGen e Converter -> CodeGen e Text
    convert Text
    rname (CodeGen CGError Converter -> ExcCodeGen Text)
    -> CodeGen CGError Converter -> ExcCodeGen Text
    forall a b. (a -> b) -> a -> b
    $ Type -> Transfer -> CodeGen CGError Converter
    hToF Type
    r (Callable -> Transfer
    returnTransfer Callable
    cb)
                   line $ "return " <> result'

    genCallback :: Name -> Callback -> CodeGen e ()
    genCallback :: forall e. Name -> Callback -> CodeGen e ()
    genCallback Name
    n callback :: Callback
    callback@(Callback {cbCallable :: Callback -> Callable
    cbCallable = Callable
    cb, cbDocumentation :: Callback -> Documentation
    cbDocumentation = Documentation
    cbDoc }) = do
      let Name Text
    _ Text
    name' = API -> Name -> Name
    normalizedAPIName (Callback -> API
    APICallback Callback
    callback) Name
    n
          cb' :: Callable
    cb' = Callable -> Callable
    fixupCallerAllocates Callable
    cb

      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- callback " 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
    "{- " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Callable -> String
    forall a. Show a => a -> String
    ppShow Callable
    cb') Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n-}"

      if Callable -> Bool
    skipReturn Callable
    cb
      then 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
    "-- XXX Skipping callback " 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
    "{- Callbacks skipping return unsupported :\n"
                 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Name -> String
    forall a. Show a => a -> String
    ppShow Name
    n) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Callable -> String
    forall a. Show a => a -> String
    ppShow Callable
    cb') Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "-}"
      else do
        (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (\CGError
    e -> do
                       Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- XXX Could not generate callback wrapper for "
                              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'
                       CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e) (ExcCodeGen () -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
          typeSynonym <- Text -> Callable -> Text -> Maybe Text -> ExcCodeGen Text
    forall e. Text -> Callable -> Text -> Maybe Text -> CodeGen e Text
    genCCallbackPrototype Text
    name' Callable
    cb' Text
    name' Maybe Text
    forall a. Maybe a
    Nothing
          dynamic <- genDynamicCallableWrapper n typeSynonym cb
          export (NamedSubsection SignalSection name') dynamic
          genCallbackWrapperFactory name' name' False
          deprecatedPragma name' (callableDeprecated cb')
          genHaskellCallbackPrototype name' cb' name' WithoutClosures False cbDoc
          when (callableHasClosures cb') $ do
               genHaskellCallbackPrototype name' cb' name' WithClosures False cbDoc
               genDropClosures name' cb' name'
          if callableThrows cb'
          then do
            {- [Note: Callables that throw]

              In the case that the Callable throws (GErrors) we cannot
              simply take a Haskell functions that throws and wrap it into
              a foreign function, since in the case that an exception is
              raised the return value of the function is undefined, but we
              need to provide some value to the FFI.

              Alternatively, we could ask the Haskell function to provide
              a return value and optionally a GError. If the GError is
              present we should then release the memory associated with
              the out/return values (the caller will not do it, since
              there was an error), and then return some bogus values. This
              is fairly complicated, and callbacks raising GErrors are
              fairly rare, so for the moment we do not generate wrappers
              for these cases.
            -}
            line $ "-- No Haskell->C wrapper generated since the function throws."
            blank
          else do
            genClosure name' cb' name' name'
            genCallbackWrapper name' cb' name' Nothing

    -- | Generate the given signal instance for the given API object.
    genSignalInfoInstance :: Name -> Signal -> CodeGen e ()
    genSignalInfoInstance :: forall e. Name -> Signal -> CodeGen e ()
    genSignalInfoInstance Name
    owner Signal
    signal = 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
      api <- Name -> CodeGen e API
    forall e. HasCallStack => Name -> CodeGen e API
    findAPIByName Name
    owner
      let name = Name -> Text
    upperName Name
    owner
          sn = (Text -> Text
    ucFirst (Text -> Text) -> (Signal -> Text) -> Signal -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    signalHaskellName (Text -> Text) -> (Signal -> Text) -> Signal -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Signal -> Text
    sigName) Signal
    signal
          lcSignal = Text -> Text
    lcFirst Text
    sn
          qualifiedSignalName = 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
    <> Signal -> Text
    sigName Signal
    signal
      hackageLink <- hackageModuleLink owner
      si <- signalInfoName owner signal
      bline $ "data " <> si
      line $ "instance SignalInfo " <> si <> " where"
      indent $ do
          let signalConnectorName = Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    sn
              cbHaskellType = Text
    signalConnectorName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "Callback"
          line $ "type HaskellCallbackType " <> si <> " = " <> cbHaskellType
          line $ "connectSignal obj cb connectMode detail = do"
          indent $ do
            genSignalConnector signal cbHaskellType "connectMode" "detail" "cb"
          line $ "dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {"
          indent $ do
            line $ "O.resolvedSymbolName = \"" <> qualifiedSignalName <> "\""
            line $ ", O.resolvedSymbolURL = \"" <> hackageLink <> "#"
              <> haddockSignalAnchor <> lcSignal <> "\"})"
      export (NamedSubsection SignalSection $ lcSignal) si

    -- | Write some simple debug message when signal generation fails, and
    -- generate a placeholder SignalInfo instance.
    processSignalError :: Signal -> Name -> CGError -> CodeGen e ()
    processSignalError :: forall e. Signal -> Name -> CGError -> CodeGen e ()
    processSignalError Signal
    signal Name
    owner CGError
    err = do
      let qualifiedSignalName :: Text
    qualifiedSignalName = Name -> Text
    upperName Name
    owner Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Signal -> Text
    sigName Signal
    signal
          sn :: Text
    sn = (Text -> Text
    ucFirst (Text -> Text) -> (Signal -> Text) -> Signal -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    signalHaskellName (Text -> Text) -> (Signal -> Text) -> Signal -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Signal -> Text
    sigName) Signal
    signal
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat [Text
    "-- XXX Could not generate signal "
                      , Text
    qualifiedSignalName
                      , Text
    "\n", Text
    "-- Error was : "]
      CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    err

      -- Generate a placeholder SignalInfo instance that raises a type
      -- error when one attempts to use it.
      CPPGuard -> CodeGen e () -> CodeGen e ()
    forall e a. CPPGuard -> CodeGen e a -> CodeGen e a
    cppIf CPPGuard
    CPPOverloading (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ 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
        si <- Name -> Signal -> CodeGen e Text
    forall e. Name -> Signal -> CodeGen e Text
    signalInfoName Name
    owner Signal
    signal
        bline $ "data " <> si
        line $ "instance SignalInfo " <> si <> " where"
        indent $ do
          line $ "type HaskellCallbackType " <> si <>
            " = B.Signals.SignalCodeGenError \"" <> qualifiedSignalName <> "\""
          line $ "connectSignal = undefined"
        export (NamedSubsection SignalSection $ lcFirst sn) si

    -- | Generate a wrapper for a signal.
    genSignal :: Signal -> Name -> CodeGen e ()
    genSignal :: forall e. Signal -> Name -> CodeGen e ()
    genSignal s :: Signal
    s@(Signal { sigName :: Signal -> Text
    sigName = Text
    sn, sigCallable :: Signal -> Callable
    sigCallable = Callable
    cb }) Name
    on =
      (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (Signal -> Name -> CGError -> CodeGen e ()
    forall e. Signal -> Name -> CGError -> CodeGen e ()
    processSignalError Signal
    s Name
    on) (ExcCodeGen () -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
      let on' :: Text
    on' = Name -> Text
    upperName Name
    on

      Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- signal " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    on' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    sn

      let sn' :: Text
    sn' = Text -> Text
    signalHaskellName Text
    sn
          signalConnectorName :: Text
    signalConnectorName = Text
    on' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    ucFirst Text
    sn'
          cbType :: Text
    cbType = Text
    signalConnectorName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "Callback"
          docSection :: HaddockSection
    docSection = NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    SignalSection (Text -> HaddockSection) -> Text -> HaddockSection
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    lcFirst Text
    sn'

      Text -> Maybe DeprecationInfo -> ExcCodeGen ()
    forall e. Text -> Maybe DeprecationInfo -> CodeGen e ()
    deprecatedPragma Text
    cbType (Callable -> Maybe DeprecationInfo
    callableDeprecated Callable
    cb)

      Text
    -> Callable
    -> Text
    -> ExposeClosures
    -> Bool
    -> Documentation
    -> ExcCodeGen ()
    genHaskellCallbackPrototype (Text -> Text
    lcFirst Text
    sn') Callable
    cb Text
    cbType ExposeClosures
    WithoutClosures Bool
    True (Signal -> Documentation
    sigDoc Signal
    s)

      _ <- Text -> Callable -> Text -> Maybe Text -> ExcCodeGen Text
    forall e. Text -> Callable -> Text -> Maybe Text -> CodeGen e Text
    genCCallbackPrototype (Text -> Text
    lcFirst Text
    sn') Callable
    cb Text
    cbType (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    on')

      genCallbackWrapperFactory (lcFirst sn') cbType True

      if callableThrows cb
        then do
          line $ "-- No Haskell->C wrapper generated since the function throws."
          blank
        else do
          genCallbackWrapper (lcFirst sn') cb cbType (Just on')

      -- Wrapper for connecting functions to the signal
      -- We can connect to a signal either before the default handler runs
      -- ("on...") or after the default handler runs (after...). We
      -- provide convenient wrappers for both cases.
      group $ do
        -- Notice that we do not include GObject here as a constraint,
        -- since if something provides signals it is necessarily a
        -- GObject.
        klass <- classConstraint on

        addLanguagePragma "ImplicitParams"
        addLanguagePragma "RankNTypes"

        let signatureConstraints = Text
    "(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    klass Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " a, MonadIO m) =>"
            implicitSelfCBType = Text
    "((?self :: a) => " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    cbType Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
            signatureArgs = if Signal -> Bool
    sigDetailed Signal
    s
              then Text
    "a -> P.Maybe T.Text -> " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    implicitSelfCBType Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> m SignalHandlerId"
              else Text
    "a -> " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    implicitSelfCBType Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> m SignalHandlerId"
            signature = Text
    " :: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    signatureConstraints Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    signatureArgs
            onName = Text
    "on" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    signalConnectorName
            afterName = Text
    "after" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    signalConnectorName

        group $ do
          writeHaddock DocBeforeSymbol onDoc
          line $ onName <> signature
          if sigDetailed s
            then do
            line $ onName <> " obj detail cb = liftIO $ do"
            indent $ do
              line $ "let wrapped self = let ?self = self in cb"
              genSignalConnector s cbType "SignalConnectBefore" "detail" "wrapped"
            else do
            line $ onName <> " obj cb = liftIO $ do"
            indent $ do
              line $ "let wrapped self = let ?self = self in cb"
              genSignalConnector s cbType "SignalConnectBefore" "Nothing" "wrapped"
          export docSection onName

        group $ do
          writeHaddock DocBeforeSymbol afterDoc
          line $ afterName <> signature
          if sigDetailed s
            then do
            line $ afterName <> " obj detail cb = liftIO $ do"
            indent $ do
              line $ "let wrapped self = let ?self = self in cb"
              genSignalConnector s cbType "SignalConnectAfter" "detail" "wrapped"
            else do
            line $ afterName <> " obj cb = liftIO $ do"
            indent $ do
              line $ "let wrapped self = let ?self = self in cb"
              genSignalConnector s cbType "SignalConnectAfter" "Nothing" "wrapped"
          export docSection afterName

      cppIf CPPOverloading (genSignalInfoInstance on s)

      where
        onDoc :: Text
        onDoc :: Text
    onDoc = let hsn :: Text
    hsn = Text -> Text
    signalHaskellName Text
    sn
                in [Text] -> Text
    T.unlines [
          Text
    "Connect a signal handler for the [" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    hsn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "](#signal:" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    hsn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
            Text
    ") signal, to be run before the default handler."
          , Text
    "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"
          , Text
    ""
          , Text
    "@"
          , Text
    "'Data.GI.Base.Signals.on' " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    lowerName Name
    on Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " #"
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    hsn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " callback"
          , Text
    "@"
          , Text
    ""
          , Text
    detailedDoc ]

        afterDoc :: Text
        afterDoc :: Text
    afterDoc = let hsn :: Text
    hsn = Text -> Text
    signalHaskellName Text
    sn
                   in [Text] -> Text
    T.unlines [
          Text
    "Connect a signal handler for the [" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    hsn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "](#signal:" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    hsn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
            Text
    ") signal, to be run after the default handler."
          , Text
    "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"
          , Text
    ""
          , Text
    "@"
          , Text
    "'Data.GI.Base.Signals.after' " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Name -> Text
    lowerName Name
    on Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " #"
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    hsn Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " callback"
          , Text
    "@"
          , Text
    ""
          , Text
    detailedDoc
          , Text
    ""
          , Text
    selfDoc]

        detailedDoc :: Text
        detailedDoc :: Text
    detailedDoc = if Bool -> Bool
    not (Signal -> Bool
    sigDetailed Signal
    s)
                      then Text
    ""
                      else [Text] -> Text
    T.unlines [
          Text
    "This signal admits a optional parameter @detail@."
          , Text
    "If it's not @Nothing@, we will connect to “@" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    sn
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "::detail@” instead."
          ]

        selfDoc :: Text
        selfDoc :: Text
    selfDoc = [Text] -> Text
    T.unlines [
          Text
    "By default the object invoking the signal is not passed to the callback."
          , Text
    "If you need to access it, you can use the implit @?self@ parameter."
          , Text
    "Note that this requires activating the @ImplicitParams@ GHC extension."
          ]

    -- | Generate the code for connecting the given signal. This assumes
    -- that it lives inside a @do@ block.
    genSignalConnector :: Signal
                       -> Text -- ^ Callback type
                       -> Text -- ^ SignalConnectBefore or SignalConnectAfter
                       -> Text -- ^ Detail
                       -> Text -- ^ Name of variable holding the callback
                       -> CodeGen e ()
    genSignalConnector :: forall e. Signal -> Text -> Text -> Text -> Text -> CodeGen e ()
    genSignalConnector (Signal {sigName :: Signal -> Text
    sigName = Text
    sn, sigCallable :: Signal -> Callable
    sigCallable = Callable
    cb})
                       Text
    cbType Text
    when Text
    detail Text
    cbName = do
      cb' <- Callable -> Text -> Text -> Bool -> CodeGen e Text
    forall e. Callable -> Text -> Text -> Bool -> CodeGen e Text
    genWrappedCallback Callable
    cb Text
    cbName Text
    cbType Bool
    True
      let cb'' = Text -> Text
    prime Text
    cb'
      line $ cb'' <> " <- " <> callbackWrapperAllocator cbType <> " " <> cb'
      line $ "connectSignalFunPtr obj \"" <> sn <> "\" " <> cb'' <> " " <> when
              <> " " <> detail