{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}

-- | Print the types in Syntax as valid SQL.  The emphasis is on
-- queries to send to the database, not on legibilty; no extra whitespace is introduced.

module Preql.QuasiQuoter.Syntax.Printer where

import Preql.Imports
import Preql.QuasiQuoter.Syntax.Name
import Preql.QuasiQuoter.Syntax.Syntax as Syn hiding (select)

import Data.Data
import Data.List (intersperse)
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift(..))
import Prelude hiding (GT, LT, lex)

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Builder.Int as B
import qualified Data.Text.Lazy.Builder.RealFloat as B

quote :: B.Builder -> B.Builder
quote :: Builder -> Builder
quote Builder
s = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"

doubleQuote :: B.Builder -> B.Builder
doubleQuote :: Builder -> Builder
doubleQuote Builder
s = Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

parens :: B.Builder -> B.Builder
parens :: Builder -> Builder
parens Builder
s = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

parensIf :: Bool -> B.Builder -> B.Builder
parensIf :: Bool -> Builder -> Builder
parensIf Bool
cond Builder
inner = if Bool
cond then Builder -> Builder
parens Builder
inner else Builder
inner

spaceAfter :: B.Builder -> B.Builder
spaceAfter :: Builder -> Builder
spaceAfter = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ")

class FormatSql a where
    fmt :: a -> B.Builder
    fmt = Int -> a -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0

    fmtPrec :: Int -> a -> B.Builder
    fmtPrec Int
_ = a -> Builder
forall a. FormatSql a => a -> Builder
fmt

formatAsString :: FormatSql a => a -> String
formatAsString :: a -> String
formatAsString = Text -> String
TL.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. FormatSql a => a -> Builder
fmt

formatAsByteString :: FormatSql a => a -> ByteString
formatAsByteString :: a -> ByteString
formatAsByteString = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. FormatSql a => a -> Text
formatAsText

formatAsText :: FormatSql a => a -> T.Text
formatAsText :: a -> Text
formatAsText = Text -> Text
TL.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. FormatSql a => a -> Builder
fmt

instance FormatSql Name where
    -- TODO enclose keywoards &c in double quotes
    fmt :: Name -> Builder
fmt = Text -> Builder
B.fromText (Text -> Builder) -> (Name -> Text) -> Name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
getName

instance FormatSql Literal where
    fmt :: Literal -> Builder
fmt (I Word
i)     = Word -> Builder
forall a. Integral a => a -> Builder
B.decimal Word
i
    fmt (F Double
x)     = Double -> Builder
forall a. RealFloat a => a -> Builder
B.realFloat Double
x
    fmt (T Text
t)     = Builder -> Builder
quote (Text -> Builder
B.fromText Text
t)
    fmt (B Bool
True)  = Builder
"true"
    fmt (B Bool
False) = Builder
"false"
    fmt Literal
Null = Builder
"null"

instance FormatSql Statement where
    fmt :: Statement -> Builder
fmt (QI Insert
insert) = Insert -> Builder
forall a. FormatSql a => a -> Builder
fmt Insert
insert
    fmt (QD Delete
delete) = Delete -> Builder
forall a. FormatSql a => a -> Builder
fmt Delete
delete
    fmt (QU Update
update) = Update -> Builder
forall a. FormatSql a => a -> Builder
fmt Update
update
    fmt (QS SelectStmt
select) = SelectStmt -> Builder
forall a. FormatSql a => a -> Builder
fmt SelectStmt
select

commas :: (FormatSql a, Foldable f) => f a -> B.Builder
commas :: f a -> Builder
commas = Builder -> f a -> Builder
forall a (f :: * -> *).
(FormatSql a, Foldable f) =>
Builder -> f a -> Builder
fmtList Builder
", "

spaces :: (FormatSql a, Foldable f) => f a -> B.Builder
spaces :: f a -> Builder
spaces = Builder -> f a -> Builder
forall a (f :: * -> *).
(FormatSql a, Foldable f) =>
Builder -> f a -> Builder
fmtList Builder
" "

fmtList :: (FormatSql a, Foldable f) => B.Builder -> f a -> B.Builder
fmtList :: Builder -> f a -> Builder
fmtList Builder
sep f a
as = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
sep ((a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall a. FormatSql a => a -> Builder
fmt (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
as)))

unlessEmpty :: (B.Builder -> B.Builder) -> B.Builder -> B.Builder
unlessEmpty :: (Builder -> Builder) -> Builder -> Builder
unlessEmpty Builder -> Builder
_ Builder
"" = Builder
""
unlessEmpty Builder -> Builder
f Builder
x = Builder -> Builder
f Builder
x

optList :: FormatSql a => B.Builder -> [a] -> B.Builder
optList :: Builder -> [a] -> Builder
optList Builder
_ [] = Builder
""
optList Builder
prepend [a]
as = Builder
prepend Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [a] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [a]
as

