{-# 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
envQ :: IsString a
=> String
-> 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 ||]
envQ' :: IsString a
=> String
-> 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"