-- | These is the pretty printing functions, which produce SQL
-- source from ASTs. The code attempts to format the output in a
-- readable way.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Language.SQL.SimpleSQL.Pretty
    (prettyQueryExpr
    ,prettyScalarExpr
    ,prettyStatement
    ,prettyStatements
    ) where

{-
TODO: there should be more comments in this file, especially the bits
which have been changed to try to improve the layout of the output.
-}

import Prettyprinter (Doc
                     ,nest
                     ,punctuate
                     ,comma
                     ,squotes
                     ,vsep
                     ,layoutPretty
                     ,defaultLayoutOptions
                     ,brackets
                     ,align
                     ,hcat
                     ,line
                     )
import qualified Prettyprinter as P
import Prettyprinter.Internal.Type (Doc(Empty))

import Prettyprinter.Render.Text (renderStrict)

import Data.Maybe (maybeToList, catMaybes)

import qualified Data.Text as T
import Data.Text (Text)

import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.Dialect


-- | Convert a query expr ast to Text.
prettyQueryExpr :: Dialect -> QueryExpr -> Text
prettyQueryExpr :: Dialect -> QueryExpr -> Text
prettyQueryExpr Dialect
d = Doc Any -> Text
forall a. Doc a -> Text
render (Doc Any -> Text) -> (QueryExpr -> Doc Any) -> QueryExpr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dialect -> QueryExpr -> Doc Any
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d

-- | Convert a value expr ast to Text.
prettyScalarExpr :: Dialect -> ScalarExpr -> Text
prettyScalarExpr :: Dialect -> ScalarExpr -> Text
prettyScalarExpr Dialect
d = Doc Any -> Text
forall a. Doc a -> Text
render (Doc Any -> Text) -> (ScalarExpr -> Doc Any) -> ScalarExpr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dialect -> ScalarExpr -> Doc Any
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d

-- | A terminating semicolon.
terminator :: Doc a
terminator :: forall a. Doc a
terminator = Text -> Doc a
forall a. Text -> Doc a
pretty Text
";" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
line

-- | Convert a statement ast to Text.
prettyStatement :: Dialect -> Statement -> Text
prettyStatement :: Dialect -> Statement -> Text
prettyStatement Dialect
_ Statement
EmptyStatement = Doc Any -> Text
forall a. Doc a -> Text
render Doc Any
forall a. Doc a
terminator
prettyStatement Dialect
d Statement
s = Doc Any -> Text
forall a. Doc a -> Text
render (Dialect -> Statement -> Doc Any
forall a. Dialect -> Statement -> Doc a
statement Dialect
d Statement
s)

-- | Convert a list of statements to Text. A semicolon
-- is inserted after each statement.
prettyStatements :: Dialect -> [Statement] -> Text
prettyStatements :: Dialect -> [Statement] -> Text
prettyStatements Dialect
d = Doc Any -> Text
forall a. Doc a -> Text
render (Doc Any -> Text)
-> ([Statement] -> Doc Any) -> [Statement] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Any] -> Doc Any
forall ann. [Doc ann] -> Doc ann
vsep ([Doc Any] -> Doc Any)
-> ([Statement] -> [Doc Any]) -> [Statement] -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement -> Doc Any) -> [Statement] -> [Doc Any]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Doc Any
forall a. Statement -> Doc a
prettyStatementWithSemicolon
  where
    prettyStatementWithSemicolon :: Statement -> Doc a
    prettyStatementWithSemicolon :: forall a. Statement -> Doc a
prettyStatementWithSemicolon Statement
s = Dialect -> Statement -> Doc a
forall a. Dialect -> Statement -> Doc a
statement Dialect
d Statement
s Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
terminator

render :: Doc a -> Text
render :: forall a. Doc a -> Text
render = SimpleDocStream a -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream a -> Text)
-> (Doc a -> SimpleDocStream a) -> Doc a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc a -> SimpleDocStream a
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

-- = scalar expressions

scalarExpr :: Dialect -> ScalarExpr -> Doc a
scalarExpr :: forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
_ (StringLit Text
s Text
e Text
t) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
s Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
t Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
e

scalarExpr Dialect
_ (NumLit Text
s) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
s
scalarExpr Dialect
_ (IntervalLit Maybe Sign
s Text
v IntervalTypeField
f Maybe IntervalTypeField
t) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"interval"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (Sign -> Doc a) -> Maybe Sign -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\Sign
x -> Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> Text -> Doc a
forall a b. (a -> b) -> a -> b
$ case Sign
x of
                             Sign
Plus -> Text
"+"
                             Sign
Minus -> Text
"-") Maybe Sign
s
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
squotes (Text -> Doc a
forall a. Text -> Doc a
pretty Text
v)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> IntervalTypeField -> Doc a
forall a. IntervalTypeField -> Doc a
intervalTypeField IntervalTypeField
f
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (IntervalTypeField -> Doc a) -> Maybe IntervalTypeField -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\IntervalTypeField
x -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"to" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> IntervalTypeField -> Doc a
forall a. IntervalTypeField -> Doc a
intervalTypeField IntervalTypeField
x) Maybe IntervalTypeField
t
scalarExpr Dialect
_ (Iden [Name]
i) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
i
scalarExpr Dialect
_ ScalarExpr
Star = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"*"
scalarExpr Dialect
_ (QStar [Name]
nms) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nms Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
".*"
scalarExpr Dialect
_ ScalarExpr
Parameter = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"?"
scalarExpr Dialect
_ (PositionalArg Int
n) = Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> Text -> Doc a
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'$' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText Int
n
scalarExpr Dialect
_ (HostParameter Text
p Maybe Text
i) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
p
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (Text -> Doc a) -> Maybe Text -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\Text
i' -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"indicator" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
i') Maybe Text
i

scalarExpr Dialect
d (App [Name]
f [ScalarExpr]
es) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es))

scalarExpr Dialect
dia (AggregateApp [Name]
f SetQuantifier
d [ScalarExpr]
es [SortSpec]
od Maybe ScalarExpr
fil) =
    ([Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ((case SetQuantifier
d of
                  SetQuantifier
Distinct -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"distinct"
                  SetQuantifier
All -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"all"
                  SetQuantifier
SQDefault -> Doc a
forall a. Monoid a => a
mempty)
               Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia) [ScalarExpr]
es)
               Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> [SortSpec] -> Doc a
forall a. Dialect -> [SortSpec] -> Doc a
orderBy Dialect
dia [SortSpec]
od))
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\ScalarExpr
x -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"filter"
                  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty Text
"where" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
x)) Maybe ScalarExpr
fil

scalarExpr Dialect
d (AggregateAppGroup [Name]
f [ScalarExpr]
es [SortSpec]
od) =
    [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es))
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> if [SortSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SortSpec]
od
        then Doc a
forall a. Monoid a => a
mempty
        else Text -> Doc a
forall a. Text -> Doc a
pretty Text
"within group" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> [SortSpec] -> Doc a
forall a. Dialect -> [SortSpec] -> Doc a
orderBy Dialect
d [SortSpec]
od)

scalarExpr Dialect
d (WindowApp [Name]
f [ScalarExpr]
es [ScalarExpr]
pb [SortSpec]
od Maybe Frame
fr) =
    [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"over"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ((case [ScalarExpr]
pb of
                    [] -> Doc a
forall a. Monoid a => a
mempty
                    [ScalarExpr]
_ -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"partition by" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align
                                   ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
pb))
                Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> [SortSpec] -> Doc a
forall a. Dialect -> [SortSpec] -> Doc a
orderBy Dialect
d [SortSpec]
od
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (Frame -> Doc a) -> Maybe Frame -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me Frame -> Doc a
forall {a}. Frame -> Doc a
frd Maybe Frame
fr)
  where
    frd :: Frame -> Doc a
frd (FrameFrom FrameRows
rs FramePos
fp) = FrameRows -> Doc a
forall {a}. FrameRows -> Doc a
rsd FrameRows
rs Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> FramePos -> Doc a
forall {a}. FramePos -> Doc a
fpd FramePos
fp
    frd (FrameBetween FrameRows
rs FramePos
fps FramePos
fpe) =
        FrameRows -> Doc a
