{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors -fno-warn-orphans #-}

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

-- | Implementation of 'Gtk.Paned' as a declarative container.
module GI.Gtk.Declarative.Container.Paned
  ( Pane
  , PaneProperties(..)
  , defaultPaneProperties
  , pane
  , paned
  )
where

import           Data.Coerce                    ( coerce )
import           Data.Default.Class             ( Default(def) )
import           Data.Vector                    ( Vector )
import qualified Data.Vector                   as 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.EventSource
import           GI.Gtk.Declarative.Patch
import           GI.Gtk.Declarative.Widget

-- | Describes a pane to be packed with
-- 'Gtk.panePack1'/'Gtk.panePack2' in a 'Gtk.Paned'.
data Pane event = Pane
  { Pane event -> PaneProperties
paneProperties :: PaneProperties
  , Pane event -> Widget event
paneChild      :: Widget event
  }
  deriving (a -> Pane b -> Pane a
(a -> b) -> Pane a -> Pane b
(forall a b. (a -> b) -> Pane a -> Pane b)
-> (forall a b. a -> Pane b -> Pane a) -> Functor Pane
forall a b. a -> Pane b -> Pane a
forall a b. (a -> b) -> Pane a -> Pane b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pane b -> Pane a
$c<$ :: forall a b. a -> Pane b -> Pane a
fmap :: (a -> b) -> Pane a -> Pane b
$cfmap :: forall a b. (a -> b) -> Pane a -> Pane b
Functor)

-- | Values used when packing a pane into a 'Gtk.Paned'.
data PaneProperties = PaneProperties
  { PaneProperties -> Bool
resize :: Bool
  , PaneProperties -> Bool
shrink :: Bool
  }

-- | Defaults for 'PaneProperties'. Use these and override specific
-- fields.
defaultPaneProperties :: PaneProperties
defaultPaneProperties :: PaneProperties
defaultPaneProperties = PaneProperties :: Bool -> Bool -> PaneProperties
PaneProperties { resize :: Bool
resize = Bool
False, shrink :: Bool
shrink = Bool
True }

instance Default PaneProperties where
  def :: PaneProperties
def = PaneProperties
defaultPaneProperties

-- | Construct a pane to be packed with
-- 'Gtk.panePack1'/'Gtk.panePack2' in a 'Gtk.Paned'.
pane :: PaneProperties -> Widget event -> Pane event
pane :: PaneProperties -> Widget event -> Pane event
pane paneProperties :: PaneProperties
paneProperties paneChild :: Widget event
paneChild = Pane :: forall event. PaneProperties -> Widget event -> Pane event
Pane { .. }

instance Patchable Pane where
  create :: Pane e -> IO SomeState
create = Widget e -> IO SomeState
forall (widget :: * -> *) e.
Patchable widget =>
widget e -> IO SomeState
create (Widget e -> IO SomeState)
-> (Pane e -> Widget e) -> Pane e -> IO SomeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pane e -> Widget e
forall event. Pane event -> Widget event
paneChild
  patch :: SomeState -> Pane e1 -> Pane e2 -> Patch
patch s :: SomeState
s b1 :: Pane e1
b1 b2 :: Pane e2
b2 = SomeState -> Widget e1 -> Widget e2 -> Patch
forall (widget :: * -> *) e1 e2.
Patchable widget =>
SomeState -> widget e1 -> widget e2 -> Patch
patch SomeState
s (Pane e1 -> Widget e1
forall event. Pane event -> Widget event
paneChild Pane e1
b1) (Pane e2 -> Widget e2
forall event. Pane event -> Widget event
paneChild Pane e2
b2)

instance EventSource Pane where
  subscribe :: Pane event -> SomeState -> (event -> IO ()) -> IO Subscription
subscribe Pane {..} = Widget event -> SomeState -> (event -> IO ()) -> IO Subscription
forall (widget :: * -> *) event.
EventSource widget =>
widget event -> SomeState -> (event -> IO ()) -> IO Subscription
subscribe Widget event
paneChild

-- | Construct a 'Gtk.Paned' based on attributes and two child 'Pane's.
paned
  :: Vector (Attribute Gtk.Paned event)
  -> Pane event
  -> Pane event
  -> Widget event
paned :: Vector (Attribute Paned event)
-> Pane event -> Pane event -> Widget event
paned attrs :: Vector (Attribute Paned event)
attrs p1 :: Pane event
p1 p2 :: Pane event
p2 = (ManagedPtr Paned -> Paned)
-> Vector (Attribute Paned event)
-> Panes (Pane 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 Paned -> Paned
Gtk.Paned Vector (Attribute Paned event)
attrs (Pane event -> Pane event -> Panes (Pane event)
forall child. child -> child -> Panes child
Panes Pane event
p1 Pane event
p2)

data Panes child = Panes child child
  deriving (a -> Panes b -> Panes a
(a -> b) -> Panes a -> Panes b
(forall a b. (a -> b) -> Panes a -> Panes b)
-> (forall a b. a -> Panes b -> Panes a) -> Functor Panes
forall a b. a -> Panes b -> Panes a
forall a b. (a -> b) -> Panes a -> Panes b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Panes b -> Panes a
$c<$ :: forall a b. a -> Panes b -> Panes a
fmap :: (a -> b) -> Panes a -> Panes b
$cfmap :: forall a b. (a -> b) -> Panes a -> Panes b
Functor)

instance IsContainer Gtk.Paned Pane where
  appendChild :: Paned -> Pane event -> Widget -> IO ()
appendChild paned' :: Paned
paned' Pane { paneProperties :: forall event. Pane event -> PaneProperties
paneProperties = PaneProperties { Bool
resize :: Bool
resize :: PaneProperties -> Bool
resize, Bool
shrink :: Bool
shrink :: PaneProperties -> Bool
shrink } } widget' :: Widget
widget'
    = do
      Maybe Widget
c1 <- Paned -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPaned a) =>
a -> m (Maybe Widget)
Gtk.panedGetChild1 Paned
paned'
      Maybe Widget
