{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Database.Relational.Monad.Trans.Ordering
-- Copyright   : 2013-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines monad transformer which lift
-- from query into query with ordering.
module Database.Relational.Monad.Trans.Ordering (
  -- * Transformer into query with ordering
  Orderings, orderings,

  -- * API of query with ordering
  orderBy', orderBy, asc, desc,

  -- * Result
  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, untypeRecord)

import Database.Relational.Monad.Class
  (MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..))


-- | Type to accumulate ordering context.
--   Type 'c' is ordering term record context type.
newtype Orderings c m a =
  Orderings (WriterT (DList OrderingTerm) m a)
  deriving (m a -> Orderings c m a
(forall (m :: * -> *) a. Monad m => m a -> Orderings c m a)
-> MonadTrans (Orderings c)
forall c (m :: * -> *) a. Monad m => m a -> Orderings c m a
forall (m :: * -> *) a. Monad m => m a -> Orderings c m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Orderings c m a
$clift :: forall c (m :: * -> *) a. Monad m => m a -> Orderings c m a
MonadTrans, Applicative (Orderings c m)
a -> Orderings c m a
Applicative (Orderings c m)
-> (forall a b.
    Orderings c m a -> (a -> Orderings c m b) -> Orderings c m b)
-> (forall a b.
    Orderings c m a -> Orderings c m b -> Orderings c m b)
-> (forall a. a -> Orderings c m a)
-> Monad (Orderings c m)
Orderings c m a -> (a -> Orderings c m b) -> Orderings c m b
Orderings c m a -> Orderings c m b -> Orderings c m b
forall a. a -> Orderings c m a
forall a b. Orderings c m a -> Orderings c m b -> Orderings c m b
forall a b.
Orderings c m a -> (a -> Orderings c m b) -> Orderings c m b
forall c (m :: * -> *). Monad m => Applicative (Orderings c m)
forall c (m :: * -> *) a. Monad m => a -> Orderings c m a
forall c (m :: * -> *) a b.
Monad m =>
Orderings c m a -> Orderings c m b -> Orderings c m b
forall c (m :: * -> *) a b.
Monad m =>
Orderings c m a -> (a -> Orderings c m b) -> Orderings c m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Orderings c m a
$creturn :: forall c (m :: * -> *) a. Monad m => a -> Orderings c m a
>> :: Orderings c m a -> Orderings c m b -> Orderings c m b
$c>> :: forall c (m :: * -> *) a b.
Monad m =>
Orderings c m a -> Orderings c m b -> Orderings c m b
>>= :: Orderings c m a -> (a -> Orderings c m b) -> Orderings c m b
$c>>= :: forall c (m :: * -> *) a b.
Monad m =>
Orderings c m a -> (a -> Orderings c m b) -> Orderings c m b
$cp1Monad :: forall c (m :: * -> *). Monad m => Applicative (Orderings c m)
Monad, a -> Orderings c m b -> Orderings c m a
(a -> b) -> Orderings c m a -> Orderings c m b
(forall a b. (a -> b) -> Orderings c m a -> Orderings c m b)
-> (forall a b. a -> Orderings c m b -> Orderings c m a)
-> Functor (Orderings c m)
forall a b. a -> Orderings c m b -> Orderings c m a
forall a b. (a -> b) -> Orderings c m a -> Orderings c m b
forall c (m :: * -> *) a b.
Functor m =>
a -> Orderings c m b -> Orderings c m a
forall c (m :: * -> *) a b.
Functor m =>
(a -> b) -> Orderings c m a -> Orderings c m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Orderings c m b -> Orderings c m a
$c<$ :: forall c (m :: * -> *) a b.
Functor m =>
a -> Orderings c m b -> Orderings c m a
fmap :: (a -> b) -> Orderings c m a -> Orderings c m b
$cfmap :: forall c (m :: * -> *) a b.
Functor m =>
(a -> b) -> Orderings c m a -> Orderings c m b
Functor, Functor (Orderings c m)
a -> Orderings c m a
Functor (Orderings c m)
-> (forall a. a -> Orderings c m a)
-> (forall a b.
    Orderings c m (a -> b) -> Orderings c m a -> Orderings c m b)
-> (forall a b c.
    (a -> b -> c)
    -> Orderings c m a -> Orderings c m b -> Orderings c m c)
-> (forall a b.
    Orderings c m a -> Orderings c m b -> Orderings c m b)
-> (forall a b.
    Orderings c m a -> Orderings c m b -> Orderings c m a)
-> Applicative (Orderings c m)
Orderings c m a -> Orderings c m b -> Orderings c m b
Orderings c m a -> Orderings c m b -> Orderings c m a
Orderings c m (a -> b) -> Orderings c m a -> Orderings c m b
(a -> b -> c)
-> Orderings c m a -> Orderings c m b -> Orderings c m c
forall a. a -> Orderings c m a
forall a b. Orderings c m a -> Orderings c m b -> Orderings c m a
forall a b. Orderings c m a -> Orderings c m b -> Orderings c m b
forall a b.
Orderings c m (a -> b) -> Orderings c m a -> Orderings c m b
forall a b c.
(a -> b -> c)
-> Orderings c m a -> Orderings c m b -> Orderings c m c
forall c (m :: * -> *). Applicative m => Functor (Orderings c m)
forall c (m :: * -> *) a. Applicative m => a -> Orderings c m a
forall c (m :: * -> *) a b.
Applicative m =>
Orderings c m a -> Orderings c m b -> Orderings c m a
forall c (m :: * -> *) a b.
Applicative m =>
Orderings c m a -> Orderings c m b -> Orderings c m b
forall c (m :: * -> *) a b.
Applicative m =>
Orderings c m (a -> b) -> Orderings c m a -> Orderings c m b
forall c (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> Orderings c m a -> Orderings c m b -> Orderings c m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Orderings c m a -> Orderings c m b -> Orderings c m a
$c<* :: forall c (m :: * -> *) a b.
Applicative m =>
Orderings c m a -> Orderings c m b -> Orderings c m a
*> :: Orderings c m a -> Orderings c m b -> Orderings c m b
$c*> :: forall c (m :: * -> *) a b.
Applicative m =>
Orderings c m a -> Orderings c m b -> Orderings c m b
liftA2 :: (a -> b -> c)
-> Orderings c m a -> Orderings c m b -> Orderings c m c
$cliftA2 :: forall c (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> Orderings c m a -> Orderings c m b -> Orderings c m c
<*> :: Orderings c m (a -> b) -> Orderings c m a -> Orderings c m b
$c<*> :: forall c (m :: * -> *) a b.
Applicative m =>
Orderings c m (a -> b) -> Orderings c m a -> Orderings c m b
pure :: a -> Orderings c m a
$cpure :: forall c (m :: * -> *) a. Applicative m => a -> Orderings c m a
$cp1Applicative :: forall c (m :: * -> *). Applicative m => Functor (Orderings c m)
Applicative)

-- | Lift to 'Orderings'.
orderings :: Monad m => m a -> Orderings c m a
orderings :: m a -> Orderings c m a
orderings =  m a -> Orderings c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | 'MonadRestrict' with ordering.
instance MonadRestrict rc m => MonadRestrict rc (Orderings c m) where
  restrict :: Predicate rc -> Orderings c m ()
restrict = m () -> Orderings c m ()
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m () -> Orderings c m ())
-> (Predicate rc -> m ()) -> Predicate rc -> Orderings c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate rc -> m ()
forall c (m :: * -> *). MonadRestrict c m => Predicate c -> m ()
restrict

-- | 'MonadQualify' with ordering.
instance MonadQualify q m => MonadQualify q (Orderings c m) where
  liftQualify :: q a -> Orderings c m a
liftQualify = m a -> Orderings c m a
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m a -> Orderings c m a) -> (q a -> m a) -> q a -> Orderings c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q a -> m a
forall (q :: * -> *) (m :: * -> *) a.
MonadQualify q m =>
q a -> m a
liftQualify

-- | 'MonadQuery' with ordering.
instance MonadQuery m => MonadQuery (Orderings c m) where
  setDuplication :: Duplication -> Orderings c m ()
setDuplication     = m () -> Orderings c m ()
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m () -> Orderings c m ())
-> (Duplication -> m ()) -> Duplication -> Orderings c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duplication -> m ()
forall (m :: * -> *). MonadQuery m => Duplication -> m ()
setDuplication
  restrictJoin :: Predicate Flat -> Orderings c m ()
restrictJoin       = m () -> Orderings c m ()
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m () -> Orderings c m ())
-> (Predicate Flat -> m ()) -> Predicate Flat -> Orderings c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate Flat -> m ()
forall (m :: * -> *). MonadQuery m => Predicate Flat -> m ()
restrictJoin
  query' :: Relation p r -> Orderings c m (PlaceHolders p, Record Flat r)
query'             = m (PlaceHolders p, Record Flat r)
-> Orderings c m (PlaceHolders p, Record Flat r)
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m (PlaceHolders p, Record Flat r)
 -> Orderings c m (PlaceHolders p, Record Flat r))
-> (Relation p r -> m (PlaceHolders p, Record Flat r))
-> Relation p r
-> Orderings c m (PlaceHolders p, Record Flat r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> m (PlaceHolders p, Record Flat r)
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query'
  queryMaybe' :: Relation p r
-> Orderings c m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'        = m (PlaceHolders p, Record Flat (Maybe r))
-> Orderings c m (PlaceHolders p, Record Flat (Maybe r))
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m (PlaceHolders p, Record Flat (Maybe r))
 -> Orderings c m (PlaceHolders p, Record Flat (Maybe r)))
