1
Fork 0

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:
Jake Wheat 2014-04-18 00:16:24 +03:00
parent 211174cfb4
commit 37dca6596b
5 changed files with 90 additions and 34 deletions
Language/SQL/SimpleSQL

View file

@ -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

View file

@ -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 ++ "\""

View file

@ -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.