From e3be820dfb4a4d433e0adc310c77750a8c418280 Mon Sep 17 00:00:00 2001 From: Jake Wheat <jakewheatmail@gmail.com> Date: Fri, 13 Dec 2013 15:05:32 +0200 Subject: [PATCH] pretty printer, minor clean ups clean up some warnings update the cabal file add pretty printer add pretty printing tests --- Parser.lhs | 11 ++-- Pretty.lhs | 114 ++++++++++++++++++++++++++++++++++++++-- TODO | 19 +++---- Tests.lhs | 22 ++++++-- simple-sql-parser.cabal | 67 ++++++----------------- 5 files changed, 157 insertions(+), 76 deletions(-) diff --git a/Parser.lhs b/Parser.lhs index 28f6039..294644d 100644 --- a/Parser.lhs +++ b/Parser.lhs @@ -2,15 +2,12 @@ > module Parser (parseQueryExpr > ,parseScalarExpr -> ,ParseError(..)) where +> ,ParseError) where > import Text.Groom > import Text.Parsec > import Control.Monad.Identity > import Control.Applicative hiding (many, (<|>), optional) -> import Debug.Trace -> import Data.List -> import Text.Parsec.Expr > import qualified Language.Haskell.Exts.Syntax as HSE > import qualified Language.Haskell.Exts.Fixity as HSE > import Data.Maybe @@ -200,9 +197,9 @@ to be. > tref = choice [try (JoinQueryExpr <$> parens queryExpr) > ,JoinParens <$> parens tref > ,SimpleTableRef <$> identifierString] -> >>= optionSuffix join +> >>= optionSuffix pjoin > >>= optionSuffix alias -> join tref0 = +> pjoin tref0 = > choice > [try (keyword_ "natural") *> keyword_ "inner" > *> conditionlessSuffix tref0 Inner (Just JoinNatural) @@ -217,7 +214,7 @@ to be. > ,try (keyword_ "cross") > *> conditionlessSuffix tref0 Cross Nothing > ] -> >>= optionSuffix join +> >>= optionSuffix pjoin > outerJoinSuffix tref0 jt = > optional (keyword_ "outer") *> conditionSuffix tref0 jt > conditionSuffix tref0 jt = diff --git a/Pretty.lhs b/Pretty.lhs index ca2bc71..3838072 100644 --- a/Pretty.lhs +++ b/Pretty.lhs @@ -2,12 +2,118 @@ 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 Pretty (pretty, prettyScalarExpr) where +> module Pretty (prettyQueryExpr, prettyScalarExpr) where > import Syntax +> import Text.PrettyPrint +> import Data.Maybe -> pretty :: QueryExpr -> String -> pretty = undefined +> prettyQueryExpr :: QueryExpr -> String +> prettyQueryExpr = render . queryExpr > prettyScalarExpr :: ScalarExpr -> String -> prettyScalarExpr = undefined +> 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 diff --git a/TODO b/TODO index 81039ea..9854ed6 100644 --- a/TODO +++ b/TODO @@ -1,24 +1,24 @@ -add tests -left factor parsing code +add tests to cabal -implement pretty printer - -reimplement the fixity thing natively +haddock dialect switching -fix lexing wrt suffixes + +left factor parsing code + +reimplement the fixity thing natively + +fix lexing wrt suffixes 1/2 done position annotation emacs parse error formatting -haddock = sql support -count(*) decimal literals, split string and number literals order by directions distinct/all @@ -59,12 +59,13 @@ group by (), grouping sets(), cube, rollup lateral corresponding named windows +table, values cte apply, pivot full tableref aliases collate - within group aggregate syntax + try to do full review of sql2003 query syntax maybe later: other dml \ No newline at end of file diff --git a/Tests.lhs b/Tests.lhs index ef8bf50..57529e4 100644 --- a/Tests.lhs +++ b/Tests.lhs @@ -1,5 +1,5 @@ -> module Tests (testData) where +> module Tests (testData, runTests) where > import Syntax > import Pretty @@ -239,12 +239,24 @@ > itemToTest (Group nm ts) = > H.TestLabel nm $ H.TestList $ map itemToTest ts > itemToTest (TestScalarExpr str expected) = -> toTest parseScalarExpr str expected +> toTest parseScalarExpr prettyScalarExpr str expected > itemToTest (TestQueryExpr str expected) = -> toTest parseQueryExpr str expected +> toTest parseQueryExpr prettyQueryExpr str expected -> toTest parser str expected = H.TestLabel str $ H.TestCase $ do +> toTest :: (Eq a, Show a, Show e) => +> (String -> Maybe (Int,Int) -> String -> Either e a) +> -> (a -> String) +> -> String +> -> a +> -> H.Test +> toTest parser pp str expected = H.TestLabel str $ H.TestCase $ do > let egot = parser "" Nothing str > case egot of > Left e -> H.assertFailure $ show e -> Right got -> H.assertEqual "" expected got +> Right got -> do +> H.assertEqual "" expected got +> let str' = pp got +> let egot' = parser "" Nothing str' +> case egot' of +> Left e' -> H.assertFailure $ "pp roundtrip " ++ show e' +> Right got' -> H.assertEqual "pp roundtrip" expected got' diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index dec1997..f311d3c 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -1,70 +1,35 @@ --- Initial simple-sql-parser.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - --- The name of the package. name: simple-sql-parser - --- The package version. See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented. --- http://www.haskell.org/haskellwiki/Package_versioning_policy --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change version: 0.1.0.0 - --- A short (one-line) description of the package. synopsis: A parser for SQL queries --- A longer description of the package. --- description: +description: A parser for SQL queries, using Parsec. Also includes pretty printer. Aims to support most of SQL2003 queries. --- URL for the project homepage or repository. -homepage: xx - --- The license under which the package is released. +homepage: https://github.com/JakeWheat/simple_sql_parser license: BSD3 - --- The file containing the license text. license-file: LICENSE - --- The package author(s). author: Jake Wheat - --- An email address to which users can send suggestions, bug reports, and --- patches. maintainer: jakewheatmail@gmail.com - --- A copyright notice. --- copyright: - -category: Database - +copyright: Copyright Jake Wheat 2013 +category: Database,Language build-type: Simple - --- Extra files to be distributed with the package, such as examples or a --- README. --- extra-source-files: - --- Constraint on the version of Cabal needed to build this package. +extra-source-files: README,LICENSE cabal-version: >=1.10 +bug-reports: https://github.com/JakeWheat/simple_sql_parser/issues +source-repository head + type: git + location: https://github.com/JakeWheat/simple_sql_parser.git library - -- Modules exported by the library. exposed-modules: Pretty, Parser, Syntax - - -- Modules included in this library but not exported. -- other-modules: - - -- LANGUAGE extensions used by modules in this package. -- other-extensions: - - -- Other library packages from which modules are imported. - build-depends: base >=4.6 && <4.7, groom >=0.1 && <0.2, parsec >=3.1 && <3.2, mtl >=2.1 && <2.2, haskell-src-exts >=1.14 && <1.15 - - -- Directories containing source files. + build-depends: base >=4.6 && <4.7, + groom >=0.1 && <0.2, + parsec >=3.1 && <3.2, + mtl >=2.1 && <2.2, + haskell-src-exts >=1.14 && <1.15, + pretty >= 1.1 && < 1.2 -- hs-source-dirs: - - -- Base language which the package is written in. default-language: Haskell2010 - \ No newline at end of file + ghc-options: -Wall \ No newline at end of file