add support for nulls first/last

2013-12-17 18:28:31 +02:00 · 2013-12-17 18:28:31 +02:00 · ebe522b21d
parent e85ab8b831
commit ebe522b21d
7 changed files with 66 additions and 34 deletions
--- a/Language/SQL/SimpleSQL/Fixity.lhs
+++ b/Language/SQL/SimpleSQL/Fixity.lhs
@ -84,15 +84,15 @@ the fixity code.
 >     Star -> str ('v':show e)
 >     AggregateApp nm d es od ->
 >         HSE.App (var ('a':name nm))
->         $ HSE.List [str $ show (d,map snd od)
+>         $ HSE.List [str $ show (d,orderInf od)
 >                    ,HSE.List $ map toHaskell es
->                    ,HSE.List $ map (toHaskell . fst) od]
+>                    ,HSE.List $ orderExps od]
 >     WindowApp nm es pb od r ->
 >         HSE.App (var ('w':name nm))
->         $ HSE.List [str $ show (map snd od, r)
+>         $ HSE.List [str $ show (orderInf od, r)
 >                    ,HSE.List $ map toHaskell es
 >                    ,HSE.List $ map toHaskell pb
->                    ,HSE.List $ map (toHaskell . fst) od]
+>                    ,HSE.List $ orderExps od]
 >     PrefixOp nm e0 ->
 >         HSE.App (HSE.Var $ sym $ name nm) (toHaskell e0)
 >     PostfixOp nm e0 ->
@ -119,6 +119,10 @@ the fixity code.
 >     name n = case n of
 >        QName q -> "\"" ++ q
 >        Name m -> m
+>     orderExps = map (toHaskell . (\(OrderField a _ _) -> a))
+>     orderInf = map (\(OrderField _ b c) -> (b,c))
+
+


 > toSql :: HSE.Exp -> ScalarExpr
@ -135,17 +139,17 @@ the fixity code.
 >             (HSE.List [HSE.Lit (HSE.String vs)
 >                       ,HSE.List es
 >                       ,HSE.List od]) ->
->         let (d,dir) = read vs
+>         let (d,oinf) = read vs
 >         in AggregateApp (unname i) d (map toSql es)
->                         $ zip (map toSql od) dir
+>                         $ sord oinf od
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('w':i))))
 >             (HSE.List [HSE.Lit (HSE.String vs)
 >                       ,HSE.List es
 >                       ,HSE.List pb
 >                       ,HSE.List od]) ->
->         let (dir,r) = read vs
+>         let (oinf,r) = read vs
 >         in WindowApp (unname i) (map toSql es) (map toSql pb)
->                        (zip (map toSql od) dir) r
+>                        (sord oinf od) 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 ->
@ -165,6 +169,7 @@ the fixity code.
 >         in In b (toSql e0) sq
 >     _ -> err e
 >   where
+>     sord = zipWith (\(i0,i1) ce -> OrderField (toSql ce) i0 i1)
 >     ltom (HSE.List []) = Nothing
 >     ltom (HSE.List [ex]) = Just $ toSql ex
 >     ltom ex = err ex
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@ -605,12 +605,17 @@ where, having, limit, offset).
 > having :: P ScalarExpr
 > having = keywordScalarExpr "having"

-> orderBy :: P [(ScalarExpr,Direction)]
+> orderBy :: P [OrderField]
 > orderBy = try (keyword_ "order") *> keyword_ "by" *> commaSep1 ob
 >   where
->     ob = (,) <$> scalarExpr
+>     ob = OrderField
+>          <$> scalarExpr
 >          <*> option Asc (choice [Asc <$ keyword_ "asc"
 >                                 ,Desc <$ keyword_ "desc"])
+>          <*> option NullsOrderDefault
+>              (try (keyword_ "nulls" >>
+>                     choice [NullsFirst <$ keyword "first"
+>                            ,NullsLast <$ keyword "last"]))

 allows offset and fetch in either order
 + postgresql offset without row(s) and limit instead of fetch also
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@ -260,13 +260,18 @@
 > grpBy gs = sep [text "group by"
 >                ,nest 9 $ commaSep $ map scalarExpr gs]

-> orderBy :: [(ScalarExpr,Direction)] -> Doc
+> orderBy :: [OrderField] -> Doc
 > orderBy [] = empty
 > orderBy os = sep [text "order by"
 >                  ,nest 9 $ commaSep $ map f os]
 >   where
->     f (e,Asc) = scalarExpr e
->     f (e,Desc) = scalarExpr e <+> text "desc"
+>     f (OrderField e d n) =
+>         scalarExpr e
+>         <+> (if d == Asc then empty else text "desc")
+>         <+> (case n of
+>                 NullsOrderDefault -> empty
+>                 NullsFirst -> text "nulls" <+> text "first"
+>                 NullsLast -> text "nulls" <+> text "last")

 = utils

--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@ -6,7 +6,9 @@
 >     ,Name(..)
 >     ,TypeName(..)
 >     ,Duplicates(..)
+>     ,OrderField(..)
 >     ,Direction(..)
+>     ,NullsOrder(..)
 >     ,InThing(..)
 >     ,SubQueryExprType(..)
 >     ,Frame(..)
@ -65,7 +67,7 @@
 >       {aggName :: Name -- ^ aggregate function name
 >       ,aggDistinct :: (Maybe Duplicates)-- ^ distinct
 >       ,aggArgs :: [ScalarExpr]-- ^ args
->       ,aggOrderBy :: [(ScalarExpr,Direction)] -- ^ order by
+>       ,aggOrderBy :: [OrderField] -- ^ order by
 >       }
 >       -- | window application, which adds over (partition by a order
 >       -- by b) to regular function application. Explicit frames are
