From 301ee009d01b5c69c387e566681334001ccfdf41 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Wed, 10 Jan 2024 16:10:00 +0000 Subject: [PATCH] fix pretty printer formatting --- Language/SQL/SimpleSQL/Pretty.hs | 94 +++++++++++++++++++------------- 1 file changed, 56 insertions(+), 38 deletions(-) diff --git a/Language/SQL/SimpleSQL/Pretty.hs b/Language/SQL/SimpleSQL/Pretty.hs index 8de4c08..93418b6 100644 --- a/Language/SQL/SimpleSQL/Pretty.hs +++ b/Language/SQL/SimpleSQL/Pretty.hs @@ -19,20 +19,20 @@ import Prelude hiding (show) import qualified Prelude as P import Prettyprinter (Doc - ,parens ,nest - ,(<+>) - ,sep ,punctuate ,comma ,squotes ,vsep - ,hsep ,layoutPretty ,defaultLayoutOptions ,brackets + ,align + ,hcat + ,line ) import qualified Prettyprinter as P +import Prettyprinter.Internal.Type (Doc(Empty)) import Prettyprinter.Render.Text (renderStrict) @@ -55,7 +55,7 @@ prettyScalarExpr d = render . scalarExpr d -- | A terminating semicolon. terminator :: Doc a -terminator = pretty ";\n" +terminator = pretty ";" <> line -- | Convert a statement ast to concrete syntax. prettyStatement :: Dialect -> Statement -> Text @@ -98,13 +98,13 @@ scalarExpr _ (HostParameter p i) = scalarExpr d (App f es) = names f <> parens (commaSep (map (scalarExpr d) es)) scalarExpr dia (AggregateApp f d es od fil) = - names f + (names f <> parens ((case d of Distinct -> pretty "distinct" All -> pretty "all" SQDefault -> mempty) <+> commaSep (map (scalarExpr dia) es) - <+> orderBy dia od) + <+> orderBy dia od)) <+> me (\x -> pretty "filter" <+> parens (pretty "where" <+> scalarExpr dia x)) fil @@ -120,8 +120,8 @@ scalarExpr d (WindowApp f es pb od fr) = <+> pretty "over" <+> parens ((case pb of [] -> mempty - _ -> pretty "partition by" - <+> nest 13 (commaSep $ map (scalarExpr d) pb)) + _ -> (pretty "partition by") <+> align + (commaSep $ map (scalarExpr d) pb)) <+> orderBy d od <+> me frd fr) where @@ -138,11 +138,13 @@ scalarExpr d (WindowApp f es pb od fr) = fpd (Preceding e) = scalarExpr d e <+> pretty "preceding" fpd (Following e) = scalarExpr d e <+> pretty "following" -scalarExpr dia (SpecialOp nm [a,b,c]) | nm `elem` [[Name Nothing "between"] - ,[Name Nothing "not between"]] = +scalarExpr dia (SpecialOp nm [a,b,c]) + | nm `elem` [[Name Nothing "between"] + ,[Name Nothing "not between"]] = sep [scalarExpr dia a - ,names nm <+> scalarExpr dia b - ,nest (T.length (unnames nm) + 1) $ pretty "and" <+> scalarExpr dia c] + ,names nm <+> nest ((T.length (unnames nm) - 3)) (sep + [scalarExpr dia b + ,pretty "and" <+> scalarExpr dia c])] scalarExpr d (SpecialOp [Name Nothing "rowctor"] as) = parens $ commaSep $ map (scalarExpr d) as @@ -181,10 +183,11 @@ scalarExpr dia (Case t ws els) = <> [pretty "end"] where w (t0,t1) = - pretty "when" <+> nest 5 (commaSep $ map (scalarExpr dia) t0) - <+> pretty "then" <+> nest 5 (scalarExpr dia t1) - e el = pretty "else" <+> nest 5 (scalarExpr dia el) -scalarExpr d (Parens e) = parens $ scalarExpr d e + pretty "when" <+> align (sep [commaSep $ map (scalarExpr dia) t0 + ,pretty "then" <+> align (scalarExpr dia t1)]) + e el = pretty "else" <+> align (scalarExpr dia el) +scalarExpr d (Parens e) = + parens (scalarExpr d e) scalarExpr d (Cast e tn) = pretty "cast" <> parens (sep [scalarExpr d e ,pretty "as" @@ -219,8 +222,7 @@ scalarExpr d (In b se x) = scalarExpr d se <+> (if b then mempty else pretty "not") <+> pretty "in" - <+> parens (nest (if b then 3 else 7) $ - case x of + <+> parens (case x of InList es -> commaSep $ map (scalarExpr d) es InQueryExpr qe -> queryExpr d qe) @@ -294,7 +296,7 @@ name (Name Nothing n) = pretty n name (Name (Just (s,e)) n) = pretty s <> pretty n <> pretty e names :: [Name] -> Doc a -names ns = hsep $ punctuate (pretty ".") $ map name ns +names ns = hcat $ punctuate (pretty ".") $ map name ns typeName :: TypeName -> Doc a typeName (TypeName t) = names t @@ -314,8 +316,8 @@ typeName (PrecLengthTypeName t i m u) = PrecCharacters -> pretty "CHARACTERS" PrecOctets -> pretty "OCTETS") u) typeName (CharTypeName t i cs col) = - names t - <> me (\x -> parens (pretty $ show x)) i + (names t + <> me (\x -> parens (pretty $ show x)) i) <+> (if null cs then mempty else pretty "character set" <+> names cs) @@ -323,8 +325,8 @@ typeName (CharTypeName t i cs col) = then mempty else pretty "collate" <+> names col) typeName (TimeTypeName t i tz) = - names t - <> me (\x -> parens (pretty $ show x)) i + (names t + <> me (\x -> parens (pretty $ show x)) i) <+> pretty (if tz then "with time zone" else "without time zone") @@ -355,12 +357,12 @@ intervalTypeField (Itf n p) = queryExpr :: Dialect -> QueryExpr -> Doc a queryExpr dia (Select d sl fr wh gb hv od off fe) = - sep [pretty "select" - ,case d of - SQDefault -> mempty - All -> pretty "all" - Distinct -> pretty "distinct" - ,nest 7 $ sep [selectList dia sl] + sep [pretty "select" <+> align (sep + [case d of + SQDefault -> mempty + All -> pretty "all" + Distinct -> pretty "distinct" + ,selectList dia sl]) ,from dia fr ,maybeScalarExpr dia "where" wh ,grpBy dia gb @@ -423,8 +425,7 @@ selectList d is = commaSep $ map si is from :: Dialect -> [TableRef] -> Doc a from _ [] = mempty from d ts = - sep [pretty "from" - ,nest 5 $ vsep $ punctuate comma $ map tr ts] + pretty "from" <+> align (vsep (punctuate comma $ map tr ts)) where tr (TRSimple t) = names t tr (TRLateral t) = pretty "lateral" <+> tr t @@ -454,13 +455,11 @@ from d ts = maybeScalarExpr :: Dialect -> Text -> Maybe ScalarExpr -> Doc a maybeScalarExpr d k = me - (\e -> sep [pretty k - ,nest (T.length k + 1) $ scalarExpr d e]) + (\e -> pretty k <+> align (scalarExpr d e)) grpBy :: Dialect -> [GroupingExpr] -> Doc a grpBy _ [] = mempty -grpBy d gs = sep [pretty "group by" - ,nest 9 $ commaSep $ map ge gs] +grpBy d gs = pretty "group by" <+> align (commaSep $ map ge gs) where ge (SimpleGroup e) = scalarExpr d e ge (GroupingParens g) = parens (commaSep $ map ge g) @@ -470,8 +469,7 @@ grpBy d gs = sep [pretty "group by" orderBy :: Dialect -> [SortSpec] -> Doc a orderBy _ [] = mempty -orderBy dia os = sep [pretty "order by" - ,nest 9 $ commaSep $ map f os] +orderBy dia os = pretty "order by" <+> align (commaSep $ map f os) where f (SortSpec e d n) = scalarExpr dia e @@ -876,3 +874,23 @@ pretty = P.pretty show :: Show a => a -> Text show = T.pack . P.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 = P.sep . filter isEmpty + where + isEmpty Empty = False + isEmpty _ = True + +(<+>) :: Doc a -> Doc a -> Doc a +(<+>) a b = case (a,b) of + (Empty, Empty) -> Empty + (Empty, x) -> x + (x, Empty) -> x + _ -> a P.<+> b + +parens :: Doc a -> Doc a +parens a = P.parens (align a)