mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-21 06:21:39 +03:00
ef0ca7dea2
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5478 GitOrigin-RevId: 269d33d48f7d41efc7ab4ac6efd9442c6741d08c
114 lines
4.7 KiB
Haskell
114 lines
4.7 KiB
Haskell
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE OverloadedLists #-}
|
|
|
|
module Hasura.Backends.DataConnector.API.V0.OrderBy
|
|
( OrderBy (..),
|
|
OrderByRelation (..),
|
|
OrderByElement (..),
|
|
OrderByTarget (..),
|
|
OrderDirection (..),
|
|
)
|
|
where
|
|
|
|
import Autodocodec
|
|
import Autodocodec.OpenAPI ()
|
|
import Control.DeepSeq (NFData)
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import Data.Data (Data)
|
|
import Data.HashMap.Strict (HashMap)
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
import Data.Hashable (Hashable)
|
|
import Data.List.NonEmpty (NonEmpty)
|
|
import Data.OpenApi (ToSchema)
|
|
import GHC.Generics (Generic)
|
|
import Hasura.Backends.DataConnector.API.V0.Aggregate qualified as API.V0
|
|
import Hasura.Backends.DataConnector.API.V0.Column qualified as API.V0
|
|
import Hasura.Backends.DataConnector.API.V0.Expression qualified as API.V0
|
|
import Hasura.Backends.DataConnector.API.V0.Relationships qualified as API.V0
|
|
import Prelude
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data OrderBy = OrderBy
|
|
{ _obRelations :: HashMap API.V0.RelationshipName OrderByRelation,
|
|
_obElements :: NonEmpty OrderByElement
|
|
}
|
|
deriving stock (Data, Eq, Generic, Ord, Show)
|
|
deriving (FromJSON, ToJSON, ToSchema) via Autodocodec OrderBy
|
|
|
|
instance HasCodec OrderBy where
|
|
codec =
|
|
object "OrderBy" $
|
|
OrderBy
|
|
<$> requiredField "relations" "A map of relationships from the current query table to target tables. The key of the map is the relationship name. The relationships are used within the order by elements." .= _obRelations
|
|
<*> requiredField "elements" "The elements to order by, in priority order" .= _obElements
|
|
|
|
data OrderByRelation = OrderByRelation
|
|
{ _obrWhere :: Maybe API.V0.Expression,
|
|
_obrSubrelations :: HashMap API.V0.RelationshipName OrderByRelation
|
|
}
|
|
deriving stock (Data, Eq, Generic, Ord, Show)
|
|
deriving anyclass (Hashable, NFData)
|
|
deriving (FromJSON, ToJSON, ToSchema) via Autodocodec OrderByRelation
|
|
|
|
instance HasCodec OrderByRelation where
|
|
codec =
|
|
named "OrderByRelation" $
|
|
object "OrderByRelation" $
|
|
OrderByRelation
|
|
<$> optionalFieldOrNull "where" "An expression to apply to the relationship's target table to filter it" .= _obrWhere
|
|
<*> requiredField "subrelations" "Further relationships to follow from the relationship's target table. The key of the map is the relationship name." .= _obrSubrelations
|
|
|
|
data OrderByElement = OrderByElement
|
|
{ _obeTargetPath :: [API.V0.RelationshipName],
|
|
_obeTarget :: OrderByTarget,
|
|
_obeOrderDirection :: OrderDirection
|
|
}
|
|
deriving stock (Data, Eq, Generic, Ord, Show)
|
|
deriving (FromJSON, ToJSON, ToSchema) via Autodocodec OrderByElement
|
|
|
|
instance HasCodec OrderByElement where
|
|
codec =
|
|
object "OrderByElement" $
|
|
OrderByElement
|
|
<$> requiredField "target_path" "The relationship path from the current query table to the table that contains the target to order by. This is always non-empty for aggregate order by targets" .= _obeTargetPath
|
|
<*> requiredField "target" "The target column or aggregate to order by" .= _obeTarget
|
|
<*> requiredField "order_direction" "The direction of ordering to apply" .= _obeOrderDirection
|
|
|
|
data OrderByTarget
|
|
= OrderByColumn API.V0.ColumnName
|
|
| OrderByStarCountAggregate
|
|
| OrderBySingleColumnAggregate API.V0.SingleColumnAggregate
|
|
deriving stock (Data, Eq, Generic, Ord, Show)
|
|
deriving (FromJSON, ToJSON, ToSchema) via Autodocodec OrderByTarget
|
|
|
|
instance HasCodec OrderByTarget where
|
|
codec =
|
|
object "OrderByTarget" $
|
|
discriminatedUnionCodec "type" enc dec
|
|
where
|
|
columnCodec = requiredField' "column"
|
|
starAggregateCodec = pureCodec ()
|
|
singleColumnAggregateCodec = API.V0.singleColumnAggregateObjectCodec
|
|
enc = \case
|
|
OrderByColumn c -> ("column", mapToEncoder c columnCodec)
|
|
OrderByStarCountAggregate -> ("star_count_aggregate", mapToEncoder () starAggregateCodec)
|
|
OrderBySingleColumnAggregate agg -> ("single_column_aggregate", mapToEncoder agg singleColumnAggregateCodec)
|
|
dec =
|
|
HashMap.fromList
|
|
[ ("column", ("OrderByColumn", mapToDecoder OrderByColumn columnCodec)),
|
|
("star_count_aggregate", ("OrderByStarCountAggregate", mapToDecoder (const OrderByStarCountAggregate) starAggregateCodec)),
|
|
("single_column_aggregate", ("OrderBySingleColumnAggregate", mapToDecoder OrderBySingleColumnAggregate singleColumnAggregateCodec))
|
|
]
|
|
|
|
data OrderDirection
|
|
= Ascending
|
|
| Descending
|
|
deriving stock (Data, Eq, Generic, Ord, Show, Enum, Bounded)
|
|
deriving (FromJSON, ToJSON, ToSchema) via Autodocodec OrderDirection
|
|
|
|
instance HasCodec OrderDirection where
|
|
codec =
|
|
named "OrderDirection" $
|
|
stringConstCodec [(Ascending, "asc"), (Descending, "desc")]
|