{-# LANGUAGE CPP #-}

-- | This module contains two things:
--
-- 1. Extension functions to libraries like GTK.  These functions wrap up some
--    generic GTK functionality.  They are not Termonad-specific.
--
-- 2. Wrappers around functionality that is only specific to certain versions
--    of libraries like GTK or VTE.
--
--    For instance, 'terminalSetEnableSixelIfExists' is
--    a wrapper around 'terminalSetEnableSixel'.  Sixel support is only availble in
--    vte >= 0.63, so if a user tries to compile Termonad with a version of vte
--    less than 0.63, this function won't do anything.

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
import GI.Vte
  ( IsTerminal
#ifdef VTE_VERSION_GEQ_0_63
  , terminalSetEnableSixel
#endif
  )


objFromBuildUnsafe ::
     GObject o => Gtk.Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe :: forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
builder Text
name 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
    Maybe Object
Nothing -> [Char] -> IO o
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO o) -> [Char] -> IO o
forall a b. (a -> b) -> a -> b
$ [Char]
"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
<> [Char]
" from builder!"
    Just 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
        Maybe o
Nothing ->
          [Char] -> IO o
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO o) -> [Char] -> IO o
forall a b. (a -> b) -> a -> b
$
            [Char]
"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
<>
            [Char]
" from builder, but couldn't convert to object!"
        Just 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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadFail m) =>
Maybe Text -> [ApplicationFlags] -> m Application
appNew Maybe Text
appName [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
    Maybe Application
Nothing -> [Char] -> m Application
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Could not create application for some reason!"
    Just 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 :: forall (m :: * -> *) a b.
(MonadIO m, IsWidget a, IsWidget b) =>
a -> b -> m Bool
widgetEq a
a b
b = do
  Widget ManagedPtr Widget
managedPtrA <- a -> m Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget a
a
  Widget 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
$ \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
$ \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)

-- | Wrapper around 'terminalSetEnableSixel'.  The 'terminalSetEnableSixel' function
-- is only available starting with vte-0.63. This function has no effect when
-- compiling against previous versions of vte.
terminalSetEnableSixelIfExists
  :: (HasCallStack, MonadIO m, IsTerminal t)
  => t -- ^ a Terminal
  -> Bool -- ^ whether to enable SIXEL images
  -> m ()
terminalSetEnableSixelIfExists :: forall (m :: * -> *) t.
(HasCallStack, MonadIO m, IsTerminal t) =>
t -> Bool -> m ()
terminalSetEnableSixelIfExists t
t Bool
b = do
#ifdef VTE_VERSION_GEQ_0_63
  terminalSetEnableSixel t b
#endif
  () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()