{-# 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
  env <- IO [(String, String)]
getEnvironment
  return $ fromMaybe "" $ lookup var 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
  b <- String -> IO Bool
doesFileExist String
path
  if b
    then do
         str <- readFile path
         let ls = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notComment (String -> [String]
lines String
str)
         return $ mapMaybe parsePair ls
    else 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
  pairs <- String -> IO [(String, String)]
readPairs String
"/etc/xdg/user-dirs.defaults"
  return $ M.fromList 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
  configDir <- String -> IO String
getUserConfigDir String
""
  let userConfig = String
configDir String -> ShowS
</> String
"user-dirs.dirs"
  pairs <- readPairs userConfig
  env <- getEnvironment
  return $ M.fromList $ mapMaybe (xdgVar env) 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
  home <- IO String
getHomeDirectory
  def <- readDefaults
  user <- readUserDirs
  case M.lookup name (user `M.union` 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)