{-# language TemplateHaskell #-}
{-# options_ghc -Wno-unused-imports #-}
module IncludeEnv.TH (includeEnv) where
import System.Environment (lookupEnv)
import Language.Haskell.TH (runIO, runQ)
import Language.Haskell.TH.Syntax (Q, Exp(..), Dec(..), Pat(..), Name, mkName, Body(..), Lit(..))
import Language.Haskell.TH.Lib (valD)
includeEnv :: String
-> String
-> Q [Dec]
includeEnv :: String -> String -> Q [Dec]
includeEnv String
e String
varname = do
Maybe String
mstr <- IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (IO (Maybe String) -> Q (Maybe String))
-> IO (Maybe String) -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
e
case Maybe String
mstr of
Just String
str -> String -> String -> Q [Dec]
decl String
varname String
str
Maybe String
Nothing -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error (String -> Q [Dec]) -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Cannot find variable", String
e, String
"in the environment."]
where
decl :: String -> String -> Q [Dec]
decl :: String -> String -> Q [Dec]
decl String
n String
x = [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
dq] where
dq :: Dec
dq = Pat -> Body -> [Dec] -> Dec
ValD Pat
qpat Body
qbody []
qpat :: Pat
qpat = Name -> Pat
VarP (String -> Name
mkName String
n)
qbody :: Body
qbody = Exp -> Body
NormalB (Lit -> Exp
LitE (String -> Lit
StringL String
x))