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