reorganise

move exe example to examples/
get rid of the second example
move tests to tests/
don't shadow show in Pretty

.gitignore

@@ -5,4 +5,6 @@
 /build/
 /.stack-work/
 /.ghc.environment.*
-/dist-newstyle/
+dist-newstyle/
+/cabal.project.local
+.emacs.*

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,

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
 
 ###############################################
 

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

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

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

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)