{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Query
  ( module X,
    BoolMatch (..),
    BoolQuery (..),
    BoostingQuery (..),
    Cache,
    ComponentFunctionScoreFunction (..),
    DisMaxQuery (..),
    Distance (..),
    DistanceRange (..),
    DistanceType (..),
    DistanceUnit (..),
    Filter (..),
    FunctionScoreFunctions (..),
    FunctionScoreQuery (..),
    GeoBoundingBox (..),
    GeoBoundingBoxConstraint (..),
    GeoFilterType (..),
    GeoPoint (..),
    HasChildQuery (..),
    HasParentQuery (..),
    IndicesQuery (..),
    InnerHits (..),
    LatLon (..),
    NestedQuery (..),
    OptimizeBbox (..),
    Query (..),
    RangeExecution (..),
    ScoreType (..),
    TemplateQueryKeyValuePairs (..),
    TemplateQueryValue,
    Term (..),
    defaultCache,
    functionScoreFunctionsPair,
    mkBoolQuery,
    showDistanceUnit,
  )
where

import qualified Data.Aeson.KeyMap as X
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Query.CommonTerms as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Commons as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Fuzzy as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Match as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.MoreLikeThis as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.MoreLikeThisField as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Prefix as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.QueryString as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Range as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Regexp as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.SimpleQueryString as X
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Wildcard as X
import Database.Bloodhound.Internal.Versions.Common.Types.Script as X
import GHC.Generics

data Query
  = TermQuery Term (Maybe Boost)
  | TermsQuery Key (NonEmpty Text)
  | QueryMatchQuery MatchQuery
  | QueryMultiMatchQuery MultiMatchQuery
  | QueryBoolQuery BoolQuery
  | QueryBoostingQuery BoostingQuery
  | QueryCommonTermsQuery CommonTermsQuery
  | ConstantScoreQuery Query Boost
  | QueryFunctionScoreQuery FunctionScoreQuery
  | QueryDisMaxQuery DisMaxQuery
  | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
  | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
  | QueryFuzzyQuery FuzzyQuery
  | QueryHasChildQuery HasChildQuery
  | QueryHasParentQuery HasParentQuery
  | IdsQuery [DocId]
  | QueryIndicesQuery IndicesQuery
  | MatchAllQuery (Maybe Boost)
  | QueryMoreLikeThisQuery MoreLikeThisQuery
  | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
  | QueryNestedQuery NestedQuery
  | QueryPrefixQuery PrefixQuery
  | QueryQueryStringQuery QueryStringQuery
  | QuerySimpleQueryStringQuery SimpleQueryStringQuery
  | QueryRangeQuery RangeQuery
  | QueryRegexpQuery RegexpQuery
  | QueryExistsQuery FieldName
  | QueryMatchNoneQuery
  | QueryWildcardQuery WildcardQuery
  deriving stock (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Eq, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show, (forall x. Query -> Rep Query x)
-> (forall x. Rep Query x -> Query) -> Generic Query
forall x. Rep Query x -> Query
forall x. Query -> Rep Query x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Query -> Rep Query x
from :: forall x. Query -> Rep Query x
$cto :: forall x. Rep Query x -> Query
to :: forall x. Rep Query x -> Query
Generic)

instance ToJSON Query where
  toJSON :: Query -> Value
toJSON (TermQuery (Term Key
termQueryField Text
termQueryValue) Maybe Boost
boost) =
    [Pair] -> Value
object
      [ Key
"term"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
termQueryField Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
merged]
      ]
    where
      base :: [Pair]
base = [Key
"value" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
termQueryValue]
      boosted :: [Pair]
boosted = [Pair] -> (Boost -> [Pair]) -> Maybe Boost -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Pair -> [Pair]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair -> [Pair]) -> (Boost -> Pair) -> Boost -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"boost" Key -> Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)) Maybe Boost
boost
      merged :: [Pair]
merged = [Pair] -> [Pair] -> [Pair]
forall a. Monoid a => a -> a -> a
mappend [Pair]
base [Pair]
boosted
  toJSON (TermsQuery Key
fieldName NonEmpty Text
terms) =
    [Pair] -> Value
object [Key
"terms" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
conjoined]
    where
      conjoined :: [Pair]
conjoined = [Key
fieldName Key -> NonEmpty Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty Text
terms]
  toJSON (IdsQuery [DocId]
docIds) =
    [Pair] -> Value
object [Key
"ids" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
conjoined]
    where
      conjoined :: [Pair]
conjoined = [Key
"values" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DocId -> Value) -> [DocId] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocId -> Value
forall a. ToJSON a => a -> Value
toJSON [DocId]
docIds]
  toJSON (QueryQueryStringQuery QueryStringQuery
qQueryStringQuery) =
    [Pair] -> Value
object [Key
"query_string" Key -> QueryStringQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= QueryStringQuery
qQueryStringQuery]
  toJSON (QueryMatchQuery MatchQuery
matchQuery) =
    [Pair] -> Value
object [Key
"match" Key -> MatchQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MatchQuery
matchQuery]
  toJSON (QueryMultiMatchQuery MultiMatchQuery
multiMatchQuery) =
    MultiMatchQuery -> Value
forall a. ToJSON a => a -> Value
toJSON MultiMatchQuery
multiMatchQuery
  toJSON (QueryBoolQuery BoolQuery
boolQuery) =
    [Pair] -> Value
object [Key
"bool" Key -> BoolQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BoolQuery
boolQuery]
  toJSON (QueryBoostingQuery BoostingQuery
boostingQuery) =
    [Pair] -> Value
object [Key
"boosting" Key -> BoostingQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BoostingQuery
boostingQuery]
  toJSON (QueryCommonTermsQuery CommonTermsQuery
commonTermsQuery) =
    [Pair] -> Value
object [Key
"common" Key -> CommonTermsQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CommonTermsQuery
commonTermsQuery]
  toJSON (ConstantScoreQuery Query
query Boost
boost) =
    [Pair] -> Value
