mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-09-11 08:55:25 +03:00
relational-query: add module to export SQL string representation for other systems.
This commit is contained in:
parent
3bad3ad72c
commit
21bf1f0acf
80
relational-query/src/Database/Relational/Export.hs
Normal file
80
relational-query/src/Database/Relational/Export.hs
Normal file
@ -0,0 +1,80 @@
|
||||
{-# 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_ check sql declName = do
|
||||
check sql
|
||||
simpleValD (varName $ varCamelcaseName 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_ check q declName = inlineSQL_ check (untypeQuery q) 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_ check q declName = inlineSQL_ check (untypeNoFetch q) 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_ = 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_ = 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_ = 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_ = inlineNoFetch_
|
Loading…
Reference in New Issue
Block a user