-- TODO replace all calls to @opt@ with @opt'@, rename
opt :: FormatSql a => B.Builder -> Maybe a -> B.Builder
opt :: Builder -> Maybe a -> Builder
opt Builder
_ Maybe a
Nothing = Builder
""
opt Builder
prepend (Just a
a) = Builder
prepend Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. FormatSql a => a -> Builder
fmt a
a

opt' :: FormatSql a => B.Builder -> Int -> Maybe a -> B.Builder
opt' :: Builder -> Int -> Maybe a -> Builder
opt' Builder
_ Int
_ Maybe a
Nothing = Builder
""
opt' Builder
prepend Int
p (Just a
a) = Builder
prepend Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> a -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
p a
a

instance FormatSql B.Builder where
    fmt :: Builder -> Builder
fmt = Builder -> Builder
forall a. a -> a
id

instance FormatSql Insert where
    fmt :: Insert -> Builder
fmt Insert{Name
$sel:table:Insert :: Insert -> Name
table :: Name
table, NonEmpty Name
$sel:columns:Insert :: Insert -> NonEmpty Name
columns :: NonEmpty Name
columns, NonEmpty Expr
$sel:values:Insert :: Insert -> NonEmpty Expr
values :: NonEmpty Expr
values} =
        Builder
"INSERT INTO " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
table Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Name -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas NonEmpty Name
columns Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
") VALUES (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Expr -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas NonEmpty Expr
values Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

instance FormatSql Delete where
    fmt :: Delete -> Builder
fmt Delete{Name
$sel:table:Delete :: Delete -> Name
table :: Name
table, Maybe Expr
$sel:conditions:Delete :: Delete -> Maybe Expr
conditions :: Maybe Expr
conditions} = Builder
"DELETE FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
table Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
wh where
      wh :: Builder
wh = case Maybe Expr
conditions of
          Maybe Expr
Nothing         -> Builder
""
          Just Expr
conditions' -> Builder
" WHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
conditions'

instance FormatSql Setting where
    fmt :: Setting -> Builder
fmt (Setting Name
column Expr
rhs) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
column Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
rhs

instance FormatSql Update where
    fmt :: Update -> Builder
fmt Update{Name
$sel:table:Update :: Update -> Name
table :: Name
table, NonEmpty Setting
$sel:settings:Update :: Update -> NonEmpty Setting
settings :: NonEmpty Setting
settings, Maybe Expr
$sel:conditions:Update :: Update -> Maybe Expr
conditions :: Maybe Expr
conditions} =
        Builder
"UPDATE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
table Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" SET " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Setting -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas NonEmpty Setting
settings Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
wh
      where wh :: Builder
wh = case Maybe Expr
conditions of
                Maybe Expr
Nothing         -> Builder
""
                Just Expr
conditions' -> Builder
" WHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
conditions'

instance FormatSql Expr where
    fmtPrec :: Int -> Expr -> Builder
fmtPrec Int
_ (Lit Literal
lit)  = Literal -> Builder
forall a. FormatSql a => a -> Builder
fmt Literal
lit
    fmtPrec Int
_ (CRef Name
name) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name
    fmtPrec Int
_ (NumberedParam Word
i) = String -> Builder
B.fromString (Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
: Word -> String
forall a. Show a => a -> String
show Word
i)
    fmtPrec Int
_ (HaskellParam Text
txt) = Builder
"${" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
txt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
    fmtPrec Int
p (BinOp BinOp
op Expr
l Expr
r) = let (Assoc
assoc, Int
p1) = BinOp -> (Assoc, Int)
binOpPrec BinOp
op
      in Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
p1) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ case Assoc
assoc of
          Assoc
LeftAssoc -> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
p1 Expr
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BinOp -> Builder
forall a. FormatSql a => a -> Builder
fmt BinOp
op Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Expr
r
          Assoc
RightAssoc -> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Expr
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BinOp -> Builder
forall a. FormatSql a => a -> Builder
fmt BinOp
op Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
p1 Expr
r
          Assoc
NonAssoc -> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Expr
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BinOp -> Builder
forall a. FormatSql a => a -> Builder
fmt BinOp
op Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Expr
r
    fmtPrec Int
p (Unary UnaryOp
op Expr
expr) = case UnaryOp
op of
        UnaryOp
Negate -> Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15) (Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>  Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
15 Expr
expr)
        UnaryOp
Not -> Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (Builder
"NOT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
5 Expr
expr)
        UnaryOp
IsNull -> Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7) (Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
8 Expr
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" IS NULL")
        UnaryOp
NotNull -> Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7) (Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
8 Expr
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" IS NOT NULL")
    -- This looks funky, but seems to match the parser
    fmtPrec Int
_ (Indirection Expr
e NonEmpty Name
indirects) =
      let m_parens :: Builder -> Builder
m_parens = case Expr
e of
            NumberedParam Word
_ -> Builder -> Builder
forall a. a -> a
id
            CRef Name
_ -> Builder -> Builder
forall a. a -> a
id
            Expr
