replace error messages tool with golden test approach

.gitignore

@@ -8,3 +8,4 @@
 dist-newstyle/
 /cabal.project.local
 .emacs.*
+/expected-parse-errors/actual

examples/ErrorMessagesTool.hs

@@ -1,514 +0,0 @@
-{-
-
-tool to compare before and after on error messages, suggested use:
-add any extra parse error examples below
-run it on baseline code
-run it on the modified code
-use meld on the two resulting csvs
-  bear in mind that " will appear as "" because of csv escaping
-
-this is how to generate a csv of errors:
-
-cabal -ftestexe build error-messages-tool && cabal -ftestexe run error-messages-tool -- generate | cabal -ftestexe run error-messages-tool -- test > res.csv
-
-TODO:
-think about making a regression test with this
-can add some more tools:
-there's a join mode to join two sets of results, could add a filter
-  to remove rows that are the same
-  but finding the different rows in meld seems to work well enough
-figure out if you can display visual diffs between pairs of cells in localc
-implement the tagging feature, one idea for working with it:
-you generate a bunch of error messages
-you eyeball the list, and mark some as good, some as bad
-then when you update, you can do a compare which filters
-  to keep any errors that have changed, and any that haven't
-  changed but are not marked as good
-etc.
-
--}
-
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE LambdaCase #-}
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Text.Show.Pretty (ppShow)
-import qualified Text.RawString.QQ as R
-
-import Language.SQL.SimpleSQL.Parse
-    (prettyError
-    ,parseQueryExpr
-    ,parseScalarExpr
---    ,parseStatement
---    ,parseStatements
-    ,ansi2011
---    ,ParseError(..)
-    )
---import qualified Language.SQL.SimpleSQL.Lex as L
-
-import Language.SQL.SimpleSQL.Dialect
-    (postgres
-    ,Dialect(..)
-    ,sqlserver
-    ,mysql
-    )
-
-import System.Environment (getArgs)
-import Data.Csv
-    (encode
-    ,decode
-    ,HasHeader(..))
-
-import qualified Data.ByteString.Lazy as B hiding (pack)
-import Data.ByteString.Lazy (ByteString)
-import qualified Data.ByteString.Lazy.Char8 as B (putStrLn)
-import qualified Data.Vector as V
-import Data.Vector (Vector)
-
-import           Database.SQLite.Simple
-    (open
-    ,execute_
-    ,executeMany
-    ,query_
-    )
-
-main :: IO ()
-main = do
-
-    as <- getArgs
-    case as of
-        ["generate"] -> B.putStrLn generateData
-        ["test"] -> do
-            txt <- B.getContents
-            B.putStrLn $ runTests txt
-        ["compare", f1, f2] -> do
-            c1 <- B.readFile f1
-            c2 <- B.readFile f2
-            B.putStrLn =<< compareFiles c1 c2
-        _ -> error $ "unsupported arguments: " <> show as
-
-------------------------------------------------------------------------------
-
--- compare two files
-{-
-
-take two inputs
-assume they have (testrunid, parser, dialect, src, res,tags) lines
-do a full outer join between them, on
-  parser,dialect,src
-so you have
-parser,dialect,src,res a, tags a, res b, tags b
-
-then output this as the result
-
-see what happens if you highlight the differences in localc, edit some
-tags, then save as csv - does the highlighting just disappear leaving
-the interesting data only?
-
--}
-    
-
-compareFiles :: ByteString -> ByteString -> IO ByteString
-compareFiles csva csvb = do
-    let data1 :: [(Text,Text,Text,Text,Text,Text)]
-        data1 = either (error . show) V.toList $ decode NoHeader csva
-        data2 :: [(Text,Text,Text,Text,Text,Text)]
-        data2 = either (error . show) V.toList $ decode NoHeader csvb
-    conn <- open ":memory:"
-    execute_ conn [R.r|
-create table data1 (
-    testrunida text,
-    parser text,
-    dialect text,
-    source text,
-    result_a text,
-    tags_a text)|]
-    execute_ conn [R.r|
-create table data2 (
-    testrunidb text,
-    parser text,
-    dialect text,
-    source text,
-    result_b text,
-    tags_b text)|]
-    
-    executeMany conn "insert into data1 values (?,?,?,?,?,?)" data1
-    executeMany conn "insert into data2 values (?,?,?,?,?,?)" data2
-    r <- query_ conn [R.r|
-select
-   parser, dialect, source, result_a, tags_a, result_b, tags_b
-from data1 natural full outer join data2|] :: IO [(Text,Text,Text,Text,Text,Text,Text)]
-
-    pure $ encode r
-
-------------------------------------------------------------------------------
-
--- running tests
-
-runTests :: ByteString -> ByteString
-runTests csvsrc =
-    let csv :: Vector (Text,Text,Text)
-        csv = either (error . show) id $ decode NoHeader csvsrc
-
-        testrunid = ("0" :: Text)
-    
-        testLine (parser,dialect,src) =
-            let d = case dialect of
-                    "ansi2011" -> ansi2011
-                    "postgres" -> postgres
-                    "sqlserver" -> sqlserver
-                    "mysql" -> mysql
-                    "params" -> ansi2011{diAtIdentifier=True, diHashIdentifier= True}
-                    "odbc" -> ansi2011{diOdbc=True}
-                    _ -> error $ "unknown dialect: " <> T.unpack dialect
-                res = case parser of
-                        "queryExpr" ->
-                            either prettyError (T.pack . ppShow)
-                            $ parseQueryExpr d "" Nothing src
-                        "scalarExpr" ->
-                            either prettyError (T.pack . ppShow)
-                            $ parseScalarExpr d "" Nothing src
-                        _ -> error $ "unknown parser: " <> T.unpack parser
-                -- prepend a newline to multi line fields, so they show
-                -- nice in a diff in meld or similar
-                resadj = if '\n' `T.elem` res
-                         then T.cons '\n' res
-                         else res
-            in (testrunid, parser, dialect, src, resadj,"" :: Text)
-
-        allres = V.map testLine csv
-    in encode $ V.toList allres
-                
-------------------------------------------------------------------------------
-
--- generating data
-
-generateData :: ByteString
-generateData =
-    encode $ concat
-    [simpleExpressions1
-    ,pgExprs
-    ,sqlServerIden
-    ,mysqliden
-    ,paramvariations
-    ,odbcexpr
-    ,odbcqexpr
-    ,otherParseErrorExamples]
-
---------------------------------------
-
--- example data
-
-parseExampleStrings :: Text -> [Text]
-parseExampleStrings = filter (not . T.null) . map T.strip . T.splitOn ";"
-
-simpleExpressions1 :: [(Text,Text,Text)]
-simpleExpressions1 =
-    concat $ flip map (parseExampleStrings simpleExprData) $ \e ->
-    [("scalarExpr", "ansi2011", e)
-    ,("queryExpr", "ansi2011", "select " <> e)
-    ,("queryExpr", "ansi2011", "select " <> e <> ",")
-    ,("queryExpr", "ansi2011", "select " <> e <> " from")]
-  where
-    simpleExprData = [R.r|
-'test
-;
-'test''t
-;
-'test''
-;
-3.23e-
-;
-.
-;
-3.23e
-;
-a.3
-;
-3.a
-;
-3.2a
-;
-4iden
-;
-4iden.
-;
-iden.4iden
-;
-4iden.*
-;
-from
-;
-from.a
-;
-a.from
-;
-not
-;
-4 +
-;
-4 + from
-;
-(5
-;
-(5 +
-;
-(5 + 6
-;
-(5 + from)
-;
-case
-;
-case a
-;
-case a when b c end
-;
-case a when b then c
-;
-case a else d end
-;
-case a from c end
-;
-case a when from then to end
-;
-/* blah
-;
-/* blah /* stuff */
-;
-/* *
-;
-/* /
-;
-$$something$
-;
-$$something
-;
-$$something
-x
-;
-$a$something$b$
-;
-$a$
-;
-'''
-;
-'''''
-;
-"a
-;
-"a""
-;
-"""
-;
-"""""
-;
-""
-;
-*/
-;
-:3
-;
-@3
-;
-#3
-;
-:::
-;
-|||
-;
-...
-;
-"
-;
-]
-;
-)
-;
-[test
-;
-[]
-;
-[[test]]
-;
-`open
-;
-```
-;
-``
-;
-}
-;
-mytype(4 '4';
-;
-app(3
-;
-app(
-;
-app(something
-;
-count(*
-;
-count(* filter (where something > 5)
-;
-count(*) filter (where something > 5
-;
-count(*) filter (
-;
-sum(a over (order by b)
-;
-sum(a) over (order by b
-;
-sum(a) over (
-;
-rank(a,c within group (order by b)
-;
-rank(a,c) within group (order by b
-;
-rank(a,c) within group (
-;
-array[
-;
-|]
-
-pgExprs :: [(Text,Text,Text)]
-pgExprs = flip map (parseExampleStrings src) $ \e ->
-    ("scalarExpr", "postgres", e)
-  where src = [R.r|
-$$something$
-;
-$$something
-;
-$$something
-x
-;
-$a$something$b$
-;
-$a$
-;
-:::
-;
-|||
-;
-...
-;
-
-|]
-
-sqlServerIden :: [(Text,Text,Text)]
-sqlServerIden = flip map (parseExampleStrings src) $ \e ->
-    ("scalarExpr", "sqlserver", e)
-  where src = [R.r|
-]
-;
-[test
-;
-[]
-;
-[[test]]
-
-|]
-
-mysqliden :: [(Text,Text,Text)]
-mysqliden = flip map (parseExampleStrings src) $ \e ->
-    ("scalarExpr", "mysql", e)
-  where src = [R.r|
-`open
-;
-```
-;
-``
-
-|]
-
-paramvariations :: [(Text,Text,Text)]
-paramvariations = flip map (parseExampleStrings src) $ \e ->
-    ("scalarExpr", "params", e)
-  where src = [R.r|
-:3
-;
-@3
-;
-#3
-
-|]
-
-
-odbcexpr :: [(Text,Text,Text)]
-odbcexpr = flip map (parseExampleStrings src) $ \e ->
-    ("scalarExpr", "odbc", e)
-  where src = [R.r|
-{d '2000-01-01'
-;
-{fn CHARACTER_LENGTH(string_exp)
-
-|]
-
-odbcqexpr :: [(Text,Text,Text)]
-odbcqexpr = flip map (parseExampleStrings src) $ \e ->
-    ("queryExpr", "odbc", e)
-  where src = [R.r|
-select * from {oj t1 left outer join t2 on expr
-
-|]
-
-
-    
-otherParseErrorExamples :: [(Text,Text,Text)]
-otherParseErrorExamples = flip map (parseExampleStrings src) $ \e ->
-    ("queryExpr", "ansi2011", e)
-  where src = [R.r|
-select a select
-;
-select a from t,
-;
-select a from t select
-;
-select a from t(a)
-;
-select a from (t
-;
-select a from (t having
-;
-select a from t a b
-;
-select a from t as
-;
-select a from t as having
-;
-select a from (1234)
-;
-select a from (1234
-;
-select a from a wrong join b
-;
-select a from a natural wrong join b
-;
-select a from a left wrong join b
-;
-select a from a left wrong join b
-;
-select a from a join b select
-;
-select a from a join b on select
-;
-select a from a join b on (1234
-;
-select a from a join b using(a
-;
-select a from a join b using(a,
-;
-select a from a join b using(a,)
-;
-select a from a join b using(1234
-;
-select a from t order no a
-;
-select a from t order by a where c
-;
-select 'test
-'
-
-|]

examples/SimpleSQLParserTool.hs

@@ -38,7 +38,8 @@ main = do
     args <- getArgs
     case args of
         [] -> do
-              showHelp $ Just "no command given"
+              -- exit with 0 in this case
+              showHelp Nothing --  $ Just "no command given"
         (c:as) -> do
              let cmd = lookup c commands
              maybe (showHelp (Just "command not recognised"))

simple-sql-parser.cabal

@@ -33,7 +33,6 @@ Flag testexe
   Description: Build Testing exe
   Default:     False
 
-
 common shared-properties
   default-language:    Haskell2010
   build-depends:       base >=4 && <5,
@@ -43,9 +42,7 @@ common shared-properties
                        prettyprinter >= 1.7 && < 1.8,
                        text >= 2.0 && < 2.2,
                        containers >= 0.6 && < 0.8
-
   ghc-options:         -Wall
-
   
 library
   import:              shared-properties
@@ -65,6 +62,9 @@ Test-Suite Tests
                        hspec-megaparsec,
                        hspec-expectations,
                        raw-strings-qq,
+                       hspec-golden,
+                       filepath,
+                       pretty-show,
 
   Other-Modules:       Language.SQL.SimpleSQL.ErrorMessages,
                        Language.SQL.SimpleSQL.FullQueries,
@@ -94,8 +94,10 @@ Test-Suite Tests
                        
   ghc-options:         -threaded
 
-executable SimpleSQLParserTool
+-- this is a testing tool, do some dumb stuff to hide the dependencies in hackage
+Test-Suite SimpleSQLParserTool
   import:              shared-properties
+  type:                exitcode-stdio-1.0
   main-is:             SimpleSQLParserTool.hs
   hs-source-dirs:      examples
   Build-Depends:       simple-sql-parser,
@@ -105,22 +107,3 @@ executable SimpleSQLParserTool
   else
     buildable:         False
 
-executable error-messages-tool
-  import:              shared-properties
-  main-is:             ErrorMessagesTool.hs
-  hs-source-dirs:      examples
-  Build-Depends:       base,
-                       text,
-                       raw-strings-qq,
-                       containers,
-                       megaparsec,
-                       simple-sql-parser,
-                       pretty-show,
-                       bytestring,
-                       cassava,
-                       vector,
-                       sqlite-simple,
-  if flag(testexe)
-    buildable:         True
-  else
-    buildable:         False

tests/Language/SQL/SimpleSQL/ErrorMessages.hs

@@ -1,12 +1,10 @@
 
 {-
-See the file examples/ErrorMessagesTool.hs for some work on this
 
-TODO:
+Quick tests for error messages, all the tests use the entire formatted
-
+output of parse failures to compare, it's slightly fragile. Most of
-add simple test to check the error and quoting on later line in multi
+the tests use a huge golden file which contains tons of parse error
-line input for lexing and parsing; had a regression here that made it
+examples.
-to a release
 
 -}
 
@@ -28,8 +26,14 @@ import Debug.Trace
 
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Test.Hspec.Golden
+    (Golden(..)
+    )
 
 import qualified Text.RawString.QQ as R
+import System.FilePath ((</>))
+import Text.Show.Pretty (ppShow)
 
 errorMessageTests :: TestItem
 errorMessageTests = Group "error messages"
@@ -65,9 +69,11 @@ order by 1,2,3 $@
   |                ^
 unexpected '$'
 |]
+   ,let fn = "expected-parse-errors"
+        got = generateParseResults parseErrorData
+    in GoldenErrorTest fn parseErrorData $ it "parse error regressions" $ myGolden (T.unpack fn) got
         ]
   where
-    
     gp :: (Show a, HasCallStack) => (Text -> Either e a) -> (e -> Text) -> Text -> Text -> TestItem
     gp parse pret src err =
         GeneralParseFailTest src err $
@@ -80,3 +86,612 @@ unexpected '$'
                             trace (T.unpack ("check\n[" <> pret f <>"]\n["<> err <> "]\n"))
                        _ -> id
            in quickTrace (f1 `ex` err)
+
+------------------------------------------------------------------------------
+
+-- golden parse error tests
+    
+myGolden :: String -> Text -> Golden Text
+myGolden name actualOutput =
+  Golden {
+    output = actualOutput,
+    encodePretty = show,
+    writeToFile = T.writeFile,
+    readFromFile = T.readFile,
+    goldenFile = name </> "golden",
+    actualFile = Just (name </> "actual"),
+    failFirstTime = False
+  }
+
+parseErrorData :: [(Text,Text,Text)]
+parseErrorData =
+    concat
+    [simpleExpressions1
+    ,pgExprs
+    ,sqlServerIden
+    ,mysqliden
+    ,paramvariations
+    ,odbcexpr
+    ,odbcqexpr
+    ,queryExprExamples
+    ,statementParseErrorExamples]
+
+generateParseResults :: [(Text,Text,Text)] -> Text
+generateParseResults dat =
+    let testLine (parser,dialect,src) =
+            let d = case dialect of
+                    "ansi2011" -> ansi2011
+                    "postgres" -> postgres
+                    "sqlserver" -> sqlserver
+                    "mysql" -> mysql
+                    "params" -> ansi2011{diAtIdentifier=True, diHashIdentifier= True}
+                    "odbc" -> ansi2011{diOdbc=True}
+                    _ -> error $ "unknown dialect: " <> T.unpack dialect
+                res = case parser of
+                        "queryExpr" ->
+                            either prettyError (T.pack . ppShow)
+                            $ parseQueryExpr d "" Nothing src
+                        "scalarExpr" ->
+                            either prettyError (T.pack . ppShow)
+                            $ parseScalarExpr d "" Nothing src
+                        "statement" ->
+                            either prettyError (T.pack . ppShow)
+                            $ parseStatement d "" Nothing src
+                        _ -> error $ "unknown parser: " <> T.unpack parser
+                -- prepend a newline to multi line fields, so they show
+                -- nice in a diff in meld or similar
+                resadj = if '\n' `T.elem` res
+                         then T.cons '\n' res
+                         else res
+            in T.unlines [parser, dialect, src, resadj]
+    in T.unlines $ map testLine dat
+
+parseExampleStrings :: Text -> [Text]
+parseExampleStrings = filter (not . T.null) . map T.strip . T.splitOn ";"
+
+simpleExpressions1 :: [(Text,Text,Text)]
+simpleExpressions1 =
+    concat $ flip map (parseExampleStrings simpleExprData) $ \e ->
+    [("scalarExpr", "ansi2011", e)
+    ,("queryExpr", "ansi2011", "select " <> e)
+    ,("queryExpr", "ansi2011", "select " <> e <> ",")
+    ,("queryExpr", "ansi2011", "select " <> e <> " from")]
+  where
+    simpleExprData = [R.r|
+'test
+;
+'test''t
+;
+'test''
+;
+3.23e-
+;
+.
+;
+3.23e
+;
+a.3
+;
+3.a
+;
+3.2a
+;
+4iden
+;
+4iden.
+;
+iden.4iden
+;
+4iden.*
+;
+from
+;
+from.a
+;
+a.from
+;
+not
+;
+4 +
+;
+4 + from
+;
+(5
+;
+(5 +
+;
+(5 + 6
+;
+(5 + from)
+;
+case
+;
+case a
+;
+case a when b c end
+;
+case a when b then c
+;
+case a else d end
+;
+case a from c end
+;
+case a when from then to end
+;
+/* blah
+;
+/* blah /* stuff */
+;
+/* *
+;
+/* /
+;
+$$something$
+;
+$$something
+;
+$$something
+x
+;
+$a$something$b$
+;
+$a$
+;
+'''
+;
+'''''
+;
+"a
+;
+"a""
+;
+"""
+;
+"""""
+;
+""
+;
+*/
+;
+:3
+;
+@3
+;
+#3
+;
+:::
+;
+|||
+;
+...
+;
+"
+;
+]
+;
+)
+;
+[test
+;
+[]
+;
+[[test]]
+;
+`open
+;
+```
+;
+``
+;
+}
+;
+mytype(4 '4';
+;
+app(3
+;
+app(
+;
+app(something
+;
+app(something,
+;
+count(*
+;
+count(* filter (where something > 5)
+;
+count(*) filter (where something > 5
+;
+count(*) filter (
+;
+sum(a over (order by b)
+;
+sum(a) over (order by b
+;
+sum(a) over (
+;
+rank(a,c within group (order by b)
+;
+rank(a,c) within group (order by b
+;
+rank(a,c) within group (
+;
+array[
+;
+(a
+;
+(
+;
+a >*
+;
+a >* b
+;
+( ( a
+;
+( ( a )
+;
+( ( a  + )
+|]
+
+pgExprs :: [(Text,Text,Text)]
+pgExprs = flip map (parseExampleStrings src) $ \e ->
+    ("scalarExpr", "postgres", e)
+  where src = [R.r|
+$$something$
+;
+$$something
+;
+$$something
+x
+;
+$a$something$b$
+;
+$a$
+;
+:::
+;
+|||
+;
+...
+;
+
+|]
+
+sqlServerIden :: [(Text,Text,Text)]
+sqlServerIden = flip map (parseExampleStrings src) $ \e ->
+    ("scalarExpr", "sqlserver", e)
+  where src = [R.r|
+]
+;
+[test
+;
+[]
+;
+[[test]]
+
+|]
+
+mysqliden :: [(Text,Text,Text)]
+mysqliden = flip map (parseExampleStrings src) $ \e ->
+    ("scalarExpr", "mysql", e)
+  where src = [R.r|
+`open
+;
+```
+;
+``
+
+|]
+
+paramvariations :: [(Text,Text,Text)]
+paramvariations = flip map (parseExampleStrings src) $ \e ->
+    ("scalarExpr", "params", e)
+  where src = [R.r|
+:3
+;
+@3
+;
+#3
+
+|]
+
+
+odbcexpr :: [(Text,Text,Text)]
+odbcexpr = flip map (parseExampleStrings src) $ \e ->
+    ("scalarExpr", "odbc", e)
+  where src = [R.r|
+{d '2000-01-01'
+;
+{fn CHARACTER_LENGTH(string_exp)
+
+|]
+
+odbcqexpr :: [(Text,Text,Text)]
+odbcqexpr = flip map (parseExampleStrings src) $ \e ->
+    ("queryExpr", "odbc", e)
+  where src = [R.r|
+select * from {oj t1 left outer join t2 on expr
+
+|]
+
+
+    
+queryExprExamples :: [(Text,Text,Text)]
+queryExprExamples = flip map (parseExampleStrings src) $ \e ->
+    ("queryExpr", "ansi2011", e)
+  where src = [R.r|
+select a select
+;
+select a from t,
+;
+select a from t select
+;
+select a from t(a)
+;
+select a from (t
+;
+select a from (t having
+;
+select a from t a b
+;
+select a from t as
+;
+select a from t as having
+;
+select a from (1234)
+;
+select a from (1234
+;
+select a from a wrong join b
+;
+select a from a natural wrong join b
+;
+select a from a left wrong join b
+;
+select a from a left wrong join b
+;
+select a from a join b select
+;
+select a from a join b on select
+;
+select a from a join b on (1234
+;
+select a from a join b using(a
+;
+select a from a join b using(a,
+;
+select a from a join b using(a,)
+;
+select a from a join b using(1234
+;
+select a from t order no a
+;
+select a from t order by a where c
+;
+select 'test
+'
+;
+select a as
+;
+select a as from t
+;
+select a as, 
+;
+select a,
+;
+select a, from t
+;
+select a as from
+;
+select a as from from
+;
+select a as from2 from
+;
+select a fromt
+;
+select a b fromt
+
+;
+select a from t u v
+;
+select a from t as
+;
+select a from t, 
+;
+select a from group by b
+;
+select a from t join group by a
+;
+select a from t join
+;
+select a from (@
+;
+select a from ()
+;
+select a from t left join u on
+;
+select a from t left join u on group by a
+;
+select a from t left join u using
+;
+select a from t left join u using (
+;
+select a from t left join u using (a
+;
+select a from t left join u using (a,
+;
+select a from (select a from)
+;
+select a from (select a
+
+;
+select a from t where
+;
+select a from t group by a having b where
+;
+select a from t where (a
+;
+select a from t where group by b
+
+;
+select a from t group by
+;
+select a from t group
+;
+select a from t group by a as
+;
+select a from t group by a,
+;
+select a from t group by order by
+;
+select a <<== b from t
+;
+/*
+;
+select * as a
+;
+select t.* as a
+;
+select 3 + *
+;
+select case when * then 1 end
+;
+select (*)
+;
+select * from (select a
+        from t
+;
+select * from (select a(stuff)
+        from t
+
+;
+select *
+     from (select a,b
+           from t
+           where a = 1
+                 and b > a
+
+;
+select *
+     from (select a,b
+           from t
+           where a = 1
+                 and b > a
+           from t)
+
+|]
+
+
+statementParseErrorExamples :: [(Text,Text,Text)]
+statementParseErrorExamples = flip map (parseExampleStrings src) $ \e ->
+    ("statement", "ansi2011", e)
+  where src = [R.r|
+create
+;
+drop
+;
+delete this
+;
+delete where 7
+;
+delete from where t
+;
+truncate nothing
+;
+truncate nothing nothing
+;
+truncate table from
+;
+truncate table t u
+;
+insert t select u
+;
+insert into t insert
+;
+insert into t (1,2)
+;
+insert into t(
+;
+insert into t(1
+;
+insert into t(a
+;
+insert into t(a,
+;
+insert into t(a,b)
+;
+insert into t(a,b) values
+;
+insert into t(a,b) values (
+;
+insert into t(a,b) values (1
+;
+insert into t(a,b) values (1,
+;
+insert into t(a,b) values (1,2) and stuff
+;
+update set 1
+;
+update t u
+;
+update t u v
+;
+update t set a
+;
+update t set a=
+;
+update t set a=1,
+;
+update t set a=1 where
+;
+update t set a=1 where 1 also
+;
+create table
+;
+create table t (
+  a
+)
+;
+create table t (
+  a
+;
+create table t (
+  a,
+)
+;
+create table t (
+)
+;
+create table t (
+;
+create table t
+;
+create table t. (
+;
+truncate table t.
+;
+drop table t. where
+;
+update t. set
+;
+delete from t. where
+;
+insert into t. values
+;
+with a as (select * from t
+select 1
+;
+with a as (select * from t
+;
+with a as (
+;
+with a (
+;
+with as (select * from t)
+select 1
+;
+with (select * from t) as a
+select 1
+
+
+|]
+

tests/Language/SQL/SimpleSQL/TestTypes.hs

@@ -52,4 +52,5 @@ should all be TODO to convert to a testqueryexpr test.
               | LexTest Dialect Text [Token] (SpecWith ())
               | LexFails Dialect Text (SpecWith ())
               | GeneralParseFailTest Text Text (SpecWith ())
+              | GoldenErrorTest Text [(Text,Text,Text)] (SpecWith ())
 

tests/Language/SQL/SimpleSQL/Tests.hs

@@ -93,3 +93,4 @@ itemToTest (ParseScalarExprFails _ _ t) = t
 itemToTest (LexTest _ _ _ t) = t
 itemToTest (LexFails _ _ t) = t
 itemToTest (GeneralParseFailTest _ _ t) = t
+itemToTest (GoldenErrorTest _ _ t) = t