From 182526d1fc1d4e5f496b31bf6a3fcbc609c23240 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 20:01:57 +0200
Subject: [PATCH] add parsing for unary + -
---
Language/SQL/SimpleSQL/Parser.lhs | 43 +++++++++++++++++++------------
TODO | 19 ++++++++------
2 files changed, 38 insertions(+), 24 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index b7a6507..c4103af 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -13,6 +13,7 @@
> import qualified Language.Haskell.Exts.Syntax as HSE
> import qualified Language.Haskell.Exts.Fixity as HSE
> import Data.Maybe
+> import Data.List
> import Language.SQL.SimpleSQL.Syntax
@@ -37,19 +38,20 @@
> setPos :: FilePath -> Maybe (Int,Int) -> P ()
> setPos f p = do
-> sp <- getPosition
-> let sp' = setSourceName sp f
-> sp'' = maybe sp'
-> (\(l,c) -> flip setSourceColumn c
-> $ setSourceLine sp' l)
-> p
-> setPosition sp''
+> sp <- getPosition
+> let sp' = setSourceName sp f
+> sp'' = maybe sp'
+> (\(l,c) -> flip setSourceColumn c
+> $ setSourceLine sp' l)
+> p
+> setPosition sp''
> data ParseError = ParseError
> {peErrorString :: String
> ,peFilename :: FilePath
> ,pePosition :: (Int,Int)
-> ,peFormattedError :: String}
+> ,peFormattedError :: String
+> } deriving (Eq,Show)
> convParseError :: String -> P.ParseError -> ParseError
> convParseError src e =
@@ -79,11 +81,8 @@ format the error more nicely: emacs format for positioning, plus context
> _ -> ""
> p = errorPos e
-Language/SQL/SimpleSQL/Parser.lhs:54:3:
-
> type P a = ParsecT String () Identity a
-
------------------------------------------------
= scalar expressions
@@ -174,9 +173,20 @@ to be.
> binOpKeywordNames :: [String]
> binOpKeywordNames = ["and", "or", "like"]
+> unOpKeywordNames :: [String]
+> unOpKeywordNames = ["not"]
+
+> unOpSymbolNames :: [String]
+> unOpSymbolNames = ["+", "-"]
+
+
> unaryOp :: P ScalarExpr
-> unaryOp = makeOp <$> (try (keyword_ "not") *> scalarExpr)
-> where makeOp e = Op "not" [e]
+> unaryOp =
+> makeOp <$> opSymbol <*> scalarExpr
+> where
+> makeOp nm e = Op nm [e]
+> opSymbol = choice (map (try . symbol) unOpSymbolNames
+> ++ map (try . keyword) unOpKeywordNames)
> scalarExpr' :: P ScalarExpr
> scalarExpr' = factor >>= trysuffix
@@ -206,7 +216,7 @@ to be.
> Op n [e0,e1] -> HSE.InfixApp (toHaskell e0)
> (HSE.QVarOp $ HSE.UnQual $ HSE.Ident n)
> (toHaskell e1)
-> Op "not" [e0] -> toHaskell $ App "not" [e0]
+> Op o [e0] -> toHaskell $ App ("unary:" ++ o) [e0]
> Op {} -> error $ "bad args to operator " ++ groom e
> Star -> HSE.Var $ HSE.UnQual $ HSE.Ident "*"
> Iden2 a b -> HSE.Var $ HSE.Qual (HSE.ModuleName a) (HSE.Ident b)
@@ -230,8 +240,9 @@ to be.
> HSE.Lit (HSE.String ('n':l)) -> NumLit l
> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case"))) (HSE.List [v,ts,el]) ->
> Case (ltom v) (pairs ts) (ltom el)
-> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "not")))
-> (HSE.List [ea]) -> Op "not" [toSql ea]
+> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident x)))
+> (HSE.List [ea]) | "unary:" `isPrefixOf` x ->
+> Op (drop 6 x) [toSql ea]
> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident i)))
> (HSE.List es) -> App i $ map toSql es
> HSE.InfixApp e0 (HSE.QVarOp (HSE.UnQual (HSE.Ident n))) e1 ->
diff --git a/TODO b/TODO
index 1a51312..860704b 100644
--- a/TODO
+++ b/TODO
@@ -1,14 +1,15 @@
-first release
-
-1. utility function to parse some sql and print the context of the
- error using the position
-2. complete the parsing for the tests in the Tests.lhs
-3. get tpch parsing
-4. add tests to cabal
-5. do code documentation and haddock
+first release:
+complete the parsing for the tests in the Tests.lhs
+case insensivity
+get tpch parsing
+check the pretty printer on the tpch queries
+add automated tests to cabal
+do code documentation and haddock
+do some tests for parse errors?
+website with haddock and table of parsing tests
----
@@ -29,6 +30,8 @@ position annotation
= sql support
+case insensitivity
+
scalar function syntax:
standard interval literal