forall {a}. FrameRows -> Doc a
rsd FrameRows
rs Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"between" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> FramePos -> Doc a
forall {a}. FramePos -> Doc a
fpd FramePos
fps
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"and" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> FramePos -> Doc a
forall {a}. FramePos -> Doc a
fpd FramePos
fpe
    rsd :: FrameRows -> Doc a
rsd FrameRows
rs = case FrameRows
rs of
                 FrameRows
FrameRows -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"rows"
                 FrameRows
FrameRange -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"range"
    fpd :: FramePos -> Doc a
fpd FramePos
UnboundedPreceding = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"unbounded preceding"
    fpd FramePos
UnboundedFollowing = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"unbounded following"
    fpd FramePos
Current = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"current row"
    fpd (Preceding ScalarExpr
e) = Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"preceding"
    fpd (Following ScalarExpr
e) = Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"following"

scalarExpr Dialect
dia (SpecialOp [Name]
nm [ScalarExpr
a,ScalarExpr
b,ScalarExpr
c])
    | [Name]
nm [Name] -> [[Name]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Maybe (Text, Text) -> Text -> Name
Name Maybe (Text, Text)
forall a. Maybe a
Nothing Text
"between"]
                ,[Maybe (Text, Text) -> Text -> Name
Name Maybe (Text, Text)
forall a. Maybe a
Nothing Text
"not between"]] =
  [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
a
      ,[Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
nest (Text -> Int
T.length ([Name] -> Text
unnames [Name]
nm) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep
          [Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
b
          ,Text -> Doc a
forall a. Text -> Doc a
pretty Text
"and" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
c])]

scalarExpr Dialect
d (SpecialOp [Name Maybe (Text, Text)
Nothing Text
"rowctor"] [ScalarExpr]
as) =
    Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
as

scalarExpr Dialect
d (SpecialOp [Name]
nm [ScalarExpr]
es) =
  [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es)

scalarExpr Dialect
d (SpecialOpK [Name]
nm Maybe ScalarExpr
fs [(Text, ScalarExpr)]
as) =
    [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ [Maybe (Doc a)] -> [Doc a]
forall a. [Maybe a] -> [a]
catMaybes
        ((ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Maybe (Doc a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) Maybe ScalarExpr
fs
         Maybe (Doc a) -> [Maybe (Doc a)] -> [Maybe (Doc a)]
forall a. a -> [a] -> [a]
: ((Text, ScalarExpr) -> Maybe (Doc a))
-> [(Text, ScalarExpr)] -> [Maybe (Doc a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
n,ScalarExpr
e) -> Doc a -> Maybe (Doc a)
forall a. a -> Maybe a
Just (Text -> Doc a
forall a. Text -> Doc a
pretty Text
n Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e)) [(Text, ScalarExpr)]
as))

scalarExpr Dialect
d (PrefixOp [Name]
f ScalarExpr
e) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e
scalarExpr Dialect
d (PostfixOp [Name]
f ScalarExpr
e) = Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f
scalarExpr Dialect
d e :: ScalarExpr
e@(BinOp ScalarExpr
_ [Name]
op ScalarExpr
_) | [Name]
op [Name] -> [[Name]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Maybe (Text, Text) -> Text -> Name
Name Maybe (Text, Text)
forall a. Maybe a
Nothing Text
"and"]
                                         ,[Maybe (Text, Text) -> Text -> Name
Name Maybe (Text, Text)
forall a. Maybe a
Nothing Text
"or"]] =
    -- special case for and, or, get all the ands so we can vsep them
    -- nicely
    case ScalarExpr -> [ScalarExpr]
ands ScalarExpr
e of
      (ScalarExpr
e':[ScalarExpr]
es) -> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e'
                       Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (([Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
op Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+>) (Doc a -> Doc a) -> (ScalarExpr -> Doc a) -> ScalarExpr -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es)
      [] -> Doc a
forall a. Monoid a => a
mempty -- shouldn't be possible
  where
    ands :: ScalarExpr -> [ScalarExpr]
ands (BinOp ScalarExpr
a [Name]
op' ScalarExpr
b) | [Name]
op [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
op' = ScalarExpr -> [ScalarExpr]
ands ScalarExpr
a [ScalarExpr] -> [ScalarExpr] -> [ScalarExpr]
forall a. Semigroup a => a -> a -> a
<> ScalarExpr -> [ScalarExpr]
ands ScalarExpr
b
    ands ScalarExpr
x = [ScalarExpr
x]
-- special case for . we don't use whitespace
scalarExpr Dialect
d (BinOp ScalarExpr
e0 [Name Maybe (Text, Text)
Nothing Text
"."] ScalarExpr
e1) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e0 Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e1
scalarExpr Dialect
d (BinOp ScalarExpr
e0 [Name]
f ScalarExpr
e1) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e0 Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e1

scalarExpr Dialect
dia (Case Maybe ScalarExpr
t [([ScalarExpr], ScalarExpr)]
ws Maybe ScalarExpr
els) =
    [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ [Text -> Doc a
forall a. Text -> Doc a
pretty Text
"case" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia) Maybe ScalarExpr
t]
          [Doc a] -> [Doc a] -> [Doc a]
forall a. Semigroup a => a -> a -> a
<> (([ScalarExpr], ScalarExpr) -> Doc a)
-> [([ScalarExpr], ScalarExpr)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ([ScalarExpr], ScalarExpr) -> Doc a
forall {a}. ([ScalarExpr], ScalarExpr) -> Doc a
w [([ScalarExpr], ScalarExpr)]
ws
          [Doc a] -> [Doc a] -> [Doc a]
forall a. Semigroup a => a -> a -> a
<> Maybe (Doc a) -> [Doc a]
forall a. Maybe a -> [a]
maybeToList ((ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Maybe (Doc a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScalarExpr -> Doc a
forall {a}. ScalarExpr -> Doc a
e Maybe ScalarExpr
els)
          [Doc a] -> [Doc a] -> [Doc a]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc a
forall a. Text -> Doc a
pretty Text
"end"]
  where
    w :: ([ScalarExpr], ScalarExpr) -> Doc a
w ([ScalarExpr]
t0,ScalarExpr
t1) =
      Text -> Doc a
forall a. Text -> Doc a
pretty Text
"when" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [[Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia) [ScalarExpr]
t0
                                   ,Text -> Doc a
forall a. Text -> Doc a
pretty Text
"then" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
t1)])
    e :: ScalarExpr -> Doc a
e ScalarExpr
el = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"else" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
el)
scalarExpr Dialect
d (Parens ScalarExpr
e) =
    Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e)
scalarExpr Dialect
d (Cast ScalarExpr
e TypeName
tn) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"cast" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e
                                 ,Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as"
                                 ,TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
tn])

scalarExpr Dialect
_ (TypedLit TypeName
tn Text
s) =
    TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
tn Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
squotes (Text -> Doc a
forall a. Text -> Doc a
pretty Text
s)

scalarExpr Dialect
d (SubQueryExpr SubQueryExprType
ty QueryExpr
qe) =
    (case SubQueryExprType
ty of
        SubQueryExprType
SqSq -> Doc a
forall a. Monoid a => a
mempty
        SubQueryExprType
SqExists -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"exists"
        SubQueryExprType
SqUnique -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"unique"
    ) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
qe)

scalarExpr Dialect
d (QuantifiedComparison ScalarExpr
v [Name]
c CompPredQuantifier
cp QueryExpr
sq) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
c
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty (case CompPredQuantifier
cp of
                    CompPredQuantifier
CPAny -> Text
"any"
                    CompPredQuantifier
CPSome -> Text
"some"
                    CompPredQuantifier
CPAll -> Text
"all")
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
sq)

scalarExpr Dialect
d (Match ScalarExpr
v Bool
u QueryExpr
sq) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"match"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (if Bool
u then Text -> Doc a
forall a. Text -> Doc a
pretty Text
"unique" else Doc a
forall a. Monoid a => a
mempty)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
sq)

scalarExpr Dialect
d (In Bool
b ScalarExpr
se InPredValue
x) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
se Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+>
    (if Bool
b then Doc a
forall a. Monoid a => a
mempty else Text -> Doc a
forall a. Text -> Doc a
pretty Text
"not")
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"in"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (case InPredValue
x of
                     InList [ScalarExpr]
es -> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es
                     InQueryExpr QueryExpr
qe -> Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
qe)

