{-# LANGUAGE CPP #-}
module System.Environment.XDG.UserDir
(readUserDirs,
getUserDir) where
import Control.Monad
import Data.Maybe
import qualified Data.Map as M
import System.FilePath
import System.Environment
import System.Environment.XDG.BaseDir
import System.Directory
data Element = Fixed Char | Var String
deriving (Element -> Element -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show)
parseString :: String -> [Element]
parseString :: String -> [Element]
parseString [] = []
parseString (Char
'$':String
xs) =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!#/;:,.*?%-=$<> \r\n\t") String
xs of
([], String
cs) -> Char -> Element
Fixed Char
'$'forall a. a -> [a] -> [a]
: String -> [Element]
parseString String
cs
(String
name, []) -> [String -> Element
Var String
name]
(String
name, String
cs) -> String -> Element
Var String
nameforall a. a -> [a] -> [a]
: String -> [Element]
parseString String
cs
parseString (Char
x:String
xs) = Char -> Element
Fixed Char
xforall a. a -> [a] -> [a]
: String -> [Element]
parseString String
xs
renderElements :: [(String, String)] -> [Element] -> String
renderElements :: [(String, String)] -> [Element] -> String
renderElements [(String, String)]
env [Element]
list = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Element -> String
render [Element]
list
where
render :: Element -> String
render (Fixed Char
c) = [Char
c]
render (Var String
name) =
forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
env
split :: Eq a => a -> [a] -> [[a]]
split :: forall a. Eq a => a -> [a] -> [[a]]
split a
_ [] = []
split a
sep [a]
list =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= a
sep) [a]
list of
([a]
x, []) -> [[a]
x]
([a]
x, a
s:[a]
xs)
| a
s forall a. Eq a => a -> a -> Bool
== a
sep -> [a]
xforall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [[a]]
split a
sep [a]
xs
| Bool
otherwise -> [[a]
x, a
sforall a. a -> [a] -> [a]
:[a]
xs]
getEnv' :: String -> IO String
getEnv' :: String -> IO String
getEnv' String
var = do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
var [(String, String)]
env
notComment :: String -> Bool
[] = Bool
False
notComment (Char
'#':String
_) = Bool
False
notComment String
_ = Bool
True
parsePair :: String -> Maybe (String, String)
parsePair :: String -> Maybe (String, String)
parsePair String
str =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'=') String
str of
(String
name, Char
'=':String
value) -> forall a. a -> Maybe a
Just (String
name, ShowS
stripQuotes String
value)
(String, String)
_ -> forall a. Maybe a
Nothing
stripQuotes :: String -> String
stripQuotes :: ShowS
stripQuotes [] = []
stripQuotes s :: String
s@(Char
'"':String
xs) =
if forall a. [a] -> a
last String
xs forall a. Eq a => a -> a -> Bool
== Char
'"' then forall a. [a] -> [a]
init String
xs else String
s
stripQuotes s :: String
s@(Char
'\'':String
xs) =
if forall a. [a] -> a
last String
xs forall a. Eq a => a -> a -> Bool
== Char
'\'' then forall a. [a] -> [a]
init String
xs else String
s
stripQuotes String
s = String
s
readPairs :: FilePath -> IO [(String,String)]
readPairs :: String -> IO [(String, String)]
readPairs String
path = do
Bool
b <- String -> IO Bool
doesFileExist String
path
if Bool
b
then do
String
str <- String -> IO String
readFile String
path
let ls :: [String]
ls = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notComment (String -> [String]
lines String
str)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, String)
parsePair [String]
ls
else forall (m :: * -> *) a. Monad m => a -> m a
return []
readDefaults :: IO (M.Map String String)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
readDefaults = return M.empty
#else
readDefaults :: IO (Map String String)
readDefaults = do
[(String, String)]
pairs <- String -> IO [(String, String)]
readPairs String
"/etc/xdg/user-dirs.defaults"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, String)]
pairs
#endif
xdgVar :: [(String, String)] -> (String, String) -> Maybe (String, String)
xdgVar :: [(String, String)] -> (String, String) -> Maybe (String, String)
xdgVar [(String, String)]
env (String
name, String
value) =
case forall a. Eq a => a -> [a] -> [[a]]
split Char
'_' String
name of
[String
"XDG", String
var, String
"DIR"] -> forall a. a -> Maybe a
Just (String
var, [(String, String)] -> [Element] -> String
renderElements [(String, String)]
env forall a b. (a -> b) -> a -> b
$ String -> [Element]
parseString String
value)
[String]
_ -> forall a. Maybe a
Nothing
readUserDirs :: IO (M.Map String String)
readUserDirs :: IO (Map String String)
readUserDirs = do
String
configDir <- String -> IO String
getUserConfigDir String
""
let userConfig :: String
userConfig = String
configDir String -> ShowS
</> String
"user-dirs.dirs"
[(String, String)]
pairs <- String -> IO [(String, String)]
readPairs String
userConfig
[(String, String)]
env <- IO [(String, String)]
getEnvironment
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([(String, String)] -> (String, String) -> Maybe (String, String)
xdgVar [(String, String)]
env) [(String, String)]
pairs
getUserDir :: String -> IO String
getUserDir :: String -> IO String
getUserDir String
name = do
String
home <- IO String
getHomeDirectory
Map String String
def <- IO (Map String String)
readDefaults
Map String String
user <- IO (Map String String)
readUserDirs
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name (Map String String
user forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map String String
def) of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
home
Just String
val -> case String
val of
(Char
'/':String
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
val
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
home String -> ShowS
</> String
val)