Little refactoring: forkThread

2 files changed, 28 insertions, 14 deletions

diff --git a/src/Xmobar/System/Utils.hs b/src/Xmobar/System/Utils.hs
index 24c655e..379dec3 100644
--- a/src/Xmobar/System/Utils.hs
+++ b/src/Xmobar/System/Utils.hs
@@ -3,7 +3,7 @@
 ------------------------------------------------------------------------------
 -- |
 -- Module: Utils
--- Copyright: (c) 2010, 2018, 2020 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2010, 2018, 2020, 2022 Jose Antonio Ortega Ruiz
 -- License: BSD3-style (see LICENSE)
 --
 -- Maintainer: Jose A Ortega Ruiz <jao@gnu.org>
@@ -21,10 +21,19 @@ module Xmobar.System.Utils
   ( expandHome
   , changeLoop
   , safeIndex
+  , forkThread
   ) where
 
 import Control.Monad
 import Control.Concurrent.STM
+import Control.Exception (handle, SomeException(..))
+
+#ifdef THREADED_RUNTIME
+import Control.Concurrent (forkOS)
+#else
+import Control.Concurrent (forkIO)
+#endif
+
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe (fromMaybe)
 
@@ -35,6 +44,18 @@ expandHome :: FilePath -> IO FilePath
 expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME")
 expandHome p = return p
 
+forkThread :: String -> IO () -> IO ()
+forkThread name action = do
+#ifdef THREADED_RUNTIME
+    _ <- forkOS (handle (onError name) action)
+#else
+    _ <- forkIO (handle (onError name) action)
+#endif
+    return ()
+  where
+    onError thing (SomeException e) =
+      void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
+
 changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()
 changeLoop s f = atomically s >>= go
  where
diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs
index c74ae57..e957acd 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -28,7 +28,7 @@ import Control.Arrow ((&&&))
 import Control.Monad.Reader
 import Control.Concurrent
 import Control.Concurrent.STM
-import Control.Exception (handle, SomeException(..))
+
 import Data.Bits
 import Data.Map hiding (foldr, map, filter)
 import qualified Data.Map as Map
@@ -56,7 +56,7 @@ import Xmobar.X11.Text
 import Xmobar.X11.Draw
 import Xmobar.X11.Bitmap as Bitmap
 import Xmobar.X11.Types
-import Xmobar.System.Utils (safeIndex)
+import Xmobar.System.Utils (safeIndex, forkThread)
 
 import Xmobar.Run.Loop (loop)
 
@@ -81,23 +81,16 @@ x11Loop conf = do
   let ic = Map.empty
       to = textOffset conf
       ts = textOffsets conf ++ replicate (length fl) (-1)
+#ifdef XFT
+  xftInitFtLibrary
+#endif
   (r,w) <- createWin d fs conf
   loop conf (startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf))
 
 startLoop :: XConf -> TMVar SignalType -> TVar [String] -> IO ()
 startLoop xcfg@(XConf _ _ w _ _ _ _) sig tv = do
-#ifdef XFT
-    xftInitFtLibrary
-#endif
-#ifdef THREADED_RUNTIME
-    _ <- forkOS (handle (handler "X event handler") (handleXEvent w sig))
-#else
-    _ <- forkIO (handle (handler "X event handler") (handleXEvent w sig))
-#endif
+    forkThread "X event handler" (handleXEvent w sig)
     eventLoop xcfg [] sig tv
-  where
-    handler thing (SomeException e) =
-      void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
 
 -- | Translates X11 events received by w to signals handled by eventLoop
 handleXEvent :: Window -> TMVar SignalType -> IO ()