{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE RecordWildCards       #-}

-- | Implementation of 'Gtk.Grid' as a declarative container.
module GI.Gtk.Declarative.Container.Grid
  ( GridChild(..)
  , GridChildProperties(..)
  , defaultGridChildProperties
  )
where

import           Data.Default.Class             ( Default(def) )
import           Data.Int                       ( Int32 )
import           Data.Vector                    ( Vector )
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 to a 'Grid'.
data GridChild event =
  GridChild
    { GridChild event -> GridChildProperties
properties :: GridChildProperties
    , GridChild event -> Widget event
child      :: Widget event
    }
  deriving (a -> GridChild b -> GridChild a
(a -> b) -> GridChild a -> GridChild b
(forall a b. (a -> b) -> GridChild a -> GridChild b)
-> (forall a b. a -> GridChild b -> GridChild a)
-> Functor GridChild
forall a b. a -> GridChild b -> GridChild a
forall a b. (a -> b) -> GridChild a -> GridChild b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GridChild b -> GridChild a
$c<$ :: forall a b. a -> GridChild b -> GridChild a
fmap :: (a -> b) -> GridChild a -> GridChild b
$cfmap :: forall a b. (a -> b) -> GridChild a -> GridChild b
Functor)

-- | Values used when /packing/ child widgets into grids.
data GridChildProperties =
  GridChildProperties
    { GridChildProperties -> Int32
height     :: Int32
    , GridChildProperties -> Int32
width      :: Int32
    , GridChildProperties -> Int32
leftAttach :: Int32
    , GridChildProperties -> Int32
topAttach  :: Int32
    }
  deriving (GridChildProperties -> GridChildProperties -> Bool
(GridChildProperties -> GridChildProperties -> Bool)
-> (GridChildProperties -> GridChildProperties -> Bool)
-> Eq GridChildProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GridChildProperties -> GridChildProperties -> Bool
$c/= :: GridChildProperties -> GridChildProperties -> Bool
== :: GridChildProperties -> GridChildProperties -> Bool
$c== :: GridChildProperties -> GridChildProperties -> Bool
Eq, Int -> GridChildProperties -> ShowS
[GridChildProperties] -> ShowS
GridChildProperties -> String
(Int -> GridChildProperties -> ShowS)
-> (GridChildProperties -> String)
-> ([GridChildProperties] -> ShowS)
-> Show GridChildProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GridChildProperties] -> ShowS
$cshowList :: [GridChildProperties] -> ShowS
show :: GridChildProperties -> String
$cshow :: GridChildProperties -> String
showsPrec :: Int -> GridChildProperties -> ShowS
$cshowsPrec :: Int -> GridChildProperties -> ShowS
Show)

-- | Defaults for 'GridChildProperties'. Use these and override
-- specific fields.
defaultGridChildProperties :: GridChildProperties
defaultGridChildProperties :: GridChildProperties
defaultGridChildProperties =
  GridChildProperties :: Int32 -> Int32 -> Int32 -> Int32 -> GridChildProperties
GridChildProperties { height :: Int32
height = 1, width :: Int32
width = 1, leftAttach :: Int32
leftAttach = 0, topAttach :: Int32
topAttach = 0 }

instance Default GridChildProperties where
  def :: GridChildProperties
def = GridChildProperties
defaultGridChildProperties

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

instance EventSource GridChild where
  subscribe :: GridChild event -> SomeState -> (event -> IO ()) -> IO Subscription
subscribe GridChild {..} = 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.Grid Vector GridChild

instance IsContainer Gtk.Grid GridChild where
  appendChild :: Grid -> GridChild event -> Widget -> IO ()
appendChild grid :: Grid
grid GridChild { GridChildProperties
properties :: GridChildProperties
properties :: forall event. GridChild event -> GridChildProperties
properties } widget' :: Widget
widget' = do
    let GridChildProperties { Int32
width :: Int32
width :: GridChildProperties -> Int32
width, Int32
height :: Int32
height :: GridChildProperties -> Int32
height, Int32
leftAttach :: Int32
leftAttach :: GridChildProperties -> Int32
leftAttach, Int32
topAttach :: Int32
topAttach :: GridChildProperties -> Int32
topAttach } =
          GridChildProperties
properties
    Grid -> Widget -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsGrid a, IsWidget b) =>
a -> b -> Int32 -> Int32 -> Int32 -> Int32 -> m ()
Gtk.gridAttach Grid
grid Widget
widget' Int32
leftAttach Int32
topAttach Int32
width Int32
height
  replaceChild :: Grid -> GridChild event -> Int32 -> Widget -> Widget -> IO ()
replaceChild grid :: Grid
grid gridChild' :: GridChild event
gridChild' _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
    Grid -> GridChild event -> Widget -> IO ()
forall container (child :: * -> *) event.
IsContainer container child =>
container -> child event -> Widget -> IO ()
appendChild Grid
grid GridChild event
gridChild' Widget
new