Parser.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings        #-}

module Test.Syntax.Parser where

import Preql.QuasiQuoter.Syntax.Name
import Preql.QuasiQuoter.Syntax.Parser
import Preql.QuasiQuoter.Syntax.Syntax

import qualified Preql.QuasiQuoter.Syntax.Lex as L

import Data.Either (isRight)
import Data.List.NonEmpty (NonEmpty(..))
import Prelude hiding (Ordering(..), lex)
import Test.Tasty
import Test.Tasty.HUnit

lexer :: TestTree
lexer = testGroup "lexer"
    [ testLex "'foo''bar'" [L.String "foo'bar"]
    , testLex "SELECT 2 + 3;" [L.SELECT, L.Iconst 2, L.Add, L.Iconst 3, L.Semicolon]
    , testLex "5" [L.Iconst 5]
    , testLex "2.5" [L.Fconst 2.5]
    , testLex "2e-2" [L.Fconst 0.02]
    , testLex "2.5e-1" [L.Fconst 0.25]
    , testLex "1 2.3" [ L.Iconst 1, L.Fconst 2.3 ]
    , testLex "1 ." [ L.Iconst 1, L.Dot ]
    , testLex "SELECT 1 IS NULL" [ L.SELECT, L.Iconst 1, L.IS, L.NULL_P ]
    , testLex "SELECT 1 ISNULL" [ L.SELECT, L.Iconst 1, L.ISNULL ]
    ]

