Little refactoring: forkThread

1 files changed, 22 insertions, 1 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