-- 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 -> s widget -> m ()
sinkBin bin :: bin
bin sinkableWidget :: s widget
sinkableWidget =
  Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ (Event t (Performable m ()) -> m ())
-> (Event t widget -> Event t (Performable m ()))
-> Event t widget
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (widget -> Performable m ())
-> Event t widget -> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\widget :: widget
widget -> IO () -> Performable m ()
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m a
runGtk
                                   (IO () -> Performable m ()) -> IO () -> Performable m ()
forall a b. (a -> b) -> a -> b
$ bin -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBin a) =>
a -> m (Maybe Widget)
binGetChild bin
bin IO (Maybe Widget) -> (Maybe Widget -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Widget -> IO ()) -> Maybe Widget -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (bin -> Widget -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerRemove bin
bin)
                                   IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> bin -> widget -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd bin
bin widget
widget
                       ) (Event t widget -> m ()) -> m (Event t widget) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s widget -> m (Event t widget)
forall t (s :: * -> *) (m :: * -> *) a.
(Sinkable t s, PostBuild t m) =>
s a -> m (Event t a)
toSinkEvent s widget
sinkableWidget