Add more tests. Fix bugs. Add error printer

Author: natefaubion

.gitignore

@@ -4,3 +4,4 @@
 /output/
 /.psc*
 /.psa*
+/.purs-repl

src/SqlSquared/Parser.purs

@@ -2,6 +2,7 @@ module SqlSquared.Parser
   ( parse
   , parseQuery
   , parseModule
+  , prettyParse
   , module SqlSquared.Parser.Tokenizer
   ) where
 
@@ -14,12 +15,13 @@ import Control.Monad.State (get, put)
 import Control.MonadZero (guard)
 
 import Data.Array as A
-import Data.NonEmpty ((:|))
+import Data.Bifunctor (lmap)
 import Data.Either as E
+import Data.Foldable as F
 import Data.List ((:))
 import Data.List as L
-import Data.Foldable as F
-import Data.Maybe (Maybe(..), isNothing, fromMaybe, isJust, maybe)
+import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
+import Data.NonEmpty ((:|))
 import Data.Json.Extended as EJ
 import Data.Tuple (Tuple(..), uncurry)
 import Data.Path.Pathy as Pt
@@ -55,15 +57,39 @@ asErrorMessage ∷ ∀ m a. Monad m ⇒ String → P.ParserT TokenStream m a →
 asErrorMessage err = flip (<|>) do
   P.ParseState input _ _ ← get
   case A.head input of
-    Nothing → P.fail $ "Expected " <> err <> ", got end of input"
-    Just tk → P.failWithPosition ("Expected " <> err <> ", got " <> printToken tk.token) tk.position
+    Nothing → P.fail $ "Expected " <> err <> ", but got end of input"
+    Just tk → P.failWithPosition ("Expected " <> err <> ", but got " <> printToken tk.token) tk.position
 
 withToken ∷ ∀ m a. Monad m ⇒ String → (Token → P.ParserT TokenStream m a) → P.ParserT TokenStream m a
 withToken err k =
   PC.try