scalarExpr Dialect
d (Array ScalarExpr
v [ScalarExpr]
es) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es)

scalarExpr Dialect
d (ArrayCtor QueryExpr
q) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"array" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q)

scalarExpr Dialect
d (MultisetCtor [ScalarExpr]
es) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"multiset" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
es)

scalarExpr Dialect
d (MultisetQueryCtor QueryExpr
q) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"multiset" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q)

scalarExpr Dialect
d (MultisetBinOp ScalarExpr
a SetOperatorName
c SetQuantifier
q ScalarExpr
b) =
    [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep
    [Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
a
    ,Text -> Doc a
forall a. Text -> Doc a
pretty Text
"multiset"
    ,Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> Text -> Doc a
forall a b. (a -> b) -> a -> b
$ case SetOperatorName
c of
                SetOperatorName
Union -> Text
"union"
                SetOperatorName
Intersect -> Text
"intersect"
                SetOperatorName
Except -> Text
"except"
    ,case SetQuantifier
q of
         SetQuantifier
SQDefault -> Doc a
forall a. Monoid a => a
mempty
         SetQuantifier
All -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"all"
         SetQuantifier
Distinct -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"distinct"
    ,Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
b]

{-scalarExpr d (Escape v e) =
    scalarExpr d v <+> pretty "escape" <+> pretty [e]

scalarExpr d (UEscape v e) =
    scalarExpr d v <+> pretty "uescape" <+> pretty [e]-}

scalarExpr Dialect
d (Collate ScalarExpr
v [Name]
c) =
    Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"collate" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
c

scalarExpr Dialect
_ (NextValueFor [Name]
ns) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"next value for" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
ns

scalarExpr Dialect
d (VEComment [Comment]
cmt ScalarExpr
v) =
    [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Comment -> Doc a) -> [Comment] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> Doc a
forall a. Comment -> Doc a
comment [Comment]
cmt [Doc a] -> [Doc a] -> [Doc a]
forall a. Semigroup a => a -> a -> a
<> [Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v]

scalarExpr Dialect
_ (OdbcLiteral OdbcLiteralType
t Text
s) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"{" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> OdbcLiteralType -> Doc a
forall {a}. OdbcLiteralType -> Doc a
lt OdbcLiteralType
t Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
squotes (Text -> Doc a
forall a. Text -> Doc a
pretty Text
s) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"}"
  where
    lt :: OdbcLiteralType -> Doc a
lt OdbcLiteralType
OLDate = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"d"
    lt OdbcLiteralType
OLTime = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"t"
    lt OdbcLiteralType
OLTimestamp = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"ts"

scalarExpr Dialect
d (OdbcFunc ScalarExpr
e) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"{fn" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"}"

scalarExpr Dialect
d (Convert TypeName
t ScalarExpr
e Maybe Integer
Nothing) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"convert(" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
t Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"," Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
")"
scalarExpr Dialect
d (Convert TypeName
t ScalarExpr
e (Just Integer
i)) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"convert(" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
t Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"," Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"," Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty (Integer -> Text
forall a. Show a => a -> Text
showText Integer
i) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
")"

unname :: Name -> Text
unname :: Name -> Text
unname (Name Maybe (Text, Text)
Nothing Text
n) = Text
n
unname (Name (Just (Text
s,Text
e)) Text
n) =
    Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e

unnames :: [Name] -> Text
unnames :: [Name] -> Text
unnames [Name]
ns = Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Text
unname [Name]
ns


name :: Name -> Doc a
name :: forall a. Name -> Doc a
name (Name Maybe (Text, Text)
Nothing Text
n) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
n
name (Name (Just (Text
s,Text
e)) Text
n) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
s Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
n Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a. Text -> Doc a
pretty Text
e

names :: [Name] -> Doc a
names :: forall a. [Name] -> Doc a
names [Name]
ns = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Text -> Doc a
forall a. Text -> Doc a
pretty Text
".") ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
ns

typeName :: TypeName -> Doc a
typeName :: forall a. TypeName -> Doc a
typeName (TypeName [Name]
t) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
typeName (PrecTypeName [Name]
t Integer
a) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> Text -> Doc a
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
showText Integer
a)
typeName (PrecScaleTypeName [Name]
t Integer
a Integer
b) =
    [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty (Integer -> Text
forall a. Show a => a -> Text
showText Integer
a) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall a. Doc a
comma Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty (Integer -> Text
forall a. Show a => a -> Text
showText Integer
b))
typeName (PrecLengthTypeName [Name]
t Integer
i Maybe PrecMultiplier
m Maybe PrecUnits
u) =
    [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty (Integer -> Text
forall a. Show a => a -> Text
showText Integer
i)
               Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> (PrecMultiplier -> Doc a) -> Maybe PrecMultiplier -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\case
                           PrecMultiplier
PrecK -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"K"
                           PrecMultiplier
PrecM -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"M"
                           PrecMultiplier
PrecG -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"G"
                           PrecMultiplier
PrecT -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"T"
                           PrecMultiplier
PrecP -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"P") Maybe PrecMultiplier
m
               Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (PrecUnits -> Doc a) -> Maybe PrecUnits -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\case
                       PrecUnits
PrecCharacters -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"CHARACTERS"
                       PrecUnits
PrecOctets -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"OCTETS") Maybe PrecUnits
u)
typeName (CharTypeName [Name]
t Maybe Integer
i [Name]
cs [Name]
col) =
    ([Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> (Integer -> Doc a) -> Maybe Integer -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\Integer
x -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> Text -> Doc a
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
showText Integer
x)) Maybe Integer
i)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
cs
         then Doc a
forall a. Monoid a => a
mempty
         else Text -> Doc a
forall a. Text -> Doc a
pretty Text
"character set" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
cs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
col
         then Doc a
forall a. Monoid a => a
mempty
         else Text -> Doc a
forall a. Text -> Doc a
pretty Text
"collate" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
col)
typeName (TimeTypeName [Name]
t Maybe Integer
i Bool
tz) =
    ([Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> (Integer -> Doc a) -> Maybe Integer -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\Integer
x -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> Text -> Doc a
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
showText Integer
x)) Maybe Integer
i)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty (if Bool
tz
              then Text
"with time zone"
              else Text
"without time zone")
typeName (RowTypeName [(Name, TypeName)]
cs) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"row" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ ((Name, TypeName) -> Doc a) -> [(Name, TypeName)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TypeName) -> Doc a
forall {a}. (Name, TypeName) -> Doc a
f [(Name, TypeName)]
cs)
  where
    f :: (Name, TypeName) -> Doc a
f (Name
n,TypeName
t) = Name -> Doc a
forall a. Name -> Doc a
name Name
n Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
t
typeName (IntervalTypeName IntervalTypeField
f Maybe IntervalTypeField
t) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"interval"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> IntervalTypeField -> Doc a
forall a. IntervalTypeField -> Doc a
intervalTypeField IntervalTypeField
f
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (IntervalTypeField -> Doc a) -> Maybe IntervalTypeField -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\IntervalTypeField
x -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"to" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> IntervalTypeField -> Doc a
forall a. IntervalTypeField -> Doc a
intervalTypeField IntervalTypeField
x) Maybe IntervalTypeField
t

typeName (ArrayTypeName TypeName
tn Maybe Integer
sz) =
    TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
tn Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"array" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (Integer -> Doc a) -> Maybe Integer -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets (Doc a -> Doc a) -> (Integer -> Doc a) -> Integer -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc a
forall a. Text -> Doc a
pretty (Text -> Doc a) -> (Integer -> Text) -> Integer -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text
forall a. Show a => a -> Text
showText) Maybe Integer
sz

typeName (MultisetTypeName TypeName
tn) =
    TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
tn Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"multiset"

intervalTypeField :: IntervalTypeField -> Doc a
intervalTypeField :: forall a. IntervalTypeField -> Doc a
intervalTypeField (Itf Text
n Maybe (Integer, Maybe Integer)
p) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> ((Integer, Maybe Integer) -> Doc a)
-> Maybe (Integer, Maybe Integer) -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\(Integer
x,Maybe Integer
x1) ->
             Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Text -> Doc a
forall a. Text -> Doc a
pretty (Integer -> Text
forall a. Show a => a -> Text
showText Integer
x)
                     Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (Integer -> Doc a) -> Maybe Integer -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\Integer
y -> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Doc a
forall a. Doc a
comma,Text -> Doc a
forall a. Text -> Doc a
pretty (Integer -> Text
forall a. Show a => a -> Text
showText Integer
y)]) Maybe Integer
x1)) Maybe (Integer, Maybe Integer)
p


-- = query expressions

queryExpr :: Dialect -> QueryExpr -> Doc a
queryExpr :: forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
dia (Select SetQuantifier
d [(ScalarExpr, Maybe Name)]
sl [TableRef]
fr Maybe ScalarExpr
wh [GroupingExpr]
gb Maybe ScalarExpr
hv [SortSpec]
od Maybe ScalarExpr
off Maybe ScalarExpr
fe) =
  [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Text -> Doc a
forall a. Text -> Doc a
pretty Text
"select" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep
          [case SetQuantifier
d of
               SetQuantifier
SQDefault -> Doc a
forall a. Monoid a => a
mempty
               SetQuantifier
All -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"all"
               SetQuantifier
Distinct -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"distinct"
          ,Dialect -> [(ScalarExpr, Maybe Name)] -> Doc a
forall a. Dialect -> [(ScalarExpr, Maybe Name)] -> Doc a
selectList Dialect
dia [(ScalarExpr, Maybe Name)]
sl])
      ,Dialect -> [TableRef] -> Doc a
forall a. Dialect -> [TableRef] -> Doc a
from Dialect
dia [TableRef]
fr
      ,Dialect -> Text -> Maybe ScalarExpr -> Doc a
forall a. Dialect -> Text -> Maybe ScalarExpr -> Doc a
maybeScalarExpr Dialect
dia Text
"where" Maybe ScalarExpr
wh
      ,Dialect -> [GroupingExpr] -> Doc a
forall a. Dialect -> [GroupingExpr] -> Doc a
grpBy Dialect
dia [GroupingExpr]
gb
      ,Dialect -> Text -> Maybe ScalarExpr -> Doc a
forall a. Dialect -> Text -> Maybe ScalarExpr -> Doc a
maybeScalarExpr Dialect
dia Text
"having" Maybe ScalarExpr
hv
      ,Dialect -> [SortSpec] -> Doc a
forall a. Dialect -> [SortSpec] -> Doc a
orderBy Dialect
dia [SortSpec]
od
      ,(ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\ScalarExpr
e -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"offset" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"rows") Maybe ScalarExpr
off
      ,Doc a
forall a. Doc a
fetchFirst
      ]
  where
    fetchFirst :: Doc a
fetchFirst =
      (ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (\ScalarExpr
e -> if Dialect -> Bool
diLimit Dialect
dia
                then Text -> Doc a
forall a. Text -> Doc a
pretty Text
"limit" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
e
                else Text -> Doc a
forall a. Text -> Doc a
pretty Text
"fetch first" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
e
                     Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"rows only") Maybe ScalarExpr
fe

queryExpr Dialect
dia (QueryExprSetOp QueryExpr
q1 SetOperatorName
ct SetQuantifier
d Corresponding
c QueryExpr
q2) =
  [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
dia QueryExpr
q1
      ,Text -> Doc a
forall a. Text -> Doc a
pretty (case SetOperatorName
ct of
                SetOperatorName
Union -> Text
"union"
                SetOperatorName
Intersect -> Text
"intersect"
                SetOperatorName
Except -> Text
"except")
       Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> case SetQuantifier
d of
               SetQuantifier
SQDefault -> Doc a
forall a. Monoid a => a
mempty
               SetQuantifier
All -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"all"
               SetQuantifier
Distinct -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"distinct"
       Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> case Corresponding
c of
               Corresponding
Corresponding -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"corresponding"
               Corresponding
Respectively -> Doc a
forall a. Monoid a => a
mempty
      ,Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
dia QueryExpr
q2]
queryExpr Dialect
d (With Bool
rc [(Alias, QueryExpr)]
withs QueryExpr
qe) =
  Text -> Doc a
forall a. Text -> Doc a
pretty Text
"with" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (if Bool
rc then Text -> Doc a
forall a. Text -> Doc a
pretty Text
"recursive" else Doc a
forall a. Monoid a => a
mempty)
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep [Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
nest Int
5
            ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc a
forall a. Doc a
comma ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (((Alias, QueryExpr) -> Doc a) -> [(Alias, QueryExpr)] -> [Doc a])
-> [(Alias, QueryExpr)] -> ((Alias, QueryExpr) -> Doc a) -> [Doc a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Alias, QueryExpr) -> Doc a) -> [(Alias, QueryExpr)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map [(Alias, QueryExpr)]
withs (((Alias, QueryExpr) -> Doc a) -> [Doc a])
-> ((Alias, QueryExpr) -> Doc a) -> [Doc a]
forall a b. (a -> b) -> a -> b
$ \(Alias
n,QueryExpr
q) ->
             Alias -> Doc a
forall {a}. Alias -> Doc a
withAlias Alias
n Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q))
           ,Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
qe]
  where
    withAlias :: Alias -> Doc a
withAlias (Alias Name
nm Maybe [Name]
cols) = Name -> Doc a
forall a. Name -> Doc a
name Name
nm
                                Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> ([Name] -> Doc a) -> [Name] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> ([Name] -> [Doc a]) -> [Name] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name) Maybe [Name]
cols


queryExpr Dialect
d (Values [[ScalarExpr]]
vs) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"values"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
nest Int
7 ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep (([ScalarExpr] -> Doc a) -> [[ScalarExpr]] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a)
-> ([ScalarExpr] -> Doc a) -> [ScalarExpr] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a)
-> ([ScalarExpr] -> [Doc a]) -> [ScalarExpr] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d)) [[ScalarExpr]]
vs))
queryExpr Dialect
_ (Table [Name]
t) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"table" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
queryExpr Dialect
d (QueryExprParens QueryExpr
qe) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
qe)
queryExpr Dialect
d (QEComment [Comment]
cmt QueryExpr
v) =
    [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Comment -> Doc a) -> [Comment] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> Doc a
forall a. Comment -> Doc a
comment [Comment]
cmt [Doc a] -> [Doc a] -> [Doc a]
forall a. Semigroup a => a -> a -> a
<> [Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
v]


alias :: Alias -> Doc a
alias :: forall {a}. Alias -> Doc a
alias (Alias Name
nm Maybe [Name]
cols) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
nm
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> ([Name] -> Doc a) -> [Name] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> ([Name] -> [Doc a]) -> [Name] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name) Maybe [Name]
cols

selectList :: Dialect -> [(ScalarExpr,Maybe Name)] -> Doc a
selectList :: forall a. Dialect -> [(ScalarExpr, Maybe Name)] -> Doc a
selectList Dialect
d [(ScalarExpr, Maybe Name)]
is = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ ((ScalarExpr, Maybe Name) -> Doc a)
-> [(ScalarExpr, Maybe Name)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (ScalarExpr, Maybe Name) -> Doc a
forall {a}. (ScalarExpr, Maybe Name) -> Doc a
si [(ScalarExpr, Maybe Name)]
is
  where
    si :: (ScalarExpr, Maybe Name) -> Doc a
si (ScalarExpr
e,Maybe Name
al) = Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (Name -> Doc a) -> Maybe Name -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me Name -> Doc a
forall a. Name -> Doc a
als Maybe Name
al
    als :: Name -> Doc a
als Name
al = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
al

from :: Dialect -> [TableRef] -> Doc a
from :: forall a. Dialect -> [TableRef] -> Doc a
from Dialect
_ [] = Doc a
forall a. Monoid a => a
mempty
from Dialect
d [TableRef]
ts =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"from" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep (Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc a
forall a. Doc a
comma ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (TableRef -> Doc a) -> [TableRef] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map TableRef -> Doc a
forall {a}. TableRef -> Doc a
tr [TableRef]
ts))
  where
    tr :: TableRef -> Doc a
