fixes for substring, change the abstract syntax for extract and

substring, and add the addition operators position, convert,
  translate, overlay and trim

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)

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

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"] =

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