Revise XDG handling

Improve handling of the whole XDG situation.  This now looks as follows

  1. If all three of xmonad's environment variables (XMONAD_DATA_DIR,
     XMONAD_CONFIG_DIR, and XMONAD_CACHE_DIR) are set, use them.
  2. If there is a build script `build' or configuration `xmonad.hs' in
     `~/.xmonad', set all three directories to `~/.xmonad'.
  3. Otherwise, use XDG_DATA_HOME, XDG_CONFIG_HOME, and
     XDG_CACHE_HOME (or their respective fallbacks).

If none of the above exist, we default to using the XDG_* variables,
creating the necessary directories if needed.

src/XMonad/Core.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
-             MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable #-}
+             MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable,
+             LambdaCase, NamedFieldPuns, DeriveTraversable #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -28,7 +29,7 @@ module XMonad.Core (
     getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX,
     getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
-    ManageHook, Query(..), runQuery
+    ManageHook, Query(..), runQuery, Directories(..), Dirs, getDirs
   ) where
 
 import XMonad.StackSet hiding (modify)
@@ -36,10 +37,12 @@ import XMonad.StackSet hiding (modify)
 import Prelude
 import Control.Exception.Extensible (fromException, try, bracket, throw, finally, SomeException(..))
 import qualified Control.Exception.Extensible as E
+import Control.Applicative ((<|>), empty)
 import Control.Monad.Fail
 import Control.Monad.State
 import Control.Monad.Reader
 import Data.Semigroup
+import Data.Traversable (for)
 import Data.Default
 import System.FilePath
 import System.IO
@@ -57,7 +60,6 @@ import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
 import Data.Typeable
 import Data.List ((\\))
 import Data.Maybe (isJust,fromMaybe)
-import System.Environment (lookupEnv)
 
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -91,8 +93,8 @@ data XConf = XConf
     , mousePosition :: !(Maybe (Position, Position))
                                       -- ^ position of the mouse according to
                                       -- the event currently being processed
-    , currentEvent :: !(Maybe Event)
+    , currentEvent :: !(Maybe Event)  -- ^ event currently being processed
-                                      -- ^ event currently being processed
+    , dirs         :: !Dirs           -- ^ directories to use
     }
 
 -- todo, better name
@@ -447,126 +449,97 @@ runOnWorkspaces job = do
              $ current ws : visible ws
     modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } }
 
--- | Return the path to the xmonad configuration directory.  This
+-- | All the directories that xmonad will use.  They will be used for
--- directory is where user configuration files are stored (e.g, the
+-- the following purposes:
--- xmonad.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
+-- * @dataDir@: This directory is used by XMonad to store data files
--- preference:
+-- such as the run-time state file and the configuration binary
+-- generated by GHC.
 --
---   1. The directory specified in the @XMONAD_CONFIG_DIR@ environment variable.
+-- * @cfgDir@: This directory is where user configuration files are
---   2. The @~\/.xmonad@ directory.
+-- stored (e.g, the xmonad.hs file).  You may also create a @lib@
---   3. The @XDG_CONFIG_HOME/xmonad@ directory.
+-- subdirectory in the configuration directory and the default recompile
+-- command will add it to the GHC include path.
 --
--- The first directory that exists will be used.  If none of the
+-- * @cacheDir@: This directory is used to store temporary files that
--- directories exist then (1) will be used if it is set, otherwise (2)
+-- can easily be recreated.  For example, the XPrompt history file.
--- will be used.  Either way, a directory will be created if necessary.
+--
-getXMonadDir :: MonadIO m => m String
+-- For how these directories are chosen, see 'getDirs'.
-getXMonadDir =
+--
-    findFirstDirWithEnv "XMONAD_CONFIG_DIR"
+data Directories a = Dirs
-      [ getAppUserDataDirectory "xmonad"
+    { dataDir  :: !a
-      , getXDGDirectory XDGConfig "xmonad"
+    , cfgDir   :: !a
-      ]
+    , cacheDir :: !a
+    }
+    deriving (Show, Functor, Foldable, Traversable)
 
--- | Return the path to the xmonad cache directory.  This directory is
+-- | Convenient type alias for the most common case in which one might
--- used to store temporary files that can easily be recreated.  For
+-- want to use the 'Directories' type.
--- example, the XPrompt history file.
+type Dirs = Directories FilePath
---
--- Several directories are considered.  In order of preference:
---
---   1. The directory specified in the @XMONAD_CACHE_DIR@ environment variable.
---   2. The @~\/.xmonad@ directory.
---   3. The @XDG_CACHE_HOME/xmonad@ 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.
-getXMonadCacheDir :: MonadIO m => m String
-getXMonadCacheDir =
-    findFirstDirWithEnv "XMONAD_CACHE_DIR"
-      [ getAppUserDataDirectory "xmonad"
-      , getXDGDirectory XDGCache "xmonad"
-      ]
 
--- | Return the path to the xmonad data directory.  This directory is
+-- | Build up the 'Dirs' that xmonad will use.  They are chosen as
--- used by XMonad to store data files such as the run-time state file
+-- follows:
--- and the configuration binary generated by GHC.
 --
--- Several directories are considered.  In order of preference:
+-- 1. If all three of xmonad's environment variables (@XMONAD_DATA_DIR@,
+--    @XMONAD_CONFIG_DIR@, and @XMONAD_CACHE_DIR@) are set, use them.
+-- 2. If there is a build script called @build@ or configuration
+--    @xmonad.hs@ in @~\/.xmonad@, set all three directories to
+--    @~\/.xmonad@.
+-- 3. Otherwise, use the @xmonad@ directory in @XDG_DATA_HOME@,
+--    @XDG_CONFIG_HOME@, and @XDG_CACHE_HOME@ (or their respective
+--    fallbacks).  These directories are created if necessary.
 --