tr (TRSimple [Name]
t) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    tr (TRLateral TableRef
t) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"lateral" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TableRef -> Doc a
tr TableRef
t
    tr (TRFunction [Name]
f [ScalarExpr]
as) =
        [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
f Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
as)
    tr (TRAlias TableRef
t Alias
a) = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [TableRef -> Doc a
tr TableRef
t, Alias -> Doc a
forall {a}. Alias -> Doc a
alias Alias
a]
    tr (TRParens TableRef
t) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ TableRef -> Doc a
tr TableRef
t
    tr (TRQueryExpr QueryExpr
q) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q
    tr (TRJoin TableRef
t0 Bool
b JoinType
jt TableRef
t1 Maybe JoinCondition
jc) =
       [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [TableRef -> Doc a
tr TableRef
t0
           ,if Bool
b then Text -> Doc a
forall a. Text -> Doc a
pretty Text
"natural" else Doc a
forall a. Monoid a => a
mempty
           ,JoinType -> Doc a
forall {a}. JoinType -> Doc a
joinText JoinType
jt Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TableRef -> Doc a
tr TableRef
t1
           ,Maybe JoinCondition -> Doc a
forall {a}. Maybe JoinCondition -> Doc a
joinCond Maybe JoinCondition
jc]
    tr (TROdbc TableRef
t) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"{oj" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TableRef -> Doc a
tr TableRef
t Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"}"
    joinText :: JoinType -> Doc a
joinText JoinType
jt =
      [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [case JoinType
jt of
              JoinType
JInner -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"inner"
              JoinType
JLeft -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"left"
              JoinType
JRight -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"right"
              JoinType
JFull -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"full"
              JoinType
JCross -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"cross"
          ,Text -> Doc a
forall a. Text -> Doc a
pretty Text
"join"]
    joinCond :: Maybe JoinCondition -> Doc a
joinCond (Just (JoinOn ScalarExpr
e)) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"on" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e
    joinCond (Just (JoinUsing [Name]
es)) =
        Text -> Doc a
forall a. Text -> Doc a
pretty Text
"using" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
es)
    joinCond Maybe JoinCondition
Nothing = Doc a
forall a. Monoid a => a
mempty

maybeScalarExpr :: Dialect -> Text -> Maybe ScalarExpr -> Doc a
maybeScalarExpr :: forall a. Dialect -> Text -> Maybe ScalarExpr -> Doc a
maybeScalarExpr Dialect
d Text
k = (ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Doc a
forall b a. (b -> Doc a) -> Maybe b -> Doc a
me
      (\ScalarExpr
e -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
k Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e))

grpBy :: Dialect -> [GroupingExpr] -> Doc a
grpBy :: forall a. Dialect -> [GroupingExpr] -> Doc a
grpBy Dialect
_ [] = Doc a
forall a. Monoid a => a
mempty
grpBy Dialect
d [GroupingExpr]
gs = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"group by" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (GroupingExpr -> Doc a) -> [GroupingExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map GroupingExpr -> Doc a
forall {a}. GroupingExpr -> Doc a
ge [GroupingExpr]
gs)
  where
    ge :: GroupingExpr -> Doc a
ge (SimpleGroup ScalarExpr
e) = Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e
    ge (GroupingParens [GroupingExpr]
g) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (GroupingExpr -> Doc a) -> [GroupingExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map GroupingExpr -> Doc a
ge [GroupingExpr]
g)
    ge (Cube [GroupingExpr]
es) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"cube" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (GroupingExpr -> Doc a) -> [GroupingExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map GroupingExpr -> Doc a
ge [GroupingExpr]
es)
    ge (Rollup [GroupingExpr]
es) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"rollup" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (GroupingExpr -> Doc a) -> [GroupingExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map GroupingExpr -> Doc a
ge [GroupingExpr]
es)
    ge (GroupingSets [GroupingExpr]
es) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"grouping sets" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (GroupingExpr -> Doc a) -> [GroupingExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map GroupingExpr -> Doc a
ge [GroupingExpr]
es)

orderBy :: Dialect -> [SortSpec] -> Doc a
orderBy :: forall a. Dialect -> [SortSpec] -> Doc a
orderBy Dialect
_ [] = Doc a
forall a. Monoid a => a
mempty
orderBy Dialect
dia [SortSpec]
os = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"order by" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (SortSpec -> Doc a) -> [SortSpec] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map SortSpec -> Doc a
forall {a}. SortSpec -> Doc a
f [SortSpec]
os)
  where
    f :: SortSpec -> Doc a
f (SortSpec ScalarExpr
e Direction
d NullsOrder
n) =
        Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
dia ScalarExpr
e
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (case Direction
d of
                  Direction
Asc -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"asc"
                  Direction
Desc -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"desc"
                  Direction
DirDefault -> Doc a
forall a. Monoid a => a
mempty)
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (case NullsOrder
n of
                NullsOrder
NullsOrderDefault -> Doc a
forall a. Monoid a => a
mempty
                NullsOrder
NullsFirst -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"nulls" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"first"
                NullsOrder
NullsLast -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"nulls" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"last")

-- = statements

statement :: Dialect -> Statement -> Doc a


-- == ddl

statement :: forall a. Dialect -> Statement -> Doc a
statement Dialect
_ (CreateSchema [Name]
nm) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"create" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"schema" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm

statement Dialect
d (CreateTable [Name]
nm [TableElement]
cds Bool
withoutRowid) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"create" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"table" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (TableElement -> Doc a) -> [TableElement] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map TableElement -> Doc a
forall {a}. TableElement -> Doc a
cd [TableElement]
cds)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (if Bool
withoutRowid then [Text] -> Doc a
forall a. [Text] -> Doc a
texts [ Text
"without", Text
"rowid" ] else Doc a
forall a. Monoid a => a
mempty)
  where
    cd :: TableElement -> Doc a
cd (TableConstraintDef Maybe [Name]
n TableConstraint
con) =
        Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
s -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"constraint" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
s) Maybe [Name]
n
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> TableConstraint -> Doc a
forall a. Dialect -> TableConstraint -> Doc a
tableConstraint Dialect
d TableConstraint
con
    cd (TableColumnDef ColumnDef
cd') = Dialect -> ColumnDef -> Doc a
forall a. Dialect -> ColumnDef -> Doc a
columnDef Dialect
d ColumnDef
cd'

statement Dialect
d (AlterTable [Name]
t AlterTableAction
act) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter",Text
"table"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> AlterTableAction -> Doc a
forall a. Dialect -> AlterTableAction -> Doc a
alterTableAction Dialect
d AlterTableAction
act

statement Dialect
_ (DropSchema [Name]
nm DropBehaviour
db) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"drop" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"schema" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
db

statement Dialect
d (CreateDomain [Name]
nm TypeName
ty Maybe ScalarExpr
def [(Maybe [Name], ScalarExpr)]
cs) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"create" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"domain" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
ty
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (ScalarExpr -> Doc a) -> Maybe ScalarExpr -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\ScalarExpr
def' -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"default" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
def') Maybe ScalarExpr
def
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep (((Maybe [Name], ScalarExpr) -> Doc a)
-> [(Maybe [Name], ScalarExpr)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe [Name], ScalarExpr) -> Doc a
forall {a}. (Maybe [Name], ScalarExpr) -> Doc a
con [(Maybe [Name], ScalarExpr)]
cs)
  where
    con :: (Maybe [Name], ScalarExpr) -> Doc a
con (Maybe [Name]
cn, ScalarExpr
e) =
        Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
cn' -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"constraint" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
cn') Maybe [Name]
cn
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"check" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e)

statement Dialect
d (AlterDomain [Name]
nm AlterDomainAction
act) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter",Text
"domain"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> AlterDomainAction -> Doc a
forall {a}. AlterDomainAction -> Doc a
a AlterDomainAction
act
  where
    a :: AlterDomainAction -> Doc a
a (ADSetDefault ScalarExpr
v) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"set",Text
"default"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v
    a AlterDomainAction
ADDropDefault = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop",Text
"default"]
    a (ADAddConstraint Maybe [Name]
cnm ScalarExpr
e) =
        Text -> Doc a
forall a. Text -> Doc a
pretty Text
"add"
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
cnm' -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"constraint" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
cnm') Maybe [Name]
cnm
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"check" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e)
    a (ADDropConstraint [Name]
cnm) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop", Text
"constraint"]
                               Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
cnm


statement Dialect
_ (DropDomain [Name]
nm DropBehaviour
db) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"drop" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"domain" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
db

statement Dialect
_ (CreateSequence [Name]
nm [SequenceGeneratorOption]
sgos) =
  [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"create",Text
"sequence"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ((SequenceGeneratorOption -> Doc a)
-> [SequenceGeneratorOption] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map SequenceGeneratorOption -> Doc a
forall a. SequenceGeneratorOption -> Doc a
sequenceGeneratorOption [SequenceGeneratorOption]
sgos)

statement Dialect
_ (AlterSequence [Name]
nm [SequenceGeneratorOption]
sgos) =
  [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter",Text
"sequence"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ((SequenceGeneratorOption -> Doc a)
-> [SequenceGeneratorOption] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map SequenceGeneratorOption -> Doc a
forall a. SequenceGeneratorOption -> Doc a
sequenceGeneratorOption [SequenceGeneratorOption]
sgos)

statement Dialect
_ (DropSequence [Name]
nm DropBehaviour
db) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"drop" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"sequence" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
db


statement Dialect
d (CreateAssertion [Name]
nm ScalarExpr
ex) =
  [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"create",Text
"assertion"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"check" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
ex)

statement Dialect
_ (DropAssertion [Name]
nm DropBehaviour
db) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"drop" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"assertion" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
db

statement Dialect
_ (CreateIndex Bool
un [Name]
nm [Name]
tbl [Name]
cols) =
  [Text] -> Doc a
forall a. [Text] -> Doc a
texts (if Bool
un
         then [Text
"create",Text
"unique",Text
"index"]
         else  [Text
"create",Text
"index"])
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"on"
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
tbl
  Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
cols)

-- == dml

statement Dialect
d (SelectStatement QueryExpr
q) = Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q

statement Dialect
d (Delete [Name]
t Maybe Name
a Maybe ScalarExpr
w) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"delete" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"from"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (Name -> Doc a) -> Maybe Name -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\Name
x -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
x) Maybe Name
a
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> Text -> Maybe ScalarExpr -> Doc a
forall a. Dialect -> Text -> Maybe ScalarExpr -> Doc a
maybeScalarExpr Dialect
d Text
"where" Maybe ScalarExpr
w

statement Dialect
_ (Truncate [Name]
t IdentityRestart
ir) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"truncate" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"table" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> case IdentityRestart
ir of
            IdentityRestart
DefaultIdentityRestart -> Doc a
forall a. Monoid a => a
mempty
            IdentityRestart
ContinueIdentity -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"continue" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"identity"
            IdentityRestart
RestartIdentity -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"restart" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"identity"

statement Dialect
d (Insert [Name]
t Maybe [Name]
cs InsertSource
s) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"insert" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"into" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
cs' -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
cs')) Maybe [Name]
cs
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> case InsertSource
s of
            InsertSource
DefaultInsertValues -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"default" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"values"
            InsertQuery QueryExpr
q -> Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q

statement Dialect
d (Update [Name]
t Maybe Name
a [SetClause]
sts Maybe ScalarExpr
whr) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"update" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (Name -> Doc a) -> Maybe Name -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\Name
x -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
x) Maybe Name
a
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"set" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((SetClause -> Doc a) -> [SetClause] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map SetClause -> Doc a
forall {a}. SetClause -> Doc a
sc [SetClause]
sts)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> Text -> Maybe ScalarExpr -> Doc a
forall a. Dialect -> Text -> Maybe ScalarExpr -> Doc a
maybeScalarExpr Dialect
d Text
"where" Maybe ScalarExpr
whr
  where
    sc :: SetClause -> Doc a
sc (Set [Name]
tg ScalarExpr
v) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
tg Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"=" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v
    sc (SetMultiple [[Name]]
ts [ScalarExpr]
vs) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ ([Name] -> Doc a) -> [[Name]] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map [Name] -> Doc a
forall a. [Name] -> Doc a
names [[Name]]
ts) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"="
                             Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ScalarExpr -> Doc a) -> [ScalarExpr] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d) [ScalarExpr]
vs)

statement Dialect
_ (DropTable [Name]
n DropBehaviour
b) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"drop" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"table" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
n Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
b

statement Dialect
d (CreateView Bool
r [Name]
nm Maybe [Name]
al QueryExpr
q Maybe CheckOption
co) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"create" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (if Bool
r then Text -> Doc a
forall a. Text -> Doc a
pretty Text
"recursive" else Doc a
forall a. Monoid a => a
mempty)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"view" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> ([Name] -> Doc a) -> [Name] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> ([Name] -> [Doc a]) -> [Name] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name) Maybe [Name]
al
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> QueryExpr -> Doc a
forall a. Dialect -> QueryExpr -> Doc a
queryExpr Dialect
d QueryExpr
q
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> case Maybe CheckOption
co of
            Maybe CheckOption
Nothing -> Doc a
forall a. Monoid a => a
mempty
            Just CheckOption
DefaultCheckOption -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"with", Text
"check", Text
"option"]
            Just CheckOption
CascadedCheckOption -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"with", Text
"cascaded", Text
"check", Text
"option"]
            Just CheckOption
LocalCheckOption -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"with", Text
"local", Text
"check", Text
"option"]

statement Dialect
_ (DropView [Name]
n DropBehaviour
b) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"drop" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"view" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
n Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
b


-- == transactions

statement Dialect
_ Statement
StartTransaction =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"start", Text
"transaction"]

statement Dialect
_ (Savepoint Name
nm) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"savepoint" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
nm

statement Dialect
_ (ReleaseSavepoint Name
nm) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"release", Text
"savepoint"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
nm

statement Dialect
_ Statement
Commit =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"commit"

statement Dialect
_ (Rollback Maybe Name
mn) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"rollback"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (Name -> Doc a) -> Maybe Name -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\Name
n -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"to",Text
"savepoint"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n) Maybe Name
mn

-- == access control

statement Dialect
_ (GrantPrivilege [PrivilegeAction]
pas PrivilegeObject
po [Name]
rs GrantOption
go) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"grant" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((PrivilegeAction -> Doc a) -> [PrivilegeAction] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map PrivilegeAction -> Doc a
forall a. PrivilegeAction -> Doc a
privAct [PrivilegeAction]
pas)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"on" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> PrivilegeObject -> Doc a
forall a. PrivilegeObject -> Doc a
privObj PrivilegeObject
po
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"to" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
rs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> GrantOption -> Doc a
forall {a}. GrantOption -> Doc a
grantOpt GrantOption
go
  where
    grantOpt :: GrantOption -> Doc a
grantOpt GrantOption
WithGrantOption = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"with",Text
"grant",Text
"option"]
    grantOpt GrantOption
WithoutGrantOption = Doc a
forall a. Monoid a => a
mempty

statement Dialect
_ (GrantRole [Name]
rs [Name]
trs AdminOption
ao) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"grant" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
rs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"to" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
trs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> AdminOption -> Doc a
forall {a}. AdminOption -> Doc a
adminOpt AdminOption
ao
  where
    adminOpt :: AdminOption -> Doc a
adminOpt AdminOption
WithAdminOption = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"with",Text
"admin",Text
"option"]
    adminOpt AdminOption
WithoutAdminOption = Doc a
forall a. Monoid a => a
mempty

statement Dialect
_ (CreateRole Name
nm) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"create",Text
"role"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
nm

statement Dialect
_ (DropRole Name
nm) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop",Text
"role"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
nm

statement Dialect
_ (RevokePrivilege GrantOptionFor
go [PrivilegeAction]
pas PrivilegeObject
po [Name]
rs DropBehaviour
db) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"revoke"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> GrantOptionFor -> Doc a
forall {a}. GrantOptionFor -> Doc a
grantOptFor GrantOptionFor
go
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((PrivilegeAction -> Doc a) -> [PrivilegeAction] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map PrivilegeAction -> Doc a
forall a. PrivilegeAction -> Doc a
privAct [PrivilegeAction]
pas)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"on" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> PrivilegeObject -> Doc a
forall a. PrivilegeObject -> Doc a
privObj PrivilegeObject
po
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"from" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
rs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
db
  where
    grantOptFor :: GrantOptionFor -> Doc a
