{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Util
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------

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.Maybe
import           Data.Either.Combinators
import           Data.GI.Base.GError
import qualified Data.GI.Gtk.Threading as Gtk
import qualified Data.Text as T
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 :: (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b
liftReader m1 a -> m b
modifier ReaderT r m1 a
action =
  ReaderT r m r
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT r m r -> (r -> ReaderT r m b) -> ReaderT r m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m b -> ReaderT r m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> ReaderT r m b) -> (r -> m b) -> r -> ReaderT r m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m1 a -> m b
modifier (m1 a -> m b) -> (r -> m1 a) -> r -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m1 a -> r -> m1 a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m1 a
action

logPrintF
  :: (MonadIO m, Show t)
  => String -> Priority -> String -> t -> m ()
logPrintF :: String -> Priority -> String -> t -> m ()
logPrintF String
logPath Priority
priority String
format t
toPrint =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
logPath Priority
priority (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
format (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> String
forall a. Show a => a -> String
show t
toPrint

logPrintFDebug :: (MonadIO m, Show t) => String -> String -> t -> m ()
logPrintFDebug :: String -> String -> t -> m ()
logPrintFDebug String
path = String -> Priority -> String -> t -> m ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
String -> Priority -> String -> t -> m ()
logPrintF String
path Priority
DEBUG

infixl 4 ??
(??) :: Functor f => f (a -> b) -> a -> f b
f (a -> b)
fab ?? :: f (a -> b) -> a -> f b
?? a
a = ((a -> b) -> b) -> f (a -> b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) f (a -> b)
fab
{-# INLINE (??) #-}

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM m Bool
cond m a
whenTrue m a
whenFalse =
  m Bool
cond m Bool -> (Bool -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Bool
bool -> if Bool
bool then m a
whenTrue else m a
whenFalse)

forkM :: Monad m => (c -> m a) -> (c -> m b) -> c -> m (a, b)
forkM :: (c -> m a) -> (c -> m b) -> c -> m (a, b)
forkM c -> m a
a c -> m b
b = (m a, m b) -> m (a, b)
forall a b. SequenceT a b => a -> b
sequenceT ((m a, m b) -> m (a, b)) -> (c -> (m a, m b)) -> c -> m (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> m a
a (c -> m a) -> (c -> m b) -> c -> (m a, m b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& c -> m b
b)

maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither = (Either b a -> (a -> Either b a) -> Maybe a -> Either b a)
-> (a -> Either b a) -> Either b a -> Maybe a -> Either b a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either b a -> (a -> Either b a) -> Maybe a -> Either b a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> Either b a
forall a b. b -> Either a b
Right (Either b a -> Maybe a -> Either b a)
-> (b -> Either b a) -> b -> Maybe a -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b a
forall a b. a -> Either a b
Left

truncateString :: Int -> String -> String
truncateString :: Int -> String -> String
truncateString Int
n String
incoming
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
incoming Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = String
incoming
  | Bool
otherwise = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n String
incoming String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"…"

truncateText :: Int -> T.Text -> T.Text
truncateText :: Int -> Text -> Text
truncateText Int
n Text
incoming
  | Text -> Int
T.length Text
incoming Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = Text
incoming
  | Bool
otherwise = Text -> Text -> Text
T.append (Int -> Text -> Text
T.take Int
n Text
incoming) Text
"…"

runCommandFromPath :: MonadIO m => [String] -> m (Either String String)
runCommandFromPath :: [String] -> m (Either String String)
runCommandFromPath = String -> [String] -> m (Either String String)
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> m (Either String String)
runCommand String
"/usr/bin/env"

-- | Run the provided command with the provided arguments.
runCommand :: MonadIO m => FilePath -> [String] -> m (Either String String)
runCommand :: String -> [String] -> m (Either String String)
runCommand String
cmd [String]
args = IO (Either String String) -> m (Either String String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String String) -> m (Either String String))
-> IO (Either String String) -> m (Either String String)
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
ecode, String
stdout, String
stderr) <- String -> [String] -> String -> IO (ExitCode, String, String)
P.readProcessWithExitCode String
cmd [String]
args String
""
  String -> Priority -> String -> IO ()
logM String
"System.Taffybar.Util" Priority
INFO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
       String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Running command %s with args %s" (String -> String
forall a. Show a => a -> String
show String
cmd) ([String] -> String
forall a. Show a => a -> String
show [String]
args)
  Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ case ExitCode
ecode of
    ExitCode
ExitSuccess -> String -> Either String String
forall a b. b -> Either a b
Right String
stdout
    ExitFailure Int
exitCode -> String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Exit code %s: %s " (Int -> String
forall a. Show a => a -> String
show Int
exitCode) String
stderr

-- | Execute the provided IO action at the provided interval.
foreverWithDelay :: RealFrac d => d -> IO a -> IO ThreadId
foreverWithDelay :: d -> IO a -> IO ThreadId
foreverWithDelay d
delay IO a
action =
  IO d -> IO ThreadId
forall d. RealFrac d => IO d -> IO ThreadId
foreverWithVariableDelay (IO d -> IO ThreadId) -> IO d -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO a
action IO a -> IO d -> IO d
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> IO d
forall (m :: * -> *) a. Monad m => a -> m a
return d
delay

foreverWithVariableDelay :: RealFrac d => IO d -> IO ThreadId
foreverWithVariableDelay :: IO d -> IO ThreadId
foreverWithVariableDelay IO d
action = IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO d
action IO d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> IO ()
delayThenAction
  where delayThenAction :: d -> IO ()
delayThenAction d
delay =
          Int -> IO ()
threadDelay (d -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (d -> Int) -> d -> Int
forall a b. (a -> b) -> a -> b
$ d
delay d -> d -> d
forall a. Num a => a -> a -> a
* d
1000000) IO () -> IO d -> IO d
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO d
action IO d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> IO ()
delayThenAction

liftActionTaker
  :: (Monad m)
  => ((a -> m a) -> m b) -> (a -> ReaderT c m a) -> ReaderT c m b
liftActionTaker :: ((a -> m a) -> m b) -> (a -> ReaderT c m a) -> ReaderT c m b
liftActionTaker (a -> m a) -> m b
actionTaker a -> ReaderT c m a
action = do
  c
ctx <- ReaderT c m c
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  m b -> ReaderT c m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> ReaderT c m b) -> m b -> ReaderT c m b
forall a b. (a -> b) -> a -> b
$ (a -> m a) -> m b
actionTaker ((a -> m a) -> m b) -> (a -> m a) -> m b
forall a b. (a -> b) -> a -> b
$ (ReaderT c m a -> c -> m a) -> c -> ReaderT c m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT c m a -> c -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT c
ctx (ReaderT c m a -> m a) -> (a -> ReaderT c m a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT c m a
action

maybeTCombine
  :: Monad m
  => m (Maybe a) -> m (Maybe a) -> m (Maybe a)
maybeTCombine :: m (Maybe a) -> m (Maybe a) -> m (Maybe a)
maybeTCombine m (Maybe a)
a m (Maybe a)
b = MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m a -> m (Maybe a)) -> MaybeT m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe a)
a MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe a)
b

