add names/docs to some of the scalar expr constuctor fields, add partial support for explicit window frames

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

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

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)
+>       ,nest (length (unname nm) + 1) $ text "and" <+> scalarExpr c]
->        $ text "and" <+> scalarExpr c]
 
 > scalarExpr (SpecialOp (Name "extract") [a,n]) =
 >   text "extract" <> parens (scalarExpr a

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)
+>     | AggregateApp
->                    [ScalarExpr]
+>       {aggName :: Name -- ^ aggregate function name
->                    [(ScalarExpr,Direction)]
+>       ,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
+>     | Case
->            [(ScalarExpr,ScalarExpr)] -- when branches
+>       {caseTest :: Maybe ScalarExpr -- ^ test value
->            (Maybe ScalarExpr) -- else 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;

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"] [] [])
+>     [("max(a) over ()", WindowApp "max" [Iden "a"] [] [] Nothing)
->     ,("count(*) over ()", WindowApp "count" [Star] [] [])
+>     ,("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)])
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] Nothing)
->      -- todo: check order by options, add frames
+
+>     ,("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