fixes for substring, change the abstract syntax for extract and

substring, and add the addition operators position, convert, translate, overlay and trim
2013-12-18 15:51:55 +02:00 · 2013-12-18 15:51:55 +02:00 · b89f2a011c
parent 1397047654
commit b89f2a011c
6 changed files with 226 additions and 43 deletions
--- a/Language/SQL/SimpleSQL/Fixity.lhs
+++ b/Language/SQL/SimpleSQL/Fixity.lhs
@ -75,6 +75,8 @@ the fixity code.
 >                       (toHaskell e0)
 >                       (HSE.QVarOp $ sym $ name op)
 >                       (toHaskell e1)
+>     -- TODO fix me
+>     (SpecialOpK {}) -> str ('v':show e)
 >     Iden {} -> str ('v':show e)
 >     StringLit {} -> str ('v':show e)
 >     NumLit {} -> str ('v':show e)
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@ -1,4 +1,5 @@

+> {-# LANGUAGE TupleSections #-}
 > -- | This is the module with the parser functions.
 > module Language.SQL.SimpleSQL.Parser
 >     (parseQueryExpr
@ -243,25 +244,113 @@ cast: cast(expr as type)
 >     prefixCast = try (TypedLit <$> typeName
 >                              <*> stringLiteral)

-extract(id from expr)
+the special op keywords
+parse an operator which is
+operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)
+
+> data SpecialOpKFirstArg = SOKNone
+>                         | SOKOptional
+>                         | SOKMandatory
+
+> specialOpK :: String -- name of the operator
+>            -> SpecialOpKFirstArg -- has a first arg without a keyword
+>            -> [(String,Bool)] -- the other args with their keywords
+>                               -- and whether they are optional
+>            -> P ScalarExpr
+> specialOpK opName firstArg kws =
+>     keyword_ opName >> do
+>     void $ symbol  "("
+>     let pfa = do
+>               e <- scalarExpr'
+>               -- check we haven't parsed the first
+>               -- keyword as an identifier
+>               guard (case (e,kws) of
+>                   (Iden (Name i), ((k,_):_)) | map toLower i == k -> False
+>                   _ -> True)
+>               return e
+>     fa <- case firstArg of
+>          SOKNone -> return Nothing
+>          SOKOptional -> optionMaybe (try pfa)
+>          SOKMandatory -> Just <$> pfa
+>     as <- mapM parseArg kws
+>     void $ symbol ")"
+>     return $ SpecialOpK (Name opName) fa $ catMaybes as
+>   where
+>     parseArg (nm,mand) =
+>         let p = keyword_ nm >> scalarExpr'
+>         in fmap (nm,) <$> if mand
+>                           then Just <$> p
+>                           else optionMaybe (try p)
+
+The actual operators:
+
+EXTRACT( date_part FROM expression )
+
+POSITION( string1 IN string2 )
+
+SUBSTRING(extraction_string FROM starting_position [FOR length]
+[COLLATE collation_name])
+
+CONVERT(char_value USING conversion_char_name)
+
+TRANSLATE(char_value USING translation_name)
+
+OVERLAY(string PLACING embedded_string FROM start
+[FOR length])
+
+TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
+target_string
+[COLLATE collation_name] )
+
+> specialOpKs :: P ScalarExpr
+> specialOpKs = choice $ map try
+>     [extract, position, substring, convert, translate, overlay, trim]

 > extract :: P ScalarExpr
