{-# LANGUAGE DeriveAnyClass #-}

module Hasura.Backends.DataConnector.IR.OrderBy
  ( OrderBy (..),
    OrderByRelation (..),
    OrderByElement (..),
    OrderByTarget (..),
    OrderDirection (..),
  )
where

--------------------------------------------------------------------------------

import Data.Aeson (ToJSON)
import Data.Aeson qualified as J
import Data.Bifunctor (bimap)
import Data.HashMap.Strict qualified as HashMap
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.IR.Aggregate qualified as IR.A
import Hasura.Backends.DataConnector.IR.Column qualified as IR.C
import Hasura.Backends.DataConnector.IR.Expression qualified as IR.E
import Hasura.Backends.DataConnector.IR.Relationships qualified as IR.R
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Witch qualified

--------------------------------------------------------------------------------

data OrderBy = OrderBy
  { OrderBy -> HashMap RelationshipName OrderByRelation
_obRelations :: HashMap IR.R.RelationshipName OrderByRelation,
    OrderBy -> NonEmpty OrderByElement
_obElements :: NonEmpty OrderByElement
  }
  deriving stock (Typeable OrderBy
DataType
Constr
Typeable OrderBy
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OrderBy -> c OrderBy)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OrderBy)
-> (OrderBy -> Constr)
-> (OrderBy -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OrderBy))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy))
-> ((forall b. Data b => b -> b) -> OrderBy -> OrderBy)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderBy -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderBy -> r)
-> (forall u. (forall d. Data d => d -> u) -> OrderBy -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy)
-> Data OrderBy
OrderBy -> DataType
OrderBy -> Constr
(forall b. Data b => b -> b) -> OrderBy -> OrderBy
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u
forall u. (forall d. Data d => d -> u) -> OrderBy -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderBy)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy)
$cOrderBy :: Constr
$tOrderBy :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
gmapMp :: (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
gmapM :: (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
gmapQi :: Int -> (forall d. Data d => d -> u) -> OrderBy -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u
gmapQ :: (forall d. Data d => d -> u) -> OrderBy -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderBy -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
gmapT :: (forall b. Data b => b -> b) -> OrderBy -> OrderBy
$cgmapT :: (forall b. Data b => b -> b) -> OrderBy -> OrderBy
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OrderBy)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderBy)
dataTypeOf :: OrderBy -> DataType
$cdataTypeOf :: OrderBy -> DataType
toConstr :: OrderBy -> Constr
$ctoConstr :: OrderBy -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
$cp1Data :: Typeable OrderBy
Data, OrderBy -> OrderBy -> Bool
(OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool) -> Eq OrderBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderBy -> OrderBy -> Bool
$c/= :: OrderBy -> OrderBy -> Bool
== :: OrderBy -> OrderBy -> Bool
$c== :: OrderBy -> OrderBy -> Bool
Eq, (forall x. OrderBy -> Rep OrderBy x)
-> (forall x. Rep OrderBy x -> OrderBy) -> Generic OrderBy
forall x. Rep OrderBy x -> OrderBy
forall x. OrderBy -> Rep OrderBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderBy x -> OrderBy
$cfrom :: forall x. OrderBy -> Rep OrderBy x
Generic, Eq OrderBy
Eq OrderBy
-> (OrderBy -> OrderBy -> Ordering)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> OrderBy)
-> (OrderBy -> OrderBy -> OrderBy)
-> Ord OrderBy
OrderBy -> OrderBy -> Bool
OrderBy -> OrderBy -> Ordering
OrderBy -> OrderBy -> OrderBy
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrderBy -> OrderBy -> OrderBy
$cmin :: OrderBy -> OrderBy -> OrderBy
max :: OrderBy -> OrderBy -> OrderBy
$cmax :: OrderBy -> OrderBy -> OrderBy
>= :: OrderBy -> OrderBy -> Bool
$c>= :: OrderBy -> OrderBy -> Bool
> :: OrderBy -> OrderBy -> Bool
$c> :: OrderBy -> OrderBy -> Bool
<= :: OrderBy -> OrderBy -> Bool
$c<= :: OrderBy -> OrderBy -> Bool
< :: OrderBy -> OrderBy -> Bool
$c< :: OrderBy -> OrderBy -> Bool
compare :: OrderBy -> OrderBy -> Ordering
$ccompare :: OrderBy -> OrderBy -> Ordering
$cp1Ord :: Eq OrderBy
Ord, Int -> OrderBy -> ShowS
[OrderBy] -> ShowS
OrderBy -> String
(Int -> OrderBy -> ShowS)
-> (OrderBy -> String) -> ([OrderBy] -> ShowS) -> Show OrderBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderBy] -> ShowS
$cshowList :: [OrderBy] -> ShowS
show :: OrderBy -> String
$cshow :: OrderBy -> String
showsPrec :: Int -> OrderBy -> ShowS
$cshowsPrec :: Int -> OrderBy -> ShowS
Show)
  deriving anyclass (Eq OrderBy
Eq OrderBy
-> (Accesses -> OrderBy -> OrderBy -> Bool) -> Cacheable OrderBy
Accesses -> OrderBy -> OrderBy -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> OrderBy -> OrderBy -> Bool
$cunchanged :: Accesses -> OrderBy -> OrderBy -> Bool
$cp1Cacheable :: Eq OrderBy
Cacheable, Int -> OrderBy -> Int
OrderBy -> Int
(Int -> OrderBy -> Int) -> (OrderBy -> Int) -> Hashable OrderBy
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OrderBy -> Int
$chash :: OrderBy -> Int
hashWithSalt :: Int -> OrderBy -> Int
$chashWithSalt :: Int -> OrderBy -> Int
Hashable, OrderBy -> ()
(OrderBy -> ()) -> NFData OrderBy
forall a. (a -> ()) -> NFData a
rnf :: OrderBy -> ()
$crnf :: OrderBy -> ()
NFData)

