module Hbro.Util (
io,
logNormal,
logVerbose,
resolve,
spawn,
getAllProcessIDs,
isCaseSensitive,
isForward,
isWrapped,
allItalic,
allBold,
send'',
labelSetMarkupTemporary,
dmenu,
errorHandler
) where
import Hbro.Types
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import Data.List
import Graphics.Rendering.Pango.Enums
import Graphics.UI.Gtk.Display.Label
import Graphics.UI.Gtk.General.General
import Prelude hiding(log)
import System.Console.CmdArgs
import System.Directory
import System.Environment.XDG.BaseDir
import qualified System.Info as Sys
import System.IO
import System.IO.Error hiding(try)
import System.Posix.Process
import System.Posix.Types
import System.Process
import System.ZMQ
io :: MonadIO m => IO a -> m a
io = liftIO
send'' :: Socket a -> ByteString -> IO ()
send'' x y = send x y []
logNormal, logVerbose :: (MonadIO m) => String -> m ()
logNormal = io . whenNormal . putStrLn
logVerbose = io . whenLoud . putStrLn
resolve :: (RefDirs -> a) -> IO a
resolve f = do
homeDir <- getHomeDirectory
tmpDir <- getTemporaryDirectory
configDir <- getUserConfigDir "hbro"
dataDir <- getUserDataDir "hbro"
return . f $ RefDirs homeDir tmpDir configDir dataDir
spawn :: String -> [String] -> IO ()
spawn command options = spawn' (proc command options)
spawn' :: CreateProcess -> IO ()
spawn' command = createProcess command { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe, close_fds = True } >> return ()
getAllProcessIDs :: IO [ProcessID]
getAllProcessIDs = do
(_, pids, _) <- readProcessWithExitCode "pidof" ["hbro"] []
(_, pids', _) <- readProcessWithExitCode "pidof" ["hbro-" ++ Sys.os ++ "-" ++ Sys.arch] []
myPid <- getProcessID
return $ delete myPid . map (read :: String -> ProcessID) . nub . words $ pids ++ " " ++ pids'
labelSetMarkupTemporary :: Label -> String -> Int -> IO ()
labelSetMarkupTemporary label text delay = do
labelSetMarkup label text
timeoutAdd (clear >> return False) delay >> return ()
where
clear = labelSetMarkup label ""
dmenu :: [String]
-> String
-> IO (Maybe String)
dmenu options input = do
(in_, out, err, pid) <- runInteractiveProcess "dmenu" options Nothing Nothing
hPutStr in_ input
hClose in_
output <- try $ hGetLine out :: IO (Either IOError String)
let output' = case output of
Left _ -> Nothing
Right x -> Just x
hClose out >> hClose err >> (void $ waitForProcess pid)
return output'
errorHandler :: FilePath -> IOError -> IO ()
errorHandler file e = do
when (isAlreadyInUseError e) $ (whenNormal . putStrLn) ("ERROR: file <" ++ file ++ "> is already opened and cannot be reopened.")
when (isDoesNotExistError e) $ (whenNormal . putStrLn) ("ERROR: file <" ++ file ++ "> doesn't exist.")
when (isPermissionError e) $ (whenNormal . putStrLn) ("ERROR: user doesn't have permission to open file <" ++ file ++ ">.")
isCaseSensitive :: CaseSensitivity -> Bool
isCaseSensitive CaseSensitive = True
isCaseSensitive _ = False
isForward :: Direction -> Bool
isForward Forward = True
isForward _ = False
isWrapped :: Wrap -> Bool
isWrapped Wrap = True
isWrapped _ = False
allItalic, allBold :: PangoAttribute
allItalic = AttrStyle {paStart = 0, paEnd = 1, paStyle = StyleItalic}
allBold = AttrWeight {paStart = 0, paEnd = 1, paWeight = WeightBold}