X.Prelude: Add mkAbsolutePath

XMonad/Prelude.hs

@@ -22,6 +22,7 @@ module XMonad.Prelude (
     NonEmpty((:|)),
     notEmpty,
     safeGetWindowAttributes,
+    mkAbsolutePath,
 
     -- * Keys
     keyToString,
@@ -58,6 +59,7 @@ import Data.Bits
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Tuple (swap)
 import GHC.Stack
+import System.Directory (getHomeDirectory)
 import qualified XMonad.StackSet as W
 
 -- | Short for 'fromIntegral'.
@@ -99,6 +101,24 @@ safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->
     0 -> pure Nothing
     _ -> Just <$> peek p
 
+-- | (Naïvely) turn a relative path into an absolute one.
+--
+-- * If the path starts with @\/@, do nothing.
+--
+-- * If it starts with @~\/@, replace that with the actual home
+-- * directory.
+--
+-- * Otherwise, prepend a @\/@ to the path.
+mkAbsolutePath :: MonadIO m => FilePath -> m FilePath
+mkAbsolutePath ps = do
+  home <- liftIO getHomeDirectory
+  pure $ case ps of
+    '/'       : _ ->                ps
+    '~' : '/' : _ -> home <> drop 1 ps
+    _             -> home <> ('/' : ps)
+{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}
+{-# SPECIALISE mkAbsolutePath :: FilePath -> X  FilePath #-}
+
 -----------------------------------------------------------------------
 -- Keys
 

XMonad/Prompt/OrgMode.hs

@@ -57,7 +57,6 @@ import XMonad.Util.Parser
 import XMonad.Util.XSelection (getSelection)
 
 import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian)
-import System.Directory (getHomeDirectory)
 import System.IO (IOMode (AppendMode), hPutStrLn, withFile)
 
 {- $usage
@@ -217,10 +216,7 @@ mkOrgPrompt xpc oc@OrgMode{ todoHeader, orgFile, clpSupport } =
                else Body   $ "\n " <> sel
 
     -- Expand path if applicable
-    fp <- case orgFile of
+    fp <- mkAbsolutePath orgFile
-      '/'       : _ -> pure orgFile
-      '~' : '/' : _ -> getHomeDirectory <&> (<> drop 1 orgFile)
-      _             -> getHomeDirectory <&> (<> ('/' : orgFile))
 
     withFile fp AppendMode . flip hPutStrLn
       <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput

XMonad/Util/Run.hs

@@ -86,7 +86,7 @@ import qualified XMonad.Util.ExtensibleConf as XC
 
 import Codec.Binary.UTF8.String (encodeString)
 import Control.Concurrent (threadDelay)
-import System.Directory (getDirectoryContents, getHomeDirectory)
+import System.Directory (getDirectoryContents)
 import System.IO
 import System.Posix.IO
 import System.Posix.Process (createSession, executeFile, forkProcess)
@@ -451,12 +451,10 @@ data EmacsLib
 -- in batch mode.
 withEmacsLibs :: [EmacsLib] -> X Input
 withEmacsLibs libs = XC.withDef $ \ProcessConfig{emacsLispDir, emacsElpaDir} -> do
-  home       <- liftIO getHomeDirectory
+  lispDir <- mkAbsolutePath emacsLispDir
-  let lispDir = mkAbsolutePath home emacsLispDir
+  elpaDir <- mkAbsolutePath emacsElpaDir
-      elpaDir = mkAbsolutePath home emacsElpaDir
+  lisp    <- liftIO $ getDirectoryContents lispDir
-
+  elpa    <- liftIO $ getDirectoryContents elpaDir
-  lisp <- liftIO $ getDirectoryContents lispDir
-  elpa <- liftIO $ getDirectoryContents elpaDir
 
   let getLib :: EmacsLib -> Maybe String = \case
         OwnFile f -> (("-l " <> lispDir) <>) <$> find (f          `isInfixOf`) lisp