{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Search
  ( Exclude (..),
    ExpandWildcards (..),
    GetTemplateScript (..),
    Include (..),
    Pattern (..),
    PatternOrPatterns (..),
    ScrollId (..),
    Search (..),
    SearchResult (..),
    SearchTemplate (..),
    SearchTemplateId (..),
    SearchTemplateSource (..),
    SearchType (..),
    Source (..),
    TimeUnits (..),
    TrackSortScores,
    unpackId,

    -- * Optics
    tookLens,
    timedOutLens,
    shardsLens,
    searchHitsLens,
    aggregationsLens,
    scrollIdLens,
    suggestLens,
    pitIdLens,
    getTemplateScriptLangLens,
    getTemplateScriptSourceLens,
    getTemplateScriptOptionsLens,
    getTemplateScriptIdLens,
    getTemplateScriptFoundLens,
  )
where

import qualified Data.HashMap.Strict as HM
import Database.Bloodhound.Client.Cluster
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Aggregation
import Database.Bloodhound.Internal.Versions.Common.Types.Highlight
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.PointInTime
import Database.Bloodhound.Internal.Versions.Common.Types.Query
import Database.Bloodhound.Internal.Versions.Common.Types.Sort
import Database.Bloodhound.Internal.Versions.Common.Types.Suggest

-- | 'unpackId' is a silly convenience function that gets used once.
unpackId :: DocId -> Text
unpackId :: DocId -> Text
unpackId (DocId Text
docId) = Text
docId

type TrackSortScores = Bool

data Search = Search
  { Search -> Maybe Query
queryBody :: Maybe Query,
    Search -> Maybe Filter
filterBody :: Maybe Filter,
    Search -> Maybe Sort
sortBody :: Maybe Sort,
    Search -> Maybe Aggregations
aggBody :: Maybe Aggregations,
    Search -> Maybe Highlights
highlight :: Maybe Highlights,
    -- default False
    Search -> TrackSortScores
trackSortScores :: TrackSortScores,
    Search -> From
from :: From,
    Search -> Size
size :: Size,
    Search -> SearchType
searchType :: SearchType,
    Search -> Maybe SearchAfterKey
searchAfterKey :: Maybe SearchAfterKey,
    Search -> Maybe [FieldName]
fields :: Maybe [FieldName],
    Search -> Maybe ScriptFields
scriptFields :: Maybe ScriptFields,
    Search -> Maybe Source
source :: Maybe Source,
    -- | Only one Suggestion request / response per Search is supported.
    Search -> Maybe Suggest
suggestBody :: Maybe Suggest,
    Search -> Maybe PointInTime
pointInTime :: Maybe PointInTime
  }
  deriving stock (Search -> Search -> TrackSortScores
(Search -> Search -> TrackSortScores)
-> (Search -> Search -> TrackSortScores) -> Eq Search
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: Search -> Search -> TrackSortScores
== :: Search -> Search -> TrackSortScores
$c/= :: Search -> Search -> TrackSortScores
/= :: Search -> Search -> TrackSortScores
Eq, Int -> Search -> ShowS
[Search] -> ShowS
Search -> String
(Int -> Search -> ShowS)
-> (Search -> String) -> ([Search] -> ShowS) -> Show Search
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Search -> ShowS
showsPrec :: Int -> Search -> ShowS
$cshow :: Search -> String
show :: Search -> String
$cshowList :: [Search] -> ShowS
showList :: [Search] -> ShowS
Show)

instance ToJSON Search where
  toJSON :: Search -> Value
toJSON
    ( Search
        Maybe Query
mquery
        Maybe Filter
sFilter
        Maybe Sort
sort
        Maybe Aggregations
searchAggs
        Maybe Highlights
highlight
        TrackSortScores
sTrackSortScores
        From
sFrom
        Size
sSize
        SearchType
_
        Maybe SearchAfterKey
sAfter
        Maybe [FieldName]
sFields
        Maybe ScriptFields
sScriptFields
        Maybe Source
sSource
        Maybe Suggest
sSuggest
        Maybe PointInTime
pPointInTime
      ) =
      [(Key, Value)] -> Value
omitNulls
        [ Key
"query" Key -> Maybe Query -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Query
query',
          Key
"sort" Key -> Maybe Sort -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Sort
sort,
          Key
"aggregations" Key -> Maybe Aggregations -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Aggregations
searchAggs,
          Key
"highlight" Key -> Maybe Highlights -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Highlights
highlight,
          Key
"from" Key -> From -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= From
sFrom,
          Key
"size" Key -> Size -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Size
sSize,
          Key
"track_scores" Key -> TrackSortScores -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TrackSortScores
sTrackSortScores,
          Key
"search_after" Key -> Maybe SearchAfterKey -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe SearchAfterKey
sAfter,
          Key
"fields" Key -> Maybe [FieldName] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe [FieldName]
sFields,
          Key
"script_fields" Key -> Maybe ScriptFields -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ScriptFields
sScriptFields,
          Key
"_source" Key -> Maybe Source -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Source
sSource,
          Key
"suggest" Key -> Maybe Suggest -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Suggest
sSuggest,
          Key
"pit" Key -> Maybe PointInTime -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe PointInTime
pPointInTime
        ]
      where
        query' :: Maybe Query
query' = case Maybe Filter
sFilter of
          Maybe Filter
Nothing -> Maybe Query
mquery
          Just Filter
x ->
            Query -> Maybe Query
forall a. a -> Maybe a
Just
              (Query -> Maybe Query)
-> (BoolQuery -> Query) -> BoolQuery -> Maybe Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolQuery -> Query
QueryBoolQuery
              (BoolQuery -> Maybe Query) -> BoolQuery -> Maybe Query
forall a b. (a -> b) -> a -> b
$ [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
mkBoolQuery
                (Maybe Query -> [Query]
forall a. Maybe a -> [a]
maybeToList Maybe Query
mquery)
                [Filter
x]
                []
                []

data SearchType
  = SearchTypeQueryThenFetch
  | SearchTypeDfsQueryThenFetch
  deriving stock (SearchType -> SearchType -> TrackSortScores
(SearchType -> SearchType -> TrackSortScores)
-> (SearchType -> SearchType -> TrackSortScores) -> Eq SearchType
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: SearchType -> SearchType -> TrackSortScores
== :: SearchType -> SearchType -> TrackSortScores
$c/= :: SearchType -> SearchType -> TrackSortScores
/= :: SearchType -> SearchType -> TrackSortScores
Eq, Int -> SearchType -> ShowS
[SearchType] -> ShowS
SearchType -> String
(Int -> SearchType -> ShowS)
-> (SearchType -> String)
-> ([SearchType] -> ShowS)
-> Show SearchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchType -> ShowS
showsPrec :: Int -> SearchType -> ShowS
$cshow :: SearchType -> String
show :: SearchType -> String
$cshowList :: [SearchType] -> ShowS
showList :: [SearchType] -> ShowS
Show)

instance ToJSON SearchType where
  toJSON :: SearchType -> Value
toJSON SearchType
SearchTypeQueryThenFetch = Text -> Value
String Text
"query_then_fetch"
  toJSON SearchType
SearchTypeDfsQueryThenFetch = Text -> Value
String Text
"dfs_query_then_fetch"

instance FromJSON SearchType where
  parseJSON :: Value -> Parser SearchType
parseJSON (String Text
"query_then_fetch") = SearchType -> Parser SearchType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchType -> Parser SearchType)
-> SearchType -> Parser SearchType
forall a b. (a -> b) -> a -> b
$ SearchType
SearchTypeQueryThenFetch
  parseJSON (String Text
"dfs_query_then_fetch") = SearchType -> Parser SearchType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchType -> Parser SearchType)
-> SearchType -> Parser SearchType
forall a b. (a -> b) -> a -> b
$ SearchType
SearchTypeDfsQueryThenFetch
  parseJSON Value
