{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module GI.Gtk.Declarative.Container.ListBox where

import           Data.Vector                    ( Vector )
import qualified GI.Gtk                        as Gtk

import           GI.Gtk.Declarative.Bin
import           GI.Gtk.Declarative.Container.Class

instance IsContainer Gtk.ListBox (Bin Gtk.ListBoxRow) where
  appendChild :: ListBox -> Bin ListBoxRow event -> Widget -> IO ()
appendChild box :: ListBox
box _ widget' :: Widget
widget' = ListBox -> Widget -> Int32 -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListBox a, IsWidget b) =>
a -> b -> Int32 -> m ()
Gtk.listBoxInsert ListBox
box Widget
widget' (-1)
  replaceChild :: ListBox
-> Bin ListBoxRow event -> Int32 -> Widget -> Widget -> IO ()
replaceChild box :: ListBox
box _ 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
    ListBox -> Widget -> Int32 -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListBox a, IsWidget b) =>
a -> b -> Int32 -> m ()
Gtk.listBoxInsert ListBox
box Widget
new Int32
i

instance ToChildren Gtk.ListBox Vector (Bin Gtk.ListBoxRow)