{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE OverloadedLists       #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}

-- | Implementation of 'Gtk.Notebook' as a declarative container.
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

-- | Describes a page to be added to a 'Notebook'
data Page event =
  Page
    { Page event -> Widget event
tabLabel :: Widget event
    , Page event -> Widget event
child    :: Widget event
    }

-- | Create a page with a textual label and an arbitrary content widget.
page :: Text -> Widget event -> Page event
page :: Text -> Widget event -> Page event
page label :: Text
label = Widget event -> Widget event -> Page event
forall event. Widget event -> Widget event -> Page event
pageWithTab ((ManagedPtr Label -> Label)
-> Vector (Attribute Label event) -> Widget event
forall widget (target :: * -> *) event.
(Typeable widget, IsWidget widget,
 FromWidget (SingleWidget widget) target) =>
(ManagedPtr widget -> widget)
-> Vector (Attribute widget event) -> target event
widget ManagedPtr Label -> Label
Gtk.Label [IsLabel "label" (AttrLabelProxy "label")
AttrLabelProxy "label"
#label AttrLabelProxy "label" -> Text -> Attribute Label event
forall info widget (attr :: Symbol) getValue setValue event.
(AttrOpAllowed 'AttrConstruct info widget,
 AttrOpAllowed 'AttrSet info widget,
 AttrGetC info widget attr getValue,
 AttrSetTypeConstraint info setValue, KnownSymbol attr,
 Typeable attr, Eq setValue, Typeable setValue) =>
AttrLabelProxy attr -> setValue -> Attribute widget event
:= Text
label])

-- | Create a page with arbitrary widgets for both label and content.
pageWithTab :: Widget event -> Widget event -> Page event
pageWithTab :: Widget event -> Widget event -> Page event
pageWithTab = Widget event -> Widget event -> Page event
forall event. Widget event -> Widget event -> Page event
Page

-- | Create a 'Notebook' by combining multiple pages.
notebook
  :: Vector (Attribute Gtk.Notebook event)
  -> Vector (Page event)
  -> Widget event
notebook :: Vector (Attribute Notebook event)
-> Vector (Page event) -> Widget event
notebook attrs :: Vector (Attribute Notebook event)
attrs children :: Vector (Page event)
children =
  let childrenAndTabs :: Vector (Widget event)
childrenAndTabs = Vector (Page event)
children Vector (Page event)
-> (Page event -> Vector (Widget event)) -> Vector (Widget event)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Page {..} -> [Item (Vector (Widget event))
Widget event
child, Item (Vector (Widget event))
Widget event
tabLabel])
  in  (ManagedPtr Notebook -> Notebook)
-> Vector (Attribute Notebook event)
-> Vector (Widget event)
-> Widget event
forall widget (child :: * -> *) (target :: * -> *)
       (parent :: * -> *) event.
(Typeable widget, Functor child, IsWidget widget,
 IsContainer widget,
 FromWidget (Container widget (Children child)) target,
 ToChildren widget parent child) =>
(ManagedPtr widget -> widget)
-> Vector (Attribute widget event)
-> parent (child event)
-> target event
container ManagedPtr Notebook -> Notebook
Gtk.Notebook Vector (Attribute Notebook event)
attrs Vector (Widget event)
childrenAndTabs

instance ToChildren Gtk.Notebook Vector Widget

instance IsContainer Gtk.Notebook Widget where
  appendChild :: Notebook -> Widget event -> Widget -> IO ()
appendChild parent :: Notebook
parent _ new :: Widget
new = do
    Maybe Widget
lastPage <- Notebook -> Int32 -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Int32 -> m (Maybe Widget)
Gtk.notebookGetNthPage Notebook
parent (-1)
    case Maybe Widget
lastPage of
      -- this is the first page to be added
      Nothing -> do
        IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Notebook -> Widget -> Maybe Widget -> IO Int32
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> m Int32
Gtk.notebookAppendPage Notebook
parent Widget
new (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget)
      Just p :: Widget
p -> do
        Maybe Widget
label <- Notebook -> Widget -> IO (Maybe Widget)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
a -> b -> m (Maybe Widget)
Gtk.notebookGetTabLabel Notebook
parent Widget
p
        if Maybe Widget -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Widget
label
            -- this page must already have a child, we just need to set the label
          then do
            Notebook -> Widget -> Maybe Widget -> IO ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> m ()
Gtk.notebookSetTabLabel Notebook
parent Widget
p (Widget -> Maybe Widget
forall a. a -> Maybe a
Just Widget
new)
          else do
            IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Notebook -> Widget -> Maybe Widget -> IO Int32
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> m Int32
Gtk.notebookAppendPage Notebook
parent
                                          Widget
new
                                          (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget)
  replaceChild :: Notebook -> Widget event -> Int32 -> Widget -> Widget -> IO ()
replaceChild parent :: Notebook
parent _ i :: Int32
i old :: Widget
old new :: Widget
new = do
    let i' :: Int32
i' = Int32
i Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`div` 2
    Maybe Widget
pageI <- Notebook -> Int32 -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Int32 -> m (Maybe Widget)
Gtk.notebookGetNthPage Notebook
parent Int32
i'
    case Maybe Widget
pageI of
      Nothing -> do
        Maybe Text -> [LogLevelFlags] -> Maybe Text -> Ptr () -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> [LogLevelFlags] -> Maybe Text -> Ptr () -> m ()
GLib.logDefaultHandler
          (Text -> Maybe Text
forall a. a -> Maybe a
Just "gi-gtk-declarative")
          [Item [LogLevelFlags]
LogLevelFlags
GLib.LogLevelFlagsLevelError]
          (Text -> Maybe Text
forall a. a -> Maybe a
Just
          (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ "GI.Gtk.Declarative.Container.Notebook.replaceChild called with an index where there is no child: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int32 -> String
forall a. Show a => a -> String
show Int32
i)
          )
          Ptr ()
forall a. Ptr a
nullPtr
      Just p :: Widget
p -> do
        if Int32
i Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`mod` 2 Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0
          then do
            Maybe Widget
label <- Notebook -> Widget -> IO (Maybe Widget)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
a -> b -> m (Maybe Widget)
Gtk.notebookGetTabLabel Notebook
parent Widget
p -- we have to replace the child
            Widget -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetDestroy Widget
old
            IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Notebook -> Widget -> Maybe Widget -> Int32 -> IO Int32
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> Int32 -> m Int32
Gtk.notebookInsertPage Notebook
parent Widget
new Maybe Widget
label Int32
i'
          else do
            Notebook -> Widget -> Maybe Widget -> IO ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> m ()
Gtk.notebookSetTabLabel Notebook
parent Widget
p (Widget -> Maybe Widget
forall a. a -> Maybe a
Just Widget
new) -- we have to replace the label