From e85ab8b8311a9f59abd4c1e071e6de200871f5e5 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Tue, 17 Dec 2013 17:29:49 +0200 Subject: [PATCH] add names/docs to some of the scalar expr constuctor fields, add partial support for explicit window frames --- Language/SQL/SimpleSQL/Fixity.lhs | 8 +-- Language/SQL/SimpleSQL/Parser.lhs | 34 ++++++++++++- Language/SQL/SimpleSQL/Pretty.lhs | 21 ++++++-- Language/SQL/SimpleSQL/Syntax.lhs | 53 +++++++++++++++++--- tools/Language/SQL/SimpleSQL/ScalarExprs.lhs | 40 ++++++++++++--- 5 files changed, 131 insertions(+), 25 deletions(-) diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs index 4aa88cd..5478a2b 100644 --- a/Language/SQL/SimpleSQL/Fixity.lhs +++ b/Language/SQL/SimpleSQL/Fixity.lhs @@ -87,9 +87,9 @@ the fixity code. > $ HSE.List [str $ show (d,map snd od) > ,HSE.List $ map toHaskell es > ,HSE.List $ map (toHaskell . fst) od] -> WindowApp nm es pb od -> +> WindowApp nm es pb od r -> > HSE.App (var ('w':name nm)) -> $ HSE.List [str $ show (map snd od) +> $ HSE.List [str $ show (map snd od, r) > ,HSE.List $ map toHaskell es > ,HSE.List $ map toHaskell pb > ,HSE.List $ map (toHaskell . fst) od] @@ -143,9 +143,9 @@ the fixity code. > ,HSE.List es > ,HSE.List pb > ,HSE.List od]) -> -> let dir = read vs +> let (dir,r) = read vs > in WindowApp (unname i) (map toSql es) (map toSql pb) -> $ zip (map toSql od) dir +> (zip (map toSql od) dir) r > HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol ('p':nm)))) e0 -> > PostfixOp (unname nm) $ toSql e0 > HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol nm))) e0 -> diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index f75efaf..66a2010 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -177,10 +177,36 @@ always used with the optionSuffix combinator. > try (keyword_ "over") > *> parens (WindowApp f es > <$> option [] partitionBy -> <*> option [] orderBy) +> <*> option [] orderBy +> <*> optionMaybe frameClause) > where > partitionBy = try (keyword_ "partition") >> > keyword_ "by" >> commaSep1 scalarExpr' +> frameClause = +> mkFrame <$> (choice [FrameRows <$ keyword_ "rows" +> ,FrameRange <$ keyword_ "range"]) +> <*> frameStartEnd +> frameStartEnd = +> choice +> [try (keyword_ "between") >> +> mkFrameBetween <$> frameLimit True +> <*> (keyword_ "and" *> frameLimit True) +> ,mkFrameFrom <$> frameLimit False] +> -- use the bexpression style from the between parsing for frame between +> frameLimit useB = +> choice +> [Current <$ try (keyword_ "current") <* keyword_ "row" +> ,try (keyword_ "unbounded") >> +> choice [UnboundedPreceding <$ keyword_ "preceding" +> ,UnboundedFollowing <$ keyword_ "following"] +> ,do +> e <- if useB then scalarExprB else scalarExpr +> choice [Preceding e <$ keyword_ "preceding" +> ,Following e <$ keyword_ "following"] +> ] +> mkFrameBetween s e rs = FrameBetween rs s e +> mkFrameFrom s rs = FrameFrom rs s +> mkFrame rs c = c rs > windowSuffix _ = fail "" > app :: P ScalarExpr @@ -486,6 +512,12 @@ expression tree (for efficiency and code clarity). > scalarExpr :: P ScalarExpr > scalarExpr = fixFixities sqlFixities <$> scalarExpr' +expose the b expression for window frame clause range between + +> scalarExprB :: P ScalarExpr +> scalarExprB = fixFixities sqlFixities <$> scalarExpr'' True + + ------------------------------------------------- = query expressions diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 9e7239f..39cee3b 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -52,21 +52,34 @@ > <+> commaSep (map scalarExpr es) > <+> orderBy od) -> scalarExpr (WindowApp f es pb od) = +> scalarExpr (WindowApp f es pb od fr) = > name f <> parens (commaSep $ map scalarExpr es) > <+> text "over" > <+> parens ((case pb of > [] -> empty > _ -> text "partition by" > <+> nest 13 (commaSep $ map scalarExpr pb)) -> <+> orderBy od) +> <+> orderBy od +> <+> maybe empty frd fr) +> where +> frd (FrameFrom rs fp) = rsd rs <+> fpd fp +> frd (FrameBetween rs fps fpe) = +> rsd rs <+> text "between" <+> fpd fps +> <+> text "and" <+> fpd fpe +> rsd rs = case rs of +> FrameRows -> text "rows" +> FrameRange -> text "range" +> fpd UnboundedPreceding = text "unbounded preceding" +> fpd UnboundedFollowing = text "unbounded following" +> fpd Current = text "current row" +> fpd (Preceding e) = scalarExpr e <+> text "preceding" +> fpd (Following e) = scalarExpr e <+> text "following" > scalarExpr (SpecialOp nm [a,b,c]) | nm `elem` [Name "between" > ,Name "not between"] = > sep [scalarExpr a > ,name nm <+> scalarExpr b -> ,nest (length (unname nm) + 1) -> $ text "and" <+> scalarExpr c] +> ,nest (length (unname nm) + 1) $ text "and" <+> scalarExpr c] > scalarExpr (SpecialOp (Name "extract") [a,n]) = > text "extract" <> parens (scalarExpr a diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 862a16b..8a7a5b9 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -9,6 +9,9 @@ > ,Direction(..) > ,InThing(..) > ,SubQueryExprType(..) +> ,Frame(..) +> ,FrameRows(..) +> ,FramePos(..) > -- * Query expressions > ,QueryExpr(..) > ,makeSelect @@ -44,7 +47,11 @@ > | StringLit String > -- | text of interval literal, units of interval precision, > -- e.g. interval 3 days (3) -> | IntervalLit String String (Maybe Int) +> | IntervalLit +> {ilLiteral :: String -- ^ literal text +> ,ilUnits :: String -- ^ units +> ,ilPrecision :: Maybe Int -- ^ precision +> } > -- | identifier without dots > | Iden Name > -- | star, as in select *, t.*, count(*) @@ -54,13 +61,22 @@ > | App Name [ScalarExpr] > -- | aggregate application, which adds distinct or all, and > -- order by, to regular function application -> | AggregateApp Name (Maybe Duplicates) -> [ScalarExpr] -> [(ScalarExpr,Direction)] +> | AggregateApp +> {aggName :: Name -- ^ aggregate function name +> ,aggDistinct :: (Maybe Duplicates)-- ^ distinct +> ,aggArgs :: [ScalarExpr]-- ^ args +> ,aggOrderBy :: [(ScalarExpr,Direction)] -- ^ order by +> } > -- | window application, which adds over (partition by a order > -- by b) to regular function application. Explicit frames are > -- not currently supported -> | WindowApp Name [ScalarExpr] [ScalarExpr] [(ScalarExpr,Direction)] +> | WindowApp +> {wnName :: Name -- ^ window function name +> ,wnArgs :: [ScalarExpr] -- ^ args +> ,wnPartition :: [ScalarExpr] -- ^ partition by +> ,wnOrderBy :: [(ScalarExpr,Direction)] -- ^ order by +> ,wnFrame :: Maybe Frame -- ^ frame clause +> } > -- | Infix binary operators. This is used for symbol operators > -- (a + b), keyword operators (a and b) and multiple keyword > -- operators (a is similar to b) @@ -79,9 +95,11 @@ > -- | case expression. both flavours supported. Multiple > -- condition when branches not currently supported (case when > -- a=4,b=5 then x end) -> | Case (Maybe ScalarExpr) -- test value -> [(ScalarExpr,ScalarExpr)] -- when branches -> (Maybe ScalarExpr) -- else value +> | Case +> {caseTest :: Maybe ScalarExpr -- ^ test value +> ,caseWhens :: [(ScalarExpr,ScalarExpr)] -- ^ when branches +> ,caseElse :: Maybe ScalarExpr -- ^ else value +> } > | Parens ScalarExpr > -- | cast(a as typename) > | Cast ScalarExpr TypeName @@ -123,6 +141,25 @@ > | SqAny > deriving (Eq,Show,Read) +> -- | Represents the frame clause of a window +> -- this can be [range | rows] frame_start +> -- or [range | rows] between frame_start and frame_end +> data Frame = FrameFrom FrameRows FramePos +> | FrameBetween FrameRows FramePos FramePos +> deriving (Eq,Show,Read) + +> -- | Represents whether a window frame clause is over rows or ranges +> data FrameRows = FrameRows | FrameRange +> deriving (Eq,Show,Read) + +> -- | represents the start or end of a frame +> data FramePos = UnboundedPreceding +> | Preceding ScalarExpr +> | Current +> | Following ScalarExpr +> | UnboundedFollowing +> deriving (Eq,Show,Read) + > -- | Represents a query expression, which can be: > -- > -- * a regular select; diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs index fec0790..8d20533 100644 --- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs @@ -224,25 +224,49 @@ Tests for parsing scalar expressions > windowFunctions :: TestItem > windowFunctions = Group "windowFunctions" $ map (uncurry TestScalarExpr) -> [("max(a) over ()", WindowApp "max" [Iden "a"] [] []) -> ,("count(*) over ()", WindowApp "count" [Star] [] []) +> [("max(a) over ()", WindowApp "max" [Iden "a"] [] [] Nothing) +> ,("count(*) over ()", WindowApp "count" [Star] [] [] Nothing) > ,("max(a) over (partition by b)" -> ,WindowApp "max" [Iden "a"] [Iden "b"] []) +> ,WindowApp "max" [Iden "a"] [Iden "b"] [] Nothing) > ,("max(a) over (partition by b,c)" -> ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] []) +> ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] [] Nothing) > ,("sum(a) over (order by b)" -> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Asc)]) +> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Asc)] Nothing) > ,("sum(a) over (order by b desc,c)" > ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Desc) -> ,(Iden "c", Asc)]) +> ,(Iden "c", Asc)] Nothing) > ,("sum(a) over (partition by b order by c)" -> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)]) -> -- todo: check order by options, add frames +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] Nothing) + +> ,("sum(a) over (partition by b order by c range unbounded preceding)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] +> $ Just $ FrameFrom FrameRange UnboundedPreceding) + +> ,("sum(a) over (partition by b order by c range 5 preceding)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] +> $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5")) + +> ,("sum(a) over (partition by b order by c range current row)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] +> $ Just $ FrameFrom FrameRange Current) + +> ,("sum(a) over (partition by b order by c rows 5 following)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] +> $ Just $ FrameFrom FrameRows $ Following (NumLit "5")) + +> ,("sum(a) over (partition by b order by c range unbounded following)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] +> $ Just $ FrameFrom FrameRange UnboundedFollowing) + +> ,("sum(a) over (partition by b order by c range between 5 preceding and 5 following)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] +> $ Just $ FrameBetween FrameRange (Preceding (NumLit "5")) (Following (NumLit "5"))) + > ] > parens :: TestItem