-- -*-haskell-*-
--
-- Author : Brandon Sloane
--
-- Created: 16 August 2017
--
-- Copyright (C) 2017 Brandon Sloane
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Utility functions for threading
--
module Data.GI.Gtk.Threading
    (
-- | Utility functions to run IO actions on the GUI thread. You must call
-- 'Data.GI.Gtk.Threading.setGUIThread' or 'Data.GI.Gtk.Threading.setCurrentThreadAsGUIThread'
-- before using the synchronous options, or you risk deadlocking.
--
-- Note that the notion of "Thread" used by this module corresponds to operating system threads, not Haskell threads.
-- A single operating system thread may run multiple Haskell threads, and a Haskell thread may migrate between operating system threads.
-- In order for this nothing of "Thread" to make sense to a Haskell program, we must be working in a bound Haskell thread, which is tied to a single operating system thread.
-- Haskell's main function is automatically bound, and the postGUI functions will create a new bound thread if nessasary.
      setGUIThread
    , getGUIThread
    , setCurrentThreadAsGUIThread
    , postGUISyncWithPriority
    , postGUISync
    , postGUIASyncWithPriority
    , postGUIASync
    , compareThreads
    , isGUIThread
    , module GI.GLib --threadSelf and Thread
    ) where

import Control.Concurrent
import Control.Concurrent.MVar
import Data.Int (Int32)
import System.IO.Unsafe (unsafePerformIO)
import System.IO (stderr, hPutStrLn)
import GI.Gdk (threadsAddIdle)
import GI.GLib.Constants
import GI.GLib (threadSelf, Thread(..))
import Data.GI.Base.ManagedPtr