_ = Parser SearchType
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

data Source
  = NoSource
  | SourcePatterns PatternOrPatterns
  | SourceIncludeExclude Include Exclude
  deriving stock (Source -> Source -> TrackSortScores
(Source -> Source -> TrackSortScores)
-> (Source -> Source -> TrackSortScores) -> Eq Source
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: Source -> Source -> TrackSortScores
== :: Source -> Source -> TrackSortScores
$c/= :: Source -> Source -> TrackSortScores
/= :: Source -> Source -> TrackSortScores
Eq, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Source -> ShowS
showsPrec :: Int -> Source -> ShowS
$cshow :: Source -> String
show :: Source -> String
$cshowList :: [Source] -> ShowS
showList :: [Source] -> ShowS
Show)

instance ToJSON Source where
  toJSON :: Source -> Value
toJSON Source
NoSource = TrackSortScores -> Value
forall a. ToJSON a => a -> Value
toJSON TrackSortScores
False
  toJSON (SourcePatterns PatternOrPatterns
patterns) = PatternOrPatterns -> Value
forall a. ToJSON a => a -> Value
toJSON PatternOrPatterns
patterns
  toJSON (SourceIncludeExclude Include
incl Exclude
excl) = [(Key, Value)] -> Value
object [Key
"includes" Key -> Include -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Include
incl, Key
"excludes" Key -> Exclude -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Exclude
excl]

data PatternOrPatterns
  = PopPattern Pattern
  | PopPatterns [Pattern]
  deriving stock (PatternOrPatterns -> PatternOrPatterns -> TrackSortScores
(PatternOrPatterns -> PatternOrPatterns -> TrackSortScores)
-> (PatternOrPatterns -> PatternOrPatterns -> TrackSortScores)
-> Eq PatternOrPatterns
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: PatternOrPatterns -> PatternOrPatterns -> TrackSortScores
== :: PatternOrPatterns -> PatternOrPatterns -> TrackSortScores
$c/= :: PatternOrPatterns -> PatternOrPatterns -> TrackSortScores
/= :: PatternOrPatterns -> PatternOrPatterns -> TrackSortScores
Eq, ReadPrec [PatternOrPatterns]
ReadPrec PatternOrPatterns
Int -> ReadS PatternOrPatterns
ReadS [PatternOrPatterns]
(Int -> ReadS PatternOrPatterns)
-> ReadS [PatternOrPatterns]
-> ReadPrec PatternOrPatterns
-> ReadPrec [PatternOrPatterns]
-> Read PatternOrPatterns
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PatternOrPatterns
readsPrec :: Int -> ReadS PatternOrPatterns
$creadList :: ReadS [PatternOrPatterns]
readList :: ReadS [PatternOrPatterns]
$creadPrec :: ReadPrec PatternOrPatterns
readPrec :: ReadPrec PatternOrPatterns
$creadListPrec :: ReadPrec [PatternOrPatterns]
readListPrec :: ReadPrec [PatternOrPatterns]
Read, Int -> PatternOrPatterns -> ShowS
[PatternOrPatterns] -> ShowS
PatternOrPatterns -> String
(Int -> PatternOrPatterns -> ShowS)
-> (PatternOrPatterns -> String)
-> ([PatternOrPatterns] -> ShowS)
-> Show PatternOrPatterns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatternOrPatterns -> ShowS
showsPrec :: Int -> PatternOrPatterns -> ShowS
$cshow :: PatternOrPatterns -> String
show :: PatternOrPatterns -> String
$cshowList :: [PatternOrPatterns] -> ShowS
showList :: [PatternOrPatterns] -> ShowS
Show)

instance ToJSON PatternOrPatterns where
  toJSON :: PatternOrPatterns -> Value
toJSON (PopPattern Pattern
pattern) = Pattern -> Value
forall a. ToJSON a => a -> Value
toJSON Pattern
pattern
  toJSON (PopPatterns [Pattern]
patterns) = [Pattern] -> Value
forall a. ToJSON a => a -> Value
toJSON [Pattern]
patterns

data Include = Include [Pattern] deriving stock (Include -> Include -> TrackSortScores
(Include -> Include -> TrackSortScores)
-> (Include -> Include -> TrackSortScores) -> Eq Include
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: Include -> Include -> TrackSortScores
== :: Include -> Include -> TrackSortScores
$c/= :: Include -> Include -> TrackSortScores
/= :: Include -> Include -> TrackSortScores
Eq, ReadPrec [Include]
ReadPrec Include
Int -> ReadS Include
ReadS [Include]
(Int -> ReadS Include)
-> ReadS [Include]
-> ReadPrec Include
-> ReadPrec [Include]
-> Read Include
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Include
readsPrec :: Int -> ReadS Include
$creadList :: ReadS [Include]
readList :: ReadS [Include]
$creadPrec :: ReadPrec Include
readPrec :: ReadPrec Include
$creadListPrec :: ReadPrec [Include]
readListPrec :: ReadPrec [Include]
Read, Int -> Include -> ShowS
[Include] -> ShowS
Include -> String
(Int -> Include -> ShowS)
-> (Include -> String) -> ([Include] -> ShowS) -> Show Include
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Include -> ShowS
showsPrec :: Int -> Include -> ShowS
$cshow :: Include -> String
show :: Include -> String
$cshowList :: [Include] -> ShowS
showList :: [Include] -> ShowS
Show)

