{-# OPTIONS_GHC -Wunused-imports #-}

-- | Expand environment variables in strings
module Agda.Utils.Environment
  ( EnvVars
  , expandEnvironmentVariables
  , expandEnvVarTelescope
  ) 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
  env  <- IO [(String, String)]
getEnvironment
  home <- getHomeDirectory
  return $ expandVars home env s

expandVars
  :: String              -- ^ Home directory.
  -> EnvVars             -- ^ 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

-- | List of environment variable bindings.
type EnvVars = [(String, String)]

-- | Expand a telescope of environment variables
--   (each value may refer to variables earlier in the list).
expandEnvVarTelescope :: String -> EnvVars -> EnvVars
expandEnvVarTelescope :: String -> [(String, String)] -> [(String, String)]
expandEnvVarTelescope String
home = [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, String)] -> (String, String) -> [(String, String)])
-> [(String, String)] -> [(String, String)] -> [(String, String)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl  -- foldl reverses, so re-reverse afterwards
  (\ [(String, String)]
acc (String
var, String
val) -> (String
var, String -> [(String, String)] -> String -> String
expandVars String
home [(String, String)]
acc String
val) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
acc) []

-- | 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
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: 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
$cshowsPrec :: Int -> Token -> String -> String
showsPrec :: Int -> Token -> String -> String
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> String -> String
showList :: [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