{-# language DataKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}

module Rel8.Table.Order
  ( ascTable
  , descTable
  )
where

-- base
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Functor.Contravariant ( (>$<), contramap )
import Prelude

-- rel8
import Rel8.Expr ( unE )
import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )
import Rel8.Order ( Order )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable (htabulateA, hfield, hspecs)
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import Rel8.Schema.Spec ( SSpec( SSpec ) )
import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
import Rel8.Table ( Columns, toColumns )
import Rel8.Table.Ord


-- | Construct an 'Order' for a 'Table' by sorting all columns into ascending
-- orders (any nullable columns will be sorted with @NULLS FIRST@).
ascTable :: forall a. OrdTable a => Order a
ascTable :: Order a
ascTable = (a -> Columns a (Col Expr))
-> Order (Columns a (Col Expr)) -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (Order (Columns a (Col Expr)) -> Order a)
-> Order (Columns a (Col Expr)) -> Order a
forall a b. (a -> b) -> a -> b
$ Const (Order (Columns a (Col Expr))) (Columns a Any)
-> Order (Columns a (Col Expr))
forall a k (b :: k). Const a b -> a
getConst (Const (Order (Columns a (Col Expr))) (Columns a Any)
 -> Order (Columns a (Col Expr)))
-> Const (Order (Columns a (Col Expr))) (Columns a Any)
-> Order (Columns a (Col Expr))
forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) (context :: HContext).
(HTable (Columns a), Apply m) =>
(forall (spec :: Spec).
 HField (Columns a) spec -> m (context spec))
-> m (Columns a context)
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA @(Columns a) ((forall (spec :: Spec).
  HField (Columns a) spec
  -> Const (Order (Columns a (Col Expr))) (Any spec))
 -> Const (Order (Columns a (Col Expr))) (Columns a Any))
-> (forall (spec :: Spec).
    HField (Columns a) spec
    -> Const (Order (Columns a (Col Expr))) (Any spec))
-> Const (Order (Columns a (Col Expr))) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) spec
field -> case Columns a SSpec -> HField (Columns a) spec -> SSpec spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField (Columns a) spec
field of
    SSpec {} -> case Columns a (Dict (ConstrainDBType DBOrd))
-> HField (Columns a) ('Spec labels a)
-> Dict (ConstrainDBType DBOrd) ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield (OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
forall a. OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
ordTable @a) HField (Columns a) spec
HField (Columns a) ('Spec labels a)
field of
      dict :: Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict@Dict (ConstrainDBType DBOrd) ('Spec labels a)
Dict -> case Dict (ConstrainDBType DBOrd) ('Spec labels a)
-> Dict DBOrd (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict of
        Dict DBOrd (Unnullify a)
Dict -> Order (Columns a (Col Expr))
-> Const (Order (Columns a (Col Expr))) (Any spec)
forall k a (b :: k). a -> Const a b
Const (Order (Columns a (Col Expr))
 -> Const (Order (Columns a (Col Expr))) (Any spec))
-> Order (Columns a (Col Expr))
-> Const (Order (Columns a (Col Expr))) (Any spec)
forall a b. (a -> b) -> a -> b
$ Col Expr ('Spec labels a) -> Expr a
forall (labels :: Labels) a. Col Expr ('Spec labels a) -> Expr a
unE (Col Expr ('Spec labels a) -> Expr a)
-> (Columns a (Col Expr) -> Col Expr ('Spec labels a))
-> Columns a (Col Expr)
-> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Columns a (Col Expr)
-> HField (Columns a) ('Spec labels a) -> Col Expr ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
`hfield` HField (Columns a) spec
HField (Columns a) ('Spec labels a)
field) (Columns a (Col Expr) -> Expr a)
-> Order (Expr a) -> Order (Columns a (Col Expr))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$<
          case Dict (ConstrainDBType DBOrd) ('Spec labels a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict of
            Nullity a
Null -> Order (Expr (Unnullify a)) -> Order (Expr (Maybe (Unnullify a)))
forall a. Order (Expr a) -> Order (Expr (Maybe a))
nullsFirst Order (Expr (Unnullify a))
forall a. DBOrd a => Order (Expr a)
asc
            Nullity a
NotNull -> Order (Expr a)
forall a. DBOrd a => Order (Expr a)
asc


-- | Construct an 'Order' for a 'Table' by sorting all columns into descending
-- orders (any nullable columns will be sorted with @NULLS LAST@).
descTable :: forall a. OrdTable a => Order a
descTable :: Order a
descTable = (a -> Columns a (Col Expr))
-> Order (Columns a (Col Expr)) -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (Order (Columns a (Col Expr)) -> Order a)
-> Order (Columns a (Col Expr)) -> Order a
forall a b. (a -> b) -> a -> b
$ Const (Order (Columns a (Col Expr))) (Columns a Any)
-> Order (Columns a (Col Expr))
forall a k (b :: k). Const a b -> a
getConst (Const (Order (Columns a (Col Expr))) (Columns a Any)
 -> Order (Columns a (Col Expr)))
-> Const (Order (Columns a (Col Expr))) (Columns a Any)
-> Order (Columns a (Col Expr))
forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) (context :: HContext).
(HTable (Columns a), Apply m) =>
(forall (spec :: Spec).
 HField (Columns a) spec -> m (context spec))
-> m (Columns a context)
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA @(Columns a) ((forall (spec :: Spec).
  HField (Columns a) spec
  -> Const (Order (Columns a (Col Expr))) (Any spec))
 -> Const (Order (Columns a (Col Expr))) (Columns a Any))
-> (forall (spec :: Spec).
    HField (Columns a) spec
    -> Const (Order (Columns a (Col Expr))) (Any spec))
-> Const (Order (Columns a (Col Expr))) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) spec
field -> case Columns a SSpec -> HField (Columns a) spec -> SSpec spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField (Columns a) spec
field of
    SSpec {} -> case Columns a (Dict (ConstrainDBType DBOrd))
-> HField (Columns a) ('Spec labels a)
-> Dict (ConstrainDBType DBOrd) ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield (OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
forall a. OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
ordTable @a) HField (Columns a) spec
HField (Columns a) ('Spec labels a)
field of
      dict :: Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict@Dict (ConstrainDBType DBOrd) ('Spec labels a)
Dict -> case Dict (ConstrainDBType DBOrd) ('Spec labels a)
-> Dict DBOrd (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict of
        Dict DBOrd (Unnullify a)
Dict -> Order (Columns a (Col Expr))
-> Const (Order (Columns a (Col Expr))) (Any spec)
forall k a (b :: k). a -> Const a b
Const (Order (Columns a (Col Expr))
 -> Const (Order (Columns a (Col Expr))) (Any spec))
-> Order (Columns a (Col Expr))
-> Const (Order (Columns a (Col Expr))) (Any spec)
forall a b. (a -> b) -> a -> b
$ Col Expr ('Spec labels a) -> Expr a
forall (labels :: Labels) a. Col Expr ('Spec labels a) -> Expr a
unE (Col Expr ('Spec labels a) -> Expr a)
-> (Columns a (Col Expr) -> Col Expr ('Spec labels a))
-> Columns a (Col Expr)
-> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Columns a (Col Expr)
-> HField (Columns a) ('Spec labels a) -> Col Expr ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
`hfield` HField (Columns a) spec
HField (Columns a) ('Spec labels a)
field) (Columns a (Col Expr) -> Expr a)
-> Order (Expr a) -> Order (Columns a (Col Expr))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$<
          case Dict (ConstrainDBType DBOrd) ('Spec labels a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict of
            Nullity a
Null -> Order (Expr (Unnullify a)) -> Order (Expr (Maybe (Unnullify a)))
forall a. Order (Expr a) -> Order (Expr (Maybe a))
nullsLast Order (Expr (Unnullify a))
forall a. DBOrd a => Order (Expr a)
desc
            Nullity a
NotNull -> Order (Expr a)
forall a. DBOrd a => Order (Expr a)
desc