instance ToJSON OrderBy where
  toJSON :: OrderBy -> Value
toJSON = Options -> OrderBy -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
J.defaultOptions

instance Witch.From OrderBy API.OrderBy where
  from :: OrderBy -> OrderBy
from OrderBy {NonEmpty OrderByElement
HashMap RelationshipName OrderByRelation
_obElements :: NonEmpty OrderByElement
_obRelations :: HashMap RelationshipName OrderByRelation
_obElements :: OrderBy -> NonEmpty OrderByElement
_obRelations :: OrderBy -> HashMap RelationshipName OrderByRelation
..} =
    OrderBy :: HashMap RelationshipName OrderByRelation
-> NonEmpty OrderByElement -> OrderBy
API.OrderBy
      { _obRelations :: HashMap RelationshipName OrderByRelation
_obRelations = [(RelationshipName, OrderByRelation)]
-> HashMap RelationshipName OrderByRelation
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(RelationshipName, OrderByRelation)]
 -> HashMap RelationshipName OrderByRelation)
-> [(RelationshipName, OrderByRelation)]
-> HashMap RelationshipName OrderByRelation
forall a b. (a -> b) -> a -> b
$ (RelationshipName -> RelationshipName)
-> (OrderByRelation -> OrderByRelation)
-> (RelationshipName, OrderByRelation)
-> (RelationshipName, OrderByRelation)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RelationshipName -> RelationshipName
forall source target. From source target => source -> target
Witch.from OrderByRelation -> OrderByRelation
forall source target. From source target => source -> target
Witch.from ((RelationshipName, OrderByRelation)
 -> (RelationshipName, OrderByRelation))
