{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

-- | Implementation of 'Gtk.Box' as a declarative container.
module GI.Gtk.Declarative.Container.Box
  ( BoxChild(..)
  , BoxChildProperties(..)
  , defaultBoxChildProperties
  )
where

import           Data.Default.Class             ( Default(def) )
import           Data.Vector                    ( Vector )
import           Data.Word                      ( Word32 )
import qualified GI.Gtk                        as Gtk

import           GI.Gtk.Declarative.Container.Class
import           GI.Gtk.Declarative.EventSource
import           GI.Gtk.Declarative.Patch
import           GI.Gtk.Declarative.Widget

-- | Describes a child widget to be added with 'boxAppend' to a 'Box'.
data BoxChild event = BoxChild
  { BoxChild event -> BoxChildProperties
properties :: BoxChildProperties
  , BoxChild event -> Widget event
child      :: Widget event
  }
  deriving (a -> BoxChild b -> BoxChild a
(a -> b) -> BoxChild a -> BoxChild b
(forall a b. (a -> b) -> BoxChild a -> BoxChild b)
-> (forall a b. a -> BoxChild b -> BoxChild a) -> Functor BoxChild
forall a b. a -> BoxChild b -> BoxChild a
forall a b. (a -> b) -> BoxChild a -> BoxChild b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BoxChild b -> BoxChild a
$c<$ :: forall a b. a -> BoxChild b -> BoxChild a
fmap :: (a -> b) -> BoxChild a -> BoxChild b
$cfmap :: forall a b. (a -> b) -> BoxChild a -> BoxChild b
Functor)

-- | Values used when /packing/ child widgets into boxes.
data BoxChildProperties = BoxChildProperties
  { BoxChildProperties -> Bool
expand  :: Bool
  , BoxChildProperties -> Bool
fill    :: Bool
  , BoxChildProperties -> Word32
padding :: Word32
  } deriving (BoxChildProperties -> BoxChildProperties -> Bool
(BoxChildProperties -> BoxChildProperties -> Bool)
-> (BoxChildProperties -> BoxChildProperties -> Bool)
-> Eq BoxChildProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxChildProperties -> BoxChildProperties -> Bool
$c/= :: BoxChildProperties -> BoxChildProperties -> Bool
== :: BoxChildProperties -> BoxChildProperties -> Bool
$c== :: BoxChildProperties -> BoxChildProperties -> Bool
Eq, Int -> BoxChildProperties -> ShowS
[BoxChildProperties] -> ShowS
BoxChildProperties -> String
(Int -> BoxChildProperties -> ShowS)
-> (BoxChildProperties -> String)
-> ([BoxChildProperties] -> ShowS)
-> Show BoxChildProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxChildProperties] -> ShowS
$cshowList :: [BoxChildProperties] -> ShowS
show :: BoxChildProperties -> String
$cshow :: BoxChildProperties -> String
showsPrec :: Int -> BoxChildProperties -> ShowS
$cshowsPrec :: Int -> BoxChildProperties -> ShowS
Show)

-- | Defaults for 'BoxChildProperties'. Use these and override
-- specific fields.
defaultBoxChildProperties :: BoxChildProperties
defaultBoxChildProperties :: BoxChildProperties
defaultBoxChildProperties =
  BoxChildProperties :: Bool -> Bool -> Word32 -> BoxChildProperties
BoxChildProperties { expand :: Bool
expand = Bool
False, fill :: Bool
fill = Bool
False, padding :: Word32
padding = 0 }

instance Default BoxChildProperties where
  def :: BoxChildProperties
def = BoxChildProperties
defaultBoxChildProperties

instance Patchable BoxChild where
  create :: BoxChild e -> IO SomeState
create = Widget e -> IO SomeState
forall (widget :: * -> *) e.
Patchable widget =>
widget e -> IO SomeState
create (Widget e -> IO SomeState)
-> (BoxChild e -> Widget e) -> BoxChild e -> IO SomeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxChild e -> Widget e
forall event. BoxChild event -> Widget event
child
  patch :: SomeState -> BoxChild e1 -> BoxChild e2 -> Patch
patch s :: SomeState
s b1 :: BoxChild e1
b1 b2 :: BoxChild e2
b2 | BoxChild e1 -> BoxChildProperties
forall event. BoxChild event -> BoxChildProperties
properties BoxChild e1
b1 BoxChildProperties -> BoxChildProperties -> Bool
forall a. Eq a => a -> a -> Bool
== BoxChild e2 -> BoxChildProperties
forall event. BoxChild event -> BoxChildProperties
properties BoxChild e2
b2 = SomeState -> Widget e1 -> Widget e2 -> Patch
forall (widget :: * -> *) e1 e2.
Patchable widget =>
SomeState -> widget e1 -> widget e2 -> Patch
patch SomeState
s (BoxChild e1 -> Widget e1
forall event. BoxChild event -> Widget event
child BoxChild e1
b1) (BoxChild e2 -> Widget e2
forall event. BoxChild event -> Widget event
child BoxChild e2
b2)
                | Bool
otherwise                      = IO SomeState -> Patch
Replace (BoxChild e2 -> IO SomeState
forall (widget :: * -> *) e.
Patchable widget =>
widget e -> IO SomeState
create BoxChild e2
b2)

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

instance ToChildren Gtk.Box Vector BoxChild

instance IsContainer Gtk.Box BoxChild where
  appendChild :: Box -> BoxChild event -> Widget -> IO ()
appendChild box :: Box
box BoxChild { properties :: forall event. BoxChild event -> BoxChildProperties
properties = BoxChildProperties { Bool
expand :: Bool
expand :: BoxChildProperties -> Bool
expand, Bool
fill :: Bool
fill :: BoxChildProperties -> Bool
fill, Word32
padding :: Word32
padding :: BoxChildProperties -> Word32
padding } } widget' :: Widget
widget'
    = Box -> Widget -> Bool -> Bool -> Word32 -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Bool -> Bool -> Word32 -> m ()
Gtk.boxPackStart Box
box Widget
widget' Bool
expand Bool
fill Word32
padding
  replaceChild :: Box -> BoxChild event -> Int32 -> Widget -> Widget -> IO ()
replaceChild box :: Box
box boxChild' :: BoxChild event
boxChild' 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
    Box -> BoxChild event -> Widget -> IO ()
forall container (child :: * -> *) event.
IsContainer container child =>
container -> child event -> Widget -> IO ()
appendChild Box
box BoxChild event
boxChild' Widget
new
    Box -> Widget -> Int32 -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Int32 -> m ()
Gtk.boxReorderChild Box
box Widget
new Int32
i