-- | Expand environment variables in strings
module Agda.Utils.Environment ( expandEnvironmentVariables ) where

import Data.Char
import Data.Maybe
import System.Environment
import System.Directory ( getHomeDirectory )

expandEnvironmentVariables :: String -> IO String
expandEnvironmentVariables :: String -> IO String
expandEnvironmentVariables String
s = do
  [(String, String)]
env  <- IO [(String, String)]
getEnvironment
  String
home <- IO String
getHomeDirectory
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> String -> String
expandVars String
home [(String, String)]
env String
s

expandVars
  :: String              -- ^ Home directory.
  -> [(String, String)]  -- ^ Environment variable substitution map.
  -> String              -- ^ Input.
  -> String              -- ^ Output with variables and @~@ (home) substituted.
expandVars :: String -> [(String, String)] -> String -> String
expandVars String
home [(String, String)]
env String
s = (Token -> String) -> [Token] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> String
repl ([Token] -> String) -> [Token] -> String
forall a b. (a -> b) -> a -> b
$ String -> [Token]
tokens String
s
  where
    repl :: Token -> String
repl Token
Home    = String
home String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
    repl (Var String
x) = 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
x [(String, String)]
env
    repl (Str String
s) = String
s

-- | Tokenization for environment variable substitution.
data Token
  = Home        -- ^ @~@.
  | Var String  -- ^ @$VARIABLE@ or @${VARIABLE}$.
  | Str String  -- ^ Ordinary characters.
  deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> String -> String
[Token] -> String -> String
Token -> String
(Int -> Token -> String -> String)
-> (Token -> String) -> ([Token] -> String -> String) -> Show Token
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Token] -> String -> String
$cshowList :: [Token] -> String -> String
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> String -> String
$cshowsPrec :: Int -> Token -> String -> String
Show)

-- | Tokenize a string.
--   The @~@ is recognized as @$HOME@ only at the beginning of the string.
tokens :: String -> [Token]
tokens :: String -> [Token]
tokens = \case
  Char
'~'  : Char
'/' : String
s -> Token
Home Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
tokens' String
s
  Char
'\\' : Char
'~' : String
s -> Char -> [Token] -> [Token]
cons Char
'~' ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ String -> [Token]
tokens' String
s
  String
s -> String -> [Token]
tokens' String
s
  where
    tokens' :: String -> [Token]
    tokens' :: String -> [Token]
tokens' = \case
        Char
'$' : Char
'$' : String
s -> Char -> [Token] -> [Token]
cons Char
'$' ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ String -> [Token]
tokens' String
s
        Char
'$' : s :: String
s@(Char
c : String
_) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isAlpha Char
c -> String -> Token
Var String
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
tokens' String
s'
          where
          (String
x, String
s') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\ Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
c) String
s
        Char
'$' : Char
'{' : String
s ->
          case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}') String
s of
            (String
x, Char
'}' : String
s) -> String -> Token
Var String
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
tokens' String
s
            (String, String)
_            -> [String -> Token
Str (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ String
"${" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s] -- abort on unterminated '{'
        Char
c : String
s -> Char -> [Token] -> [Token]
cons Char
c ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ String -> [Token]
tokens' String
s
        String
""    -> []
    cons :: Char -> [Token] -> [Token]
    cons :: Char -> [Token] -> [Token]
cons Char
c (Str String
s : [Token]
ts) = String -> Token
Str (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
s) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts
    cons Char
c [Token]
ts           = String -> Token
Str [Char
c] Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts