Utilities for dealing with config and data directories

5 files changed, 110 insertions, 72 deletions

diff --git a/app/Configuration.hs b/app/Configuration.hs
deleted file mode 100644
index 3e30730..0000000
--- a/app/Configuration.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-{-# LANGUAGE FlexibleContexts, CPP #-}
-
-------------------------------------------------------------------------------
--- |
--- Module: Configuration
--- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
--- License: BSD3-style (see LICENSE)
---
--- Maintainer: jao@gnu.org
--- Stability: unstable
--- Portability: portable
--- Created: Wed Nov 21, 2018 23:13
---
---
--- Parsing configuration files
---
-------------------------------------------------------------------------------
-
-
-module Configuration (readConfig, readDefaultConfig) where
-
-import Control.Monad.IO.Class (liftIO)
-
-import System.Environment
-import System.Posix.Files (fileExist)
-
-import qualified Xmobar as X
-
--- | Reads the configuration files or quits with an error
-readConfig :: FilePath -> String -> IO (X.Config,[String])
-readConfig f usage = do
-  let err m = error $ f ++ ": " ++ m
-  file <- liftIO $ fileExist f
-  r <- if file
-       then X.readConfig X.defaultConfig f
-       else err $ "file not found" ++ "\n" ++ usage
-  case r of
-    Left e -> err (show e)
-    Right res -> return res
-
--- | Read default configuration file or load the default config
-readDefaultConfig :: String -> IO (X.Config,[String])
-readDefaultConfig usage = do
-  xdgConfigFile <- X.getXdgConfigFile
-  xdgConfigFileExists <- liftIO $ fileExist xdgConfigFile
-  home <- liftIO $ getEnv "HOME"
-  let defaultConfigFile = home ++ "/.xmobarrc"
-  defaultConfigFileExists <- liftIO $ fileExist defaultConfigFile
-  if xdgConfigFileExists
-    then readConfig xdgConfigFile usage
-    else if defaultConfigFileExists
-         then readConfig defaultConfigFile usage
-         else return (X.defaultConfig,[])
diff --git a/app/Main.hs b/app/Main.hs
index b5d3993..51bfe8b 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -23,11 +23,10 @@ import System.Exit
 import System.Environment (getArgs)
 import Control.Monad (unless)
 import Text.Read (readMaybe)
+import System.Posix.Files (fileExist)
 
 import Xmobar
-
 import Paths_xmobar (version)
-import Configuration as C (readConfig, readDefaultConfig)
 
 -- $main
 
@@ -36,12 +35,32 @@ main :: IO ()
 main = do
   (o,file) <- getArgs >>= getOpts
   (c,defaultings) <- case file of
-                       [cfgfile] -> C.readConfig cfgfile usage
-                       _ -> C.readDefaultConfig usage
+                       [cfgfile] -> config cfgfile usage
+                       _ -> defConfig usage
   unless (null defaultings || (not $ any (== Debug) o)) $ putStrLn $
     "Fields missing from config defaulted: " ++ intercalate "," defaultings
   doOpts c o >>= xmobar
 
+config :: FilePath -> String -> IO (Config,[String])
+config f msg = do
+  let err m = error $ f ++ ": " ++ m
+  file <- fileExist f
+  r <- if file
+       then readConfig defaultConfig f
+       else err $ "file not found" ++ "\n" ++ msg
+  case r of
+    Left e -> err (show e)
+    Right res -> return res
+
+-- | Read default configuration file or load the default config
+defConfig :: String -> IO (Config,[String])
+defConfig msg = do
+  xdgConfigFile <- xmobarConfigFile
+  xdgConfigFileExists <- fileExist xdgConfigFile
+  if xdgConfigFileExists
+    then config xdgConfigFile msg
+    else return (defaultConfig,[])
+
 data Opts = Help
           | Debug
           | Version
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index df31abd..f6a8463 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -17,7 +17,7 @@
 
 module Xmobar (xmobar
               , defaultConfig
-              , getXdgConfigFile
+              , xmobarConfigFile
               , Runnable (..)
               , Exec (..)
               , module Xmobar.Config.Types
@@ -64,4 +64,4 @@ import Xmobar.Plugins.StdinReader
 import Xmobar.Plugins.XMonadLog
 
 import Xmobar.App.Main(xmobar)
-import Xmobar.App.Config(defaultConfig, getXdgConfigFile)
+import Xmobar.App.Config(defaultConfig, xmobarConfigFile)
diff --git a/src/Xmobar/App/Config.hs b/src/Xmobar/App/Config.hs
index 86bc9cb..7b1171f 100644
--- a/src/Xmobar/App/Config.hs
+++ b/src/Xmobar/App/Config.hs
@@ -10,16 +10,21 @@
 -- Created: Sun Nov 25, 2018 22:26
 --
 --
--- Default values for Xmobar configurations
+-- Default values for Xmobar configurations and functions to access
+-- configuration files and directories.
 --
 ------------------------------------------------------------------------------
 
 
-module Xmobar.App.Config (defaultConfig, getXdgConfigFile) where
+module Xmobar.App.Config (defaultConfig,
+                          xmobarConfigDir,
+                          xmobarDataDir,
+                          xmobarConfigFile) where
 
 import System.Environment
-import System.Directory (getHomeDirectory)
+import System.Directory
 import System.FilePath ((</>))
+import System.Posix.Files (fileExist)
 
 import Xmobar.Plugins.Date
 import Xmobar.Plugins.StdinReader
@@ -58,14 +63,81 @@ defaultConfig =
                         "<fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>"
            }
 
-xdgConfigDir :: IO String
-xdgConfigDir = do env <- getEnvironment
-                  case lookup "XDG_CONFIG_HOME" env of
-                       Just val -> return val
-                       Nothing  -> fmap (</> ".config") getHomeDirectory
+-- | Return the path to the xmobar configuration directory.  This
+-- directory is where user configuration files are stored (e.g, the
+-- xmobar.hs file).  You may also create a @lib@ subdirectory in the
+-- configuration directory and the default recompile command will add
+-- it to the GHC include path.
+--
+-- Several directories are considered.  In order of
+-- preference:
+--
+--   1. The directory specified in the @XMOBAR_CONFIG_DIR@ environment variable.
+--   2. The @~\/.xmobar@ directory.
+--   3. The @XDG_CONFIG_HOME/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.
+xmobarConfigDir :: IO String
+xmobarConfigDir =
+    findFirstDirWithEnv "XMOBAR_CONFIG_DIR"
+      [ getAppUserDataDirectory "xmobar"
+      , getXdgDirectory XdgConfig "xmobar"
+      ]
+
+-- | 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 @~\/.xmobar@ directory.
+--   3. The @XDG_DATA_HOME/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 =
+    findFirstDirWithEnv "XMOBAR_DATA_DIR"
+      [ getAppUserDataDirectory "xmobar"
+      , getXdgDirectory XdgData "xmobar"
+      ]
+
+-- | Helper function that will find the first existing directory and
+-- return its path.  If none of the directories can be found, create
+-- and return the first from the list.  If the list is empty this
+-- function returns the historical @~\/.xmobar@ directory.
+findFirstDirOf :: [IO FilePath] -> IO FilePath
+findFirstDirOf [] = findFirstDirOf [getAppUserDataDirectory "xmobar"]
+findFirstDirOf possibles = do
+    found <- go possibles
+    case found of
+      Just path -> return path
+      Nothing ->  do
+        primary <- head possibles
+        createDirectoryIfMissing True primary
+        return primary
+  where
+    go [] = return Nothing
+    go (x:xs) = do
+      exists <- x >>= doesDirectoryExist
+      if exists then x >>= return . Just else go xs
 
-xmobarConfigDir :: IO FilePath
-xmobarConfigDir = fmap (</> "xmobar") xdgConfigDir
+-- | Simple wrapper around @findFirstDirOf@ that allows the primary
+-- path to be specified by an environment variable.
+findFirstDirWithEnv :: String -> [IO FilePath] -> IO FilePath
+findFirstDirWithEnv envName paths = do
+    envPath' <- lookupEnv envName
+    case envPath' of
+      Nothing -> findFirstDirOf paths
+      Just envPath -> findFirstDirOf (return envPath:paths)
 
-getXdgConfigFile :: IO FilePath
-getXdgConfigFile = fmap (</> "xmobarrc") xmobarConfigDir
+xmobarConfigFile :: IO FilePath
+xmobarConfigFile = do
+  f <- fmap (</> "xmobarrc") xmobarConfigDir
+  fe <- fileExist f
+  if fe then return f else fmap (</> ".xmobarrc") getHomeDirectory
diff --git a/xmobar.cabal b/xmobar.cabal
index 2430f5f..8a67b1f 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -256,7 +256,7 @@ library
 executable xmobar
     hs-source-dirs:     app
     main-is:            Main.hs
-    other-modules:      Paths_xmobar, Configuration
+    other-modules:      Paths_xmobar
     build-depends:      base,
                         containers,
                         async,