infixl 3 <||>
(<||>) ::
  Monad m =>
  (t -> m (Maybe a)) -> (t -> m (Maybe a)) -> t -> m (Maybe a)
t -> m (Maybe a)
a <||> :: (t -> m (Maybe a)) -> (t -> m (Maybe a)) -> t -> m (Maybe a)
<||> t -> m (Maybe a)
b = t -> m (Maybe a)
combineOptions
  where combineOptions :: t -> m (Maybe a)
combineOptions t
v = m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
maybeTCombine (t -> m (Maybe a)
a t
v) (t -> m (Maybe a)
b t
v)

infixl 3 <|||>
(<|||>)
  :: Monad m
  => (t -> t1 -> m (Maybe a))
  -> (t -> t1 -> m (Maybe a))
  -> t
  -> t1
  -> m (Maybe a)
t -> t1 -> m (Maybe a)
a <|||> :: (t -> t1 -> m (Maybe a))
-> (t -> t1 -> m (Maybe a)) -> t -> t1 -> m (Maybe a)
<|||> t -> t1 -> m (Maybe a)
b = t -> t1 -> m (Maybe a)
combineOptions
  where combineOptions :: t -> t1 -> m (Maybe a)
combineOptions t
v t1
v1 = m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
maybeTCombine (t -> t1 -> m (Maybe a)
a t
v t1
v1) (t -> t1 -> m (Maybe a)
b t
v t1
v1)