-> [(RelationshipName, OrderByRelation)]
-> [(RelationshipName, OrderByRelation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap RelationshipName OrderByRelation
-> [(RelationshipName, OrderByRelation)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap RelationshipName OrderByRelation
_obRelations,
        _obElements :: NonEmpty OrderByElement
_obElements = OrderByElement -> OrderByElement
forall source target. From source target => source -> target
Witch.from (OrderByElement -> OrderByElement)
-> NonEmpty OrderByElement -> NonEmpty OrderByElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty OrderByElement
_obElements
      }

data OrderByRelation = OrderByRelation
  { OrderByRelation -> Maybe Expression
_obrWhere :: Maybe IR.E.Expression,
    OrderByRelation -> HashMap RelationshipName OrderByRelation
_obrSubrelations :: HashMap IR.R.RelationshipName OrderByRelation
  }
  deriving stock (Typeable OrderByRelation
DataType
Constr
Typeable OrderByRelation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OrderByRelation -> c OrderByRelation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OrderByRelation)
-> (OrderByRelation -> Constr)
-> (OrderByRelation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OrderByRelation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OrderByRelation))
-> ((forall b. Data b => b -> b)
    -> OrderByRelation -> OrderByRelation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OrderByRelation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OrderByRelation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OrderByRelation -> m OrderByRelation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OrderByRelation -> m OrderByRelation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OrderByRelation -> m OrderByRelation)
-> Data OrderByRelation
OrderByRelation -> DataType
OrderByRelation -> Constr
(forall b. Data b => b -> b) -> OrderByRelation -> OrderByRelation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByRelation -> c OrderByRelation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByRelation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OrderByRelation -> u
forall u. (forall d. Data d => d -> u) -> OrderByRelation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByRelation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByRelation -> c OrderByRelation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderByRelation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByRelation)
$cOrderByRelation :: Constr
$tOrderByRelation :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
gmapMp :: (forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
gmapM :: (forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrderByRelation -> m OrderByRelation
gmapQi :: Int -> (forall d. Data d => d -> u) -> OrderByRelation -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OrderByRelation -> u
gmapQ :: (forall d. Data d => d -> u) -> OrderByRelation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderByRelation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByRelation -> r
gmapT :: (forall b. Data b => b -> b) -> OrderByRelation -> OrderByRelation
$cgmapT :: (forall b. Data b => b -> b) -> OrderByRelation -> OrderByRelation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByRelation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByRelation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OrderByRelation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderByRelation)
dataTypeOf :: OrderByRelation -> DataType
$cdataTypeOf :: OrderByRelation -> DataType
toConstr :: OrderByRelation -> Constr
$ctoConstr :: OrderByRelation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByRelation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByRelation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByRelation -> c OrderByRelation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByRelation -> c OrderByRelation
$cp1Data :: Typeable OrderByRelation
Data, OrderByRelation -> OrderByRelation -> Bool
(OrderByRelation -> OrderByRelation -> Bool)
-> (OrderByRelation -> OrderByRelation -> Bool)
-> Eq OrderByRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderByRelation -> OrderByRelation -> Bool
$c/= :: OrderByRelation -> OrderByRelation -> Bool
== :: OrderByRelation -> OrderByRelation -> Bool
$c== :: OrderByRelation -> OrderByRelation -> Bool
Eq, (forall x. OrderByRelation -> Rep OrderByRelation x)
-> (forall x. Rep OrderByRelation x -> OrderByRelation)
-> Generic OrderByRelation
forall x. Rep OrderByRelation x -> OrderByRelation
forall x. OrderByRelation -> Rep OrderByRelation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderByRelation x -> OrderByRelation
$cfrom :: forall x. OrderByRelation -> Rep OrderByRelation x
Generic, Eq OrderByRelation
Eq OrderByRelation
-> (OrderByRelation -> OrderByRelation -> Ordering)
-> (OrderByRelation -> OrderByRelation -> Bool)
-> (OrderByRelation -> OrderByRelation -> Bool)
-> (OrderByRelation -> OrderByRelation -> Bool)
-> (OrderByRelation -> OrderByRelation -> Bool)
-> (OrderByRelation -> OrderByRelation -> OrderByRelation)
-> (OrderByRelation -> OrderByRelation -> OrderByRelation)
-> Ord OrderByRelation
OrderByRelation -> OrderByRelation -> Bool
OrderByRelation -> OrderByRelation -> Ordering
OrderByRelation -> OrderByRelation -> OrderByRelation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrderByRelation -> OrderByRelation -> OrderByRelation
$cmin :: OrderByRelation -> OrderByRelation -> OrderByRelation
max :: OrderByRelation -> OrderByRelation -> OrderByRelation
$cmax :: OrderByRelation -> OrderByRelation -> OrderByRelation
>= :: OrderByRelation -> OrderByRelation -> Bool
$c>= :: OrderByRelation -> OrderByRelation -> Bool
> :: OrderByRelation -> OrderByRelation -> Bool
$c> :: OrderByRelation -> OrderByRelation -> Bool
<= :: OrderByRelation -> OrderByRelation -> Bool
$c<= :: OrderByRelation -> OrderByRelation -> Bool
< :: OrderByRelation -> OrderByRelation -> Bool
$c< :: OrderByRelation -> OrderByRelation -> Bool
compare :: OrderByRelation -> OrderByRelation -> Ordering
$ccompare :: OrderByRelation -> OrderByRelation -> Ordering
$cp1Ord :: Eq OrderByRelation
Ord, Int -> OrderByRelation -> ShowS
[OrderByRelation] -> ShowS
OrderByRelation -> String
(Int -> OrderByRelation -> ShowS)
-> (OrderByRelation -> String)
-> ([OrderByRelation] -> ShowS)
-> Show OrderByRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderByRelation] -> ShowS
$cshowList :: [OrderByRelation] -> ShowS
show :: OrderByRelation -> String
$cshow :: OrderByRelation -> String
showsPrec :: Int -> OrderByRelation -> ShowS
$cshowsPrec :: Int -> OrderByRelation -> ShowS
Show)
  deriving anyclass (Eq OrderByRelation
Eq OrderByRelation
-> (Accesses -> OrderByRelation -> OrderByRelation -> Bool)
-> Cacheable OrderByRelation
Accesses -> OrderByRelation -> OrderByRelation -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> OrderByRelation -> OrderByRelation -> Bool
$cunchanged :: Accesses -> OrderByRelation -> OrderByRelation -> Bool
$cp1Cacheable :: Eq OrderByRelation
Cacheable, Int -> OrderByRelation -> Int
OrderByRelation -> Int
(Int -> OrderByRelation -> Int)
-> (OrderByRelation -> Int) -> Hashable OrderByRelation
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OrderByRelation -> Int
$chash :: OrderByRelation -> Int
hashWithSalt :: Int -> OrderByRelation -> Int
$chashWithSalt :: Int -> OrderByRelation -> Int
Hashable, OrderByRelation -> ()
(OrderByRelation -> ()) -> NFData OrderByRelation
forall a. (a -> ()) -> NFData a
rnf :: OrderByRelation -> ()
$crnf :: OrderByRelation -> ()
NFData)

