{-# 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

-- | Element of shell-string
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)

-- | Parse shell-format string
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

-- | Render shell-format string using given environment
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 list
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]

-- | Similar to System.Environment.getEnv,
-- but returns empty string if there is no
-- such variable.
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

-- | Check if line is not a comment
notComment :: String -> Bool
notComment :: String -> Bool
notComment [] = Bool
False
notComment (Char
'#':String
_) = Bool
False
notComment String
_ = Bool
True

-- | Parse `NAME=VALUE' pair
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

-- | Strip single\/double quotes
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

-- | Read list of `NAME=VALUE' pairs from file.
-- If there is no such file, return empty list.
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 []

-- | Read default XDG-user-dirs config
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

-- | Read user-configured set of user directories
-- (from user-dirs.dirs)
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

-- | Get one specific user directory (e. g., 
-- getUserDir \"DOWNLOAD\"). If there is no
-- such specified directory, return home directory.
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)