_ -> Builder -> Builder
parens
      in Builder -> Builder
m_parens (Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
e) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Name -> Builder
forall (f :: * -> *). Foldable f => f Name -> Builder
fmtIndirections NonEmpty Name
indirects
    fmtPrec Int
_ (SelectExpr SelectStmt
stmt) = Builder -> Builder
parens (SelectStmt -> Builder
forall a. FormatSql a => a -> Builder
fmt SelectStmt
stmt)
    fmtPrec Int
p (L LikeE
likeE) = Int -> LikeE -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
p LikeE
likeE
    fmtPrec Int
_ (Fun FunctionApplication
f) = FunctionApplication -> Builder
forall a. FormatSql a => a -> Builder
fmt FunctionApplication
f
    fmtPrec Int
_ (Cas Case
c) = Case -> Builder
forall a. FormatSql a => a -> Builder
fmt Case
c

fmtIndirections :: Foldable f => f Indirection -> TLB.Builder
fmtIndirections :: f Name -> Builder
fmtIndirections = (Name -> Builder) -> f Name -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Name -> Builder) -> Name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Builder
forall a. FormatSql a => a -> Builder
fmt)

instance FormatSql BinOp where
    fmt :: BinOp -> Builder
fmt BinOp
op = case BinOp
op of
        BinOp
Mul      -> Builder
"*"
        BinOp
Div      -> Builder
"/"
        BinOp
Add      -> Builder
"+"
        BinOp
Sub      -> Builder
"-"
        BinOp
Exponent -> Builder
"^"
        BinOp
Mod -> Builder
"%"
        BinOp
Eq    -> Builder
"="
        BinOp
LT    -> Builder
"<"
        BinOp
LTE   -> Builder
"<="
        BinOp
GT    -> Builder
">"
        BinOp
GTE   -> Builder
">="
        BinOp
NEq   -> Builder
"!="
        BinOp
IsDistinctFrom -> Builder
"IS DISTINCT FROM"
        BinOp
IsNotDistinctFrom -> Builder
"IS NOT DISTINCT FROM"
        BinOp
And -> Builder
"AND"
        BinOp
Or -> Builder
"OR"

data Assoc = LeftAssoc | RightAssoc | NonAssoc
  deriving (Int -> Assoc -> String -> String
[Assoc] -> String -> String
Assoc -> String
(Int -> Assoc -> String -> String)
-> (Assoc -> String) -> ([Assoc] -> String -> String) -> Show Assoc
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Assoc] -> String -> String
$cshowList :: [Assoc] -> String -> String
show :: Assoc -> String
$cshow :: Assoc -> String
showsPrec :: Int -> Assoc -> String -> String
$cshowsPrec :: Int -> Assoc -> String -> String
Show, Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c== :: Assoc -> Assoc -> Bool
Eq, Int -> Assoc
Assoc -> Int
Assoc -> [Assoc]
Assoc -> Assoc
Assoc -> Assoc -> [Assoc]
Assoc -> Assoc -> Assoc -> [Assoc]
(Assoc -> Assoc)
-> (Assoc -> Assoc)
-> (Int -> Assoc)
-> (Assoc -> Int)
-> (Assoc -> [Assoc])
-> (Assoc -> Assoc -> [Assoc])
-> (Assoc -> Assoc -> [Assoc])
-> (Assoc -> Assoc -> Assoc -> [Assoc])
-> Enum Assoc
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Assoc -> Assoc -> Assoc -> [Assoc]
$cenumFromThenTo :: Assoc -> Assoc -> Assoc -> [Assoc]
enumFromTo :: Assoc -> Assoc -> [Assoc]
$cenumFromTo :: Assoc -> Assoc -> [Assoc]
enumFromThen :: Assoc -> Assoc -> [Assoc]
$cenumFromThen :: Assoc -> Assoc -> [Assoc]
enumFrom :: Assoc -> [Assoc]
$cenumFrom :: Assoc -> [Assoc]
fromEnum :: Assoc -> Int
$cfromEnum :: Assoc -> Int
toEnum :: Int -> Assoc
$ctoEnum :: Int -> Assoc
pred :: Assoc -> Assoc
$cpred :: Assoc -> Assoc
succ :: Assoc -> Assoc
$csucc :: Assoc -> Assoc
Enum, Assoc
Assoc -> Assoc -> Bounded Assoc
forall a. a -> a -> Bounded a
maxBound :: Assoc
$cmaxBound :: Assoc
minBound :: Assoc
$cminBound :: Assoc
Bounded, Typeable Assoc
DataType
Constr
Typeable Assoc
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Assoc -> c Assoc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Assoc)
-> (Assoc -> Constr)
-> (Assoc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Assoc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc))
-> ((forall b. Data b => b -> b) -> Assoc -> Assoc)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r)
-> (forall u. (forall d. Data d => d -> u) -> Assoc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Assoc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Assoc -> m Assoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assoc -> m Assoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assoc -> m Assoc)
-> Data Assoc
Assoc -> DataType
Assoc -> Constr
(forall b. Data b => b -> b) -> Assoc -> Assoc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Assoc -> u
forall u. (forall d. Data d => d -> u) -> Assoc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Assoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc)
$cNonAssoc :: Constr
$cRightAssoc :: Constr
$cLeftAssoc :: Constr
$tAssoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Assoc -> m Assoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
gmapMp :: (forall d. Data d => d -> m d) -> Assoc -> m Assoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
gmapM :: (forall d. Data d => d -> m d) -> Assoc -> m Assoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
gmapQi :: Int -> (forall d. Data d => d -> u) -> Assoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Assoc -> u
gmapQ :: (forall d. Data d => d -> u) -> Assoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Assoc -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
gmapT :: (forall b. Data b => b -> b) -> Assoc -> Assoc
$cgmapT :: (forall b. Data b => b -> b) -> Assoc -> Assoc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Assoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Assoc)
dataTypeOf :: Assoc -> DataType
$cdataTypeOf :: Assoc -> DataType
toConstr :: Assoc -> Constr
$ctoConstr :: Assoc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
$cp1Data :: Typeable Assoc
Data, Assoc -> Q Exp
Assoc -> Q (TExp Assoc)
(Assoc -> Q Exp) -> (Assoc -> Q (TExp Assoc)) -> Lift Assoc
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Assoc -> Q (TExp Assoc)
$cliftTyped :: Assoc -> Q (TExp Assoc)
lift :: Assoc -> Q Exp
$clift :: Assoc -> Q Exp
Lift, (forall x. Assoc -> Rep Assoc x)
-> (forall x. Rep Assoc x -> Assoc) -> Generic Assoc
forall x. Rep Assoc x -> Assoc
forall x. Assoc -> Rep Assoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Assoc x -> Assoc
$cfrom :: forall x. Assoc -> Rep Assoc x
Generic)

