{-# 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 :: 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 ||]