-- 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 = m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> (IO a -> m (m a)) -> IO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m (m a)
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m (m a)
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 :: IO a -> PostBuildT t m a
runGtk = m a -> PostBuildT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PostBuildT t m a)
-> (IO a -> m a) -> IO a -> PostBuildT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m a
runGtk
  runGtk_ :: IO a -> PostBuildT t m ()
runGtk_ = m () -> PostBuildT t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> PostBuildT t m ())
-> (IO a -> m ()) -> IO a -> PostBuildT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m ()
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m ()
runGtk_
  runGtkPromise :: IO a -> PostBuildT t m (PostBuildT t m a)
runGtkPromise = (m a -> PostBuildT t m a)
-> PostBuildT t m (m a) -> PostBuildT t m (PostBuildT t m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m a -> PostBuildT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PostBuildT t m (m a) -> PostBuildT t m (PostBuildT t m a))
-> (IO a -> PostBuildT t m (m a))
-> IO a
-> PostBuildT t m (PostBuildT t m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m a) -> PostBuildT t m (m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (m a) -> PostBuildT t m (m a))
-> (IO a -> m (m a)) -> IO a -> PostBuildT t m (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m (m a)
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m (m a)
runGtkPromise

instance MonadRunGtk m => MonadRunGtk (TriggerEventT t m) where
  runGtk :: IO a -> TriggerEventT t m a
runGtk = m a -> TriggerEventT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TriggerEventT t m a)
-> (IO a -> m a) -> IO a -> TriggerEventT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m a
runGtk
  runGtk_ :: IO a -> TriggerEventT t m ()
runGtk_ = m () -> TriggerEventT t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TriggerEventT t m ())
-> (IO a -> m ()) -> IO a -> TriggerEventT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m ()
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m ()
runGtk_
  runGtkPromise :: IO a -> TriggerEventT t m (TriggerEventT t m a)
runGtkPromise = (m a -> TriggerEventT t m a)
-> TriggerEventT t m (m a)
-> TriggerEventT t m (TriggerEventT t m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m a -> TriggerEventT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (m a)
 -> TriggerEventT t m (TriggerEventT t m a))
-> (IO a -> TriggerEventT t m (m a))
-> IO a
-> TriggerEventT t m (TriggerEventT t m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m a) -> TriggerEventT t m (m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (m a) -> TriggerEventT t m (m a))
-> (IO a -> m (m a)) -> IO a -> TriggerEventT t m (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m (m a)
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m (m a)
runGtkPromise

instance MonadRunGtk m => MonadRunGtk (ReaderT r m) where
  runGtk :: IO a -> ReaderT r m a
runGtk = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a) -> (IO a -> m a) -> IO a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m a
runGtk
  runGtk_ :: IO a -> ReaderT r m ()
runGtk_ = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (IO a -> m ()) -> IO a -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m ()
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m ()
runGtk_
  runGtkPromise :: IO a -> ReaderT r m (ReaderT r m a)
runGtkPromise = (m a -> ReaderT r m a)
-> ReaderT r m (m a) -> ReaderT r m (ReaderT r m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT r m (m a) -> ReaderT r m (ReaderT r m a))
-> (IO a -> ReaderT r m (m a))
-> IO a
-> ReaderT r m (ReaderT r m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m a) -> ReaderT r m (m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (m a) -> ReaderT r m (m a))
-> (IO a -> m (m a)) -> IO a -> ReaderT r m (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m (m a)
forall (m :: * -> *) a. MonadRunGtk m => IO a -> m (m a)
runGtkPromise