{-# 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 (
  -- * Configuration
    taffyStateDir
  -- * GTK concurrency
  , module Gtk
  -- * GLib
  , catchGErrorsAsLeft
  -- * Logging
  , logPrintF
  -- * Text
  , truncateString
  , truncateText
  -- * Resources
  , downloadURIToPath
  , getPixbufFromFilePath
  , safePixbufNewFromFile
  -- * Logic Combinators
  , (<||>)
  , (<|||>)
  , forkM
  , ifM
  , anyM
  , maybeTCombine
  , maybeToEither
  -- * Control
  , foreverWithVariableDelay
  , foreverWithDelay
  -- * Process control
  , runCommand
  , onSigINT
  , maybeHandleSigHUP
  , handlePosixSignal
  -- * Resource management
  , rebracket
  , rebracket_
  -- * Deprecated
  , logPrintFDebug
  , liftReader
  , liftActionTaker
  , (??)
  , runCommandFromPath
  ) where

import           Conduit
import           Control.Applicative
import           Control.Arrow ((&&&))
import           Control.Concurrent (ThreadId, forkIO, threadDelay)
import qualified Control.Concurrent.MVar as MV
import           Control.Exception.Base
import           Control.Monad
import           Control.Monad.Trans.Maybe
import           Control.Monad.Trans.Reader
import           Data.Either.Combinators
import           Data.GI.Base.GError
import           Control.Exception.Enclosed (catchAny)
import           Data.GI.Gtk.Threading as Gtk (postGUIASync, postGUISync)
import           Data.GI.Gtk.Threading (postGUIASyncWithPriority)
import           Data.Maybe
import           Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.Text as T
import           Data.Tuple.Sequence
import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
import qualified GI.GLib.Constants as G
import           Network.HTTP.Simple
import           System.Directory
import           System.Environment.XDG.BaseDir
import           System.Exit (ExitCode (..), exitWith)
import           System.FilePath.Posix
import           System.IO (hIsTerminalDevice, stdout, stderr)
import           System.Log.Logger
import           System.Posix.Signals (Signal, Handler(..), installHandler, sigHUP, sigINT)
import qualified System.Process as P
import           Text.Printf


taffyStateDir :: IO FilePath
taffyStateDir :: IO FilePath
taffyStateDir = FilePath -> IO FilePath
getUserDataDir FilePath
"taffybar"