binOpPrec :: BinOp -> (Assoc, Int)
binOpPrec :: BinOp -> (Assoc, Int)
binOpPrec BinOp
op = case BinOp
op of
  BinOp
Or -> (Assoc
LeftAssoc, Int
3)
  BinOp
And -> (Assoc
LeftAssoc, Int
4)
  BinOp
IsDistinctFrom -> (Assoc
NonAssoc, Int
7)
  BinOp
IsNotDistinctFrom -> (Assoc
NonAssoc, Int
7)
  BinOp
Eq -> (Assoc
NonAssoc, Int
8)
  BinOp
LT -> (Assoc
NonAssoc, Int
8)
  BinOp
LTE -> (Assoc
NonAssoc, Int
8)
  BinOp
GT -> (Assoc
NonAssoc, Int
8)
  BinOp
GTE -> (Assoc
NonAssoc, Int
8)
  BinOp
NEq -> (Assoc
NonAssoc, Int
8)
  BinOp
Add -> (Assoc
LeftAssoc, Int
12)
  BinOp
Sub -> (Assoc
LeftAssoc, Int
12)
  BinOp
Mul -> (Assoc
LeftAssoc, Int
13)
  BinOp
Div -> (Assoc
LeftAssoc, Int
13)
  BinOp
Mod -> (Assoc
LeftAssoc, Int
13)
  BinOp
Exponent -> (Assoc
LeftAssoc, Int
14)

setOpPrec :: SetOp -> Int
setOpPrec :: SetOp -> Int
setOpPrec SetOp
op = case SetOp
op of
  SetOp
Union -> Int
1
  SetOp
Except -> Int
1
  SetOp
Intersect -> Int
2

instance FormatSql LikeE where
  -- Expr L puts parens around if needed
    fmtPrec :: Int -> LikeE -> Builder
fmtPrec Int
p LikeE{LikeOp
$sel:op:LikeE :: LikeE -> LikeOp
op :: LikeOp
op, Expr
$sel:string:LikeE :: LikeE -> Expr
string :: Expr
string, Expr
$sel:likePattern:LikeE :: LikeE -> Expr
likePattern :: Expr
likePattern, Maybe Expr
$sel:escape:LikeE :: LikeE -> Maybe Expr
escape :: Maybe Expr
escape, Bool
$sel:invert:LikeE :: LikeE -> Bool
invert :: Bool
invert} = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
likePrec) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
        Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
10 Expr
string Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
invert then Builder
" NOT" else Builder
"")
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
op' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
10 Expr
likePattern Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Int -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Int -> Maybe a -> Builder
opt' Builder
" ESCAPE " Int
10 Maybe Expr
escape
      where
        likePrec :: Int
likePrec = if Bool
invert then Int
5 else Int
9
        op' :: Builder
op' = case LikeOp
op of
              LikeOp
Like -> Builder
" LIKE "
              LikeOp
ILike -> Builder
" ILIKE "
              LikeOp
Similar -> Builder
" SIMILAR TO "