-> extract = try (keyword_ "extract") >>
->     parens (makeOp <$> name
->                    <*> (keyword_ "from" *> scalarExpr'))
->   where makeOp n e = SpecialOp (Name "extract") [Iden n, e]
+> extract = specialOpK "extract" SOKMandatory [("from", True)]

-substring(x from expr to expr)
+> position :: P ScalarExpr
+> position = specialOpK "position" SOKMandatory [("in", True)]

-todo: also support substring(x from expr)
+strictly speaking, the substring must have at least one of from and
+for, but the parser doens't enforce this

 > substring :: P ScalarExpr
-> substring = try (keyword_ "substring") >>
->     parens (makeOp <$> scalarExpr'
->                    <*> (keyword_ "from" *> scalarExpr')
->                    <*> (keyword_ "for" *> scalarExpr')
->                    )
->   where makeOp a b c = SpecialOp (Name "substring") [a,b,c]
+> substring = specialOpK "substring" SOKMandatory
+>                 [("from", False),("for", False),("collate", False)]
+
+> convert :: P ScalarExpr
+> convert = specialOpK "convert" SOKMandatory [("using", True)]
+
+
+> translate :: P ScalarExpr
+> translate = specialOpK "translate" SOKMandatory [("using", True)]
+
+> overlay :: P ScalarExpr
+> overlay = specialOpK "overlay" SOKMandatory
+>                 [("placing", True),("from", True),("for", False)]
+
+trim is too different because of the optional char, so a custom parser
+the both ' ' is filled in as the default if either parts are missing
+in the source
+
+> trim :: P ScalarExpr
+> trim =
+>     keyword "trim" >>
+>     parens (mkTrim
+>             <$> option "both" sides
+>             <*> option " " stringLiteral
+>             <*> (keyword_ "from" *> scalarExpr')
+>             <*> optionMaybe (keyword_ "collate" *> stringLiteral))
+>   where
+>     sides = choice ["leading" <$ keyword_ "leading"
+>                    ,"trailing" <$ keyword_ "trailing"
+>                    ,"both" <$ keyword_ "both"]
+>     mkTrim fa ch fr cl =
+>       SpecialOpK (Name "trim") Nothing
+>           $ catMaybes [Just (fa,StringLit ch)
+>                       ,Just ("from", fr)
+>                       ,fmap (("collate",) . StringLit) cl]

 in: two variations:
 a in (expr0, expr1, ...)
@ -482,8 +571,7 @@ could at least do with some heavy explanation.
 > factor = choice [literal
 >                 ,scase
 >                 ,cast
->                 ,extract
->                 ,substring
+>                 ,try specialOpKs
 >                 ,subquery
 >                 ,prefixUnaryOp
 >                 ,try app
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@ -81,24 +81,17 @@
 >       ,name nm <+> scalarExpr b
 >       ,nest (length (unname nm) + 1) $ text "and" <+> scalarExpr c]

-> scalarExpr (SpecialOp (Name "extract") [a,n]) =
->   text "extract" <> parens (scalarExpr a
->                             <+> text "from"
->                             <+> scalarExpr n)
-
-> scalarExpr (SpecialOp (Name "substring") [a,s,e]) =
->   text "substring" <> parens (scalarExpr a
->                             <+> text "from"
->                             <+> scalarExpr s
->                             <+> text "for"
->                             <+> scalarExpr e)
-
 > scalarExpr (SpecialOp (Name "rowctor") as) =
 >     parens $ commaSep $ map scalarExpr as

 > scalarExpr (SpecialOp nm es) =
 >   name nm <+> parens (commaSep $ map scalarExpr es)

+> scalarExpr (SpecialOpK (Name nm) fs as) =
+>     text nm <> parens (sep $ catMaybes
+>         ((fmap scalarExpr fs)
+>          : map (\(n,e) -> Just (text n <+> scalarExpr e)) as))
+
 > scalarExpr (PrefixOp f e) = name f <+> scalarExpr e
 > scalarExpr (PostfixOp f e) = scalarExpr e <+> name f
 > scalarExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] =
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@ -84,16 +84,21 @@
 >       -- operators (a is similar to b)
 >     | BinOp ScalarExpr Name ScalarExpr
 >       -- | Prefix unary operators. This is used for symbol
->       -- operators, keyword operators and multiple keyword operators
+>       -- operators, keyword operators and multiple keyword operators.
 >     | PrefixOp Name ScalarExpr
 >       -- | Postfix unary operators. This is used for symbol
->       -- operators, keyword operators and multiple keyword operators
+>       -- operators, keyword operators and multiple keyword operators.
 >     | PostfixOp Name ScalarExpr
 >       -- | Used for ternary, mixfix and other non orthodox
->       -- operators, including the function looking calls which use
->       -- keywords instead of commas to separate the arguments,
->       -- e.g. substring(t from 1 to 5)
+>       -- operators. Currently used for row constructors, and for
+>       -- between.
 >     | SpecialOp Name [ScalarExpr]
+>       -- | Used for the operators which look like functions
+>       -- except the arguments are separated by keywords instead
+>       -- of commas. The maybe is for the first unnamed argument
+>       -- if it is present, and the list is for the keyword argument
+>       -- pairs.
+>     | SpecialOpK Name (Maybe ScalarExpr) [(String,ScalarExpr)]
 >       -- | case expression. both flavours supported
 >     | Case
 >       {caseTest :: Maybe ScalarExpr -- ^ test value
--- a/2
+++ b/2
@ -39,6 +39,8 @@ check ansi standard for operators

 == other

+change any/some/all to be proper infix operators like in
+
 review syntax to replace maybe and bool with better ctors
 maybe review some of the dodgy ast names like orderfield and inthing

--- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
@ -184,14 +184,6 @@ Tests for parsing scalar expressions
 >     [("a in (1,2,3)"
 >      ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"])

->     ,("a between b and c", SpecialOp "between" [Iden "a"
->                                                ,Iden "b"
->                                                ,Iden "c"])
-
->     ,("a not between b and c", SpecialOp "not between" [Iden "a"
->                                                        ,Iden "b"
->                                                        ,Iden "c"])
-
 >     ,("a is null", PostfixOp "is null" (Iden "a"))
 >     ,("a is not null", PostfixOp "is not null" (Iden "a"))
 >     ,("a is true", PostfixOp "is true" (Iden "a"))
@ -213,14 +205,115 @@ Tests for parsing scalar expressions
 >      ,BinOp (Iden "a") "is not similar to" (Iden "b"))

 >     ,("a overlaps b", BinOp (Iden "a") "overlaps" (Iden "b"))
->     ,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])

->     ,("substring(x from 1 for 2)"
->      ,SpecialOp "substring" [Iden "x", NumLit "1", NumLit "2"])

+special operators
+
+>     ,("a between b and c", SpecialOp "between" [Iden "a"
+>                                                ,Iden "b"
+>                                                ,Iden "c"])
+
+>     ,("a not between b and c", SpecialOp "not between" [Iden "a"
+>                                                        ,Iden "b"
+>                                                        ,Iden "c"])
 >     ,("(1,2)"
 >      ,SpecialOp "rowctor" [NumLit "1", NumLit "2"])

+
+keyword special operators
+
+>     ,("extract(day from t)"
+>      , SpecialOpK "extract" (Just $ Iden "day") [("from", Iden "t")])
+
+>     ,("substring(x from 1 for 2)"
+>      ,SpecialOpK "substring" (Just $ Iden "x") [("from", NumLit "1")
+>                                                ,("for", NumLit "2")])
+
+>     ,("substring(x from 1)"
+>      ,SpecialOpK "substring" (Just $ Iden "x") [("from", NumLit "1")])
+
+>     ,("substring(x for 2)"
+>      ,SpecialOpK "substring" (Just $ Iden "x") [("for", NumLit "2")])
+
+>     ,("substring(x from 1 for 2 collate 'C')"
+>      ,SpecialOpK "substring" (Just $ Iden "x") [("from", NumLit "1")
+>                                                ,("for", NumLit "2")
+>                                                ,("collate", StringLit "C")])
+
+>     ,("POSITION( string1 IN string2 )"
+>      ,SpecialOpK "position" (Just $ Iden "string1") [("in", Iden "string2")])
+
+>     ,("CONVERT(char_value USING conversion_char_name)"
+>      ,SpecialOpK "convert" (Just $ Iden "char_value")
+>           [("using", Iden "conversion_char_name")])
+
+>     ,("TRANSLATE(char_value USING translation_name)"
+>      ,SpecialOpK "translate" (Just $ Iden "char_value")
+>           [("using", Iden "translation_name")])
+
+OVERLAY(string PLACING embedded_string FROM start
+[FOR length])
+
+>     ,("OVERLAY(string PLACING embedded_string FROM start)"
+>      ,SpecialOpK "overlay" (Just $ Iden "string")
+>           [("placing", Iden "embedded_string")
+>           ,("from", Iden "start")])
+
+>     ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"
+>      ,SpecialOpK "overlay" (Just $ Iden "string")
+>           [("placing", Iden "embedded_string")
+>           ,("from", Iden "start")
+>           ,("for", Iden "length")])
+
+TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
+target_string
+[COLLATE collation_name] )
+
+
+
+>     ,("trim(from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("both", StringLit " ")
+>           ,("from", Iden "target_string")])
+
+>     ,("trim(leading from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("leading", StringLit " ")
+>           ,("from", Iden "target_string")])
+
+>     ,("trim(trailing from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("trailing", StringLit " ")
+>           ,("from", Iden "target_string")])
+
+>     ,("trim(both from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("both", StringLit " ")
+>           ,("from", Iden "target_string")])
+
+
+>     ,("trim(leading 'x' from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("leading", StringLit "x")
+>           ,("from", Iden "target_string")])
+
+>     ,("trim(trailing 'y' from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("trailing", StringLit "y")
+>           ,("from", Iden "target_string")])
+
+>     ,("trim(both 'z' from target_string collate 'C')"
+>      ,SpecialOpK "trim" Nothing
+>           [("both", StringLit "z")
+>           ,("from", Iden "target_string")
+>           ,("collate", StringLit "C")])
+
+>     ,("trim(leading from target_string)"
+>      ,SpecialOpK "trim" Nothing
+>           [("leading", StringLit " ")
+>           ,("from", Iden "target_string")])
+
+
 >     ]

 > aggregates :: TestItem