    {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    -----------------------------------------------------------------------------
    module System.Taffybar
      (
      -- | Taffybar is a system status bar meant for use with window managers like
      -- XMonad and i3wm. Taffybar is somewhat similar to xmobar, but it opts to use
      -- more heavy weight GUI in the form of gtk+ rather than the mostly textual
      -- approach favored by the latter. This allows it to provide features like an
      -- SNI system tray, and a workspace widget with window icons.
      --

      -- * Config File
      -- |
      -- The interface that taffybar provides to the end user is roughly as follows:
      -- you give Taffybar a list of ([Taffy]IO actions that build) gtk+ widgets and
      -- it renders them in a horizontal bar for you (taking care of ugly details
      -- like reserving strut space so that window managers don't put windows over
      -- it).
      --
      -- The config file in which you specify the gtk+ widgets to render is just a
      -- Haskell source file which is used to produce a custom executable with the
      -- desired set of widgets. This approach requires that taffybar be installed
      -- as a haskell library (not merely as an executable), and that the ghc
      -- compiler be available for recompiling the configuration. The upshot of this
      -- approach is that taffybar's behavior and widget set are not limited to the
      -- set of widgets provided by the library, because custom code and widgets can
      -- be provided to taffybar for instantiation and execution.
      --
      -- The following code snippet is a simple example of what a taffybar
      -- configuration might look like (also see "System.Taffybar.Example"):
      --
      -- > {-# LANGUAGE OverloadedStrings #-}
      -- > import Data.Default (def)
      -- > import System.Taffybar
      -- > import System.Taffybar.Information.CPU
      -- > import System.Taffybar.SimpleConfig
      -- > import System.Taffybar.Widget
      -- > import System.Taffybar.Widget.Generic.Graph
      -- > import System.Taffybar.Widget.Generic.PollingGraph
      -- >
      -- > cpuCallback = do
      -- >   (_, systemLoad, totalLoad) <- cpuLoad
      -- >   return [ totalLoad, systemLoad ]
      -- >
      -- > main = do
      -- >   let cpuCfg = def
      -- >                  { graphDataColors = [ (0, 1, 0, 1), (1, 0, 1, 0.5)]
      -- >                  , graphLabel = Just "cpu"
      -- >                  }
      -- >       clock = textClockNewWith def
      -- >       cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
      -- >       workspaces = workspacesNew def
      -- >       simpleConfig = def
      -- >                        { startWidgets = [ workspaces ]
      -- >                        , endWidgets = [ sniTrayNew, clock, cpu ]
      -- >                        }
      -- >   simpleTaffybar simpleConfig
      --
      -- This configuration creates a bar with four widgets. On the left is a widget
      -- that shows information about the workspace configuration. The rightmost
      -- widget is the system tray, with a clock and then a CPU graph.
      --
      -- The CPU widget plots two graphs on the same widget: total CPU use in green
      -- and then system CPU use in a kind of semi-transparent purple on top of the
      -- green.
      --
      -- It is important to note that the widget lists are *not* [Widget]. They are
      -- actually [TaffyIO Widget] since the bar needs to construct them after
      -- performing some GTK initialization.
      --
      -- * Taffybar and DBus
      --
      -- | Taffybar has a strict dependency on dbus, so you must ensure that it is
      -- started before starting taffybar.
      --
      -- * If you start your window manager using a graphical login manager like gdm
      -- or kdm, DBus should be started automatically for you.
      --
      -- * If you start xmonad with a different graphical login manager that does
      -- not start DBus for you automatically, put the line @eval \`dbus-launch
      -- --auto-syntax\`@ into your ~\/.xsession *before* xmonad and taffybar are
      -- started. This command sets some environment variables that the two must
      -- agree on.
      --
      -- * If you start xmonad via @startx@ or a similar command, add the
      -- above command to ~\/.xinitrc
      --
      -- * System tray compatability
      --
      -- | "System.Taffybar.Widget.SNITray" only supports the newer
      -- StatusNotifierItem (SNI) protocol; older xembed applets will not work.
      -- AppIndicator is also a valid implementation of SNI.
      --
      -- Additionally, this module does not handle recognising new tray applets.
      -- Instead it is necessary to run status-notifier-watcher from the
      -- [status-notifier-item](https://github.com/taffybar/status-notifier-item)
      -- package early on system startup.
      -- In case this is not possible, the alternative widget
      -- sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt is available, but
      -- this may not necessarily be able to pick up everything.

      -- * Colors
      --
      -- | While taffybar is based on GTK+, it ignores your GTK+ theme. The default
      -- theme that it uses lives at
      -- https://github.com/taffybar/taffybar/blob/master/taffybar.css You can alter
      -- this theme by editing @~\/.config\/taffybar\/taffybar.css@ to your liking.
      -- For an idea of the customizations you can make, see
      -- <https://live.gnome.org/GnomeArt/Tutorials/GtkThemes>.
        dyreTaffybar
      , dyreTaffybarMain
      , getTaffyFile
      , startTaffybar
      , taffybarDyreParams
      ) where

    import qualified Config.Dyre as Dyre
    import qualified Config.Dyre.Params as Dyre
    import           Control.Monad
    import qualified Data.GI.Gtk.Threading as GIThreading
    import qualified Data.Text as T
    import qualified GI.Gdk as Gdk
    import qualified GI.Gtk as Gtk
    import           Graphics.X11.Xlib.Misc
    import           System.Directory
    import           System.Environment.XDG.BaseDir ( getUserConfigFile )
    import           System.Exit ( exitFailure )
    import           System.FilePath ( (</>) )
    import qualified System.IO as IO
    import           System.Log.Logger
    import           System.Taffybar.Context
    import           System.Taffybar.Hooks

    import           Paths_taffybar ( getDataDir )

    -- | The parameters that are passed to Dyre when taffybar is invoked with
    -- 'dyreTaffybar'.
    taffybarDyreParams :: Params TaffybarConfig ()
    taffybarDyreParams =
      (String
    -> (TaffybarConfig -> IO ())
    -> (TaffybarConfig -> String -> TaffybarConfig)
    -> Params TaffybarConfig ()
    forall cfg a.
    String -> (cfg -> IO a) -> (cfg -> String -> cfg) -> Params cfg a
    Dyre.newParams String
    "taffybar" TaffybarConfig -> IO ()
    dyreTaffybarMain TaffybarConfig -> String -> TaffybarConfig
    showError)
      { ghcOpts :: [String]
    Dyre.ghcOpts = [String
    "-threaded", String
    "-rtsopts"]
      , rtsOptsHandling :: RTSOptionHandling
    Dyre.rtsOptsHandling = [String] -> RTSOptionHandling
    Dyre.RTSAppend [String
    "-I0", String
    "-V0"]
      }

    -- | Use Dyre to configure and start taffybar. This will automatically recompile
    -- taffybar whenever there are changes to your taffybar.hs configuration file.
    dyreTaffybar :: TaffybarConfig -> IO ()
    dyreTaffybar :: TaffybarConfig -> IO ()
    dyreTaffybar = Params TaffybarConfig () -> TaffybarConfig -> IO ()
    forall cfgType a. Params cfgType a -> cfgType -> IO a
    Dyre.wrapMain Params TaffybarConfig ()
    taffybarDyreParams

    showError :: TaffybarConfig -> String -> TaffybarConfig
    showError :: TaffybarConfig -> String -> TaffybarConfig
    showError TaffybarConfig
    cfg String
    msg = TaffybarConfig
    cfg { errorMsg :: Maybe String
    errorMsg = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    msg }

    -- | The main function that should be run by dyre given a TaffybarConfig.
    dyreTaffybarMain :: TaffybarConfig -> IO ()
    dyreTaffybarMain :: TaffybarConfig -> IO ()
    dyreTaffybarMain TaffybarConfig
    cfg =
      case TaffybarConfig -> Maybe String
    errorMsg TaffybarConfig
    cfg of
        Maybe String
    Nothing -> TaffybarConfig -> IO ()
    startTaffybar TaffybarConfig
    cfg
        Just String
    err -> do
          Handle -> String -> IO ()
    IO.hPutStrLn Handle
    IO.stderr (String
    "Error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err)
          IO ()
    forall a. IO a
    exitFailure

    getDataFile :: String -> IO FilePath
    getDataFile :: String -> IO String
    getDataFile String
    name = do
      String
    dataDir <- IO String
    getDataDir
      String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    dataDir String -> String -> String
    </> String
    name)

    startCSS :: [FilePath] -> IO Gtk.CssProvider
    startCSS :: [String] -> IO CssProvider
    startCSS [String]
    cssFilePaths = do
      -- Override the default GTK theme path settings.  This causes the
      -- bar (by design) to ignore the real GTK theme and just use the
      -- provided minimal theme to set the background and text colors.
      -- Users can override this default.
      CssProvider
    taffybarProvider <- IO CssProvider
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m CssProvider
    Gtk.cssProviderNew

      let loadIfExists :: String -> IO ()
    loadIfExists String
    filePath =
            String -> IO Bool
    doesFileExist String
    filePath IO Bool -> (Bool -> 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
    >>=
            (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CssProvider -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsCssProvider a) =>
    a -> Text -> m ()
    Gtk.cssProviderLoadFromPath CssProvider
    taffybarProvider (String -> Text
    T.pack String
    filePath))

      (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> IO ()
    loadIfExists [String]
    cssFilePaths

      Just Screen
    scr <- IO (Maybe Screen)
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m (Maybe Screen)
    Gdk.screenGetDefault
      Screen -> CssProvider -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsScreen a, IsStyleProvider b) =>
    a -> b -> Word32 -> m ()
    Gtk.styleContextAddProviderForScreen Screen
    scr CssProvider
    taffybarProvider Word32
    800
      CssProvider -> IO CssProvider
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CssProvider
    taffybarProvider

    getTaffyFile :: String -> IO FilePath
    getTaffyFile :: String -> IO String
    getTaffyFile = String -> String -> IO String
    getUserConfigFile String
    "taffybar"

    getDefaultCSSPaths :: IO [FilePath]
    getDefaultCSSPaths :: IO [String]
    getDefaultCSSPaths = do
      String
    defaultUserConfig <- String -> IO String
    getTaffyFile String
    "taffybar.css"
      [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    defaultUserConfig]

    -- | Start taffybar with the provided 'TaffybarConfig'. This function will not
    -- handle recompiling taffybar automatically when taffybar.hs is updated. If you
    -- would like this feature, use 'dyreTaffybar' instead. If automatic
    -- recompilation is handled by another mechanism such as stack or a custom user
    -- script or not desired for some reason, it is perfectly fine (and probably
    -- better) to use this function.
    startTaffybar :: TaffybarConfig -> IO ()
    startTaffybar :: TaffybarConfig -> IO ()
    startTaffybar TaffybarConfig
    config = do
      String -> (Logger -> Logger) -> IO ()
    updateGlobalLogger String
    "" Logger -> Logger
    removeHandler
      String -> IO ()
    setTaffyLogFormatter String
    "System.Taffybar"
      String -> IO ()
    setTaffyLogFormatter String
    "StatusNotifier"
      Status
    _ <- IO Status
    initThreads
      Maybe [Text]
    _ <- Maybe [Text] -> IO (Maybe [Text])
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe [Text] -> m (Maybe [Text])
    Gtk.init Maybe [Text]
    forall a. Maybe a
    Nothing
      IO ()
    GIThreading.setCurrentThreadAsGUIThread
      String
    defaultCSS <- String -> IO String
    getDataFile String
    "taffybar.css"
      [String]
    cssPathsToLoad <-
        if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([String] -> Bool) -> [String] -> Bool
    forall a b. (a -> b) -> a -> b
    $ TaffybarConfig -> [String]
    cssPaths TaffybarConfig
    config
        then IO [String]
    getDefaultCSSPaths
        else [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ TaffybarConfig -> [String]
    cssPaths TaffybarConfig
    config
      CssProvider
    _ <- [String] -> IO CssProvider
    startCSS ([String] -> IO CssProvider) -> [String] -> IO CssProvider
    forall a b. (a -> b) -> a -> b
    $ String
    defaultCSSString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    cssPathsToLoad
      Context
    _ <- TaffybarConfig -> IO Context
    buildContext TaffybarConfig
    config

      IO ()
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
    Gtk.main
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()