{-# 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
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
appNew ::
(HasCallStack, MonadIO m, MonadFail m)
=> Maybe Text
-> [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
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)
terminalSetEnableSixelIfExists
:: (HasCallStack, MonadIO m, IsTerminal t)
=> t
-> Bool
-> 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 ()