c2 <- Paned -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPaned a) =>
a -> m (Maybe Widget)
Gtk.panedGetChild2 Paned
paned'
      case (Maybe Widget
c1, Maybe Widget
c2) of
        (Nothing, Nothing) ->
          Paned -> Widget -> Bool -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPaned a, IsWidget b) =>
a -> b -> Bool -> Bool -> m ()
Gtk.panedPack1 Paned
paned' Widget
widget' (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
resize) (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
shrink)
        (Just _, Nothing) ->
          Paned -> Widget -> Bool -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPaned a, IsWidget b) =>
a -> b -> Bool -> Bool -> m ()
Gtk.panedPack2 Paned
paned' Widget
widget' (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
resize) (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
shrink)
        _ -> 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")
          [LogLevelFlags
GLib.LogLevelFlagsLevelWarning]
          (Text -> Maybe Text
forall a. a -> Maybe a
Just
            "appendChild: The `GI.Gtk.Paned` widget can only fit 2 panes. Additional children will be ignored."
          )
          Ptr ()
forall a. Ptr a
nullPtr
  replaceChild :: Paned -> Pane event -> Int32 -> Widget -> Widget -> IO ()
replaceChild paned' :: Paned
paned' Pane { paneProperties :: forall event. Pane event -> PaneProperties
paneProperties = PaneProperties { Bool
resize :: Bool
resize :: PaneProperties -> Bool
resize, Bool
shrink :: Bool
shrink :: PaneProperties -> Bool
shrink } } i :: Int32
i old :: Widget
old new :: Widget
new
    = do
      Widget -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetDestroy Widget
old
      case Int32
i of
        0 -> Paned -> Widget -> Bool -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPaned a, IsWidget b) =>
a -> b -> Bool -> Bool -> m ()
Gtk.panedPack1 Paned
paned' Widget
new (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
resize) (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
shrink)
        1 -> Paned -> Widget -> Bool -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPaned a, IsWidget b) =>
a -> b -> Bool -> Bool -> m ()
Gtk.panedPack2 Paned
paned' Widget
new (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
resize) (Bool -> Bool
forall a b. Coercible a b => a -> b
coerce Bool
shrink)
        _ -> 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")
          [LogLevelFlags
GLib.LogLevelFlagsLevelWarning]
          (Text -> Maybe Text
forall a. a -> Maybe a
Just
            "replaceChild: The `GI.Gtk.Paned` widget can only fit 2 panes. Additional children will be ignored."
          )
          Ptr ()
forall a. Ptr a
nullPtr

instance ToChildren Gtk.Paned Panes Pane where
  toChildren :: (ManagedPtr Paned -> Paned)
-> Panes (Pane event) -> Children Pane event
toChildren _ (Panes p1 :: Pane event
p1 p2 :: Pane event
p2) = Vector (Pane event) -> Children Pane event
forall (child :: * -> *) event.
Vector (child event) -> Children child event
Children ([Pane event] -> Vector (Pane event)
forall a. [a] -> Vector a
Vector.fromList [Pane event
p1, Pane event
p2])