From c0a9c6df0080a0db5981047f80c9c120ac1cef61 Mon Sep 17 00:00:00 2001 From: jao Date: Fri, 4 Feb 2022 23:11:56 +0000 Subject: Little refactoring: forkThread --- src/Xmobar/System/Utils.hs | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) (limited to 'src/Xmobar/System') 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 @@ -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 -- cgit v1.2.3