instance FormatSql SelectStmt where
    fmtPrec :: Int -> SelectStmt -> Builder
fmtPrec Int
_ (SelectValues NonEmpty (NonEmpty Expr)
values) = Builder
"VALUES " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Builder -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas ((NonEmpty Expr -> Builder)
-> NonEmpty (NonEmpty Expr) -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Builder -> Builder
parens (Builder -> Builder)
-> (NonEmpty Expr -> Builder) -> NonEmpty Expr -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Expr -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas) NonEmpty (NonEmpty Expr)
values)
    fmtPrec Int
_ (Simple Select
un) = Select -> Builder
forall a. FormatSql a => a -> Builder
fmt Select
un
    fmtPrec Int
p (S SelectStmt
ss SelectOptions
so) = let topLevel :: Builder
topLevel = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> SelectStmt -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
1 SelectStmt
ss Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SelectOptions -> Builder
forall a. FormatSql a => a -> Builder
fmt SelectOptions
so) in
      case SelectOptions -> Maybe WithClause
withClause SelectOptions
so of
        Maybe WithClause
Nothing -> Builder
topLevel
        Just WithClause
ctes -> WithClause -> Builder
forall a. FormatSql a => a -> Builder
fmt WithClause
ctes Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
topLevel
    fmtPrec Int
p (Set SetOp
op AllOrDistinct
distinct SelectStmt
l SelectStmt
r) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
q) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
      Int -> SelectStmt -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
q SelectStmt
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SetOp -> Builder
forall a. FormatSql a => a -> Builder
fmt SetOp
op Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> SelectStmt -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SelectStmt
r
      where
        q :: Int
q = SetOp -> Int
setOpPrec SetOp
op
        d :: Builder
d = case AllOrDistinct
distinct of
                AllOrDistinct
All -> Builder
" ALL "
                AllOrDistinct
Distinct -> Builder
" "

instance FormatSql Select where
    fmt :: Select -> Builder
fmt Select{[ResTarget]
$sel:targetList:Select :: Select -> [ResTarget]
targetList :: [ResTarget]
targetList, [TableRef]
$sel:from:Select :: Select -> [TableRef]
from :: [TableRef]
from, Maybe DistinctClause
$sel:distinct:Select :: Select -> Maybe DistinctClause
distinct :: Maybe DistinctClause
distinct, Maybe Expr
$sel:whereClause:Select :: Select -> Maybe Expr
whereClause :: Maybe Expr
whereClause, [Expr]
$sel:groupBy:Select :: Select -> [Expr]
groupBy :: [Expr]
groupBy, Maybe Expr
$sel:having:Select :: Select -> Maybe Expr
having :: Maybe Expr
having, [WindowDef]
$sel:window:Select :: Select -> [WindowDef]
window :: [WindowDef]
window}
        = Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m_distinct Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas (ResTarget -> Builder
forall a. FormatSql a => a -> Builder
fmt (ResTarget -> Builder) -> [ResTarget] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResTarget]
targetList) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [TableRef] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [TableRef]
from
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
" WHERE " Maybe Expr
whereClause
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Expr] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" GROUP BY " [Expr]
groupBy
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
" HAVING " Maybe Expr
having
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [WindowDef] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" WINDOW " [WindowDef]
window
        where
          m_distinct :: Builder
m_distinct = Builder
-> (DistinctClause -> Builder) -> Maybe DistinctClause -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Builder -> Builder
spaceAfter (Builder -> Builder)
-> (DistinctClause -> Builder) -> DistinctClause -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistinctClause -> Builder
forall a. FormatSql a => a -> Builder
fmt) Maybe DistinctClause
distinct

instance FormatSql SelectOptions where
  -- ignore WithClause here; handle it in SelectStmt so we can put it before the top query
    fmt :: SelectOptions -> Builder
fmt SelectOptions{[SortBy]
$sel:sortBy:SelectOptions :: SelectOptions -> [SortBy]
sortBy :: [SortBy]
sortBy, Maybe Expr
$sel:offset:SelectOptions :: SelectOptions -> Maybe Expr
offset :: Maybe Expr
offset, Maybe Expr
$sel:limit:SelectOptions :: SelectOptions -> Maybe Expr
limit :: Maybe Expr
limit, [Locking]
$sel:locking:SelectOptions :: SelectOptions -> [Locking]
locking :: [Locking]
locking} =
        Builder -> [SortBy] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" ORDER BY " [SortBy]