-> (Relation p r -> m (PlaceHolders p, Record Flat (Maybe r)))
-> Relation p r
-> Orderings c m (PlaceHolders p, Record Flat (Maybe r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'

-- | 'MonadAggregate' with ordering.
instance MonadAggregate m => MonadAggregate (Orderings c m) where
  groupBy :: Record Flat r -> Orderings c m (Record Aggregated r)
groupBy  = m (Record Aggregated r) -> Orderings c m (Record Aggregated r)
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m (Record Aggregated r) -> Orderings c m (Record Aggregated r))
-> (Record Flat r -> m (Record Aggregated r))
-> Record Flat r
-> Orderings c m (Record Aggregated r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record Flat r -> m (Record Aggregated r)
forall (m :: * -> *) r.
MonadAggregate m =>
Record Flat r -> m (Record Aggregated r)
groupBy
  groupBy' :: AggregateKey (Record Aggregated r)
-> Orderings c m (Record Aggregated r)
groupBy' = m (Record Aggregated r) -> Orderings c m (Record Aggregated r)
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m (Record Aggregated r) -> Orderings c m (Record Aggregated r))
-> (AggregateKey (Record Aggregated r) -> m (Record Aggregated r))
-> AggregateKey (Record Aggregated r)
-> Orderings c m (Record Aggregated r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregateKey (Record Aggregated r) -> m (Record Aggregated r)
forall (m :: * -> *) r.
MonadAggregate m =>
AggregateKey (Record Aggregated r) -> m (Record Aggregated r)
groupBy'

-- | 'MonadPartition' with ordering.
instance MonadPartition c m => MonadPartition c (Orderings c m) where
  partitionBy :: Record c r -> Orderings c m ()
partitionBy = m () -> Orderings c m ()
forall (m :: * -> *) a c. Monad m => m a -> Orderings c m a
orderings (m () -> Orderings c m ())
-> (Record c r -> m ()) -> Record c r -> Orderings c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c r -> m ()
forall c (m :: * -> *) r. MonadPartition c m => Record c r -> m ()
partitionBy

-- | Add ordering terms.
updateOrderBys :: Monad m
               => (Order, Maybe Nulls) -- ^ Order direction
               -> Record c t       -- ^ Ordering terms to add
               -> Orderings c m ()     -- ^ Result context with ordering
updateOrderBys :: (Order, Maybe Nulls) -> Record c t -> Orderings c m ()
updateOrderBys (Order, Maybe Nulls)
opair Record c t
p = WriterT (DList OrderingTerm) m () -> Orderings c m ()
forall c (m :: * -> *) a.
WriterT (DList OrderingTerm) m a -> Orderings c m a
Orderings (WriterT (DList OrderingTerm) m () -> Orderings c m ())
-> ([DList OrderingTerm] -> WriterT (DList OrderingTerm) m ())
-> [DList OrderingTerm]
-> Orderings c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DList OrderingTerm -> WriterT (DList OrderingTerm) m ())
-> [DList OrderingTerm] -> WriterT (DList OrderingTerm) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DList OrderingTerm -> WriterT (DList OrderingTerm) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([DList OrderingTerm] -> Orderings c m ())
-> [DList OrderingTerm] -> Orderings c m ()
forall a b. (a -> b) -> a -> b
$ [DList OrderingTerm]
terms  where
  terms :: [DList OrderingTerm]
terms = (OrderingTerm -> DList OrderingTerm)
-> (Order, Maybe Nulls) -> Column -> DList OrderingTerm
forall a b c. ((a, b) -> c) -> a -> b -> c
curry OrderingTerm -> DList OrderingTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Order, Maybe Nulls)
opair (Column -> DList OrderingTerm) -> [Column] -> [DList OrderingTerm]
forall a b. (a -> b) -> [a] -> [b]
`map` Record c t -> [Column]
forall c t. Record c t -> [Column]
untypeRecord Record c t
p

