{-# 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'.
(GObject 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
appNew ::
(HasCallStack, MonadIO m, MonadFail m)
=> Maybe Text
-> [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
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)