{-# LANGUAGE TypeFamilies #-}
-- | Internal module defining handler and its ContextHandler instance as well as some methods
module Graphics.GPipe.Context.GLFW.Handler where

-- stdlib
import           Control.Concurrent                   (MVar, ThreadId,
                                                       modifyMVar_, myThreadId,
                                                       newMVar, withMVar)
import           Control.Concurrent.Async             (withAsync)
import           Control.Concurrent.STM               (atomically)
import           Control.Concurrent.STM.TVar          (TVar, modifyTVar,
                                                       newTVarIO, readTVarIO,
                                                       writeTVar)
import           Control.Exception                    (Exception, throwIO)
import           Control.Monad                        (forM, forM_, unless,
                                                       void, when)
import           Control.Monad.IO.Class               (MonadIO, liftIO)
import           Data.List                            (delete, partition)
import           Data.Maybe                           (fromMaybe)
import           Text.Printf                          (printf)
-- thirdparty
import qualified Graphics.GPipe                       as GPipe (ContextHandler (..),
                                                                ContextT,
                                                                Window,
                                                                WindowBits,
                                                                withContextWindow)
import qualified Graphics.UI.GLFW                     as GLFW (Error, Window)
-- local
import qualified Graphics.GPipe.Context.GLFW.Calls    as Call
import qualified Graphics.GPipe.Context.GLFW.Format   as Format
import qualified Graphics.GPipe.Context.GLFW.Logger   as Log
import qualified Graphics.GPipe.Context.GLFW.RPC      as RPC
import           Graphics.GPipe.Context.GLFW.Resource (defaultWindowConfig)
import qualified Graphics.GPipe.Context.GLFW.Resource as Resource

-- | Internal handle for a GPipe-created GLFW window/context
newtype Context = Context
    { Context -> Window
contextRaw :: GLFW.Window
--  , contextComm :: RPC.Handle
--  , contextAsync :: Async ()
    }
-- | Closeable internal handle for 'Context'.
type MMContext = MVar (Maybe Context)

-- | Opaque handle representing the initialized GLFW library.
--
-- To get started quickly try 'defaultHandleConfig' and 'defaultWindowConfig'.
--
-- @
--      import Graphics.GPipe
--      import qualified Graphics.GPipe.Context.GLFW as GLFW
--
--      runContextT GLFW.defaultHandleConfig $ do
--          win <- newWindow (WindowFormatColorDepth RGB8 Depth16) (GLFW.defaultWindowConfig "OpenGL Graphics")
--          -- Do GPipe things here
-- @
data Handle = Handle
    { Handle -> ThreadId
handleTid         :: ThreadId
    , Handle -> Handle
handleComm        :: RPC.Handle
    , Handle -> Window
handleRaw         :: GLFW.Window
    , Handle -> TVar [MMContext]
handleCtxs        :: TVar [MMContext]
    , Handle -> Maybe EventPolicy
handleEventPolicy :: Maybe EventPolicy
    , Handle -> Logger
handleLogger      :: Log.Logger
    }

-- | Opaque handle representing a, possibly closed, internal 'Context'. You'll
-- typically deal with GPipe's @Window@ instead of this one.
newtype GLFWWindow = WWindow (MMContext, Handle)

-- | Run the action with the context /if the context is still open/.
withContext :: String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext :: String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
callerTag MMContext
mmContext Context -> IO a
action = MMContext -> (Maybe Context -> IO (Maybe a)) -> IO (Maybe a)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MMContext
mmContext Maybe Context -> IO (Maybe a)
go
    where
        go :: Maybe Context -> IO (Maybe a)
go Maybe Context
Nothing = String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"WARNING %s: GPipe-GLFW context already closed" String
callerTag IO () -> IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        go (Just Context
context) = a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> IO a
action Context
context

-- | Template for "Run the action with XYZ /if the gpipe window still exists and ABC/."
unwrappingGPipeWindow :: MonadIO m
    => (String -> action -> Handle -> MMContext -> IO (Maybe a)) -- ^ Specialize use of unwrappingGPipeWindow
    -> String -> GPipe.Window os c ds -> action -> GPipe.ContextT Handle os m (Maybe a)
unwrappingGPipeWindow :: (String -> action -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> action
-> ContextT Handle os m (Maybe a)
unwrappingGPipeWindow String -> action -> Handle -> MMContext -> IO (Maybe a)
specialize String
callerTag Window os c ds
wid action
action = Window os c ds
-> (Maybe (ContextWindow Handle) -> IO (Maybe a))
-> ContextT Handle os m (Maybe a)
forall (m :: * -> *) os c ds ctx a.
MonadIO m =>
Window os c ds
-> (Maybe (ContextWindow ctx) -> IO a) -> ContextT ctx os m a
GPipe.withContextWindow Window os c ds
wid Maybe (ContextWindow Handle) -> IO (Maybe a)
Maybe GLFWWindow -> IO (Maybe a)
go
    where
        go :: Maybe GLFWWindow -> IO (Maybe a)
go Maybe GLFWWindow
Nothing = String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"WARNING %s: GPipe had no such window" String
callerTag IO () -> IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        go (Just (WWindow (MMContext
mmContext, Handle
handle))) = String -> action -> Handle -> MMContext -> IO (Maybe a)
specialize String
callerTag action
action Handle
handle MMContext
mmContext

-- | Run the action with the context __handle__ /if the gpipe window still exists/.
withHandleFromGPipe :: MonadIO m => String -> GPipe.Window os c ds -> (Handle -> IO a) -> GPipe.ContextT Handle os m (Maybe a)
withHandleFromGPipe :: String
-> Window os c ds
-> (Handle -> IO a)
-> ContextT Handle os m (Maybe a)
withHandleFromGPipe = (String -> (Handle -> IO a) -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> (Handle -> IO a)
-> ContextT Handle os m (Maybe a)
forall (m :: * -> *) action a os c ds.
MonadIO m =>
(String -> action -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> action
-> ContextT Handle os m (Maybe a)
unwrappingGPipeWindow ((String
  -> (Handle -> IO a) -> Handle -> MMContext -> IO (Maybe a))
 -> String
 -> Window os c ds
 -> (Handle -> IO a)
 -> ContextT Handle os m (Maybe a))
-> (String
    -> (Handle -> IO a) -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> (Handle -> IO a)
-> ContextT Handle os m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \String
_callerTag Handle -> IO a
action Handle
handle MMContext
_mmContext ->
    a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO a
action Handle
handle

---- | Run the action with the __context__ /if the gpipe window still exists and corresponding context is still open/.
withContextFromGPipe :: MonadIO m => String -> GPipe.Window os c ds -> (Context -> IO a) -> GPipe.ContextT Handle os m (Maybe a)
withContextFromGPipe :: String
-> Window os c ds
-> (Context -> IO a)
-> ContextT Handle os m (Maybe a)
withContextFromGPipe = (String
 -> (Context -> IO a) -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> (Context -> IO a)
-> ContextT Handle os m (Maybe a)
forall (m :: * -> *) action a os c ds.
MonadIO m =>
(String -> action -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> action
-> ContextT Handle os m (Maybe a)
unwrappingGPipeWindow ((String
  -> (Context -> IO a) -> Handle -> MMContext -> IO (Maybe a))
 -> String
 -> Window os c ds
 -> (Context -> IO a)
 -> ContextT Handle os m (Maybe a))
-> (String
    -> (Context -> IO a) -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> (Context -> IO a)
-> ContextT Handle os m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \String
callerTag Context -> IO a
action Handle
_handle MMContext
mmContext ->
    String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
forall a. String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
callerTag MMContext
mmContext Context -> IO a
action

withBothFromGPipe :: MonadIO m => String -> GPipe.Window os c ds -> (Handle -> Context -> IO a) -> GPipe.ContextT Handle os m (Maybe a)
withBothFromGPipe :: String
-> Window os c ds
-> (Handle -> Context -> IO a)
-> ContextT Handle os m (Maybe a)
withBothFromGPipe = (String
 -> (Handle -> Context -> IO a)
 -> Handle
 -> MMContext
 -> IO (Maybe a))
-> String
-> Window os c ds
-> (Handle -> Context -> IO a)
-> ContextT Handle os m (Maybe a)
forall (m :: * -> *) action a os c ds.
MonadIO m =>
(String -> action -> Handle -> MMContext -> IO (Maybe a))
-> String
-> Window os c ds
-> action
-> ContextT Handle os m (Maybe a)
unwrappingGPipeWindow ((String
  -> (Handle -> Context -> IO a)
  -> Handle
  -> MMContext
  -> IO (Maybe a))
 -> String
 -> Window os c ds
 -> (Handle -> Context -> IO a)
 -> ContextT Handle os m (Maybe a))
-> (String
    -> (Handle -> Context -> IO a)
    -> Handle
    -> MMContext
    -> IO (Maybe a))
-> String
-> Window os c ds
-> (Handle -> Context -> IO a)
-> ContextT Handle os m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \String
callerTag Handle -> Context -> IO a
action Handle
handle MMContext
mmContext ->
    String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
forall a. String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
callerTag MMContext
mmContext (Handle -> Context -> IO a
action Handle
handle)

-- | Route an effect to the main thread.
effectMain :: Handle -> Call.EffectMain
effectMain :: Handle -> EffectMain
effectMain Handle
handle = Handle -> EffectMain
RPC.sendEffect (Handle -> Handle
handleComm Handle
handle)

-- | Route an action with a result to the main thread.
onMain :: Handle -> Call.OnMain a
onMain :: Handle -> OnMain a
onMain Handle
handle = Handle -> OnMain a
forall a. Handle -> IO a -> IO a
RPC.fetchResult (Handle -> Handle
handleComm Handle
handle)

-- | Default GLFW handle configuration.
--
-- * Print any errors that GLFW emits.
-- * Automatically process GLFW events after every buffer swap.
-- * Log only context handling activity which represents undesired conditions.
defaultHandleConfig :: GPipe.ContextHandlerParameters Handle
defaultHandleConfig :: ContextHandlerParameters Handle
defaultHandleConfig = HandleConfig :: (Error -> String -> IO ())
-> Maybe EventPolicy -> Logger -> ContextHandlerParameters Handle
HandleConfig
    { configErrorCallback :: Error -> String -> IO ()
configErrorCallback = String -> String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"%s: %s\n" (String -> String -> IO ())
-> (Error -> String) -> Error -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show
    , configEventPolicy :: Maybe EventPolicy
configEventPolicy = EventPolicy -> Maybe EventPolicy
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventPolicy
Poll
    , configLogger :: Logger
configLogger = Logger :: LogLevel -> LogSink -> Logger
Log.Logger
        { loggerLevel :: LogLevel
Log.loggerLevel = LogLevel
Log.WARNING
        , loggerSink :: LogSink
Log.loggerSink = LogSink
Log.stderrSink
        }
    }

instance GPipe.ContextHandler Handle where

    -- | Configuration for the GLFW handle.
    data ContextHandlerParameters Handle = HandleConfig
        { -- | Specify a callback to handle errors emitted by GLFW.
          ContextHandlerParameters Handle -> Error -> String -> IO ()
configErrorCallback :: GLFW.Error -> String -> IO ()
          -- | Specify the 'EventPolicy' to use for automatic GLFW event
          -- processing. Set to 'Nothing' to disable automatic event processing
          -- (you'll need to call 'mainloop' or 'mainstep').
        , ContextHandlerParameters Handle -> Maybe EventPolicy
configEventPolicy :: Maybe EventPolicy
          -- | Configuration for emitting messages.
        , ContextHandlerParameters Handle -> Logger
configLogger :: Log.Logger
        }

    type ContextWindow Handle = GLFWWindow
    type WindowParameters Handle = Resource.WindowConfig

    -- Thread assumption: any thread
    --
    -- Create a context which shares objects with the contexts created by this
    -- handle, if any.
    createContext :: Handle
-> Maybe (WindowBits, WindowParameters Handle)
-> IO (ContextWindow Handle)
createContext Handle
handle Maybe (WindowBits, WindowParameters Handle)
settings = do
        Window
window <- Logger
-> Maybe Window -> Maybe (WindowBits, WindowConfig) -> IO Window
createWindow (Handle -> Logger
handleLogger Handle
handle) (Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$ Handle -> Window
handleRaw Handle
handle) Maybe (WindowBits, WindowParameters Handle)
Maybe (WindowBits, WindowConfig)
settings
        MMContext
mmContext <- Maybe Context -> IO MMContext
forall a. a -> IO (MVar a)
newMVar (Maybe Context -> IO MMContext)
-> (Context -> Maybe Context) -> Context -> IO MMContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Maybe Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context -> IO MMContext) -> Context -> IO MMContext
forall a b. (a -> b) -> a -> b
$ Window -> Context
Context Window
window
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [MMContext] -> ([MMContext] -> [MMContext]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (Handle -> TVar [MMContext]
handleCtxs Handle
handle) (MMContext
mmContext MMContext -> [MMContext] -> [MMContext]
forall a. a -> [a] -> [a]
:)
        GLFWWindow -> IO GLFWWindow
forall (m :: * -> *) a. Monad m => a -> m a
return (GLFWWindow -> IO GLFWWindow) -> GLFWWindow -> IO GLFWWindow
forall a b. (a -> b) -> a -> b
$ (MMContext, Handle) -> GLFWWindow
WWindow (MMContext
mmContext, Handle
handle)

    -- Threading assumption: any thread
    --
    -- Do work with the specified context by making it current. If no context
    -- is specified, then any context being current is sufficient.
    --
    -- XXX: If there's a lot of context swapping, change this to RPC to a
    -- context-private thread running a mainloop.
    contextDoAsync :: Handle -> Maybe (ContextWindow Handle) -> EffectMain
contextDoAsync Handle
handle Maybe (ContextWindow Handle)
Nothing IO ()
action = Handle -> EffectMain
RPC.sendEffect (Handle -> Handle
handleComm Handle
handle) EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ do
        -- (on main thread) Make the ancestor current if nothing else already is
        -- FIXME: these two bodies could be combined, perhaps.. the RPC is only necessary if the current thread lacks a context
        Maybe Window
ccHuh <- IO (Maybe Window)
Call.getCurrentContext
        IO () -> (Window -> IO ()) -> Maybe Window -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Logger -> String -> Maybe Window -> IO ()
Call.makeContextCurrent (Handle -> Logger
handleLogger Handle
handle) String
"contextDoAsync required some context" (Maybe Window -> IO ())
-> (Window -> Maybe Window) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Maybe Window
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Window -> IO ()) -> Window -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Window
handleRaw Handle
handle)
            (IO () -> Window -> IO ()
forall a b. a -> b -> a
const (IO () -> Window -> IO ()) -> IO () -> Window -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
            Maybe Window
ccHuh
        IO ()
action
    contextDoAsync Handle
_ (Just (WWindow (mmContext, handle))) IO ()
action =
        IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> MMContext -> (Context -> IO ()) -> IO (Maybe ())
forall a. String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
"contextDoAsync" MMContext
mmContext ((Context -> IO ()) -> IO (Maybe ()))
-> (Context -> IO ()) -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ \Context
context -> do
            Logger -> String -> Maybe Window -> IO ()
Call.makeContextCurrent (Handle -> Logger
handleLogger Handle
handle) String
"contextDoAsync required a specific context" (Maybe Window -> IO ())
-> (Context -> Maybe Window) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Maybe Window
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Window -> Maybe Window)
-> (Context -> Window) -> Context -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Window
contextRaw (Context -> IO ()) -> Context -> IO ()
forall a b. (a -> b) -> a -> b
$ Context
context
            IO ()
action

    -- Threading assumption: main thread
    --
    -- Swap buffers for the specified context. If an event policy is set,
    -- process events.
    contextSwap :: Handle -> ContextWindow Handle -> IO ()
contextSwap Handle
_ (WWindow (mmContext, handle)) = do
        IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> MMContext -> (Context -> IO ()) -> IO (Maybe ())
forall a. String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
"contextSwap" MMContext
mmContext ((Context -> IO ()) -> IO (Maybe ()))
-> (Context -> IO ()) -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ Window -> IO ()
Call.swapBuffers (Window -> IO ()) -> (Context -> Window) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Window
contextRaw
        (EventPolicy -> IO ()) -> Maybe EventPolicy -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> EventPolicy -> IO ()
mainstepInternal Handle
handle) (Maybe EventPolicy -> IO ()) -> Maybe EventPolicy -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Maybe EventPolicy
handleEventPolicy Handle
handle

    -- Threading assumption: same thread as contextCreate for the given context
    --
    -- Fetch framebuffer size for the specified context by RPCing the main thread.
    contextFrameBufferSize :: Handle -> ContextWindow Handle -> IO (Int, Int)
contextFrameBufferSize Handle
_ (WWindow (mmContext, handle)) = do
        Maybe (Int, Int)
result <- String
-> MMContext -> (Context -> IO (Int, Int)) -> IO (Maybe (Int, Int))
forall a. String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
"contextFrameBufferSize" MMContext
mmContext ((Context -> IO (Int, Int)) -> IO (Maybe (Int, Int)))
-> (Context -> IO (Int, Int)) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \Context
context -> do
            OnMain (Int, Int) -> Window -> IO (Int, Int)
Call.getFramebufferSize (Handle -> OnMain (Int, Int)
forall a. Handle -> OnMain a
onMain Handle
handle) (Window -> IO (Int, Int)) -> Window -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ Context -> Window
contextRaw Context
context
        IO (Int, Int)
-> ((Int, Int) -> IO (Int, Int))
-> Maybe (Int, Int)
-> IO (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Int, Int)
failure (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
result
        where
            failure :: IO (Int, Int)
failure = do
                Logger -> LogLevel -> String -> IO ()
Call.say (Handle -> Logger
handleLogger Handle
handle) LogLevel
Log.ERROR (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
forall r. PrintfType r => String -> r
printf String
"contextFrameBufferSize could not access context"
                (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
0)

    -- Threading assumption: same thread as contextCreate for the given context
    --
    -- Destroy the given context by making it current on the main thread and
    -- then destroying it there.
    --
    -- Note: See the restrictions for Call.destroyWindow
    contextDelete :: Handle -> ContextWindow Handle -> IO ()
contextDelete Handle
_ (WWindow (mmContext, handle)) = do
        -- close the context mvar
        MMContext -> (Maybe Context -> IO (Maybe Context)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MMContext
mmContext ((Maybe Context -> IO (Maybe Context)) -> IO ())
-> (Maybe Context -> IO (Maybe Context)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe Context
mContext -> do
            Logger -> LogLevel -> String -> IO ()
Call.say (Handle -> Logger
handleLogger Handle
handle) LogLevel
Log.INFO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"contextDelete of %s" (Maybe Window -> String
forall a. Show a => a -> String
show (Maybe Window -> String) -> Maybe Window -> String
forall a b. (a -> b) -> a -> b
$ Context -> Window
contextRaw (Context -> Window) -> Maybe Context -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Context
mContext)
            Maybe Context -> (Context -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Context
mContext ((Context -> IO ()) -> IO ()) -> (Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Context
context -> Handle -> EffectMain
RPC.sendEffect (Handle -> Handle
handleComm Handle
handle) EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ do
                Logger -> String -> Maybe Window -> IO ()
Call.makeContextCurrent (Handle -> Logger
handleLogger Handle
handle) String
"contextDelete" (Maybe Window -> IO ())
-> (Context -> Maybe Window) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Maybe Window
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Window -> Maybe Window)
-> (Context -> Window) -> Context -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Window
contextRaw (Context -> IO ()) -> Context -> IO ()
forall a b. (a -> b) -> a -> b
$ Context
context
                EffectMain -> Window -> IO ()
Call.destroyWindow EffectMain
forall a. a -> a
id (Context -> Window
contextRaw Context
context) -- id RPC because this is in a mainthread RPC
            Maybe Context -> IO (Maybe Context)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
forall a. Maybe a
Nothing
        -- remove the context from the handle
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [MMContext] -> ([MMContext] -> [MMContext]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (Handle -> TVar [MMContext]
handleCtxs Handle
handle) (MMContext -> [MMContext] -> [MMContext]
forall a. Eq a => a -> [a] -> [a]
delete MMContext
mmContext)

    -- Threading assumption: main thread
    contextHandlerCreate :: ContextHandlerParameters Handle -> IO Handle
contextHandlerCreate ContextHandlerParameters Handle
config = do
        Logger -> LogLevel -> String -> IO ()
Call.say (ContextHandlerParameters Handle -> Logger
configLogger ContextHandlerParameters Handle
config) LogLevel
Log.DEBUG String
"contextHandlerCreate"
        -- make handle resources
        ThreadId
tid <- IO ThreadId
myThreadId
        Handle
comm <- IO Handle
RPC.newBound
        TVar [MMContext]
ctxs <- [MMContext] -> IO (TVar [MMContext])
forall a. a -> IO (TVar a)
newTVarIO []
        -- initialize glfw
        EffectMain -> Maybe (Error -> String -> IO ()) -> IO ()
Call.setErrorCallback EffectMain
forall a. a -> a
id (Maybe (Error -> String -> IO ()) -> IO ())
-> ((Error -> String -> IO ()) -> Maybe (Error -> String -> IO ()))
-> (Error -> String -> IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> String -> IO ()) -> Maybe (Error -> String -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Error -> String -> IO ()) -> IO ())
-> (Error -> String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContextHandlerParameters Handle -> Error -> String -> IO ()
configErrorCallback ContextHandlerParameters Handle
config -- id RPC because contextHandlerCreate is called only on mainthread
        Bool
ok <- OnMain Bool -> IO Bool
Call.init OnMain Bool
forall a. a -> a
id -- id RPC because contextHandlerCreate is called only on mainthread
        Bool -> EffectMain
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ InitException -> IO ()
forall e a. Exception e => e -> IO a
throwIO InitException
InitException
        -- wrap up handle
        Window
ancestor <- Logger
-> Maybe Window -> Maybe (WindowBits, WindowConfig) -> IO Window
createWindow (ContextHandlerParameters Handle -> Logger
configLogger ContextHandlerParameters Handle
config) Maybe Window
forall a. Maybe a
Nothing Maybe (WindowBits, WindowConfig)
forall a. Maybe a
Nothing
        Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> IO Handle) -> Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ Handle :: ThreadId
-> Handle
-> Window
-> TVar [MMContext]
-> Maybe EventPolicy
-> Logger
-> Handle
Handle
            { handleTid :: ThreadId
handleTid = ThreadId
tid
            , handleComm :: Handle
handleComm = Handle
comm
            , handleRaw :: Window
handleRaw = Window
ancestor
            , handleCtxs :: TVar [MMContext]
handleCtxs = TVar [MMContext]
ctxs
            , handleEventPolicy :: Maybe EventPolicy
handleEventPolicy = ContextHandlerParameters Handle -> Maybe EventPolicy
configEventPolicy ContextHandlerParameters Handle
config
            , handleLogger :: Logger
handleLogger = ContextHandlerParameters Handle -> Logger
configLogger ContextHandlerParameters Handle
config
            }

    -- Threading: main thread
    contextHandlerDelete :: Handle -> IO ()
contextHandlerDelete Handle
handle = do
        Logger -> LogLevel -> String -> IO ()
Call.say (Handle -> Logger
handleLogger Handle
handle) LogLevel
Log.DEBUG String
"contextHandlerDelete"
        [MMContext]
ctxs <- TVar [MMContext] -> IO [MMContext]
forall a. TVar a -> IO a
readTVarIO (TVar [MMContext] -> IO [MMContext])
-> TVar [MMContext] -> IO [MMContext]
forall a b. (a -> b) -> a -> b
$ Handle -> TVar [MMContext]
handleCtxs Handle
handle
        [MMContext] -> (MMContext -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MMContext]
ctxs ((MMContext -> IO ()) -> IO ()) -> (MMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MMContext
mmContext -> Handle -> ContextWindow Handle -> IO ()
forall ctx. ContextHandler ctx => ctx -> ContextWindow ctx -> IO ()
GPipe.contextDelete Handle
handle ((MMContext, Handle) -> GLFWWindow
WWindow (MMContext
mmContext, Handle
handle))
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [MMContext] -> [MMContext] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (Handle -> TVar [MMContext]
handleCtxs Handle
handle) []
        -- all resources are released
        EffectMain -> IO ()
Call.terminate EffectMain
forall a. a -> a
id -- id RPC because contextHandlerDelete is called only on mainthread
        EffectMain -> Maybe (Error -> String -> IO ()) -> IO ()
Call.setErrorCallback EffectMain
forall a. a -> a
id Maybe (Error -> String -> IO ())
forall a. Maybe a
Nothing -- id RPC because contextHandlerDelete is called only on mainthread

-- Create a raw GLFW window for use by contextHandlerCreate & createContext
createWindow :: Log.Logger -> Maybe GLFW.Window -> Maybe (GPipe.WindowBits, Resource.WindowConfig) -> IO GLFW.Window
createWindow :: Logger
-> Maybe Window -> Maybe (WindowBits, WindowConfig) -> IO Window
createWindow Logger
logger Maybe Window
parentHuh Maybe (WindowBits, WindowConfig)
settings = do
    Bool -> EffectMain
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([WindowHint] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WindowHint]
disallowedHints) EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$
        UnsafeWindowHintsException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (UnsafeWindowHintsException -> IO ())
-> UnsafeWindowHintsException -> IO ()
forall a b. (a -> b) -> a -> b
$ [WindowHint] -> UnsafeWindowHintsException
Format.UnsafeWindowHintsException [WindowHint]
disallowedHints
    -- make a context
    Maybe Window
windowHuh <- OnMain (Maybe Window)
-> Int
-> Int
-> String
-> Maybe Monitor
-> [WindowHint]
-> Maybe Window
-> IO (Maybe Window)
Call.createWindow OnMain (Maybe Window)
forall a. a -> a
id Int
width Int
height String
title Maybe Monitor
monitor [WindowHint]
hints Maybe Window
parentHuh -- id RPC because contextHandlerCreate & createContext are called only on mainthread
    Logger -> LogLevel -> String -> IO ()
Call.say Logger
logger LogLevel
Log.DEBUG (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"made context %s -> parent %s" (Maybe Window -> String
forall a. Show a => a -> String
show Maybe Window
windowHuh) (Maybe Window -> String
forall a. Show a => a -> String
show Maybe Window
parentHuh)
    Window
window <- IO Window -> (Window -> IO Window) -> Maybe Window -> IO Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Window
exc Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
windowHuh
    -- set up context
    Maybe Int -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int
intervalHuh ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
interval -> do
        Logger -> String -> Maybe Window -> IO ()
Call.makeContextCurrent Logger
logger String
"apply vsync setting" (Maybe Window -> IO ()) -> Maybe Window -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Maybe Window
forall (f :: * -> *) a. Applicative f => a -> f a
pure Window
window
        Int -> IO ()
Call.swapInterval Int
interval
    -- done
    Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
window
    where
        config :: WindowConfig
config = WindowConfig
-> ((WindowBits, WindowConfig) -> WindowConfig)
-> Maybe (WindowBits, WindowConfig)
-> WindowConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> WindowConfig
defaultWindowConfig String
"") (WindowBits, WindowConfig) -> WindowConfig
forall a b. (a, b) -> b
snd Maybe (WindowBits, WindowConfig)
settings
        Resource.WindowConfig {configWidth :: WindowConfig -> Int
Resource.configWidth=Int
width, configHeight :: WindowConfig -> Int
Resource.configHeight=Int
height} = WindowConfig
config
        Resource.WindowConfig Int
_ Int
_ String
title Maybe Monitor
monitor [WindowHint]
_ Maybe Int
intervalHuh = WindowConfig
config
        ([WindowHint]
userHints, [WindowHint]
disallowedHints) = (WindowHint -> Bool)
-> [WindowHint] -> ([WindowHint], [WindowHint])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition WindowHint -> Bool
Format.allowedHint ([WindowHint] -> ([WindowHint], [WindowHint]))
-> [WindowHint] -> ([WindowHint], [WindowHint])
forall a b. (a -> b) -> a -> b
$ WindowConfig -> [WindowHint]
Resource.configHints WindowConfig
config
        hints :: [WindowHint]
hints = [WindowHint]
userHints [WindowHint] -> [WindowHint] -> [WindowHint]
forall a. [a] -> [a] -> [a]
++ Maybe WindowBits -> [WindowHint]
Format.bitsToHints ((WindowBits, WindowConfig) -> WindowBits
forall a b. (a, b) -> a
fst ((WindowBits, WindowConfig) -> WindowBits)
-> Maybe (WindowBits, WindowConfig) -> Maybe WindowBits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WindowBits, WindowConfig)
settings) [WindowHint] -> [WindowHint] -> [WindowHint]
forall a. [a] -> [a] -> [a]
++ [WindowHint]
Format.unconditionalHints
        exc :: IO Window
exc = CreateWindowException -> IO Window
forall e a. Exception e => e -> IO a
throwIO (CreateWindowException -> IO Window)
-> (WindowConfig -> CreateWindowException)
-> WindowConfig
-> IO Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CreateWindowException
CreateSharedWindowException (String -> CreateWindowException)
-> (WindowConfig -> String)
-> WindowConfig
-> CreateWindowException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowConfig -> String
forall a. Show a => a -> String
show (WindowConfig -> IO Window) -> WindowConfig -> IO Window
forall a b. (a -> b) -> a -> b
$ WindowConfig
config {configHints :: [WindowHint]
Resource.configHints = [WindowHint]
hints}

-- | Type to describe the waiting or polling style of event processing
-- supported by GLFW.
--
-- * Recommended reading: /Event Processing/ section of the GLFW /Input Guide/
-- at <http://www.glfw.org/docs/latest/input_guide.html#events>.
data EventPolicy
    = Poll
    | Wait
    | WaitTimeout Double
    deriving
    ( Int -> EventPolicy -> String -> String
[EventPolicy] -> String -> String
EventPolicy -> String
(Int -> EventPolicy -> String -> String)
-> (EventPolicy -> String)
-> ([EventPolicy] -> String -> String)
-> Show EventPolicy
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EventPolicy] -> String -> String
$cshowList :: [EventPolicy] -> String -> String
show :: EventPolicy -> String
$cshow :: EventPolicy -> String
showsPrec :: Int -> EventPolicy -> String -> String
$cshowsPrec :: Int -> EventPolicy -> String -> String
Show
    )

-- | Process GLFW and GPipe events according to the given 'EventPolicy'.
--
-- __Use case:__ Call 'mainstep' as part of a custom engine loop in multithreaded
-- applications which do GPipe rendering off of the main thread. Use 'mainloop'
-- for less complex applications.
--
-- * Must be called on the main thread.
-- * Can be called with /any/ window you've created and not yet deleted.
-- * If GPipe can't find the window you passed in, returns 'Nothing'.
mainstep :: MonadIO m
    => GPipe.Window os c ds
    -> EventPolicy -- ^ 'Poll' will process events and return immediately while 'Wait' will sleep until events are received.
    -> GPipe.ContextT Handle os m (Maybe ())
mainstep :: Window os c ds -> EventPolicy -> ContextT Handle os m (Maybe ())
mainstep Window os c ds
win EventPolicy
eventPolicy = String
-> Window os c ds
-> (Handle -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) os c ds a.
MonadIO m =>
String
-> Window os c ds
-> (Handle -> IO a)
-> ContextT Handle os m (Maybe a)
withHandleFromGPipe String
"mainstep" Window os c ds
win ((Handle -> IO ()) -> ContextT Handle os m (Maybe ()))
-> (Handle -> IO ()) -> ContextT Handle os m (Maybe ())
forall a b. (a -> b) -> a -> b
$ EffectMain
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO EffectMain -> (Handle -> IO ()) -> Handle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> EventPolicy -> IO ()) -> EventPolicy -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> EventPolicy -> IO ()
mainstepInternal EventPolicy
eventPolicy

mainstepInternal :: Handle -> EventPolicy -> IO ()
mainstepInternal :: Handle -> EventPolicy -> IO ()
mainstepInternal Handle
handle EventPolicy
eventPolicy = do
    ThreadId
tid <- IO ThreadId
myThreadId
    Bool -> EffectMain
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ThreadId
tid ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle -> ThreadId
handleTid Handle
handle) EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$
        UsageException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (UsageException -> IO ()) -> UsageException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> UsageException
MainstepOffMainException String
"mainstep must be called from main thread"
    case EventPolicy
eventPolicy of
        EventPolicy
Poll -> EffectMain -> IO ()
Call.pollEvents EffectMain
forall a. a -> a
id -- id RPC because mainstepInternal is called only on mainthread
        EventPolicy
Wait -> IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync
                    -- Async sleeps on RPC chan, waking op main when RPC received
                    (Handle -> IO RPC
RPC.awaitActions (Handle -> Handle
handleComm Handle
handle) IO RPC -> EffectMain
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
Call.postEmptyEvent)
                    -- Main sleeps on waitEvents
                    (IO () -> Async () -> IO ()
forall a b. a -> b -> a
const (IO () -> Async () -> IO ()) -> IO () -> Async () -> IO ()
forall a b. (a -> b) -> a -> b
$ EffectMain -> IO ()
Call.waitEvents EffectMain
forall a. a -> a
id) -- id RPC because mainstepInternal is called only on mainthread
        WaitTimeout Double
timeout -> IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync
                    -- Async sleeps on RPC chan, waking op main when RPC received
                    (Handle -> IO RPC
RPC.awaitActions (Handle -> Handle
handleComm Handle
handle) IO RPC -> EffectMain
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
Call.postEmptyEvent)
                    -- Main sleeps on waitEventsTimeout
                    (IO () -> Async () -> IO ()
forall a b. a -> b -> a
const (IO () -> Async () -> IO ()) -> IO () -> Async () -> IO ()
forall a b. (a -> b) -> a -> b
$ EffectMain -> Double -> IO ()
Call.waitEventsTimeout EffectMain
forall a. a -> a
id Double
timeout) -- id RPC because mainstepInternal is called only on mainthread
    Handle -> IO ()
RPC.processActions (Handle -> IO ()) -> Handle -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Handle
handleComm Handle
handle

-- | Process GLFW and GPipe events according to the given 'EventPolicy' in a
-- loop.
--
-- __Use case:__ Call 'mainloop' in multithreaded applications which do GPipe
-- rendering off of the main thread, but which do not otherwise need additional
-- control over the main thread. For less complex applications use automatic
-- event processing configured via 'HandleConfig'.
--
-- * Must be called on the main thread.
-- * The loop will run until 'windowShouldClose' is true for the all 'Window's
-- created by the same 'ContextHandler', or all the 'Window's have been
-- deleted.
-- * To indicate a window should close use 'setWindowShouldClose' in "Graphics.GPipe.Context.GLFW.Wrapped".
mainloop :: MonadIO m
    => GPipe.Window os c ds
    -> EventPolicy -- ^ A 'Poll' loop runs continuously while a 'Wait' loop sleeps until events or user input occur.
    -> GPipe.ContextT Handle os m (Maybe ())
mainloop :: Window os c ds -> EventPolicy -> ContextT Handle os m (Maybe ())
mainloop Window os c ds
win EventPolicy
eventPolicy = String
-> Window os c ds
-> (Handle -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) os c ds a.
MonadIO m =>
String
-> Window os c ds
-> (Handle -> IO a)
-> ContextT Handle os m (Maybe a)
withHandleFromGPipe String
"mainloop" Window os c ds
win ((Handle -> IO ()) -> ContextT Handle os m (Maybe ()))
-> (Handle -> IO ()) -> ContextT Handle os m (Maybe ())
forall a b. (a -> b) -> a -> b
$ EffectMain
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO EffectMain -> (Handle -> IO ()) -> Handle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> EventPolicy -> IO ()) -> EventPolicy -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> EventPolicy -> IO ()
mainloopInternal EventPolicy
eventPolicy

mainloopInternal :: Handle -> EventPolicy -> IO ()
mainloopInternal :: Handle -> EventPolicy -> IO ()
mainloopInternal Handle
handle EventPolicy
eventPolicy = do
    Handle -> EventPolicy -> IO ()
mainstepInternal Handle
handle EventPolicy
eventPolicy
    [MMContext]
ctxs <- TVar [MMContext] -> IO [MMContext]
forall a. TVar a -> IO a
readTVarIO (TVar [MMContext] -> IO [MMContext])
-> TVar [MMContext] -> IO [MMContext]
forall a b. (a -> b) -> a -> b
$ Handle -> TVar [MMContext]
handleCtxs Handle
handle
    Bool
allShouldClose <- [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> IO [Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MMContext] -> (MMContext -> IO Bool) -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [MMContext]
ctxs MMContext -> IO Bool
oneShouldClose
    Bool -> EffectMain
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allShouldClose EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$
        Handle -> EventPolicy -> IO ()
mainloopInternal Handle
handle EventPolicy
eventPolicy
    where
        oneShouldClose :: MMContext -> IO Bool
oneShouldClose MMContext
mmContext = do
            Maybe Bool
shouldCloseHuh <- String -> MMContext -> (Context -> IO Bool) -> IO (Maybe Bool)
forall a. String -> MMContext -> (Context -> IO a) -> IO (Maybe a)
withContext String
"oneShouldClose" MMContext
mmContext ((Context -> IO Bool) -> IO (Maybe Bool))
-> (Context -> IO Bool) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Window -> IO Bool
Call.windowShouldClose (Window -> IO Bool) -> (Context -> Window) -> Context -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Window
contextRaw
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
shouldCloseHuh

-- | IO exception thrown when GLFW library initialization fails.
data InitException = InitException
    deriving Int -> InitException -> String -> String
[InitException] -> String -> String
InitException -> String
(Int -> InitException -> String -> String)
-> (InitException -> String)
-> ([InitException] -> String -> String)
-> Show InitException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InitException] -> String -> String
$cshowList :: [InitException] -> String -> String
show :: InitException -> String
$cshow :: InitException -> String
showsPrec :: Int -> InitException -> String -> String
$cshowsPrec :: Int -> InitException -> String -> String
Show
instance Exception InitException

-- | IO Exception thrown when GLFW window creation fails.
data CreateWindowException
    = CreateWindowException String
    | CreateSharedWindowException String
    deriving Int -> CreateWindowException -> String -> String
[CreateWindowException] -> String -> String
CreateWindowException -> String
(Int -> CreateWindowException -> String -> String)
-> (CreateWindowException -> String)
-> ([CreateWindowException] -> String -> String)
-> Show CreateWindowException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CreateWindowException] -> String -> String
$cshowList :: [CreateWindowException] -> String -> String
show :: CreateWindowException -> String
$cshow :: CreateWindowException -> String
showsPrec :: Int -> CreateWindowException -> String -> String
$cshowsPrec :: Int -> CreateWindowException -> String -> String
Show
instance Exception CreateWindowException

-- | IO Exception thrown when application code calls a GPipe-GLFW incorrectly
-- (eg. on the wrong thread).
newtype UsageException
    = MainstepOffMainException String
    deriving Int -> UsageException -> String -> String
[UsageException] -> String -> String
UsageException -> String
(Int -> UsageException -> String -> String)
-> (UsageException -> String)
-> ([UsageException] -> String -> String)
-> Show UsageException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UsageException] -> String -> String
$cshowList :: [UsageException] -> String -> String
show :: UsageException -> String
$cshow :: UsageException -> String
showsPrec :: Int -> UsageException -> String -> String
$cshowsPrec :: Int -> UsageException -> String -> String
Show
instance Exception UsageException