module Hasql.QQ where
import Hasql.Prelude
import Hasql.TH
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import qualified Data.Text as Text
import qualified Hasql.QQ.Parser as Parser
import qualified Hasql.Backend as Bknd
stmt :: QuasiQuoter
stmt =
QuasiQuoter
(parseExp)
(const $ fail "Pattern context is not supported")
(const $ fail "Type context is not supported")
(const $ fail "Declaration context is not supported")
where
parseExp =
fmap (uncurry statementF) .
either (fail . showString "Parsing failure: ") return .
Parser.parse .
fromString
statementF t params =
LamE
(map VarP argNames)
(purify [|Bknd.Stmt $(pure statementE) $(pure argsE) True|])
where
(varNames, argNames) =
(\(a, b) -> (reverse a, reverse b)) $
flip execState ([], []) $ forM_ params $ \case
Parser.ParamName n ->
modify $ \(a, b) -> (mkName (Text.unpack n) : a, b)
Parser.OrderedPlaceholder ->
modify $ \(a, b) ->
let n = mkName $ '_' : show (length b + 1)
in (n : a, n : b)
Parser.IndexedPlaceholder i ->
fail "Indexed placeholders are not supported"
statementE =
LitE (StringL (Text.unpack t))
argsE =
vectorE $
map (\x -> purify [| Bknd.encodeValue $(varE x) |]) $
varNames