{-# DEPRECATED liftReader "Use Control.Monad.Trans.Reader.mapReaderT instead" #-}
liftReader :: Monad m => (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b
liftReader :: forall (m :: * -> *) (m1 :: * -> *) a b r.
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
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT

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

{-# DEPRECATED logPrintFDebug "Use logPrintF instead" #-}
logPrintFDebug :: (MonadIO m, Show t) => String -> String -> t -> m ()
logPrintFDebug :: forall (m :: * -> *) t.
(MonadIO m, Show t) =>
FilePath -> FilePath -> t -> m ()
logPrintFDebug FilePath
path = FilePath -> Priority -> FilePath -> t -> m ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
FilePath -> Priority -> FilePath -> t -> m ()
logPrintF FilePath
path Priority
DEBUG

infixl 4 ??
(??) :: Functor f => f (a -> b) -> a -> f b
f (a -> b)
fab ?? :: forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? a
a = ((a -> b) -> b) -> f (a -> b) -> f b
forall a b. (a -> b) -> f a -> 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 (??) #-}
{-# DEPRECATED (??) "Use @f <*> pure a@ instead" #-}

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => 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 a b. m a -> (a -> m b) -> m b
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 :: forall (m :: * -> *) c a b.
Monad m =>
(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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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 :: forall b a. 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 -> FilePath -> FilePath
truncateString Int
n FilePath
incoming
  | FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
incoming Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = FilePath
incoming
  | Bool
otherwise = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
n FilePath
incoming FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"…"

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
"…"

-- | Run the provided command with the provided arguments.
--
-- If the command filename does not contain a slash, then the @PATH@
-- environment variable is searched for the executable.
runCommand :: MonadIO m => FilePath -> [String] -> m (Either String String)
runCommand :: forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> m (Either FilePath FilePath)
runCommand FilePath
cmd [FilePath]
args = IO (Either FilePath FilePath) -> m (Either FilePath FilePath)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath FilePath) -> m (Either FilePath FilePath))
-> IO (Either FilePath FilePath) -> m (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
ecode, FilePath
out, FilePath
err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
P.readProcessWithExitCode FilePath
cmd [FilePath]
args FilePath
""
  FilePath -> Priority -> FilePath -> IO ()
logM FilePath
"System.Taffybar.Util" Priority
INFO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
       FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"Running command %s with args %s" (FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
cmd) ([FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args)
  Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> IO (Either FilePath FilePath))
-> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ case ExitCode
ecode of
    ExitCode
ExitSuccess -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
out
    ExitFailure Int
exitCode -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"Exit code %s: %s " (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
exitCode) FilePath
err

{-# DEPRECATED runCommandFromPath "Use runCommand instead" #-}
runCommandFromPath :: MonadIO m => FilePath -> [String] -> m (Either String String)
runCommandFromPath :: forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> m (Either FilePath FilePath)
runCommandFromPath = FilePath -> [FilePath] -> m (Either FilePath FilePath)
forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> m (Either FilePath FilePath)
runCommand

-- | A variant of 'bracket' which allows for reloading.
--
-- The first parameter is an allocation function which returns a newly
-- created value of type @r@, paired with an @IO@ action which will
-- destroy that value.
--
-- The second parameter is the action to run. It is passed a "reload"
-- function which will run the allocation function and return the
-- newly created value.
--
-- Initially, there is no value. Reloading will cause the previous
-- value (if any) to be destroyed. When the action completes, the
-- current value (if any) will be destroyed.
rebracket :: IO (IO (), r) -> (IO r -> IO a) -> IO a
rebracket :: forall r a. IO (IO (), r) -> (IO r -> IO a) -> IO a
rebracket IO (IO (), r)
alloc IO r -> IO a
action = IO (MVar (Maybe (IO (), r)))
-> (MVar (Maybe (IO (), r)) -> IO ())
-> (MVar (Maybe (IO (), r)) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (MVar (Maybe (IO (), r)))
forall {a}. IO (MVar (Maybe a))
setup MVar (Maybe (IO (), r)) -> IO ()
teardown (IO r -> IO a
action (IO r -> IO a)
-> (MVar (Maybe (IO (), r)) -> IO r)
-> MVar (Maybe (IO (), r))
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe (IO (), r)) -> IO r
reload)
  where
    cleanup :: (a, b) -> a
cleanup = (a, b) -> a
forall a b. (a, b) -> a
fst
    resource :: (a, b) -> b
resource = (a, b) -> b
forall a b. (a, b) -> b
snd
    setup :: IO (MVar (Maybe a))
setup = Maybe a -> IO (MVar (Maybe a))
forall a. a -> IO (MVar a)
MV.newMVar Maybe a
forall a. Maybe a
Nothing
    teardown :: MVar (Maybe (IO (), r)) -> IO ()
teardown = Maybe (IO (), r) -> IO ()
forall {b}. Maybe (IO (), b) -> IO ()
maybeTeardown (Maybe (IO (), r) -> IO ())
-> (MVar (Maybe (IO (), r)) -> IO (Maybe (IO (), r)))
-> MVar (Maybe (IO (), r))
-> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MVar (Maybe (IO (), r)) -> IO (Maybe (IO (), r))
forall a. MVar a -> IO a
MV.takeMVar
    maybeTeardown :: Maybe (IO (), b) -> IO ()
maybeTeardown = IO () -> ((IO (), b) -> IO ()) -> Maybe (IO (), b) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO (), b) -> IO ()
forall a b. (a, b) -> a
cleanup
    reload :: MVar (Maybe (IO (), r)) -> IO r
reload MVar (Maybe (IO (), r))
var = MVar (Maybe (IO (), r))
-> (Maybe (IO (), r) -> IO (Maybe (IO (), r), r)) -> IO r
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MV.modifyMVar MVar (Maybe (IO (), r))
var ((Maybe (IO (), r) -> IO (Maybe (IO (), r), r)) -> IO r)
-> (Maybe (IO (), r) -> IO (Maybe (IO (), r), r)) -> IO r
forall a b. (a -> b) -> a -> b
$ \Maybe (IO (), r)
stale -> do
      Maybe (IO (), r) -> IO ()
forall {b}. Maybe (IO (), b) -> IO ()
maybeTeardown Maybe (IO (), r)
stale
      (IO (), r)
fresh <- IO (IO (), r)
alloc
      (Maybe (IO (), r), r) -> IO (Maybe (IO (), r), r)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((IO (), r) -> Maybe (IO (), r)
forall a. a -> Maybe a
Just (IO (), r)
fresh, (IO (), r) -> r
forall a b. (a, b) -> b
resource (IO (), r)
fresh)

-- | A variant of 'rebracket' where the resource value isn't needed.
--
-- And because the resource value isn't needed, this variant will
-- automatically allocate the resource before running the enclosed
-- action.
rebracket_ :: IO (IO ()) -> (IO () -> IO a) -> IO a
rebracket_ :: forall a. IO (IO ()) -> (IO () -> IO a) -> IO a
rebracket_ IO (IO ())
alloc IO () -> IO a
action = IO (IO (), ()) -> (IO () -> IO a) -> IO a
forall r a. IO (IO (), r) -> (IO r -> IO a) -> IO a
rebracket ((, ()) (IO () -> (IO (), ())) -> IO (IO ()) -> IO (IO (), ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IO ())
alloc) ((IO () -> IO a) -> IO a) -> (IO () -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
  \IO ()
reload -> IO ()
reload IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO a
action IO ()
reload

-- | Execute the provided IO action at the provided interval.
foreverWithDelay :: (MonadIO m, RealFrac d) => d -> IO () -> m ThreadId
foreverWithDelay :: forall (m :: * -> *) d.
(MonadIO m, RealFrac d) =>
d -> IO () -> m ThreadId
foreverWithDelay d
delay IO ()
action =
  IO d -> m ThreadId
forall (m :: * -> *) d.
(MonadIO m, RealFrac d) =>
IO d -> m ThreadId
foreverWithVariableDelay (IO d -> m ThreadId) -> IO d -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO ()
safeAction IO () -> IO d -> IO d
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> IO d
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return d
delay
  where safeAction :: IO ()
safeAction =
          IO () -> (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> (SomeException -> m a) -> m a
catchAny IO ()
action ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
            FilePath -> Priority -> FilePath -> SomeException -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
FilePath -> Priority -> FilePath -> t -> m ()
logPrintF FilePath
"System.Taffybar.Util" Priority
WARNING FilePath
"Error in foreverWithDelay %s" SomeException
e

-- | Execute the provided IO action, and use the value it returns to decide how
-- long to wait until executing it again. The value returned by the action is
-- interpreted as a number of seconds.
foreverWithVariableDelay :: (MonadIO m, RealFrac d) => IO d -> m ThreadId
foreverWithVariableDelay :: forall (m :: * -> *) d.
(MonadIO m, RealFrac d) =>
IO d -> m ThreadId
foreverWithVariableDelay IO d
action = IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ 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 a b. IO a -> (a -> IO b) -> IO b
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 b. Integral b => d -> b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO d
action IO d -> (d -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: forall (m :: * -> *) a b c.
Monad m =>
((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 (m :: * -> *) a. Monad m => m a -> ReaderT c m a
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 :: forall (m :: * -> *) a.
Monad m =>
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 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 <||> :: forall (m :: * -> *) t a.
Monad m =>
(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 <|||> :: forall (m :: * -> *) t t1 a.
Monad m =>
(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 :: forall a. 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 a. a -> IO 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 :: forall a. IO a -> IO (Maybe a)
catchGErrorsAsNothing = (Either GError a -> Maybe a)
-> IO (Either GError a) -> IO (Maybe a)
forall a b. (a -> b) -> IO a -> IO b
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 :: FilePath -> 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))
-> (FilePath -> IO (Maybe (Maybe Pixbuf)))
-> FilePath
-> 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)))
-> (FilePath -> IO (Maybe Pixbuf))
-> FilePath
-> IO (Maybe (Maybe Pixbuf))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe Pixbuf)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FilePath -> 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 a b. (a -> b) -> IO a -> IO b
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 :: FilePath -> IO (Maybe Pixbuf)
getPixbufFromFilePath FilePath
filepath = do
  Maybe Pixbuf
result <- FilePath -> IO (Maybe Pixbuf)
safePixbufNewFromFile FilePath
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
$
       FilePath -> Priority -> FilePath -> IO ()
logM FilePath
"System.Taffybar.WindowIcon" Priority
WARNING (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"Failed to load icon from filepath %s" FilePath
filepath
  Maybe Pixbuf -> IO (Maybe Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
result

downloadURIToPath :: Request -> FilePath -> IO ()
downloadURIToPath :: Request -> FilePath -> IO ()
downloadURIToPath Request
uri FilePath
filepath =
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
directory IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (Request
-> (Response (ConduitM () ByteString (ResourceT IO) ())
    -> ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) (n :: * -> *) i o r.
(MonadResource m, MonadIO n) =>
Request
-> (Response (ConduitM i ByteString n ()) -> ConduitM i o m r)
-> ConduitM i o m r
httpSource Request
uri Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall a. Response a -> a
getResponseBody ConduitM () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| FilePath -> ConduitT ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
filepath)
  where (FilePath
directory, FilePath
_) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
filepath

anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
anyM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM a -> m Bool
_ [] = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
anyM a -> m Bool
p (a
x:[a]
xs) = do
  Bool
q <- a -> m Bool
p a
x
  if Bool
q
  then Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  else (a -> m Bool) -> [a] -> m Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM a -> m Bool
p [a]
xs

-- | Installs a useful posix signal handler for 'sigINT' (i.e. Ctrl-C)
-- for cases when the 'Control.Exception.UserInterrupt' exception gets
-- swallowed within a main loop, preventing the program from exiting.
--
-- The given callback should be a command which causes the main loop
-- action to exit. For example:
--
-- > Gtk.main `onSigINT` Gtk.mainQuit
--
-- If the signal handler was invoked, the program will exit with
-- status 130 after the main loop action returns.
onSigINT
  :: IO a -- ^ The main loop 'IO' action
  -> IO () -- ^ Callback for @SIGINT@
  -> IO a
onSigINT :: forall a. IO a -> IO () -> IO a
onSigINT IO a
action IO ()
callback = do
  IORef (Maybe ExitCode)
exitStatus <- Maybe ExitCode -> IO (IORef (Maybe ExitCode))
forall a. a -> IO (IORef a)
newIORef Maybe ExitCode
forall a. Maybe a
Nothing

  let intHandler :: IO ()
intHandler = do
        IORef (Maybe ExitCode) -> Maybe ExitCode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ExitCode)
exitStatus (ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just (Int -> ExitCode
ExitFailure Int
130))
        IO ()
callback

  Signal -> Handler -> IO a -> IO a
forall a. Signal -> Handler -> IO a -> IO a
withSigHandlerBase Signal
sigINT (IO () -> Handler
CatchOnce IO ()
intHandler) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    a
res <- IO a
action
    IORef (Maybe ExitCode) -> IO (Maybe ExitCode)
forall a. IORef a -> IO a
readIORef IORef (Maybe ExitCode)
exitStatus IO (Maybe ExitCode) -> (Maybe ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ExitCode -> IO Any) -> Maybe ExitCode -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExitCode -> IO Any
forall a. ExitCode -> IO a
exitWith
    a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

-- | Installs the given function as a handler for @SIGHUP@, but only
-- if this process is not running in a terminal (i.e. runnning as a
-- daemon).
--
-- If not running as a daemon, then no handler is installed by
-- 'maybeHandleSigHUP'. The default handler for 'sigHUP' exits the
-- program, which is the correct thing to do.
maybeHandleSigHUP :: IO () -> IO a -> IO a
maybeHandleSigHUP :: forall a. IO () -> IO a -> IO a
maybeHandleSigHUP IO ()
callback IO a
action =
  IO Bool -> IO a -> IO a -> IO a
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((Handle -> IO Bool) -> [Handle] -> IO Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM Handle -> IO Bool
hIsTerminalDevice [Handle
stdout, Handle
stderr])
    IO a
action
    (Signal -> IO () -> IO a -> IO a
forall a. Signal -> IO () -> IO a -> IO a
handlePosixSignal Signal
sigHUP IO ()
callback IO a
action)

-- | Install a handler for the given POSIX 'Signal' while the given
-- @IO@ action is running, then restore the original handler.
--
-- This function is for handling non-critical signals.
--
-- The given callback function won't be run immediately within the
-- @sigaction@ handler, but will instead be posted to the GLib main
-- loop.
handlePosixSignal :: Signal -> IO () -> IO a -> IO a
handlePosixSignal :: forall a. Signal -> IO () -> IO a -> IO a
handlePosixSignal Signal
sig IO ()
cb = Signal -> Handler -> IO a -> IO a
forall a. Signal -> Handler -> IO a -> IO a
withSigHandlerBase Signal
sig (IO () -> Handler
Catch IO ()
handler)
  where
    handler :: IO ()
handler = Int32 -> IO () -> IO ()
postGUIASyncWithPriority Int32
G.PRIORITY_HIGH_IDLE IO ()
cb

-- | Install a handler for the given signal, run an 'IO' action, then
-- restore the original handler.
withSigHandlerBase :: Signal -> Handler -> IO a -> IO a
withSigHandlerBase :: forall a. Signal -> Handler -> IO a -> IO a
withSigHandlerBase Signal
sig Handler
h = IO Handler -> (Handler -> IO Handler) -> (Handler -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Handler -> IO Handler
install Handler
h) Handler -> IO Handler
install ((Handler -> IO a) -> IO a)
-> (IO a -> Handler -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Handler -> IO a
forall a b. a -> b -> a
const
  where
    install :: Handler -> IO Handler
install Handler
handler = Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sig Handler
handler Maybe SignalSet
forall a. Maybe a
Nothing