{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Database.Relational.Export
-- Copyright   : 2021 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines templates to export SQL string representation to other systems.
module Database.Relational.Export (
  inlineQuery_,
  inlineUpdate_,
  inlineInsertValue_,
  inlineInsertQuery_,
  inlineDelete_,
  ) where

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.ByteString.Short (ShortByteString, toShort)

import Language.Haskell.TH (Q, Dec, stringE)
import Language.Haskell.TH.Name.CamelCase (varName, varCamelcaseName)
import Language.Haskell.TH.Lib.Extra (simpleValD)

import Database.Relational
  (Query, Update, Insert, InsertQuery, Delete,
   untypeQuery, UntypeableNoFetch (untypeNoFetch))


inlineSQL_ :: (String -> Q ()) -- ^ action to check SQL string
           -> String           -- ^ SQL String
           -> String           -- ^ Variable name to define as inlined SQL
           -> Q [Dec]          -- ^ Result declarations
inlineSQL_ :: (String -> Q ()) -> String -> String -> Q [Dec]
inlineSQL_ String -> Q ()
check String
sql String
declName = do
  String -> Q ()
check String
sql
  Name -> TypeQ -> ExpQ -> Q [Dec]
simpleValD (VarName -> Name
varName forall a b. (a -> b) -> a -> b
$ String -> VarName
varCamelcaseName String
declName)
    [t| ShortByteString |]
    [| toShort $ T.encodeUtf8 $ T.pack $(stringE sql) |]
    -- IsString instance of ShortByteString type does not handle multi-byte characters.

inlineQuery_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())
             -> Query p a        -- ^ query to inline
             -> String           -- ^ Variable name to define as inlined query
             -> Q [Dec]          -- ^ Result declarations
inlineQuery_ :: forall p a. (String -> Q ()) -> Query p a -> String -> Q [Dec]
inlineQuery_ String -> Q ()
check Query p a
q String
declName = (String -> Q ()) -> String -> String -> Q [Dec]
inlineSQL_ String -> Q ()
check (forall p a. Query p a -> String
untypeQuery Query p a
q) String
declName

inlineNoFetch_ :: UntypeableNoFetch s
              => (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())
              -> s a              -- ^ statement to inline
              -> String           -- ^ Variable name to define as inlined query
              -> Q [Dec]          -- ^ Result declarations
inlineNoFetch_ :: forall (s :: * -> *) a.
UntypeableNoFetch s =>
(String -> Q ()) -> s a -> String -> Q [Dec]
inlineNoFetch_ String -> Q ()
check s a
q String
declName = (String -> Q ()) -> String -> String -> Q [Dec]
inlineSQL_ String -> Q ()
check (forall (s :: * -> *) p. UntypeableNoFetch s => s p -> String
untypeNoFetch s a
q) String
declName

inlineUpdate_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())
              -> Update p         -- ^ statement to inline
              -> String           -- ^ Variable name to define as inlined query
              -> Q [Dec]          -- ^ Result declarations
inlineUpdate_ :: forall p. (String -> Q ()) -> Update p -> String -> Q [Dec]
inlineUpdate_ = forall (s :: * -> *) a.
UntypeableNoFetch s =>
(String -> Q ()) -> s a -> String -> Q [Dec]
inlineNoFetch_

inlineInsertValue_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())
                   -> Insert p         -- ^ statement to inline
                   -> String           -- ^ Variable name to define as inlined query
                   -> Q [Dec]          -- ^ Result declarations
inlineInsertValue_ :: forall p. (String -> Q ()) -> Insert p -> String -> Q [Dec]
inlineInsertValue_ = forall (s :: * -> *) a.
UntypeableNoFetch s =>
(String -> Q ()) -> s a -> String -> Q [Dec]
inlineNoFetch_

inlineInsertQuery_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())
                   -> InsertQuery p    -- ^ statement to inline
                   -> String           -- ^ Variable name to define as inlined query
                   -> Q [Dec]          -- ^ Result declarations
inlineInsertQuery_ :: forall p. (String -> Q ()) -> InsertQuery p -> String -> Q [Dec]
inlineInsertQuery_ = forall (s :: * -> *) a.
UntypeableNoFetch s =>
(String -> Q ()) -> s a -> String -> Q [Dec]
inlineNoFetch_

inlineDelete_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())
              -> Delete p         -- ^ statement to inline
              -> String           -- ^ Variable name to define as inlined query
              -> Q [Dec]          -- ^ Result declarations
inlineDelete_ :: forall p. (String -> Q ()) -> Delete p -> String -> Q [Dec]
inlineDelete_ = forall (s :: * -> *) a.
UntypeableNoFetch s =>
(String -> Q ()) -> s a -> String -> Q [Dec]
inlineNoFetch_