{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Language.Haskell.TH.Env (envQ, envQ')

where

import Data.String
import Language.Haskell.TH
import Language.Haskell.TH.Syntax.Compat
import System.Environment

-- | Produce a typed expression with the current value of an
-- environment variable, or Nothing if it's not set.
envQ :: IsString a
     => String
     -- ^ Environment variable name.
     -> SpliceQ (Maybe a)
envQ :: String -> SpliceQ (Maybe a)
envQ String
name = SpliceQ (Maybe a) -> SpliceQ (Maybe a)
forall a (m :: * -> *). m (TExp a) -> m (TExp a)
liftSplice (SpliceQ (Maybe a) -> SpliceQ (Maybe a))
-> SpliceQ (Maybe a) -> SpliceQ (Maybe a)
forall a b. (a -> b) -> a -> b
$
  IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (String -> IO (Maybe String)
lookupEnv String
name) Q (Maybe String)
-> (Maybe String -> SpliceQ (Maybe a)) -> SpliceQ (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
v  -> Code Q (Maybe a) -> SpliceQ (Maybe a)
forall (q :: * -> *) a c. IsCode q a c => Code q a -> c
fromCode (Code Q (Maybe a) -> SpliceQ (Maybe a))
-> Code Q (Maybe a) -> SpliceQ (Maybe a)
forall a b. (a -> b) -> a -> b
$ SpliceQ (Maybe a) -> Code Q (Maybe a)
forall (q :: * -> *) a c. IsCode q a c => c -> Code q a
toCode [|| Just (fromString v) ||]
    Maybe String
Nothing -> Code Q (Maybe a) -> SpliceQ (Maybe a)
forall (q :: * -> *) a c. IsCode q a c => Code q a -> c
fromCode (Code Q (Maybe a) -> SpliceQ (Maybe a))
-> Code Q (Maybe a) -> SpliceQ (Maybe a)
forall a b. (a -> b) -> a -> b
$ SpliceQ (Maybe a) -> Code Q (Maybe a)
forall (q :: * -> *) a c. IsCode q a c => c -> Code q a
toCode [|| Nothing ||]

-- | Produce a typed expression with the current value of an
-- environment variable. Fail if it's not set.
envQ' :: IsString a
      => String
      -- ^ Environment variable name.
      -> SpliceQ a
envQ' :: String -> SpliceQ a
envQ' String
name = SpliceQ a -> SpliceQ a
forall a (m :: * -> *). m (TExp a) -> m (TExp a)
liftSplice (SpliceQ a -> SpliceQ a) -> SpliceQ a -> SpliceQ a
forall a b. (a -> b) -> a -> b
$
  IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (String -> IO (Maybe String)
lookupEnv String
name) Q (Maybe String) -> (Maybe String -> SpliceQ a) -> SpliceQ a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
v  -> Code Q a -> SpliceQ a
forall (q :: * -> *) a c. IsCode q a c => Code q a -> c
fromCode (Code Q a -> SpliceQ a) -> Code Q a -> SpliceQ a
forall a b. (a -> b) -> a -> b
$ SpliceQ a -> Code Q a
forall (q :: * -> *) a c. IsCode q a c => c -> Code q a
toCode [|| fromString v ||]
    Maybe String
Nothing -> String -> SpliceQ a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> SpliceQ a) -> String -> SpliceQ a
forall a b. (a -> b) -> a -> b
$ String
"Environment variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not set"