> {- | Functions to convert sql asts to valid SQL source code.
>
>    Some effort is made produce human readable output.
> -}
> {-# LANGUAGE PatternGuards,OverloadedStrings,TypeSynonymInstances,FlexibleInstances #-}
> module Database.HsSqlPpp.Internals.PrettyInternal
>     (--convert a sql ast to text
>      prettyStatements
>     --,printStatementsAnn
>     ,prettyQueryExpr
>      --convert a single expression parse node to text
>     ,prettyScalarExpr
>     ,PrettyFlags(..)
>     )
>     where
>
> import Text.PrettyPrint
> import Data.Maybe
>
> import Database.HsSqlPpp.Syntax hiding (ann)
> import Database.HsSqlPpp.Internals.AstInternal (
>     Annotation(..)
>    ,emptyAnnotation)
> --import Database.HsSqlPpp.Utils.Utils

> import Database.HsSqlPpp.Internals.Dialect

> import Database.HsSqlPpp.Internals.TypesInternal
> --import Database.HsSqlPpp.Internals.StringLike
> import qualified Data.Text as T
> import qualified Data.Text.Lazy as L
> import Database.HsSqlPpp.Internals.Utils

> data PrettyFlags =
>   PrettyFlags

>   {ppDialect :: Dialect
>   }
>   deriving (Show,Eq)

> -- | Convert an ast back to valid SQL source.
> prettyStatements :: PrettyFlags -> [Statement] -> L.Text
> prettyStatements f = prettyStatementsAnn f (const "")
>
> -- | Convert the ast back to valid source, and convert any annotations to
> -- text using the function provided and interpolate the output of
> -- this function (inside comments) with the SQL source.

> prettyStatementsAnn :: PrettyFlags -> (Annotation -> String) -> [Statement] -> L.Text
> prettyStatementsAnn flg f ast =
>   renderText $ vcat (map (statement flg True f) ast) <> text "\n"

> -- | pretty print a query expression
> prettyQueryExpr :: PrettyFlags -> QueryExpr -> L.Text
> prettyQueryExpr f ast = renderText (queryExpr f True True Nothing ast <> statementEnd True)

> -- | pretty print a scalar expression
> prettyScalarExpr :: PrettyFlags -> ScalarExpr -> L.Text
> prettyScalarExpr f = renderText . scalExpr f

> direct :: Bool
> direct = True

> renderText :: Doc -> L.Text
> renderText doc =
>   if direct
>   then fullRender (mode style) (lineLength style) (ribbonsPerLine style)
>                    dataTextPrettyer "" doc
>   else L.pack $ render doc

> dataTextPrettyer :: TextDetails -> L.Text -> L.Text
> dataTextPrettyer (Chr c)   s  = L.cons c s
> dataTextPrettyer (Str s1)  s2 = L.pack s1 `L.append` s2
> dataTextPrettyer (PStr s1) s2 = L.pack s1 `L.append` s2

> -- Statements
>
> statement :: PrettyFlags -> Bool -> (Annotation -> String) -> Statement -> Doc
> statement _flg _se _ca (AntiStatement s) = text $ "$(" ++ s ++ ")"
>
> -- selects
>
> statement flg se ca (QueryStatement ann s) =
>   annot ca ann <+>
>   queryExpr flg True True Nothing s <> statementEnd se
>
> --dml
>
> statement flg se pa (Insert ann tb atts idata rt) =
>   annot pa ann <+>
>   text "insert into" <+> name tb
>   <+> ifNotEmpty (parens . sepCsvMap nmc) atts
>   $+$ queryExpr flg True True Nothing idata
>   $+$ returning flg rt
>   <> statementEnd se
>
> statement flg se ca (Update ann tb scs fr wh rt) =
>    annot ca ann <+>
>    text "update" <+> name tb <+> text "set"
>    <+> sepCsvMap (set flg) scs
>    <+> ifNotEmpty (\_ -> text "from" <+> sepCsvMap (tref flg) fr) fr
>    <+> whr flg wh
>    $+$ returning flg rt <> statementEnd se
>
> statement flg se ca (Delete ann tbl us wh rt) =
>    annot ca ann <+>
>    text "delete from" <+> name tbl
>    <+> ifNotEmpty (\_ -> text "using" <+> sepCsvMap (tref flg) us) us
>    <+> whr flg wh
>    $+$ returning flg rt
>    <> statementEnd se
>
> statement flg se ca (Truncate ann names ri casc) =
>     annot ca ann <+>
>     text "truncate"
>     <+> sepCsvMap name names
>     <+> case (diSyntaxFlavour $ ppDialect flg) of
>        SqlServer -> empty
>        _ -> text (case ri of
>                       RestartIdentity -> "restart identity"
>                       ContinueIdentity -> "continue identity")
>             <+> cascade casc
>     <> statementEnd se
>
> -- ddl
>
> statement flg se ca (CreateTable ann tbl atts cns partition rep) =
>     annot ca ann <+>
>     text ("create " ++ (case rep of
>                          Replace -> "or replace "
>                          _ -> "") ++ "table")
>     <+> name tbl <+> lparen
>     $+$ nest 2 (vcat (csv (map (attrDef flg) atts ++ map (constraint flg) cns)))
>     $+$ rparen
>     $+$ case (diSyntaxFlavour $ ppDialect flg) of
>          SqlServer -> empty
>          _ -> (tablePartition partition)
>     <> statementEnd se
>
> statement flg se ca (AlterTable ann tnm op) =
>     annot ca ann <+>
>     text "alter table" <+> name tnm
>     <+> alterOperation op <> statementEnd se
>     where
>       alterOperation (RenameTable _ nm) = 
>           text "rename to" <+> name nm
>       alterOperation (RenameColumn _ old new) = 
>           text "rename column" <+> nmc old <+> "to" <+> nmc new
>       alterOperation (AlterTableActions _ actions) = hcatCsvMap alterAction actions
>       alterAction (AddColumn _ att) = 
>           text "add column" <+> attrDef flg att
>       alterAction (DropColumn _ nm) = 
>           text "drop column" <+> nmc nm
>       alterAction (AlterColumn _ nm action) = 
>           text "alter column" <+> nmc nm <+> alterColumnAction action
>       alterAction (AddConstraint _ con) =
>           text "add" <+> constraint flg con
>       alterColumnAction (SetDataType _ t) =
>           text "set data type" <+> typeName t
>       alterColumnAction (SetNotNull _) =
>           text "set not null"
>       alterColumnAction (DropNotNull _) =
>           text "drop not null"
>       alterColumnAction (SetDefault _ def) =
>           text "set default" <+> scalExpr flg def
>       alterColumnAction (DropDefault _) =
>           text "drop default"
>
> statement _flg se ca (CreateSequence ann nm incr minv maxv start cache) =
>     annot ca ann <+>
>     text "create sequence" <+> name nm <+>
>     text "increment" <+> text (show incr) <+>
>     maybe (text "no minvalue") ((text "minvalue" <+>) . (text . show)) minv <+>
>     maybe (text "no maxvalue") ((text "maxvalue" <+>) . (text . show)) maxv <+>
>     text "start with" <+> text (show start) <+>
>     text "cache" <+> text (show cache) <> statementEnd se
>
> statement _flg se ca (AlterSequence ann nm op) =
>     annot ca ann <+>
>     text "alter sequence" <+> name nm
>     <+> alterOperation op <> statementEnd se
>     where
>       alterOperation (AlterSequenceOwned _ o) = 
>           text "owned by" <+> name o
>       alterOperation (AlterSequenceRename _ rnm) = 
>           text "rename to" <+> name rnm
>       alterOperation (AlterSequenceActions _ actions) = hsep $ map alterAction actions
>       alterAction (AlterSequenceIncrement _ incr) = 
>           text "increment by" <+> text (show incr)
>       alterAction (AlterSequenceMin _ minv) =
>           maybe (text "no minvalue") ((text "minvalue" <+>) . (text . show)) minv
>       alterAction (AlterSequenceMax _ maxv) =
>           maybe (text "no maxvalue") ((text "maxvalue" <+>) . (text . show)) maxv
>       alterAction (AlterSequenceStart _ start) = 
>           text "start with" <+> text (show start)
>       alterAction (AlterSequenceRestart _ restart) = 
>           text "restart" <+> text (maybe "" (("with " ++) . show) restart)
>       alterAction (AlterSequenceCache _ cache) = 
>           text "cache" <+> text (show cache)

>
> statement flg se ca (CreateTableAs ann t rep sel) =
>     annot ca ann <+>
>     text ("create " ++ (case rep of
>                          Replace -> "or replace "
>                          _ -> "") ++ "table")
>     <+> name t <+> text "as"
>     $+$ queryExpr flg True True Nothing sel
>     <> statementEnd se
>
> statement flg se ca (CreateFunction ann nm args retType rep lang body vol) =
>     annot ca ann <+>
>     text ("create " ++ (case rep of
>                          Replace -> "or replace "
>                          _ -> "") ++ "function")
>     <+> name nm
>     <+> parens (sepCsvMap paramDefn args)
>     <+> text "returns" <+> typeName retType <+> text "as" <+> text "$$"
>     $+$ functionBody body
>     $+$ text "$$" <+> text "language"
>     <+> text (case lang of
>                         Sql -> "sql"
>                         Plpgsql -> "plpgsql")
>     <+> text (case vol of
>                        Volatile -> "volatile"
>                        Stable -> "stable"
>                        Immutable -> "immutable")
>     <> statementEnd se
>     where
>       functionBody (SqlFnBody ann1 sts) =
>         annot ca ann1 <+>
>         nestedStatements flg ca sts
>       functionBody (PlpgsqlFnBody ann1 blk) =
>           annot ca ann1 <+>
>           statement flg True ca blk
>       paramDefn (ParamDef _ n t) = nmc n <+> typeName t
>       paramDefn  (ParamDefTp _ t) = typeName t
>
> statement flg se ca (Block ann lb decls sts) =
>   annot ca ann <+>
>   label lb <>
>   ifNotEmpty (\l -> text "declare"
>                   $+$ nest 2 (vcat $ map varDefn l)) decls
>   $+$ text "begin"
>   $+$ nestedStatements flg ca sts
>   $+$ text "end" <> statementEnd se
>   where
>       varDefn (VarDef _ n t v) =
>         nmc n <+> typeName t
>         <+> maybePrint (\x -> text ":=" <+> scalExpr flg x) v <> semi
>       varDefn (VarAlias _ n n1) =
>         nmc n <+> text "alias for" <+> name n1 <> semi
>       varDefn (ParamAlias _ n p) =
>         nmc n <+> text "alias for $" <> text (show p) <> semi
>
>
> statement flg se ca (CreateView ann nm cols sel) =
>     annot ca ann <+>
>     text "create view" <+> name nm
>     <> case cols of
>          Nothing -> empty
>          Just cs -> parens (sepCsvMap nmc cs)
>     <+> text "as"
>     $+$ nest 2 (queryExpr flg True True Nothing sel) <> statementEnd se
>
> statement flg se ca (AlterView ann nm cols sel) =
>     annot ca ann <+>
>     text "alter view" <+> name nm
>     <> case cols of
>          Nothing -> empty
>          Just cs -> parens (sepCsvMap nmc cs)
>     <+> text "as"
>     $+$ nest 2 (queryExpr flg True True Nothing sel) <> statementEnd se
>
> statement flg se ca (CreateDomain ann nm tp n ex) =
>     annot ca ann <+>
>     text "create domain" <+> name nm <+> text "as"
>     <+> typeName tp <+> cname <+> checkExp ex <> statementEnd se
>     where
>       checkExp = maybePrint (\e -> text "check" <+> parens (scalExpr flg e))
>       cname = if n == ""
>                then empty
>                else text "constraint" <+> ttext n
>
> statement _flg se ca (CreateDatabase ann nm) =
>     annot ca ann <+>
>     text "create database" <+> name nm <> statementEnd se

> statement _flg se ca (CreateSchema ann nm musr) =
>     annot ca ann <+> text "create schema" <+> nmc nm 
>     <+> case musr of
>           Nothing -> empty
>           Just u -> text "authorization" <+> name u
>     <> statementEnd se

> statement _flg se ca (AlterDatabase ann nm op) =
>     annot ca ann <+> text "alter database" <+>
>           name nm <+> alterDbOperation op <> statementEnd se
>     where
>      alterDbOperation (RenameDatabase _ nm') =
>       text "rename to" <+> name nm'

> statement _flg se ca (AlterSchema ann snm op) =
>     annot ca ann <+>
>     text "alter schema" <+> nmc snm
>     <+> alterOperation op <> statementEnd se
>     where
>       alterOperation (AlterSchemaName _ nsnm) = 
>           text "rename to" <+> nmc nsnm
>       alterOperation (AlterSchemaOwner _ nunm) = 
>           text "owner to" <+> name nunm

> statement _flg se ca (DropFunction ann ifE fns casc) =
>   annot ca ann <+>
>   text "drop function"
>   <+> ifExists ifE
>   <+> sepCsvMap doFunction fns
>   <+> cascade casc
>   <> statementEnd se
>   where
>     doFunction (nm,types) =
>       name nm <> parens (sepCsvMap typeName types)
>
> statement flg se ca (DropSomething ann dropType ifE names casc) =
>     annot ca ann <+>
>     text "drop"
>     <+> text (case dropType of
>                 Table -> "table"
>                 View -> "view"
>                 Domain -> "domain"
>                 Type -> "type"
>                 Database -> "database"
>                 User -> "user"
>                 Login -> "login"
>                 Schema -> "schema")
>     <+> ifExists ifE
>     <+> sepCsvMap name names
>     <+> case (diSyntaxFlavour $ ppDialect flg) of
>            SqlServer -> empty
>            _ -> cascade casc
>     <> statementEnd se
>
> statement _flg se ca (DropTrigger ann ifE nam tbn casc) =
>     annot ca ann <+>
>     text "drop"
>     <+> text "trigger"
>     <+> ifExists ifE
>     <+> nmc nam
>     <+> text "on"
>     <+> name tbn
>     <+> cascade casc
>     <> statementEnd se
>
> statement _flg se ca (CreateType ann nm atts) =
>     annot ca ann <+>
>     text "create type" <+> name nm <+> text "as" <+> lparen
>     $+$ nest 2 (vcat (csv
>           (map (\(TypeAttDef _ n t) -> nmc n <+> typeName t)  atts)))
>     $+$ rparen <> statementEnd se
>
> statement _flg se ca (CreateLanguage ann nm) =
>     annot ca ann <+>
>     text "create language" <+> ttext nm <> statementEnd se
>
> statement flg se ca (CreateTrigger ann nm wh events tbl firing fnName fnArgs) =
>     annot ca ann <+>
>     text "create trigger" <+> nmc nm
>     <+> text (case wh of
>                       TriggerBefore -> "before"
>                       TriggerAfter -> "after")
>     <+> evs
>     <+> text "on" <+> name tbl
>     <+> text "for" <+> text (case firing of
>                                         EachRow -> "row"
>                                         EachStatement -> "statement")
>     <+> text "execute procedure" <+> name fnName
>     <> parens (sepCsvMap (scalExpr flg) fnArgs) <> statementEnd se
>     where
>       evs = sep $ punctuate (text " or ") $ map
>             (text . (\e -> case e of
>                                 TInsert -> "insert"
>                                 TUpdate -> "update"
>                                 TDelete -> "delete"
>                                 AntiTriggerEvent s -> "$(" ++ s ++ ")")) events
>
> -- plpgsql
>
> statement _flg se ca (NullStatement ann) =
>   annot ca ann <+> text "null" <> statementEnd se
> statement _flg se ca (ExitStatement ann lb) =
>   annot ca ann <+> text "exit"
>     <+> maybe empty ttext lb <> statementEnd se
>

> statement flg se ca (Into ann str is (QueryStatement _ q)) =
>   annot ca ann <+>
>   queryExpr flg True True (Just (str,is)) q <> statementEnd se

> statement flg se ca (Into ann str into st) =
>   annot ca ann <+>
>   statement flg False ca st
>   <+> text "into"
>   <> (if str
>       then empty <+> text "strict"
>       else empty)
>   <+> sepCsvMap name into
>   <> statementEnd se
>   --fixme, should be insert,update,delete,execute

> statement flg se ca (Assignment ann nm val) =
>     annot ca ann <+>
>     name nm <+> text ":=" <+> scalExpr flg val <> statementEnd se
>
> statement flg se ca (Return ann ex) =
>     annot ca ann <+>
>     text "return" <+> maybePrint (scalExpr flg) ex <> statementEnd se
>
> statement flg se ca (ReturnNext ann ex) =
>     annot ca ann <+>
>     text "return" <+> text "next" <+> scalExpr flg ex <> statementEnd se
>
> statement flg se ca (ReturnQuery ann sel) =
>     annot ca ann <+>
>     text "return" <+> text "query"
>     <+> queryExpr flg True True Nothing sel <> statementEnd se
>
> statement flg se ca (Raise ann rt st exps) =
>     annot ca ann <+>
>     text "raise"
>     <+> case rt of
>                 RNotice -> text "notice"
>                 RException -> text "exception"
>                 RError -> text "error"
>     <+> scalExpr flg (StringLit emptyAnnotation st)
>     <> ifNotEmpty (\e -> comma <+> csvExp flg e) exps
>     <> statementEnd se
>
> statement flg se ca (ForQueryStatement ann lb i sel stmts) =
>     annot ca ann <+>
>     label lb <>
>     text "for" <+> nmc i <+> text "in"
>     <+> queryExpr flg True True Nothing sel <+> text "loop"
>     $+$ nestedStatements flg ca stmts
>     $+$ text "end loop" <> statementEnd se
>
> statement flg se ca (ForIntegerStatement ann lb var st en stmts) =
>     annot ca ann <+>
>     label lb <>
>     text "for" <+> nmc var <+> text "in"
>     <+> scalExpr flg st <+> text ".." <+> scalExpr flg en <+> text "loop"
>     $+$ nestedStatements flg ca stmts
>     $+$ text "end loop" <> statementEnd se
>
> statement flg se ca (WhileStatement ann lb ex stmts) =
>     annot ca ann <+>
>     label lb <>
>     text "while" <+> scalExpr flg ex <+> text "loop"
>     $+$ nestedStatements flg ca stmts
>     $+$ text "end loop" <> statementEnd se
> statement flg se ca (LoopStatement ann lb stmts) =
>     annot ca ann <+>
>     label lb <>
>     text "loop"
>     $+$ nestedStatements flg ca stmts
>     $+$ text "end loop" <> statementEnd se
>
> statement _flg se ca (ContinueStatement ann lb) =
>     annot ca ann <+> text "continue"
>       <+> maybe empty ttext lb <> statementEnd se
> statement flg se ca (Perform ann f@(App {})) =
>     annot ca ann <+>
>     text "perform" <+> scalExpr flg f <> statementEnd se
> statement _ _ _ (Perform _ x) =
>    error $ "internal error: statement not supported for " ++ show x
>
> statement _flg se ca (CopyFrom ann tb cols src opts) =
>     annot ca ann <+>
>     text "copy" <+> name tb
>     <+> ifNotEmpty (parens . sepCsvMap nmc) cols
>     <+> text "from"
>     <+> case src of
>                  CopyFilename s -> (quotes $ ttext s)
>                                    <+> copyFromOpts opts
>                                    <> statementEnd se

>                  Stdin -> text "stdin"
>                           <+> copyFromOpts opts
>                           -- put statement end without new line
>                           -- so that the copydata follows immediately after
>                           -- without an extra blank line inbetween
>                           <> statementEndNNL se

> statement flg se ca (CopyTo ann src fn opts) =
>     annot ca ann <+>
>     text "copy" <+> s src
>     <+> text "to"
>     <+> quotes (ttext fn)
>     <+> copyToOpts opts
>     <> statementEnd se
>     where
>       s (CopyTable tb cols) = name tb
>                               <+> ifNotEmpty (parens . sepCsvMap nmc) cols
>       s (CopyQuery qry) = parens (queryExpr flg True True Nothing qry)
>
> statement _ _ ca (CopyData ann s) =
>     annot ca ann <+>
>     tltext s <> text "\\." <> newline
>
> statement flg se ca (If ann conds els) =
>    if tsql
>    then
>      annot ca ann <+>
>      text "if" <+> scalExpr flg (fst $ head conds)
>                <+> blck (snd $ head conds)
>      $+$ ifNotEmpty (\e -> text "else" <+> blck e) els
>      <> statementEnd se
>    else
>      annot ca ann <+>
>      text "if" <+> constraintd (head conds)
>      $+$ vcat (map (\c -> text "elseif" <+> constraintd c) $ tail conds)
>      $+$ ifNotEmpty (\e -> text "else" $+$ nestedStatements flg ca e) els
>      $+$ text "end if" <> statementEnd se
>    where
>      constraintd (ex, sts) = scalExpr flg ex <+> text "then"
>                              $+$ nestedStatements flg ca sts
>      tsql = diSyntaxFlavour (ppDialect flg) == SqlServer
>      blck sts = sep [text "begin"
>                     ,nestedStatements flg ca sts
>                     ,text "end"]
> statement flg se ca (Execute ann s) =
>     annot ca ann <+>
>     text "execute" <+> scalExpr flg s <> statementEnd se
>
>
> statement flg se ca (CaseStatementSimple ann c conds els) =
>     annot ca ann <+>
>     text "case" <+> scalExpr flg c
>     $+$ nest 2 (
>                 vcat (map (uncurry whenStatement) conds)
>                 $+$ elseStatement els
>                 ) $+$ text "end case" <> statementEnd se
>     where
>       whenStatement ex sts = text "when" <+> sepCsvMap (scalExpr flg) ex
>                           <+> text "then" $+$ nestedStatements flg ca sts
>       elseStatement = ifNotEmpty (\s -> text "else"
>                                      $+$ nestedStatements flg ca s)
> statement flg se ca (CaseStatement ann conds els) =
>     annot ca ann <+>
>     text "case"
>     $+$ nest 2 (
>                 vcat (map (uncurry whenStatement) conds)
>                 $+$ elseStatement els
>                 ) $+$ text "end case" <> statementEnd se
>     where
>       whenStatement ex sts = text "when" <+> sepCsvMap (scalExpr flg) ex
>                           <+> text "then" $+$ nestedStatements flg ca sts
>       elseStatement = ifNotEmpty (\s -> text "else"
>                                      $+$ nestedStatements flg ca s)

> statement flg _se ca (DeclareStatement ann des) =
>   annot ca ann <+>
>   text "declare" <+> sepCsvMap de des
>   where
>     de (nm,ty,val) =
>       ttext nm <+> typeName ty
>       <+> maybe empty (\e -> text "=" <+> scalExpr flg e) val

>
> -- misc
>
> statement _flg se _ (Set _ n vs) =
>   text "set" <+> ttext n <+> text "="
>   <+> sepCsvMap (text . dv) vs <> statementEnd se
>   where
>     dv (SetStr _ s) = "'" ++ s ++ "'"
>     dv (SetId _ i) = i
>     dv (SetNum _ nm) = show nm
>
> statement _flg se _ (Notify _ n) =
>   text "notify" <+> ttext n  <> statementEnd se

> statement flg _se _ (ExecStatement _ nm args) =
>   text "exec" <+> name nm <+> sepCsvMap (scalExpr flg) args

> statement _flg _se _ (CreateIndexTSQL _ nm obj cols) =
>   text "create" <+> text "index"
>   <+> nmc nm <+> text "on"
>   <+> name obj <+> parens (sepCsvMap nmc cols)

> statement _flg _se _ (CreateUser _ nm pw) =
>   text "create user" <+> name nm
>   <+> text "with password=" <> quotes (text pw)

> statement _flg _se _ (CreateLogin _ nm pw) =
>   text "create login" <+> name nm
>   <+> text "with password=" <> quotes (text pw)

> statement _flg _se _ (AlterUser _ nm pw) =
>   text "alter user" <+> name nm
>   <+> text "with password=" <> quotes (text pw)

> statement _flg _se _ (AlterLogin _ nm pw) =
>   text "alter login" <+> name nm
>   <+> text "with password=" <> quotes (text pw)

> statementEnd :: Bool -> Doc
> statementEnd b = if b
>                  then semi <> newline
>                  else empty

> statementEndNNL :: Bool -> Doc
> statementEndNNL b = if b
>                     then semi
>                     else empty

> -- selects
>
> queryExpr :: PrettyFlags -> Bool -> Bool -> Maybe (Bool,[Name]) -> QueryExpr -> Doc
> queryExpr flg writeSelect _ intoi (Select _ dis l tb wh grp hav
>                                     order lim off hs) =
>   (text (if writeSelect then "select" else "")
>          <+> (case dis of
>                  All -> empty
>                  Distinct -> text "distinct"))
>          <+> (case lim of
>                  Just lime | useTop -> text "top" <+> scalExpr flg lime
>                  _ -> empty)
>   $+$ nest 2 (vcat $ catMaybes
>   [fmap (\(str,is) -> text "into"
>                       <+> (if str
>                            then text "strict"
>                            else empty)
>                       <+> sepCsvMap name is) intoi
>   ,Just $ nest 2 $ selectList flg l
>   ,Just $ if null tb
>           then empty
>           else text "from" $+$ nest 2 (sepCsvMap (tref flg) tb)
>   ,Just $ whr flg wh
>   ,case grp of
>      [] -> Nothing
>      g -> Just $ text "group by" $+$ nest 2 (sepCsvMap (scalExpr flg) g)
>   ,flip fmap hav $ \h -> text "having" $+$ nest 2 (scalExpr flg h)
>   ,Just $ orderBy flg order
>   ,if useTop then Nothing else flip fmap lim $ \lm -> text "limit" <+> scalExpr flg lm
>   ,flip fmap off $ \offs -> text "offset" <+> scalExpr flg offs
>   ,if null hs then Nothing else Just $ text "option" $+$ parens (sepCsvMap (text . prettyQueryHint) hs)
>   ])
>   where
>     useTop = (diSyntaxFlavour $ ppDialect flg) == SqlServer
>     prettyQueryHint QueryHintPartitionGroup = "partition group"
>     prettyQueryHint QueryHintColumnarHostGroup = "columnar host group"
>
> queryExpr flg writeSelect topLev _ (CombineQueryExpr _ tp s1 s2) =
>   let p = queryExpr flg writeSelect False Nothing  s1
>           $+$ (case tp of
>                        Except -> text "except"
>                        Union -> text "union"
>                        UnionAll -> text "union" <+> text "all"
>                        Intersect -> text "intersect")
>           $+$ queryExpr flg True False Nothing s2
>   in if topLev then p else parens p
> queryExpr flg _ _ _ (Values _ expss) =
>   text "values" $$ nest 2 (vcat $ csv $ map (parens . csvExp flg) expss)
> queryExpr flg _ _ _ (WithQueryExpr _ wqs ex) =
>   text "with" $$ nest 2 (vcat $ csv $ map pwq wqs)
>        $+$ queryExpr flg True False Nothing ex
>   where
>     pwq (WithQuery _ nm cs ex1) =
>       nmc nm <> case cs of
>                    Nothing -> empty
>                    Just cs' -> parens $ sepCsvMap nmc cs'
>       <+> text "as"
>       <+> parens (queryExpr flg True False Nothing ex1)

> name :: Name -> Doc
> name (Name _ ns) = nmcs ns
> name (AntiName n) = text ("$n(" ++ n ++ ")")

> nmcs :: [NameComponent] -> Doc
> nmcs ns = hcat $ punctuate (text ".") $ map nmc ns

> nmc :: NameComponent -> Doc
> nmc (Nmc ns) = ttext ns
> nmc (QNmc ns) = doubleQuotes $ ttext ns
> nmc (AntiNameComponent n) = text ("$m(" ++ n ++ ")")

>
> tref :: PrettyFlags -> TableRef -> Doc
> tref _ (Tref _ f) = name f
> tref flg (SubTref _ sub) =
>   parens (queryExpr flg True True Nothing sub)
> tref flg (FunTref _ f@(App {})) = scalExpr flg f
> tref _flg (FunTref _ x) =
>       error $ "internal error: node not supported in function tref: "
>             ++ show x
> tref flg (TableRefParens _ t) = parens (tref flg t)
> tref flg (OdbcTableRef _ t) = text "{oj" <+> tref flg t <> text "}"
> tref flg (TableAlias _ t tr) = maybeParen flg tr <+> text "as" <+> nmc t
> -- hack this out for now. When the type checking is fixed, can try
> -- to eliminate unneeded aliases?
> tref flg (FullAlias _ t s tr) =
>   maybeParen flg tr <+> text "as"
>   <+> nmc t <> parens (sepCsvMap nmc s)

> tref flg (JoinTref _ t1 nat jt ht t2 ex) =
>   sep [tref flg t1
>       ,hsep ([case nat of
>                 Natural -> text "natural"
>                 Unnatural -> empty
>             ,text $ case jt of
>                Inner -> "inner"
>                Cross -> "cross"
>                LeftOuter -> "left outer"
>                RightOuter -> "right outer"
>                FullOuter -> "full outer"]
>             ++ maybe [] (\h -> [text $ case h of
>                               Merge -> "merge"
>                               Loop -> "loop"
>                               Hash -> "hash"])
>                      ht
>             ++ [text "join"])
>       ,tref flg t2
>       ,maybePrint (nest 2 . joinScalarExpr) ex]
>   where
>     joinScalarExpr (JoinOn _ e) = text "on" <+> scalExpr flg e
>     joinScalarExpr (JoinUsing _ ids) =
>         text "using" <+> parens (sepCsvMap nmc ids)

> maybeParen :: PrettyFlags -> TableRef -> Doc
> --maybeParen flg t@(JoinTref {}) = parens $ tref flg t
> maybeParen = tref

> direction :: Direction -> Doc
> direction d = text $ case d of
>                           Asc -> "asc"
>                           Desc -> "desc"
>

> nullsOrder :: NullsOrder -> Doc
> nullsOrder d = case d of
>                     NullsDefault -> empty
>                     NullsFirst -> text "nulls " <+> text "first"
>                     NullsLast  -> text "nulls " <+> text "last"
>
> whr :: PrettyFlags -> Maybe ScalarExpr -> Doc
> whr flg (Just ex) = text "where" $+$ nest 2 (scalExpr flg ex)
> whr _ Nothing = empty
>
> selectList :: PrettyFlags -> SelectList -> Doc
> selectList flg (SelectList _ ex) =
>   sepCsvMap selectItem ex
>   where
>     selectItem (SelectItem _ ex1 nm) = scalExprSl flg ex1 <+> text "as" <+> nmc nm
>     selectItem (SelExp _ e) = scalExprSl flg e
>
> cascade :: Cascade -> Doc
> cascade casc = text $ case casc of
>                                  Cascade -> "cascade"
>                                  Restrict -> "restrict"

> copyToOpts :: [CopyToOption] -> Doc
> copyToOpts opts =
>   ifNotEmpty (const $ "with" <+> sep (map po opts)) opts
>   where
>       po (CopyToFormat s) = text "format" <+> text s
>       po (CopyToDelimiter s) = text "delimiter" <+> quotes (text s)
>       po (CopyToErrorLog s) = text "error_log" <+> quotes (text s)
>       po (CopyToErrorVerbosity s) = text "error_verbosity" <+> int s

> copyFromOpts :: [CopyFromOption] -> Doc
> copyFromOpts opts =
>   ifNotEmpty (const $ "with" <+> sep (map po opts)) opts
>   where
>       po (CopyFromFormat s) = text "format" <+> text s
>       po (CopyFromDelimiter s) = text "delimiter" <+> quotes (text s)
>       po (CopyFromErrorLog s) = text "error_log" <+> quotes (text s)
>       po (CopyFromErrorVerbosity s) = text "error_verbosity" <+> int s
>       po (CopyFromParsers s) = text "parsers" <+> quotes (text s)
>       po (CopyFromDirectory) = text "directory"
>       po (CopyFromOffset i) = text "offset" <+> integer i
>       po (CopyFromLimit i) = text "limit" <+> integer i
>       po (CopyFromErrorThreshold i) = text "stop after" <+> int i <+> text "errors"
>       po (CopyFromNewlineFormat n) = text "record delimiter" <+> text n
> -- ddl
>
> constraint :: PrettyFlags -> Constraint -> Doc
> constraint _flg (UniqueConstraint _ n c) =
>         mname n <+> text "unique"
>         <+> parens (sepCsvMap nmc c)
> constraint _flg (PrimaryKeyConstraint _ n p) =
>         mname n <+>
>         text "primary key"
>         <+> parens (sepCsvMap nmc p)
> constraint flg (CheckConstraint _ n c) =
>         mname n <+> text "check" <+> parens (scalExpr flg c)
> constraint _flg (ReferenceConstraint _ n at tb rat ondel onupd) =
>         mname n <+>
>         text "foreign key" <+> parens (sepCsvMap nmc at)
>         <+> text "references" <+> name tb
>         <+> ifNotEmpty (parens . sepCsvMap nmc) rat
>         <+> text "on update" <+> cascade onupd
>         <+> text "on delete" <+> cascade ondel
>
> mname :: String -> Doc
> mname n = if n == ""
>           then empty
>           else text "constraint" <+> text n
>
> returning :: PrettyFlags -> Maybe SelectList -> Doc
> returning flg l = case l of
>                 Nothing -> empty
>                 Just ls -> nest 2 (text "returning" <+> selectList flg ls)
>
> ifExists :: IfExists -> Doc
> ifExists i = case i of
>                         Require -> empty
>                         IfExists -> text "if exists"
>

> tablePartition :: Maybe TablePartitionDef -> Doc
> tablePartition Nothing = text ""
> tablePartition (Just (TablePartitionDef _ cn tf interval)) =
>      text "partition by range" <+> parens (nmc cn)
>      <> parens ((text "every") <+> (text $ show tf) <+> (intervalify interval))
>  where
>   intervalify = \x-> text $ case x of
>            Year -> "years"
>            Month -> "months"
>            Day -> "days"
>            Hour -> "hours"
>            Minute -> "minutes"
>            Second -> "seconds"
>            Millisecond -> "milliseconds"
>            -- _ -> "unknown type " ++ (show x)

> attrDef :: PrettyFlags -> AttributeDef -> Doc
> attrDef flg (AttributeDef _ n t def cons) =
>   nmc n <+> typeName t
>   <+> maybePrint (\e -> text "default" <+> scalExpr flg e) def
>   <+> hsep (map cCons cons)
>   where
>     cCons (NullConstraint _ cn) =
>       mname cn <+> text "null"
>     cCons (NotNullConstraint _ cn) =
>       mname cn <+> text "not null"
>     cCons (RowCheckConstraint _ cn ew) =
>       mname cn <+> text "check" <+> parens (scalExpr flg ew)
>     cCons (RowUniqueConstraint _ cn) =
>       mname cn <+> text "unique"
>     cCons (RowPrimaryKeyConstraint _ cn) =
>       mname cn <+> text "primary key"
>     cCons (RowReferenceConstraint _ cn tb att ondel onupd) =
>       mname cn <+> text "references" <+> name tb
>       <+> maybePrint (parens . nmc) att
>       <+> text "on delete" <+> cascade ondel
>       <+> text "on update" <+> cascade onupd
>     cCons (IdentityConstraint _ cn si) = 
>       mname cn <+> text "identity" <> text (maybe "" show si)
> -- plpgsql
>
> nestedStatements :: PrettyFlags -> (Annotation -> String) -> [Statement] -> Doc
> nestedStatements flg pa = nest 2 . vcat . map (statement flg True pa)
>
> typeName :: TypeName -> Doc
> typeName (SimpleTypeName _ s) = name s
> typeName (PrecTypeName _ s i) = name s <> parens(integer i)
> typeName (Prec2TypeName _ s i i1) = name s <> parens (sepCsv [integer i, integer i1])
> typeName (ArrayTypeName _ t) = typeName t <> text "[]"
> typeName (SetOfTypeName _ t) = text "setof" <+> typeName t
>
> ppType:: Type -> Doc
> ppType (ScalarType t) = text "scalar type" <> parens (text $ T.unpack t)
> ppType (DomainType t) = text "domain type" <> parens (text $ T.unpack t)
> ppType (EnumType t) = text "enum type" <> parens (text $ T.unpack t)
> ppType (UnknownType) = text "unknown type"
> ppType (ArrayType t) = text "array type" <> parens (ppType t)
> ppType (NamedCompositeType t) = text "named composite type" <> parens (text $ T.unpack t)
> ppType (CompositeType ts)
>     = text "composite type"
>       <> brackets (sepCsv
>                     $ map (\(t,te)
>                           -> parens $ sepCsv [text (T.unpack t), typeExtra te])
>                         ts)
> ppType (TrefType ts)
>     = text "tref type"
>       <> brackets (sepCsv
>                     $ map (\((t1,t2),te)
>                           -> parens $ sepCsv
>                                 [parens $ sepCsv
>                                     [text (T.unpack t1)
>                                     ,text (T.unpack t2)]
>                                 , typeExtra te])
>                         ts)
> ppType (AnonymousCompositeType ts)
>     = text "anonymous composite type"
>       <> brackets (sepCsv $ map ppType ts)
> ppType (Pseudo _) = text "pseudo type"
>
> typeExtra:: TypeExtra -> Doc
> typeExtra te = parens $ sepCsv
>     [ppType (teType te)
>     ,ppPrec "precision" (tePrecision te)
>     ,ppPrec "scale" (teScale te)
>     ,ppNullability (teNullable te)]

> ppPrec :: String -> Maybe Int -> Doc
> ppPrec precType prec = case prec of
>     Nothing -> text $ "no " ++ precType
>     Just p -> text $ precType ++ ' ':show p

> ppNullability :: Bool -> Doc
> ppNullability n = text $ (if n then "" else "not ") ++ "nullable"
>
> -- expressions
>
> scalExpr :: PrettyFlags -> ScalarExpr -> Doc
> scalExpr flg (Parens _ e) = parens (scalExpr flg e)
> scalExpr _ (AntiScalarExpr s) = text $ "$(" ++ s ++ ")"
> scalExpr _ (Star _) = text "*"
> scalExpr _ (QStar _ i) = nmc i <> text ".*"
> scalExpr _ (Identifier _ (AntiName _)) = error "Antiname component"

> scalExpr _flg (Identifier _a (Name _ is)) =
>   hcat (punctuate (text ".") (map nmc is))

> scalExpr _ (NumberLit _ n) = ttext n
> scalExpr _ (StringLit _ s) = -- needs some thought about using $$?
>                           text "'" <> ttext replaceQuotes <> text "'"
>                           where
>                             replaceQuotes = replace "'" "''" s
>
> scalExpr flg (SpecialOp _ n es) =
>    case getTName n of
>      Just "arrayctor" -> text "array" <> brackets (csvExp flg es)
>      Just "between" -> scalExpr flg (head es) <+> text "between"
>                         <+> scalExpr flg (es !! 1)
>                         <+> text "and"
>                         <+> scalExpr flg (es !! 2)
>      Just "notbetween" -> scalExpr flg (head es) <+> text "not between"
>                         <+> scalExpr flg (es !! 1)
>                         <+> text "and"
>                         <+> scalExpr flg (es !! 2)
>      Just "substring" -> text "substring"
>                      <> parens (scalExpr flg (head es)
>                                 <+> text "from" <+> scalExpr flg (es !! 1)
>                                 <+> text "for" <+> scalExpr flg (es !! 2))
>      Just "arraysub" ->
>        case es of
>                (Identifier _ i : es1) -> name i
>                                          <> brackets (csvExp flg es1)
>                (e:es') -> scalExpr flg e
>                           <> brackets (csvExp flg es')
>                _ -> error $ "bad args to !arraysub: " ++ show es
>      Just "rowctor" -> text "row" <> parens (sepCsvMap (scalExpr flg) es)
>      x -> error $ "bad special operator name: " ++ show x

> scalExpr flg (BinaryOp _ n e0 e1) =
>    case getTName n of
>      Just "and" | otherwise -> sep [scalExpr flg e0
>                                    ,text "and"
>                                    ,scalExpr flg e1]
>      Just n' | Just n'' <- lookup n' [("or","or")
>                                      ,("like","like")
>                                      ,("rlike","rlike")
>                                      ,("notlike","not like")] ->
>        scalExpr flg e0
>        <+> text n''
>        <+> scalExpr flg e1
>      Just "."   -- special case to avoid ws around '.'. Don't know if this is important
>                 -- or just cosmetic
>          -> scalExpr flg e0 <> text "." <> scalExpr flg e1
>      Just n' -> scalExpr flg e0 <+> ttext n' <+> scalExpr flg e1
>      Nothing -> error $ "bad binary operator name:" ++ show n

> scalExpr flg (PrefixOp _ n e0)
>   | Just "not" <- getTName n =
>       text "not" <+> scalExpr flg e0
>   | Just n' <- getTName n =
>       ttext n'
>     <+> scalExpr flg e0
>   | otherwise = error $ "bad prefix operator name:" ++ show n

> scalExpr flg (PostfixOp _ n e0)
>   | Just n' <- getTName n >>= flip lookup [("isnull", "is null")
>                                           ,("isnotnull", "is not null")] =
>        scalExpr flg e0 <+> ttext n'
>   | Just n' <- getTName n =
>       scalExpr flg e0 <+> ttext n'
>   | otherwise = error $ "bad postfix operator name:" ++ show n

> scalExpr flg (App _ n es) =
>   name n <> parens (csvExp flg es)