module System.Taffybar.Util where
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Concurrent
import Control.Exception.Base
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Either.Combinators
import Data.GI.Base.GError
import Data.Tuple.Sequence
import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
import System.Exit (ExitCode (..))
import System.Log.Logger
import qualified System.Process as P
import Text.Printf
liftReader ::
Monad m => (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b
liftReader modifier action =
ask >>= lift . modifier . runReaderT action
logPrintF
:: (MonadIO m, Show t)
=> String -> Priority -> String -> t -> m ()
logPrintF logPath priority format toPrint =
liftIO $ logM logPath priority $ printf format $ show toPrint
logPrintFDebug :: (MonadIO m, Show t) => String -> String -> t -> m ()
logPrintFDebug path = logPrintF path DEBUG
infixl 4 ??
(??) :: Functor f => f (a -> b) -> a -> f b
fab ?? a = fmap ($ a) fab
{-# INLINE (??) #-}
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM cond whenTrue whenFalse =
cond >>= (\bool -> if bool then whenTrue else whenFalse)
forkM :: Monad m => (c -> m a) -> (c -> m b) -> c -> m (a, b)
forkM a b = sequenceT . (a &&& b)
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither = flip maybe Right . Left
truncateString :: Int -> String -> String
truncateString n xs
| length xs <= n = xs
| otherwise = take n xs ++ "…"
runCommandFromPath :: MonadIO m => [String] -> m (Either String String)
runCommandFromPath = runCommand "/usr/bin/env"
runCommand :: MonadIO m => FilePath -> [String] -> m (Either String String)
runCommand cmd args = liftIO $ do
(ecode, stdout, stderr) <- P.readProcessWithExitCode cmd args ""
logM "System.Taffybar.Util" INFO $
printf "Running command %s with args %s" (show cmd) (show args)
return $ case ecode of
ExitSuccess -> Right stdout
ExitFailure exitCode -> Left $ printf "Exit code %s: %s " (show exitCode) stderr
foreverWithDelay :: RealFrac a1 => a1 -> IO a -> IO ThreadId
foreverWithDelay delay action =
forkIO $ forever $ action >> threadDelay (floor $ delay * 1000000)
liftActionTaker
:: (Monad m)
=> ((a -> m a) -> m b) -> (a -> ReaderT c m a) -> ReaderT c m b
liftActionTaker actionTaker action = do
ctx <- ask
lift $ actionTaker $ flip runReaderT ctx . action
maybeTCombine
:: Monad m
=> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
maybeTCombine a b = runMaybeT $ MaybeT a <|> MaybeT b
infixl 3 <||>
(<||>) :: Monad m =>
(t -> m (Maybe a)) -> (t -> m (Maybe a)) -> t -> m (Maybe a)
a <||> b = combineOptions
where combineOptions v = maybeTCombine (a v) (b v)
infixl 3 <|||>
(<|||>)
:: Monad m
=> (t -> t1 -> m (Maybe a))
-> (t -> t1 -> m (Maybe a))
-> t
-> t1
-> m (Maybe a)
a <|||> b = combineOptions
where combineOptions v v1 = maybeTCombine (a v v1) (b v v1)
catchGErrorsAsLeft :: IO a -> IO (Either GError a)
catchGErrorsAsLeft action = catch (Right <$> action) mkLeft
where mkLeft err = return $ Left err
safePixbufNewFromFile :: FilePath -> IO (Either GError Gdk.Pixbuf)
safePixbufNewFromFile filepath =
catchGErrorsAsLeft (Gdk.pixbufNewFromFile filepath)
getPixbufFromFilePath :: FilePath -> IO (Maybe Gdk.Pixbuf)
getPixbufFromFilePath filepath = do
result <- safePixbufNewFromFile filepath
when (isLeft result) $
logM "System.Taffybar.WindowIcon" WARNING $
printf "Failed to load icon from filepath %s" filepath
return $ rightToMaybe result