    -- | This is a simple static image widget, and a polling image widget that
    -- updates its contents by calling a callback at a set interval.
    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

    -- | Create a new widget that displays a static image
    --
    -- > iconImageWidgetNew path
    --
    -- returns a widget with icon at @path@.
    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

    -- | Create a new widget that updates itself at regular intervals.  The
    -- function
    --
    -- > pollingIconImageWidgetNew path interval cmd
    --
    -- returns a widget with initial icon at @path@.  The widget
    -- forks a thread to update its contents every @interval@ seconds.
    -- The command should return a FilePath of a valid icon.
    --
    -- If the IO action throws an exception, it will be swallowed and the
    -- label will not update until the update interval expires.
    pollingIconImageWidgetNew
      :: MonadIO m
      => FilePath -- ^ Initial file path of the icon
      -> Double -- ^ Update interval (in seconds)
      -> IO FilePath -- ^ Command to run to get the input 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 ()