ORDER BY support.

relational-join/src/Database/Relational/Query.hs

@@ -21,4 +21,4 @@ import Database.Relational.Query.Projection
    value, valueTrue, valueFalse, valueNull, placeholder)
 import Database.Relational.Query.Relation (Relation)
 import Database.Relational.Query.Join
-import Database.Relational.Query.Type (Query, untypeQuery, toQuery)
+import Database.Relational.Query.Type (Query, untypeQuery, fromRelation)

relational-join/src/Database/Relational/Query/Join.hs

@@ -2,7 +2,7 @@
 module Database.Relational.Query.Join (
   QueryJoin,
 
-  on, wheres,
+  on, wheres, asc, desc,
   table,
 
   record, expr, compose, (>*<), (!), (!?), relation,
@@ -25,7 +25,7 @@ import qualified Database.Relational.Query.AliasId as AliasId
 import Database.Relational.Query.Table (Table)
 import Database.Relational.Query.Sub (SubQuery)
 
-import Database.Relational.Query.Expr (Expr)
+import Database.Relational.Query.Expr (Expr, showExpr)
 import qualified Database.Relational.Query.Expr as Expr
 
 import Database.Relational.Query.Product
@@ -37,17 +37,18 @@ import qualified Database.Relational.Query.Projection as Projection
 
 import Database.Relational.Query.Pi (Pi)
 
-import Database.Relational.Query.Relation (Relation, finalizeRelation)
+import Database.Relational.Query.Relation (Relation, finalizeRelation, Order(Asc, Desc))
 import qualified Database.Relational.Query.Relation as Relation
 
 data Context = Context
                { currentAliasId :: AliasId
                , product :: Maybe QueryProduct
                , restriction :: Maybe (Expr Bool)
+               , orderByRev :: [(Order, String)]
                }
 
 primContext :: Context
-primContext =  Context primAlias Nothing Nothing
+primContext =  Context primAlias Nothing Nothing []
 
 nextAliasContext :: Context -> Context
 nextAliasContext s = s { currentAliasId =  newAliasId (currentAliasId s) }
@@ -62,6 +63,10 @@ updateRestriction' e1 ctx =
   where uf  Nothing = e1
         uf (Just e0) = e0 `Expr.and` e1
 
+updateOrderBy' :: Order -> Expr t -> Context -> Context
+updateOrderBy' order e ctx =
+  ctx { orderByRev = ((order, showExpr e) :) . orderByRev $ ctx  }
+
 
 newtype QueryJoin a =
   QueryJoin { runQueryJoin :: Context -> (a, Context) }
@@ -89,6 +94,9 @@ updateJoinRestriction e = updateContext (updateProduct' d)  where
 updateRestriction :: Expr Bool -> QueryJoin ()
 updateRestriction e = updateContext (updateRestriction' e)
 
+updateOrderBy :: Order -> Expr t -> QueryJoin ()
+updateOrderBy order e = updateContext (updateOrderBy' order e)
+
 
 on :: Expr Bool -> QueryJoin ()
 on =  updateJoinRestriction
@@ -96,6 +104,12 @@ on =  updateJoinRestriction
 wheres :: Expr Bool -> QueryJoin ()
 wheres =  updateRestriction
 
+asc  :: Expr t -> QueryJoin ()
+asc  =  updateOrderBy Asc
+
+desc :: Expr t -> QueryJoin ()
+desc =  updateOrderBy Desc
+
 
 table :: Table r -> Relation r
 table =  Relation.fromTable
@@ -157,7 +171,7 @@ from :: Table r -> QueryJoin (Projection r)
 from =  inner . table
 
 relation :: QueryJoin (Projection r) -> Relation r
-relation q = finalizeRelation projection product' (restriction st)  where
+relation q = finalizeRelation projection product' (restriction st) (orderByRev st)  where
   (projection, st) = runQueryPrime q
   product' = maybe (error "relation: empty product!") Product.tree $ product st
 

relational-join/src/Database/Relational/Query/Relation.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
 
 module Database.Relational.Query.Relation (
 
+  Order (..),
   Relation,
 
   outer,
@@ -13,6 +15,7 @@ module Database.Relational.Query.Relation (
   ) where
 
 import Prelude hiding (product, and)
+import Data.List (foldl')
 
 import Database.Relational.Query.AliasId (asColumnN)
 
@@ -33,11 +36,14 @@ import Language.SQL.Keyword (Keyword(..), unwordsSQL)
 import qualified Language.SQL.Keyword as SQL
 
 
+data Order = Asc | Desc
+
 data Relation r = Table (Table r)
                 | Relation
                   { projection  :: Projection r
                   , product     :: Product
                   , restriction :: Maybe (Expr Bool)
+                  , orderByRev  :: [(Order, String)]
                   }
 
 outer :: Relation r -> Relation (Maybe r)
@@ -53,17 +59,23 @@ width =  d  where
 fromTable :: Table r -> Relation r
 fromTable =  Table
 
-composedSQL :: Projection r -> Product -> Maybe (Expr Bool) -> String
+composedSQL :: Projection r -> Product -> Maybe (Expr Bool) -> [(Order, String)] -> String
-composedSQL pj pd re =
+composedSQL pj pd re odRev =
   unwordsSQL
-  $ [SELECT, columns' `SQL.sepBy` SQL.word ", ",
+  $ [SELECT, columns' `SQL.sepBy` ", ",
-     FROM, SQL.word . productSQL $ pd ]
+     FROM, SQL.word . productSQL $ pd]
   ++ wheres re
+  ++ orders
     where columns' = zipWith
                     (\f n -> SQL.word f `asColumnN` n)
                     (Projection.columns pj)
                     [(0 :: Int)..]
           wheres  = maybe [] (\e -> [WHERE, SQL.word . showExpr $ e])
+          order Asc  = ASC
+          order Desc = DESC
+          orderList = foldl' (\ r (o, e) -> [SQL.word e, order o] `SQL.sepBy` " "  : r) [] odRev
+          orders | null odRev = []
+                 | otherwise  = [ORDER, BY, orderList `SQL.sepBy` ", "]
 
 toSubQuery :: Relation r -> SubQuery
 toSubQuery =  d  where
@@ -72,10 +84,12 @@ toSubQuery =  d  where
                          (composedSQL
                           (projection rel)
                           (product rel)
-                          (restriction rel))
+                          (restriction rel)
+                          (orderByRev rel)
+                         )
                          (width rel)
 
-finalizeRelation :: Projection r -> Product -> Maybe (Expr Bool) -> Relation r
+finalizeRelation :: Projection r -> Product -> Maybe (Expr Bool) -> [(Order, String)] -> Relation r
 finalizeRelation =  Relation
 
 toSQL :: Relation r -> String

relational-join/src/Database/Relational/Query/Type.hs

@@ -1,6 +1,6 @@
 
 module Database.Relational.Query.Type (
-  Query (untypeQuery), unsafeTypedQuery, toQuery
+  Query (untypeQuery), unsafeTypedQuery, fromRelation
   ) where
 
 import Database.Relational.Query.Relation (Relation)
@@ -15,5 +15,5 @@ instance Show (Query p a) where
   show = untypeQuery
 
 
-toQuery :: Relation r -> Query p r
+fromRelation :: Relation r -> Query p r
-toQuery =  unsafeTypedQuery . Relation.toSQL
+fromRelation =  unsafeTypedQuery . Relation.toSQL