------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Config.Defaults
-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Nov 25, 2018 22:26
--
--
-- Default values for Xmobar configurations and functions to access
-- configuration files and directories.
--
------------------------------------------------------------------------------


module Xmobar.App.Config (defaultConfig,
                          xmobarDataDir,
                          xmobarConfigFile) where

import Control.Monad (when, filterM)
import Data.Functor ((<&>))

import System.Environment
import System.Directory
import System.FilePath ((</>))
import System.Posix.Files (fileExist)

import Xmobar.Plugins.Date
import Xmobar.Plugins.StdinReader
import Xmobar.Config.Types
import Xmobar.Run.Runnable

-- | The default configuration values
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
    Config :: String
-> [String]
-> String
-> String
-> String
-> String
-> XPosition
-> Bool
-> TextOutputFormat
-> Int
-> [Int]
-> Int
-> Border
-> String
-> Int
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> String
-> [Runnable]
-> String
-> String
-> String
-> Bool
-> SignalChan
-> Config
Config { font :: String
font = String
"-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
           , additionalFonts :: [String]
additionalFonts = []
           , wmClass :: String
wmClass = String
"xmobar"
           , wmName :: String
wmName = String
"xmobar"
           , bgColor :: String
bgColor = String
"#000000"
           , fgColor :: String
fgColor = String
"#BFBFBF"
           , alpha :: Int
alpha   = Int
255
           , position :: XPosition
position = XPosition
Top
           , border :: Border
border = Border
NoBorder
           , borderColor :: String
borderColor = String
"#BFBFBF"
           , borderWidth :: Int
borderWidth = Int
1
           , textOffset :: Int
textOffset = -Int
1
           , iconOffset :: Int
iconOffset = -Int
1
           , textOffsets :: [Int]
textOffsets = []
           , hideOnStart :: Bool
hideOnStart = Bool
False
           , lowerOnStart :: Bool
lowerOnStart = Bool
True
           , persistent :: Bool
persistent = Bool
False
           , allDesktops :: Bool
allDesktops = Bool
True
           , overrideRedirect :: Bool
overrideRedirect = Bool
True
           , pickBroadest :: Bool
pickBroadest = Bool
False
           , iconRoot :: String
iconRoot = String
"."
           , commands :: [Runnable]
commands = [ Date -> Runnable
forall r. (Exec r, Read r, Show r) => r -> Runnable
Run (Date -> Runnable) -> Date -> Runnable
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> Date
Date String
"%a %b %_d %Y * %H:%M:%S" String
"theDate" Int
10
                        , StdinReader -> Runnable
forall r. (Exec r, Read r, Show r) => r -> Runnable
Run StdinReader
StdinReader]
           , sepChar :: String
sepChar = String
"%"
           , alignSep :: String
alignSep = String
"}{"
           , template :: String
template = String
"%StdinReader% }{ " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                        String
"<fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>"
           , verbose :: Bool
verbose = Bool
False
           , signal :: SignalChan
signal = Maybe (TMVar SignalType) -> SignalChan
SignalChan Maybe (TMVar SignalType)
forall a. Maybe a
Nothing
           , textOutput :: Bool
textOutput = Bool
False
           , textOutputFormat :: TextOutputFormat
textOutputFormat = TextOutputFormat
Plain
           }

-- | Return the path to the xmobar data directory.  This directory is
-- used by Xmobar to store data files such as the run-time state file
-- and the configuration binary generated by GHC.
--
-- Several directories are considered.  In order of preference:
--
--   1. The directory specified in the @XMOBAR_DATA_DIR@ environment variable.
--   2. The @XDG_DATA_HOME/xmobar@ directory.
--   3. The @~\/.xmobar@ directory.
--
-- The first directory that exists will be used.  If none of the
-- directories exist then (1) will be used if it is set, otherwise (2)
-- will be used.  Either way, a directory will be created if
-- necessary.
xmobarDataDir :: IO String
xmobarDataDir :: IO String
xmobarDataDir =
    Bool -> String -> [IO String] -> IO String
