module System.Command.QQ
(
sh_
, sh
, shell
, interpreter
, quoter
, callCommand
, substituteVars
, module System.Command.QQ.Embed
, module System.Command.QQ.Eval
) where
import Control.Applicative
import Data.Char (isLower, isUpper)
import Data.Maybe (fromMaybe)
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import System.Command.QQ.Embed
import System.Command.QQ.Eval
sh :: QuasiQuoter
sh = quoter $ \string -> do
shellEx <- runIO $ getEnvDefault "/bin/sh" "SHELL"
callCommand shellEx ["-c"] string
sh_ :: QuasiQuoter
sh_ = quoter $ \string -> do
shellEx <- runIO $ getEnvDefault "/bin/sh" "SHELL"
callCommand_ shellEx ["-c"] string
shell :: FilePath -> QuasiQuoter
shell path = quoter (callCommand path ["-c"])
interpreter :: FilePath -> QuasiQuoter
interpreter path = quoter (callCommand path ["-e"])
quoter :: (String -> Q Exp) -> QuasiQuoter
quoter quote = QuasiQuoter
{ quoteExp = quote
, quotePat = failure "patterns"
, quoteType = failure "types"
, quoteDec = failure "declarations"
}
where
failure kind =
fail $ "this quasiquoter does not support splicing " ++ kind
callCommand
:: FilePath
-> [String]
-> String
-> Q Exp
callCommand path args string =
[e| eval path (args ++ [$(substituteVars string)]) |]
callCommand_
:: FilePath
-> [String]
-> String
-> Q Exp
callCommand_ path args string =
[e| eval path (args ++ [$(substituteVars string)]) :: IO () |]
substituteVars :: String -> Q Exp
substituteVars = raw where
raw, var :: String -> Q Exp
raw (break (== '#') -> parts) = case parts of
(before, '#':'{' :after) -> [e| before ++ $(var after) |]
(before, '#':'\\':after) -> [e| before ++ '#' : $(raw after) |]
(before, '#':after) -> [e| before ++ '#' : $(raw after) |]
(before, []) -> [e| before |]
_ -> fail "Should never happen"
var (break (== '}') -> parts) = case parts of
(b:efore, '}':after)
| isLower b -> external (VarE (mkName (b:efore))) after
| isUpper b -> external (ConE (mkName (b:efore))) after
| Just i <- readMaybe (b:efore) -> external (LitE (IntegerL i)) after
| Just d <- readMaybe (b:efore) -> external (LitE (RationalL (toRational (d :: Double)))) after
| Just c <- readMaybe (b:efore) -> external (LitE (CharL c)) after
| Just s <- readMaybe (b:efore) -> external (LitE (StringL s)) after
(before, _) -> fail $ "Invalid name: " ++ before
external :: Exp -> String -> Q Exp
external e after = [e| embed $(return e) ++ $(raw after) |]
getEnvDefault
:: String
-> String
-> IO String
getEnvDefault def query = fromMaybe def <$> lookupEnv query