catchGErrorsAsLeft :: IO a -> IO (Either GError a)
catchGErrorsAsLeft :: IO a -> IO (Either GError a)
catchGErrorsAsLeft IO a
action = IO (Either GError a)
-> (GError -> IO (Either GError a)) -> IO (Either GError a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> Either GError a
forall a b. b -> Either a b
Right (a -> Either GError a) -> IO a -> IO (Either GError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action) (Either GError a -> IO (Either GError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GError a -> IO (Either GError a))
-> (GError -> Either GError a) -> GError -> IO (Either GError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GError -> Either GError a
forall a b. a -> Either a b
Left)

catchGErrorsAsNothing :: IO a -> IO (Maybe a)
catchGErrorsAsNothing :: IO a -> IO (Maybe a)
catchGErrorsAsNothing = (Either GError a -> Maybe a)
-> IO (Either GError a) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either GError a -> Maybe a
forall a b. Either a b -> Maybe b
rightToMaybe (IO (Either GError a) -> IO (Maybe a))
-> (IO a -> IO (Either GError a)) -> IO a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either GError a)
forall a. IO a -> IO (Either GError a)
catchGErrorsAsLeft

safePixbufNewFromFile :: FilePath -> IO (Maybe Gdk.Pixbuf)
safePixbufNewFromFile :: String -> IO (Maybe Pixbuf)
safePixbufNewFromFile =
  IO (Maybe (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
forall a. IO (Maybe (Maybe a)) -> IO (Maybe a)
handleResult (IO (Maybe (Maybe Pixbuf)) -> IO (Maybe Pixbuf))
-> (String -> IO (Maybe (Maybe Pixbuf)))
-> String
-> IO (Maybe Pixbuf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe Pixbuf) -> IO (Maybe (Maybe Pixbuf))
forall a. IO a -> IO (Maybe a)
catchGErrorsAsNothing (IO (Maybe Pixbuf) -> IO (Maybe (Maybe Pixbuf)))
-> (String -> IO (Maybe Pixbuf))
-> String
-> IO (Maybe (Maybe Pixbuf))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe Pixbuf)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m (Maybe Pixbuf)
Gdk.pixbufNewFromFile
  where
#if MIN_VERSION_gi_gdkpixbuf(2,0,26)
    handleResult :: IO (Maybe (Maybe a)) -> IO (Maybe a)
handleResult = (Maybe (Maybe a) -> Maybe a)
-> IO (Maybe (Maybe a)) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
#else
    handleResult = id
#endif

getPixbufFromFilePath :: FilePath -> IO (Maybe Gdk.Pixbuf)
getPixbufFromFilePath :: String -> IO (Maybe Pixbuf)
getPixbufFromFilePath String
filepath = do
  Maybe Pixbuf
result <- String -> IO (Maybe Pixbuf)
safePixbufNewFromFile String
filepath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixbuf -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Pixbuf
result) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       String -> Priority -> String -> IO ()
logM String
"System.Taffybar.WindowIcon" Priority
WARNING (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Failed to load icon from filepath %s" String
filepath
  Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
result

postGUIASync :: IO () -> IO ()
postGUIASync :: IO () -> IO ()
postGUIASync = IO () -> IO ()
Gtk.postGUIASync

postGUISync :: IO () -> IO ()
postGUISync :: IO () -> IO ()
postGUISync = IO () -> IO ()
forall a. IO a -> IO a
Gtk.postGUISync