diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs index 8663f6e..2b7a7c2 100644 --- 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) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 9f04ca2..769ad9f 100644 --- 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 diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index a6ce889..fb02a91 100644 --- 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"] = diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index aa91235..dfd3b4c 100644 --- 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 diff --git a/TODO b/TODO index 9a2627a..c9570b9 100644 --- a/TODO +++ b/TODO @@ -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 diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs index 7beecab..3f6f7aa 100644 --- 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