instance ToJSON OrderByRelation where
  toJSON :: OrderByRelation -> Value
toJSON = Options -> OrderByRelation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
J.defaultOptions

instance Witch.From OrderByRelation API.OrderByRelation where
  from :: OrderByRelation -> OrderByRelation
from OrderByRelation {Maybe Expression
HashMap RelationshipName OrderByRelation
_obrSubrelations :: HashMap RelationshipName OrderByRelation
_obrWhere :: Maybe Expression
_obrSubrelations :: OrderByRelation -> HashMap RelationshipName OrderByRelation
_obrWhere :: OrderByRelation -> Maybe Expression
..} =
    OrderByRelation :: Maybe Expression
-> HashMap RelationshipName OrderByRelation -> OrderByRelation
API.OrderByRelation
      { _obrWhere :: Maybe Expression
_obrWhere = Expression -> Expression
forall source target. From source target => source -> target
Witch.from (Expression -> Expression) -> Maybe Expression -> Maybe Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expression
_obrWhere,
        _obrSubrelations :: HashMap RelationshipName OrderByRelation
_obrSubrelations = [(RelationshipName, OrderByRelation)]
-> HashMap RelationshipName OrderByRelation
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(RelationshipName, OrderByRelation)]
 -> HashMap RelationshipName OrderByRelation)
-> [(RelationshipName, OrderByRelation)]
-> HashMap RelationshipName OrderByRelation
forall a b. (a -> b) -> a -> b
$ (RelationshipName -> RelationshipName)
-> (OrderByRelation -> OrderByRelation)
-> (RelationshipName, OrderByRelation)
-> (RelationshipName, OrderByRelation)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RelationshipName -> RelationshipName
forall source target. From source target => source -> target
Witch.from OrderByRelation -> OrderByRelation
forall source target. From source target => source -> target
Witch.from ((RelationshipName, OrderByRelation)
 -> (RelationshipName, OrderByRelation))
-> [(RelationshipName, OrderByRelation)]
-> [(RelationshipName, OrderByRelation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap RelationshipName OrderByRelation
-> [(RelationshipName, OrderByRelation)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap RelationshipName OrderByRelation
_obrSubrelations
      }

data OrderByElement = OrderByElement
  { OrderByElement -> [RelationshipName]
_obeTargetPath :: [IR.R.RelationshipName],
    OrderByElement -> OrderByTarget
_obeTarget :: OrderByTarget,
    OrderByElement -> OrderDirection
_obeOrderDirection :: OrderDirection
  }
  deriving stock (Typeable OrderByElement
DataType
Constr
Typeable OrderByElement
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OrderByElement -> c OrderByElement)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OrderByElement)
-> (OrderByElement -> Constr)
-> (OrderByElement -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OrderByElement))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OrderByElement))
-> ((forall b. Data b => b -> b)
    -> OrderByElement -> OrderByElement)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderByElement -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderByElement -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OrderByElement -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OrderByElement -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OrderByElement -> m OrderByElement)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OrderByElement -> m OrderByElement)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OrderByElement -> m OrderByElement)