parser :: TestTree
parser = testGroup "parser"
  [ testGroup "Expr"
    [ testParseExpr "2 * 3 + 1"
      (BinOp Add (BinOp Mul (Lit (I 2)) (Lit (I 3))) (Lit (I 1)))
    , testParseExpr "1 + 2 * 3"
      (BinOp Add (Lit (I 1)) (BinOp Mul (Lit (I 2)) (Lit (I 3))) )
    , testParseExpr "name = 'Daniel'"
      (BinOp Eq (CRef "name") (Lit (T "Daniel")))
    , testParseExpr "TRUE" (Lit (B True))
    , testParseExpr "true" (Lit (B True))
    , testParseExpr "false" (Lit (B False))
    ]
  , testGroup "Statement"
    [ testParse "DELETE FROM taffy"
        (QD (Delete (mkName "taffy") Nothing))
    , testParse "dEleTe FROM taffy WHERE flavor = 'blueberry'"
      (QD Delete
          { table = mkName "taffy"
          , conditions = Just (BinOp Eq (CRef "flavor") (Lit (T"blueberry")))
          })
    , testParse "DELETE FROM users WHERE email != 'bergey@teallabs.org'"
      (QD Delete
       { table = mkName "users"
       , conditions = Just (BinOp NEq (CRef "email") (Lit (T "bergey@teallabs.org")))
       })
    , testParse "INSERT INTO users (email) VALUES ('bergey@teallabs.org')"
        (QI Insert
            { table = mkName "users"
            , columns = mkName "email" :| []
            , values = Lit (T "bergey@teallabs.org") :| []
            })
    , testParse "INSERT INTO addresses (street, country) VALUES ('4 Ames St', 'USA')"
      (QI Insert
       { table = "addresses"
       , columns = "street" :| ["country" ]
       , values = Lit (T "4 Ames St") :| [ Lit (T "USA") ]
       })
    ]
  , testGroup "Select"
    [ testParseSelect "SELECT name FROM users"
      (Simple select
       { from = [ J (Table "users") ]
       , targetList = [ Column (CRef "name") Nothing ]
       })
    , testParse "SELECT name, email FROM users"
      (QS (Simple select
       { from = [ J (Table "users") ]
       , targetList = [ Column (CRef "name") Nothing, Column (CRef "email") Nothing ]
       }))
    , testParse "SELECT name, email FROM users WHERE name = 'Daniel'"
      (QS (Simple select
       { from = [ J (Table "users") ]
       , targetList = [ Column (CRef "name") Nothing, Column (CRef "email") Nothing ]
       , whereClause = Just (BinOp Eq (CRef "name") (Lit (T "Daniel")))
       }))
    , testParse "SELECT name, email FROM users WHERE name = 'Daniel' OR name = 'Bergey'"
      (QS (Simple select
       { from = [ J (Table "users") ]
       , targetList = [ Column (CRef "name") Nothing, Column (CRef "email") Nothing ]
       , whereClause = Just (BinOp Or (BinOp Eq (CRef "name") (Lit (T "Daniel"))) (BinOp Eq (CRef "name") (Lit (T "Bergey"))))
       }))
    , testParse "SELECT name FROM users WHERE age = 35"
        -- We currently parse integers & decimals all to Double
        -- Just test that both parser rules work
      (QS (Simple select
       { from = [ J (Table "users") ]
       , targetList = [ Column (CRef "name") Nothing ]
       , whereClause = Just (BinOp Eq (CRef "age") (Lit (I 35)))
       }))
    , testParse "SELECT name FROM users WHERE age = 35.5"
      (QS (Simple select
       { from = [ J (Table "users") ]
       , targetList = [ Column (CRef "name") Nothing ]
       , whereClause = Just (BinOp Eq (CRef "age") (Lit (F 35.5)))
       }))
    , testParse "SELECT foo FROM bar WHERE baz > -2"
      (QS (Simple select
       { from = [ J (Table "bar") ]
       , targetList = [ Column (CRef "foo") Nothing ]
       , whereClause = Just (BinOp GT (CRef "baz") (Unary Negate (Lit (I 2))))
       }))
    , testParse "SELECT foo FROM bar WHERE baz = 2e-2"
      (QS (Simple select
       { from = [ J (Table "bar") ]
       , targetList = [ Column (CRef "foo") Nothing ]
       , whereClause = Just (BinOp Eq (CRef "baz") (Lit (F 0.02)))
       }))
    , testParse "SELECT foo FROM bar WHERE baz = 2E-2"
      (QS (Simple select
       { from = [ J (Table "bar") ]
       , targetList = [ Column (CRef "foo") Nothing ]
       , whereClause = Just (BinOp Eq (CRef "baz") (Lit (F 0.02)))
       }))
    , testParse "SELECT * FROM foobar"
      (QS (Simple select
       { from = [ J (Table "foobar") ]
       , targetList = [ Star ]
       }))
    , testParse "SELECT * FROM foo ORDER BY bar"
      (QS (S (Simple select { from = [J (Table "foo") ], targetList = [Star] })
          selectOptions { sortBy = [ SortBy (CRef "bar") (SortOrder DefaultSortOrder) NullsOrderDefault ] }))
    , testParse "SELECT * FROM foo ORDER BY bar DESC"
      (QS (S (Simple select { from = [J (Table "foo") ], targetList = [Star] })
          selectOptions { sortBy = [ SortBy (CRef "bar") (SortOrder Descending) NullsOrderDefault ] }))
    , testParse "SELECT * FROM foo ORDER BY bar NULLS FIRST"
      (QS (S (Simple select { from = [J (Table "foo") ], targetList = [Star] })
          selectOptions { sortBy = [ SortBy (CRef "bar") (SortOrder DefaultSortOrder) NullsFirst ] }))
    , testParse "SELECT * FROM foo ORDER BY bar ASC NULLS LAST"
      (QS (S (Simple select { from = [J (Table "foo") ], targetList = [Star] })
          selectOptions { sortBy = [ SortBy (CRef "bar") (SortOrder Ascending) NullsLast ] }))
    , testParse "SELECT * FROM foobar LIMIT 5"
      (QS (S (Simple select { from = [J (Table "foobar") ], targetList = [Star] })
          selectOptions { limit = Just (Lit (I 5)) }))
    , testParse "SELECT * FROM foobar LIMIT 5 OFFSET 5"
      (QS (S (Simple select { from = [J (Table "foobar") ], targetList = [Star] })
          selectOptions { limit = Just (Lit (I 5)), offset = Just (Lit (I 5)) }))
    , testParse "SELECT * FROM foobar OFFSET 25"
      (QS (S (Simple select { from = [J (Table "foobar") ], targetList = [Star] })
          selectOptions { offset = Just (Lit (I 25)) }))
    , testParse "TABLE foo"
      (QS (Simple select { from = [J (Table "foo") ], targetList = [Star] }))
    , testParse "SELECT foo FROM bar union SELECT baz FROM quux"
      (QS (Set Union Distinct
              (Simple select { from = [ J (Table "bar") ], targetList = [ Column (CRef "foo") Nothing ] })
              (Simple select { from = [ J (Table "quux") ], targetList = [ Column (CRef "baz") Nothing ] })))
    , testParse "SELECT foo FROM bar Intersect ALL SELECT baz FROM quux"
      (QS (Set Intersect All
              (Simple select { from = [ J (Table "bar") ], targetList = [ Column (CRef "foo") Nothing ] })
              (Simple select { from = [ J (Table "quux") ], targetList = [ Column (CRef "baz") Nothing ] })))
    , testParse "SELECT foo FROM bar EXCEPT SELECT baz FROM quux"
      (QS (Set Except Distinct
              (Simple select { from = [ J (Table "bar") ], targetList = [ Column (CRef "foo") Nothing ] })
              (Simple select { from = [ J (Table "quux") ], targetList = [ Column (CRef "baz") Nothing ] })))
    , testParse "SELECT * FROM foo CROSS JOIN bar"
      (QS (Simple select { from = [ J (CrossJoin (J (Table "foo")) (J (Table "bar"))) ]
                         , targetList = [Star] }))
    , testParse "SELECT * FROM foo JOIN bar ON foo.f = bar.b"
      (QS (Simple select { from = [ J (Join Inner (On (BinOp Eq (Indirection (CRef "foo") ("f" :| [])) (Indirection (CRef "bar") ("b" :| [])))) (J (Table "foo")) (J (Table "bar"))) ]
                         , targetList = [Star]}))
    , testParse "SELECT * FROM foo JOIN bar USING (f, b)"
      (QS (Simple select { from = [ J (Join Inner (Using ["f", "b"]) (J (Table "foo")) (J (Table "bar"))) ]
                         , targetList = [Star]}))
    , testParse "SELECT * FROM foo LEFT JOIN bar ON bar.foo = f.id"
      (QS (Simple select { from = [ J (Join LeftJoin (On (BinOp Eq (Indirection (CRef "bar") ("foo" :| [])) (Indirection (CRef "f") ("id" :| [])))) (J (Table "foo")) (J (Table "bar"))) ]
                         , targetList = [Star]}))
    , testParse "SELECT * FROM foo NATURAL JOIN bar"
      (QS (Simple select { from = [ J (Join Inner Natural (J (Table "foo")) (J (Table "bar"))) ]
                         , targetList = [Star]}))
    , testParse "SELECT DISTINCT foo FROM bar"
      (QS (Simple select { from = [ J (Table "bar") ], targetList = [ Column (CRef "foo") Nothing ], distinct = Just DistinctAll }))
    , testParse "SELECT DISTINCT ON (foo) * FROM bar"
      (QS (Simple select { from = [ J (Table "bar") ], targetList = [ Star ], distinct = Just (DistinctOn (CRef "foo" :| [] )) } ))
    , testParse "SELECT DISTINCT ON (foo, baz) * FROM bar"
      (QS (Simple select { from = [ J (Table "bar") ], targetList = [ Star ], distinct = Just (DistinctOn (CRef "foo" :| [CRef "baz" ] )) } ))
    , testParse "SELECT * FROM (SELECT foo FROM bar) AS baz"
      (QS (Simple select { targetList = [Star]
                         , from = [ SubSelect (Simple select { targetList = [ Column (CRef "foo") Nothing ], from = [ J (Table "bar") ] }) (Alias "baz" []) ] } ))
  , testParse "SELECT * FROM foo GROUP BY bar"
    (QS (Simple select { targetList = [Star], from = [J (Table "foo")]
                       , groupBy = [ CRef "bar" ] } ))
  -- TODO add count(*) or something, once we can parse functions
  , testParse "SELECT bar FROM foo GROUP BY bar HAVING count > 1"
    (QS (Simple select { targetList = [ Column (CRef "bar") Nothing ]
                       , from = [J (Table "foo")]
                       , groupBy = [ CRef "bar" ]
                       , having = Just (BinOp GT (CRef "count") (Lit (I 1))) } ))
  , testParse "SELECT * FROM foo WHERE bar LIKE '%'"
    (QS (Simple select { targetList = [Star], from = [J (Table "foo")]
                       , whereClause = Just (L (like Like (CRef "bar") (Lit (T "%")))) }))
  , testParse "SELECT * FROM foo WHERE bar NOT LIKE '%'"
    (QS (Simple select { targetList = [Star], from = [J (Table "foo")]
                       , whereClause = Just (L (like Like (CRef "bar") (Lit (T "%"))) { invert = True }) }))
  , testParse "SELECT * FROM foo WHERE bar SIMILAR TO '%'"
    (QS (Simple select { targetList = [Star], from = [J (Table "foo")]
                       , whereClause = Just (L (like Similar (CRef "bar") (Lit (T "%")))) }))
  , testParse "SELECT coalesce(foo, bar) FROM baz"
    ( QS (Simple select
          { targetList = [ Column (Fun $ fapp1 "coalesce" [CRef "foo", CRef "bar"]) Nothing ]
          , from = [J (Table "baz")] }))
  , testParse "SELECT greatest(foo, bar) FROM baz"
    ( QS (Simple select
          { targetList = [ Column (Fun $ fapp1 "greatest" [CRef "foo", CRef "bar"]) Nothing ]
          , from = [J (Table "baz")] }))
  , testParse "SELECT least(foo, bar) FROM baz"
    ( QS (Simple select
          { targetList = [ Column (Fun $ fapp1 "least" [CRef "foo", CRef "bar"]) Nothing ]
          , from = [J (Table "baz")] }))
  , testParse "SELECT 1 IS NULL"
    ( QS (Simple select { targetList = [ Column (Unary IsNull (Lit (I 1))) Nothing ] } ))
  , testParse "SELECT 1 ISNULL"
    ( QS (Simple select { targetList = [ Column (Unary IsNull (Lit (I 1))) Nothing ] } ))
  , testParse "SELECT CASE WHEN true THEN 1 ELSE 2 END"
    ( QS (Simple select
         { targetList =
           [ Column (Cas (Case
                           { whenClause = [(Lit (B True), Lit (I 1))]
                           , elseClause = Just (Lit (I 2))
                           , implicitArg = Nothing }))
             Nothing ] } ))
  , testParse "SELECT CASE WHEN foo is null THEN 1 WHEN foo > 0 THEN 2 END FROM bar"
    ( QS (Simple select
         { targetList =
           [ Column (Cas (Case
                          { whenClause =
                            [ (Unary IsNull (CRef "foo"), Lit (I 1))
                            , (BinOp GT (CRef "foo") (Lit (I 0)), Lit (I 2))
                            ]
                          , implicitArg = Nothing
                          , elseClause = Nothing }))
             Nothing ]
         , from = [ J (Table "bar") ] } ))
  , testParse "SELECT CASE WHEN foo is null THEN 1 WHEN foo > 0 THEN 2 ELSE 3 END FROM bar"
    ( QS (Simple select
         { targetList =
           [ Column (Cas (Case
                          { whenClause =
                            [ (Unary IsNull (CRef "foo"), Lit (I 1))
                            , (BinOp GT (CRef "foo") (Lit (I 0)), Lit (I 2))
                            ]
                          , implicitArg = Nothing
                          , elseClause = Just (Lit (I 3))}))
             Nothing ]
         , from = [ J (Table "bar") ] } ))
  , testParse "SELECT CASE foo WHEN 'bar' THEN 1 ELSE 0 END FROM quux"
    ( QS (Simple select
         { targetList =
           [ Column (Cas (Case
                          { implicitArg = Just (CRef "foo")
                          , whenClause = [ (Lit (T "bar"), Lit (I 1)) ]
                          , elseClause = Just (Lit (I 0))}))
             Nothing ]
         , from = [ J (Table "quux") ] } ))
  , testParse "SELECT CASE foo WHEN 'bar' THEN 1 WHEN 'baz' THEN 2 ELSE 0 END FROM quux"
    ( QS (Simple select
          { targetList =
           [ Column (Cas (Case
                          { implicitArg = Just (CRef "foo")
                          , whenClause =
                            [ (Lit (T "bar"), Lit (I 1))
                            , (Lit (T "baz"), Lit (I 2))
                            ]
                          , elseClause = Just (Lit (I 0))}))
             Nothing ]
         , from = [ J (Table "quux") ] } ))
  , testParse "WITH regional_sales AS (\
\    SELECT region, SUM(amount) AS total_sales\
\    FROM orders\
\    GROUP BY region\
\)\
\SELECT region,\
\       product,\
\       SUM(quantity) AS product_units,\
\       SUM(amount) AS product_sales \
\FROM orders \
\WHERE region = 'Lemuria' \
\GROUP BY region, product;"
  ( QS (S (Simple select
           { targetList = [ Column (CRef "region") Nothing
                          , Column (CRef "product") Nothing
                          , Column (Fun $ fapp1 "SUM" [ CRef "quantity" ]) (Just "product_units")
                          , Column (Fun $ fapp1 "SUM" [ CRef "amount" ]) (Just "product_sales")
                          ]
           , from = [ J (Table "orders") ]
           , whereClause = Just ( BinOp Eq (CRef "region") (Lit (T "Lemuria")) )
           , groupBy = [ CRef "region", CRef "product" ]
           })
          selectOptions
            { withClause = Just With
              { recursive = NotRecursive
              , commonTables = [ CommonTableExpr
                               { name = "regional_sales"
                               , aliases = []
                               , materialized = MaterializeDefault
                               , query = QS (Simple select
                                            { targetList =
                                              [ Column (CRef "region") Nothing
                                              , Column (Fun $ fapp1 "SUM" [ CRef "amount" ]) (Just "total_sales")
                                              ]
                                            , from = [ J (Table "orders") ]
                                            , groupBy = [ CRef "region" ]
                                            })
                               } ]
              }
            }))
  , testParse "WITH RECURSIVE t(n) AS (\
\    VALUES (1)\
\  UNION ALL\
\    SELECT n+1 FROM t WHERE n < 100\
\ )\
\ SELECT sum(n) FROM t;"
  ( QS (S (Simple select
          { targetList = [ Column (Fun $ fapp1 "sum" [ CRef "n" ]) Nothing ]
          , from = [ J (Table "t") ]
          })
         selectOptions
            { withClause = Just With
              { recursive = Recursive
              , commonTables = [ CommonTableExpr
                               { name = "t"
                               , aliases = [ "n" ]
                               , materialized = MaterializeDefault
                               , query = QS (Set Union All
                                             (SelectValues ((Lit (I 1) :| []) :| []))
                                             ( Simple select
                                               { targetList = [ Column (BinOp Add (CRef "n") (Lit (I 1))) Nothing ]
                                               , from = [ J (Table "t") ]
                                               , whereClause = Just (BinOp LT (CRef "n") (Lit (I 100)))
                                               }))
                               } ]
              }
            }))
    ]
  , testGroup "locking"
    [ testParseSelect  "SELECT * FROM j FOR UPDATE NOWAIT"
      (S (Simple select { targetList = [Star], from = [J (Table "j")] }) selectOptions { locking = [Locking ForUpdate [] LockWaitError] })
    , testParseSelect  "SELECT * FROM j UNION ALL SELECT * FROM d"
      ( Set Union All
        (Simple select { targetList = [Star] , from = [ J (Table "j") ]})
        (Simple select { targetList = [Star] , from = [ J (Table "d") ]})
      )
    , canParse  "SELECT * FROM j UNION ALL SELECT * FROM d UNION ALL (SELECT * FROM z UNION ALL SELECT * FROM c) FOR UPDATE NOWAIT"
    ]
  ]

testParse :: TestName -> Statement -> TestTree
testParse queryStr expected = testCase queryStr $
    assertEqual "testParse" (Right expected) (parseStatement "<testcase>" queryStr)

testParseSelect :: TestName -> SelectStmt -> TestTree
testParseSelect queryStr expected = testCase queryStr $
    assertEqual "testParseSelect" (Right expected) (parseSelect "<testcase>" queryStr)

testParseExpr :: TestName -> Expr -> TestTree
testParseExpr queryStr expected = testCase queryStr $
    assertEqual "testParseExpr" (Right expected) (parseExpr "<testcase>" queryStr)

testLex :: TestName -> [L.Token] -> TestTree
testLex queryStr expected = testCase queryStr $
    assertEqual "testLex" (Right (expected ++ [L.EOF])) (L.testLex queryStr)

canParse :: TestName -> TestTree
canParse queryStr = testCase queryStr $
  assertBool "canParse" (isRight (parseSelect "<testcase>" queryStr))