    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.SimpleConfig
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    -----------------------------------------------------------------------------
    module System.Taffybar.SimpleConfig
      ( SimpleTaffyConfig(..)
      , Position(..)
      , defaultSimpleTaffyConfig
      , simpleTaffybar
      , toTaffyConfig
      , useAllMonitors
      , usePrimaryMonitor
      ) where

    import qualified Control.Concurrent.MVar as MV
    import           Control.Monad
    import           Control.Monad.Trans.Class
    import           Data.List
    import           Data.Maybe
    import           Data.Unique
    import qualified GI.Gtk as Gtk
    import           GI.Gdk
    import           Graphics.UI.GIGtkStrut
    import           System.Taffybar.Information.X11DesktopInfo
    import           System.Taffybar
    import qualified System.Taffybar.Context as BC (BarConfig(..), TaffybarConfig(..))
    import           System.Taffybar.Context hiding (TaffybarConfig(..), BarConfig(..))
    import           System.Taffybar.Util

    -- | The side of the monitor at which taffybar should be displayed.
    data Position = Top | Bottom deriving (Int -> Position -> ShowS
    [Position] -> ShowS
    Position -> String
    (Int -> Position -> ShowS)
    -> (Position -> String) -> ([Position] -> ShowS) -> Show Position
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Position] -> ShowS
    $cshowList :: [Position] -> ShowS
    show :: Position -> String
    $cshow :: Position -> String
    showsPrec :: Int -> Position -> ShowS
    $cshowsPrec :: Int -> Position -> ShowS
    Show, Position -> Position -> Bool
    (Position -> Position -> Bool)
    -> (Position -> Position -> Bool) -> Eq Position
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Position -> Position -> Bool
    $c/= :: Position -> Position -> Bool
    == :: Position -> Position -> Bool
    $c== :: Position -> Position -> Bool
    Eq)

    -- | A configuration object whose interface is simpler than that of
    -- 'TaffybarConfig'. Unless you have a good reason to use taffybar's more
    -- advanced interface, you should stick to this one.
    data SimpleTaffyConfig = SimpleTaffyConfig
      {
      -- | The xinerama/xrandr monitor number to put the bar on (default: PrimaryMonitor)
        SimpleTaffyConfig -> TaffyIO [Int]
    monitorsAction :: TaffyIO [Int]
      -- | Number of pixels to reserve for the bar
      , SimpleTaffyConfig -> Int
    barHeight :: Int
      -- | Number of additional pixels to reserve for the bar strut (default: 0)
      , SimpleTaffyConfig -> Int
    barPadding :: Int
      -- | The position of the bar on the screen (default: Top)
      , SimpleTaffyConfig -> Position
    barPosition :: Position
      -- | The number of pixels between widgets
      , SimpleTaffyConfig -> Int
    widgetSpacing :: Int
      -- | Widget constructors whose output are placed at the beginning of the bar
      , SimpleTaffyConfig -> [TaffyIO Widget]
    startWidgets :: [TaffyIO Gtk.Widget]
      -- | Widget constructors whose output are placed in the center of the bar
      , SimpleTaffyConfig -> [TaffyIO Widget]
    centerWidgets :: [TaffyIO Gtk.Widget]
      -- | Widget constructors whose output are placed at the end of the bar
      , SimpleTaffyConfig -> [TaffyIO Widget]
    endWidgets :: [TaffyIO Gtk.Widget]
      -- | Optional path to CSS stylesheet (loaded in addition to stylesheet found
      -- in XDG data directory).
      , SimpleTaffyConfig -> Maybe String
    cssPath :: Maybe FilePath
      -- | Hook to run at taffybar startup.
      , SimpleTaffyConfig -> TaffyIO ()
    startupHook :: TaffyIO ()
      }

    -- | Sensible defaults for most of the fields of 'SimpleTaffyConfig'. You'll
    -- need to specify the widgets you want in the bar with 'startWidgets',
    -- 'centerWidgets' and 'endWidgets'.
    defaultSimpleTaffyConfig :: SimpleTaffyConfig
    defaultSimpleTaffyConfig :: SimpleTaffyConfig
    defaultSimpleTaffyConfig = SimpleTaffyConfig :: TaffyIO [Int]
    -> Int
    -> Int
    -> Position
    -> Int
    -> [TaffyIO Widget]
    -> [TaffyIO Widget]
    -> [TaffyIO Widget]
    -> Maybe String
    -> TaffyIO ()
    -> SimpleTaffyConfig
    SimpleTaffyConfig
      { monitorsAction :: TaffyIO [Int]
    monitorsAction = TaffyIO [Int]
    useAllMonitors
      , barHeight :: Int
    barHeight = 30
      , barPadding :: Int
    barPadding = 0
      , barPosition :: Position
    barPosition = Position
    Top
      , widgetSpacing :: Int
    widgetSpacing = 5
      , startWidgets :: [TaffyIO Widget]
    startWidgets = []
      , centerWidgets :: [TaffyIO Widget]
    centerWidgets = []
      , endWidgets :: [TaffyIO Widget]
    endWidgets = []
      , cssPath :: Maybe String
    cssPath = Maybe String
    forall a. Maybe a
    Nothing
      , startupHook :: TaffyIO ()
    startupHook = () -> TaffyIO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      }

    toStrutConfig :: SimpleTaffyConfig -> Int -> StrutConfig
    toStrutConfig :: SimpleTaffyConfig -> Int -> StrutConfig
    toStrutConfig SimpleTaffyConfig { barHeight :: SimpleTaffyConfig -> Int
    barHeight = Int
    size
                                    , barPadding :: SimpleTaffyConfig -> Int
    barPadding = Int
    padding
                                    , barPosition :: SimpleTaffyConfig -> Position
    barPosition = Position
    pos
                                    } monitor :: Int
    monitor =
      StrutConfig
    defaultStrutConfig
      { strutHeight :: StrutSize
    strutHeight = Int32 -> StrutSize
    ExactSize (Int32 -> StrutSize) -> Int32 -> StrutSize
    forall a b. (a -> b) -> a -> b
    $ Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size
      , strutYPadding :: Int32
    strutYPadding = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    padding
      , strutXPadding :: Int32
    strutXPadding = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    padding
      , strutAlignment :: StrutAlignment
    strutAlignment = StrutAlignment
    Center
      , strutMonitor :: Maybe Int32
    strutMonitor = Int32 -> Maybe Int32
    forall a. a -> Maybe a
    Just (Int32 -> Maybe Int32) -> Int32 -> Maybe Int32
    forall a b. (a -> b) -> a -> b
    $ Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    monitor
      , strutPosition :: StrutPosition
    strutPosition =
          case Position
    pos of
            Top -> StrutPosition
    TopPos
            Bottom -> StrutPosition
    BottomPos
      }

    toBarConfig :: SimpleTaffyConfig -> Int -> IO BC.BarConfig
    toBarConfig :: SimpleTaffyConfig -> Int -> IO BarConfig
    toBarConfig config :: SimpleTaffyConfig
    config monitor :: Int
    monitor = do
      let strutConfig :: StrutConfig
    strutConfig = SimpleTaffyConfig -> Int -> StrutConfig
    toStrutConfig SimpleTaffyConfig
    config Int
    monitor
      Unique
    barId <- IO Unique
    newUnique
      BarConfig -> IO BarConfig
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        BarConfig :: StrutConfig
    -> Int32
    -> [TaffyIO Widget]
    -> [TaffyIO Widget]
    -> [TaffyIO Widget]
    -> Unique
    -> BarConfig
    BC.BarConfig
        { strutConfig :: StrutConfig
    BC.strutConfig = StrutConfig
    strutConfig
        , widgetSpacing :: Int32
    BC.widgetSpacing = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int32) -> Int -> Int32
    forall a b. (a -> b) -> a -> b
    $ SimpleTaffyConfig -> Int
    widgetSpacing SimpleTaffyConfig
    config
        , startWidgets :: [TaffyIO Widget]
    BC.startWidgets = SimpleTaffyConfig -> [TaffyIO Widget]
    startWidgets SimpleTaffyConfig
    config
        , centerWidgets :: [TaffyIO Widget]
    BC.centerWidgets = SimpleTaffyConfig -> [TaffyIO Widget]
    centerWidgets SimpleTaffyConfig
    config
        , endWidgets :: [TaffyIO Widget]
    BC.endWidgets = SimpleTaffyConfig -> [TaffyIO Widget]
    endWidgets SimpleTaffyConfig
    config
        , barId :: Unique
    BC.barId = Unique
    barId
        }

    newtype SimpleBarConfigs = SimpleBarConfigs (MV.MVar [(Int, BC.BarConfig)])

    toTaffyConfig :: SimpleTaffyConfig -> BC.TaffybarConfig
    toTaffyConfig :: SimpleTaffyConfig -> TaffybarConfig
    toTaffyConfig conf :: SimpleTaffyConfig
    conf =
        TaffybarConfig
    defaultTaffybarConfig
        { getBarConfigsParam :: BarConfigGetter
    BC.getBarConfigsParam = BarConfigGetter
    configGetter
        , cssPath :: Maybe String
    BC.cssPath = SimpleTaffyConfig -> Maybe String
    cssPath SimpleTaffyConfig
    conf
        , startupHook :: TaffyIO ()
    BC.startupHook = SimpleTaffyConfig -> TaffyIO ()
    startupHook SimpleTaffyConfig
    conf
        }
      where
        configGetter :: BarConfigGetter
    configGetter = do
          SimpleBarConfigs configsVar :: MVar [(Int, BarConfig)]
    configsVar <-
            Taffy IO SimpleBarConfigs -> ReaderT Context IO SimpleBarConfigs
    forall t. Typeable t => Taffy IO t -> Taffy IO t
    getStateDefault (Taffy IO SimpleBarConfigs -> ReaderT Context IO SimpleBarConfigs)
    -> Taffy IO SimpleBarConfigs -> ReaderT Context IO SimpleBarConfigs
    forall a b. (a -> b) -> a -> b
    $ IO SimpleBarConfigs -> ReaderT Context IO SimpleBarConfigs
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MVar [(Int, BarConfig)] -> SimpleBarConfigs
    SimpleBarConfigs (MVar [(Int, BarConfig)] -> SimpleBarConfigs)
    -> IO (MVar [(Int, BarConfig)]) -> IO SimpleBarConfigs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Int, BarConfig)] -> IO (MVar [(Int, BarConfig)])
    forall a. a -> IO (MVar a)
    MV.newMVar [])
          [Int]
    monitorNumbers <- SimpleTaffyConfig -> TaffyIO [Int]
    monitorsAction SimpleTaffyConfig
    conf

          let lookupWithIndex :: [(a, b)] -> a -> (a, Maybe b)
    lookupWithIndex barConfigs :: [(a, b)]
    barConfigs monitorNumber :: a
    monitorNumber =
                (a
    monitorNumber, a -> [(a, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup a
    monitorNumber [(a, b)]
    barConfigs)

              lookupAndUpdate :: [(Int, BarConfig)] -> IO ([(Int, BarConfig)], [BarConfig])
    lookupAndUpdate barConfigs :: [(Int, BarConfig)]
    barConfigs = do

                let (alreadyPresent :: [(Int, Maybe BarConfig)]
    alreadyPresent, toCreate :: [(Int, Maybe BarConfig)]
    toCreate) =
                      ((Int, Maybe BarConfig) -> Bool)
    -> [(Int, Maybe BarConfig)]
    -> ([(Int, Maybe BarConfig)], [(Int, Maybe BarConfig)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Maybe BarConfig -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe BarConfig -> Bool)
    -> ((Int, Maybe BarConfig) -> Maybe BarConfig)
    -> (Int, Maybe BarConfig)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Maybe BarConfig) -> Maybe BarConfig
    forall a b. (a, b) -> b
    snd) ([(Int, Maybe BarConfig)]
     -> ([(Int, Maybe BarConfig)], [(Int, Maybe BarConfig)]))
    -> [(Int, Maybe BarConfig)]
    -> ([(Int, Maybe BarConfig)], [(Int, Maybe BarConfig)])
    forall a b. (a -> b) -> a -> b
    $
                      (Int -> (Int, Maybe BarConfig))
    -> [Int] -> [(Int, Maybe BarConfig)]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(Int, BarConfig)] -> Int -> (Int, Maybe BarConfig)
    forall a b. Eq a => [(a, b)] -> a -> (a, Maybe b)
    lookupWithIndex [(Int, BarConfig)]
    barConfigs) [Int]
    monitorNumbers
                    alreadyPresentConfigs :: [BarConfig]
    alreadyPresentConfigs = ((Int, Maybe BarConfig) -> Maybe BarConfig)
    -> [(Int, Maybe BarConfig)] -> [BarConfig]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Int, Maybe BarConfig) -> Maybe BarConfig
    forall a b. (a, b) -> b
    snd [(Int, Maybe BarConfig)]
    alreadyPresent

                [(Int, BarConfig)]
    newlyCreated <-
                  ((Int, Maybe BarConfig) -> IO (Int, BarConfig))
    -> [(Int, Maybe BarConfig)] -> IO [(Int, BarConfig)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Int -> IO Int)
    -> (Int -> IO BarConfig) -> Int -> IO (Int, BarConfig)
    forall (m :: * -> *) c a b.
    Monad m =>
    (c -> m a) -> (c -> m b) -> c -> m (a, b)
    forkM Int -> IO Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimpleTaffyConfig -> Int -> IO BarConfig
    toBarConfig SimpleTaffyConfig
    conf) (Int -> IO (Int, BarConfig))
    -> ((Int, Maybe BarConfig) -> Int)
    -> (Int, Maybe BarConfig)
    -> IO (Int, BarConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Maybe BarConfig) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, Maybe BarConfig)]
    toCreate
                let result :: [BarConfig]
    result = ((Int, BarConfig) -> BarConfig)
    -> [(Int, BarConfig)] -> [BarConfig]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, BarConfig) -> BarConfig
    forall a b. (a, b) -> b
    snd [(Int, BarConfig)]
    newlyCreated [BarConfig] -> [BarConfig] -> [BarConfig]
    forall a. [a] -> [a] -> [a]
    ++ [BarConfig]
    alreadyPresentConfigs
                ([(Int, BarConfig)], [BarConfig])
    -> IO ([(Int, BarConfig)], [BarConfig])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Int, BarConfig)]
    barConfigs [(Int, BarConfig)] -> [(Int, BarConfig)] -> [(Int, BarConfig)]
    forall a. [a] -> [a] -> [a]
    ++ [(Int, BarConfig)]
    newlyCreated, [BarConfig]
    result)

          IO [BarConfig] -> BarConfigGetter
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO [BarConfig] -> BarConfigGetter)
    -> IO [BarConfig] -> BarConfigGetter
    forall a b. (a -> b) -> a -> b
    $ MVar [(Int, BarConfig)]
    -> ([(Int, BarConfig)] -> IO ([(Int, BarConfig)], [BarConfig]))
    -> IO [BarConfig]
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MV.modifyMVar MVar [(Int, BarConfig)]
    configsVar [(Int, BarConfig)] -> IO ([(Int, BarConfig)], [BarConfig])
    lookupAndUpdate

    -- | Start taffybar using 'SimpleTaffybarConfig'.
    simpleTaffybar :: SimpleTaffyConfig -> IO ()
    simpleTaffybar :: SimpleTaffyConfig -> IO ()
    simpleTaffybar conf :: SimpleTaffyConfig
    conf = TaffybarConfig -> IO ()
    dyreTaffybar (TaffybarConfig -> IO ()) -> TaffybarConfig -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SimpleTaffyConfig -> TaffybarConfig
    toTaffyConfig SimpleTaffyConfig
    conf

    getMonitorCount :: IO Int
    getMonitorCount :: IO Int
    getMonitorCount =
      Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int) -> IO Int32 -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO (Maybe Screen)
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m (Maybe Screen)
    screenGetDefault IO (Maybe Screen) -> (Maybe Screen -> IO Int32) -> IO Int32
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO Int32 -> (Screen -> IO Int32) -> Maybe Screen -> IO Int32
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Int32 -> IO Int32
    forall (m :: * -> *) a. Monad m => a -> m a
    return 0) (Screen -> IO Display
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsScreen a) =>
    a -> m Display
    screenGetDisplay (Screen -> IO Display)
    -> (Display -> IO Int32) -> Screen -> IO Int32
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Display -> IO Int32
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsDisplay a) =>
    a -> m Int32
    displayGetNMonitors))

    -- | Display a taffybar window on all monitors.
    useAllMonitors :: TaffyIO [Int]
    useAllMonitors :: TaffyIO [Int]
    useAllMonitors = IO [Int] -> TaffyIO [Int]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO [Int] -> TaffyIO [Int]) -> IO [Int] -> TaffyIO [Int]
    forall a b. (a -> b) -> a -> b
    $ do
      Int
    count <- IO Int
    getMonitorCount
      [Int] -> IO [Int]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [0..Int
    countInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1]

    -- | Display the taffybar window on the primary monitor.
    usePrimaryMonitor :: TaffyIO [Int]
    usePrimaryMonitor :: TaffyIO [Int]
    usePrimaryMonitor =
      Int -> [Int]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> [Int]) -> (Maybe Int -> Int) -> Maybe Int -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 0 (Maybe Int -> [Int])
    -> ReaderT Context IO (Maybe Int) -> TaffyIO [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe Int) -> ReaderT Context IO (Maybe Int)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (X11Property (Maybe Int) -> IO (Maybe Int)
    forall a. X11Property a -> IO a
    withDefaultCtx X11Property (Maybe Int)
    getPrimaryOutputNumber)