diff --git a/.gitignore b/.gitignore index 166bd3e..bda5365 100644 --- a/.gitignore +++ b/.gitignore @@ -5,4 +5,6 @@ /build/ /.stack-work/ /.ghc.environment.* -/dist-newstyle/ +dist-newstyle/ +/cabal.project.local +.emacs.* diff --git a/Language/SQL/SimpleSQL/Pretty.hs b/Language/SQL/SimpleSQL/Pretty.hs index 556a078..7b0d1eb 100644 --- a/Language/SQL/SimpleSQL/Pretty.hs +++ b/Language/SQL/SimpleSQL/Pretty.hs @@ -16,9 +16,6 @@ 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 Prelude hiding (show) -import qualified Prelude as P - import Prettyprinter (Doc ,nest ,punctuate @@ -91,7 +88,7 @@ scalarExpr _ (IntervalLit s v f t) = scalarExpr _ (Iden i) = names i scalarExpr _ Star = pretty "*" scalarExpr _ Parameter = pretty "?" -scalarExpr _ (PositionalArg n) = pretty $ T.cons '$' $ show n +scalarExpr _ (PositionalArg n) = pretty $ T.cons '$' $ showText n scalarExpr _ (HostParameter p i) = pretty p <+> me (\i' -> pretty "indicator" <+> pretty i') i @@ -281,7 +278,7 @@ scalarExpr d (OdbcFunc e) = scalarExpr d (Convert t e Nothing) = pretty "convert(" <> typeName t <> pretty "," <+> scalarExpr d e <> pretty ")" scalarExpr d (Convert t e (Just i)) = - pretty "convert(" <> typeName t <> pretty "," <+> scalarExpr d e <> pretty "," <+> pretty (show i) <> pretty ")" + pretty "convert(" <> typeName t <> pretty "," <+> scalarExpr d e <> pretty "," <+> pretty (showText i) <> pretty ")" unname :: Name -> Text unname (Name Nothing n) = n @@ -301,12 +298,12 @@ names ns = hcat $ punctuate (pretty ".") $ map name ns typeName :: TypeName -> Doc a typeName (TypeName t) = names t -typeName (PrecTypeName t a) = names t <+> parens (pretty $ show a) +typeName (PrecTypeName t a) = names t <+> parens (pretty $ showText a) typeName (PrecScaleTypeName t a b) = - names t <+> parens (pretty (show a) <+> comma <+> pretty (show b)) + names t <+> parens (pretty (showText a) <+> comma <+> pretty (showText b)) typeName (PrecLengthTypeName t i m u) = names t - <> parens (pretty (show i) + <> parens (pretty (showText i) <> me (\case PrecK -> pretty "K" PrecM -> pretty "M" @@ -318,7 +315,7 @@ typeName (PrecLengthTypeName t i m u) = PrecOctets -> pretty "OCTETS") u) typeName (CharTypeName t i cs col) = (names t - <> me (\x -> parens (pretty $ show x)) i) + <> me (\x -> parens (pretty $ showText x)) i) <+> (if null cs then mempty else pretty "character set" <+> names cs) @@ -327,7 +324,7 @@ typeName (CharTypeName t i cs col) = else pretty "collate" <+> names col) typeName (TimeTypeName t i tz) = (names t - <> me (\x -> parens (pretty $ show x)) i) + <> me (\x -> parens (pretty $ showText x)) i) <+> pretty (if tz then "with time zone" else "without time zone") @@ -341,7 +338,7 @@ typeName (IntervalTypeName f t) = <+> me (\x -> pretty "to" <+> intervalTypeField x) t typeName (ArrayTypeName tn sz) = - typeName tn <+> pretty "array" <+> me (brackets . pretty . show) sz + typeName tn <+> pretty "array" <+> me (brackets . pretty . showText) sz typeName (MultisetTypeName tn) = typeName tn <+> pretty "multiset" @@ -350,8 +347,8 @@ intervalTypeField :: IntervalTypeField -> Doc a intervalTypeField (Itf n p) = pretty n <+> me (\(x,x1) -> - parens (pretty (show x) - <+> me (\y -> sep [comma,pretty (show y)]) x1)) p + parens (pretty (showText x) + <+> me (\y -> sep [comma,pretty (showText y)]) x1)) p -- = query expressions @@ -741,12 +738,12 @@ sequenceGeneratorOption :: SequenceGeneratorOption -> Doc a sequenceGeneratorOption (SGODataType t) = pretty "as" <+> typeName t sequenceGeneratorOption (SGORestart mi) = - pretty "restart" <+> maybe mempty (\mi' -> texts ["with", show mi']) mi -sequenceGeneratorOption (SGOStartWith i) = texts ["start", "with", show i] -sequenceGeneratorOption (SGOIncrementBy i) = texts ["increment", "by", show i] -sequenceGeneratorOption (SGOMaxValue i) = texts ["maxvalue", show i] + pretty "restart" <+> maybe mempty (\mi' -> texts ["with", showText mi']) mi +sequenceGeneratorOption (SGOStartWith i) = texts ["start", "with", showText i] +sequenceGeneratorOption (SGOIncrementBy i) = texts ["increment", "by", showText i] +sequenceGeneratorOption (SGOMaxValue i) = texts ["maxvalue", showText i] sequenceGeneratorOption SGONoMaxValue = texts ["no", "maxvalue"] -sequenceGeneratorOption (SGOMinValue i) = texts ["minvalue", show i] +sequenceGeneratorOption (SGOMinValue i) = texts ["minvalue", showText i] sequenceGeneratorOption SGONoMinValue = texts ["no", "minvalue"] sequenceGeneratorOption SGOCycle = pretty "cycle" sequenceGeneratorOption SGONoCycle = pretty "no cycle" @@ -873,8 +870,8 @@ texts ts = sep $ map pretty ts pretty :: Text -> Doc a pretty = P.pretty -show :: Show a => a -> Text -show = T.pack . P.show +showText :: Show a => a -> Text +showText = T.pack . show -- restore the correct behaviour of mempty -- this doesn't quite work when you chain <> and <+> together, diff --git a/Makefile b/Makefile index 30b4a7c..b80b28f 100644 --- a/Makefile +++ b/Makefile @@ -6,13 +6,12 @@ .PHONY : build build : - cabal build --enable-tests -fparserexe + cabal build .PHONY : test test : cabal run test:Tests -- --hide-successes --ansi-tricks=false - .PHONY : test-coverage test-coverage : cabal test --enable-coverage @@ -24,8 +23,10 @@ clean : .PHONY : parserexe parserexe : - cabal build -fparserexe SimpleSqlParserTool + cabal build -fparserexe SimpleSQLParserTool +.PHONY : all +all : build test parserexe ############################################### diff --git a/TODO b/TODO index 15df9c4..d5a05ba 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,5 @@ -Some random notes on what could be done with the package in the future. None of this is scheduled. - -The most important thing is adding more support for needed SQL. Everything else is very secondary to this. +Some random notes on what could be done with the package in the +future. None of this is scheduled. Infrastructure -------------- @@ -78,7 +77,9 @@ use this lib to build a typesafe sql wrapper for haskell optimise the lexer: add some benchmarks do some experiments with left factoring - try to use the token approach with megaparsec + try to use the match approach with megaparsec + see if it's work using something other than megaparsec for the lexer + or// maybe it's no longer worth having a separate lexer? rewrite bits of the parser, lots of it is a bit questionable - an expert with megaparsec would write something simpler diff --git a/tools/SimpleSqlParserTool.hs b/examples/SimpleSQLParserTool.hs similarity index 94% rename from tools/SimpleSqlParserTool.hs rename to examples/SimpleSQLParserTool.hs index 78091b9..f00e94d 100644 --- a/tools/SimpleSqlParserTool.hs +++ b/examples/SimpleSQLParserTool.hs @@ -50,12 +50,12 @@ commands = [("help", helpCommand) ,("parse", parseCommand) ,("lex", lexCommand) - ,("indent", indentCommand)] + ,("format", formatCommand)] showHelp :: Maybe String -> IO () showHelp msg = do maybe (return ()) (\e -> putStrLn $ "Error: " ++ e) msg - putStrLn "Usage:\n SimpleSqlParserTool command args" + putStrLn "Usage:\n SimpleSQLParserTool command args" forM_ commands $ \(c, (h,_)) -> do putStrLn $ c ++ "\t" ++ h when (isJust msg) $ exitFailure @@ -93,8 +93,8 @@ lexCommand = ) -indentCommand :: (String,[String] -> IO ()) -indentCommand = +formatCommand :: (String,[String] -> IO ()) +formatCommand = ("parse then pretty print SQL from file/stdin/command line (use -c to parse from command line)" ,\args -> do (f,src) <- getInput args diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index 08978de..ce32c08 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -28,11 +28,7 @@ source-repository head location: https://github.com/JakeWheat/simple-sql-parser.git Flag parserexe - Description: Build SimpleSqlParserTool exe - Default: False - -Flag exampleexe - Description: Build simple sql parser example exe + Description: Build SimpleSQLParserTool exe Default: False common shared-properties @@ -60,7 +56,7 @@ Test-Suite Tests import: shared-properties type: exitcode-stdio-1.0 main-is: RunTests.hs - hs-source-dirs: tools + hs-source-dirs: tests Build-Depends: simple-sql-parser, tasty >= 1.1 && < 1.6, tasty-hunit >= 0.9 && < 0.11 @@ -91,24 +87,13 @@ Test-Suite Tests ghc-options: -threaded -executable SimpleSqlParserTool +executable SimpleSQLParserTool import: shared-properties - main-is: SimpleSqlParserTool.hs - hs-source-dirs: tools + main-is: SimpleSQLParserTool.hs + hs-source-dirs: examples Build-Depends: simple-sql-parser, pretty-show >= 1.6 && < 1.10 if flag(parserexe) buildable: True else buildable: False - -executable SimpleSQLParserExample - import: shared-properties - main-is: SimpleSQLParserExample.hs - hs-source-dirs: tools - Build-Depends: simple-sql-parser, - pretty-show >= 1.6 && < 1.10 - if flag(exampleexe) - buildable: True - else - buildable: False diff --git a/tools/Filter.hs b/tests/Filter.hs similarity index 100% rename from tools/Filter.hs rename to tests/Filter.hs diff --git a/tools/FilterSpaces.hs b/tests/FilterSpaces.hs similarity index 100% rename from tools/FilterSpaces.hs rename to tests/FilterSpaces.hs diff --git a/tools/Language/SQL/SimpleSQL/CreateIndex.hs b/tests/Language/SQL/SimpleSQL/CreateIndex.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/CreateIndex.hs rename to tests/Language/SQL/SimpleSQL/CreateIndex.hs diff --git a/tools/Language/SQL/SimpleSQL/CustomDialect.hs b/tests/Language/SQL/SimpleSQL/CustomDialect.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/CustomDialect.hs rename to tests/Language/SQL/SimpleSQL/CustomDialect.hs diff --git a/tools/Language/SQL/SimpleSQL/EmptyStatement.hs b/tests/Language/SQL/SimpleSQL/EmptyStatement.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/EmptyStatement.hs rename to tests/Language/SQL/SimpleSQL/EmptyStatement.hs diff --git a/tools/Language/SQL/SimpleSQL/ErrorMessages.hs b/tests/Language/SQL/SimpleSQL/ErrorMessages.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/ErrorMessages.hs rename to tests/Language/SQL/SimpleSQL/ErrorMessages.hs diff --git a/tools/Language/SQL/SimpleSQL/FullQueries.hs b/tests/Language/SQL/SimpleSQL/FullQueries.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/FullQueries.hs rename to tests/Language/SQL/SimpleSQL/FullQueries.hs diff --git a/tools/Language/SQL/SimpleSQL/GroupBy.hs b/tests/Language/SQL/SimpleSQL/GroupBy.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/GroupBy.hs rename to tests/Language/SQL/SimpleSQL/GroupBy.hs diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.hs b/tests/Language/SQL/SimpleSQL/LexerTests.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/LexerTests.hs rename to tests/Language/SQL/SimpleSQL/LexerTests.hs diff --git a/tools/Language/SQL/SimpleSQL/MySQL.hs b/tests/Language/SQL/SimpleSQL/MySQL.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/MySQL.hs rename to tests/Language/SQL/SimpleSQL/MySQL.hs diff --git a/tools/Language/SQL/SimpleSQL/Odbc.hs b/tests/Language/SQL/SimpleSQL/Odbc.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/Odbc.hs rename to tests/Language/SQL/SimpleSQL/Odbc.hs diff --git a/tools/Language/SQL/SimpleSQL/Oracle.hs b/tests/Language/SQL/SimpleSQL/Oracle.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/Oracle.hs rename to tests/Language/SQL/SimpleSQL/Oracle.hs diff --git a/tools/Language/SQL/SimpleSQL/Postgres.hs b/tests/Language/SQL/SimpleSQL/Postgres.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/Postgres.hs rename to tests/Language/SQL/SimpleSQL/Postgres.hs diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.hs b/tests/Language/SQL/SimpleSQL/QueryExprComponents.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/QueryExprComponents.hs rename to tests/Language/SQL/SimpleSQL/QueryExprComponents.hs diff --git a/tools/Language/SQL/SimpleSQL/QueryExprs.hs b/tests/Language/SQL/SimpleSQL/QueryExprs.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/QueryExprs.hs rename to tests/Language/SQL/SimpleSQL/QueryExprs.hs diff --git a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.hs b/tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/SQL2011AccessControl.hs rename to tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Bits.hs b/tests/Language/SQL/SimpleSQL/SQL2011Bits.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/SQL2011Bits.hs rename to tests/Language/SQL/SimpleSQL/SQL2011Bits.hs diff --git a/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs b/tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs rename to tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Queries.hs b/tests/Language/SQL/SimpleSQL/SQL2011Queries.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/SQL2011Queries.hs rename to tests/Language/SQL/SimpleSQL/SQL2011Queries.hs diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.hs b/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/SQL2011Schema.hs rename to tests/Language/SQL/SimpleSQL/SQL2011Schema.hs diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.hs b/tests/Language/SQL/SimpleSQL/ScalarExprs.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/ScalarExprs.hs rename to tests/Language/SQL/SimpleSQL/ScalarExprs.hs diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.hs b/tests/Language/SQL/SimpleSQL/TableRefs.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/TableRefs.hs rename to tests/Language/SQL/SimpleSQL/TableRefs.hs diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.hs b/tests/Language/SQL/SimpleSQL/TestTypes.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/TestTypes.hs rename to tests/Language/SQL/SimpleSQL/TestTypes.hs diff --git a/tools/Language/SQL/SimpleSQL/Tests.hs b/tests/Language/SQL/SimpleSQL/Tests.hs similarity index 90% rename from tools/Language/SQL/SimpleSQL/Tests.hs rename to tests/Language/SQL/SimpleSQL/Tests.hs index 1857e1b..59b9fce 100644 --- a/tools/Language/SQL/SimpleSQL/Tests.hs +++ b/tests/Language/SQL/SimpleSQL/Tests.hs @@ -133,17 +133,19 @@ toTest parser pp d str expected = H.testCase (T.unpack str) $ do let egot = parser d "" Nothing str case egot of Left e -> H.assertFailure $ T.unpack $ prettyError e - Right got -> do - H.assertEqual "" expected got - let str' = pp d got - let egot' = parser d "" Nothing str' - case egot' of - Left e' -> H.assertFailure $ "pp roundtrip" - ++ "\n" ++ (T.unpack str') - ++ (T.unpack $ prettyError e') - Right got' -> H.assertEqual - ("pp roundtrip" ++ "\n" ++ T.unpack str') - expected got' + Right got -> H.assertEqual "" expected got + + let str' = pp d expected + egot' = parser d "" Nothing str' + case egot' of + Left e' -> + H.assertFailure $ "pp roundtrip" + ++ "\n" ++ (T.unpack str') + ++ (T.unpack $ prettyError e') + Right got' -> + H.assertEqual + ("pp roundtrip" ++ "\n" ++ T.unpack str') + expected got' toPTest :: (Eq a, Show a) => (Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a) diff --git a/tools/Language/SQL/SimpleSQL/Tpch.hs b/tests/Language/SQL/SimpleSQL/Tpch.hs similarity index 100% rename from tools/Language/SQL/SimpleSQL/Tpch.hs rename to tests/Language/SQL/SimpleSQL/Tpch.hs diff --git a/tools/RunTests.hs b/tests/RunTests.hs similarity index 100% rename from tools/RunTests.hs rename to tests/RunTests.hs diff --git a/tools/ShowErrors.hs b/tests/ShowErrors.hs similarity index 100% rename from tools/ShowErrors.hs rename to tests/ShowErrors.hs diff --git a/tools/SimpleSQLParserExample.hs b/tests/SimpleSQLParserExample.hs similarity index 100% rename from tools/SimpleSQLParserExample.hs rename to tests/SimpleSQLParserExample.hs