{-# 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
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
/= :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Element -> ShowS
showsPrec :: Int -> Element -> ShowS
$cshow :: Element -> String
show :: Element -> String
$cshowList :: [Element] -> ShowS
showList :: [Element] -> ShowS
Show)
parseString :: String -> [Element]
parseString :: String -> [Element]
parseString [] = []
parseString (Char
'$':String
xs) =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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
'$'Element -> [Element] -> [Element]
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
nameElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: String -> [Element]
parseString String
cs
parseString (Char
x:String
xs) = Char -> Element
Fixed Char
xElement -> [Element] -> [Element]
forall 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 = (Element -> String) -> [Element] -> String
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) =
String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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 (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
sep) [a]
list of
([a]
x, []) -> [[a]
x]
([a]
x, a
s:[a]
xs)
| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
sep -> [a]
x[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
split a
sep [a]
xs
| Bool
otherwise -> [[a]
x, a
sa -> [a] -> [a]
forall 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
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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 (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') String
str of
(String
name, Char
'=':String
value) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
name, ShowS
stripQuotes String
value)
(String, String)
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
stripQuotes :: String -> String
stripQuotes :: ShowS
stripQuotes [] = []
stripQuotes s :: String
s@(Char
'"':String
xs) =
if String -> Char
forall a. HasCallStack => [a] -> a
last String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then ShowS
forall a. HasCallStack => [a] -> [a]
init String
xs else String
s
stripQuotes s :: String
s@(Char
'\'':String
xs) =
if String -> Char
forall a. HasCallStack => [a] -> a
last String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' then ShowS
forall a. HasCallStack => [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 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notComment (String -> [String]
lines String
str)
[(String, String)] -> IO [(String, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> IO [(String, String)])
-> [(String, String)] -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (String, String))
-> [String] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, String)
parsePair [String]
ls
else [(String, String)] -> IO [(String, String)]
forall a. a -> IO a
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"
Map String String -> IO (Map String String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String String -> IO (Map String String))
-> Map String String -> IO (Map String String)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Map String String
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 Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
split Char
'_' String
name of
[String
"XDG", String
var, String
"DIR"] -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
var, [(String, String)] -> [Element] -> String
renderElements [(String, String)]
env ([Element] -> String) -> [Element] -> String
forall a b. (a -> b) -> a -> b
$ String -> [Element]
parseString String
value)
[String]
_ -> Maybe (String, 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
Map String String -> IO (Map String String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String String -> IO (Map String String))
-> Map String String -> IO (Map String String)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, String)] -> Map String String)
-> [(String, String)] -> Map String String
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Maybe (String, String))
-> [(String, String)] -> [(String, String)]
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 String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name (Map String String
user Map String String -> Map String String -> Map String String
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map String String
def) of
Maybe String
Nothing -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
home
Just String
val -> case String
val of
(Char
'/':String
_) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
val
String
_ -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
home String -> ShowS
</> String
val)