module System.Taffybar.Widget.Generic.Icon
( iconImageWidgetNew
, pollingIconImageWidgetNew
) where
import Control.Concurrent ( forkIO, threadDelay )
import Control.Exception as E
import Control.Monad ( forever )
import Control.Monad.IO.Class
import GI.Gtk
import System.Taffybar.Util
iconImageWidgetNew :: MonadIO m => FilePath -> m Widget
iconImageWidgetNew :: FilePath -> m Widget
iconImageWidgetNew path :: FilePath
path = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Image
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FilePath -> m Image
imageNewFromFile FilePath
path IO Image -> (Image -> IO Widget) -> IO Widget
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Image -> IO Widget
forall child. IsWidget child => child -> IO Widget
putInBox
pollingIconImageWidgetNew
:: MonadIO m
=> FilePath
-> Double
-> IO FilePath
-> m Widget
pollingIconImageWidgetNew :: FilePath -> Double -> IO FilePath -> m Widget
pollingIconImageWidgetNew path :: FilePath
path interval :: Double
interval cmd :: IO FilePath
cmd = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
Image
icon <- FilePath -> IO Image
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FilePath -> m Image
imageNewFromFile FilePath
path
SignalHandlerId
_ <- Image -> WidgetRealizeCallback -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> WidgetRealizeCallback -> m SignalHandlerId
onWidgetRealize Image
icon (WidgetRealizeCallback -> IO SignalHandlerId)
-> WidgetRealizeCallback -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
ThreadId
_ <- WidgetRealizeCallback -> IO ThreadId
forkIO (WidgetRealizeCallback -> IO ThreadId)
-> WidgetRealizeCallback -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ WidgetRealizeCallback -> WidgetRealizeCallback
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (WidgetRealizeCallback -> WidgetRealizeCallback)
-> WidgetRealizeCallback -> WidgetRealizeCallback
forall a b. (a -> b) -> a -> b
$ do
let tryUpdate :: WidgetRealizeCallback
tryUpdate = do
FilePath
str <- IO FilePath
cmd
WidgetRealizeCallback -> WidgetRealizeCallback
postGUIASync (WidgetRealizeCallback -> WidgetRealizeCallback)
-> WidgetRealizeCallback -> WidgetRealizeCallback
forall a b. (a -> b) -> a -> b
$ Image -> Maybe FilePath -> WidgetRealizeCallback
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Maybe FilePath -> m ()
imageSetFromFile Image
icon (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
str)
WidgetRealizeCallback
-> (IOException -> WidgetRealizeCallback) -> WidgetRealizeCallback
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch WidgetRealizeCallback
tryUpdate IOException -> WidgetRealizeCallback
ignoreIOException
Int -> WidgetRealizeCallback
threadDelay (Int -> WidgetRealizeCallback) -> Int -> WidgetRealizeCallback
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
interval Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1000000)
() -> WidgetRealizeCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Image -> IO Widget
forall child. IsWidget child => child -> IO Widget
putInBox Image
icon
putInBox :: IsWidget child => child -> IO Widget
putInBox :: child -> IO Widget
putInBox icon :: child
icon = do
Box
box <- Orientation -> Int32 -> IO Box
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Orientation -> Int32 -> m Box
boxNew Orientation
OrientationHorizontal 0
Box -> child -> Bool -> Bool -> Word32 -> WidgetRealizeCallback
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Bool -> Bool -> Word32 -> m ()
boxPackStart Box
box child
icon Bool
False Bool
False 0
Box -> WidgetRealizeCallback
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShowAll Box
box
Box -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget Box
box
ignoreIOException :: IOException -> IO ()
ignoreIOException :: IOException -> WidgetRealizeCallback
ignoreIOException _ = () -> WidgetRealizeCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()