{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Sort where

import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Query

-- | 'SortMode' prescribes how to handle sorting array/multi-valued fields.
--
-- http://www.elastic.co/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
data SortMode
  = SortMin
  | SortMax
  | SortSum
  | SortAvg
  deriving stock (SortMode -> SortMode -> Bool
(SortMode -> SortMode -> Bool)
-> (SortMode -> SortMode -> Bool) -> Eq SortMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortMode -> SortMode -> Bool
== :: SortMode -> SortMode -> Bool
$c/= :: SortMode -> SortMode -> Bool
/= :: SortMode -> SortMode -> Bool
Eq, Int -> SortMode -> ShowS
[SortMode] -> ShowS
SortMode -> String
(Int -> SortMode -> ShowS)
-> (SortMode -> String) -> ([SortMode] -> ShowS) -> Show SortMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortMode -> ShowS
showsPrec :: Int -> SortMode -> ShowS
$cshow :: SortMode -> String
show :: SortMode -> String
$cshowList :: [SortMode] -> ShowS
showList :: [SortMode] -> ShowS
Show)

instance ToJSON SortMode where
  toJSON :: SortMode -> Value
toJSON SortMode
SortMin = Text -> Value
String Text
"min"
  toJSON SortMode
SortMax = Text -> Value
String Text
"max"
  toJSON SortMode
SortSum = Text -> Value
String Text
"sum"
  toJSON SortMode
SortAvg = Text -> Value
String Text
"avg"

-- | 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
--   that you can concisely describe the usual kind of 'SortSpec's you want.
mkSort :: FieldName -> SortOrder -> DefaultSort
mkSort :: FieldName -> SortOrder -> DefaultSort
mkSort FieldName
fieldName SortOrder
sOrder = FieldName
-> SortOrder
-> Maybe Text
-> Maybe SortMode
-> Maybe Missing
-> Maybe Filter
-> DefaultSort
DefaultSort FieldName
fieldName SortOrder
sOrder Maybe Text
forall a. Maybe a
Nothing Maybe SortMode
forall a. Maybe a
Nothing Maybe Missing
forall a. Maybe a
Nothing Maybe Filter
forall a. Maybe a
Nothing

-- | 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
--   dependent with later sorts acting as tie-breakers for earlier sorts.
type Sort = [SortSpec]

-- | The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
--   'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
--   'DistanceUnit' to express "nearness" to a single geographical point as a
--   sort specification.
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
data SortSpec
  = DefaultSortSpec DefaultSort
  | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit
  deriving stock (SortSpec -> SortSpec -> Bool
(SortSpec -> SortSpec -> Bool)
-> (SortSpec -> SortSpec -> Bool) -> Eq SortSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortSpec -> SortSpec -> Bool
== :: SortSpec -> SortSpec -> Bool
$c/= :: SortSpec -> SortSpec -> Bool
/= :: SortSpec -> SortSpec -> Bool
Eq, Int -> SortSpec -> ShowS
[SortSpec] -> ShowS
SortSpec -> String
(Int -> SortSpec -> ShowS)
-> (SortSpec -> String) -> ([SortSpec] -> ShowS) -> Show SortSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortSpec -> ShowS
showsPrec :: Int -> SortSpec -> ShowS
$cshow :: SortSpec -> String
show :: SortSpec -> String
$cshowList :: [SortSpec] -> ShowS
showList :: [SortSpec] -> ShowS
Show)

instance ToJSON SortSpec where
  toJSON :: SortSpec -> Value
toJSON
    ( DefaultSortSpec
        ( DefaultSort
            (FieldName Text
dsSortFieldName)
            SortOrder
dsSortOrder
            Maybe Text
dsIgnoreUnmapped
            Maybe SortMode
dsSortMode
            Maybe Missing
dsMissingSort
            Maybe Filter
dsNestedFilter
          )
      ) =
      [Pair] -> Value
object [Text -> Key
fromText Text
dsSortFieldName Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
omitNulls [Pair]
base]
      where
        base :: [Pair]
base =
          [ Key
"order" Key -> SortOrder -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SortOrder
dsSortOrder,
            Key
"unmapped_type" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
dsIgnoreUnmapped,
            Key
"mode" Key -> Maybe SortMode -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe SortMode
dsSortMode,
            Key
"missing" Key -> Maybe Missing -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Missing
dsMissingSort,
            Key
"nested_filter" Key -> Maybe Filter -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Filter
dsNestedFilter
          ]
  toJSON (GeoDistanceSortSpec SortOrder
gdsSortOrder (GeoPoint (FieldName Text
field) LatLon
gdsLatLon) DistanceUnit
units) =
    [Pair] -> Value
object
      [ Key
"unit" Key -> DistanceUnit -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DistanceUnit
units,
        Text -> Key
fromText Text
field Key -> LatLon -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LatLon
gdsLatLon,
        Key
"order" Key -> SortOrder -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SortOrder
gdsSortOrder
      ]

-- | 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
--   'mkSort' convenience function for when you want to specify only the most
--   common parameters.
--
--   The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
data DefaultSort = DefaultSort
  { DefaultSort -> FieldName
sortFieldName :: FieldName,
    DefaultSort -> SortOrder
sortOrder :: SortOrder,
    -- default False
    DefaultSort -> Maybe Text
ignoreUnmapped :: Maybe Text,
    DefaultSort -> Maybe SortMode
sortMode :: Maybe SortMode,
    DefaultSort -> Maybe Missing
missingSort :: Maybe Missing,
    DefaultSort -> Maybe Filter
nestedFilter :: Maybe Filter
  }
  deriving stock (DefaultSort -> DefaultSort -> Bool
(DefaultSort -> DefaultSort -> Bool)
-> (DefaultSort -> DefaultSort -> Bool) -> Eq DefaultSort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultSort -> DefaultSort -> Bool
== :: DefaultSort -> DefaultSort -> Bool
$c/= :: DefaultSort -> DefaultSort -> Bool
/= :: DefaultSort -> DefaultSort -> Bool
Eq, Int -> DefaultSort -> ShowS
[DefaultSort] -> ShowS
DefaultSort -> String
(Int -> DefaultSort -> ShowS)
-> (DefaultSort -> String)
-> ([DefaultSort] -> ShowS)
-> Show DefaultSort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultSort -> ShowS
showsPrec :: Int -> DefaultSort -> ShowS
$cshow :: DefaultSort -> String
show :: DefaultSort -> String
$cshowList :: [DefaultSort] -> ShowS
showList :: [DefaultSort] -> ShowS
Show)

sortFieldNameLens :: Lens' DefaultSort FieldName
sortFieldNameLens :: Lens' DefaultSort FieldName
sortFieldNameLens = (DefaultSort -> FieldName)
-> (DefaultSort -> FieldName -> DefaultSort)
-> Lens' DefaultSort FieldName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DefaultSort -> FieldName
sortFieldName (\DefaultSort
x FieldName
y -> DefaultSort
x {sortFieldName = y})

sortOrderLens :: Lens' DefaultSort SortOrder
sortOrderLens :: Lens' DefaultSort SortOrder
sortOrderLens = (DefaultSort -> SortOrder)
-> (DefaultSort -> SortOrder -> DefaultSort)
-> Lens' DefaultSort SortOrder
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DefaultSort -> SortOrder
sortOrder (\DefaultSort
x SortOrder
y -> DefaultSort
x {sortOrder = y})

ignoreUnmappedLens :: Lens' DefaultSort (Maybe Text)
ignoreUnmappedLens :: Lens' DefaultSort (Maybe Text)
ignoreUnmappedLens = (DefaultSort -> Maybe Text)
-> (DefaultSort -> Maybe Text -> DefaultSort)
-> Lens' DefaultSort (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DefaultSort -> Maybe Text
ignoreUnmapped (\DefaultSort
x Maybe Text
y -> DefaultSort
x {ignoreUnmapped = y})

sortModeLens :: Lens' DefaultSort (Maybe SortMode)
sortModeLens :: Lens' DefaultSort (Maybe SortMode)
sortModeLens = (DefaultSort -> Maybe SortMode)
-> (DefaultSort -> Maybe SortMode -> DefaultSort)
-> Lens' DefaultSort (Maybe SortMode)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DefaultSort -> Maybe SortMode
sortMode (\DefaultSort
x Maybe SortMode
y -> DefaultSort
x {sortMode = y})

missingSortLens :: Lens' DefaultSort (Maybe Missing)
missingSortLens :: Lens' DefaultSort (Maybe Missing)
missingSortLens = (DefaultSort -> Maybe Missing)
-> (DefaultSort -> Maybe Missing -> DefaultSort)
-> Lens' DefaultSort (Maybe Missing)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DefaultSort -> Maybe Missing
missingSort (\DefaultSort
x Maybe Missing
y -> DefaultSort
x {missingSort = y})

nestedFilterLens :: Lens' DefaultSort (Maybe Filter)
nestedFilterLens :: Lens' DefaultSort (Maybe Filter)
nestedFilterLens = (DefaultSort -> Maybe Filter)
-> (DefaultSort -> Maybe Filter -> DefaultSort)
-> Lens' DefaultSort (Maybe Filter)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DefaultSort -> Maybe Filter
nestedFilter (\DefaultSort
x Maybe Filter
y -> DefaultSort
x {nestedFilter = y})

-- | 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
--   encoded into "asc" or "desc" when turned into JSON.
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
data SortOrder
  = Ascending
  | Descending
  deriving stock (SortOrder -> SortOrder -> Bool
(SortOrder -> SortOrder -> Bool)
-> (SortOrder -> SortOrder -> Bool) -> Eq SortOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortOrder -> SortOrder -> Bool
== :: SortOrder -> SortOrder -> Bool
$c/= :: SortOrder -> SortOrder -> Bool
/= :: SortOrder -> SortOrder -> Bool
Eq, Int -> SortOrder -> ShowS
[SortOrder] -> ShowS
SortOrder -> String
(Int -> SortOrder -> ShowS)
-> (SortOrder -> String)
-> ([SortOrder] -> ShowS)
-> Show SortOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortOrder -> ShowS
showsPrec :: Int -> SortOrder -> ShowS
$cshow :: SortOrder -> String
show :: SortOrder -> String
$cshowList :: [SortOrder] -> ShowS
showList :: [SortOrder] -> ShowS
Show)

instance ToJSON SortOrder where
  toJSON :: SortOrder -> Value
toJSON SortOrder
Ascending = Text -> Value
String Text
"asc"
  toJSON SortOrder
Descending = Text -> Value
String Text
"desc"

-- | 'Missing' prescribes how to handle missing fields. A missing field can be
--   sorted last, first, or using a custom value as a substitute.
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
data Missing
  = LastMissing
  | FirstMissing
  | CustomMissing Text
  deriving stock (Missing -> Missing -> Bool
(Missing -> Missing -> Bool)
-> (Missing -> Missing -> Bool) -> Eq Missing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Missing -> Missing -> Bool
== :: Missing -> Missing -> Bool
$c/= :: Missing -> Missing -> Bool
/= :: Missing -> Missing -> Bool
Eq, Int -> Missing -> ShowS
[Missing] -> ShowS
Missing -> String
(Int -> Missing -> ShowS)
-> (Missing -> String) -> ([Missing] -> ShowS) -> Show Missing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Missing -> ShowS
showsPrec :: Int -> Missing -> ShowS
$cshow :: Missing -> String
show :: Missing -> String
$cshowList :: [Missing] -> ShowS
showList :: [Missing] -> ShowS
Show)

instance ToJSON Missing where
  toJSON :: Missing -> Value
toJSON Missing
LastMissing = Text -> Value
String Text
"_last"
  toJSON Missing
FirstMissing = Text -> Value
String Text
"_first"
  toJSON (CustomMissing Text
txt) = Text -> Value
String Text
txt