object
      [ Key
"constant_score"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [ Key
"filter" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
query,
              Key
"boost" Key -> Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Boost
boost
            ]
      ]
  toJSON (QueryFunctionScoreQuery FunctionScoreQuery
functionScoreQuery') =
    [Pair] -> Value
object [Key
"function_score" Key -> FunctionScoreQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FunctionScoreQuery
functionScoreQuery']
  toJSON (QueryDisMaxQuery DisMaxQuery
disMaxQuery) =
    [Pair] -> Value
object [Key
"dis_max" Key -> DisMaxQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DisMaxQuery
disMaxQuery]
  toJSON (QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
fuzzyQuery) =
    [Pair] -> Value
object [Key
"fuzzy_like_this" Key -> FuzzyLikeThisQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FuzzyLikeThisQuery
fuzzyQuery]
  toJSON (QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
fuzzyFieldQuery) =
    [Pair] -> Value
object [Key
"fuzzy_like_this_field" Key -> FuzzyLikeFieldQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FuzzyLikeFieldQuery
fuzzyFieldQuery]
  toJSON (QueryFuzzyQuery FuzzyQuery
fuzzyQuery) =
    [Pair] -> Value
object [Key
"fuzzy" Key -> FuzzyQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FuzzyQuery
fuzzyQuery]
  toJSON (QueryHasChildQuery HasChildQuery
childQuery) =
    [Pair] -> Value
object [Key
"has_child" Key -> HasChildQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HasChildQuery
childQuery]
  toJSON (QueryHasParentQuery HasParentQuery
parentQuery) =
    [Pair] -> Value
object [Key
"has_parent" Key -> HasParentQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HasParentQuery
parentQuery]
  toJSON (QueryIndicesQuery IndicesQuery
qIndicesQuery) =
    [Pair] -> Value
object [Key
"indices" Key -> IndicesQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndicesQuery
qIndicesQuery]
  toJSON (MatchAllQuery Maybe Boost
boost) =
    [Pair] -> Value
object [Key
"match_all" 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 [Key
"boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
boost]]
  toJSON (QueryMoreLikeThisQuery MoreLikeThisQuery
query) =
    [Pair] -> Value
object [Key
"more_like_this" Key -> MoreLikeThisQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MoreLikeThisQuery
query]
  toJSON (QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
query) =
    [Pair] -> Value
object [Key
"more_like_this_field" Key -> MoreLikeThisFieldQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MoreLikeThisFieldQuery
query]
  toJSON (QueryNestedQuery NestedQuery
query) =
    [Pair] -> Value
object [Key
"nested" Key -> NestedQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NestedQuery
query]
  toJSON (QueryPrefixQuery PrefixQuery
query) =
    [Pair] -> Value
object [Key
"prefix" Key -> PrefixQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PrefixQuery
query]
  toJSON (QueryRangeQuery RangeQuery
query) =
    [Pair] -> Value
object [Key
"range" Key -> RangeQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RangeQuery
query]
  toJSON (QueryRegexpQuery RegexpQuery
query) =
    [Pair] -> Value
object [Key
"regexp" Key -> RegexpQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RegexpQuery
query]
  toJSON (QuerySimpleQueryStringQuery SimpleQueryStringQuery
query) =
    [Pair] -> Value
object [Key
"simple_query_string" Key -> SimpleQueryStringQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SimpleQueryStringQuery
query]
  toJSON (QueryExistsQuery (FieldName Text
fieldName)) =
    [Pair] -> Value
object
      [ Key
"exists"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [Key
"field" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
fieldName]
      ]
  toJSON Query
QueryMatchNoneQuery =
    [Pair] -> Value
object [Key
"match_none" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []]
  toJSON (QueryWildcardQuery WildcardQuery
query) =
    [Pair] -> Value
object [Key
"wildcard" Key -> WildcardQuery -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= WildcardQuery
query]

instance FromJSON Query where
  parseJSON :: Value -> Parser Query
parseJSON Value
v = String -> (Object -> Parser Query) -> Value -> Parser Query
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Query" Object -> Parser Query
parse Value
v
    where
      parse :: Object -> Parser Query
parse Object
o =
        Object -> Parser Query
termQuery
          (Object -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"term"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HashMap Key Value -> Parser Query
termsQuery
            (HashMap Key Value -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"terms"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser Query
idsQuery
            (Object -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"ids"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QueryStringQuery -> Parser Query
queryQueryStringQuery
            (QueryStringQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"query_string"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MatchQuery -> Parser Query
queryMatchQuery
            (MatchQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"match"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Query
queryMultiMatchQuery
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoolQuery -> Parser Query
queryBoolQuery
            (BoolQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"bool"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoostingQuery -> Parser Query
queryBoostingQuery
            (BoostingQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"boosting"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommonTermsQuery -> Parser Query
queryCommonTermsQuery
            (CommonTermsQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"common"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser Query
constantScoreQuery
            (Object -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"constant_score"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FunctionScoreQuery -> Parser Query
queryFunctionScoreQuery
            (FunctionScoreQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"function_score"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DisMaxQuery -> Parser Query
queryDisMaxQuery
            (DisMaxQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"dis_max"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FuzzyLikeThisQuery -> Parser Query
queryFuzzyLikeThisQuery
            (FuzzyLikeThisQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"fuzzy_like_this"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FuzzyLikeFieldQuery -> Parser Query
queryFuzzyLikeFieldQuery
            (FuzzyLikeFieldQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"fuzzy_like_this_field"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FuzzyQuery -> Parser Query
queryFuzzyQuery
            (FuzzyQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"fuzzy"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HasChildQuery -> Parser Query
queryHasChildQuery
            (HasChildQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"has_child"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HasParentQuery -> Parser Query
queryHasParentQuery
            (HasParentQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"has_parent"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IndicesQuery -> Parser Query
queryIndicesQuery
            (IndicesQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"indices"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser Query
matchAllQuery
            (Object -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"match_all"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MoreLikeThisQuery -> Parser Query
queryMoreLikeThisQuery
            (MoreLikeThisQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"more_like_this"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MoreLikeThisFieldQuery -> Parser Query
queryMoreLikeThisFieldQuery
            (MoreLikeThisFieldQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"more_like_this_field"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NestedQuery -> Parser Query
queryNestedQuery
            (NestedQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"nested"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrefixQuery -> Parser Query
queryPrefixQuery
            (PrefixQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"prefix"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RangeQuery -> Parser Query
queryRangeQuery
            (RangeQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"range"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RegexpQuery -> Parser Query
queryRegexpQuery
            (RegexpQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"regexp"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleQueryStringQuery -> Parser Query
querySimpleQueryStringQuery
            (SimpleQueryStringQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"simple_query_string"
          Parser Query -> Parser Query -> Parser Query
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WildcardQuery -> Parser Query
queryWildcardQuery
            (WildcardQuery -> Parser Query) -> Key -> Parser Query
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"wildcard"
        where
          taggedWith :: (a -> Parser b) -> Key -> Parser b
taggedWith a -> Parser b
parser Key
k = a -> Parser b
parser (a -> Parser b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
      termQuery :: Object -> Parser Query
termQuery = (FieldName -> Object -> Parser Query) -> Object -> Parser Query
forall (m :: * -> *) a.
(Monad m, MonadFail m) =>
(FieldName -> Object -> m a) -> Object -> m a
fieldTagged ((FieldName -> Object -> Parser Query) -> Object -> Parser Query)
-> (FieldName -> Object -> Parser Query) -> Object -> Parser Query
forall a b. (a -> b) -> a -> b
$ \(FieldName Text
fn) Object
o ->
        Term -> Maybe Boost -> Query
TermQuery (Term -> Maybe Boost -> Query)
-> Parser Term -> Parser (Maybe Boost -> Query)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> Text -> Term
Term (Text -> Key
fromText Text
fn) (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value") Parser (Maybe Boost -> Query)
-> Parser (Maybe Boost) -> Parser Query
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"
      termsQuery :: HashMap Key Value -> Parser Query
termsQuery HashMap Key Value
o = case HashMap Key Value -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Key Value
o of
        [(Key
fn, Value
vs)] -> do
          [Text]
vals <- Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
vs
          case [Text]
vals of
            Text
x : [Text]
xs -> Query -> Parser Query
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key -> NonEmpty Text -> Query
TermsQuery Key
fn (Text
x Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
xs))
            [Text]
_ -> String -> Parser Query
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected non empty list of values"
        [Pair]
_ -> String -> Parser Query
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected object with 1 field-named key"
      idsQuery :: Object -> Parser Query
idsQuery Object
o = [DocId] -> Query
IdsQuery ([DocId] -> Query) -> Parser [DocId] -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [DocId]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values"
      queryQueryStringQuery :: QueryStringQuery -> Parser Query
queryQueryStringQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (QueryStringQuery -> Query) -> QueryStringQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryStringQuery -> Query
QueryQueryStringQuery
      queryMatchQuery :: MatchQuery -> Parser Query
queryMatchQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (MatchQuery -> Query) -> MatchQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchQuery -> Query
QueryMatchQuery
      queryMultiMatchQuery :: Parser Query
queryMultiMatchQuery = MultiMatchQuery -> Query
QueryMultiMatchQuery (MultiMatchQuery -> Query)
-> Parser MultiMatchQuery -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser MultiMatchQuery
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      queryBoolQuery :: BoolQuery -> Parser Query
queryBoolQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (BoolQuery -> Query) -> BoolQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolQuery -> Query
QueryBoolQuery
      queryBoostingQuery :: BoostingQuery -> Parser Query
queryBoostingQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (BoostingQuery -> Query) -> BoostingQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoostingQuery -> Query
QueryBoostingQuery
      queryCommonTermsQuery :: CommonTermsQuery -> Parser Query
queryCommonTermsQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (CommonTermsQuery -> Query) -> CommonTermsQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonTermsQuery -> Query
QueryCommonTermsQuery
      constantScoreQuery :: Object -> Parser Query
constantScoreQuery Object
o = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"filter" Object
o of
        Just Value
x ->
          Query -> Boost -> Query
ConstantScoreQuery
            (Query -> Boost -> Query)
-> Parser Query -> Parser (Boost -> Query)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Query
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
            Parser (Boost -> Query) -> Parser Boost -> Parser Query
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Boost
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"boost"
        Maybe Value
_ -> String -> Parser Query
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Does not appear to be a ConstantScoreQuery"
      queryFunctionScoreQuery :: FunctionScoreQuery -> Parser Query
queryFunctionScoreQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (FunctionScoreQuery -> Query)
-> FunctionScoreQuery
-> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionScoreQuery -> Query
QueryFunctionScoreQuery
      queryDisMaxQuery :: DisMaxQuery -> Parser Query
queryDisMaxQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (DisMaxQuery -> Query) -> DisMaxQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisMaxQuery -> Query
QueryDisMaxQuery
      queryFuzzyLikeThisQuery :: FuzzyLikeThisQuery -> Parser Query
queryFuzzyLikeThisQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (FuzzyLikeThisQuery -> Query)
-> FuzzyLikeThisQuery
-> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuzzyLikeThisQuery -> Query
QueryFuzzyLikeThisQuery
      queryFuzzyLikeFieldQuery :: FuzzyLikeFieldQuery -> Parser Query
queryFuzzyLikeFieldQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (FuzzyLikeFieldQuery -> Query)
-> FuzzyLikeFieldQuery
-> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuzzyLikeFieldQuery -> Query
QueryFuzzyLikeFieldQuery
      queryFuzzyQuery :: FuzzyQuery -> Parser Query
queryFuzzyQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (FuzzyQuery -> Query) -> FuzzyQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuzzyQuery -> Query
QueryFuzzyQuery
      queryHasChildQuery :: HasChildQuery -> Parser Query
queryHasChildQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (HasChildQuery -> Query) -> HasChildQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasChildQuery -> Query
QueryHasChildQuery
      queryHasParentQuery :: HasParentQuery -> Parser Query
queryHasParentQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (HasParentQuery -> Query) -> HasParentQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasParentQuery -> Query
QueryHasParentQuery
      queryIndicesQuery :: IndicesQuery -> Parser Query
queryIndicesQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (IndicesQuery -> Query) -> IndicesQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndicesQuery -> Query
QueryIndicesQuery
      matchAllQuery :: Object -> Parser Query
matchAllQuery Object
o = Maybe Boost -> Query
MatchAllQuery (Maybe Boost -> Query) -> Parser (Maybe Boost) -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"
      queryMoreLikeThisQuery :: MoreLikeThisQuery -> Parser Query
queryMoreLikeThisQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (MoreLikeThisQuery -> Query)
-> MoreLikeThisQuery
-> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoreLikeThisQuery -> Query
QueryMoreLikeThisQuery
      queryMoreLikeThisFieldQuery :: MoreLikeThisFieldQuery -> Parser Query
queryMoreLikeThisFieldQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (MoreLikeThisFieldQuery -> Query)
-> MoreLikeThisFieldQuery
-> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoreLikeThisFieldQuery -> Query
QueryMoreLikeThisFieldQuery
      queryNestedQuery :: NestedQuery -> Parser Query
queryNestedQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (NestedQuery -> Query) -> NestedQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedQuery -> Query
QueryNestedQuery
      queryPrefixQuery :: PrefixQuery -> Parser Query
queryPrefixQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (PrefixQuery -> Query) -> PrefixQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixQuery -> Query
QueryPrefixQuery
      queryRangeQuery :: RangeQuery -> Parser Query
queryRangeQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (RangeQuery -> Query) -> RangeQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeQuery -> Query
QueryRangeQuery
      queryRegexpQuery :: RegexpQuery -> Parser Query
queryRegexpQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (RegexpQuery -> Query) -> RegexpQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegexpQuery -> Query
QueryRegexpQuery
      querySimpleQueryStringQuery :: SimpleQueryStringQuery -> Parser Query
querySimpleQueryStringQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (SimpleQueryStringQuery -> Query)
-> SimpleQueryStringQuery
-> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleQueryStringQuery -> Query
QuerySimpleQueryStringQuery
      -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
      queryWildcardQuery :: WildcardQuery -> Parser Query
queryWildcardQuery = Query -> Parser Query
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> Parser Query)
-> (WildcardQuery -> Query) -> WildcardQuery -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WildcardQuery -> Query
QueryWildcardQuery

-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
--  Bool Query, and flagged in a different context.
newtype Filter = Filter {Filter -> Query
unFilter :: Query}
  deriving stock (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
/= :: Filter -> Filter -> Bool
Eq, Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filter -> ShowS
showsPrec :: Int -> Filter -> ShowS
$cshow :: Filter -> String
show :: Filter -> String
$cshowList :: [Filter] -> ShowS
showList :: [Filter] -> ShowS
Show)

instance ToJSON Filter where
  toJSON :: Filter -> Value
toJSON = Query -> Value
forall a. ToJSON a => a -> Value
toJSON (Query -> Value) -> (Filter -> Query) -> Filter -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> Query
unFilter

instance FromJSON Filter where
  parseJSON :: Value -> Parser Filter
parseJSON Value
v = Query -> Filter
Filter (Query -> Filter) -> Parser Query -> Parser Filter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Query
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data NestedQuery = NestedQuery
  { NestedQuery -> QueryPath
nestedQueryPath :: QueryPath,
    NestedQuery -> ScoreType
nestedQueryScoreType :: ScoreType,
    NestedQuery -> Query
nestedQuery :: Query,
    NestedQuery -> Maybe InnerHits
nestedQueryInnerHits :: Maybe InnerHits
  }
  deriving stock (NestedQuery -> NestedQuery -> Bool
(NestedQuery -> NestedQuery -> Bool)
-> (NestedQuery -> NestedQuery -> Bool) -> Eq NestedQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NestedQuery -> NestedQuery -> Bool
== :: NestedQuery -> NestedQuery -> Bool
$c/= :: NestedQuery -> NestedQuery -> Bool
/= :: NestedQuery -> NestedQuery -> Bool
Eq, Int -> NestedQuery -> ShowS
[NestedQuery] -> ShowS
NestedQuery -> String
(Int -> NestedQuery -> ShowS)
-> (NestedQuery -> String)
-> ([NestedQuery] -> ShowS)
-> Show NestedQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NestedQuery -> ShowS
showsPrec :: Int -> NestedQuery -> ShowS
$cshow :: NestedQuery -> String
show :: NestedQuery -> String
$cshowList :: [NestedQuery] -> ShowS
showList :: [NestedQuery] -> ShowS
Show, (forall x. NestedQuery -> Rep NestedQuery x)
-> (forall x. Rep NestedQuery x -> NestedQuery)
-> Generic NestedQuery
forall x. Rep NestedQuery x -> NestedQuery
forall x. NestedQuery -> Rep NestedQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NestedQuery -> Rep NestedQuery x
from :: forall x. NestedQuery -> Rep NestedQuery x
$cto :: forall x. Rep NestedQuery x -> NestedQuery
to :: forall x. Rep NestedQuery x -> NestedQuery
Generic)

instance ToJSON NestedQuery where
  toJSON :: NestedQuery -> Value
toJSON (NestedQuery QueryPath
nqPath ScoreType
nqScoreType Query
nqQuery Maybe InnerHits
nqInnerHits) =
    [Pair] -> Value
omitNulls
      [ Key
"path" Key -> QueryPath -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= QueryPath
nqPath,
        Key
"score_mode" Key -> ScoreType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScoreType
nqScoreType,
        Key
"query" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
nqQuery,
        Key
"inner_hits" Key -> Maybe InnerHits -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe InnerHits
nqInnerHits
      ]

instance FromJSON NestedQuery where
  parseJSON :: Value -> Parser NestedQuery
parseJSON = String
-> (Object -> Parser NestedQuery) -> Value -> Parser NestedQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NestedQuery" Object -> Parser NestedQuery
parse
    where
      parse :: Object -> Parser NestedQuery
parse Object
o =
        QueryPath -> ScoreType -> Query -> Maybe InnerHits -> NestedQuery
NestedQuery
          (QueryPath -> ScoreType -> Query -> Maybe InnerHits -> NestedQuery)
-> Parser QueryPath
-> Parser (ScoreType -> Query -> Maybe InnerHits -> NestedQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser QueryPath
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
          Parser (ScoreType -> Query -> Maybe InnerHits -> NestedQuery)
-> Parser ScoreType
-> Parser (Query -> Maybe InnerHits -> NestedQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ScoreType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"score_mode"
          Parser (Query -> Maybe InnerHits -> NestedQuery)
-> Parser Query -> Parser (Maybe InnerHits -> NestedQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Query
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query"
          Parser (Maybe InnerHits -> NestedQuery)
-> Parser (Maybe InnerHits) -> Parser NestedQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe InnerHits)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"inner_hits"

data IndicesQuery = IndicesQuery
  { IndicesQuery -> [IndexName]
indicesQueryIndices :: [IndexName],
    IndicesQuery -> Query
indicesQuery :: Query,
    -- default "all"
    IndicesQuery -> Maybe Query
indicesQueryNoMatch :: Maybe Query
  }
  deriving stock (IndicesQuery -> IndicesQuery -> Bool
(IndicesQuery -> IndicesQuery -> Bool)
-> (IndicesQuery -> IndicesQuery -> Bool) -> Eq IndicesQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndicesQuery -> IndicesQuery -> Bool
== :: IndicesQuery -> IndicesQuery -> Bool
$c/= :: IndicesQuery -> IndicesQuery -> Bool
/= :: IndicesQuery -> IndicesQuery -> Bool
Eq, Int -> IndicesQuery -> ShowS
[IndicesQuery] -> ShowS
IndicesQuery -> String
(Int -> IndicesQuery -> ShowS)
-> (IndicesQuery -> String)
-> ([IndicesQuery] -> ShowS)
-> Show IndicesQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndicesQuery -> ShowS
showsPrec :: Int -> IndicesQuery -> ShowS
$cshow :: IndicesQuery -> String
show :: IndicesQuery -> String
$cshowList :: [IndicesQuery] -> ShowS
showList :: [IndicesQuery] -> ShowS
Show, (forall x. IndicesQuery -> Rep IndicesQuery x)
-> (forall x. Rep IndicesQuery x -> IndicesQuery)
-> Generic IndicesQuery
forall x. Rep IndicesQuery x -> IndicesQuery
forall x. IndicesQuery -> Rep IndicesQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IndicesQuery -> Rep IndicesQuery x
from :: forall x. IndicesQuery -> Rep IndicesQuery x
$cto :: forall x. Rep IndicesQuery x -> IndicesQuery
to :: forall x. Rep IndicesQuery x -> IndicesQuery
Generic)

instance ToJSON IndicesQuery where
  toJSON :: IndicesQuery -> Value
toJSON (IndicesQuery [IndexName]
indices Query
query Maybe Query
noMatch) =
    [Pair] -> Value
omitNulls
      [ Key
"indices" Key -> [IndexName] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [IndexName]
indices,
        Key
"no_match_query" Key -> Maybe Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Query
noMatch,
        Key
"query" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
query
      ]

instance FromJSON IndicesQuery where
  parseJSON :: Value -> Parser IndicesQuery
parseJSON = String
-> (Object -> Parser IndicesQuery) -> Value -> Parser IndicesQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndicesQuery" Object -> Parser IndicesQuery
parse
    where
      parse :: Object -> Parser IndicesQuery
parse Object
o =
        [IndexName] -> Query -> Maybe Query -> IndicesQuery
IndicesQuery
          ([IndexName] -> Query -> Maybe Query -> IndicesQuery)
-> Parser [IndexName]
-> Parser (Query -> Maybe Query -> IndicesQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [IndexName])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"indices" Parser (Maybe [IndexName]) -> [IndexName] -> Parser [IndexName]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser (Query -> Maybe Query -> IndicesQuery)
-> Parser Query -> Parser (Maybe Query -> IndicesQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Query
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query"
          Parser (Maybe Query -> IndicesQuery)
-> Parser (Maybe Query) -> Parser IndicesQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"no_match_query"

data HasParentQuery = HasParentQuery
  { HasParentQuery -> RelationName
hasParentQueryType :: RelationName,
    HasParentQuery -> Query
hasParentQuery :: Query,
    HasParentQuery -> Maybe AggregateParentScore
hasParentQueryScore :: Maybe AggregateParentScore,
    HasParentQuery -> Maybe IgnoreUnmapped
hasParentIgnoreUnmapped :: Maybe IgnoreUnmapped
  }
  deriving stock (HasParentQuery -> HasParentQuery -> Bool
(HasParentQuery -> HasParentQuery -> Bool)
-> (HasParentQuery -> HasParentQuery -> Bool) -> Eq HasParentQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HasParentQuery -> HasParentQuery -> Bool
== :: HasParentQuery -> HasParentQuery -> Bool
$c/= :: HasParentQuery -> HasParentQuery -> Bool
/= :: HasParentQuery -> HasParentQuery -> Bool
Eq, Int -> HasParentQuery -> ShowS
[HasParentQuery] -> ShowS
HasParentQuery -> String
(Int -> HasParentQuery -> ShowS)
-> (HasParentQuery -> String)
-> ([HasParentQuery] -> ShowS)
-> Show HasParentQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HasParentQuery -> ShowS
showsPrec :: Int -> HasParentQuery -> ShowS
$cshow :: HasParentQuery -> String
show :: HasParentQuery -> String
$cshowList :: [HasParentQuery] -> ShowS
showList :: [HasParentQuery] -> ShowS
Show, (forall x. HasParentQuery -> Rep HasParentQuery x)
-> (forall x. Rep HasParentQuery x -> HasParentQuery)
-> Generic HasParentQuery
forall x. Rep HasParentQuery x -> HasParentQuery
forall x. HasParentQuery -> Rep HasParentQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HasParentQuery -> Rep HasParentQuery x
from :: forall x. HasParentQuery -> Rep HasParentQuery x
$cto :: forall x. Rep HasParentQuery x -> HasParentQuery
to :: forall x. Rep HasParentQuery x -> HasParentQuery
Generic)

instance ToJSON HasParentQuery where
  toJSON :: HasParentQuery -> Value
toJSON (HasParentQuery RelationName
queryType Query
query Maybe AggregateParentScore
scoreType Maybe IgnoreUnmapped
ignoreUnmapped) =
    [Pair] -> Value
omitNulls
      [ Key
"parent_type" Key -> RelationName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RelationName
queryType,
        Key
"score" Key -> Maybe AggregateParentScore -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe AggregateParentScore
scoreType,
        Key
"query" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
query,
        Key
"ignore_unmapped" Key -> Maybe IgnoreUnmapped -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe IgnoreUnmapped
ignoreUnmapped
      ]

instance FromJSON HasParentQuery where
  parseJSON :: Value -> Parser HasParentQuery
parseJSON = String
-> (Object -> Parser HasParentQuery)
-> Value
-> Parser HasParentQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HasParentQuery" Object -> Parser HasParentQuery
parse
    where
      parse :: Object -> Parser HasParentQuery
parse Object
o =
        RelationName
-> Query
-> Maybe AggregateParentScore
-> Maybe IgnoreUnmapped
-> HasParentQuery
HasParentQuery
          (RelationName
 -> Query
 -> Maybe AggregateParentScore
 -> Maybe IgnoreUnmapped
 -> HasParentQuery)
-> Parser RelationName
-> Parser
     (Query
      -> Maybe AggregateParentScore
      -> Maybe IgnoreUnmapped
      -> HasParentQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser RelationName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent_type"
          Parser
  (Query
   -> Maybe AggregateParentScore
   -> Maybe IgnoreUnmapped
   -> HasParentQuery)
-> Parser Query
-> Parser
     (Maybe AggregateParentScore
      -> Maybe IgnoreUnmapped -> HasParentQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Query
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query"
          Parser
  (Maybe AggregateParentScore
   -> Maybe IgnoreUnmapped -> HasParentQuery)
-> Parser (Maybe AggregateParentScore)
-> Parser (Maybe IgnoreUnmapped -> HasParentQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe AggregateParentScore)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"score"
          Parser (Maybe IgnoreUnmapped -> HasParentQuery)
-> Parser (Maybe IgnoreUnmapped) -> Parser HasParentQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe IgnoreUnmapped)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_unmapped"

data HasChildQuery = HasChildQuery
  { HasChildQuery -> RelationName
hasChildQueryType :: RelationName,
    HasChildQuery -> Query
hasChildQuery :: Query,
    HasChildQuery -> Maybe ScoreType
hasChildQueryScoreType :: Maybe ScoreType,
    HasChildQuery -> Maybe IgnoreUnmapped
hasChildIgnoreUnmappped :: Maybe IgnoreUnmapped,
    HasChildQuery -> Maybe MinChildren
hasChildMinChildren :: Maybe MinChildren,
    HasChildQuery -> Maybe MaxChildren
hasChildMaxChildren :: Maybe MaxChildren
  }
  deriving stock (HasChildQuery -> HasChildQuery -> Bool
(HasChildQuery -> HasChildQuery -> Bool)
-> (HasChildQuery -> HasChildQuery -> Bool) -> Eq HasChildQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HasChildQuery -> HasChildQuery -> Bool
== :: HasChildQuery -> HasChildQuery -> Bool
$c/= :: HasChildQuery -> HasChildQuery -> Bool
/= :: HasChildQuery -> HasChildQuery -> Bool
Eq, Int -> HasChildQuery -> ShowS
[HasChildQuery] -> ShowS
HasChildQuery -> String
(Int -> HasChildQuery -> ShowS)
-> (HasChildQuery -> String)
-> ([HasChildQuery] -> ShowS)
-> Show HasChildQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HasChildQuery -> ShowS
showsPrec :: Int -> HasChildQuery -> ShowS
$cshow :: HasChildQuery -> String
show :: HasChildQuery -> String
$cshowList :: [HasChildQuery] -> ShowS
showList :: [HasChildQuery] -> ShowS
Show, (forall x. HasChildQuery -> Rep HasChildQuery x)
-> (forall x. Rep HasChildQuery x -> HasChildQuery)
-> Generic HasChildQuery
forall x. Rep HasChildQuery x -> HasChildQuery
forall x. HasChildQuery -> Rep HasChildQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HasChildQuery -> Rep HasChildQuery x
from :: forall x. HasChildQuery -> Rep HasChildQuery x
$cto :: forall x. Rep HasChildQuery x -> HasChildQuery
to :: forall x. Rep HasChildQuery x -> HasChildQuery
Generic)

instance ToJSON HasChildQuery where
  toJSON :: HasChildQuery -> Value
toJSON (HasChildQuery RelationName
queryType Query
query Maybe ScoreType
scoreType Maybe IgnoreUnmapped
ignoreUnmapped Maybe MinChildren
minChildren Maybe MaxChildren
maxChildren) =
    [Pair] -> Value
omitNulls
      [ Key
"query" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
query,
        Key
"score_mode" Key -> Maybe ScoreType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ScoreType
scoreType,
        Key
"type" Key -> RelationName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RelationName
queryType,
        Key
"min_children" Key -> Maybe MinChildren -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe MinChildren
minChildren,
        Key
"max_children" Key -> Maybe MaxChildren -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe MaxChildren
maxChildren,
        Key
"ignore_unmapped" Key -> Maybe IgnoreUnmapped -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe IgnoreUnmapped
ignoreUnmapped
      ]

instance FromJSON HasChildQuery where
  parseJSON :: Value -> Parser HasChildQuery
parseJSON = String
-> (Object -> Parser HasChildQuery)
-> Value
-> Parser HasChildQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HasChildQuery" Object -> Parser HasChildQuery
parse
    where
      parse :: Object -> Parser HasChildQuery
parse Object
o =
        RelationName
-> Query
-> Maybe ScoreType
-> Maybe IgnoreUnmapped
-> Maybe MinChildren
-> Maybe MaxChildren
-> HasChildQuery
HasChildQuery
          (RelationName
 -> Query
 -> Maybe ScoreType
 -> Maybe IgnoreUnmapped
 -> Maybe MinChildren
 -> Maybe MaxChildren
 -> HasChildQuery)
-> Parser RelationName
-> Parser
     (Query
      -> Maybe ScoreType
      -> Maybe IgnoreUnmapped
      -> Maybe MinChildren
      -> Maybe MaxChildren
      -> HasChildQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser RelationName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
          Parser
  (Query
   -> Maybe ScoreType
   -> Maybe IgnoreUnmapped
   -> Maybe MinChildren
   -> Maybe MaxChildren
   -> HasChildQuery)
-> Parser Query
-> Parser
     (Maybe ScoreType
      -> Maybe IgnoreUnmapped
      -> Maybe MinChildren
      -> Maybe MaxChildren
      -> HasChildQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Query
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query"
          Parser
  (Maybe ScoreType
   -> Maybe IgnoreUnmapped
   -> Maybe MinChildren
   -> Maybe MaxChildren
   -> HasChildQuery)
-> Parser (Maybe ScoreType)
-> Parser
     (Maybe IgnoreUnmapped
      -> Maybe MinChildren -> Maybe MaxChildren -> HasChildQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ScoreType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"score_mode"
          Parser
  (Maybe IgnoreUnmapped
   -> Maybe MinChildren -> Maybe MaxChildren -> HasChildQuery)
-> Parser (Maybe IgnoreUnmapped)
-> Parser (Maybe MinChildren -> Maybe MaxChildren -> HasChildQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe IgnoreUnmapped)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_unmapped"
          Parser (Maybe MinChildren -> Maybe MaxChildren -> HasChildQuery)
-> Parser (Maybe MinChildren)
-> Parser (Maybe MaxChildren -> HasChildQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe MinChildren)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_children"
          Parser (Maybe MaxChildren -> HasChildQuery)
-> Parser (Maybe MaxChildren) -> Parser HasChildQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe MaxChildren)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_children"

data ScoreType
  = ScoreTypeMax
  | ScoreTypeSum
  | ScoreTypeAvg
  | ScoreTypeNone
  deriving stock (ScoreType -> ScoreType -> Bool
(ScoreType -> ScoreType -> Bool)
-> (ScoreType -> ScoreType -> Bool) -> Eq ScoreType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScoreType -> ScoreType -> Bool
== :: ScoreType -> ScoreType -> Bool
$c/= :: ScoreType -> ScoreType -> Bool
/= :: ScoreType -> ScoreType -> Bool
Eq, Int -> ScoreType -> ShowS
[ScoreType] -> ShowS
ScoreType -> String
(Int -> ScoreType -> ShowS)
-> (ScoreType -> String)
-> ([ScoreType] -> ShowS)
-> Show ScoreType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScoreType -> ShowS
showsPrec :: Int -> ScoreType -> ShowS
$cshow :: ScoreType -> String
show :: ScoreType -> String
$cshowList :: [ScoreType] -> ShowS
showList :: [ScoreType] -> ShowS
Show, (forall x. ScoreType -> Rep ScoreType x)
-> (forall x. Rep ScoreType x -> ScoreType) -> Generic ScoreType
forall x. Rep ScoreType x -> ScoreType
forall x. ScoreType -> Rep ScoreType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScoreType -> Rep ScoreType x
from :: forall x. ScoreType -> Rep ScoreType x
$cto :: forall x. Rep ScoreType x -> ScoreType
to :: forall x. Rep ScoreType x -> ScoreType
Generic)

instance ToJSON ScoreType where
  toJSON :: ScoreType -> Value
toJSON ScoreType
ScoreTypeMax = Value
"max"
  toJSON ScoreType
ScoreTypeAvg = Value
"avg"
  toJSON ScoreType
ScoreTypeSum = Value
"sum"
  toJSON ScoreType
ScoreTypeNone = Value
"none"

instance FromJSON ScoreType where
  parseJSON :: Value -> Parser ScoreType
parseJSON = String -> (Text -> Parser ScoreType) -> Value -> Parser ScoreType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ScoreType" Text -> Parser ScoreType
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f ScoreType
parse
    where
      parse :: a -> f ScoreType
parse a
"max" = ScoreType -> f ScoreType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreType
ScoreTypeMax
      parse a
"avg" = ScoreType -> f ScoreType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreType
ScoreTypeAvg
      parse a
"sum" = ScoreType -> f ScoreType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreType
ScoreTypeSum
      parse a
"none" = ScoreType -> f ScoreType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreType
ScoreTypeNone
      parse a
t = String -> f ScoreType
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected ScoreType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
t)

data DisMaxQuery = DisMaxQuery
  { DisMaxQuery -> [Query]
disMaxQueries :: [Query],
    -- default 0.0
    DisMaxQuery -> Tiebreaker
disMaxTiebreaker :: Tiebreaker,
    DisMaxQuery -> Maybe Boost
disMaxBoost :: Maybe Boost
  }
  deriving stock (DisMaxQuery -> DisMaxQuery -> Bool
(DisMaxQuery -> DisMaxQuery -> Bool)
-> (DisMaxQuery -> DisMaxQuery -> Bool) -> Eq DisMaxQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisMaxQuery -> DisMaxQuery -> Bool
== :: DisMaxQuery -> DisMaxQuery -> Bool
$c/= :: DisMaxQuery -> DisMaxQuery -> Bool
/= :: DisMaxQuery -> DisMaxQuery -> Bool
Eq, Int -> DisMaxQuery -> ShowS
[DisMaxQuery] -> ShowS
DisMaxQuery -> String
(Int -> DisMaxQuery -> ShowS)
-> (DisMaxQuery -> String)
-> ([DisMaxQuery] -> ShowS)
-> Show DisMaxQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisMaxQuery -> ShowS
showsPrec :: Int -> DisMaxQuery -> ShowS
$cshow :: DisMaxQuery -> String
show :: DisMaxQuery -> String
$cshowList :: [DisMaxQuery] -> ShowS
showList :: [DisMaxQuery] -> ShowS
Show, (forall x. DisMaxQuery -> Rep DisMaxQuery x)
-> (forall x. Rep DisMaxQuery x -> DisMaxQuery)
-> Generic DisMaxQuery
forall x. Rep DisMaxQuery x -> DisMaxQuery
forall x. DisMaxQuery -> Rep DisMaxQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DisMaxQuery -> Rep DisMaxQuery x
from :: forall x. DisMaxQuery -> Rep DisMaxQuery x
$cto :: forall x. Rep DisMaxQuery x -> DisMaxQuery
to :: forall x. Rep DisMaxQuery x -> DisMaxQuery
Generic)

instance ToJSON DisMaxQuery where
  toJSON :: DisMaxQuery -> Value
toJSON (DisMaxQuery [Query]
queries Tiebreaker
tiebreaker Maybe Boost
boost) =
    [Pair] -> Value
omitNulls [Pair]
base
    where
      base :: [Pair]
base =
        [ Key
"queries" Key -> [Query] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Query]
queries,
          Key
"boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
boost,
          Key
"tie_breaker" Key -> Tiebreaker -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tiebreaker
tiebreaker
        ]

instance FromJSON DisMaxQuery where
  parseJSON :: Value -> Parser DisMaxQuery
parseJSON = String
-> (Object -> Parser DisMaxQuery) -> Value -> Parser DisMaxQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DisMaxQuery" Object -> Parser DisMaxQuery
parse
    where
      parse :: Object -> Parser DisMaxQuery
parse Object
o =
        [Query] -> Tiebreaker -> Maybe Boost -> DisMaxQuery
DisMaxQuery
          ([Query] -> Tiebreaker -> Maybe Boost -> DisMaxQuery)
-> Parser [Query]
-> Parser (Tiebreaker -> Maybe Boost -> DisMaxQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [Query])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"queries" Parser (Maybe [Query]) -> [Query] -> Parser [Query]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser (Tiebreaker -> Maybe Boost -> DisMaxQuery)
-> Parser Tiebreaker -> Parser (Maybe Boost -> DisMaxQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Tiebreaker
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tie_breaker"
          Parser (Maybe Boost -> DisMaxQuery)
-> Parser (Maybe Boost) -> Parser DisMaxQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"

data BoolQuery = BoolQuery
  { BoolQuery -> [Query]
boolQueryMustMatch :: [Query],
    BoolQuery -> [Filter]
boolQueryFilter :: [Filter],
    BoolQuery -> [Query]
boolQueryMustNotMatch :: [Query],
    BoolQuery -> [Query]
boolQueryShouldMatch :: [Query],
    BoolQuery -> Maybe MinimumMatch
boolQueryMinimumShouldMatch :: Maybe MinimumMatch,
    BoolQuery -> Maybe Boost
boolQueryBoost :: Maybe Boost,
    BoolQuery -> Maybe DisableCoord
boolQueryDisableCoord :: Maybe DisableCoord
  }
  deriving stock (BoolQuery -> BoolQuery -> Bool
(BoolQuery -> BoolQuery -> Bool)
-> (BoolQuery -> BoolQuery -> Bool) -> Eq BoolQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoolQuery -> BoolQuery -> Bool
== :: BoolQuery -> BoolQuery -> Bool
$c/= :: BoolQuery -> BoolQuery -> Bool
/= :: BoolQuery -> BoolQuery -> Bool
Eq, Int -> BoolQuery -> ShowS
[BoolQuery] -> ShowS
BoolQuery -> String
(Int -> BoolQuery -> ShowS)
-> (BoolQuery -> String)
-> ([BoolQuery] -> ShowS)
-> Show BoolQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoolQuery -> ShowS
showsPrec :: Int -> BoolQuery -> ShowS
$cshow :: BoolQuery -> String
show :: BoolQuery -> String
$cshowList :: [BoolQuery] -> ShowS
showList :: [BoolQuery] -> ShowS
Show, (forall x. BoolQuery -> Rep BoolQuery x)
-> (forall x. Rep BoolQuery x -> BoolQuery) -> Generic BoolQuery
forall x. Rep BoolQuery x -> BoolQuery
forall x. BoolQuery -> Rep BoolQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoolQuery -> Rep BoolQuery x
from :: forall x. BoolQuery -> Rep BoolQuery x
$cto :: forall x. Rep BoolQuery x -> BoolQuery
to :: forall x. Rep BoolQuery x -> BoolQuery
Generic)

instance ToJSON BoolQuery where
  toJSON :: BoolQuery -> Value
toJSON (BoolQuery [Query]
mustM [Filter]
filterM' [Query]
notM [Query]
shouldM Maybe MinimumMatch
bqMin Maybe Boost
boost Maybe DisableCoord
disableCoord) =
    [Pair] -> Value
omitNulls [Pair]
base
    where
      base :: [Pair]
base =
        [ Key
"must" Key -> [Query] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Query]
mustM,
          Key
"filter" Key -> [Filter] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Filter]
filterM',
          Key
"must_not" Key -> [Query] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Query]
notM,
          Key
"should" Key -> [Query] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Query]
shouldM,
          Key
"minimum_should_match" Key -> Maybe MinimumMatch -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe MinimumMatch
bqMin,
          Key
"boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
boost,
          Key
"disable_coord" Key -> Maybe DisableCoord -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe DisableCoord
disableCoord
        ]

instance FromJSON BoolQuery where
  parseJSON :: Value -> Parser BoolQuery
parseJSON = String -> (Object -> Parser BoolQuery) -> Value -> Parser BoolQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BoolQuery" Object -> Parser BoolQuery
parse
    where
      parse :: Object -> Parser BoolQuery
parse Object
o =
        [Query]
-> [Filter]
-> [Query]
-> [Query]
-> Maybe MinimumMatch
-> Maybe Boost
-> Maybe DisableCoord
-> BoolQuery
BoolQuery
          ([Query]
 -> [Filter]
 -> [Query]
 -> [Query]
 -> Maybe MinimumMatch
 -> Maybe Boost
 -> Maybe DisableCoord
 -> BoolQuery)
-> Parser [Query]
-> Parser
     ([Filter]
      -> [Query]
      -> [Query]
      -> Maybe MinimumMatch
      -> Maybe Boost
      -> Maybe DisableCoord
      -> BoolQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [Query])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"must" Parser (Maybe [Query]) -> [Query] -> Parser [Query]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser
  ([Filter]
   -> [Query]
   -> [Query]
   -> Maybe MinimumMatch
   -> Maybe Boost
   -> Maybe DisableCoord
   -> BoolQuery)
-> Parser [Filter]
-> Parser
     ([Query]
      -> [Query]
      -> Maybe MinimumMatch
      -> Maybe Boost
      -> Maybe DisableCoord
      -> BoolQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Filter])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter" Parser (Maybe [Filter]) -> [Filter] -> Parser [Filter]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser
  ([Query]
   -> [Query]
   -> Maybe MinimumMatch
   -> Maybe Boost
   -> Maybe DisableCoord
   -> BoolQuery)
-> Parser [Query]
-> Parser
     ([Query]
      -> Maybe MinimumMatch
      -> Maybe Boost
      -> Maybe DisableCoord
      -> BoolQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Query])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"must_not" Parser (Maybe [Query]) -> [Query] -> Parser [Query]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser
  ([Query]
   -> Maybe MinimumMatch
   -> Maybe Boost
   -> Maybe DisableCoord
   -> BoolQuery)
-> Parser [Query]
-> Parser
     (Maybe MinimumMatch
      -> Maybe Boost -> Maybe DisableCoord -> BoolQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Query])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"should" Parser (Maybe [Query]) -> [Query] -> Parser [Query]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser
  (Maybe MinimumMatch
   -> Maybe Boost -> Maybe DisableCoord -> BoolQuery)
-> Parser (Maybe MinimumMatch)
-> Parser (Maybe Boost -> Maybe DisableCoord -> BoolQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe MinimumMatch)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minimum_should_match"
          Parser (Maybe Boost -> Maybe DisableCoord -> BoolQuery)
-> Parser (Maybe Boost) -> Parser (Maybe DisableCoord -> BoolQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"
          Parser (Maybe DisableCoord -> BoolQuery)
-> Parser (Maybe DisableCoord) -> Parser BoolQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe DisableCoord)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disable_coord"

mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
mkBoolQuery [Query]
must [Filter]
filt [Query]
mustNot [Query]
should =
  [Query]
-> [Filter]
-> [Query]
-> [Query]
-> Maybe MinimumMatch
-> Maybe Boost
-> Maybe DisableCoord
-> BoolQuery
BoolQuery [Query]
must [Filter]
filt [Query]
mustNot [Query]
should Maybe MinimumMatch
forall a. Maybe a
Nothing Maybe Boost
forall a. Maybe a
Nothing Maybe DisableCoord
forall a. Maybe a
Nothing

data BoostingQuery = BoostingQuery
  { BoostingQuery -> Query
positiveQuery :: Query,
    BoostingQuery -> Query
negativeQuery :: Query,
    BoostingQuery -> Boost
negativeBoost :: Boost
  }
  deriving stock (BoostingQuery -> BoostingQuery -> Bool
(BoostingQuery -> BoostingQuery -> Bool)
-> (BoostingQuery -> BoostingQuery -> Bool) -> Eq BoostingQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoostingQuery -> BoostingQuery -> Bool
== :: BoostingQuery -> BoostingQuery -> Bool
$c/= :: BoostingQuery -> BoostingQuery -> Bool
/= :: BoostingQuery -> BoostingQuery -> Bool
Eq, Int -> BoostingQuery -> ShowS
[BoostingQuery] -> ShowS
BoostingQuery -> String
(Int -> BoostingQuery -> ShowS)
-> (BoostingQuery -> String)
-> ([BoostingQuery] -> ShowS)
-> Show BoostingQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoostingQuery -> ShowS
showsPrec :: Int -> BoostingQuery -> ShowS
$cshow :: BoostingQuery -> String
show :: BoostingQuery -> String
$cshowList :: [BoostingQuery] -> ShowS
showList :: [BoostingQuery] -> ShowS
Show, (forall x. BoostingQuery -> Rep BoostingQuery x)
-> (forall x. Rep BoostingQuery x -> BoostingQuery)
-> Generic BoostingQuery
forall x. Rep BoostingQuery x -> BoostingQuery
forall x. BoostingQuery -> Rep BoostingQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoostingQuery -> Rep BoostingQuery x
from :: forall x. BoostingQuery -> Rep BoostingQuery x
$cto :: forall x. Rep BoostingQuery x -> BoostingQuery
to :: forall x. Rep BoostingQuery x -> BoostingQuery
Generic)

instance ToJSON BoostingQuery where
  toJSON :: BoostingQuery -> Value
toJSON (BoostingQuery Query
bqPositiveQuery Query
bqNegativeQuery Boost
bqNegativeBoost) =
    [Pair] -> Value
object
      [ Key
"positive" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
bqPositiveQuery,
        Key
"negative" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
bqNegativeQuery,
        Key
"negative_boost" Key -> Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Boost
bqNegativeBoost
      ]

instance FromJSON BoostingQuery where
  parseJSON :: Value -> Parser BoostingQuery
parseJSON = String
-> (Object -> Parser BoostingQuery)
-> Value
-> Parser BoostingQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BoostingQuery" Object -> Parser BoostingQuery
parse
    where
      parse :: Object -> Parser BoostingQuery
parse Object
o =
        Query -> Query -> Boost -> BoostingQuery
BoostingQuery
          (Query -> Query -> Boost -> BoostingQuery)
-> Parser Query -> Parser (Query -> Boost -> BoostingQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Query
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"positive"
          Parser (Query -> Boost -> BoostingQuery)
-> Parser Query -> Parser (Boost -> BoostingQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Query
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"negative"
          Parser (Boost -> BoostingQuery)
-> Parser Boost -> Parser BoostingQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Boost
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"negative_boost"

data RangeExecution
  = RangeExecutionIndex
  | RangeExecutionFielddata
  deriving stock (RangeExecution -> RangeExecution -> Bool
(RangeExecution -> RangeExecution -> Bool)
-> (RangeExecution -> RangeExecution -> Bool) -> Eq RangeExecution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RangeExecution -> RangeExecution -> Bool
== :: RangeExecution -> RangeExecution -> Bool
$c/= :: RangeExecution -> RangeExecution -> Bool
/= :: RangeExecution -> RangeExecution -> Bool
Eq, Int -> RangeExecution -> ShowS
[RangeExecution] -> ShowS
RangeExecution -> String
(Int -> RangeExecution -> ShowS)
-> (RangeExecution -> String)
-> ([RangeExecution] -> ShowS)
-> Show RangeExecution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RangeExecution -> ShowS
showsPrec :: Int -> RangeExecution -> ShowS
$cshow :: RangeExecution -> String
show :: RangeExecution -> String
$cshowList :: [RangeExecution] -> ShowS
showList :: [RangeExecution] -> ShowS
Show, (forall x. RangeExecution -> Rep RangeExecution x)
-> (forall x. Rep RangeExecution x -> RangeExecution)
-> Generic RangeExecution
forall x. Rep RangeExecution x -> RangeExecution
forall x. RangeExecution -> Rep RangeExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RangeExecution -> Rep RangeExecution x
from :: forall x. RangeExecution -> Rep RangeExecution x
$cto :: forall x. Rep RangeExecution x -> RangeExecution
to :: forall x. Rep RangeExecution x -> RangeExecution
Generic)

-- index for smaller ranges, fielddata for longer ranges
instance ToJSON RangeExecution where
  toJSON :: RangeExecution -> Value
toJSON RangeExecution
RangeExecutionIndex = Value
"index"
  toJSON RangeExecution
RangeExecutionFielddata = Value
"fielddata"

instance FromJSON RangeExecution where
  parseJSON :: Value -> Parser RangeExecution
parseJSON = String
-> (Text -> Parser RangeExecution)
-> Value
-> Parser RangeExecution
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RangeExecution" Text -> Parser RangeExecution
forall {a} {f :: * -> *}.
(Eq a, IsString a, Applicative f, Show a) =>
a -> f RangeExecution
parse
    where
      parse :: a -> f RangeExecution
parse a
"index" = RangeExecution -> f RangeExecution
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RangeExecution
RangeExecutionIndex
      parse a
"fielddata" = RangeExecution -> f RangeExecution
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RangeExecution
RangeExecutionFielddata
      parse a
t = String -> f RangeExecution
forall a. HasCallStack => String -> a
error (String
"Unrecognized RangeExecution " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
t)

data Term = Term
  { Term -> Key
termField :: Key,
    Term -> Text
termValue :: Text
  }
  deriving stock (Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
/= :: Term -> Term -> Bool
Eq, Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Term -> ShowS
showsPrec :: Int -> Term -> ShowS
$cshow :: Term -> String
show :: Term -> String
$cshowList :: [Term] -> ShowS
showList :: [Term] -> ShowS
Show, (forall x. Term -> Rep Term x)
-> (forall x. Rep Term x -> Term) -> Generic Term
forall x. Rep Term x -> Term
forall x. Term -> Rep Term x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Term -> Rep Term x
from :: forall x. Term -> Rep Term x
$cto :: forall x. Rep Term x -> Term
to :: forall x. Rep Term x -> Term
Generic)

instance ToJSON Term where
  toJSON :: Term -> Value
toJSON (Term Key
field Text
value) =
    [Pair] -> Value
object
      [ Key
"term"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [Key
field Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
value]
      ]

instance FromJSON Term where
  parseJSON :: Value -> Parser Term
parseJSON = String -> (Object -> Parser Term) -> Value -> Parser Term
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Term" Object -> Parser Term
parse
    where
      parse :: Object -> Parser Term
parse Object
o = do
        HashMap Key Value
termObj <- Object
o Object -> Key -> Parser (HashMap Key Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"term"
        case HashMap Key Value -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Key Value
termObj of
          [(Key
fn, Value
v)] -> Key -> Text -> Term
Term Key
fn (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          [Pair]
_ -> String -> Parser Term
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected object with 1 field-named key"

data BoolMatch
  = MustMatch Term Cache
  | MustNotMatch Term Cache
  | ShouldMatch [Term] Cache
  deriving stock (BoolMatch -> BoolMatch -> Bool
(BoolMatch -> BoolMatch -> Bool)
-> (BoolMatch -> BoolMatch -> Bool) -> Eq BoolMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoolMatch -> BoolMatch -> Bool
== :: BoolMatch -> BoolMatch -> Bool
$c/= :: BoolMatch -> BoolMatch -> Bool
/= :: BoolMatch -> BoolMatch -> Bool
Eq, Int -> BoolMatch -> ShowS
[BoolMatch] -> ShowS
BoolMatch -> String
(Int -> BoolMatch -> ShowS)
-> (BoolMatch -> String)
-> ([BoolMatch] -> ShowS)
-> Show BoolMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoolMatch -> ShowS
showsPrec :: Int -> BoolMatch -> ShowS
$cshow :: BoolMatch -> String
show :: BoolMatch -> String
$cshowList :: [BoolMatch] -> ShowS
showList :: [BoolMatch] -> ShowS
Show, (forall x. BoolMatch -> Rep BoolMatch x)
-> (forall x. Rep BoolMatch x -> BoolMatch) -> Generic BoolMatch
forall x. Rep BoolMatch x -> BoolMatch
forall x. BoolMatch -> Rep BoolMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoolMatch -> Rep BoolMatch x
from :: forall x. BoolMatch -> Rep BoolMatch x
$cto :: forall x. Rep BoolMatch x -> BoolMatch
to :: forall x. Rep BoolMatch x -> BoolMatch
Generic)

instance ToJSON BoolMatch where
  toJSON :: BoolMatch -> Value
toJSON (MustMatch Term
term Bool
cache) =
    [Pair] -> Value
object
      [ Key
"must" Key -> Term -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Term
term,
        Key
"_cache" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
cache
      ]
  toJSON (MustNotMatch Term
term Bool
cache) =
    [Pair] -> Value
object
      [ Key
"must_not" Key -> Term -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Term
term,
        Key
"_cache" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
cache
      ]
  toJSON (ShouldMatch [Term]
terms Bool
cache) =
    [Pair] -> Value
object
      [ Key
"should" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Term -> Value) -> [Term] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Value
forall a. ToJSON a => a -> Value
toJSON [Term]
terms,
        Key
"_cache" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
cache
      ]

instance FromJSON BoolMatch where
  parseJSON :: Value -> Parser BoolMatch
parseJSON = String -> (Object -> Parser BoolMatch) -> Value -> Parser BoolMatch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BoolMatch" Object -> Parser BoolMatch
parse
    where
      parse :: Object -> Parser BoolMatch
parse Object
o =
        Term -> Parser BoolMatch
mustMatch
          (Term -> Parser BoolMatch) -> Key -> Parser BoolMatch
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"must"
          Parser BoolMatch -> Parser BoolMatch -> Parser BoolMatch
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Term -> Parser BoolMatch
mustNotMatch
            (Term -> Parser BoolMatch) -> Key -> Parser BoolMatch
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"must_not"
          Parser BoolMatch -> Parser BoolMatch -> Parser BoolMatch
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Term] -> Parser BoolMatch
shouldMatch
            ([Term] -> Parser BoolMatch) -> Key -> Parser BoolMatch
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"should"
        where
          taggedWith :: (a -> Parser b) -> Key -> Parser b
taggedWith a -> Parser b
parser Key
k = a -> Parser b
parser (a -> Parser b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
          mustMatch :: Term -> Parser BoolMatch
mustMatch Term
t = Term -> Bool -> BoolMatch
MustMatch Term
t (Bool -> BoolMatch) -> Parser Bool -> Parser BoolMatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_cache" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
defaultCache
          mustNotMatch :: Term -> Parser BoolMatch
mustNotMatch Term
t = Term -> Bool -> BoolMatch
MustNotMatch Term
t (Bool -> BoolMatch) -> Parser Bool -> Parser BoolMatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_cache" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
defaultCache
          shouldMatch :: [Term] -> Parser BoolMatch
shouldMatch [Term]
t = [Term] -> Bool -> BoolMatch
ShouldMatch [Term]
t (Bool -> BoolMatch) -> Parser Bool -> Parser BoolMatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_cache" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
defaultCache

-- "memory" or "indexed"
data GeoFilterType
  = GeoFilterMemory
  | GeoFilterIndexed
  deriving stock (GeoFilterType -> GeoFilterType -> Bool
(GeoFilterType -> GeoFilterType -> Bool)
-> (GeoFilterType -> GeoFilterType -> Bool) -> Eq GeoFilterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeoFilterType -> GeoFilterType -> Bool
== :: GeoFilterType -> GeoFilterType -> Bool
$c/= :: GeoFilterType -> GeoFilterType -> Bool
/= :: GeoFilterType -> GeoFilterType -> Bool
Eq, Int -> GeoFilterType -> ShowS
[GeoFilterType] -> ShowS
GeoFilterType -> String
(Int -> GeoFilterType -> ShowS)
-> (GeoFilterType -> String)
-> ([GeoFilterType] -> ShowS)
-> Show GeoFilterType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeoFilterType -> ShowS
showsPrec :: Int -> GeoFilterType -> ShowS
$cshow :: GeoFilterType -> String
show :: GeoFilterType -> String
$cshowList :: [GeoFilterType] -> ShowS
showList :: [GeoFilterType] -> ShowS
Show, (forall x. GeoFilterType -> Rep GeoFilterType x)
-> (forall x. Rep GeoFilterType x -> GeoFilterType)
-> Generic GeoFilterType
forall x. Rep GeoFilterType x -> GeoFilterType
forall x. GeoFilterType -> Rep GeoFilterType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeoFilterType -> Rep GeoFilterType x
from :: forall x. GeoFilterType -> Rep GeoFilterType x
$cto :: forall x. Rep GeoFilterType x -> GeoFilterType
to :: forall x. Rep GeoFilterType x -> GeoFilterType
Generic)

instance ToJSON GeoFilterType where
  toJSON :: GeoFilterType -> Value
toJSON GeoFilterType
GeoFilterMemory = Text -> Value
String Text
"memory"
  toJSON GeoFilterType
GeoFilterIndexed = Text -> Value
String Text
"indexed"

instance FromJSON GeoFilterType where
  parseJSON :: Value -> Parser GeoFilterType
parseJSON = String
-> (Text -> Parser GeoFilterType) -> Value -> Parser GeoFilterType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"GeoFilterType" Text -> Parser GeoFilterType
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f GeoFilterType
parse
    where
      parse :: a -> f GeoFilterType
parse a
"memory" = GeoFilterType -> f GeoFilterType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GeoFilterType
GeoFilterMemory
      parse a
"indexed" = GeoFilterType -> f GeoFilterType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GeoFilterType
GeoFilterIndexed
      parse a
t = String -> f GeoFilterType
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unrecognized GeoFilterType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
t)

data LatLon = LatLon
  { LatLon -> Double
lat :: Double,
    LatLon -> Double
lon :: Double
  }
  deriving stock (LatLon -> LatLon -> Bool
(LatLon -> LatLon -> Bool)
-> (LatLon -> LatLon -> Bool) -> Eq LatLon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatLon -> LatLon -> Bool
== :: LatLon -> LatLon -> Bool
$c/= :: LatLon -> LatLon -> Bool
/= :: LatLon -> LatLon -> Bool
Eq, Int -> LatLon -> ShowS
[LatLon] -> ShowS
LatLon -> String
(Int -> LatLon -> ShowS)
-> (LatLon -> String) -> ([LatLon] -> ShowS) -> Show LatLon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LatLon -> ShowS
showsPrec :: Int -> LatLon -> ShowS
$cshow :: LatLon -> String
show :: LatLon -> String
$cshowList :: [LatLon] -> ShowS
showList :: [LatLon] -> ShowS
Show, (forall x. LatLon -> Rep LatLon x)
-> (forall x. Rep LatLon x -> LatLon) -> Generic LatLon
forall x. Rep LatLon x -> LatLon
forall x. LatLon -> Rep LatLon x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LatLon -> Rep LatLon x
from :: forall x. LatLon -> Rep LatLon x
$cto :: forall x. Rep LatLon x -> LatLon
to :: forall x. Rep LatLon x -> LatLon
Generic)

instance ToJSON LatLon where
  toJSON :: LatLon -> Value
toJSON (LatLon Double
lLat Double
lLon) =
    [Pair] -> Value
object
      [ Key
"lat" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
lLat,
        Key
"lon" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
lLon
      ]

instance FromJSON LatLon where
  parseJSON :: Value -> Parser LatLon
parseJSON = String -> (Object -> Parser LatLon) -> Value -> Parser LatLon
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LatLon" Object -> Parser LatLon
parse
    where
      parse :: Object -> Parser LatLon
parse Object
o =
        Double -> Double -> LatLon
LatLon
          (Double -> Double -> LatLon)
-> Parser Double -> Parser (Double -> LatLon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lat"
          Parser (Double -> LatLon) -> Parser Double -> Parser LatLon
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lon"

data GeoBoundingBox = GeoBoundingBox
  { GeoBoundingBox -> LatLon
topLeft :: LatLon,
    GeoBoundingBox -> LatLon
bottomRight :: LatLon
  }
  deriving stock (GeoBoundingBox -> GeoBoundingBox -> Bool
(GeoBoundingBox -> GeoBoundingBox -> Bool)
-> (GeoBoundingBox -> GeoBoundingBox -> Bool) -> Eq GeoBoundingBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeoBoundingBox -> GeoBoundingBox -> Bool
== :: GeoBoundingBox -> GeoBoundingBox -> Bool
$c/= :: GeoBoundingBox -> GeoBoundingBox -> Bool
/= :: GeoBoundingBox -> GeoBoundingBox -> Bool
Eq, Int -> GeoBoundingBox -> ShowS
[GeoBoundingBox] -> ShowS
GeoBoundingBox -> String
(Int -> GeoBoundingBox -> ShowS)
-> (GeoBoundingBox -> String)
-> ([GeoBoundingBox] -> ShowS)
-> Show GeoBoundingBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeoBoundingBox -> ShowS
showsPrec :: Int -> GeoBoundingBox -> ShowS
$cshow :: GeoBoundingBox -> String
show :: GeoBoundingBox -> String
$cshowList :: [GeoBoundingBox] -> ShowS
showList :: [GeoBoundingBox] -> ShowS
Show, (forall x. GeoBoundingBox -> Rep GeoBoundingBox x)
-> (forall x. Rep GeoBoundingBox x -> GeoBoundingBox)
-> Generic GeoBoundingBox
forall x. Rep GeoBoundingBox x -> GeoBoundingBox
forall x. GeoBoundingBox -> Rep GeoBoundingBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeoBoundingBox -> Rep GeoBoundingBox x
from :: forall x. GeoBoundingBox -> Rep GeoBoundingBox x
$cto :: forall x. Rep GeoBoundingBox x -> GeoBoundingBox
to :: forall x. Rep GeoBoundingBox x -> GeoBoundingBox
Generic)

instance ToJSON GeoBoundingBox where
  toJSON :: GeoBoundingBox -> Value
toJSON (GeoBoundingBox LatLon
gbbTopLeft LatLon
gbbBottomRight) =
    [Pair] -> Value
object
      [ Key
"top_left" Key -> LatLon -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LatLon
gbbTopLeft,
        Key
"bottom_right" Key -> LatLon -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LatLon
gbbBottomRight
      ]

instance FromJSON GeoBoundingBox where
  parseJSON :: Value -> Parser GeoBoundingBox
parseJSON = String
-> (Object -> Parser GeoBoundingBox)
-> Value
-> Parser GeoBoundingBox
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GeoBoundingBox" Object -> Parser GeoBoundingBox
parse
    where
      parse :: Object -> Parser GeoBoundingBox
parse Object
o =
        LatLon -> LatLon -> GeoBoundingBox
GeoBoundingBox
          (LatLon -> LatLon -> GeoBoundingBox)
-> Parser LatLon -> Parser (LatLon -> GeoBoundingBox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser LatLon
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"top_left"
          Parser (LatLon -> GeoBoundingBox)
-> Parser LatLon -> Parser GeoBoundingBox
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LatLon
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bottom_right"

data GeoBoundingBoxConstraint = GeoBoundingBoxConstraint
  { GeoBoundingBoxConstraint -> FieldName
geoBBField :: FieldName,
    GeoBoundingBoxConstraint -> GeoBoundingBox
constraintBox :: GeoBoundingBox,
    GeoBoundingBoxConstraint -> Bool
bbConstraintcache :: Cache,
    GeoBoundingBoxConstraint -> GeoFilterType
geoType :: GeoFilterType
  }
  deriving stock (GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool
(GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool)
-> (GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool)
-> Eq GeoBoundingBoxConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool
== :: GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool
$c/= :: GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool
/= :: GeoBoundingBoxConstraint -> GeoBoundingBoxConstraint -> Bool
Eq, Int -> GeoBoundingBoxConstraint -> ShowS
[GeoBoundingBoxConstraint] -> ShowS
GeoBoundingBoxConstraint -> String
(Int -> GeoBoundingBoxConstraint -> ShowS)
-> (GeoBoundingBoxConstraint -> String)
-> ([GeoBoundingBoxConstraint] -> ShowS)
-> Show GeoBoundingBoxConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeoBoundingBoxConstraint -> ShowS
showsPrec :: Int -> GeoBoundingBoxConstraint -> ShowS
$cshow :: GeoBoundingBoxConstraint -> String
show :: GeoBoundingBoxConstraint -> String
$cshowList :: [GeoBoundingBoxConstraint] -> ShowS
showList :: [GeoBoundingBoxConstraint] -> ShowS
Show, (forall x.
 GeoBoundingBoxConstraint -> Rep GeoBoundingBoxConstraint x)
-> (forall x.
    Rep GeoBoundingBoxConstraint x -> GeoBoundingBoxConstraint)
-> Generic GeoBoundingBoxConstraint
forall x.
Rep GeoBoundingBoxConstraint x -> GeoBoundingBoxConstraint
forall x.
GeoBoundingBoxConstraint -> Rep GeoBoundingBoxConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GeoBoundingBoxConstraint -> Rep GeoBoundingBoxConstraint x
from :: forall x.
GeoBoundingBoxConstraint -> Rep GeoBoundingBoxConstraint x
$cto :: forall x.
Rep GeoBoundingBoxConstraint x -> GeoBoundingBoxConstraint
to :: forall x.
Rep GeoBoundingBoxConstraint x -> GeoBoundingBoxConstraint
Generic)

instance ToJSON GeoBoundingBoxConstraint where
  toJSON :: GeoBoundingBoxConstraint -> Value
toJSON
    ( GeoBoundingBoxConstraint
        (FieldName Text
gbbcGeoBBField)
        GeoBoundingBox
gbbcConstraintBox
        Bool
cache
        GeoFilterType
type'
      ) =
      [Pair] -> Value
object
        [ Text -> Key
fromText Text
gbbcGeoBBField Key -> GeoBoundingBox -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GeoBoundingBox
gbbcConstraintBox,
          Key
"_cache" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
cache,
          Key
"type" Key -> GeoFilterType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GeoFilterType
type'
        ]

instance FromJSON GeoBoundingBoxConstraint where
  parseJSON :: Value -> Parser GeoBoundingBoxConstraint
parseJSON = String
-> (Object -> Parser GeoBoundingBoxConstraint)
-> Value
-> Parser GeoBoundingBoxConstraint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GeoBoundingBoxConstraint" Object -> Parser GeoBoundingBoxConstraint
parse
    where
      parse :: Object -> Parser GeoBoundingBoxConstraint
parse Object
o = case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList ([Key] -> Object -> Object
forall v. [Key] -> KeyMap v -> KeyMap v
deleteSeveral [Key
"type", Key
"_cache"] Object
o) of
        [(Key
fn, Value
v)] ->
          FieldName
-> GeoBoundingBox
-> Bool
-> GeoFilterType
-> GeoBoundingBoxConstraint
GeoBoundingBoxConstraint (Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
fn)
            (GeoBoundingBox
 -> Bool -> GeoFilterType -> GeoBoundingBoxConstraint)
-> Parser GeoBoundingBox
-> Parser (Bool -> GeoFilterType -> GeoBoundingBoxConstraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoBoundingBox
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Parser (Bool -> GeoFilterType -> GeoBoundingBoxConstraint)
-> Parser Bool
-> Parser (GeoFilterType -> GeoBoundingBoxConstraint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_cache" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
defaultCache
            Parser (GeoFilterType -> GeoBoundingBoxConstraint)
-> Parser GeoFilterType -> Parser GeoBoundingBoxConstraint
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser GeoFilterType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        [Pair]
_ -> String -> Parser GeoBoundingBoxConstraint
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not find field name for GeoBoundingBoxConstraint"

data GeoPoint = GeoPoint
  { GeoPoint -> FieldName
geoField :: FieldName,
    GeoPoint -> LatLon
latLon :: LatLon
  }
  deriving stock (GeoPoint -> GeoPoint -> Bool
(GeoPoint -> GeoPoint -> Bool)
-> (GeoPoint -> GeoPoint -> Bool) -> Eq GeoPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeoPoint -> GeoPoint -> Bool
== :: GeoPoint -> GeoPoint -> Bool
$c/= :: GeoPoint -> GeoPoint -> Bool
/= :: GeoPoint -> GeoPoint -> Bool
Eq, Int -> GeoPoint -> ShowS
[GeoPoint] -> ShowS
GeoPoint -> String
(Int -> GeoPoint -> ShowS)
-> (GeoPoint -> String) -> ([GeoPoint] -> ShowS) -> Show GeoPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeoPoint -> ShowS
showsPrec :: Int -> GeoPoint -> ShowS
$cshow :: GeoPoint -> String
show :: GeoPoint -> String
$cshowList :: [GeoPoint] -> ShowS
showList :: [GeoPoint] -> ShowS
Show, (forall x. GeoPoint -> Rep GeoPoint x)
-> (forall x. Rep GeoPoint x -> GeoPoint) -> Generic GeoPoint
forall x. Rep GeoPoint x -> GeoPoint
forall x. GeoPoint -> Rep GeoPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeoPoint -> Rep GeoPoint x
from :: forall x. GeoPoint -> Rep GeoPoint x
$cto :: forall x. Rep GeoPoint x -> GeoPoint
to :: forall x. Rep GeoPoint x -> GeoPoint
Generic)

instance ToJSON GeoPoint where
  toJSON :: GeoPoint -> Value
toJSON (GeoPoint (FieldName Text
geoPointField) LatLon
geoPointLatLon) =
    [Pair] -> Value
object [Text -> Key
fromText Text
geoPointField Key -> LatLon -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LatLon
geoPointLatLon]

data DistanceUnit
  = Miles
  | Yards
  | Feet
  | Inches
  | Kilometers
  | Meters
  | Centimeters
  | Millimeters
  | NauticalMiles
  deriving stock (DistanceUnit -> DistanceUnit -> Bool
(DistanceUnit -> DistanceUnit -> Bool)
-> (DistanceUnit -> DistanceUnit -> Bool) -> Eq DistanceUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistanceUnit -> DistanceUnit -> Bool
== :: DistanceUnit -> DistanceUnit -> Bool
$c/= :: DistanceUnit -> DistanceUnit -> Bool
/= :: DistanceUnit -> DistanceUnit -> Bool
Eq, Int -> DistanceUnit -> ShowS
[DistanceUnit] -> ShowS
DistanceUnit -> String
(Int -> DistanceUnit -> ShowS)
-> (DistanceUnit -> String)
-> ([DistanceUnit] -> ShowS)
-> Show DistanceUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistanceUnit -> ShowS
showsPrec :: Int -> DistanceUnit -> ShowS
$cshow :: DistanceUnit -> String
show :: DistanceUnit -> String
$cshowList :: [DistanceUnit] -> ShowS
showList :: [DistanceUnit] -> ShowS
Show, (forall x. DistanceUnit -> Rep DistanceUnit x)
-> (forall x. Rep DistanceUnit x -> DistanceUnit)
-> Generic DistanceUnit
forall x. Rep DistanceUnit x -> DistanceUnit
forall x. DistanceUnit -> Rep DistanceUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DistanceUnit -> Rep DistanceUnit x
from :: forall x. DistanceUnit -> Rep DistanceUnit x
$cto :: forall x. Rep DistanceUnit x -> DistanceUnit
to :: forall x. Rep DistanceUnit x -> DistanceUnit
Generic)

showDistanceUnit :: DistanceUnit -> Text
showDistanceUnit :: DistanceUnit -> Text
showDistanceUnit DistanceUnit
x =
  case DistanceUnit
x of
    DistanceUnit
Miles -> Text
"mi"
    DistanceUnit
Yards -> Text
"yd"
    DistanceUnit
Feet -> Text
"ft"
    DistanceUnit
Inches -> Text
"in"
    DistanceUnit
Kilometers -> Text
"km"
    DistanceUnit
Meters -> Text
"m"
    DistanceUnit
Centimeters -> Text
"cm"
    DistanceUnit
Millimeters -> Text
"mm"
    DistanceUnit
NauticalMiles -> Text
"nmi"

instance ToJSON DistanceUnit where
  toJSON :: DistanceUnit -> Value
toJSON = Text -> Value
String (Text -> Value) -> (DistanceUnit -> Text) -> DistanceUnit -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistanceUnit -> Text
showDistanceUnit

instance FromJSON DistanceUnit where
  parseJSON :: Value -> Parser DistanceUnit
parseJSON = String
-> (Text -> Parser DistanceUnit) -> Value -> Parser DistanceUnit
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DistanceUnit" Text -> Parser DistanceUnit
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f DistanceUnit
parse
    where
      parse :: a -> f DistanceUnit
parse a
"mi" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Miles
      parse a
"yd" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Yards
      parse a
"ft" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Feet
      parse a
"in" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Inches
      parse a
"km" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Kilometers
      parse a
"m" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Meters
      parse a
"cm" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Centimeters
      parse a
"mm" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
Millimeters
      parse a
"nmi" = DistanceUnit -> f DistanceUnit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceUnit
NauticalMiles
      parse a
u = String -> f DistanceUnit
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unrecognized DistanceUnit: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
u)

data DistanceType
  = Arc
  | SloppyArc -- doesn't exist <1.0
  | Plane
  deriving stock (DistanceType -> DistanceType -> Bool
(DistanceType -> DistanceType -> Bool)
-> (DistanceType -> DistanceType -> Bool) -> Eq DistanceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistanceType -> DistanceType -> Bool
== :: DistanceType -> DistanceType -> Bool
$c/= :: DistanceType -> DistanceType -> Bool
/= :: DistanceType -> DistanceType -> Bool
Eq, Int -> DistanceType -> ShowS
[DistanceType] -> ShowS
DistanceType -> String
(Int -> DistanceType -> ShowS)
-> (DistanceType -> String)
-> ([DistanceType] -> ShowS)
-> Show DistanceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistanceType -> ShowS
showsPrec :: Int -> DistanceType -> ShowS
$cshow :: DistanceType -> String
show :: DistanceType -> String
$cshowList :: [DistanceType] -> ShowS
showList :: [DistanceType] -> ShowS
Show, (forall x. DistanceType -> Rep DistanceType x)
-> (forall x. Rep DistanceType x -> DistanceType)
-> Generic DistanceType
forall x. Rep DistanceType x -> DistanceType
forall x. DistanceType -> Rep DistanceType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DistanceType -> Rep DistanceType x
from :: forall x. DistanceType -> Rep DistanceType x
$cto :: forall x. Rep DistanceType x -> DistanceType
to :: forall x. Rep DistanceType x -> DistanceType
Generic)

instance ToJSON DistanceType where
  toJSON :: DistanceType -> Value
toJSON DistanceType
Arc = Text -> Value
String Text
"arc"
  toJSON DistanceType
SloppyArc = Text -> Value
String Text
"sloppy_arc"
  toJSON DistanceType
Plane = Text -> Value
String Text
"plane"

instance FromJSON DistanceType where
  parseJSON :: Value -> Parser DistanceType
parseJSON = String
-> (Text -> Parser DistanceType) -> Value -> Parser DistanceType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DistanceType" Text -> Parser DistanceType
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f DistanceType
parse
    where
      parse :: a -> f DistanceType
parse a
"arc" = DistanceType -> f DistanceType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceType
Arc
      parse a
"sloppy_arc" = DistanceType -> f DistanceType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceType
SloppyArc
      parse a
"plane" = DistanceType -> f DistanceType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceType
Plane
      parse a
t = String -> f DistanceType
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unrecognized DistanceType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
t)

data OptimizeBbox
  = OptimizeGeoFilterType GeoFilterType
  | NoOptimizeBbox
  deriving stock (OptimizeBbox -> OptimizeBbox -> Bool
(OptimizeBbox -> OptimizeBbox -> Bool)
-> (OptimizeBbox -> OptimizeBbox -> Bool) -> Eq OptimizeBbox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimizeBbox -> OptimizeBbox -> Bool
== :: OptimizeBbox -> OptimizeBbox -> Bool
$c/= :: OptimizeBbox -> OptimizeBbox -> Bool
/= :: OptimizeBbox -> OptimizeBbox -> Bool
Eq, Int -> OptimizeBbox -> ShowS
[OptimizeBbox] -> ShowS
OptimizeBbox -> String
(Int -> OptimizeBbox -> ShowS)
-> (OptimizeBbox -> String)
-> ([OptimizeBbox] -> ShowS)
-> Show OptimizeBbox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptimizeBbox -> ShowS
showsPrec :: Int -> OptimizeBbox -> ShowS
$cshow :: OptimizeBbox -> String
show :: OptimizeBbox -> String
$cshowList :: [OptimizeBbox] -> ShowS
showList :: [OptimizeBbox] -> ShowS
Show, (forall x. OptimizeBbox -> Rep OptimizeBbox x)
-> (forall x. Rep OptimizeBbox x -> OptimizeBbox)
-> Generic OptimizeBbox
forall x. Rep OptimizeBbox x -> OptimizeBbox
forall x. OptimizeBbox -> Rep OptimizeBbox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OptimizeBbox -> Rep OptimizeBbox x
from :: forall x. OptimizeBbox -> Rep OptimizeBbox x
$cto :: forall x. Rep OptimizeBbox x -> OptimizeBbox
to :: forall x. Rep OptimizeBbox x -> OptimizeBbox
Generic)

instance ToJSON OptimizeBbox where
  toJSON :: OptimizeBbox -> Value
toJSON OptimizeBbox
NoOptimizeBbox = Text -> Value
String Text
"none"
  toJSON (OptimizeGeoFilterType GeoFilterType
gft) = GeoFilterType -> Value
forall a. ToJSON a => a -> Value
toJSON GeoFilterType
gft

instance FromJSON OptimizeBbox where
  parseJSON :: Value -> Parser OptimizeBbox
parseJSON Value
v =
    String
-> (Text -> Parser OptimizeBbox) -> Value -> Parser OptimizeBbox
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NoOptimizeBbox" Text -> Parser OptimizeBbox
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadPlus f) =>
a -> f OptimizeBbox
parseNoOptimize Value
v
      Parser OptimizeBbox -> Parser OptimizeBbox -> Parser OptimizeBbox
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser OptimizeBbox
parseOptimize Value
v
    where
      parseNoOptimize :: a -> f OptimizeBbox
parseNoOptimize a
"none" = OptimizeBbox -> f OptimizeBbox
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OptimizeBbox
NoOptimizeBbox
      parseNoOptimize a
_ = f OptimizeBbox
forall a. f a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      parseOptimize :: Value -> Parser OptimizeBbox
parseOptimize = (GeoFilterType -> OptimizeBbox)
-> Parser GeoFilterType -> Parser OptimizeBbox
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GeoFilterType -> OptimizeBbox
OptimizeGeoFilterType (Parser GeoFilterType -> Parser OptimizeBbox)
-> (Value -> Parser GeoFilterType) -> Value -> Parser OptimizeBbox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser GeoFilterType
forall a. FromJSON a => Value -> Parser a
parseJSON

data Distance = Distance
  { Distance -> Double
coefficient :: Double,
    Distance -> DistanceUnit
unit :: DistanceUnit
  }
  deriving stock (Distance -> Distance -> Bool
(Distance -> Distance -> Bool)
-> (Distance -> Distance -> Bool) -> Eq Distance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Distance -> Distance -> Bool
== :: Distance -> Distance -> Bool
$c/= :: Distance -> Distance -> Bool
/= :: Distance -> Distance -> Bool
Eq, Int -> Distance -> ShowS
[Distance] -> ShowS
Distance -> String
(Int -> Distance -> ShowS)
-> (Distance -> String) -> ([Distance] -> ShowS) -> Show Distance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Distance -> ShowS
showsPrec :: Int -> Distance -> ShowS
$cshow :: Distance -> String
show :: Distance -> String
$cshowList :: [Distance] -> ShowS
showList :: [Distance] -> ShowS
Show, (forall x. Distance -> Rep Distance x)
-> (forall x. Rep Distance x -> Distance) -> Generic Distance
forall x. Rep Distance x -> Distance
forall x. Distance -> Rep Distance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Distance -> Rep Distance x
from :: forall x. Distance -> Rep Distance x
$cto :: forall x. Rep Distance x -> Distance
to :: forall x. Rep Distance x -> Distance
Generic)

instance ToJSON Distance where
  toJSON :: Distance -> Value
toJSON (Distance Double
dCoefficient DistanceUnit
dUnit) =
    Text -> Value
String Text
boltedTogether
    where
      coefText :: Text
coefText = Double -> Text
forall a. Show a => a -> Text
showText Double
dCoefficient
      boltedTogether :: Text
boltedTogether = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
coefText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DistanceUnit -> Text
showDistanceUnit DistanceUnit
dUnit

instance FromJSON Distance where
  parseJSON :: Value -> Parser Distance
parseJSON = String -> (Text -> Parser Distance) -> Value -> Parser Distance
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Distance" Text -> Parser Distance
parse
    where
      parse :: Text -> Parser Distance
parse Text
t =
        Double -> DistanceUnit -> Distance
Distance
          (Double -> DistanceUnit -> Distance)
-> Parser Double -> Parser (DistanceUnit -> Distance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Double
forall {m :: * -> *} {a}. (MonadFail m, Read a) => Text -> m a
parseCoeff Text
nT
          Parser (DistanceUnit -> Distance)
-> Parser DistanceUnit -> Parser Distance
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser DistanceUnit
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
unitT)
        where
          (Text
nT, Text
unitT) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
validForNumber Text
t
          -- may be a better way to do this
          validForNumber :: Char -> Bool
validForNumber Char
'-' = Bool
True
          validForNumber Char
'.' = Bool
True
          validForNumber Char
'e' = Bool
True
          validForNumber Char
c = Char -> Bool
isNumber Char
c
          parseCoeff :: Text -> m a
parseCoeff Text
"" = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty string cannot be parsed as number"
          parseCoeff Text
s = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> a
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
s))

data DistanceRange = DistanceRange
  { DistanceRange -> Distance
distanceFrom :: Distance,
    DistanceRange -> Distance
distanceTo :: Distance
  }
  deriving stock (DistanceRange -> DistanceRange -> Bool
(DistanceRange -> DistanceRange -> Bool)
-> (DistanceRange -> DistanceRange -> Bool) -> Eq DistanceRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistanceRange -> DistanceRange -> Bool
== :: DistanceRange -> DistanceRange -> Bool
$c/= :: DistanceRange -> DistanceRange -> Bool
/= :: DistanceRange -> DistanceRange -> Bool
Eq, Int -> DistanceRange -> ShowS
[DistanceRange] -> ShowS
DistanceRange -> String
(Int -> DistanceRange -> ShowS)
-> (DistanceRange -> String)
-> ([DistanceRange] -> ShowS)
-> Show DistanceRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistanceRange -> ShowS
showsPrec :: Int -> DistanceRange -> ShowS
$cshow :: DistanceRange -> String
show :: DistanceRange -> String
$cshowList :: [DistanceRange] -> ShowS
showList :: [DistanceRange] -> ShowS
Show, (forall x. DistanceRange -> Rep DistanceRange x)
-> (forall x. Rep DistanceRange x -> DistanceRange)
-> Generic DistanceRange
forall x. Rep DistanceRange x -> DistanceRange
forall x. DistanceRange -> Rep DistanceRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DistanceRange -> Rep DistanceRange x
from :: forall x. DistanceRange -> Rep DistanceRange x
$cto :: forall x. Rep DistanceRange x -> DistanceRange
to :: forall x. Rep DistanceRange x -> DistanceRange
Generic)

type TemplateQueryValue = Text

newtype TemplateQueryKeyValuePairs
  = TemplateQueryKeyValuePairs (X.KeyMap TemplateQueryValue)
  deriving stock (TemplateQueryKeyValuePairs -> TemplateQueryKeyValuePairs -> Bool
(TemplateQueryKeyValuePairs -> TemplateQueryKeyValuePairs -> Bool)
-> (TemplateQueryKeyValuePairs
    -> TemplateQueryKeyValuePairs -> Bool)
-> Eq TemplateQueryKeyValuePairs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateQueryKeyValuePairs -> TemplateQueryKeyValuePairs -> Bool
== :: TemplateQueryKeyValuePairs -> TemplateQueryKeyValuePairs -> Bool
$c/= :: TemplateQueryKeyValuePairs -> TemplateQueryKeyValuePairs -> Bool
/= :: TemplateQueryKeyValuePairs -> TemplateQueryKeyValuePairs -> Bool
Eq, Int -> TemplateQueryKeyValuePairs -> ShowS
[TemplateQueryKeyValuePairs] -> ShowS
TemplateQueryKeyValuePairs -> String
(Int -> TemplateQueryKeyValuePairs -> ShowS)
-> (TemplateQueryKeyValuePairs -> String)
-> ([TemplateQueryKeyValuePairs] -> ShowS)
-> Show TemplateQueryKeyValuePairs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateQueryKeyValuePairs -> ShowS
showsPrec :: Int -> TemplateQueryKeyValuePairs -> ShowS
$cshow :: TemplateQueryKeyValuePairs -> String
show :: TemplateQueryKeyValuePairs -> String
$cshowList :: [TemplateQueryKeyValuePairs] -> ShowS
showList :: [TemplateQueryKeyValuePairs] -> ShowS
Show)

instance ToJSON TemplateQueryKeyValuePairs where
  toJSON :: TemplateQueryKeyValuePairs -> Value
toJSON (TemplateQueryKeyValuePairs KeyMap Text
x) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String (Text -> Value) -> KeyMap Text -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Text
x

instance FromJSON TemplateQueryKeyValuePairs where
  parseJSON :: Value -> Parser TemplateQueryKeyValuePairs
parseJSON (Object Object
o) =
    TemplateQueryKeyValuePairs -> Parser TemplateQueryKeyValuePairs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TemplateQueryKeyValuePairs -> Parser TemplateQueryKeyValuePairs)
-> (KeyMap Text -> TemplateQueryKeyValuePairs)
-> KeyMap Text
-> Parser TemplateQueryKeyValuePairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Text -> TemplateQueryKeyValuePairs
TemplateQueryKeyValuePairs (KeyMap Text -> Parser TemplateQueryKeyValuePairs)
-> KeyMap Text -> Parser TemplateQueryKeyValuePairs
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe Text) -> Object -> KeyMap Text
forall a b. (a -> Maybe b) -> KeyMap a -> KeyMap b
X.mapMaybe Value -> Maybe Text
getValue Object
o
    where
      getValue :: Value -> Maybe Text
getValue (String Text
x) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
      getValue Value
_ = Maybe Text
forall a. Maybe a
Nothing
  parseJSON Value
_ =
    String -> Parser TemplateQueryKeyValuePairs
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error parsing TemplateQueryKeyValuePairs"

-- | 'Cache' is for telling ES whether it should cache a 'Filter' not.
--   'Query's cannot be cached.
type Cache = Bool -- caching on/off

defaultCache :: Cache
defaultCache :: Bool
defaultCache = Bool
False

data FunctionScoreQuery = FunctionScoreQuery
  { FunctionScoreQuery -> Maybe Query
functionScoreQuery :: Maybe Query,
    FunctionScoreQuery -> Maybe Boost
functionScoreBoost :: Maybe Boost,
    FunctionScoreQuery -> FunctionScoreFunctions
functionScoreFunctions :: FunctionScoreFunctions,
    FunctionScoreQuery -> Maybe Boost
functionScoreMaxBoost :: Maybe Boost,
    FunctionScoreQuery -> Maybe BoostMode
functionScoreBoostMode :: Maybe BoostMode,
    FunctionScoreQuery -> Score
functionScoreMinScore :: Score,
    FunctionScoreQuery -> Maybe ScoreMode
functionScoreScoreMode :: Maybe ScoreMode
  }
  deriving stock (FunctionScoreQuery -> FunctionScoreQuery -> Bool
(FunctionScoreQuery -> FunctionScoreQuery -> Bool)
-> (FunctionScoreQuery -> FunctionScoreQuery -> Bool)
-> Eq FunctionScoreQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionScoreQuery -> FunctionScoreQuery -> Bool
== :: FunctionScoreQuery -> FunctionScoreQuery -> Bool
$c/= :: FunctionScoreQuery -> FunctionScoreQuery -> Bool
/= :: FunctionScoreQuery -> FunctionScoreQuery -> Bool
Eq, Int -> FunctionScoreQuery -> ShowS
[FunctionScoreQuery] -> ShowS
FunctionScoreQuery -> String
(Int -> FunctionScoreQuery -> ShowS)
-> (FunctionScoreQuery -> String)
-> ([FunctionScoreQuery] -> ShowS)
-> Show FunctionScoreQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionScoreQuery -> ShowS
showsPrec :: Int -> FunctionScoreQuery -> ShowS
$cshow :: FunctionScoreQuery -> String
show :: FunctionScoreQuery -> String
$cshowList :: [FunctionScoreQuery] -> ShowS
showList :: [FunctionScoreQuery] -> ShowS
Show, (forall x. FunctionScoreQuery -> Rep FunctionScoreQuery x)
-> (forall x. Rep FunctionScoreQuery x -> FunctionScoreQuery)
-> Generic FunctionScoreQuery
forall x. Rep FunctionScoreQuery x -> FunctionScoreQuery
forall x. FunctionScoreQuery -> Rep FunctionScoreQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionScoreQuery -> Rep FunctionScoreQuery x
from :: forall x. FunctionScoreQuery -> Rep FunctionScoreQuery x
$cto :: forall x. Rep FunctionScoreQuery x -> FunctionScoreQuery
to :: forall x. Rep FunctionScoreQuery x -> FunctionScoreQuery
Generic)

instance ToJSON FunctionScoreQuery where
  toJSON :: FunctionScoreQuery -> Value
toJSON (FunctionScoreQuery Maybe Query
query Maybe Boost
boost FunctionScoreFunctions
fns Maybe Boost
maxBoost Maybe BoostMode
boostMode Score
minScore Maybe ScoreMode
scoreMode) =
    [Pair] -> Value
omitNulls [Pair]
base
    where
      base :: [Pair]
base =
        FunctionScoreFunctions -> Pair
functionScoreFunctionsPair FunctionScoreFunctions
fns
          Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [ Key
"query" Key -> Maybe Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Query
query,
              Key
"boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
boost,
              Key
"max_boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
maxBoost,
              Key
"boost_mode" Key -> Maybe BoostMode -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe BoostMode
boostMode,
              Key
"min_score" Key -> Score -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Score
minScore,
              Key
"score_mode" Key -> Maybe ScoreMode -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ScoreMode
scoreMode
            ]

instance FromJSON FunctionScoreQuery where
  parseJSON :: Value -> Parser FunctionScoreQuery
parseJSON = String
-> (Object -> Parser FunctionScoreQuery)
-> Value
-> Parser FunctionScoreQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FunctionScoreQuery" Object -> Parser FunctionScoreQuery
parse
    where
      parse :: Object -> Parser FunctionScoreQuery
parse Object
o =
        Maybe Query
-> Maybe Boost
-> FunctionScoreFunctions
-> Maybe Boost
-> Maybe BoostMode
-> Score
-> Maybe ScoreMode
-> FunctionScoreQuery
FunctionScoreQuery
          (Maybe Query
 -> Maybe Boost
 -> FunctionScoreFunctions
 -> Maybe Boost
 -> Maybe BoostMode
 -> Score
 -> Maybe ScoreMode
 -> FunctionScoreQuery)
-> Parser (Maybe Query)
-> Parser
     (Maybe Boost
      -> FunctionScoreFunctions
      -> Maybe Boost
      -> Maybe BoostMode
      -> Score
      -> Maybe ScoreMode
      -> FunctionScoreQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query"
          Parser
  (Maybe Boost
   -> FunctionScoreFunctions
   -> Maybe Boost
   -> Maybe BoostMode
   -> Score
   -> Maybe ScoreMode
   -> FunctionScoreQuery)
-> Parser (Maybe Boost)
-> Parser
     (FunctionScoreFunctions
      -> Maybe Boost
      -> Maybe BoostMode
      -> Score
      -> Maybe ScoreMode
      -> FunctionScoreQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"
          Parser
  (FunctionScoreFunctions
   -> Maybe Boost
   -> Maybe BoostMode
   -> Score
   -> Maybe ScoreMode
   -> FunctionScoreQuery)
-> Parser FunctionScoreFunctions
-> Parser
     (Maybe Boost
      -> Maybe BoostMode
      -> Score
      -> Maybe ScoreMode
      -> FunctionScoreQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object -> Parser FunctionScoreFunctions
singleFunction Object
o
                  Parser FunctionScoreFunctions
-> Parser FunctionScoreFunctions -> Parser FunctionScoreFunctions
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NonEmpty ComponentFunctionScoreFunction
-> Parser FunctionScoreFunctions
multipleFunctions
                    (NonEmpty ComponentFunctionScoreFunction
 -> Parser FunctionScoreFunctions)
-> Key -> Parser FunctionScoreFunctions
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"functions"
              )
          Parser
  (Maybe Boost
   -> Maybe BoostMode
   -> Score
   -> Maybe ScoreMode
   -> FunctionScoreQuery)
-> Parser (Maybe Boost)
-> Parser
     (Maybe BoostMode -> Score -> Maybe ScoreMode -> FunctionScoreQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_boost"
          Parser
  (Maybe BoostMode -> Score -> Maybe ScoreMode -> FunctionScoreQuery)
-> Parser (Maybe BoostMode)
-> Parser (Score -> Maybe ScoreMode -> FunctionScoreQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe BoostMode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost_mode"
          Parser (Score -> Maybe ScoreMode -> FunctionScoreQuery)
-> Parser Score -> Parser (Maybe ScoreMode -> FunctionScoreQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Score
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_score"
          Parser (Maybe ScoreMode -> FunctionScoreQuery)
-> Parser (Maybe ScoreMode) -> Parser FunctionScoreQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ScoreMode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"score_mode"
        where
          taggedWith :: (a -> Parser b) -> Key -> Parser b
taggedWith a -> Parser b
parser Key
k = a -> Parser b
parser (a -> Parser b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
      singleFunction :: Object -> Parser FunctionScoreFunctions
singleFunction = (FunctionScoreFunction -> FunctionScoreFunctions)
-> Parser FunctionScoreFunction -> Parser FunctionScoreFunctions
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunctionScoreFunction -> FunctionScoreFunctions
FunctionScoreSingle (Parser FunctionScoreFunction -> Parser FunctionScoreFunctions)
-> (Object -> Parser FunctionScoreFunction)
-> Object
-> Parser FunctionScoreFunctions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Parser FunctionScoreFunction
parseFunctionScoreFunction
      multipleFunctions :: NonEmpty ComponentFunctionScoreFunction
-> Parser FunctionScoreFunctions
multipleFunctions = FunctionScoreFunctions -> Parser FunctionScoreFunctions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionScoreFunctions -> Parser FunctionScoreFunctions)
-> (NonEmpty ComponentFunctionScoreFunction
    -> FunctionScoreFunctions)
-> NonEmpty ComponentFunctionScoreFunction
-> Parser FunctionScoreFunctions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ComponentFunctionScoreFunction -> FunctionScoreFunctions
FunctionScoreMultiple

data FunctionScoreFunctions
  = FunctionScoreSingle FunctionScoreFunction
  | FunctionScoreMultiple (NonEmpty ComponentFunctionScoreFunction)
  deriving stock (FunctionScoreFunctions -> FunctionScoreFunctions -> Bool
(FunctionScoreFunctions -> FunctionScoreFunctions -> Bool)
-> (FunctionScoreFunctions -> FunctionScoreFunctions -> Bool)
-> Eq FunctionScoreFunctions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionScoreFunctions -> FunctionScoreFunctions -> Bool
== :: FunctionScoreFunctions -> FunctionScoreFunctions -> Bool
$c/= :: FunctionScoreFunctions -> FunctionScoreFunctions -> Bool
/= :: FunctionScoreFunctions -> FunctionScoreFunctions -> Bool
Eq, Int -> FunctionScoreFunctions -> ShowS
[FunctionScoreFunctions] -> ShowS
FunctionScoreFunctions -> String
(Int -> FunctionScoreFunctions -> ShowS)
-> (FunctionScoreFunctions -> String)
-> ([FunctionScoreFunctions] -> ShowS)
-> Show FunctionScoreFunctions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionScoreFunctions -> ShowS
showsPrec :: Int -> FunctionScoreFunctions -> ShowS
$cshow :: FunctionScoreFunctions -> String
show :: FunctionScoreFunctions -> String
$cshowList :: [FunctionScoreFunctions] -> ShowS
showList :: [FunctionScoreFunctions] -> ShowS
Show, (forall x. FunctionScoreFunctions -> Rep FunctionScoreFunctions x)
-> (forall x.
    Rep FunctionScoreFunctions x -> FunctionScoreFunctions)
-> Generic FunctionScoreFunctions
forall x. Rep FunctionScoreFunctions x -> FunctionScoreFunctions
forall x. FunctionScoreFunctions -> Rep FunctionScoreFunctions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionScoreFunctions -> Rep FunctionScoreFunctions x
from :: forall x. FunctionScoreFunctions -> Rep FunctionScoreFunctions x
$cto :: forall x. Rep FunctionScoreFunctions x -> FunctionScoreFunctions
to :: forall x. Rep FunctionScoreFunctions x -> FunctionScoreFunctions
Generic)

data ComponentFunctionScoreFunction = ComponentFunctionScoreFunction
  { ComponentFunctionScoreFunction -> Maybe Filter
componentScoreFunctionFilter :: Maybe Filter,
    ComponentFunctionScoreFunction -> FunctionScoreFunction
componentScoreFunction :: FunctionScoreFunction,
    ComponentFunctionScoreFunction -> Maybe Weight
componentScoreFunctionWeight :: Maybe Weight
  }
  deriving stock (ComponentFunctionScoreFunction
-> ComponentFunctionScoreFunction -> Bool
(ComponentFunctionScoreFunction
 -> ComponentFunctionScoreFunction -> Bool)
-> (ComponentFunctionScoreFunction
    -> ComponentFunctionScoreFunction -> Bool)
-> Eq ComponentFunctionScoreFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentFunctionScoreFunction
-> ComponentFunctionScoreFunction -> Bool
== :: ComponentFunctionScoreFunction
-> ComponentFunctionScoreFunction -> Bool
$c/= :: ComponentFunctionScoreFunction
-> ComponentFunctionScoreFunction -> Bool
/= :: ComponentFunctionScoreFunction
-> ComponentFunctionScoreFunction -> Bool
Eq, Int -> ComponentFunctionScoreFunction -> ShowS
[ComponentFunctionScoreFunction] -> ShowS
ComponentFunctionScoreFunction -> String
(Int -> ComponentFunctionScoreFunction -> ShowS)
-> (ComponentFunctionScoreFunction -> String)
-> ([ComponentFunctionScoreFunction] -> ShowS)
-> Show ComponentFunctionScoreFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentFunctionScoreFunction -> ShowS
showsPrec :: Int -> ComponentFunctionScoreFunction -> ShowS
$cshow :: ComponentFunctionScoreFunction -> String
show :: ComponentFunctionScoreFunction -> String
$cshowList :: [ComponentFunctionScoreFunction] -> ShowS
showList :: [ComponentFunctionScoreFunction] -> ShowS
Show, (forall x.
 ComponentFunctionScoreFunction
 -> Rep ComponentFunctionScoreFunction x)
-> (forall x.
    Rep ComponentFunctionScoreFunction x
    -> ComponentFunctionScoreFunction)
-> Generic ComponentFunctionScoreFunction
forall x.
Rep ComponentFunctionScoreFunction x
-> ComponentFunctionScoreFunction
forall x.
ComponentFunctionScoreFunction
-> Rep ComponentFunctionScoreFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ComponentFunctionScoreFunction
-> Rep ComponentFunctionScoreFunction x
from :: forall x.
ComponentFunctionScoreFunction
-> Rep ComponentFunctionScoreFunction x
$cto :: forall x.
Rep ComponentFunctionScoreFunction x
-> ComponentFunctionScoreFunction
to :: forall x.
Rep ComponentFunctionScoreFunction x
-> ComponentFunctionScoreFunction
Generic)

instance ToJSON ComponentFunctionScoreFunction where
  toJSON :: ComponentFunctionScoreFunction -> Value
toJSON (ComponentFunctionScoreFunction Maybe Filter
filter' FunctionScoreFunction
fn Maybe Weight
weight) =
    [Pair] -> Value
omitNulls [Pair]
base
    where
      base :: [Pair]
base =
        FunctionScoreFunction -> Pair
functionScoreFunctionPair FunctionScoreFunction
fn
          Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [ Key
"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
filter',
              Key
"weight" Key -> Maybe Weight -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Weight
weight
            ]

instance FromJSON ComponentFunctionScoreFunction where
  parseJSON :: Value -> Parser ComponentFunctionScoreFunction
parseJSON = String
-> (Object -> Parser ComponentFunctionScoreFunction)
-> Value
-> Parser ComponentFunctionScoreFunction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ComponentFunctionScoreFunction" Object -> Parser ComponentFunctionScoreFunction
parse
    where
      parse :: Object -> Parser ComponentFunctionScoreFunction
parse Object
o =
        Maybe Filter
-> FunctionScoreFunction
-> Maybe Weight
-> ComponentFunctionScoreFunction
ComponentFunctionScoreFunction
          (Maybe Filter
 -> FunctionScoreFunction
 -> Maybe Weight
 -> ComponentFunctionScoreFunction)
-> Parser (Maybe Filter)
-> Parser
     (FunctionScoreFunction
      -> Maybe Weight -> ComponentFunctionScoreFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Filter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter"
          Parser
  (FunctionScoreFunction
   -> Maybe Weight -> ComponentFunctionScoreFunction)
-> Parser FunctionScoreFunction
-> Parser (Maybe Weight -> ComponentFunctionScoreFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser FunctionScoreFunction
parseFunctionScoreFunction Object
o
          Parser (Maybe Weight -> ComponentFunctionScoreFunction)
-> Parser (Maybe Weight) -> Parser ComponentFunctionScoreFunction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Weight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"weight"

functionScoreFunctionsPair :: FunctionScoreFunctions -> (Key, Value)
functionScoreFunctionsPair :: FunctionScoreFunctions -> Pair
functionScoreFunctionsPair (FunctionScoreSingle FunctionScoreFunction
fn) =
  FunctionScoreFunction -> Pair
functionScoreFunctionPair FunctionScoreFunction
fn
functionScoreFunctionsPair (FunctionScoreMultiple NonEmpty ComponentFunctionScoreFunction
componentFns) =
  (Key
"functions", NonEmpty ComponentFunctionScoreFunction -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty ComponentFunctionScoreFunction
componentFns)

data InnerHits = InnerHits
  { InnerHits -> Maybe Integer
innerHitsFrom :: Maybe Integer,
    InnerHits -> Maybe Integer
innerHitsSize :: Maybe Integer
  }
  deriving stock (InnerHits -> InnerHits -> Bool
(InnerHits -> InnerHits -> Bool)
-> (InnerHits -> InnerHits -> Bool) -> Eq InnerHits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InnerHits -> InnerHits -> Bool
== :: InnerHits -> InnerHits -> Bool
$c/= :: InnerHits -> InnerHits -> Bool
/= :: InnerHits -> InnerHits -> Bool
Eq, Int -> InnerHits -> ShowS
[InnerHits] -> ShowS
InnerHits -> String
(Int -> InnerHits -> ShowS)
-> (InnerHits -> String)
-> ([InnerHits] -> ShowS)
-> Show InnerHits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InnerHits -> ShowS
showsPrec :: Int -> InnerHits -> ShowS
$cshow :: InnerHits -> String
show :: InnerHits -> String
$cshowList :: [InnerHits] -> ShowS
showList :: [InnerHits] -> ShowS
Show, (forall x. InnerHits -> Rep InnerHits x)
-> (forall x. Rep InnerHits x -> InnerHits) -> Generic InnerHits
forall x. Rep InnerHits x -> InnerHits
forall x. InnerHits -> Rep InnerHits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InnerHits -> Rep InnerHits x
from :: forall x. InnerHits -> Rep InnerHits x
$cto :: forall x. Rep InnerHits x -> InnerHits
to :: forall x. Rep InnerHits x -> InnerHits
Generic)

instance ToJSON InnerHits where
  toJSON :: InnerHits -> Value
toJSON (InnerHits Maybe Integer
ihFrom Maybe Integer
ihSize) =
    [Pair] -> Value
omitNulls
      [ Key
"from" Key -> Maybe Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
ihFrom,
        Key
"size" Key -> Maybe Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
ihSize
      ]

instance FromJSON InnerHits where
  parseJSON :: Value -> Parser InnerHits
parseJSON = String -> (Object -> Parser InnerHits) -> Value -> Parser InnerHits
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InnerHits" Object -> Parser InnerHits
parse
    where
      parse :: Object -> Parser InnerHits
parse Object
o =
        Maybe Integer -> Maybe Integer -> InnerHits
InnerHits
          (Maybe Integer -> Maybe Integer -> InnerHits)
-> Parser (Maybe Integer) -> Parser (Maybe Integer -> InnerHits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"from"
          Parser (Maybe Integer -> InnerHits)
-> Parser (Maybe Integer) -> Parser InnerHits
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size"