summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/System/Utils.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-02-04 23:11:56 +0000
committerjao <jao@gnu.org>2022-02-06 00:24:10 +0000
commitc0a9c6df0080a0db5981047f80c9c120ac1cef61 (patch)
treedd8aff5a2cfa631fa996c68cd00fdb4e36e4a26d /src/Xmobar/System/Utils.hs
parente020b92e7ace80867a93873ab5b7d40e1ae3ddfe (diff)
downloadxmobar-c0a9c6df0080a0db5981047f80c9c120ac1cef61.tar.gz
xmobar-c0a9c6df0080a0db5981047f80c9c120ac1cef61.tar.bz2
Little refactoring: forkThread
Diffstat (limited to 'src/Xmobar/System/Utils.hs')
-rw-r--r--src/Xmobar/System/Utils.hs23
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