support character set literals, e.g. N'stuff'
support collate postfix operator support escape and uescape as postfix operators change the collate support in substring and trim which isn't a special case in the sql 2003 grammar anymore but just a normal collate postfix operator, the old code had the collation name as a string, but the new style is as an identifier
This commit is contained in:
parent
211174cfb4
commit
37dca6596b
5 changed files with 90 additions and 34 deletions
Language/SQL/SimpleSQL
|
@ -17,7 +17,7 @@
|
|||
> ,option,between,sepBy,sepBy1,string,manyTill,anyChar
|
||||
> ,try,string,many1,oneOf,digit,(<|>),choice,char,eof
|
||||
> ,optionMaybe,optional,many,letter,parse
|
||||
> ,chainl1, (<?>),notFollowedBy,alphaNum)
|
||||
> ,chainl1, (<?>),notFollowedBy,alphaNum, lookAhead)
|
||||
> import Text.Parsec.String (Parser)
|
||||
> import qualified Text.Parsec as P (ParseError)
|
||||
> import Text.Parsec.Perm (permute,(<$?>), (<|?>))
|
||||
|
@ -123,8 +123,20 @@ which parses as a typed literal
|
|||
> mkIt val Nothing = TypedLit (TypeName "interval") val
|
||||
> mkIt val (Just (a,b)) = IntervalLit val a b
|
||||
|
||||
> characterSetLiteral :: Parser ValueExpr
|
||||
> characterSetLiteral =
|
||||
> CSStringLit <$> shortCSPrefix <*> stringToken
|
||||
> where
|
||||
> shortCSPrefix =
|
||||
> choice
|
||||
> [(:[]) <$> oneOf "nNbBxX"
|
||||
> ,string "u&"
|
||||
> ,string "U&"
|
||||
> ] <* lookAhead (char '\'')
|
||||
|
||||
> literal :: Parser ValueExpr
|
||||
> literal = number <|> stringValue <|> interval
|
||||
> literal = number <|> stringValue <|> interval <|> try characterSetLiteral
|
||||
|
||||
|
||||
== Names
|
||||
|
||||
|
@ -348,7 +360,7 @@ for, but the parser doens't enforce this
|
|||
|
||||
> substring :: Parser ValueExpr
|
||||
> substring = specialOpK "substring" SOKMandatory
|
||||
> [("from", False),("for", False),("collate", False)]
|
||||
> [("from", False),("for", False)]
|
||||
|
||||
> convert :: Parser ValueExpr
|
||||
> convert = specialOpK "convert" SOKMandatory [("using", True)]
|
||||
|
@ -371,17 +383,15 @@ in the source
|
|||
> parens (mkTrim
|
||||
> <$> option "both" sides
|
||||
> <*> option " " stringToken
|
||||
> <*> (keyword_ "from" *> valueExpr)
|
||||
> <*> optionMaybe (keyword_ "collate" *> stringToken))
|
||||
> <*> (keyword_ "from" *> valueExpr))
|
||||
> where
|
||||
> sides = choice ["leading" <$ keyword_ "leading"
|
||||
> ,"trailing" <$ keyword_ "trailing"
|
||||
> ,"both" <$ keyword_ "both"]
|
||||
> mkTrim fa ch fr cl =
|
||||
> mkTrim fa ch fr =
|
||||
> SpecialOpK (Name "trim") Nothing
|
||||
> $ catMaybes [Just (fa,StringLit ch)
|
||||
> ,Just ("from", fr)
|
||||
> ,fmap (("collate",) . StringLit) cl]
|
||||
> ,Just ("from", fr)]
|
||||
|
||||
in: two variations:
|
||||
a in (expr0, expr1, ...)
|
||||
|
@ -473,6 +483,21 @@ a match (select a from t)
|
|||
> [ArrayCtor <$> parens queryExpr
|
||||
> ,Array (Iden (Name "array")) <$> brackets (commaSep valueExpr)]
|
||||
|
||||
> escape :: Parser (ValueExpr -> ValueExpr)
|
||||
> escape = do
|
||||
> ctor <- choice
|
||||
> [Escape <$ keyword_ "escape"
|
||||
> ,UEscape <$ keyword_ "uescape"]
|
||||
> c <- anyChar
|
||||
> return $ \v -> ctor v c
|
||||
|
||||
> collate :: Parser (ValueExpr -> ValueExpr)
|
||||
> collate = do
|
||||
> keyword_ "collate"
|
||||
> i <- identifier
|
||||
> return $ \v -> Collate v i
|
||||
|
||||
|
||||
typename: used in casts. Special cases for the multi keyword typenames
|
||||
that SQL supports.
|
||||
|
||||
|
@ -538,9 +563,12 @@ TODO: carefully review the precedences and associativities.
|
|||
> -- todo: left factor the quantified comparison with regular
|
||||
> -- binary comparison, somehow
|
||||
> [E.Postfix $ try quantifiedComparison
|
||||
> ,E.Postfix matchPredicate]
|
||||
> ,E.Postfix matchPredicate
|
||||
> ]
|
||||
> ,[binarySym "." E.AssocLeft]
|
||||
> ,[postfix' arrayPostfix]
|
||||
> ,[postfix' arrayPostfix
|
||||
> ,postfix' escape
|
||||
> ,postfix' collate]
|
||||
> ,[prefixSym "+", prefixSym "-"]
|
||||
> ,[binarySym "^" E.AssocLeft]
|
||||
> ,[binarySym "*" E.AssocLeft
|
||||
|
|
|
@ -34,9 +34,6 @@ which have been changed to try to improve the layout of the output.
|
|||
|
||||
> valueExpr :: ValueExpr -> Doc
|
||||
> valueExpr (StringLit s) = quotes $ text $ doubleUpQuotes s
|
||||
> where doubleUpQuotes [] = []
|
||||
> doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs
|
||||
> doubleUpQuotes (c:cs) = c:doubleUpQuotes cs
|
||||
|
||||
> valueExpr (NumLit s) = text s
|
||||
> valueExpr (IntervalLit v u p) =
|
||||
|
@ -177,6 +174,24 @@ which have been changed to try to improve the layout of the output.
|
|||
> valueExpr (ArrayCtor q) =
|
||||
> text "array" <> parens (queryExpr q)
|
||||
|
||||
> valueExpr (CSStringLit cs st) =
|
||||
> text cs <> quotes (text $ doubleUpQuotes st)
|
||||
|
||||
> valueExpr (Escape v e) =
|
||||
> valueExpr v <+> text "escape" <+> text [e]
|
||||
|
||||
> valueExpr (UEscape v e) =
|
||||
> valueExpr v <+> text "uescape" <+> text [e]
|
||||
|
||||
> valueExpr (Collate v c) =
|
||||
> valueExpr v <+> text "collate" <+> text c
|
||||
|
||||
|
||||
> doubleUpQuotes :: String -> String
|
||||
> doubleUpQuotes [] = []
|
||||
> doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs
|
||||
> doubleUpQuotes (c:cs) = c:doubleUpQuotes cs
|
||||
|
||||
|
||||
> unname :: Name -> String
|
||||
> unname (QName n) = "\"" ++ n ++ "\""
|
||||
|
|
|
@ -140,6 +140,10 @@
|
|||
> -- valueExpr is the array, the
|
||||
> -- second is the subscripts/ctor args
|
||||
> | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t)> deriving (Eq,Show,Read,Data,Typeable)
|
||||
> | CSStringLit String String
|
||||
> | Escape ValueExpr Char
|
||||
> | UEscape ValueExpr Char
|
||||
> | Collate ValueExpr String
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
> -- | Represents an identifier name, which can be quoted or unquoted.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue