    {-# LANGUAGE CPP #-}

    module Termonad.Gtk where

    import Termonad.Prelude

    import Control.Monad.Fail (MonadFail, fail)
    import Data.GI.Base (ManagedPtr, withManagedPtr)
    import GHC.Stack (HasCallStack)
    import GI.Gdk
      ( GObject
      , castTo
      )
    import GI.Gio (ApplicationFlags)
    import GI.Gtk (Application, IsWidget, Widget(Widget), applicationNew, builderGetObject, toWidget)
    import qualified GI.Gtk as Gtk

    objFromBuildUnsafe ::
         GObject o => Gtk.Builder -> Text -> (ManagedPtr o -> o) -> IO o
    objFromBuildUnsafe :: Builder -> Text -> (ManagedPtr o -> o) -> IO o
    objFromBuildUnsafe builder :: Builder
    builder name :: Text
    name constructor :: ManagedPtr o -> o
    constructor = do
      Maybe Object
    maybePlainObj <- Builder -> Text -> IO (Maybe Object)
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsBuilder a) =>
    a -> Text -> m (Maybe Object)
    builderGetObject Builder
    builder Text
    name
      case Maybe Object
    maybePlainObj of
        Nothing -> [Char] -> IO o
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO o) -> [Char] -> IO o
    forall a b. (a -> b) -> a -> b
    $ "Couldn't get " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Element Text]
    forall mono. MonoFoldable mono => mono -> [Element mono]
    unpack Text
    name [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> " from builder!"
        Just plainObj :: Object
    plainObj -> do
          Maybe o
    maybeNewObj <- (ManagedPtr o -> o) -> Object -> IO (Maybe o)
    forall o o'.
    (HasCallStack, ManagedPtrNewtype o, TypedObject o,
     ManagedPtrNewtype o', TypedObject o', GObject o') =>
    (ManagedPtr o' -> o') -> o -> IO (Maybe o')
    castTo ManagedPtr o -> o
    constructor Object
    plainObj
          case Maybe o
    maybeNewObj of
            Nothing ->
              [Char] -> IO o
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO o) -> [Char] -> IO o
    forall a b. (a -> b) -> a -> b
    $
                "Got " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                Text -> [Element Text]
    forall mono. MonoFoldable mono => mono -> [Element mono]
    unpack Text
    name [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                " from builder, but couldn't convert to object!"
            Just obj :: o
    obj -> o -> IO o
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure o
    obj

    -- | Unsafely creates a new 'Application'.  This calls 'fail' if it cannot
    -- create the 'Application' for some reason.
    --
    -- This can fail for different reasons, one of which being that application
    -- name does not have a period in it.
    appNew ::
         (HasCallStack, MonadIO m, MonadFail m)
      => Maybe Text
      -- ^ The application name.  Must have a period in it if specified.  If passed
      -- as 'Nothing', then no application name will be used.
      -> [ApplicationFlags]
      -> m Application
    appNew :: Maybe Text -> [ApplicationFlags] -> m Application
    appNew appName :: Maybe Text
    appName appFlags :: [ApplicationFlags]
    appFlags = do
      Maybe Application
    maybeApp <- Maybe Text -> [ApplicationFlags] -> m (Maybe Application)
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> [ApplicationFlags] -> m (Maybe Application)
    applicationNew Maybe Text
    appName [ApplicationFlags]
    appFlags
      case Maybe Application
    maybeApp of
        Nothing -> [Char] -> m Application
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail "Could not create application for some reason!"
        Just app :: Application
    app -> Application -> m Application
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Application
    app

    -- | Tests to see if two GTK widgets point to the same thing.  This should only
    -- happen if they are actually the same thing.
    widgetEq :: (MonadIO m, IsWidget a, IsWidget b) => a -> b -> m Bool
    widgetEq :: a -> b -> m Bool
    widgetEq a :: a
    a b :: b
    b = do
      Widget managedPtrA :: ManagedPtr Widget
    managedPtrA <- a -> m Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget a
    a
      Widget managedPtrB :: ManagedPtr Widget
    managedPtrB <- b -> m Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget b
    b
      IO Bool -> m Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $
        ManagedPtr Widget
    -> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr ManagedPtr Widget
    managedPtrA ((Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool)
    -> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \ptrA :: Ptr (ManagedPtr Widget)
    ptrA ->
          ManagedPtr Widget
    -> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr ManagedPtr Widget
    managedPtrB ((Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool)
    -> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \ptrB :: Ptr (ManagedPtr Widget)
    ptrB ->
            Bool -> IO Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ptr (ManagedPtr Widget)
    ptrA Ptr (ManagedPtr Widget) -> Ptr (ManagedPtr Widget) -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr (ManagedPtr Widget)
    ptrB)