Utils.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 OverloadedLabels #-}

{-|
Description : Miscellaneous 'Widget' helpers
Copyright   : Sven Bartscher 2020
License     : MPL-2.0
Maintainer  : sven.bartscher@weltraumschlangen.de
Stability   : experimental

This module provides miscellaneous helpers for dealing with GTK
'Widget's in reactive contexts.
-}
module Reflex.GI.Gtk.Widget.Utils
  ( holdNotReadyWidget
  , holdNotReadyDynamicWidget
  , notReadyWidget
  ) where

import Control.Monad (join)
import GI.Gtk ( Widget
              , spinnerNew
              , toWidget
              )
import Reflex ( Dynamic
              , Event
              , MonadHold
              , Reflex
              , holdDyn
              )
import Reflex.GI.Gtk.Run.Class ( MonadRunGtk
                               , runGtk
                               )

-- | A widget appropriate for displaying in place of widgets that
-- aren't available yet, e.g. as replacement for widgets that aren't
-- available until post-build time.
--
-- The current implementation returns a 'GI.Gtk.Spinner' that has been
-- started ('GI.Gtk.spinnerStart').
--
-- Note that the widget is not 'GI.Gtk.widgetShow'n in this
-- function. If you want the 'Widget' to be actually shown, you should
-- call 'GI.Gtk.widgetShow' explicitly on it.
notReadyWidget :: IO Widget
notReadyWidget = do
  spinner <- spinnerNew
  #start spinner
  toWidget spinner

-- | Hold an 'Event' firing 'Widget's in a 'Dynamic', automatically
-- using a 'notReadyWidget' as the initial value.
holdNotReadyWidget :: ( MonadRunGtk m
                      , MonadHold t m
                      )
                   => Event t Widget -> m (Dynamic t Widget)
holdNotReadyWidget newWidget = do
  spinner <- runGtk notReadyWidget
  holdDyn spinner newWidget

-- | A variant of 'holdNotReadyWidget' where 'Widget's aren't replaced
-- directly, but instead different @'Dynamic' t 'Widget'@s are
-- switched in.
holdNotReadyDynamicWidget :: ( MonadRunGtk m
                             , MonadHold t m
                             , Reflex t
                             )
                          => Event t (Dynamic t Widget) -> m (Dynamic t Widget)
holdNotReadyDynamicWidget newWidget = do
  spinner <- runGtk notReadyWidget
  join <$> holdDyn (pure spinner) newWidget