-- -*-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 = unsafePerformIO $ newMVar Nothing -- | Inform gi-gtk-hs what thread is running the gtk main loop. setGUIThread :: Thread -> IO () setGUIThread t = swapMVar guiThread (Just t) >> 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 = threadSelf >>= setGUIThread -- | Get the Thread that is running the Gtk main loop, if it has been set. getGUIThread :: IO (Maybe Thread) getGUIThread = readMVar 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 priority action = runInBoundThread $ do b <- isGUIThread if b then action else run where run = do ans <- newEmptyMVar threadsAddIdle priority $ action >>= putMVar ans >> return False takeMVar 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 = postGUISyncWithPriority 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 priority action = threadsAddIdle priority (action >> return False) >> 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 = postGUIASyncWithPriority 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 mptr1) (Thread mptr2) = withManagedPtr mptr1 $ \ptr1 -> withManagedPtr mptr2 $ \ptr2 -> return $ ptr1 == 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 = do guiThread <- getGUIThread case guiThread of Nothing -> hPutStrLn stderr "WARNING Data.GI.Gtk.Threading Calling isGUIThread before setGUIThread" >> return False Just t1 -> threadSelf >>= compareThreads t1