modify mkAbsolutePath to support environment vars

If you want more general support, comment on PR #744.
This commit is contained in:
brandon s allbery kf8nh 2022-08-20 12:00:28 -04:00
parent 40171824cd
commit 64eb4e46ec
No known key found for this signature in database
GPG Key ID: 227EE1942B0BDB95
2 changed files with 21 additions and 9 deletions

View File

@ -184,6 +184,10 @@
- Added `WindowScreen`, which is a type synonym for the specialized `Screen`
type, that results from the `WindowSet` definition in `XMonad.Core`.
- Modified `mkAbsolutePath` to support a leading environment variable, so
things like `$HOME/NOTES` work. If you want more general environment
variable support, comment on [this PR].
* `XMonad.Util.XUtils`
- Added `withSimpleWindow`, `showSimpleWindow`, `WindowConfig`, and

View File

@ -1,5 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------
-- |
-- Module : XMonad.Prelude
@ -60,6 +61,8 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Tuple (swap)
import GHC.Stack
import System.Directory (getHomeDirectory)
import System.Environment (getEnv)
import Control.Exception (SomeException, handle)
import qualified XMonad.StackSet as W
-- | Short for 'fromIntegral'.
@ -80,7 +83,7 @@ chunksOf i xs = chunk : chunksOf i rest
(!?) xs n | n < 0 = Nothing
| otherwise = listToMaybe $ drop n xs
-- | Multivariant composition.
-- | Multivariable composition.
--
-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)
(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b
@ -108,14 +111,19 @@ safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->
-- * If it starts with @~\/@, replace that with the actual home
-- * directory.
--
-- * Otherwise, prepend a @\/@ to the path.
-- * If it starts with @$@, read the name of an environment
-- * variable and replace it with the contents of that.
--
-- * Otherwise, prepend the home directory and @\/@ 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)
home <- io getHomeDirectory
case ps of
'/' : _ -> pure ps
'~' : '/' : _ -> pure (home <> drop 1 ps)
'$' : _ -> let (v,ps') = span (`elem` ("_"<>['A'..'Z']<>['a'..'z']<>['0'..'9'])) (drop 1 ps)
in io ((\(_ :: SomeException) -> pure "") `handle` getEnv v) Exports.<&> (<> ps')
_ -> pure (home <> ('/' : ps))
{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}
{-# SPECIALISE mkAbsolutePath :: FilePath -> X FilePath #-}