module Database.Relational.Monad.Trans.Ordering (
Orderings, orderings,
orderBy', orderBy, asc, desc,
extractOrderingTerms
) where
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)
import Control.Applicative (Applicative, pure, (<$>))
import Control.Arrow (second)
import Data.DList (DList, toList)
import Database.Relational.SqlSyntax
(Order (..), Nulls (..), OrderingTerm, Record)
import qualified Database.Relational.Record as Record
import Database.Relational.Monad.Class
(MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..))
newtype Orderings c m a =
Orderings (WriterT (DList OrderingTerm) m a)
deriving (MonadTrans, Monad, Functor, Applicative)
orderings :: Monad m => m a -> Orderings c m a
orderings = lift
instance MonadRestrict rc m => MonadRestrict rc (Orderings c m) where
restrict = orderings . restrict
instance MonadQualify q m => MonadQualify q (Orderings c m) where
liftQualify = orderings . liftQualify
instance MonadQuery m => MonadQuery (Orderings c m) where
setDuplication = orderings . setDuplication
restrictJoin = orderings . restrictJoin
query' = orderings . query'
queryMaybe' = orderings . queryMaybe'
instance MonadAggregate m => MonadAggregate (Orderings c m) where
groupBy = orderings . groupBy
groupBy' = orderings . groupBy'
instance MonadPartition c m => MonadPartition c (Orderings c m) where
partitionBy = orderings . partitionBy
updateOrderBys :: Monad m
=> (Order, Maybe Nulls)
-> Record c t
-> Orderings c m ()
updateOrderBys opair p = Orderings . mapM_ tell $ terms where
terms = curry pure opair `map` Record.columns p
orderBy' :: Monad m
=> Record c t
-> Order
-> Nulls
-> Orderings c m ()
orderBy' p o n = updateOrderBys (o, Just n) p
orderBy :: Monad m
=> Record c t
-> Order
-> Orderings c m ()
orderBy p o = updateOrderBys (o, Nothing) p
asc :: Monad m
=> Record c t
-> Orderings c m ()
asc = updateOrderBys (Asc, Nothing)
desc :: Monad m
=> Record c t
-> Orderings c m ()
desc = updateOrderBys (Desc, Nothing)
extractOrderingTerms :: (Monad m, Functor m) => Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms (Orderings oc) = second toList <$> runWriterT oc