    {-# LANGUAGE ScopedTypeVariables #-}

    -- This is needed because of using the IsWidget constraint synonym in
    -- printWidgetTree.  See
    -- https://github.com/haskell-gi/haskell-gi/pull/376#discussion_r786423429
    -- for a little discussion of this.
    {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-}

    -- |
    -- Stability   : provisional
    -- Portability : portable (depends on GHC)
    --
    -- Helper functions for working with 'Widget's.

    module Data.GI.Gtk.Widget
        ( printWidgetTree
        ) where

    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Foldable (for_)
    import Data.GI.Base.GObject (gtypeFromInstance)
    import GI.Gtk.Objects.Widget (IsWidget, Widget, toWidget)
    import GI.Gtk (Container(Container), castTo, containerGetChildren, gtypeName, managedForeignPtr, toManagedPtr)

    -- | Print out a tree of decendents for a given GTK 'Widget'.  This function is
    -- mainly to help with debugging.
    --
    -- This function outputs a tree of 'Widget's like the following:
    --
    -- > GtkApplicationWindow  0x00000000068de2a0
    -- >   GtkMenuBar  0x0000000006c661d0
    -- >     GtkModelMenuItem  0x0000000006c72b00
    -- >       GtkAccelLabel  0x0000000006c73b60
    -- >     GtkModelMenuItem  0x0000000006c723c0
    -- >       GtkAccelLabel  0x0000000006c733a0
    -- >   GtkNotebook  0x0000000006b0a200
    -- >     GtkPaned  0x0000000006b073c0
    -- >       GtkScrolledWindow  0x0000000006b0c7c0
    -- >         VteTerminal  0x00000000068af4a0
    -- >       GtkScrolledWindow  0x0000000006b0c470
    -- >         VteTerminal  0x00000000068af370
    --
    -- Note that you may also be interested in
    -- <https://wiki.gnome.org/Projects/GTK/Inspector GTKInspector>, which is a
    -- built-in interactive debugger for GTK applications.
    printWidgetTree :: forall m a. (MonadIO m, IsWidget a) => a -> m ()
    printWidgetTree :: forall (m :: * -> *) a. (MonadIO m, IsWidget a) => a -> m ()
    printWidgetTree a
    widget_ = do
      widget <- a -> m Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget a
    widget_
      go "" widget
      where
        go :: String -> Widget -> m ()
        go :: String -> Widget -> m ()
    go String
    indent Widget
    w = do
          type_ <- IO GType -> m GType
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GType -> m GType) -> IO GType -> m GType
    forall a b. (a -> b) -> a -> b
    $ Widget -> IO GType
    forall o. GObject o => o -> IO GType
    gtypeFromInstance Widget
    w
          name <- liftIO $ gtypeName type_
          let ptr = ManagedPtr Widget -> ForeignPtr Widget
    forall a. ManagedPtr a -> ForeignPtr a
    managedForeignPtr (ManagedPtr Widget -> ForeignPtr Widget)
    -> (Widget -> ManagedPtr Widget) -> Widget -> ForeignPtr Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Widget -> ManagedPtr Widget
    forall a. ManagedPtrNewtype a => a -> ManagedPtr a
    toManagedPtr (Widget -> ForeignPtr Widget) -> Widget -> ForeignPtr Widget
    forall a b. (a -> b) -> a -> b
    $ Widget
    w
          liftIO $ putStrLn $ indent <> name <> "  " <> show ptr
          maybeContainer <- liftIO $ castTo Container w
          for_ maybeContainer $ \Container
    container -> do
            children <- Container -> m [Widget]
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsContainer a) =>
    a -> m [Widget]
    containerGetChildren Container
    container
            for_ children $ \Widget
    child -> do
              String -> Widget -> m ()
    go (String
    "  " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    indent) Widget
    child