-> Data OrderByElement
OrderByElement -> DataType
OrderByElement -> Constr
(forall b. Data b => b -> b) -> OrderByElement -> OrderByElement
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByElement -> c OrderByElement
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByElement
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OrderByElement -> u
forall u. (forall d. Data d => d -> u) -> OrderByElement -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByElement -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByElement -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByElement
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByElement -> c OrderByElement
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderByElement)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByElement)
$cOrderByElement :: Constr
$tOrderByElement :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
gmapMp :: (forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
gmapM :: (forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrderByElement -> m OrderByElement
gmapQi :: Int -> (forall d. Data d => d -> u) -> OrderByElement -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OrderByElement -> u
gmapQ :: (forall d. Data d => d -> u) -> OrderByElement -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderByElement -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByElement -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByElement -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByElement -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByElement -> r
gmapT :: (forall b. Data b => b -> b) -> OrderByElement -> OrderByElement
$cgmapT :: (forall b. Data b => b -> b) -> OrderByElement -> OrderByElement
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByElement)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByElement)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OrderByElement)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderByElement)
dataTypeOf :: OrderByElement -> DataType
$cdataTypeOf :: OrderByElement -> DataType
toConstr :: OrderByElement -> Constr
$ctoConstr :: OrderByElement -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByElement
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByElement
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByElement -> c OrderByElement
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByElement -> c OrderByElement
$cp1Data :: Typeable OrderByElement
Data, OrderByElement -> OrderByElement -> Bool
(OrderByElement -> OrderByElement -> Bool)
-> (OrderByElement -> OrderByElement -> Bool) -> Eq OrderByElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderByElement -> OrderByElement -> Bool
$c/= :: OrderByElement -> OrderByElement -> Bool
== :: OrderByElement -> OrderByElement -> Bool
$c== :: OrderByElement -> OrderByElement -> Bool
Eq, (forall x. OrderByElement -> Rep OrderByElement x)
-> (forall x. Rep OrderByElement x -> OrderByElement)
-> Generic OrderByElement
forall x. Rep OrderByElement x -> OrderByElement
forall x. OrderByElement -> Rep OrderByElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderByElement x -> OrderByElement
$cfrom :: forall x. OrderByElement -> Rep OrderByElement x
Generic, Eq OrderByElement
Eq OrderByElement
-> (OrderByElement -> OrderByElement -> Ordering)
-> (OrderByElement -> OrderByElement -> Bool)
-> (OrderByElement -> OrderByElement -> Bool)
-> (OrderByElement -> OrderByElement -> Bool)
-> (OrderByElement -> OrderByElement -> Bool)
-> (OrderByElement -> OrderByElement -> OrderByElement)
-> (OrderByElement -> OrderByElement -> OrderByElement)
-> Ord OrderByElement
OrderByElement -> OrderByElement -> Bool
OrderByElement -> OrderByElement -> Ordering
OrderByElement -> OrderByElement -> OrderByElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrderByElement -> OrderByElement -> OrderByElement
$cmin :: OrderByElement -> OrderByElement -> OrderByElement
max :: OrderByElement -> OrderByElement -> OrderByElement
$cmax :: OrderByElement -> OrderByElement -> OrderByElement
>= :: OrderByElement -> OrderByElement -> Bool
$c>= :: OrderByElement -> OrderByElement -> Bool
> :: OrderByElement -> OrderByElement -> Bool
$c> :: OrderByElement -> OrderByElement -> Bool
<= :: OrderByElement -> OrderByElement -> Bool
$c<= :: OrderByElement -> OrderByElement -> Bool
< :: OrderByElement -> OrderByElement -> Bool
$c< :: OrderByElement -> OrderByElement -> Bool
compare :: OrderByElement -> OrderByElement -> Ordering
$ccompare :: OrderByElement -> OrderByElement -> Ordering
$cp1Ord :: Eq OrderByElement
Ord, Int -> OrderByElement -> ShowS
[OrderByElement] -> ShowS
OrderByElement -> String
(Int -> OrderByElement -> ShowS)
-> (OrderByElement -> String)
-> ([OrderByElement] -> ShowS)
-> Show OrderByElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderByElement] -> ShowS
$cshowList :: [OrderByElement] -> ShowS
show :: OrderByElement -> String
$cshow :: OrderByElement -> String
showsPrec :: Int -> OrderByElement -> ShowS
$cshowsPrec :: Int -> OrderByElement -> ShowS
Show)
  deriving anyclass (Eq OrderByElement
Eq OrderByElement
-> (Accesses -> OrderByElement -> OrderByElement -> Bool)
-> Cacheable OrderByElement
Accesses -> OrderByElement -> OrderByElement -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> OrderByElement -> OrderByElement -> Bool
$cunchanged :: Accesses -> OrderByElement -> OrderByElement -> Bool
$cp1Cacheable :: Eq OrderByElement
Cacheable, Int -> OrderByElement -> Int
OrderByElement -> Int
(Int -> OrderByElement -> Int)
-> (OrderByElement -> Int) -> Hashable OrderByElement
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OrderByElement -> Int
$chash :: OrderByElement -> Int
hashWithSalt :: Int -> OrderByElement -> Int
$chashWithSalt :: Int -> OrderByElement -> Int
Hashable, OrderByElement -> ()
(OrderByElement -> ()) -> NFData OrderByElement
forall a. (a -> ()) -> NFData a
rnf :: OrderByElement -> ()
$crnf :: OrderByElement -> ()
NFData)

instance ToJSON OrderByElement where
  toJSON :: OrderByElement -> Value
toJSON = Options -> OrderByElement -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
J.defaultOptions

instance Witch.From OrderByElement API.OrderByElement where
  from :: OrderByElement -> OrderByElement
from OrderByElement {[RelationshipName]
OrderDirection
OrderByTarget
_obeOrderDirection :: OrderDirection
_obeTarget :: OrderByTarget
_obeTargetPath :: [RelationshipName]
_obeOrderDirection :: OrderByElement -> OrderDirection
_obeTarget :: OrderByElement -> OrderByTarget
_obeTargetPath :: OrderByElement -> [RelationshipName]
..} =
    OrderByElement :: [RelationshipName]
-> OrderByTarget -> OrderDirection -> OrderByElement
API.OrderByElement
      { _obeTargetPath :: [RelationshipName]
_obeTargetPath = RelationshipName -> RelationshipName
forall source target. From source target => source -> target
Witch.from (RelationshipName -> RelationshipName)
-> [RelationshipName] -> [RelationshipName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RelationshipName]
_obeTargetPath,
        _obeTarget :: OrderByTarget
_obeTarget = OrderByTarget -> OrderByTarget
forall source target. From source target => source -> target
Witch.from OrderByTarget
_obeTarget,
        _obeOrderDirection :: OrderDirection
_obeOrderDirection = OrderDirection -> OrderDirection
forall source target. From source target => source -> target
Witch.from OrderDirection
_obeOrderDirection
      }