sortBy
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder) -> Builder -> Builder
unlessEmpty (Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ([Locking] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
spaces [Locking]
locking) -- no commas
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
" LIMIT " Maybe Expr
limit
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
" OFFSET " Maybe Expr
offset

instance FormatSql WithClause where
  fmt :: WithClause -> Builder
fmt With {[CTE]
$sel:commonTables:With :: WithClause -> [CTE]
commonTables :: [CTE]
commonTables, Recursive
$sel:recursive:With :: WithClause -> Recursive
recursive :: Recursive
recursive} =
    Builder
"WITH" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
recursive' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [CTE] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [CTE]
commonTables
    where recursive' :: Builder
recursive' = case Recursive
recursive of
            Recursive
Recursive -> Builder
" RECURSIVE "
            Recursive
NotRecursive -> Builder
" "

instance FormatSql Materialized where
  fmt :: Materialized -> Builder
fmt Materialized
Materialized = Builder
"MATERIALIZED"
  fmt Materialized
NotMaterialized = Builder
"NOT MATERIALIZED"
  fmt Materialized
MaterializeDefault = Builder
""

instance FormatSql CTE where
  fmt :: CTE -> Builder
fmt CommonTableExpr {Name
$sel:name:CommonTableExpr :: CTE -> Name
name :: Name
name, [Name]
$sel:aliases:CommonTableExpr :: CTE -> [Name]
aliases :: [Name]
aliases, Materialized
$sel:materialized:CommonTableExpr :: CTE -> Materialized
materialized :: Materialized
materialized, Statement
$sel:query:CommonTableExpr :: CTE -> Statement
query :: Statement
query} =
    Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder) -> Builder -> Builder
unlessEmpty Builder -> Builder
parens ([Name] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [Name]
aliases)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder) -> Builder -> Builder
unlessEmpty Builder -> Builder
forall a. (Semigroup a, IsString a) => a -> a
spacesAround (Materialized -> Builder
forall a. FormatSql a => a -> Builder
fmt Materialized
materialized) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Statement -> Builder
forall a. FormatSql a => a -> Builder
fmt Statement
query)
    where
      spacesAround :: a -> a
spacesAround a
s = a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" "

instance FormatSql TableRef where
    fmtPrec :: Int -> TableRef -> Builder
fmtPrec Int
p (J JoinedTable
jt) = Int -> JoinedTable -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
p JoinedTable
jt
    fmtPrec Int
p (As JoinedTable
jt Alias
alias) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> JoinedTable -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
1 JoinedTable
jt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall a. FormatSql a => a -> Builder
fmt Alias
alias
    fmtPrec Int
_ (SubSelect SelectStmt
stmt Alias
alias) = Builder -> Builder
parens (SelectStmt -> Builder
forall a. FormatSql a => a -> Builder
fmt SelectStmt
stmt) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall a. FormatSql a => a -> Builder
fmt Alias
alias

instance FormatSql Alias where
    fmt :: Alias -> Builder
fmt (Alias Name
name []) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name
    fmt (Alias Name
name [Name]
columns) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens ([Name] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [Name]
columns)

instance FormatSql JoinedTable where
    fmtPrec :: Int -> JoinedTable -> Builder
fmtPrec Int
_ (Table Name
name) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name
    fmtPrec Int
p (CrossJoin TableRef
l TableRef
r) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 TableRef
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" CROSS JOIN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
1 TableRef
r
    fmtPrec Int
p (Join JoinType
Inner JoinQual
Natural TableRef
l TableRef
r) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 TableRef
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" NATURAL JOIN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
1 TableRef
r
    fmtPrec Int
p (Join JoinType
ty JoinQual
Natural TableRef
l TableRef
r) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 TableRef
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" NATURAL" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> JoinType -> Builder
forall a. FormatSql a => a -> Builder
fmt JoinType
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"JOIN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
1 TableRef
r
    fmtPrec Int
p (Join JoinType
ty (Using [Name]
cols) TableRef
l TableRef
r) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 TableRef
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> JoinType -> Builder
forall a. FormatSql a => a -> Builder
fmt JoinType
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" JOIN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
1 TableRef
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" USING " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens ([Name] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [Name]
cols)
    fmtPrec Int
p (Join JoinType
ty (On Expr
expr) TableRef
l TableRef
r) = Bool -> Builder -> Builder
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 TableRef
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> JoinType -> Builder
forall a. FormatSql a => a -> Builder
fmt JoinType
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" JOIN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> TableRef -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 TableRef
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ON " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Builder
forall a. FormatSql a => Int -> a -> Builder
fmtPrec Int
0 Expr
expr

instance FormatSql JoinType where
    fmt :: JoinType -> Builder
fmt JoinType
Inner = Builder
" INNER "
    fmt JoinType
LeftJoin = Builder
" LEFT "
    fmt JoinType
RightJoin = Builder
" RIGHT "
    fmt JoinType
Full = Builder
" FULL "

instance FormatSql DistinctClause where
    fmt :: DistinctClause -> Builder
fmt DistinctClause
DistinctAll = Builder
"DISTINCT"
    fmt (DistinctOn NonEmpty Expr
expr) = Builder
"DISTINCT ON " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (NonEmpty Expr -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas NonEmpty Expr
expr)

instance FormatSql SortBy where
    fmt :: SortBy -> Builder
