{-# language DataKinds #-}
{-# language NamedFieldPuns #-}
{-# 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.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 ( Spec( Spec, nullity ) )
import Rel8.Table ( Columns, toColumns )
import Rel8.Table.Ord ( OrdTable, ordTable )


-- | 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 :: forall a. OrdTable a => Order a
ascTable = forall (f :: Context) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$
  forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA @(Columns a) forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field -> case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField (Columns a) a
field of
    Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @a) HField (Columns a) a
field of
      Dict (Sql DBOrd) a
Dict -> forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ (forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns a) a
field) forall (f :: Context) a b.
Contravariant f =>
(a -> b) -> f b -> f a
>$<
        case Nullity a
nullity of
          Nullity a
Null -> forall a. Order (Expr a) -> Order (Expr (Maybe a))
nullsFirst forall a. DBOrd a => Order (Expr a)
asc
          Nullity a
NotNull -> 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 :: forall a. OrdTable a => Order a
descTable = forall (f :: Context) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$
  forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA @(Columns a) forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field -> case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField (Columns a) a
field of
    Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @a) HField (Columns a) a
field of
      Dict (Sql DBOrd) a
Dict -> forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ (forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns a) a
field) forall (f :: Context) a b.
Contravariant f =>
(a -> b) -> f b -> f a
>$<
        case Nullity a
nullity of
          Nullity a
Null -> forall a. Order (Expr a) -> Order (Expr (Maybe a))
nullsLast forall a. DBOrd a => Order (Expr a)
desc
          Nullity a
NotNull -> forall a. DBOrd a => Order (Expr a)
desc