data OrderByTarget
  = OrderByColumn IR.C.Name
  | OrderByStarCountAggregate
  | OrderBySingleColumnAggregate IR.A.SingleColumnAggregate
  deriving stock (Typeable OrderByTarget
DataType
Constr
Typeable OrderByTarget
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OrderByTarget -> c OrderByTarget)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OrderByTarget)
-> (OrderByTarget -> Constr)
-> (OrderByTarget -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OrderByTarget))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OrderByTarget))
-> ((forall b. Data b => b -> b) -> OrderByTarget -> OrderByTarget)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r)
-> (forall u. (forall d. Data d => d -> u) -> OrderByTarget -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OrderByTarget -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget)
-> Data OrderByTarget
OrderByTarget -> DataType
OrderByTarget -> Constr
(forall b. Data b => b -> b) -> OrderByTarget -> OrderByTarget
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByTarget -> c OrderByTarget
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByTarget
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrderByTarget -> u
forall u. (forall d. Data d => d -> u) -> OrderByTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByTarget -> c OrderByTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderByTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByTarget)
$cOrderBySingleColumnAggregate :: Constr
$cOrderByStarCountAggregate :: Constr
$cOrderByColumn :: Constr
$tOrderByTarget :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
gmapMp :: (forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
gmapM :: (forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderByTarget -> m OrderByTarget
gmapQi :: Int -> (forall d. Data d => d -> u) -> OrderByTarget -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrderByTarget -> u
gmapQ :: (forall d. Data d => d -> u) -> OrderByTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderByTarget -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderByTarget -> r
gmapT :: (forall b. Data b => b -> b) -> OrderByTarget -> OrderByTarget
$cgmapT :: (forall b. Data b => b -> b) -> OrderByTarget -> OrderByTarget
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderByTarget)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OrderByTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderByTarget)
dataTypeOf :: OrderByTarget -> DataType
$cdataTypeOf :: OrderByTarget -> DataType
toConstr :: OrderByTarget -> Constr
$ctoConstr :: OrderByTarget -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderByTarget
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByTarget -> c OrderByTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderByTarget -> c OrderByTarget
$cp1Data :: Typeable OrderByTarget
Data, OrderByTarget -> OrderByTarget -> Bool
(OrderByTarget -> OrderByTarget -> Bool)
-> (OrderByTarget -> OrderByTarget -> Bool) -> Eq OrderByTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderByTarget -> OrderByTarget -> Bool
$c/= :: OrderByTarget -> OrderByTarget -> Bool
== :: OrderByTarget -> OrderByTarget -> Bool
$c== :: OrderByTarget -> OrderByTarget -> Bool
Eq, (forall x. OrderByTarget -> Rep OrderByTarget x)
-> (forall x. Rep OrderByTarget x -> OrderByTarget)
-> Generic OrderByTarget
forall x. Rep OrderByTarget x -> OrderByTarget
forall x. OrderByTarget -> Rep OrderByTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderByTarget x -> OrderByTarget
$cfrom :: forall x. OrderByTarget -> Rep OrderByTarget x
Generic, Eq OrderByTarget
Eq OrderByTarget
-> (OrderByTarget -> OrderByTarget -> Ordering)
-> (OrderByTarget -> OrderByTarget -> Bool)
-> (OrderByTarget -> OrderByTarget -> Bool)
-> (OrderByTarget -> OrderByTarget -> Bool)
-> (OrderByTarget -> OrderByTarget -> Bool)
-> (OrderByTarget -> OrderByTarget -> OrderByTarget)
-> (OrderByTarget -> OrderByTarget -> OrderByTarget)
-> Ord OrderByTarget
OrderByTarget -> OrderByTarget -> Bool
OrderByTarget -> OrderByTarget -> Ordering
OrderByTarget -> OrderByTarget -> OrderByTarget
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrderByTarget -> OrderByTarget -> OrderByTarget
$cmin :: OrderByTarget -> OrderByTarget -> OrderByTarget
max :: OrderByTarget -> OrderByTarget -> OrderByTarget
$cmax :: OrderByTarget -> OrderByTarget -> OrderByTarget
>= :: OrderByTarget -> OrderByTarget -> Bool
$c>= :: OrderByTarget -> OrderByTarget -> Bool
> :: OrderByTarget -> OrderByTarget -> Bool
$c> :: OrderByTarget -> OrderByTarget -> Bool
<= :: OrderByTarget -> OrderByTarget -> Bool
$c<= :: OrderByTarget -> OrderByTarget -> Bool
< :: OrderByTarget -> OrderByTarget -> Bool
$c< :: OrderByTarget -> OrderByTarget -> Bool
compare :: OrderByTarget -> OrderByTarget -> Ordering
$ccompare :: OrderByTarget -> OrderByTarget -> Ordering
$cp1Ord :: Eq OrderByTarget
Ord, Int -> OrderByTarget -> ShowS
[OrderByTarget] -> ShowS
OrderByTarget -> String
(Int -> OrderByTarget -> ShowS)
-> (OrderByTarget -> String)
-> ([OrderByTarget] -> ShowS)
-> Show OrderByTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderByTarget] -> ShowS
$cshowList :: [OrderByTarget] -> ShowS
show :: OrderByTarget -> String
$cshow :: OrderByTarget -> String
showsPrec :: Int -> OrderByTarget -> ShowS
$cshowsPrec :: Int -> OrderByTarget -> ShowS
Show)
  deriving anyclass (Eq OrderByTarget
Eq OrderByTarget
-> (Accesses -> OrderByTarget -> OrderByTarget -> Bool)
-> Cacheable OrderByTarget
Accesses -> OrderByTarget -> OrderByTarget -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> OrderByTarget -> OrderByTarget -> Bool
$cunchanged :: Accesses -> OrderByTarget -> OrderByTarget -> Bool
$cp1Cacheable :: Eq OrderByTarget
Cacheable, Int -> OrderByTarget -> Int
OrderByTarget -> Int
(Int -> OrderByTarget -> Int)
-> (OrderByTarget -> Int) -> Hashable OrderByTarget
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OrderByTarget -> Int
$chash :: OrderByTarget -> Int
hashWithSalt :: Int -> OrderByTarget -> Int
$chashWithSalt :: Int -> OrderByTarget -> Int
Hashable, OrderByTarget -> ()
(OrderByTarget -> ()) -> NFData OrderByTarget
forall a. (a -> ()) -> NFData a
rnf :: OrderByTarget -> ()
$crnf :: OrderByTarget -> ()
NFData)