---   1. The directory specified in the @XMONAD_DATA_DIR@ environment variable.
+-- The xmonad configuration file (or the build script, if present) is
---   2. The @~\/.xmonad@ directory.
+-- always assumed to be in @cfgDir@.
---   3. The @XDG_DATA_HOME/xmonad@ directory.
 --
--- The first directory that exists will be used.  If none of the
+getDirs :: IO Dirs
--- directories exist then (1) will be used if it is set, otherwise (2)
+getDirs = xmEnvDirs <|> xmDirs <|> xdgDirs
--- will be used.  Either way, a directory will be created if necessary.
-getXMonadDataDir :: MonadIO m => m String
-getXMonadDataDir =
-    findFirstDirWithEnv "XMONAD_DATA_DIR"
-      [ getAppUserDataDirectory "xmonad"
-      , getXDGDirectory XDGData "xmonad"
-      ]
-
--- | 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 @~\/.xmonad@ directory.
-findFirstDirOf :: MonadIO m => [IO FilePath] -> m FilePath
-findFirstDirOf []        = findFirstDirOf [getAppUserDataDirectory "xmonad"]
-findFirstDirOf possibles = do
-    found <- go possibles
-
-    case found of
-      Just path -> return path
-      Nothing   -> do
-        primary <- io (head possibles)
-        io (createDirectoryIfMissing True primary)
-        return primary
-
   where
-    go []     = return Nothing
+    -- | Check for xmonad's environment variables first
-    go (x:xs) = do
+    xmEnvDirs :: IO Dirs
-      dir    <- io x
+    xmEnvDirs = do
-      exists <- io (doesDirectoryExist dir)
+        let xmEnvs = Dirs{ dataDir  = "XMONAD_DATA_DIR"
-      if exists then return (Just dir) else go xs
+                         , cfgDir   = "XMONAD_CONFIG_DIR"
+                         , cacheDir = "XMONAD_CACHE_DIR"
+                         }
+        maybe empty pure . sequenceA =<< traverse getEnv xmEnvs
 
--- | Simple wrapper around @findFirstDirOf@ that allows the primary
+    -- | Check whether the config file or a build script is in the
--- path to be specified by an environment variable.
+    -- @~\/.xmonad@ directory
-findFirstDirWithEnv :: MonadIO m => String -> [IO FilePath] -> m FilePath
+    xmDirs :: IO Dirs
-findFirstDirWithEnv envName paths = do
+    xmDirs = do
-    envPath' <- io (getEnv envName)
+        xmDir <- getAppUserDataDirectory "xmonad"
+        conf  <- doesFileExist $ xmDir </> "xmonad.hs"
+        build <- doesFileExist $ xmDir </> "build"
 
-    case envPath' of
+        -- Place *everything* in ~/.xmonad if yes
-      Nothing      -> findFirstDirOf paths
+        guard $ conf || build
-      Just envPath -> findFirstDirOf (return envPath:paths)
+        pure Dirs{ dataDir = xmDir, cfgDir = xmDir, cacheDir = xmDir }
 