grantOptFor GrantOptionFor
GrantOptionFor = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"grant",Text
"option",Text
"for"]
    grantOptFor GrantOptionFor
NoGrantOptionFor = Doc a
forall a. Monoid a => a
mempty

statement Dialect
_ (RevokeRole AdminOptionFor
ao [Name]
rs [Name]
trs DropBehaviour
db) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"revoke"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> AdminOptionFor -> Doc a
forall {a}. AdminOptionFor -> Doc a
adminOptFor AdminOptionFor
ao
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
rs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"from" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
trs)
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
db
  where
    adminOptFor :: AdminOptionFor -> Doc a
adminOptFor AdminOptionFor
AdminOptionFor = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"admin",Text
"option",Text
"for"]
    adminOptFor AdminOptionFor
NoAdminOptionFor = Doc a
forall a. Monoid a => a
mempty


statement Dialect
_ (StatementComment [Comment]
cs) = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Comment -> Doc a) -> [Comment] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> Doc a
forall a. Comment -> Doc a
comment [Comment]
cs
statement Dialect
_ Statement
EmptyStatement = Doc a
forall a. Monoid a => a
mempty


{-
== sessions


== extras
-}

dropBehav :: DropBehaviour -> Doc a
dropBehav :: forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
DefaultDropBehaviour = Doc a
forall a. Monoid a => a
mempty
dropBehav DropBehaviour
Cascade = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"cascade"
dropBehav DropBehaviour
Restrict = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"restrict"

columnDef :: Dialect -> ColumnDef -> Doc a
columnDef :: forall a. Dialect -> ColumnDef -> Doc a
columnDef Dialect
d (ColumnDef Name
n Maybe TypeName
t [ColConstraintDef]
cons) =
      Name -> Doc a
forall a. Name -> Doc a
name Name
n Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (TypeName -> Doc a) -> Maybe TypeName -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty TypeName -> Doc a
forall a. TypeName -> Doc a
typeName Maybe TypeName
t
      Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ((ColConstraintDef -> Doc a) -> [ColConstraintDef] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ColConstraintDef -> Doc a
forall {a}. ColConstraintDef -> Doc a
cdef [ColConstraintDef]
cons)
  where
    cdef :: ColConstraintDef -> Doc a
cdef (ColConstraintDef Maybe [Name]
cnm ColConstraint
con) =
        Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
s -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"constraint" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
s) Maybe [Name]
cnm
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> ColConstraint -> Doc a
forall {a}. ColConstraint -> Doc a
pcon ColConstraint
con
    pcon :: ColConstraint -> Doc a
pcon ColConstraint
ColNotNullConstraint = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"not",Text
"null"]
    pcon ColConstraint
ColNullableConstraint = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"null"]
    pcon ColConstraint
ColUniqueConstraint = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"unique"
    pcon (ColPrimaryKeyConstraint Bool
autoincrement) =
      [Text] -> Doc a
forall a. [Text] -> Doc a
texts ([Text] -> Doc a) -> [Text] -> Doc a
forall a b. (a -> b) -> a -> b
$ [Text
"primary",Text
"key"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"autoincrement"|Bool
autoincrement]
    --pcon ColPrimaryKeyConstraint = texts ["primary","key"]
    pcon (ColCheckConstraint ScalarExpr
v) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"check" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v)
    pcon (ColReferencesConstraint [Name]
tb Maybe Name
c ReferenceMatch
m ReferentialAction
u ReferentialAction
del) =
        Text -> Doc a
forall a. Text -> Doc a
pretty Text
"references"
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
tb
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (Name -> Doc a) -> Maybe Name -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> (Name -> Doc a) -> Name -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Doc a
forall a. Name -> Doc a
name) Maybe Name
c
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> ReferenceMatch -> Doc a
forall a. ReferenceMatch -> Doc a
refMatch ReferenceMatch
m
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> ReferentialAction -> Doc a
forall a. Text -> ReferentialAction -> Doc a
refAct Text
"update" ReferentialAction
u
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> ReferentialAction -> Doc a
forall a. Text -> ReferentialAction -> Doc a
refAct Text
"delete" ReferentialAction
del
    pcon (ColDefaultClause DefaultClause
clause) = case DefaultClause
clause of
        DefaultClause ScalarExpr
def ->
            Text -> Doc a
forall a. Text -> Doc a
pretty Text
"default" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
def
        GenerationClause ScalarExpr
e ->
            [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"generated",Text
"always",Text
"as"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
e)
        IdentityColumnSpec IdentityWhen
w [SequenceGeneratorOption]
o ->
            Text -> Doc a
forall a. Text -> Doc a
pretty Text
"generated"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (case IdentityWhen
w of
                    IdentityWhen
GeneratedAlways -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"always"
                    IdentityWhen
GeneratedByDefault -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"by" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"default")
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"identity"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> (case [SequenceGeneratorOption]
o of
                    [] -> Doc a
forall a. Monoid a => a
mempty
                    [SequenceGeneratorOption]
os -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (SequenceGeneratorOption -> Doc a)
-> [SequenceGeneratorOption] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map SequenceGeneratorOption -> Doc a
forall a. SequenceGeneratorOption -> Doc a
sequenceGeneratorOption [SequenceGeneratorOption]
os))

sequenceGeneratorOption :: SequenceGeneratorOption -> Doc a
sequenceGeneratorOption :: forall a. SequenceGeneratorOption -> Doc a
sequenceGeneratorOption (SGODataType TypeName
t) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"as" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
t
sequenceGeneratorOption (SGORestart Maybe Integer
mi) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"restart" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (Integer -> Doc a) -> Maybe Integer -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\Integer
mi' -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"with", Integer -> Text
forall a. Show a => a -> Text
showText Integer
mi']) Maybe Integer
mi
sequenceGeneratorOption (SGOStartWith Integer
i) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"start",  Text
"with", Integer -> Text
forall a. Show a => a -> Text
showText Integer
i]
sequenceGeneratorOption (SGOIncrementBy Integer
i) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"increment", Text
"by", Integer -> Text
forall a. Show a => a -> Text
showText Integer
i]
sequenceGeneratorOption (SGOMaxValue Integer
i) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"maxvalue", Integer -> Text
forall a. Show a => a -> Text
showText Integer
i]
sequenceGeneratorOption SequenceGeneratorOption
SGONoMaxValue = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"no", Text
"maxvalue"]
sequenceGeneratorOption (SGOMinValue Integer
i) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"minvalue", Integer -> Text
forall a. Show a => a -> Text
showText Integer
i]
sequenceGeneratorOption SequenceGeneratorOption
SGONoMinValue = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"no", Text
"minvalue"]
sequenceGeneratorOption SequenceGeneratorOption
SGOCycle = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"cycle"
sequenceGeneratorOption SequenceGeneratorOption
SGONoCycle = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"no cycle"

refMatch :: ReferenceMatch -> Doc a
refMatch :: forall a. ReferenceMatch -> Doc a
refMatch ReferenceMatch
m = case ReferenceMatch
m of
                     ReferenceMatch
DefaultReferenceMatch -> Doc a
forall a. Monoid a => a
mempty
                     ReferenceMatch
MatchFull -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"match", Text
"full"]
                     ReferenceMatch
MatchPartial -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"match",Text
"partial"]
                     ReferenceMatch
MatchSimple -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"match", Text
"simple"]

refAct :: Text -> ReferentialAction -> Doc a
refAct :: forall a. Text -> ReferentialAction -> Doc a
refAct Text
t ReferentialAction
a = case ReferentialAction
a of
                     ReferentialAction
DefaultReferentialAction -> Doc a
forall a. Monoid a => a
mempty
                     ReferentialAction
RefCascade -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"on", Text
t, Text
"cascade"]
                     ReferentialAction
RefSetNull -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"on", Text
t, Text
"set", Text
"null"]
                     ReferentialAction