instance ToJSON OrderByTarget where
  toJSON :: OrderByTarget -> Value
toJSON = Options -> OrderByTarget -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
J.defaultOptions

instance Witch.From OrderByTarget API.OrderByTarget where
  from :: OrderByTarget -> OrderByTarget
from = \case
    OrderByColumn Name
name -> ColumnName -> OrderByTarget
API.OrderByColumn (ColumnName -> OrderByTarget) -> ColumnName -> OrderByTarget
forall a b. (a -> b) -> a -> b
$ Name -> ColumnName
forall source target. From source target => source -> target
Witch.from Name
name
    OrderByTarget
OrderByStarCountAggregate -> OrderByTarget
API.OrderByStarCountAggregate
    OrderBySingleColumnAggregate SingleColumnAggregate
aggregate -> SingleColumnAggregate -> OrderByTarget
API.OrderBySingleColumnAggregate (SingleColumnAggregate -> OrderByTarget)
-> SingleColumnAggregate -> OrderByTarget
forall a b. (a -> b) -> a -> b
$ SingleColumnAggregate -> SingleColumnAggregate
forall source target. From source target => source -> target
Witch.from SingleColumnAggregate
aggregate

data OrderDirection
  = Ascending
  | Descending
  deriving stock (Typeable OrderDirection
DataType
Constr
Typeable OrderDirection
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OrderDirection -> c OrderDirection)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OrderDirection)
-> (OrderDirection -> Constr)
-> (OrderDirection -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OrderDirection))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OrderDirection))
-> ((forall b. Data b => b -> b)
    -> OrderDirection -> OrderDirection)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderDirection -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderDirection -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OrderDirection -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OrderDirection -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OrderDirection -> m OrderDirection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OrderDirection -> m OrderDirection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OrderDirection -> m OrderDirection)