--- | Helper function to retrieve the various XDG directories.
+    -- | Use XDG directories as a fallback
--- This has been based on the implementation shipped with GHC version 8.0.1 or
+    xdgDirs :: IO Dirs
--- higher. Put here to preserve compatibility with older GHC versions.
+    xdgDirs =
-getXDGDirectory :: XDGDirectory -> FilePath -> IO FilePath
+        for Dirs{ dataDir = XdgData, cfgDir = XdgConfig, cacheDir = XdgCache }
-getXDGDirectory xdgDir suffix =
+            $ \dir -> do d <- getXdgDirectory dir "xmonad"
-  normalise . (</> suffix) <$>
+                         d <$ createDirectoryIfMissing True d
-  case xdgDir of
+
-    XDGData   -> get "XDG_DATA_HOME"   ".local/share"
+-- | Return the path to the xmonad configuration directory.
-    XDGConfig -> get "XDG_CONFIG_HOME" ".config"
+getXMonadDir :: X String
-    XDGCache  -> get "XDG_CACHE_HOME"  ".cache"
+getXMonadDir = asks (cfgDir . dirs)
-  where
+{-# DEPRECATED getXMonadDir "Use `asks (cfgDir . dirs)' instead." #-}
-    get name fallback = do
+
-      env <- lookupEnv name
+-- | Return the path to the xmonad cache directory.
-      case env of
+getXMonadCacheDir :: X String
-        Nothing -> fallback'
+getXMonadCacheDir = asks (cacheDir . dirs)
-        Just path
+{-# DEPRECATED getXMonadCacheDir "Use `asks (cacheDir . dirs)' instead." #-}
-          | isRelative path -> fallback'
+
-          | otherwise -> return path
+-- | Return the path to the xmonad data directory.
-      where
+getXMonadDataDir :: X String
-        fallback' = (</> fallback) <$> getHomeDirectory
+getXMonadDataDir = asks (dataDir . dirs)
-data XDGDirectory = XDGData | XDGConfig | XDGCache
+{-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . dirs)' instead." #-}
 
 -- | Get the name of the file used to store the xmonad window state.
-stateFileName :: (Functor m, MonadIO m) => m FilePath
+stateFileName :: X FilePath
 stateFileName = (</> "xmonad.state") <$> getXMonadDataDir
 
 -- | 'recompile force', recompile the xmonad configuration file when
@@ -588,16 +561,14 @@ stateFileName = (</> "xmonad.state") <$> getXMonadDataDir
 --
 -- 'False' is returned if there are compilation errors.
 --
-recompile :: MonadIO m => Bool -> m Bool
+recompile :: MonadIO m => Dirs -> Bool -> m Bool
-recompile force = io $ do
+recompile Dirs{ cfgDir, dataDir } force = io $ do
-    cfgdir  <- getXMonadDir
-    datadir <- getXMonadDataDir
     let binn = "xmonad-"++arch++"-"++os
-        bin  = datadir </> binn
+        bin  = dataDir </> binn
-        err  = datadir </> "xmonad.errors"
+        err  = dataDir </> "xmonad.errors"
-        src  = cfgdir </> "xmonad.hs"
+        src  = cfgDir  </> "xmonad.hs"
-        lib  = cfgdir </> "lib"
+        lib  = cfgDir  </> "lib"
-        buildscript = cfgdir </> "build"
+        buildscript = cfgDir </> "build"
 
     libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
     srcT <- getModTime src
@@ -640,8 +611,8 @@ recompile force = io $ do
         uninstallSignalHandlers
         status <- bracket (openFile err WriteMode) hClose $ \errHandle ->
             waitForProcess =<< if useBuildscript
-                               then compileScript bin cfgdir buildscript errHandle
+                               then compileScript bin cfgDir buildscript errHandle
-                               else compileGHC bin cfgdir errHandle
+                               else compileGHC bin cfgDir errHandle
 
         -- re-enable SIGCHLD:
         installSignalHandlers

src/XMonad/Main.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, NamedFieldPuns #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Main
@@ -39,7 +39,7 @@ import XMonad.Operations
 import System.IO
 import System.Directory
 import System.Info
-import System.Environment
+import System.Environment (getArgs, getProgName, withArgs)
 import System.Posix.Process (executeFile)
 import System.Exit (exitFailure)
 import System.FilePath
@@ -59,17 +59,18 @@ xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
 xmonad conf = do
     installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
 
+    dirs <- getDirs
     let launch' args = do
-              catchIO buildLaunch
+              catchIO (buildLaunch dirs)
               conf'@XConfig { layoutHook = Layout l }
                   <- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) }
