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

    -- | 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' :: forall a. IsString a => String -> SpliceQ a
    envQ' String
    name = Q (TExp a) -> Code Q a
    forall a (m :: * -> *). m (TExp a) -> Splice m a
    liftSplice (Q (TExp a) -> Code Q a) -> Q (TExp a) -> Code Q 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 a)) -> Q (TExp 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 a -> Q (TExp a)
    forall (q :: * -> *) a c. IsCode q a c => Code q a -> c
    fromCode (Code Q a -> Q (TExp a)) -> Code Q a -> Q (TExp a)
    forall a b. (a -> b) -> a -> b
    $ Code Q a -> Code Q a
    forall (q :: * -> *) a c. IsCode q a c => c -> Code q a
    toCode [|| String -> a
    forall a. IsString a => String -> a
    fromString String
    v ||]
        Maybe String
    Nothing -> String -> Q (TExp a)
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q (TExp a)) -> String -> Q (TExp 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"