@ -74,7 +76,7 @@
 >       {wnName :: Name -- ^ window function name
 >       ,wnArgs :: [ScalarExpr] -- ^ args
 >       ,wnPartition :: [ScalarExpr] -- ^ partition by
->       ,wnOrderBy :: [(ScalarExpr,Direction)] -- ^ order by
+>       ,wnOrderBy :: [OrderField] -- ^ order by
 >       ,wnFrame :: Maybe Frame -- ^ frame clause
 >       }
 >       -- | Infix binary operators. This is used for symbol operators
@ -141,6 +143,14 @@
 >     | SqAny
 >       deriving (Eq,Show,Read)

+> data OrderField = OrderField ScalarExpr Direction NullsOrder
+>                   deriving (Eq,Show,Read)
+
+> data NullsOrder = NullsOrderDefault
+>                 | NullsFirst
+>                 | NullsLast
+>                   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
@ -181,7 +191,7 @@
 >       ,qeWhere :: Maybe ScalarExpr
 >       ,qeGroupBy :: [ScalarExpr]
 >       ,qeHaving :: Maybe ScalarExpr
->       ,qeOrderBy :: [(ScalarExpr,Direction)]
+>       ,qeOrderBy :: [OrderField]
 >       ,qeOffset :: Maybe ScalarExpr
 >       ,qeFetch :: Maybe ScalarExpr
 >       }
--- a/tools/Language/SQL/SimpleSQL/FullQueries.lhs
+++ b/tools/Language/SQL/SimpleSQL/FullQueries.lhs
@ -33,7 +33,7 @@ Some tests for parsing full queries.
 >       ,qeGroupBy = [Iden "a"]
 >       ,qeHaving = Just $ BinOp (App "count" [NumLit "1"])
 >                                ">" (NumLit "5")
->       ,qeOrderBy = [(Iden "s", Asc)]
+>       ,qeOrderBy = [OrderField (Iden "s") Asc NullsOrderDefault]
 >       }
 >      )
 >     ]
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@ -108,16 +108,23 @@ These are a few misc tests which don't fit anywhere else.
 > orderBy :: TestItem
 > orderBy = Group "orderBy" $ map (uncurry TestQueryExpr)
 >     [("select a from t order by a"
->      ,ms [(Iden "a", Asc)])
+>      ,ms [OrderField (Iden "a") Asc NullsOrderDefault])

 >     ,("select a from t order by a, b"
->      ,ms [(Iden "a", Asc), (Iden "b", Asc)])
+>      ,ms [OrderField (Iden "a") Asc NullsOrderDefault
+>          ,OrderField (Iden "b") Asc NullsOrderDefault])

 >     ,("select a from t order by a asc"
->      ,ms [(Iden "a", Asc)])
+>      ,ms [OrderField (Iden "a") Asc NullsOrderDefault])

 >     ,("select a from t order by a desc, b desc"
->      ,ms [(Iden "a", Desc), (Iden "b", Desc)])
+>      ,ms [OrderField (Iden "a") Desc NullsOrderDefault
+>          ,OrderField (Iden "b") Desc NullsOrderDefault])
+
+>     ,("select a from t order by a desc nulls first, b desc nulls last"
+>      ,ms [OrderField (Iden "a") Desc NullsFirst
+>          ,OrderField (Iden "b") Desc NullsLast])
+
 >     ]
 >   where
 >     ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")]
--- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
@ -213,7 +213,7 @@ Tests for parsing scalar expressions
 >     [("count(*)",App "count" [Star])

 >     ,("sum(a order by a)"
->     ,AggregateApp "sum" Nothing [Iden "a"] [(Iden "a", Asc)])
+>     ,AggregateApp "sum" Nothing [Iden "a"] [(OrderField (Iden "a") Asc NullsOrderDefault)])

 >     ,("sum(all a)"
 >     ,AggregateApp "sum" (Just All) [Iden "a"] [])
@ -234,37 +234,37 @@ Tests for parsing scalar expressions
 >      ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] [] Nothing)

 >     ,("sum(a) over (order by b)"
->      ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Asc)] Nothing)
+>      ,WindowApp "sum" [Iden "a"] [] [(OrderField (Iden "b") Asc NullsOrderDefault)] Nothing)

 >     ,("sum(a) over (order by b desc,c)"
->      ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Desc)
->                                     ,(Iden "c", Asc)] Nothing)
+>      ,WindowApp "sum" [Iden "a"] [] [(OrderField (Iden "b") Desc NullsOrderDefault)
+>                                     ,(OrderField (Iden "c") Asc NullsOrderDefault)] Nothing)

 >     ,("sum(a) over (partition by b order by c)"
->      ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)] Nothing)
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault] Nothing)

 >     ,("sum(a) over (partition by b order by c range unbounded preceding)"
->      ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)]
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault]
 >       $ 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)]
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault]
 >       $ 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)]
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault]
 >       $ 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)]
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault]
 >       $ 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)]
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault]
 >       $ 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)]
+>      ,WindowApp "sum" [Iden "a"] [Iden "b"] [OrderField (Iden "c") Asc NullsOrderDefault]
 >       $ Just $ FrameBetween FrameRange (Preceding (NumLit "5")) (Following (NumLit "5")))

 >     ]