From ba55859dd76221d374436e56a84a9182b4fd6897 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Thu, 18 Feb 2016 20:29:45 +0200
Subject: [PATCH] special case in the lexer to support postgres 1..2

---
 Language/SQL/SimpleSQL/Lex.lhs              | 17 ++++++++++++++---
 tools/Language/SQL/SimpleSQL/LexerTests.lhs | 10 ++++++++--
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Lex.lhs b/Language/SQL/SimpleSQL/Lex.lhs
index b4812c8..e977da9 100644
--- a/Language/SQL/SimpleSQL/Lex.lhs
+++ b/Language/SQL/SimpleSQL/Lex.lhs
@@ -294,10 +294,15 @@ considered part of the constant; it is an operator applied to the
 constant.
 
 > sqlNumber :: Dialect -> Parser Token
-> sqlNumber _ =
+> sqlNumber d =
 >     SqlNumber <$> completeNumber
 >     -- this is for definitely avoiding possibly ambiguous source
->     <* notFollowedBy (oneOf "eE.")
+>     <* choice [-- special case to allow e.g. 1..2
+>                guard (diSyntaxFlavour d == Postgres)
+>                *> (void $ lookAhead $ try $ string "..")
+>                   <|> void (notFollowedBy (oneOf "eE."))
+>               ,notFollowedBy (oneOf "eE.")
+>               ]
 >   where
 >     completeNumber =
 >       (int <??> (pp dot <??.> pp int)
@@ -309,7 +314,13 @@ constant.
 >       <??> pp expon
 
 >     int = many1 digit
->     dot = string "."
+>     -- make sure we don't parse two adjacent dots in a number
+>     -- special case for postgresql, we backtrack if we see two adjacent dots
+>     -- to parse 1..2, but in other dialects we commit to the failure
+>     dot = let p = string "." <* notFollowedBy (char '.')
+>           in if (diSyntaxFlavour d == Postgres)
+>              then try p
+>              else p
 >     expon = (:) <$> oneOf "eE" <*> sInt
 >     sInt = (++) <$> option "" (string "+" <|> string "-") <*> int
 >     pp = (<$$> (++))
diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.lhs b/tools/Language/SQL/SimpleSQL/LexerTests.lhs
index fb2bdc1..63344c4 100644
--- a/tools/Language/SQL/SimpleSQL/LexerTests.lhs
+++ b/tools/Language/SQL/SimpleSQL/LexerTests.lhs
@@ -42,7 +42,8 @@ Test for the lexer
 >     -- the lexer doesn't apply escapes at all
 >     ++ [("'string'", [SqlString "'" "'" "string"])
 >        ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
->        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])]
+>        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
+>        ,("'\n'", [SqlString "'" "'" "\n"])]
 >     -- csstrings
 >     ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
 >        ["n", "N","b", "B","x", "X", "u&"]
@@ -164,6 +165,8 @@ also: do the testing for the ansi compatibility special cases
 >     ++ [("'string'", [SqlString "'" "'" "string"])
 >        ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
 >        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
+>        ,("'\n'", [SqlString "'" "'" "\n"])
+>        ,("E'\n'", [SqlString "E'" "'" "\n"])
 >        ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])
 >        ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])
 >        ,("'not this \\' quote", [SqlString "'" "'" "not this \\"
@@ -257,7 +260,10 @@ the + or -.
 >         ,LexFails postgres "12e3.4"
 >         ,LexFails postgres "12.4.5"
 >         ,LexFails postgres "12.4e5.6"
->         ,LexFails postgres "12.4e5e7"]
+>         ,LexFails postgres "12.4e5e7"
+>          -- special case allow this to lex to 1 .. 2
+>          -- this is for 'for loops' in plpgsql
+>         ,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]
 >     ]
 >  where
 >    edgeCaseCommentOps =