data Exclude = Exclude [Pattern] deriving stock (Exclude -> Exclude -> TrackSortScores
(Exclude -> Exclude -> TrackSortScores)
-> (Exclude -> Exclude -> TrackSortScores) -> Eq Exclude
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: Exclude -> Exclude -> TrackSortScores
== :: Exclude -> Exclude -> TrackSortScores
$c/= :: Exclude -> Exclude -> TrackSortScores
/= :: Exclude -> Exclude -> TrackSortScores
Eq, ReadPrec [Exclude]
ReadPrec Exclude
Int -> ReadS Exclude
ReadS [Exclude]
(Int -> ReadS Exclude)
-> ReadS [Exclude]
-> ReadPrec Exclude
-> ReadPrec [Exclude]
-> Read Exclude
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Exclude
readsPrec :: Int -> ReadS Exclude
$creadList :: ReadS [Exclude]
readList :: ReadS [Exclude]
$creadPrec :: ReadPrec Exclude
readPrec :: ReadPrec Exclude
$creadListPrec :: ReadPrec [Exclude]
readListPrec :: ReadPrec [Exclude]
Read, Int -> Exclude -> ShowS
[Exclude] -> ShowS
Exclude -> String
(Int -> Exclude -> ShowS)
-> (Exclude -> String) -> ([Exclude] -> ShowS) -> Show Exclude
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exclude -> ShowS
showsPrec :: Int -> Exclude -> ShowS
$cshow :: Exclude -> String
show :: Exclude -> String
$cshowList :: [Exclude] -> ShowS
showList :: [Exclude] -> ShowS
Show)

instance ToJSON Include where
  toJSON :: Include -> Value
toJSON (Include [Pattern]
patterns) = [Pattern] -> Value
forall a. ToJSON a => a -> Value
toJSON [Pattern]
patterns

instance ToJSON Exclude where
  toJSON :: Exclude -> Value
toJSON (Exclude [Pattern]
patterns) = [Pattern] -> Value
forall a. ToJSON a => a -> Value
toJSON [Pattern]
patterns

newtype Pattern = Pattern Text deriving stock (Pattern -> Pattern -> TrackSortScores
(Pattern -> Pattern -> TrackSortScores)
-> (Pattern -> Pattern -> TrackSortScores) -> Eq Pattern
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: Pattern -> Pattern -> TrackSortScores
== :: Pattern -> Pattern -> TrackSortScores
$c/= :: Pattern -> Pattern -> TrackSortScores
/= :: Pattern -> Pattern -> TrackSortScores
Eq, ReadPrec [Pattern]
ReadPrec Pattern
Int -> ReadS Pattern
ReadS [Pattern]
(Int -> ReadS Pattern)
-> ReadS [Pattern]
-> ReadPrec Pattern
-> ReadPrec [Pattern]
-> Read Pattern
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Pattern
readsPrec :: Int -> ReadS Pattern
$creadList :: ReadS [Pattern]
readList :: ReadS [Pattern]
$creadPrec :: ReadPrec Pattern
readPrec :: ReadPrec Pattern
$creadListPrec :: ReadPrec [Pattern]
readListPrec :: ReadPrec [Pattern]
Read, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pattern -> ShowS
showsPrec :: Int -> Pattern -> ShowS
$cshow :: Pattern -> String
show :: Pattern -> String
$cshowList :: [Pattern] -> ShowS
showList :: [Pattern] -> ShowS
Show)

instance ToJSON Pattern where
  toJSON :: Pattern -> Value
toJSON (Pattern Text
pattern) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
pattern

data SearchResult a = SearchResult
  { forall a. SearchResult a -> Int
took :: Int,
    forall a. SearchResult a -> TrackSortScores
timedOut :: Bool,
    forall a. SearchResult a -> ShardResult
shards :: ShardResult,
    forall a. SearchResult a -> SearchHits a
searchHits :: SearchHits a,
    forall a. SearchResult a -> Maybe AggregationResults
aggregations :: Maybe AggregationResults,
    -- | Only one Suggestion request / response per
    --   Search is supported.
    forall a. SearchResult a -> Maybe ScrollId
scrollId :: Maybe ScrollId,
    forall a. SearchResult a -> Maybe NamedSuggestionResponse
suggest :: Maybe NamedSuggestionResponse,
    forall a. SearchResult a -> Maybe Text
pitId :: Maybe Text
  }
  deriving stock (SearchResult a -> SearchResult a -> TrackSortScores
(SearchResult a -> SearchResult a -> TrackSortScores)
-> (SearchResult a -> SearchResult a -> TrackSortScores)
-> Eq (SearchResult a)
forall a.
Eq a =>
SearchResult a -> SearchResult a -> TrackSortScores
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: forall a.
Eq a =>
SearchResult a -> SearchResult a -> TrackSortScores
== :: SearchResult a -> SearchResult a -> TrackSortScores
$c/= :: forall a.
Eq a =>
SearchResult a -> SearchResult a -> TrackSortScores
/= :: SearchResult a -> SearchResult a -> TrackSortScores
Eq, Int -> SearchResult a -> ShowS
[SearchResult a] -> ShowS
SearchResult a -> String
(Int -> SearchResult a -> ShowS)
-> (SearchResult a -> String)
-> ([SearchResult a] -> ShowS)
-> Show (SearchResult a)
forall a. Show a => Int -> SearchResult a -> ShowS
forall a. Show a => [SearchResult a] -> ShowS
forall a. Show a => SearchResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SearchResult a -> ShowS
showsPrec :: Int -> SearchResult a -> ShowS
$cshow :: forall a. Show a => SearchResult a -> String
show :: SearchResult a -> String
$cshowList :: forall a. Show a => [SearchResult a] -> ShowS
showList :: [SearchResult a] -> ShowS
Show)

