{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module GI.Gtk.Declarative.Container.Notebook
( Page
, page
, pageWithTab
, notebook
)
where
import Control.Monad ( void )
import Data.Maybe ( isNothing )
import Data.Text ( Text
, pack
)
import Data.Vector ( Vector )
import GHC.Ptr ( nullPtr )
import qualified GI.GLib as GLib
import qualified GI.Gtk as Gtk
import GI.Gtk.Declarative.Attributes
import GI.Gtk.Declarative.Container
import GI.Gtk.Declarative.Container.Class
import GI.Gtk.Declarative.SingleWidget
import GI.Gtk.Declarative.Widget
data Page event =
Page
{ tabLabel :: Widget event
, child :: Widget event
}
page :: Text -> Widget event -> Page event
page label = pageWithTab (widget Gtk.Label [#label := label])
pageWithTab :: Widget event -> Widget event -> Page event
pageWithTab = Page
notebook
:: Vector (Attribute Gtk.Notebook event)
-> Vector (Page event)
-> Widget event
notebook attrs children =
let childrenAndTabs = children >>= (\Page {..} -> [child, tabLabel])
in container Gtk.Notebook attrs childrenAndTabs
instance ToChildren Gtk.Notebook Vector Widget
instance IsContainer Gtk.Notebook Widget where
appendChild parent _ new = do
lastPage <- Gtk.notebookGetNthPage parent (-1)
case lastPage of
Nothing -> do
void $ Gtk.notebookAppendPage parent new (Nothing :: Maybe Gtk.Widget)
Just p -> do
label <- Gtk.notebookGetTabLabel parent p
if isNothing label
then do
Gtk.notebookSetTabLabel parent p (Just new)
else do
void $ Gtk.notebookAppendPage parent
new
(Nothing :: Maybe Gtk.Widget)
replaceChild parent _ i old new = do
let i' = i `div` 2
pageI <- Gtk.notebookGetNthPage parent i'
case pageI of
Nothing -> do
GLib.logDefaultHandler
(Just "gi-gtk-declarative")
[GLib.LogLevelFlagsLevelError]
(Just
$ "GI.Gtk.Declarative.Container.Notebook.replaceChild called with an index where there is no child: "
<> pack (show i)
)
nullPtr
Just p -> do
if i `mod` 2 == 0
then do
label <- Gtk.notebookGetTabLabel parent p
Gtk.widgetDestroy old
void $ Gtk.notebookInsertPage parent new label i'
else do
Gtk.notebookSetTabLabel parent p (Just new)