RefSetDefault -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"on", Text
t, Text
"set", Text
"default"]
                     ReferentialAction
RefRestrict -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"on", Text
t, Text
"restrict"]
                     ReferentialAction
RefNoAction -> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"on", Text
t, Text
"no", Text
"action"]

alterTableAction :: Dialect -> AlterTableAction -> Doc a
alterTableAction :: forall a. Dialect -> AlterTableAction -> Doc a
alterTableAction Dialect
d (AddColumnDef ColumnDef
cd) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"add", Text
"column"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ColumnDef -> Doc a
forall a. Dialect -> ColumnDef -> Doc a
columnDef Dialect
d ColumnDef
cd

alterTableAction Dialect
d (AlterColumnSetDefault Name
n ScalarExpr
v) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter", Text
"column"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"set",Text
"default"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v
alterTableAction Dialect
_ (AlterColumnDropDefault Name
n) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter", Text
"column"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop",Text
"default"]

alterTableAction Dialect
_ (AlterColumnSetNotNull Name
n) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter", Text
"column"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"set",Text
"not",Text
"null"]

alterTableAction Dialect
_ (AlterColumnDropNotNull Name
n) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter", Text
"column"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop",Text
"not",Text
"null"]

alterTableAction Dialect
_ (AlterColumnSetDataType Name
n TypeName
t) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"alter", Text
"column"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"set",Text
"data",Text
"Type"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> TypeName -> Doc a
forall a. TypeName -> Doc a
typeName TypeName
t

alterTableAction Dialect
_ (DropColumn Name
n DropBehaviour
b) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop", Text
"column"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc a
forall a. Name -> Doc a
name Name
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
b

alterTableAction Dialect
d (AddTableConstraintDef Maybe [Name]
n TableConstraint
con) =
    Text -> Doc a
forall a. Text -> Doc a
pretty Text
"add"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
s -> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"constraint" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
s) Maybe [Name]
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Dialect -> TableConstraint -> Doc a
forall a. Dialect -> TableConstraint -> Doc a
tableConstraint Dialect
d TableConstraint
con

alterTableAction Dialect
_ (DropTableConstraintDef [Name]
n DropBehaviour
b) =
    [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"drop", Text
"constraint"]
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
n
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> DropBehaviour -> Doc a
forall a. DropBehaviour -> Doc a
dropBehav DropBehaviour
b


tableConstraint :: Dialect -> TableConstraint -> Doc a
tableConstraint :: forall a. Dialect -> TableConstraint -> Doc a
tableConstraint Dialect
_ (TableUniqueConstraint [Name]
ns) =
         Text -> Doc a
forall a. Text -> Doc a
pretty Text
"unique" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
ns)
tableConstraint Dialect
_ (TablePrimaryKeyConstraint [Name]
ns) =
        [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"primary",Text
"key"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
ns)
tableConstraint Dialect
_ (TableReferencesConstraint [Name]
cs [Name]
t Maybe [Name]
tcs ReferenceMatch
m ReferentialAction
u ReferentialAction
del) =
        [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"foreign", Text
"key"]
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
cs)
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"references"
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
t
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> ([Name] -> Doc a) -> Maybe [Name] -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty (\[Name]
c' -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
c')) Maybe [Name]
tcs
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> ReferenceMatch -> Doc a
forall a. ReferenceMatch -> Doc a
refMatch ReferenceMatch
m
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> ReferentialAction -> Doc a
forall a. Text -> ReferentialAction -> Doc a
refAct Text
"update" ReferentialAction
u
        Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> ReferentialAction -> Doc a
forall a. Text -> ReferentialAction -> Doc a
refAct Text
"delete" ReferentialAction
del
tableConstraint Dialect
d (TableCheckConstraint ScalarExpr
v) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"check" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Dialect -> ScalarExpr -> Doc a
forall a. Dialect -> ScalarExpr -> Doc a
scalarExpr Dialect
d ScalarExpr
v)


privAct :: PrivilegeAction -> Doc a
privAct :: forall a. PrivilegeAction -> Doc a
privAct PrivilegeAction
PrivAll = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"all",Text
"privileges"]
privAct (PrivSelect [Name]
cs) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"select" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
maybeColList [Name]
cs
privAct (PrivInsert [Name]
cs) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"insert" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
maybeColList [Name]
cs
privAct (PrivUpdate [Name]
cs) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"update" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
maybeColList [Name]
cs
privAct (PrivReferences [Name]
cs) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"references" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
maybeColList [Name]
cs
privAct PrivilegeAction
PrivDelete = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"delete"
privAct PrivilegeAction
PrivUsage = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"usage"
privAct PrivilegeAction
PrivTrigger = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"trigger"
privAct PrivilegeAction
PrivExecute = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"execute"

maybeColList :: [Name] -> Doc a
maybeColList :: forall a. [Name] -> Doc a
maybeColList [Name]
cs =
    if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
cs
    then Doc a
forall a. Monoid a => a
mempty
    else Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commaSep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a. Name -> Doc a
name [Name]
cs)

privObj :: PrivilegeObject -> Doc a
privObj :: forall a. PrivilegeObject -> Doc a
privObj (PrivTable [Name]
nm) = [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
privObj (PrivDomain [Name]
nm) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"domain" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
privObj (PrivType [Name]
nm) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"type" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
privObj (PrivSequence [Name]
nm) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"sequence" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm
privObj (PrivFunction [Name]
nm) = [Text] -> Doc a
forall a. [Text] -> Doc a
texts [Text
"specific", Text
"function"] Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Name] -> Doc a
forall a. [Name] -> Doc a
names [Name]
nm

-- = utils

commaSep :: [Doc a] -> Doc a
commaSep :: forall ann. [Doc ann] -> Doc ann
commaSep [Doc a]
ds = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc a
forall a. Doc a
comma [Doc a]
ds

me :: (b -> Doc a) -> Maybe b -> Doc a
me :: forall b a. (b -> Doc a) -> Maybe b -> Doc a
me = Doc a -> (b -> Doc a) -> Maybe b -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty

comment :: Comment -> Doc a
comment :: forall a. Comment -> Doc a
comment (BlockComment Text
str) = Text -> Doc a
forall a. Text -> Doc a
pretty Text
"/*" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
str Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall a. Text -> Doc a
pretty Text
"*/"

texts :: [Text] -> Doc a
texts :: forall a. [Text] -> Doc a
texts [Text]
ts = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Text -> Doc a) -> [Text] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc a
forall a. Text -> Doc a
pretty [Text]
ts

-- regular pretty completely defeats the type checker when you want
-- to change the ast and get type errors, instead it just produces
-- incorrect code.
pretty :: Text -> Doc a
pretty :: forall a. Text -> Doc a
pretty = Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall a. Text -> Doc a
P.pretty

showText :: Show a => a -> Text
showText :: forall a. Show a => a -> Text
showText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- restore the correct behaviour of mempty
-- this doesn't quite work when you chain <> and <+> together,
-- so use parens in those cases

sep :: [Doc a] -> Doc a
sep :: forall ann. [Doc ann] -> Doc ann
sep = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
P.sep ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Bool) -> [Doc a] -> [Doc a]
forall a. (a -> Bool) -> [a] -> [a]
filter Doc a -> Bool
forall {ann}. Doc ann -> Bool
isEmpty
  where
    isEmpty :: Doc ann -> Bool
isEmpty Doc ann
Empty = Bool
False
    isEmpty Doc ann
_ = Bool
True

(<+>) :: Doc a -> Doc a -> Doc a
<+> :: forall a. Doc a -> Doc a -> Doc a
(<+>) Doc a
a Doc a
b = case (Doc a
a,Doc a
b) of
    (Doc a
Empty, Doc a
Empty) -> Doc a
forall a. Doc a
Empty
    (Doc a
Empty, Doc a
x) -> Doc a
x
    (Doc a
x, Doc a
Empty) -> Doc a
x
    (Doc a, Doc a)
_ ->  Doc a
a Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
P.<+> Doc a
b

parens :: Doc a -> Doc a
parens :: forall ann. Doc ann -> Doc ann
parens Doc a
a = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
P.parens (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align Doc a
a)