{-# LANGUAGE CPP #-}

------------------------------------------------------------------------------
-- |
-- Module: Utils
-- Copyright: (c) 2010, 2018 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: Jose A Ortega Ruiz <jao@gnu.org>
-- Stability: unstable
-- Portability: unportable
-- Created: Sat Dec 11, 2010 20:55
--
--
-- Miscellaneous utility functions
--
------------------------------------------------------------------------------


module Xmobar.System.Utils (expandHome, changeLoop, hGetLineSafe)
where

import Control.Monad
import Control.Concurrent.STM

import System.Environment
import System.FilePath
import System.IO

#if defined XFT || defined UTF8
import qualified System.IO as S (hGetLine)
#endif

hGetLineSafe :: Handle -> IO String
#if defined XFT || defined UTF8
hGetLineSafe :: Handle -> IO String
hGetLineSafe = Handle -> IO String
S.hGetLine
#else
hGetLineSafe = hGetLine
#endif


expandHome :: FilePath -> IO FilePath
expandHome :: String -> IO String
expandHome (Char
'~':Char
'/':String
path) = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
path) (String -> IO String
getEnv String
"HOME")
expandHome String
p = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p

changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()
changeLoop :: STM a -> (a -> IO ()) -> IO ()
changeLoop STM a
s a -> IO ()
f = STM a -> IO a
forall a. STM a -> IO a
atomically STM a
s IO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO ()
forall b. a -> IO b
go
 where
    go :: a -> IO b
go a
old = do
        a -> IO ()
f a
old
        a -> IO b
go (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM a -> IO a
forall a. STM a -> IO a
atomically (do
            a
new <- STM a
s
            Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
new a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
old)
            a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
new)