findFirstDirWithEnv Bool
True String
"XMOBAR_DATA_DIR"
      [ XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
"xmobar"
      , String -> IO String
getAppUserDataDirectory String
"xmobar"
      ]

-- | Helper function that will find the first existing directory and
-- return its path.  If none of the directories can be found,
-- optionally create and return the first from the list.  If the list
-- is empty this function returns the historical @~\/.xmobar@
-- directory.
findFirstDirOf :: Bool -> [IO FilePath] -> IO FilePath
findFirstDirOf :: Bool -> [IO String] -> IO String
findFirstDirOf Bool
create [] = Bool -> [IO String] -> IO String
findFirstDirOf Bool
create [String -> IO String
getAppUserDataDirectory String
"xmobar"]
findFirstDirOf Bool
create [IO String]
possibles = do
    Maybe String
found <- [IO String] -> IO (Maybe String)
go [IO String]
possibles
    case Maybe String
found of
      Just String
path -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
      Maybe String
Nothing ->  do
        String
primary <- [IO String] -> IO String
forall a. [a] -> a
head [IO String]
possibles
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
create (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
primary)
        String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
primary
  where
    go :: [IO String] -> IO (Maybe String)
go [] = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    go (IO String
x:[IO String]
xs) = do
      Bool
exists <- IO String
x IO String -> (String -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO Bool
doesDirectoryExist
      if Bool
exists then IO String
x IO String -> (String -> Maybe String) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Maybe String
forall a. a -> Maybe a
Just else [IO String] -> IO (Maybe String)
go [IO String]
xs

-- | Simple wrapper around @findFirstDirOf@ that allows the primary
-- path to be specified by an environment variable.
findFirstDirWithEnv :: Bool -> String -> [IO FilePath] -> IO FilePath
findFirstDirWithEnv :: Bool -> String -> [IO String] -> IO String
findFirstDirWithEnv Bool
create String
envName [IO String]
paths = do
    Maybe String
envPath' <- String -> IO (Maybe String)
lookupEnv String
envName
    case Maybe String
envPath' of
      Maybe String
Nothing -> Bool -> [IO String] -> IO String
findFirstDirOf Bool
create [IO String]
paths
      Just String
envPath -> Bool -> [IO String] -> IO String
findFirstDirOf Bool
create (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
envPathIO String -> [IO String] -> [IO String]
forall a. a -> [a] -> [a]
:[IO String]
paths)

xmobarInConfigDirs :: FilePath -> IO (Maybe FilePath)
xmobarInConfigDirs :: String -> IO (Maybe String)
xmobarInConfigDirs String
fn  = do
    Maybe String
env <- String -> IO (Maybe String)
lookupEnv String
"XMOBAR_CONFIG_DIR"
    String
xdg <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"xmobar"
    String
app <- String -> IO String
getAppUserDataDirectory String
"xmobar"
    String
hom <- IO String
getHomeDirectory
    let candidates :: [String]
candidates = case Maybe String
env of
                       Maybe String
Nothing -> [String
app, String
xdg, String
hom]
                       Just String
p -> [String
p, String
app, String
xdg, String
hom]
    [String]
fs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\String
d -> String -> IO Bool
fileExist (String
d String -> String -> String
</> String
fn)) [String]
candidates
    Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fs then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
forall a. [a] -> a
head [String]
fs String -> String -> String
</> String
fn)

xmobarConfigFile :: IO (Maybe FilePath)
xmobarConfigFile :: IO (Maybe String)
xmobarConfigFile =
  ([Maybe String] -> Maybe String)
-> IO [Maybe String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
ffirst (IO [Maybe String] -> IO (Maybe String))
-> IO [Maybe String] -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe String)
xmobarInConfigDirs [String
"xmobar.hs", String
".xmobarrc", String
"xmobarrc"]
  where ffirst :: [Maybe a] -> Maybe a
ffirst [] = Maybe a
forall a. Maybe a
Nothing
        ffirst (Maybe a
Nothing:[Maybe a]
fs) = [Maybe a] -> Maybe a
ffirst [Maybe a]
fs
        ffirst (Maybe a
p:[Maybe a]
_) = Maybe a
p