From 3bb7bdb9d2ac3dccd2e19cb1e7e22d3e78d57737 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Sat, 2 Feb 2019 09:33:30 +0100 Subject: [PATCH] Assert in 'run' that the program is using the threaded RTS --- .../src/GI/Gtk/Declarative/App/Simple.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/gi-gtk-declarative-app-simple/src/GI/Gtk/Declarative/App/Simple.hs b/gi-gtk-declarative-app-simple/src/GI/Gtk/Declarative/App/Simple.hs index fe5c1ba..74241fe 100644 --- a/gi-gtk-declarative-app-simple/src/GI/Gtk/Declarative/App/Simple.hs +++ b/gi-gtk-declarative-app-simple/src/GI/Gtk/Declarative/App/Simple.hs @@ -26,6 +26,8 @@ import GI.Gtk.Declarative.EventSource import GI.Gtk.Declarative.State import Pipes import Pipes.Concurrent +import System.Exit +import System.IO -- | Describes an state reducer application. data App window state event = @@ -72,6 +74,7 @@ run => App window state event -- ^ Application to run -> IO state run app = do + assertRuntimeSupportsBoundThreads void $ Gtk.init Nothing Async.withAsync (runLoop app <* Gtk.mainQuit) $ \lastState -> do Gtk.main @@ -139,6 +142,17 @@ runLoop App {..} = do loop newState newMarkup events sub newModel Exit -> return oldModel +-- | Assert that the program was linked using the @-threaded@ flag, to +-- enable the threaded runtime required by this module. +assertRuntimeSupportsBoundThreads :: IO () +assertRuntimeSupportsBoundThreads = + unless rtsSupportsBoundThreads $ do + hPutStrLn stderr "GI.Gtk.Declarative.App.Simple requires the program to \ + \be linked using the threaded runtime of GHC (-threaded \ + \flag)." + exitFailure + + publishEvent :: Chan event -> event -> IO () publishEvent mvar = void . writeChan mvar