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

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

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

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

-- | 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 (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

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

-- | 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 = (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 []

-- | 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"
  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

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

-- | 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 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)