-> Data OrderDirection
OrderDirection -> DataType
OrderDirection -> Constr
(forall b. Data b => b -> b) -> OrderDirection -> OrderDirection
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderDirection -> c OrderDirection
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderDirection
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OrderDirection -> u
forall u. (forall d. Data d => d -> u) -> OrderDirection -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderDirection -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderDirection -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderDirection
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderDirection -> c OrderDirection
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderDirection)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderDirection)
$cDescending :: Constr
$cAscending :: Constr
$tOrderDirection :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
gmapMp :: (forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
gmapM :: (forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrderDirection -> m OrderDirection
gmapQi :: Int -> (forall d. Data d => d -> u) -> OrderDirection -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OrderDirection -> u
gmapQ :: (forall d. Data d => d -> u) -> OrderDirection -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderDirection -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderDirection -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderDirection -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderDirection -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderDirection -> r
gmapT :: (forall b. Data b => b -> b) -> OrderDirection -> OrderDirection
$cgmapT :: (forall b. Data b => b -> b) -> OrderDirection -> OrderDirection
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderDirection)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderDirection)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OrderDirection)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderDirection)
dataTypeOf :: OrderDirection -> DataType
$cdataTypeOf :: OrderDirection -> DataType
toConstr :: OrderDirection -> Constr
$ctoConstr :: OrderDirection -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderDirection
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderDirection
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderDirection -> c OrderDirection
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderDirection -> c OrderDirection
$cp1Data :: Typeable OrderDirection
Data, OrderDirection -> OrderDirection -> Bool
(OrderDirection -> OrderDirection -> Bool)
-> (OrderDirection -> OrderDirection -> Bool) -> Eq OrderDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderDirection -> OrderDirection -> Bool
$c/= :: OrderDirection -> OrderDirection -> Bool
== :: OrderDirection -> OrderDirection -> Bool
$c== :: OrderDirection -> OrderDirection -> Bool
Eq, (forall x. OrderDirection -> Rep OrderDirection x)
-> (forall x. Rep OrderDirection x -> OrderDirection)
-> Generic OrderDirection
forall x. Rep OrderDirection x -> OrderDirection
forall x. OrderDirection -> Rep OrderDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderDirection x -> OrderDirection
$cfrom :: forall x. OrderDirection -> Rep OrderDirection x
Generic, Eq OrderDirection
Eq OrderDirection
-> (OrderDirection -> OrderDirection -> Ordering)
-> (OrderDirection -> OrderDirection -> Bool)
-> (OrderDirection -> OrderDirection -> Bool)
-> (OrderDirection -> OrderDirection -> Bool)
-> (OrderDirection -> OrderDirection -> Bool)
-> (OrderDirection -> OrderDirection -> OrderDirection)
-> (OrderDirection -> OrderDirection -> OrderDirection)
-> Ord OrderDirection
OrderDirection -> OrderDirection -> Bool
OrderDirection -> OrderDirection -> Ordering
OrderDirection -> OrderDirection -> OrderDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrderDirection -> OrderDirection -> OrderDirection
$cmin :: OrderDirection -> OrderDirection -> OrderDirection
max :: OrderDirection -> OrderDirection -> OrderDirection
$cmax :: OrderDirection -> OrderDirection -> OrderDirection
>= :: OrderDirection -> OrderDirection -> Bool
$c>= :: OrderDirection -> OrderDirection -> Bool
> :: OrderDirection -> OrderDirection -> Bool
$c> :: OrderDirection -> OrderDirection -> Bool
<= :: OrderDirection -> OrderDirection -> Bool
$c<= :: OrderDirection -> OrderDirection -> Bool
< :: OrderDirection -> OrderDirection -> Bool
$c< :: OrderDirection -> OrderDirection -> Bool
compare :: OrderDirection -> OrderDirection -> Ordering
$ccompare :: OrderDirection -> OrderDirection -> Ordering
$cp1Ord :: Eq OrderDirection
Ord, Int -> OrderDirection -> ShowS
[OrderDirection] -> ShowS
OrderDirection -> String
(Int -> OrderDirection -> ShowS)
-> (OrderDirection -> String)
-> ([OrderDirection] -> ShowS)
-> Show OrderDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderDirection] -> ShowS
$cshowList :: [OrderDirection] -> ShowS
show :: OrderDirection -> String
$cshow :: OrderDirection -> String
showsPrec :: Int -> OrderDirection -> ShowS
$cshowsPrec :: Int -> OrderDirection -> ShowS
Show)
  deriving anyclass (Eq OrderDirection
Eq OrderDirection
-> (Accesses -> OrderDirection -> OrderDirection -> Bool)
-> Cacheable OrderDirection
Accesses -> OrderDirection -> OrderDirection -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> OrderDirection -> OrderDirection -> Bool
$cunchanged :: Accesses -> OrderDirection -> OrderDirection -> Bool
$cp1Cacheable :: Eq OrderDirection
Cacheable, Int -> OrderDirection -> Int
OrderDirection -> Int
(Int -> OrderDirection -> Int)
-> (OrderDirection -> Int) -> Hashable OrderDirection
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OrderDirection -> Int
$chash :: OrderDirection -> Int
hashWithSalt :: Int -> OrderDirection -> Int
$chashWithSalt :: Int -> OrderDirection -> Int
Hashable, OrderDirection -> ()
(OrderDirection -> ()) -> NFData OrderDirection
forall a. (a -> ()) -> NFData a
rnf :: OrderDirection -> ()
$crnf :: OrderDirection -> ()
NFData)

instance ToJSON OrderDirection where
  toJSON :: OrderDirection -> Value
toJSON = Options -> OrderDirection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
J.defaultOptions

instance Witch.From API.OrderDirection OrderDirection where
  from :: OrderDirection -> OrderDirection
from OrderDirection
API.Ascending = OrderDirection
Ascending
  from OrderDirection
API.Descending = OrderDirection
Descending

instance Witch.From OrderDirection API.OrderDirection where
  from :: OrderDirection -> OrderDirection
from OrderDirection
Ascending = OrderDirection
API.Ascending
  from OrderDirection
Descending = OrderDirection
API.Descending