fmt (SortBy Expr
expr SortOrderOrUsing
order NullsOrder
nulls) = Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SortOrderOrUsing -> Builder
forall a. FormatSql a => a -> Builder
fmt SortOrderOrUsing
order Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NullsOrder -> Builder
forall a. FormatSql a => a -> Builder
fmt NullsOrder
nulls

instance FormatSql SortOrderOrUsing where
    fmt :: SortOrderOrUsing -> Builder
fmt (SortOrder SortOrder
order) = SortOrder -> Builder
forall a. FormatSql a => a -> Builder
fmt SortOrder
order
    fmt (SortUsing BinOp
op) = Builder
"USING " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BinOp -> Builder
forall a. FormatSql a => a -> Builder
fmt BinOp
op

instance FormatSql SortOrder where
    -- leading space
    fmt :: SortOrder -> Builder
fmt SortOrder
Ascending = Builder
" ASC"
    fmt SortOrder
Descending = Builder
" DESC"
    fmt SortOrder
DefaultSortOrder = Builder
""

instance FormatSql NullsOrder where
    -- leading space
    fmt :: NullsOrder -> Builder
fmt NullsOrder
NullsFirst = Builder
" NULLS FIRST"
    fmt NullsOrder
NullsLast = Builder
" NULLS LAST"
    fmt NullsOrder
NullsOrderDefault = Builder
""

instance FormatSql Locking where
    fmt :: Locking -> Builder
fmt Locking{LockingStrength
$sel:strength:Locking :: Locking -> LockingStrength
strength :: LockingStrength
strength, [Name]
$sel:tables:Locking :: Locking -> [Name]
tables :: [Name]
tables, LockWait
$sel:wait:Locking :: Locking -> LockWait
wait :: LockWait
wait} =
        Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LockingStrength -> Builder
forall a. FormatSql a => a -> Builder
fmt LockingStrength
strength Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Name] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" OF " [Name]
tables Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LockWait -> Builder
forall a. FormatSql a => a -> Builder
fmt LockWait
wait

instance FormatSql LockingStrength where
    fmt :: LockingStrength -> Builder
fmt LockingStrength
ForUpdate = Builder
"FOR UPDATE"
    fmt LockingStrength
ForNoKeyUpdate = Builder
"FOR NO KEY UPDATE"
    fmt LockingStrength
ForShare = Builder
"FOR SHARE"
    fmt LockingStrength
ForKeyShare = Builder
"FOR KEY SHARE"

instance FormatSql LockWait where
    fmt :: LockWait -> Builder
fmt LockWait
LockWaitError = Builder
"NOWAIT"
    fmt LockWait
LockWaitSkip = Builder
"SKIP LOCKED"
    fmt LockWait
LockWaitBlock = Builder
""

instance FormatSql SetOp where
    fmt :: SetOp -> Builder
fmt SetOp
Union = Builder
"UNION"
    fmt SetOp
Intersect = Builder
"INTERSECT"
    fmt SetOp
Except = Builder
"EXCEPT"

instance FormatSql ResTarget where
    fmt :: ResTarget -> Builder
fmt ResTarget
Star = Builder
"*"
    fmt (Column Expr
expr Maybe Name
Nothing) = Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
expr
    fmt (Column Expr
expr (Just Name
name)) = Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name

-- instance FormatSql ColumnRef where
--     fmt ColumnRef {value, name} = fmt value <> case name of
--         Nothing -> ""
--         Just n -> "." <> fmt n

instance FormatSql WindowDef where
  fmt :: WindowDef -> Builder
fmt (WindowDef Name
name WindowSpec
spec) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WindowSpec -> Builder
forall a. FormatSql a => a -> Builder
fmt WindowSpec
spec

instance FormatSql WindowSpec where
    fmt :: WindowSpec -> Builder
fmt WindowSpec { Maybe Name
$sel:refName:WindowSpec :: WindowSpec -> Maybe Name
refName :: Maybe Name
refName, [Expr]
$sel:partitionClause:WindowSpec :: WindowSpec -> [Expr]
partitionClause :: [Expr]
partitionClause, [SortBy]
$sel:orderClause:WindowSpec :: WindowSpec -> [SortBy]
orderClause :: [SortBy]
orderClause }
        = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
m_refName, Builder
m_partition, Builder
m_order ] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")" where
      m_refName :: Builder
m_refName = Builder -> (Name -> Builder) -> Maybe Name -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Maybe Name
refName
      m_partition :: Builder
m_partition = case [Expr]
partitionClause of
          [] -> Builder
""
          [Expr]
_ -> Builder
" PARTITION BY " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas (Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt (Expr -> Builder) -> [Expr] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
partitionClause)
      m_order :: Builder
m_order = case [SortBy]
orderClause of
          [] -> Builder
""
          [SortBy]
_ -> Builder
" ORDER BY " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas (SortBy -> Builder
forall a. FormatSql a => a -> Builder
fmt (SortBy -> Builder) -> [SortBy] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SortBy]
orderClause)

