123 lines
3.6 KiB
Plaintext
123 lines
3.6 KiB
Plaintext
|
|
This is the pretty printer code which takes AST values and turns them
|
|
back into SQL source text. It attempts to format the output nicely.
|
|
|
|
> module Language.SQL.SimpleSQL.Pretty
|
|
> (prettyQueryExpr
|
|
> ,prettyScalarExpr
|
|
> ) where
|
|
|
|
> import Language.SQL.SimpleSQL.Syntax
|
|
> import Text.PrettyPrint
|
|
> import Data.Maybe
|
|
|
|
> prettyQueryExpr :: QueryExpr -> String
|
|
> prettyQueryExpr = render . queryExpr
|
|
|
|
> prettyScalarExpr :: ScalarExpr -> String
|
|
> prettyScalarExpr = render . scalarExpr
|
|
|
|
|
|
= scalar expressions
|
|
|
|
> scalarExpr :: ScalarExpr -> Doc
|
|
> scalarExpr (Literal s) = quotes $ text s
|
|
> scalarExpr (Identifier i) = text i
|
|
> scalarExpr (Identifier2 q i) = text q <> text "." <> text i
|
|
> scalarExpr Star = text "*"
|
|
> scalarExpr (Star2 q) = text q <> text "." <> text "*"
|
|
|
|
> scalarExpr (App f es) = text f <> parens (commaSep (map scalarExpr es))
|
|
> scalarExpr (Op f [e]) = text f <+> scalarExpr e
|
|
> scalarExpr (Op f [e0,e1]) =
|
|
> sep [scalarExpr e0, text f, scalarExpr e1]
|
|
|
|
> scalarExpr (Op f es) =
|
|
> -- TODO: how to handle this? error or either seems poor
|
|
> text f <> parens (commaSep (map scalarExpr es))
|
|
|
|
> scalarExpr (Case t ws els) =
|
|
> sep [text "case" <+> (maybe empty scalarExpr t)
|
|
> ,nest 4 (sep ((map w ws)
|
|
> ++ maybeToList (fmap e els)))
|
|
> ,text "end"]
|
|
> where
|
|
> w (t0,t1) = sep [text "when" <+> scalarExpr t0
|
|
> ,text "then" <+> scalarExpr t1]
|
|
> e el = text "else" <+> scalarExpr el
|
|
> scalarExpr (Parens e) = parens $ scalarExpr e
|
|
|
|
= query expressions
|
|
|
|
> queryExpr :: QueryExpr -> Doc
|
|
> queryExpr (Select sl fr wh gb hv od) =
|
|
> sep [text "select"
|
|
> ,nest 4 $ sep [selectList sl]
|
|
> ,from fr
|
|
> ,whr wh
|
|
> ,grpBy gb
|
|
> ,having hv
|
|
> ,orderBy od]
|
|
|
|
> selectList :: [(Maybe String, ScalarExpr)] -> Doc
|
|
> selectList is = commaSep $ map si is
|
|
> where
|
|
> si (al,e) = scalarExpr e <+> maybe empty alias al
|
|
> alias al = text "as" <+> text al
|
|
|
|
> from :: [TableRef] -> Doc
|
|
> from [] = empty
|
|
> from ts =
|
|
> sep [text "from"
|
|
> ,nest 4 $ commaSep $ map tr ts]
|
|
> where
|
|
> tr (SimpleTableRef t) = text t
|
|
> tr (JoinAlias t a) = tr t <+> text "as" <+> text a
|
|
> tr (JoinParens t) = parens $ tr t
|
|
> tr (JoinQueryExpr q) = parens $ queryExpr q
|
|
> tr (JoinTableRef jt t0 t1 jc) =
|
|
> sep [tr t0
|
|
> ,joinText jt jc
|
|
> ,tr t1
|
|
> ,joinCond jc]
|
|
> joinText jt jc =
|
|
> sep [case jc of
|
|
> Just JoinNatural -> text "natural"
|
|
> _ -> empty
|
|
> ,case jt of
|
|
> Inner -> text "inner"
|
|
> JLeft -> text "left"
|
|
> JRight -> text "right"
|
|
> Full -> text "full"
|
|
> Cross -> text "cross"
|
|
> ,text "join"]
|
|
> joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e
|
|
> joinCond (Just (JoinUsing es)) = text "using" <+> parens (commaSep $ map text es)
|
|
> joinCond Nothing = empty
|
|
> joinCond (Just JoinNatural) = empty
|
|
|
|
> whr :: Maybe ScalarExpr -> Doc
|
|
> whr = maybe empty
|
|
> (\w -> sep [text "where"
|
|
> ,nest 4 $ scalarExpr w])
|
|
|
|
> grpBy :: [ScalarExpr] -> Doc
|
|
> grpBy [] = empty
|
|
> grpBy gs = sep [text "group by"
|
|
> ,nest 4 $ commaSep $ map scalarExpr gs]
|
|
|
|
> having :: Maybe ScalarExpr -> Doc
|
|
> having = maybe empty
|
|
> (\w -> sep [text "having"
|
|
> ,nest 4 $ scalarExpr w])
|
|
> orderBy :: [ScalarExpr] -> Doc
|
|
> orderBy [] = empty
|
|
> orderBy os = sep [text "order by"
|
|
> ,nest 4 $ commaSep $ map scalarExpr os]
|
|
|
|
|
|
= utils
|
|
|
|
> commaSep :: [Doc] -> Doc
|
|
> commaSep ds = sep $ punctuate comma ds
|