{-# LANGUAGE
AllowAmbiguousTypes
, ConstraintKinds
, FlexibleContexts
, LambdaCase
, MagicHash
, OverloadedStrings
, PolyKinds
, RankNTypes
, ScopedTypeVariables
, TypeApplications
#-}
module Squeal.PostgreSQL.Render
(
RenderSQL (..)
, printSQL
, escape
, parenthesized
, bracketed
, (<+>)
, commaSeparated
, doubleQuoted
, singleQuotedText
, singleQuotedUtf8
, escapeQuotedString
, escapeQuotedText
, renderCommaSeparated
, renderCommaSeparatedConstraint
, renderCommaSeparatedMaybe
, renderNat
, renderSymbol
) where
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (ByteString)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Generics.SOP
import GHC.Exts
import GHC.TypeLits hiding (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
parenthesized :: ByteString -> ByteString
parenthesized :: ByteString -> ByteString
parenthesized ByteString
str = ByteString
"(" forall a. Semigroup a => a -> a -> a
<> ByteString
str forall a. Semigroup a => a -> a -> a
<> ByteString
")"
bracketed :: ByteString -> ByteString
bracketed :: ByteString -> ByteString
bracketed ByteString
str = ByteString
"[" forall a. Semigroup a => a -> a -> a
<> ByteString
str forall a. Semigroup a => a -> a -> a
<> ByteString
"]"
(<+>) :: ByteString -> ByteString -> ByteString
infixr 7 <+>
ByteString
str1 <+> :: ByteString -> ByteString -> ByteString
<+> ByteString
str2 = ByteString
str1 forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> ByteString
str2
commaSeparated :: [ByteString] -> ByteString
commaSeparated :: [ByteString] -> ByteString
commaSeparated = ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
", "
doubleQuoted :: ByteString -> ByteString
doubleQuoted :: ByteString -> ByteString
doubleQuoted ByteString
str = ByteString
"\"" forall a. Semigroup a => a -> a -> a
<> ByteString
str forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
singleQuotedText :: Text -> ByteString
singleQuotedText :: Text -> ByteString
singleQuotedText Text
str =
ByteString
"'" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
Text.encodeUtf8 (Text -> Text -> Text -> Text
Text.replace Text
"'" Text
"''" Text
str) forall a. Semigroup a => a -> a -> a
<> ByteString
"'"
singleQuotedUtf8 :: ByteString -> ByteString
singleQuotedUtf8 :: ByteString -> ByteString
singleQuotedUtf8 = Text -> ByteString
singleQuotedText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
escapeQuotedString :: String -> ByteString
escapeQuotedString :: String -> ByteString
escapeQuotedString String
x = ByteString
"E\'" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
Text.encodeUtf8 (forall a. IsString a => String -> a
fromString (Char -> String
escape forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
x)) forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
escapeQuotedText :: Text -> ByteString
escapeQuotedText :: Text -> ByteString
escapeQuotedText Text
x =
ByteString
"E\'" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
Text.encodeUtf8 ((Char -> Text) -> Text -> Text
Text.concatMap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
escape) Text
x) forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
renderCommaSeparated
:: SListI xs
=> (forall x. expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated :: forall {k} (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall (x :: k). expression x -> ByteString
render
= [ByteString] -> ByteString
commaSeparated
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
(f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). expression x -> ByteString
render)
renderCommaSeparatedConstraint
:: forall c xs expression. (All c xs, SListI xs)
=> (forall x. c x => expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparatedConstraint :: forall {k} (c :: k -> Constraint) (xs :: [k])
(expression :: k -> *).
(All c xs, SListI xs) =>
(forall (x :: k). c x => expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparatedConstraint forall (x :: k). c x => expression x -> ByteString
render
= [ByteString] -> ByteString
commaSeparated
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
Proxy @c) (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). c x => expression x -> ByteString
render)
renderCommaSeparatedMaybe
:: SListI xs
=> (forall x. expression x -> Maybe ByteString)
-> NP expression xs -> ByteString
renderCommaSeparatedMaybe :: forall {k} (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> Maybe ByteString)
-> NP expression xs -> ByteString
renderCommaSeparatedMaybe forall (x :: k). expression x -> Maybe ByteString
render
= [ByteString] -> ByteString
commaSeparated
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
(f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). expression x -> Maybe ByteString
render)
renderNat :: forall n. KnownNat n => ByteString
renderNat :: forall (n :: Nat). KnownNat n => ByteString
renderNat = forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# n)))
renderSymbol :: forall s. KnownSymbol s => ByteString
renderSymbol :: forall (s :: Symbol). KnownSymbol s => ByteString
renderSymbol = forall a. IsString a => String -> a
fromString (forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# s))
class RenderSQL sql where renderSQL :: sql -> ByteString
printSQL :: (RenderSQL sql, MonadIO io) => sql -> io ()
printSQL :: forall sql (io :: * -> *).
(RenderSQL sql, MonadIO io) =>
sql -> io ()
printSQL = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
Char8.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql. RenderSQL sql => sql -> ByteString
renderSQL
escape :: Char -> String
escape :: Char -> String
escape = \case
Char
'\NUL' -> String
""
Char
'\'' -> String
"''"
Char
'"' -> String
"\\\""
Char
'\b' -> String
"\\b"
Char
'\n' -> String
"\\n"
Char
'\r' -> String
"\\r"
Char
'\t' -> String
"\\t"
Char
'\\' -> String
"\\\\"
Char
c -> [Char
c]