-              withArgs [] $ launch (conf' { layoutHook = l })
+              withArgs [] $ launch (conf' { layoutHook = l }) dirs
 
     args <- getArgs
     case args of
-        ("--resume": ws : xs : args') -> migrateState ws xs >> launch' args'
+        ("--resume": ws : xs : args') -> migrateState dirs ws xs >> launch' args'
         ["--help"]            -> usage
-        ["--recompile"]       -> recompile True >>= flip unless exitFailure
+        ["--recompile"]       -> recompile dirs True >>= flip unless exitFailure
         ["--restart"]         -> sendRestart
         ["--version"]         -> putStrLn $ unwords shortVersion
         ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
@@ -90,7 +91,7 @@ usage = do
         "Options:" :
         "  --help                       Print this message" :
         "  --version                    Print the version number" :
-        "  --recompile                  Recompile your ~/.xmonad/xmonad.hs" :
+        "  --recompile                  Recompile your xmonad.hs" :
         "  --replace                    Replace the running window manager with xmonad" :
         "  --restart                    Request a running xmonad process to restart" :
         []
@@ -111,8 +112,8 @@ usage = do
 --
 --   * Missing XMonad\/XMonadContrib modules due to ghc upgrade
 --
-buildLaunch ::  IO ()
+buildLaunch :: Dirs -> IO ()
-buildLaunch = do
+buildLaunch dirs@Dirs{ dataDir } = do
     whoami <- getProgName
     let compiledConfig = "xmonad-"++arch++"-"++os
     unless (whoami == compiledConfig) $ do
@@ -122,10 +123,9 @@ buildLaunch = do
         , " but the compiled configuration should be called "
         , show compiledConfig
         ]
-      recompile False
+      recompile dirs False
-      dir  <- getXMonadDataDir
       args <- getArgs
-      executeFile (dir </> compiledConfig) False args Nothing
+      executeFile (dataDir </> compiledConfig) False args Nothing
 
 sendRestart :: IO ()
 sendRestart = do
@@ -166,8 +166,8 @@ sendReplace = do
 -- function instead of 'xmonad'.  You probably also want to have a key
 -- binding to the 'XMonad.Operations.restart` function that restarts
 -- your custom binary with the resume flag set to @True@.
-launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
+launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> Dirs -> IO ()
-launch initxmc = do
+launch initxmc drs = do
     -- setup locale information from environment
     setLocale LC_ALL (Just "")
     -- ignore SIGPIPE and SIGCHLD
@@ -216,7 +216,9 @@ launch initxmc = do
             , buttonActions = mouseBindings xmc xmc
             , mouseFocused  = False
             , mousePosition = Nothing
-            , currentEvent  = Nothing }
+            , currentEvent  = Nothing
+            , dirs          = drs
+            }
 
         st = XState
             { windowset       = initialWinset

src/XMonad/Operations.hs

@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, NamedFieldPuns #-}
 -- --------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Operations
@@ -36,6 +36,7 @@ import qualified Control.Exception.Extensible as C
 
 import System.IO
 import System.Directory
+import System.FilePath ((</>))
 import System.Posix.Process (executeFile)
 import Graphics.X11.Xlib
 import Graphics.X11.Xinerama (getScreenInfo)
@@ -524,12 +525,11 @@ readStateFile xmc = do
 -- | Migrate state from a previously running xmonad instance that used
 -- the older @--resume@ technique.
 {-# DEPRECATED migrateState "will be removed some point in the future." #-}
-migrateState :: (Functor m, MonadIO m) => String -> String -> m ()
+migrateState :: (Functor m, MonadIO m) => Dirs -> String -> String -> m ()
-migrateState ws xs = do
+migrateState Dirs{ dataDir } ws xs = do
     io (putStrLn "WARNING: --resume is no longer supported.")
-    whenJust stateData $ \s -> do
+    whenJust stateData $ \s ->
-      path <- stateFileName
+        catchIO (writeFile (dataDir </> "xmonad.state") $ show s)
-      catchIO (writeFile path $ show s)
   where
     stateData = StateFile <$> maybeRead ws <*> maybeRead xs
     maybeRead s = case reads s of