instance FormatSql FunctionApplication where
  fmt :: FunctionApplication -> Builder
fmt FApp {[Name]
[SortBy]
Maybe Expr
Name
FunctionArguments
Over
$sel:over:FApp :: FunctionApplication -> Over
$sel:filterClause:FApp :: FunctionApplication -> Maybe Expr
$sel:withinGroup:FApp :: FunctionApplication -> [SortBy]
$sel:arguments:FApp :: FunctionApplication -> FunctionArguments
$sel:indirection:FApp :: FunctionApplication -> [Name]
$sel:name:FApp :: FunctionApplication -> Name
over :: Over
filterClause :: Maybe Expr
withinGroup :: [SortBy]
arguments :: FunctionArguments
indirection :: [Name]
name :: Name
..} = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Name] -> Builder
forall (f :: * -> *). Foldable f => f Name -> Builder
fmtIndirections [Name]
indirection
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FunctionArguments -> Builder
forall a. FormatSql a => a -> Builder
fmt FunctionArguments
arguments  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
withinGroup'
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Expr -> Builder) -> Maybe Expr -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (\Expr
fc -> Builder
" FILTER " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Builder
"WHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
fc)) Maybe Expr
filterClause
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
over'
    where
      withinGroup' :: Builder
withinGroup' = case [SortBy]
withinGroup of
        [] -> Builder
""
        [SortBy]
_ -> Builder
"WITHIN GROUP " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Builder
"ORDER BY " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SortBy] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas [SortBy]
withinGroup)
      over' :: Builder
over' = case Over
over of
        (Window (WindowSpec Maybe Name
Nothing [] [])) -> Builder
""
        (WindowName Name
alias) -> Builder
"OVER " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
alias
        Window WindowSpec {Maybe Name
refName :: Maybe Name
$sel:refName:WindowSpec :: WindowSpec -> Maybe Name
refName, [Expr]
partitionClause :: [Expr]
$sel:partitionClause:WindowSpec :: WindowSpec -> [Expr]
partitionClause, [SortBy]
orderClause :: [SortBy]
$sel:orderClause:WindowSpec :: WindowSpec -> [SortBy]
orderClause} ->
          Builder
"OVER " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens
              (Builder -> Maybe Name -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
"" Maybe Name
refName
               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Expr] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" PARTITION BY " [Expr]
partitionClause
               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [SortBy] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" ORDER BY " [SortBy]
orderClause)

instance FormatSql FunctionArguments where
  fmt :: FunctionArguments -> Builder
fmt FunctionArguments
StarArg = Builder
"(*)"
  fmt FunctionArguments
NoArgs = Builder
"()"
  fmt (Args ArgsList{Bool
[SortBy]
NonEmpty Argument
$sel:distinct:ArgsList :: ArgsList -> Bool
$sel:sortBy:ArgsList :: ArgsList -> [SortBy]
$sel:arguments:ArgsList :: ArgsList -> NonEmpty Argument
distinct :: Bool
sortBy :: [SortBy]
arguments :: NonEmpty Argument
..}) = Builder -> Builder
parens (Builder
distinct' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Argument -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
commas NonEmpty Argument
arguments Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sortBy') where
    distinct' :: Builder
distinct' = if Bool
distinct then Builder
"DISTINCT " else Builder
""
    sortBy' :: Builder
sortBy' = Builder -> [SortBy] -> Builder
forall a. FormatSql a => Builder -> [a] -> Builder
optList Builder
" ORDER BY " [SortBy]
sortBy

instance FormatSql Argument where
  fmt :: Argument -> Builder
fmt (E Expr
e) = Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
e
  fmt (Named Name
name Expr
e) = Name -> Builder
forall a. FormatSql a => a -> Builder
fmt Name
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" => " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
e

instance FormatSql Case where
  fmt :: Case -> Builder
fmt Case { [(Expr, Expr)]
$sel:whenClause:Case :: Case -> [(Expr, Expr)]
whenClause :: [(Expr, Expr)]
whenClause, Maybe Expr
$sel:implicitArg:Case :: Case -> Maybe Expr
implicitArg :: Maybe Expr
implicitArg, Maybe Expr
$sel:elseClause:Case :: Case -> Maybe Expr
elseClause :: Maybe Expr
elseClause } =
   Builder
"CASE" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
" " Maybe Expr
implicitArg Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
whenClauses' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Expr -> Builder
forall a. FormatSql a => Builder -> Maybe a -> Builder
opt Builder
" ELSE " Maybe Expr
elseClause Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" END"
    where whenClauses' :: Builder
whenClauses' = [Builder] -> Builder
forall a (f :: * -> *). (FormatSql a, Foldable f) => f a -> Builder
spaces [ Builder
" WHEN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
condition Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" THEN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
forall a. FormatSql a => a -> Builder
fmt Expr
result
                                | (Expr
condition, Expr
result) <- [(Expr, Expr)]
whenClause ]