{-# language TemplateHaskell #-}
{-# options_ghc -Wno-unused-imports #-}
{-|
Include the value of an environment variable in the binary at compile time.

== Rationale
Users might want to embed secrets (e.g. API keys, database connection strings) inside production artifacts without checking these into the repository.

== Example

@
import IncludeEnv.TH (includeEnv)

$(`includeEnv` \"SHELL\" "shl")
shl :: String

main :: IO ()
main = putStrLn $ unwords ["your current shell :", shl]
@

-}
module IncludeEnv.TH (
  includeEnv
  , includeEnvLenient
  , includeEnvMaybe
  ) where

import System.Environment (lookupEnv)

-- template-haskell
import Language.Haskell.TH (runIO, runQ)
import Language.Haskell.TH.Syntax (Q, Exp(..), Dec(..), Pat(..), Name, mkName, Body(..), Lit(..), reportWarning)
import Language.Haskell.TH.Lib (valD)


-- | Include the value of an environment variable at compile time.
--
-- A fresh variable of type `String` is declared each time this is computation is evaluated.
--
-- Note : will crash with `error` if the environment variable is not found.
includeEnv :: String -- ^ name of environment variable to be looked up
           -> String -- ^ name of new value
           -> Q [Dec]
includeEnv :: String -> String -> Q [Dec]
includeEnv String
e String
varname = do
  Maybe String
mstr <- IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (IO (Maybe String) -> Q (Maybe String))
-> IO (Maybe String) -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
e
  case Maybe String
mstr of
    Just String
str -> String -> String -> Q [Dec]
decl String
varname String
str
    Maybe String
Nothing -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error (String -> Q [Dec]) -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Cannot find variable", String
e, String
"in the environment."]
    where
      decl :: String -> String -> Q [Dec]
      decl :: String -> String -> Q [Dec]
decl String
n String
x = [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
dq] where
        dq :: Dec
dq = Pat -> Body -> [Dec] -> Dec
ValD Pat
qpat Body
qbody []
        qpat :: Pat
qpat = Name -> Pat
VarP (String -> Name
mkName String
n)
        qbody :: Body
qbody = Exp -> Body
NormalB (Lit -> Exp
LitE (String -> Lit
StringL String
x))

-- | Like 'includeEnv' but only prints a warning if the environment variable cannot be found.
--
-- NB : If the lookup fails, the declared value will contain an _empty string_ .
includeEnvLenient :: String -- ^ name of environment variable to be looked up
                  -> String -- ^ name of new value
                  -> Q [Dec]
includeEnvLenient :: String -> String -> Q [Dec]
includeEnvLenient String
e String
varname = do
  Maybe String
mstr <- IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (IO (Maybe String) -> Q (Maybe String))
-> IO (Maybe String) -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
e
  case Maybe String
mstr of
    Just String
str -> String -> String -> Q [Dec]
decl String
varname String
str
    Maybe String
Nothing -> do
      String -> Q ()
reportWarning (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"*** WARNING : Cannot find variable", String
e, String
"in the environment."]
      String -> String -> Q [Dec]
decl String
varname String
""
    where
      decl :: String -> String -> Q [Dec]
      decl :: String -> String -> Q [Dec]
decl String
n String
x = [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
dq] where
        dq :: Dec
dq = Pat -> Body -> [Dec] -> Dec
ValD Pat
qpat Body
qbody []
        qpat :: Pat
qpat = Name -> Pat
VarP (String -> Name
mkName String
n)
        qbody :: Body
qbody = Exp -> Body
NormalB (Lit -> Exp
LitE (String -> Lit
StringL String
x))

-- | Like 'includeEnv' but produces a 'Maybe String'
--
-- Use case : The program needs to be compiled against two different environments that may have different sets of environment variables. 'includeEnvMaybe' lets you account for the results of multiple such lookups at runtime.
--
-- @since 0.4.0.0
includeEnvMaybe :: String -- ^ name of environment variable to be looked up
                -> Q Exp
includeEnvMaybe :: String -> Q Exp
includeEnvMaybe String
e = do
  Maybe String
mstr <- IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (IO (Maybe String) -> Q (Maybe String))
-> IO (Maybe String) -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
e
  [| mstr |]