Class.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/.

module Reflex.GI.Gtk.Run.Class
  ( MonadRunGtk( runGtk_
               , runGtk
               , runGtkPromise
               )
  ) where

import Control.Monad (join)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT)
import Control.Monad.Trans (lift)
import Reflex ( PostBuildT
              , TriggerEventT
              )

-- | Typeclass for 'Monad's that give the ability to run IO actions in
-- the proper context for calling GTK functions. Most notably, this
-- means that the IO action is run in the thread that GTK was
-- initialized in.
class (MonadIO m) => MonadRunGtk m where
  -- | Execute the given 'IO' action in the correct context for
  -- calling GTK actions. This might mean executing the action in a
  -- different thread if the current thread is not the GTK thread, but
  -- it might also mean executing the action in the current thread if
  -- the current thread is the GTK thread.
  runGtk :: IO a -> m a
  runGtk = join . runGtkPromise

  -- | Like 'runGtk' but does not return the result of the executed
  -- action and will not wait for the action to finish executing if it
  -- is run in a different thread.
  --
  -- Note that it is not precisely specified under which circumstances
  -- will be executed asynchronously in a different thread or
  -- synchronously in the current thread, so you should either account
  -- for both possibilities or use 'runGtk' to always wait
  -- synchronously wait for the action to finish.
  runGtk_ :: IO a -> m ()

  -- | Like 'runGtk' but does not wait for the 'IO' action to finish
  -- executing. Instead it returns another monadic action that waits
  -- for the action to finish and returns its result.
  --
  -- Note that just as with 'runGtk_' it is not exactly specified
  -- under which circumstances the action will be run asynchronously
  -- or synchronously. You should either account for both cases or use
  -- 'runGtk' to always wait for the action to finish.
  runGtkPromise :: IO a -> m (m a)

instance MonadRunGtk m => MonadRunGtk (PostBuildT t m) where
  runGtk = lift . runGtk
  runGtk_ = lift . runGtk_
  runGtkPromise = fmap lift . lift . runGtkPromise

instance MonadRunGtk m => MonadRunGtk (TriggerEventT t m) where
  runGtk = lift . runGtk
  runGtk_ = lift . runGtk_
  runGtkPromise = fmap lift . lift . runGtkPromise

instance MonadRunGtk m => MonadRunGtk (ReaderT r m) where
  runGtk = lift . runGtk
  runGtk_ = lift . runGtk_
  runGtkPromise = fmap lift . lift . runGtkPromise