-- | Add ordering terms with null ordering.
orderBy' :: Monad m
         => Record c t   -- ^ Ordering terms to add
         -> Order            -- ^ Order direction
         -> Nulls            -- ^ Order of null
         -> Orderings c m () -- ^ Result context with ordering
orderBy' :: Record c t -> Order -> Nulls -> Orderings c m ()
orderBy' Record c t
p Order
o Nulls
n = (Order, Maybe Nulls) -> Record c t -> Orderings c m ()
forall (m :: * -> *) c t.
Monad m =>
(Order, Maybe Nulls) -> Record c t -> Orderings c m ()
updateOrderBys (Order
o, Nulls -> Maybe Nulls
forall a. a -> Maybe a
Just Nulls
n) Record c t
p

-- | Add ordering terms.
orderBy :: Monad m
        => Record c t   -- ^ Ordering terms to add
        -> Order        -- ^ Order direction
        -> Orderings c m () -- ^ Result context with ordering
orderBy :: Record c t -> Order -> Orderings c m ()
orderBy Record c t
p Order
o = (Order, Maybe Nulls) -> Record c t -> Orderings c m ()
forall (m :: * -> *) c t.
Monad m =>
(Order, Maybe Nulls) -> Record c t -> Orderings c m ()
updateOrderBys (Order
o, Maybe Nulls
forall a. Maybe a
Nothing) Record c t
p

-- | Add ascendant ordering term.
asc :: Monad m
    => Record c t   -- ^ Ordering terms to add
    -> Orderings c m () -- ^ Result context with ordering
asc :: Record c t -> Orderings c m ()
asc  =  (Order, Maybe Nulls) -> Record c t -> Orderings c m ()
forall (m :: * -> *) c t.
Monad m =>
(Order, Maybe Nulls) -> Record c t -> Orderings c m ()
updateOrderBys (Order
Asc, Maybe Nulls
forall a. Maybe a
Nothing)

-- | Add descendant ordering term.
desc :: Monad m
     => Record c t   -- ^ Ordering terms to add
     -> Orderings c m () -- ^ Result context with ordering
desc :: Record c t -> Orderings c m ()
desc =  (Order, Maybe Nulls) -> Record c t -> Orderings c m ()
forall (m :: * -> *) c t.
Monad m =>
(Order, Maybe Nulls) -> Record c t -> Orderings c m ()
updateOrderBys (Order
Desc, Maybe Nulls
forall a. Maybe a
Nothing)

-- | Run 'Orderings' to get 'OrderingTerms'
extractOrderingTerms :: (Monad m, Functor m) => Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms :: Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms (Orderings WriterT (DList OrderingTerm) m a
oc) = (DList OrderingTerm -> [OrderingTerm])
-> (a, DList OrderingTerm) -> (a, [OrderingTerm])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DList OrderingTerm -> [OrderingTerm]
forall a. DList a -> [a]
toList ((a, DList OrderingTerm) -> (a, [OrderingTerm]))
-> m (a, DList OrderingTerm) -> m (a, [OrderingTerm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT (DList OrderingTerm) m a -> m (a, DList OrderingTerm)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (DList OrderingTerm) m a
oc