guiThread :: MVar (Maybe Thread)
{-# NOINLINE guiThread #-}
guiThread :: MVar (Maybe Thread)
guiThread = IO (MVar (Maybe Thread)) -> MVar (Maybe Thread)
forall a. IO a -> a
unsafePerformIO (IO (MVar (Maybe Thread)) -> MVar (Maybe Thread))
-> IO (MVar (Maybe Thread)) -> MVar (Maybe Thread)
forall a b. (a -> b) -> a -> b
$ Maybe Thread -> IO (MVar (Maybe Thread))
forall a. a -> IO (MVar a)
newMVar Maybe Thread
forall a. Maybe a
Nothing

-- | Inform gi-gtk-hs what thread is running the gtk main loop.
setGUIThread :: Thread -> IO ()
setGUIThread :: Thread -> IO ()
setGUIThread Thread
t = MVar (Maybe Thread) -> Maybe Thread -> IO (Maybe Thread)
forall a. MVar a -> a -> IO a
swapMVar MVar (Maybe Thread)
guiThread (Thread -> Maybe Thread
forall a. a -> Maybe a
Just Thread
t) IO (Maybe Thread) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Inform gi-gtk-hs that the current thread is, or will be, running the gtk main loop.
--
-- Equivalent to @'GI.GLib.threadSelf' >>= 'Data.GI.Gtk.Threading.setGUIThread'@
setCurrentThreadAsGUIThread :: IO ()
setCurrentThreadAsGUIThread :: IO ()
setCurrentThreadAsGUIThread = IO Thread
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Thread
threadSelf IO Thread -> (Thread -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Thread -> IO ()
setGUIThread

-- | Get the Thread that is running the Gtk main loop, if it has been set.
getGUIThread :: IO (Maybe Thread)
getGUIThread :: IO (Maybe Thread)
getGUIThread = MVar (Maybe Thread) -> IO (Maybe Thread)
forall a. MVar a -> IO a
readMVar MVar (Maybe Thread)
guiThread

-- | Queue an action to be run in the GTK event loop.
-- If called from the same process as the event loop, this runs the action directly.
-- Otherwise, this queues it in GTK's event loop and blocks until the action is complete
--
-- You must call 'Data.GI.Gtk.Threading.setGUIThread' or 'Data.GI.Gtk.Threading.setCurrentThreadAsGUIThread' before this.
--
-- Priority is typically between 'GI.GLib.Constants.PRIORITY_HIGH_IDLE' (100) and 'GI.GLib.Constants.PRIORITY_DEFAULT_IDLE' (200)
postGUISyncWithPriority :: Int32 -> IO a -> IO a
postGUISyncWithPriority :: forall a. Int32 -> IO a -> IO a
postGUISyncWithPriority Int32
priority IO a
action = IO a -> IO a
forall a. IO a -> IO a
runInBoundThread (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    Bool
b <- IO Bool
isGUIThread
    if Bool
b then
        IO a
action
    else
        IO a
run
    where
    run :: IO a
run = do
        MVar a
ans <- IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
        Int32 -> IO Bool -> IO Word32
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> IO Bool -> m Word32
threadsAddIdle Int32
priority (IO Bool -> IO Word32) -> IO Bool -> IO Word32
forall a b. (a -> b) -> a -> b
$ IO a
action IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
ans IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
ans

-- | Queue an action to be run in the GTK event loop.
-- If called from the same process as the event loop, this runs the action directly.
-- Otherwise, this queues it in GTK's event loop and blocks until the action is complete
--
-- You must call 'Data.GI.Gtk.Threading.setGUIThread' or 'Data.GI.Gtk.Threading.setCurrentThreadAsGUIThread' before this.
--
-- Equivalent to @'Data.GI.Gtk.Threading.postGUISyncWithPriority' 'GI.GLib.Constants.PRIORITY_DEFAULT_IDLE'@
postGUISync :: IO a -> IO a
postGUISync :: forall a. IO a -> IO a
postGUISync = Int32 -> IO a -> IO a
forall a. Int32 -> IO a -> IO a
postGUISyncWithPriority Int32
PRIORITY_DEFAULT_IDLE

-- | Queue an action to be run in the GTK event loop.
-- This function queues the event regardless of what process it is called from, and returns immidietly.
--
-- Priority is typically between 'GI.GLib.Constants.PRIORITY_HIGH_IDLE' (100) and 'GI.GLib.Constants.PRIORITY_DEFAULT_IDLE' (200)
postGUIASyncWithPriority :: Int32 -> IO () -> IO ()
postGUIASyncWithPriority :: Int32 -> IO () -> IO ()
postGUIASyncWithPriority Int32
priority IO ()
action = Int32 -> IO Bool -> IO Word32
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> IO Bool -> m Word32
threadsAddIdle Int32
priority (IO ()
action IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) IO Word32 -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Queue an action to be run in the GTK event loop.
-- This function queues the event regardless of what process it is called from, and returns immidietly.
--
-- Equivalent to @'Data.GI.Gtk.Threading.postGUIASyncWithPriority' 'GI.GLib.Constants.PRIORITY_DEFAULT_IDLE'@
postGUIASync :: IO () -> IO ()
postGUIASync :: IO () -> IO ()
postGUIASync = Int32 -> IO () -> IO ()
postGUIASyncWithPriority Int32
PRIORITY_DEFAULT_IDLE

-- | Test if two 'GI.GLib.Structs.Thread.Thread's refer to the same OS thread.
-- A 'GI.GLib.Structs.Thread.Thread' can be gotten from 'GI.GLib.Structs.Thread.threadSelf'.
-- Note that 'GI.GLib.Structs.Thread.threadSelf' only makes sense from a bound thread.
compareThreads :: Thread -> Thread -> IO Bool
compareThreads :: Thread -> Thread -> IO Bool
compareThreads (Thread ManagedPtr Thread
mptr1) (Thread ManagedPtr Thread
mptr2) =
    ManagedPtr Thread
-> (Ptr (ManagedPtr Thread) -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ManagedPtr Thread
mptr1 ((Ptr (ManagedPtr Thread) -> IO Bool) -> IO Bool)
-> (Ptr (ManagedPtr Thread) -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr (ManagedPtr Thread)
ptr1 ->
    ManagedPtr Thread
-> (Ptr (ManagedPtr Thread) -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ManagedPtr Thread
mptr2 ((Ptr (ManagedPtr Thread) -> IO Bool) -> IO Bool)
-> (Ptr (ManagedPtr Thread) -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr (ManagedPtr Thread)
ptr2 ->
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr (ManagedPtr Thread)
ptr1 Ptr (ManagedPtr Thread) -> Ptr (ManagedPtr Thread) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (ManagedPtr Thread)
ptr2

-- | Check if the current thread is the Gtk gui thread.
--
-- You must call 'Data.GI.Gtk.Threading.setGUIThread' or 'Data.GI.Gtk.Threading.setCurrentThreadAsGUIThread' before this.
-- This only makes sense when called from a bound thread.
isGUIThread :: IO Bool
isGUIThread :: IO Bool
isGUIThread = do
    Maybe Thread
guiThread <- IO (Maybe Thread)
getGUIThread
    case Maybe Thread
guiThread of
        Maybe Thread
Nothing -> Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"WARNING Data.GI.Gtk.Threading Calling isGUIThread before setGUIThread" IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just Thread
t1 -> IO Thread
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Thread
threadSelf IO Thread -> (Thread -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Thread -> Thread -> IO Bool
compareThreads Thread
t1