{-# language DataKinds #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
module Rel8.Table.Order
( ascTable
, descTable
)
where
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Functor.Contravariant ( (>$<), contramap )
import Prelude
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 )
ascTable :: forall a. OrdTable a => Order a
ascTable :: Order a
ascTable = (a -> Columns a Expr) -> Order (Columns a Expr) -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns (Order (Columns a Expr) -> Order a)
-> Order (Columns a Expr) -> Order a
forall a b. (a -> b) -> a -> b
$ Const (Order (Columns a Expr)) (Columns a Any)
-> Order (Columns a Expr)
forall a k (b :: k). Const a b -> a
getConst (Const (Order (Columns a Expr)) (Columns a Any)
-> Order (Columns a Expr))
-> Const (Order (Columns a Expr)) (Columns a Any)
-> Order (Columns a Expr)
forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) (context :: * -> *).
(HTable (Columns a), Apply m) =>
(forall a. HField (Columns a) a -> m (context a))
-> m (Columns a context)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA @(Columns a) ((forall a.
HField (Columns a) a -> Const (Order (Columns a Expr)) (Any a))
-> Const (Order (Columns a Expr)) (Columns a Any))
-> (forall a.
HField (Columns a) a -> Const (Order (Columns a Expr)) (Any a))
-> Const (Order (Columns a Expr)) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field -> case Columns a Spec -> HField (Columns a) a -> Spec a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Spec
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 Columns a (Dict (Sql DBOrd))
-> HField (Columns a) a -> Dict (Sql DBOrd) a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (OrdTable a => Columns a (Dict (Sql DBOrd))
forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @a) HField (Columns a) a
field of
Dict (Sql DBOrd) a
Dict -> Order (Columns a Expr) -> Const (Order (Columns a Expr)) (Any a)
forall k a (b :: k). a -> Const a b
Const (Order (Columns a Expr) -> Const (Order (Columns a Expr)) (Any a))
-> Order (Columns a Expr) -> Const (Order (Columns a Expr)) (Any a)
forall a b. (a -> b) -> a -> b
$ (Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns a) a
field) (Columns a Expr -> Expr a)
-> Order (Expr a) -> Order (Columns a Expr)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$<
case Nullity a
nullity of
Nullity a
Null -> Order (Expr (Unnullify' (IsMaybe a) a))
-> Order (Expr (Maybe (Unnullify' (IsMaybe a) a)))
forall a. Order (Expr a) -> Order (Expr (Maybe a))
nullsFirst Order (Expr (Unnullify' (IsMaybe a) a))
forall a. DBOrd a => Order (Expr a)
asc
Nullity a
NotNull -> Order (Expr a)
forall a. DBOrd a => Order (Expr a)
asc
descTable :: forall a. OrdTable a => Order a
descTable :: Order a
descTable = (a -> Columns a Expr) -> Order (Columns a Expr) -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns (Order (Columns a Expr) -> Order a)
-> Order (Columns a Expr) -> Order a
forall a b. (a -> b) -> a -> b
$ Const (Order (Columns a Expr)) (Columns a Any)
-> Order (Columns a Expr)
forall a k (b :: k). Const a b -> a
getConst (Const (Order (Columns a Expr)) (Columns a Any)
-> Order (Columns a Expr))
-> Const (Order (Columns a Expr)) (Columns a Any)
-> Order (Columns a Expr)
forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) (context :: * -> *).
(HTable (Columns a), Apply m) =>
(forall a. HField (Columns a) a -> m (context a))
-> m (Columns a context)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA @(Columns a) ((forall a.
HField (Columns a) a -> Const (Order (Columns a Expr)) (Any a))
-> Const (Order (Columns a Expr)) (Columns a Any))
-> (forall a.
HField (Columns a) a -> Const (Order (Columns a Expr)) (Any a))
-> Const (Order (Columns a Expr)) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field -> case Columns a Spec -> HField (Columns a) a -> Spec a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Spec
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 Columns a (Dict (Sql DBOrd))
-> HField (Columns a) a -> Dict (Sql DBOrd) a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (OrdTable a => Columns a (Dict (Sql DBOrd))
forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @a) HField (Columns a) a
field of
Dict (Sql DBOrd) a
Dict -> Order (Columns a Expr) -> Const (Order (Columns a Expr)) (Any a)
forall k a (b :: k). a -> Const a b
Const (Order (Columns a Expr) -> Const (Order (Columns a Expr)) (Any a))
-> Order (Columns a Expr) -> Const (Order (Columns a Expr)) (Any a)
forall a b. (a -> b) -> a -> b
$ (Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns a) a
field) (Columns a Expr -> Expr a)
-> Order (Expr a) -> Order (Columns a Expr)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$<
case Nullity a
nullity of
Nullity a
Null -> Order (Expr (Unnullify' (IsMaybe a) a))
-> Order (Expr (Maybe (Unnullify' (IsMaybe a) a)))
forall a. Order (Expr a) -> Order (Expr (Maybe a))
nullsLast Order (Expr (Unnullify' (IsMaybe a) a))
forall a. DBOrd a => Order (Expr a)
desc
Nullity a
NotNull -> Order (Expr a)
forall a. DBOrd a => Order (Expr a)
desc