{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Language.Haskell.TH.Env (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.
envQ :: IsString a
     => String
     -- ^ Environment variable name.
     -> SpliceQ (Maybe a)
envQ :: forall a. IsString a => String -> SpliceQ (Maybe a)
envQ String
name = Q (TExp (Maybe a)) -> Code Q (Maybe a)
forall a (m :: * -> *). m (TExp a) -> Splice m a
liftSplice (Q (TExp (Maybe a)) -> Code Q (Maybe a))
-> Q (TExp (Maybe a)) -> Code Q (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 -> Q (TExp (Maybe a))) -> Q (TExp (Maybe a))
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
v  -> Code Q (Maybe a) -> Q (TExp (Maybe a))
forall (q :: * -> *) a c. IsCode q a c => Code q a -> c
fromCode (Code Q (Maybe a) -> Q (TExp (Maybe a)))
-> Code Q (Maybe a) -> Q (TExp (Maybe a))
forall a b. (a -> b) -> a -> b
$ Code Q (Maybe a) -> Code Q (Maybe a)
forall (q :: * -> *) a c. IsCode q a c => c -> Code q a
toCode [|| a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. IsString a => String -> a
fromString String
v) ||]
    Maybe String
Nothing -> Code Q (Maybe a) -> Q (TExp (Maybe a))
forall (q :: * -> *) a c. IsCode q a c => Code q a -> c
fromCode (Code Q (Maybe a) -> Q (TExp (Maybe a)))
-> Code Q (Maybe a) -> Q (TExp (Maybe a))
forall a b. (a -> b) -> a -> b
$ Code Q (Maybe a) -> Code Q (Maybe a)
forall (q :: * -> *) a c. IsCode q a c => c -> Code q a
toCode [|| Maybe a
forall a. Maybe a
Nothing ||]