instance (FromJSON a) => FromJSON (SearchResult a) where
  parseJSON :: Value -> Parser (SearchResult a)
parseJSON (Object Object
v) =
    Int
-> TrackSortScores
-> ShardResult
-> SearchHits a
-> Maybe AggregationResults
-> Maybe ScrollId
-> Maybe NamedSuggestionResponse
-> Maybe Text
-> SearchResult a
forall a.
Int
-> TrackSortScores
-> ShardResult
-> SearchHits a
-> Maybe AggregationResults
-> Maybe ScrollId
-> Maybe NamedSuggestionResponse
-> Maybe Text
-> SearchResult a
SearchResult
      (Int
 -> TrackSortScores
 -> ShardResult
 -> SearchHits a
 -> Maybe AggregationResults
 -> Maybe ScrollId
 -> Maybe NamedSuggestionResponse
 -> Maybe Text
 -> SearchResult a)
-> Parser Int
-> Parser
     (TrackSortScores
      -> ShardResult
      -> SearchHits a
      -> Maybe AggregationResults
      -> Maybe ScrollId
      -> Maybe NamedSuggestionResponse
      -> Maybe Text
      -> SearchResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
        Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"took"
      Parser
  (TrackSortScores
   -> ShardResult
   -> SearchHits a
   -> Maybe AggregationResults
   -> Maybe ScrollId
   -> Maybe NamedSuggestionResponse
   -> Maybe Text
   -> SearchResult a)
-> Parser TrackSortScores
-> Parser
     (ShardResult
      -> SearchHits a
      -> Maybe AggregationResults
      -> Maybe ScrollId
      -> Maybe NamedSuggestionResponse
      -> Maybe Text
      -> SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser TrackSortScores
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
      Parser
  (ShardResult
   -> SearchHits a
   -> Maybe AggregationResults
   -> Maybe ScrollId
   -> Maybe NamedSuggestionResponse
   -> Maybe Text
   -> SearchResult a)
-> Parser ShardResult
-> Parser
     (SearchHits a
      -> Maybe AggregationResults
      -> Maybe ScrollId
      -> Maybe NamedSuggestionResponse
      -> Maybe Text
      -> SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser ShardResult
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_shards"
      Parser
  (SearchHits a
   -> Maybe AggregationResults
   -> Maybe ScrollId
   -> Maybe NamedSuggestionResponse
   -> Maybe Text
   -> SearchResult a)
-> Parser (SearchHits a)
-> Parser
     (Maybe AggregationResults
      -> Maybe ScrollId
      -> Maybe NamedSuggestionResponse
      -> Maybe Text
      -> SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser (SearchHits a)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hits"
      Parser
  (Maybe AggregationResults
   -> Maybe ScrollId
   -> Maybe NamedSuggestionResponse
   -> Maybe Text
   -> SearchResult a)
-> Parser (Maybe AggregationResults)
-> Parser
     (Maybe ScrollId
      -> Maybe NamedSuggestionResponse -> Maybe Text -> SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser (Maybe AggregationResults)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aggregations"
      Parser
  (Maybe ScrollId
   -> Maybe NamedSuggestionResponse -> Maybe Text -> SearchResult a)
-> Parser (Maybe ScrollId)
-> Parser
     (Maybe NamedSuggestionResponse -> Maybe Text -> SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser (Maybe ScrollId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_scroll_id"
      Parser
  (Maybe NamedSuggestionResponse -> Maybe Text -> SearchResult a)
-> Parser (Maybe NamedSuggestionResponse)
-> Parser (Maybe Text -> SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser (Maybe NamedSuggestionResponse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"suggest"
      Parser (Maybe Text -> SearchResult a)
-> Parser (Maybe Text) -> Parser (SearchResult a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pit_id"
  parseJSON Value
_ = Parser (SearchResult a)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

tookLens :: Lens' (SearchResult a) Int
tookLens :: forall a. Lens' (SearchResult a) Int
tookLens = (SearchResult a -> Int)
-> (SearchResult a -> Int -> SearchResult a)
-> Lens (SearchResult a) (SearchResult a) Int Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> Int
forall a. SearchResult a -> Int
took (\SearchResult a
x Int
y -> SearchResult a
x {took = y})

timedOutLens :: Lens' (SearchResult a) Bool
timedOutLens :: forall a. Lens' (SearchResult a) TrackSortScores
timedOutLens = (SearchResult a -> TrackSortScores)
-> (SearchResult a -> TrackSortScores -> SearchResult a)
-> Lens
     (SearchResult a) (SearchResult a) TrackSortScores TrackSortScores
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> TrackSortScores
forall a. SearchResult a -> TrackSortScores
timedOut (\SearchResult a
x TrackSortScores
y -> SearchResult a
x {timedOut = y})

shardsLens :: Lens' (SearchResult a) ShardResult
shardsLens :: forall a. Lens' (SearchResult a) ShardResult
shardsLens = (SearchResult a -> ShardResult)
-> (SearchResult a -> ShardResult -> SearchResult a)
-> Lens (SearchResult a) (SearchResult a) ShardResult ShardResult
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> ShardResult
forall a. SearchResult a -> ShardResult
shards (\SearchResult a
x ShardResult
y -> SearchResult a
x {shards = y})

searchHitsLens :: Lens' (SearchResult a) (SearchHits a)
searchHitsLens :: forall a. Lens' (SearchResult a) (SearchHits a)
searchHitsLens = (SearchResult a -> SearchHits a)
-> (SearchResult a -> SearchHits a -> SearchResult a)
-> Lens
     (SearchResult a) (SearchResult a) (SearchHits a) (SearchHits a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> SearchHits a
forall a. SearchResult a -> SearchHits a
searchHits (\SearchResult a
x SearchHits a
y -> SearchResult a
x {searchHits = y})

aggregationsLens :: Lens' (SearchResult a) (Maybe AggregationResults)
aggregationsLens :: forall a. Lens' (SearchResult a) (Maybe AggregationResults)
aggregationsLens = (SearchResult a -> Maybe AggregationResults)
-> (SearchResult a -> Maybe AggregationResults -> SearchResult a)
-> Lens
     (SearchResult a)
     (SearchResult a)
     (Maybe AggregationResults)
     (Maybe AggregationResults)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> Maybe AggregationResults
forall a. SearchResult a -> Maybe AggregationResults
aggregations (\SearchResult a
x Maybe AggregationResults
y -> SearchResult a
x {aggregations = y})

scrollIdLens :: Lens' (SearchResult a) (Maybe ScrollId)
scrollIdLens :: forall a. Lens' (SearchResult a) (Maybe ScrollId)
scrollIdLens = (SearchResult a -> Maybe ScrollId)
-> (SearchResult a -> Maybe ScrollId -> SearchResult a)
-> Lens
     (SearchResult a) (SearchResult a) (Maybe ScrollId) (Maybe ScrollId)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> Maybe ScrollId
forall a. SearchResult a -> Maybe ScrollId
scrollId (\SearchResult a
x Maybe ScrollId
y -> SearchResult a
x {scrollId = y})

suggestLens :: Lens' (SearchResult a) (Maybe NamedSuggestionResponse)
suggestLens :: forall a. Lens' (SearchResult a) (Maybe NamedSuggestionResponse)
suggestLens = (SearchResult a -> Maybe NamedSuggestionResponse)
-> (SearchResult a
    -> Maybe NamedSuggestionResponse -> SearchResult a)
-> Lens
     (SearchResult a)
     (SearchResult a)
     (Maybe NamedSuggestionResponse)
     (Maybe NamedSuggestionResponse)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> Maybe NamedSuggestionResponse
forall a. SearchResult a -> Maybe NamedSuggestionResponse
suggest (\SearchResult a
x Maybe NamedSuggestionResponse
y -> SearchResult a
x {suggest = y})

pitIdLens :: Lens' (SearchResult a) (Maybe Text)
pitIdLens :: forall a. Lens' (SearchResult a) (Maybe Text)
pitIdLens = (SearchResult a -> Maybe Text)
-> (SearchResult a -> Maybe Text -> SearchResult a)
-> Lens (SearchResult a) (SearchResult a) (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SearchResult a -> Maybe Text
forall a. SearchResult a -> Maybe Text
pitId (\SearchResult a
x Maybe Text
y -> SearchResult a
x {pitId = y})

newtype ScrollId
  = ScrollId Text
  deriving newtype (ScrollId -> ScrollId -> TrackSortScores
(ScrollId -> ScrollId -> TrackSortScores)
-> (ScrollId -> ScrollId -> TrackSortScores) -> Eq ScrollId
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: ScrollId -> ScrollId -> TrackSortScores
== :: ScrollId -> ScrollId -> TrackSortScores
$c/= :: ScrollId -> ScrollId -> TrackSortScores
/= :: ScrollId -> ScrollId -> TrackSortScores
Eq, Eq ScrollId
Eq ScrollId =>
(ScrollId -> ScrollId -> Ordering)
-> (ScrollId -> ScrollId -> TrackSortScores)
-> (ScrollId -> ScrollId -> TrackSortScores)
-> (ScrollId -> ScrollId -> TrackSortScores)
-> (ScrollId -> ScrollId -> TrackSortScores)
-> (ScrollId -> ScrollId -> ScrollId)
-> (ScrollId -> ScrollId -> ScrollId)
-> Ord ScrollId
ScrollId -> ScrollId -> TrackSortScores
ScrollId -> ScrollId -> Ordering
ScrollId -> ScrollId -> ScrollId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> TrackSortScores)
-> (a -> a -> TrackSortScores)
-> (a -> a -> TrackSortScores)
-> (a -> a -> TrackSortScores)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScrollId -> ScrollId -> Ordering
compare :: ScrollId -> ScrollId -> Ordering
$c< :: ScrollId -> ScrollId -> TrackSortScores
< :: ScrollId -> ScrollId -> TrackSortScores
$c<= :: ScrollId -> ScrollId -> TrackSortScores
<= :: ScrollId -> ScrollId -> TrackSortScores
$c> :: ScrollId -> ScrollId -> TrackSortScores
> :: ScrollId -> ScrollId -> TrackSortScores
$c>= :: ScrollId -> ScrollId -> TrackSortScores
>= :: ScrollId -> ScrollId -> TrackSortScores
$cmax :: ScrollId -> ScrollId -> ScrollId
max :: ScrollId -> ScrollId -> ScrollId
$cmin :: ScrollId -> ScrollId -> ScrollId
min :: ScrollId -> ScrollId -> ScrollId
Ord, Int -> ScrollId -> ShowS
[ScrollId] -> ShowS
ScrollId -> String
(Int -> ScrollId -> ShowS)
-> (ScrollId -> String) -> ([ScrollId] -> ShowS) -> Show ScrollId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollId -> ShowS
showsPrec :: Int -> ScrollId -> ShowS
$cshow :: ScrollId -> String
show :: ScrollId -> String
$cshowList :: [ScrollId] -> ShowS
showList :: [ScrollId] -> ShowS
Show, [ScrollId] -> Value
[ScrollId] -> Encoding
ScrollId -> TrackSortScores
ScrollId -> Value
ScrollId -> Encoding
(ScrollId -> Value)
-> (ScrollId -> Encoding)
-> ([ScrollId] -> Value)
-> ([ScrollId] -> Encoding)
-> (ScrollId -> TrackSortScores)
-> ToJSON ScrollId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> TrackSortScores)
-> ToJSON a
$ctoJSON :: ScrollId -> Value
toJSON :: ScrollId -> Value
$ctoEncoding :: ScrollId -> Encoding
toEncoding :: ScrollId -> Encoding
$ctoJSONList :: [ScrollId] -> Value
toJSONList :: [ScrollId] -> Value
$ctoEncodingList :: [ScrollId] -> Encoding
toEncodingList :: [ScrollId] -> Encoding
$comitField :: ScrollId -> TrackSortScores
omitField :: ScrollId -> TrackSortScores
ToJSON, Maybe ScrollId
Value -> Parser [ScrollId]
Value -> Parser ScrollId
(Value -> Parser ScrollId)
-> (Value -> Parser [ScrollId])
-> Maybe ScrollId
-> FromJSON ScrollId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ScrollId
parseJSON :: Value -> Parser ScrollId
$cparseJSONList :: Value -> Parser [ScrollId]
parseJSONList :: Value -> Parser [ScrollId]
$comittedField :: Maybe ScrollId
omittedField :: Maybe ScrollId
FromJSON)

newtype SearchTemplateId = SearchTemplateId Text deriving stock (SearchTemplateId -> SearchTemplateId -> TrackSortScores
(SearchTemplateId -> SearchTemplateId -> TrackSortScores)
-> (SearchTemplateId -> SearchTemplateId -> TrackSortScores)
-> Eq SearchTemplateId
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
== :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
$c/= :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
/= :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
Eq, Int -> SearchTemplateId -> ShowS
[SearchTemplateId] -> ShowS
SearchTemplateId -> String
(Int -> SearchTemplateId -> ShowS)
-> (SearchTemplateId -> String)
-> ([SearchTemplateId] -> ShowS)
-> Show SearchTemplateId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchTemplateId -> ShowS
showsPrec :: Int -> SearchTemplateId -> ShowS
$cshow :: SearchTemplateId -> String
show :: SearchTemplateId -> String
$cshowList :: [SearchTemplateId] -> ShowS
showList :: [SearchTemplateId] -> ShowS
Show)

instance ToJSON SearchTemplateId where
  toJSON :: SearchTemplateId -> Value
toJSON (SearchTemplateId Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x

newtype SearchTemplateSource = SearchTemplateSource Text deriving stock (SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
(SearchTemplateSource -> SearchTemplateSource -> TrackSortScores)
-> (SearchTemplateSource
    -> SearchTemplateSource -> TrackSortScores)
-> Eq SearchTemplateSource
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
== :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
$c/= :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
/= :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
Eq, Int -> SearchTemplateSource -> ShowS
[SearchTemplateSource] -> ShowS
SearchTemplateSource -> String
(Int -> SearchTemplateSource -> ShowS)
-> (SearchTemplateSource -> String)
-> ([SearchTemplateSource] -> ShowS)
-> Show SearchTemplateSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchTemplateSource -> ShowS
showsPrec :: Int -> SearchTemplateSource -> ShowS
$cshow :: SearchTemplateSource -> String
show :: SearchTemplateSource -> String
$cshowList :: [SearchTemplateSource] -> ShowS
showList :: [SearchTemplateSource] -> ShowS
Show)

instance ToJSON SearchTemplateSource where
  toJSON :: SearchTemplateSource -> Value
toJSON (SearchTemplateSource Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x

instance FromJSON SearchTemplateSource where
  parseJSON :: Value -> Parser SearchTemplateSource
parseJSON (String Text
s) = SearchTemplateSource -> Parser SearchTemplateSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchTemplateSource -> Parser SearchTemplateSource)
-> SearchTemplateSource -> Parser SearchTemplateSource
forall a b. (a -> b) -> a -> b
$ Text -> SearchTemplateSource
SearchTemplateSource Text
s
  parseJSON Value
_ = Parser SearchTemplateSource
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

data ExpandWildcards
  = ExpandWildcardsAll
  | ExpandWildcardsOpen
  | ExpandWildcardsClosed
  | ExpandWildcardsNone
  deriving stock (ExpandWildcards -> ExpandWildcards -> TrackSortScores
(ExpandWildcards -> ExpandWildcards -> TrackSortScores)
-> (ExpandWildcards -> ExpandWildcards -> TrackSortScores)
-> Eq ExpandWildcards
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
== :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
$c/= :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
/= :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
Eq, Int -> ExpandWildcards -> ShowS
[ExpandWildcards] -> ShowS
ExpandWildcards -> String
(Int -> ExpandWildcards -> ShowS)
-> (ExpandWildcards -> String)
-> ([ExpandWildcards] -> ShowS)
-> Show ExpandWildcards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpandWildcards -> ShowS
showsPrec :: Int -> ExpandWildcards -> ShowS
$cshow :: ExpandWildcards -> String
show :: ExpandWildcards -> String
$cshowList :: [ExpandWildcards] -> ShowS
showList :: [ExpandWildcards] -> ShowS
Show)

instance ToJSON ExpandWildcards where
  toJSON :: ExpandWildcards -> Value
toJSON ExpandWildcards
ExpandWildcardsAll = Text -> Value
String Text
"all"
  toJSON ExpandWildcards
ExpandWildcardsOpen = Text -> Value
String Text
"open"
  toJSON ExpandWildcards
ExpandWildcardsClosed = Text -> Value
String Text
"closed"
  toJSON ExpandWildcards
ExpandWildcardsNone = Text -> Value
String Text
"none"

instance FromJSON ExpandWildcards where
  parseJSON :: Value -> Parser ExpandWildcards
parseJSON (String Text
"all") = ExpandWildcards -> Parser ExpandWildcards
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandWildcards -> Parser ExpandWildcards)
-> ExpandWildcards -> Parser ExpandWildcards
forall a b. (a -> b) -> a -> b
$ ExpandWildcards
ExpandWildcardsAll
  parseJSON (String Text
"open") = ExpandWildcards -> Parser ExpandWildcards
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandWildcards -> Parser ExpandWildcards)
-> ExpandWildcards -> Parser ExpandWildcards
forall a b. (a -> b) -> a -> b
$ ExpandWildcards
ExpandWildcardsOpen
  parseJSON (String Text
"closed") = ExpandWildcards -> Parser ExpandWildcards
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandWildcards -> Parser ExpandWildcards)
-> ExpandWildcards -> Parser ExpandWildcards
forall a b. (a -> b) -> a -> b
$ ExpandWildcards
ExpandWildcardsClosed
  parseJSON (String Text
"none") = ExpandWildcards -> Parser ExpandWildcards
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandWildcards -> Parser ExpandWildcards)
-> ExpandWildcards -> Parser ExpandWildcards
forall a b. (a -> b) -> a -> b
$ ExpandWildcards
ExpandWildcardsNone
  parseJSON Value
_ = Parser ExpandWildcards
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

data TimeUnits
  = TimeUnitDays
  | TimeUnitHours
  | TimeUnitMinutes
  | TimeUnitSeconds
  | TimeUnitMilliseconds
  | TimeUnitMicroseconds
  | TimeUnitNanoseconds
  deriving stock (TimeUnits -> TimeUnits -> TrackSortScores
(TimeUnits -> TimeUnits -> TrackSortScores)
-> (TimeUnits -> TimeUnits -> TrackSortScores) -> Eq TimeUnits
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: TimeUnits -> TimeUnits -> TrackSortScores
== :: TimeUnits -> TimeUnits -> TrackSortScores
$c/= :: TimeUnits -> TimeUnits -> TrackSortScores
/= :: TimeUnits -> TimeUnits -> TrackSortScores
Eq, Int -> TimeUnits -> ShowS
[TimeUnits] -> ShowS
TimeUnits -> String
(Int -> TimeUnits -> ShowS)
-> (TimeUnits -> String)
-> ([TimeUnits] -> ShowS)
-> Show TimeUnits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeUnits -> ShowS
showsPrec :: Int -> TimeUnits -> ShowS
$cshow :: TimeUnits -> String
show :: TimeUnits -> String
$cshowList :: [TimeUnits] -> ShowS
showList :: [TimeUnits] -> ShowS
Show)

instance ToJSON TimeUnits where
  toJSON :: TimeUnits -> Value
toJSON TimeUnits
TimeUnitDays = Text -> Value
String Text
"d"
  toJSON TimeUnits
TimeUnitHours = Text -> Value
String Text
"h"
  toJSON TimeUnits
TimeUnitMinutes = Text -> Value
String Text
"m"
  toJSON TimeUnits
TimeUnitSeconds = Text -> Value
String Text
"s"
  toJSON TimeUnits
TimeUnitMilliseconds = Text -> Value
String Text
"ms"
  toJSON TimeUnits
TimeUnitMicroseconds = Text -> Value
String Text
"micros"
  toJSON TimeUnits
TimeUnitNanoseconds = Text -> Value
String Text
"nanos"

instance FromJSON TimeUnits where
  parseJSON :: Value -> Parser TimeUnits
parseJSON (String Text
"d") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitDays
  parseJSON (String Text
"h") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitHours
  parseJSON (String Text
"m") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitMinutes
  parseJSON (String Text
"s") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitSeconds
  parseJSON (String Text
"ms") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitMilliseconds
  parseJSON (String Text
"micros") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitMicroseconds
  parseJSON (String Text
"nanos") = TimeUnits -> Parser TimeUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeUnits -> Parser TimeUnits) -> TimeUnits -> Parser TimeUnits
forall a b. (a -> b) -> a -> b
$ TimeUnits
TimeUnitNanoseconds
  parseJSON Value
_ = Parser TimeUnits
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

data SearchTemplate = SearchTemplate
  { SearchTemplate -> Either SearchTemplateId SearchTemplateSource
searchTemplate :: Either SearchTemplateId SearchTemplateSource,
    SearchTemplate -> TemplateQueryKeyValuePairs
params :: TemplateQueryKeyValuePairs,
    SearchTemplate -> Maybe TrackSortScores
explainSearchTemplate :: Maybe Bool,
    SearchTemplate -> Maybe TrackSortScores
profileSearchTemplate :: Maybe Bool
  }
  deriving stock (SearchTemplate -> SearchTemplate -> TrackSortScores
(SearchTemplate -> SearchTemplate -> TrackSortScores)
-> (SearchTemplate -> SearchTemplate -> TrackSortScores)
-> Eq SearchTemplate
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: SearchTemplate -> SearchTemplate -> TrackSortScores
== :: SearchTemplate -> SearchTemplate -> TrackSortScores
$c/= :: SearchTemplate -> SearchTemplate -> TrackSortScores
/= :: SearchTemplate -> SearchTemplate -> TrackSortScores
Eq, Int -> SearchTemplate -> ShowS
[SearchTemplate] -> ShowS
SearchTemplate -> String
(Int -> SearchTemplate -> ShowS)
-> (SearchTemplate -> String)
-> ([SearchTemplate] -> ShowS)
-> Show SearchTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchTemplate -> ShowS
showsPrec :: Int -> SearchTemplate -> ShowS
$cshow :: SearchTemplate -> String
show :: SearchTemplate -> String
$cshowList :: [SearchTemplate] -> ShowS
showList :: [SearchTemplate] -> ShowS
Show)

instance ToJSON SearchTemplate where
  toJSON :: SearchTemplate -> Value
toJSON SearchTemplate {Maybe TrackSortScores
Either SearchTemplateId SearchTemplateSource
TemplateQueryKeyValuePairs
searchTemplate :: SearchTemplate -> Either SearchTemplateId SearchTemplateSource
params :: SearchTemplate -> TemplateQueryKeyValuePairs
explainSearchTemplate :: SearchTemplate -> Maybe TrackSortScores
profileSearchTemplate :: SearchTemplate -> Maybe TrackSortScores
searchTemplate :: Either SearchTemplateId SearchTemplateSource
params :: TemplateQueryKeyValuePairs
explainSearchTemplate :: Maybe TrackSortScores
profileSearchTemplate :: Maybe TrackSortScores
..} =
    [(Key, Value)] -> Value
omitNulls
      [ (SearchTemplateId -> (Key, Value))
-> (SearchTemplateSource -> (Key, Value))
-> Either SearchTemplateId SearchTemplateSource
-> (Key, Value)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Key
"id" Key -> SearchTemplateId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Key
"source" Key -> SearchTemplateSource -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) Either SearchTemplateId SearchTemplateSource
searchTemplate,
        Key
"params" Key -> TemplateQueryKeyValuePairs -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TemplateQueryKeyValuePairs
params,
        Key
"explain" Key -> Maybe TrackSortScores -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe TrackSortScores
explainSearchTemplate,
        Key
"profile" Key -> Maybe TrackSortScores -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe TrackSortScores
profileSearchTemplate
      ]

data GetTemplateScript = GetTemplateScript
  { GetTemplateScript -> Maybe Text
getTemplateScriptLang :: Maybe Text,
    GetTemplateScript -> Maybe SearchTemplateSource
getTemplateScriptSource :: Maybe SearchTemplateSource,
    GetTemplateScript -> Maybe (HashMap Text Text)
getTemplateScriptOptions :: Maybe (HM.HashMap Text Text),
    GetTemplateScript -> Text
getTemplateScriptId :: Text,
    GetTemplateScript -> TrackSortScores
getTemplateScriptFound :: Bool
  }
  deriving stock (GetTemplateScript -> GetTemplateScript -> TrackSortScores
(GetTemplateScript -> GetTemplateScript -> TrackSortScores)
-> (GetTemplateScript -> GetTemplateScript -> TrackSortScores)
-> Eq GetTemplateScript
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
$c== :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
== :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
$c/= :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
/= :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
Eq, Int -> GetTemplateScript -> ShowS
[GetTemplateScript] -> ShowS
GetTemplateScript -> String
(Int -> GetTemplateScript -> ShowS)
-> (GetTemplateScript -> String)
-> ([GetTemplateScript] -> ShowS)
-> Show GetTemplateScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetTemplateScript -> ShowS
showsPrec :: Int -> GetTemplateScript -> ShowS
$cshow :: GetTemplateScript -> String
show :: GetTemplateScript -> String
$cshowList :: [GetTemplateScript] -> ShowS
showList :: [GetTemplateScript] -> ShowS
Show)

instance FromJSON GetTemplateScript where
  parseJSON :: Value -> Parser GetTemplateScript
parseJSON (Object Object
v) = do
    Maybe Object
script <- Object
v Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"script"
    Parser GetTemplateScript
-> (Object -> Parser GetTemplateScript)
-> Maybe Object
-> Parser GetTemplateScript
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Maybe Text
-> Maybe SearchTemplateSource
-> Maybe (HashMap Text Text)
-> Text
-> TrackSortScores
-> GetTemplateScript
GetTemplateScript Maybe Text
forall a. Maybe a
Nothing Maybe SearchTemplateSource
forall a. Maybe a
Nothing Maybe (HashMap Text Text)
forall a. Maybe a
Nothing (Text -> TrackSortScores -> GetTemplateScript)
-> Parser Text -> Parser (TrackSortScores -> GetTemplateScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id" Parser (TrackSortScores -> GetTemplateScript)
-> Parser TrackSortScores -> Parser GetTemplateScript
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser TrackSortScores
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"found")
      ( \Object
s ->
          Maybe Text
-> Maybe SearchTemplateSource
-> Maybe (HashMap Text Text)
-> Text
-> TrackSortScores
-> GetTemplateScript
GetTemplateScript
            (Maybe Text
 -> Maybe SearchTemplateSource
 -> Maybe (HashMap Text Text)
 -> Text
 -> TrackSortScores
 -> GetTemplateScript)
-> Parser (Maybe Text)
-> Parser
     (Maybe SearchTemplateSource
      -> Maybe (HashMap Text Text)
      -> Text
      -> TrackSortScores
      -> GetTemplateScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
s
              Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lang"
            Parser
  (Maybe SearchTemplateSource
   -> Maybe (HashMap Text Text)
   -> Text
   -> TrackSortScores
   -> GetTemplateScript)
-> Parser (Maybe SearchTemplateSource)
-> Parser
     (Maybe (HashMap Text Text)
      -> Text -> TrackSortScores -> GetTemplateScript)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
s
              Object -> Key -> Parser (Maybe SearchTemplateSource)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
            Parser
  (Maybe (HashMap Text Text)
   -> Text -> TrackSortScores -> GetTemplateScript)
-> Parser (Maybe (HashMap Text Text))
-> Parser (Text -> TrackSortScores -> GetTemplateScript)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
s
              Object -> Key -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Parser (Text -> TrackSortScores -> GetTemplateScript)
-> Parser Text -> Parser (TrackSortScores -> GetTemplateScript)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
              Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id"
            Parser (TrackSortScores -> GetTemplateScript)
-> Parser TrackSortScores -> Parser GetTemplateScript
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
              Object -> Key -> Parser TrackSortScores
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"found"
      )
      Maybe Object
script
  parseJSON Value
_ = Parser GetTemplateScript
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

getTemplateScriptLangLens :: Lens' GetTemplateScript (Maybe Text)
getTemplateScriptLangLens :: Lens' GetTemplateScript (Maybe Text)
getTemplateScriptLangLens = (GetTemplateScript -> Maybe Text)
-> (GetTemplateScript -> Maybe Text -> GetTemplateScript)
-> Lens' GetTemplateScript (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GetTemplateScript -> Maybe Text
getTemplateScriptLang (\GetTemplateScript
x Maybe Text
y -> GetTemplateScript
x {getTemplateScriptLang = y})

getTemplateScriptSourceLens :: Lens' GetTemplateScript (Maybe SearchTemplateSource)
getTemplateScriptSourceLens :: Lens' GetTemplateScript (Maybe SearchTemplateSource)
getTemplateScriptSourceLens = (GetTemplateScript -> Maybe SearchTemplateSource)
-> (GetTemplateScript
    -> Maybe SearchTemplateSource -> GetTemplateScript)
-> Lens' GetTemplateScript (Maybe SearchTemplateSource)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GetTemplateScript -> Maybe SearchTemplateSource
getTemplateScriptSource (\GetTemplateScript
x Maybe SearchTemplateSource
y -> GetTemplateScript
x {getTemplateScriptSource = y})

getTemplateScriptOptionsLens :: Lens' GetTemplateScript (Maybe (HM.HashMap Text Text))
getTemplateScriptOptionsLens :: Lens' GetTemplateScript (Maybe (HashMap Text Text))
getTemplateScriptOptionsLens = (GetTemplateScript -> Maybe (HashMap Text Text))
-> (GetTemplateScript
    -> Maybe (HashMap Text Text) -> GetTemplateScript)
-> Lens' GetTemplateScript (Maybe (HashMap Text Text))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GetTemplateScript -> Maybe (HashMap Text Text)
getTemplateScriptOptions (\GetTemplateScript
x Maybe (HashMap Text Text)
y -> GetTemplateScript
x {getTemplateScriptOptions = y})

getTemplateScriptIdLens :: Lens' GetTemplateScript Text
getTemplateScriptIdLens :: Lens' GetTemplateScript Text
getTemplateScriptIdLens = (GetTemplateScript -> Text)
-> (GetTemplateScript -> Text -> GetTemplateScript)
-> Lens' GetTemplateScript Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GetTemplateScript -> Text
getTemplateScriptId (\GetTemplateScript
x Text
y -> GetTemplateScript
x {getTemplateScriptId = y})

getTemplateScriptFoundLens :: Lens' GetTemplateScript Bool
getTemplateScriptFoundLens :: Lens' GetTemplateScript TrackSortScores
getTemplateScriptFoundLens = (GetTemplateScript -> TrackSortScores)
-> (GetTemplateScript -> TrackSortScores -> GetTemplateScript)
-> Lens' GetTemplateScript TrackSortScores
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GetTemplateScript -> TrackSortScores
getTemplateScriptFound (\GetTemplateScript
x TrackSortScores
y -> GetTemplateScript
x {getTemplateScriptFound = y})