-- 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 :: IO Widget
notReadyWidget = do
  Spinner
spinner <- IO Spinner
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Spinner
spinnerNew
  #start spinner
  Spinner -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget Spinner
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 :: Event t Widget -> m (Dynamic t Widget)
holdNotReadyWidget newWidget :: Event t Widget
newWidget = do
  Widget
spinner <- IO Widget -> m Widget
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m a
runGtk IO Widget
notReadyWidget
  Widget -> Event t Widget -> m (Dynamic t Widget)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Widget
spinner Event t Widget
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 :: Event t (Dynamic t Widget) -> m (Dynamic t Widget)
holdNotReadyDynamicWidget newWidget :: Event t (Dynamic t Widget)
newWidget = do
  Widget
spinner <- IO Widget -> m Widget
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m a
runGtk IO Widget
notReadyWidget
  Dynamic t (Dynamic t Widget) -> Dynamic t Widget
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Dynamic t (Dynamic t Widget) -> Dynamic t Widget)
-> m (Dynamic t (Dynamic t Widget)) -> m (Dynamic t Widget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Widget
-> Event t (Dynamic t Widget) -> m (Dynamic t (Dynamic t Widget))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (Widget -> Dynamic t Widget
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget
spinner) Event t (Dynamic t Widget)
newWidget