-    $ withErrorMessage (append $ err <> ", got ")
+    $ withErrorMessage (append $ err <> ", but got ")
     ((withErrorMessage' (const "end of input") token) >>= k)
 
+prettyParse
+  ∷ ∀ a
+  . (String → E.Either P.ParseError a)
+  → String
+  → E.Either String a
+prettyParse parser input =
+  lmap printError (parser input)
+  where
+  padLeft n s =
+    S.fromCharArray (A.replicate (n - S.length s) ' ') <> s
+
+  printError parseError =
+    let
+      message = P.parseErrorMessage parseError
+      PP.Position pos = P.parseErrorPosition parseError
+      lines = S.split (S.Pattern "\n") input
+      pre = A.drop (pos.line - 3) $ A.take (pos.line - 1) lines
+      line = A.take 1 $ A.drop (pos.line - 1) lines
+      post = A.take 3 $ A.drop pos.line lines
+      nums = A.mapWithIndex (\n l → padLeft 4 (show (n + pos.line - (A.length pre))) <> " | " <> l) (pre <> line <> post)
+      pointer = pure $ S.fromCharArray (A.replicate (pos.column - 1 + 7) '-') <> "^ " <> message
+    in
+      S.joinWith "\n" $ A.take 3 nums <> pointer <> A.drop 3 nums
+
 parse
   ∷ ∀ t
   . Corecursive t (Sig.SqlF EJ.EJsonF)
@@ -434,12 +460,12 @@ keyValuePair = do
 
 negatableSuffix ∷ ∀ m t. SqlParser m t (t → t)
 negatableSuffix = do
-  mbInv ← PC.optionMaybe do
-    _ ← keyword "is"
+  inv ← do
+    _ ← PC.optionMaybe $ keyword "is"
     n ← PC.optionMaybe $ keyword "not"
-    pure $ isNothing n
-  let inv = fromMaybe false mbInv
-  suffix ← betweenSuffix <|> inSuffix <|> likeSuffix
+    pure $ isJust n
+  suffix ← asErrorMessage "`LIKE`, `IN`, or `BETWEEN`" do
+    betweenSuffix <|> inSuffix <|> likeSuffix
   pure \e → (if inv then _NOT else id) $ suffix e
 
 betweenSuffix ∷ ∀ m t. SqlParser m t (t → t)

src/SqlSquared/Parser/Tokenizer.purs

@@ -97,7 +97,9 @@ operators =
   , "~"
   , "??"
   , "="
+  , ">="
   , ">"
+  , "<="
   , "<"
   , "["
   , "]"

test/src/Parse.purs

@@ -3,62 +3,171 @@ module Test.Parse where
 import Prelude
 
 import Data.Either as E
-import Data.Foldable as F
 import SqlSquared (parseQuery, SqlQuery)
+import SqlSquared.Parser (prettyParse)
 
+import Test.Queries as Q
 import Test.Unit (suite, test, TestSuite)
 import Test.Unit.Assert as Assert
 import Test.Unit.Console as Console
 
-testPrintParse ∷ ∀ e. E.Either String String → TestSuite (testOutput ∷ Console.TESTOUTPUT | e)
-testPrintParse = case _ of
-  E.Left s → do
-    test s case parseQuery s of
-      E.Left err → pure unit
-      E.Right (sql ∷ SqlQuery) → Assert.assert "Parse succeeded" false
-  E.Right s → do
-    test s case parseQuery s of
-      E.Left err → Assert.assert (show err) false
-      E.Right (sql ∷ SqlQuery) → pure unit
-
-inputs ∷ Array (E.Either String String)
-inputs =
-  [ E.Right """select a from `/f` where b is not between 1 and (2..3)"""
-  , E.Right """select foo, bar from (select foo, bar from (select foo, bar from `/baz`)as t) as d"""
-  , E.Right """select (1 + 2) * 3 + 2"""
-  , E.Right """select 1 + 2 * 3 ^ 1.2 / 14 + Minimum(12, 23)"""
-  , E.Right """select ("12" || "12" || "12")"""
-  , E.Right """select date("12-12-12") from `/fo` cross join `/bar`"""
-  , E.Right """Select foo as bar from `/test/db/collection`"""
-  , E.Right """Select `foo`, `bar`[*] from `/test` join `/test2` on baz where doo = (12 + 23)"""
-  , E.Right """foo := 12; select * from `/test` group by baz"""
-  , E.Right """select 1"""
-  , E.Right """select (1, 2)"""
-  , E.Right """foo := [1, 2]; select 1"""
-  , E.Right """foo := 1; bar := 2; select [] """
-  , E.Right """select foo from `/bar` order by zoo desc"""
-  , E.Right """select distinct a from `/f`"""
-  , E.Right """select a from /* trololo */ `/db`"""
-  , E.Right """-- comment
-select 12
-"""
-  , E.Right """import foo; select * from `/test`"""
-  , E.Right """create function foo(:bar) begin :bar + 2 end; select * from `/test` where foo = foo(42)"""
-  , E.Right """select :where"""
-  , E.Right """foo.`_id`"""
-  , E.Left  """foo._id"""
-  , E.Right """select * from foo JOIN bar on baz"""
-  , E.Right """select * from foo FULL JOIN bar on baz"""
-  , E.Right """select * from foo FULL OUTER JOIN bar on baz"""
-  , E.Right """select * from foo INNER JOIN bar on baz"""
-  , E.Right """select * from foo LEFT OUTER JOIN bar on baz"""
-  , E.Right """select * from foo LEFT JOIN bar on baz"""
-  , E.Right """select * from foo RIGHT OUTER JOIN bar on baz"""
-  , E.Right """select * from foo RIGHT JOIN bar on baz"""
-  , E.Right """industry"""
-  ]
+parseSucc ∷ ∀ e. String → String → TestSuite (testOutput ∷ Console.TESTOUTPUT | e)
+parseSucc n s =
+  test n case prettyParse parseQuery s of
+    E.Left err → Assert.assert ("\n" <> err) false
+    E.Right (sql ∷ SqlQuery) → pure unit
+
+parseFail ∷ ∀ e. String → String → TestSuite (testOutput ∷ Console.TESTOUTPUT | e)
+parseFail n s =
+  test n case parseQuery s of
+    E.Left err → pure unit
+    E.Right (sql ∷ SqlQuery) → Assert.assert s false
 
 testSuite ∷ ∀ e. TestSuite (testOutput ∷ Console.TESTOUTPUT | e)
-testSuite = do
-  suite "parsers" do
-    F.traverse_ testPrintParse inputs
+testSuite = suite "parsers" do
+  parseSucc "t1" """
+    select a from `/f` where b is not between 1 and (2..3)
+  """
+
+  parseSucc "t2" """
+    select foo, bar from (select foo, bar from (select foo, bar from `/baz`)as t) as d
+  """
+
+  parseSucc "t3" """
+    select (1 + 2) * 3 + 2
+  """
+
+  parseSucc "t4" """
+    select 1 + 2 * 3 ^ 1.2 / 14 + Minimum(12, 23)
+  """
+
+  parseSucc "t5" """
+    select ("12" || "12" || "12")
+  """
+
+  parseSucc "t6" """
+    select date("12-12-12") from `/fo` cross join `/bar`
+  """
+
+  parseSucc "t7" """
+    Select foo as bar from `/test/db/collection`
+  """
+
+  parseSucc "t8" """
+    Select `foo`, `bar`[*] from `/test` join `/test2` on baz where doo = (12 + 23)
+  """
+
+  parseSucc "t9" """
+    foo := 12; select * from `/test` group by baz
+  """
+
+  parseSucc "t10" """
+    select 1
+  """
+
+  parseSucc "t11" """
+    select (1, 2)
+  """
+
+  parseSucc "t12" """
+    foo := [1, 2]; select 1
+  """
+
+  parseSucc "t13" """
+    foo := 1; bar := 2; select []
+  """
+
+  parseSucc "t14" """
+    select foo from `/bar` order by zoo desc
+  """
+
+  parseSucc "t15" """
+    select distinct a from `/f`
+  """
+
+  parseSucc "t16" """
+    select a from /* trololo */ `/db`
+  """
+
+  parseSucc "t17" """
+    -- comment
+    select 12
+  """
+
+  parseSucc "t18" """
+    import foo; select * from `/test`
+  """
+
+  parseSucc "t19" """
+    create function foo(:bar) begin :bar + 2 end; select * from `/test` where foo = foo(42)
+  """
+
+  parseSucc "t20" """
+    select :where
+  """
+
+  parseSucc "t21" """
+    foo.`_id`
+  """
+
+  parseFail "t22" """
+    foo._id
+  """
+
+  parseSucc "t23" """
+    select * from foo JOIN bar on baz
+  """
+
+  parseSucc "t24" """
+    select * from foo FULL JOIN bar on baz
+  """
+
+  parseSucc "t25" """
+    select * from foo FULL OUTER JOIN bar on baz
+  """
+
+  parseSucc "t26" """
+    select * from foo INNER JOIN bar on baz
+  """
+
+  parseSucc "t27" """
+    select * from foo LEFT OUTER JOIN bar on baz
+  """
+
+  parseSucc "t28" """
+    select * from foo LEFT JOIN bar on baz
+  """
+
+  parseSucc "t29" """
+    select * from foo RIGHT OUTER JOIN bar on baz
+  """
+
+  parseSucc "t30" """
+    select * from foo RIGHT JOIN bar on baz
+  """
+
+  parseSucc "t31" """
+    industry
+  """
+
+  parseSucc "q1" Q.q1
+  parseSucc "q2" Q.q2
+  parseSucc "q3" Q.q3
+  parseSucc "q4" Q.q4
+  parseSucc "q5" Q.q5
+  parseSucc "q6" Q.q6
+  parseSucc "q7" Q.q7
+  parseSucc "q8" Q.q8
+  parseSucc "q9" Q.q9
+  parseSucc "q10" Q.q10
+  parseSucc "q11" Q.q11
+  parseSucc "q12" Q.q12
+  parseSucc "q13" Q.q13
+  parseSucc "q14" Q.q14
+  parseSucc "q15" Q.q15
+  parseSucc "q16" Q.q16
+  parseSucc "q17" Q.q17
+  parseSucc "q18" Q.q18
+  parseSucc "q19" Q.q19
+  parseSucc "q20" Q.q20
+  parseSucc "q21" Q.q21