Bin.hs

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{-# LANGUAGE FlexibleContexts #-}

{-|
Description : Reactive helpers for 'Bin's
Copyright   : Sven Bartscher 2020
License     : MPL-2.0
Maintainer  : sven.bartscher@weltraumschlangen.de
Stability   : experimental

This module provides helpers for dealing with 'Bin's in reactive
contexts.
-}
module Reflex.GI.Gtk.Widget.Bin
  ( sinkBin
  ) where

import Data.GI.Base (GObject)
import Data.GI.Base.Overloading (IsDescendantOf)
import GI.Gtk ( Bin
              , Container
              , Widget
              , binGetChild
              , containerAdd
              , containerRemove
              )
import Reflex ( PerformEvent
              , Performable
              , PostBuild
              , performEvent_
              )
import Reflex.GI.Gtk.Output ( Sinkable
                            , toSinkEvent
                            )
import Reflex.GI.Gtk.Run.Class ( MonadRunGtk
                               , runGtk
                               )

-- | Display a single reactively changing widget inside a 'Bin'.
sinkBin :: ( MonadRunGtk (Performable m)
           , PerformEvent t m
           , PostBuild t m
           , Sinkable t s
           , GObject bin
           , IsDescendantOf Bin bin
           , IsDescendantOf Container bin
           , GObject widget
           , IsDescendantOf Widget widget
           )
        => bin
        -- ^ The bin to display the widget in
        -> s widget
        -- ^ The changing widget to display
        -> m ()
sinkBin bin sinkableWidget =
  performEvent_ . fmap (\widget -> runGtk
                                   $ binGetChild bin >>= mapM_ (containerRemove bin)
                                   >> containerAdd bin widget
                       ) =<< toSinkEvent sinkableWidget