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

-- |
-- Module : Database.Bloodhound.Types
-- Copyright : (C) 2014, 2018 Chris Allen
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Chris Allen <cma@bitemyapp.com
-- Stability : provisional
-- Portability : GHC
--
-- Data types for describing actions and data structures performed to interact
-- with Elasticsearch. The two main buckets your queries against Elasticsearch
-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
-- traditional database constraints and often have preferable performance
-- properties. 'Query's support human-written textual queries, such as fuzzy
-- queries.
module Database.Bloodhound.Types
  ( defaultCache,
    defaultIndexSettings,
    defaultIndexMappingsLimits,
    defaultIndexDocumentSettings,
    mkSort,
    showText,
    unpackId,
    mkMatchQuery,
    mkMultiMatchQuery,
    mkBoolQuery,
    mkRangeQuery,
    mkQueryStringQuery,
    mkAggregations,
    mkTermsAggregation,
    mkTermsScriptAggregation,
    mkDateHistogram,
    mkCardinalityAggregation,
    mkDocVersion,
    mkStatsAggregation,
    mkExtendedStatsAggregation,
    docVersionNumber,
    toMissing,
    toTerms,
    toDateHistogram,
    toTopHits,
    omitNulls,
    BH (..),
    runBH,
    BHEnv,
    bhServer,
    bhManager,
    bhRequestHook,
    mkBHEnv,
    MonadBH (..),
    Version (..),
    VersionNumber (..),
    MaybeNA (..),
    BuildHash (..),
    Status (..),
    Existence (..),
    NullValue (..),
    IndexMappingsLimits (..),
    IndexSettings (..),
    UpdatableIndexSetting (..),
    IndexSettingsSummary (..),
    AllocationPolicy (..),
    Compression (..),
    ReplicaBounds (..),
    Bytes (..),
    gigabytes,
    megabytes,
    kilobytes,
    FSType (..),
    InitialShardCount (..),
    NodeAttrFilter (..),
    NodeAttrName (..),
    CompoundFormat (..),
    IndexTemplate (..),
    Server (..),
    EsResult (..),
    EsResultFound (..),
    EsError (..),
    EsProtocolException (..),
    IndexAlias (..),
    IndexAliasName (..),
    IndexAliasAction (..),
    IndexAliasCreate (..),
    IndexAliasSummary (..),
    IndexAliasesSummary (..),
    AliasRouting (..),
    SearchAliasRouting (..),
    IndexAliasRouting (..),
    RoutingValue (..),
    DocVersion,
    ExternalDocVersion (..),
    VersionControl (..),
    JoinRelation (..),
    IndexDocumentSettings (..),
    Query (..),
    Search (..),
    SearchType (..),
    SearchResult (..),
    ScrollId (..),
    HitsTotalRelation (..),
    HitsTotal (..),
    SearchHits (..),
    TrackSortScores,
    From (..),
    Size (..),
    Source (..),
    PatternOrPatterns (..),
    Include (..),
    Exclude (..),
    Pattern (..),
    ShardResult (..),
    Hit (..),
    HitFields (..),
    Filter (..),
    BoolMatch (..),
    Term (..),
    GeoPoint (..),
    GeoBoundingBoxConstraint (..),
    GeoBoundingBox (..),
    GeoFilterType (..),
    Distance (..),
    DistanceUnit (..),
    DistanceType (..),
    DistanceRange (..),
    OptimizeBbox (..),
    LatLon (..),
    RangeValue (..),
    RangeExecution (..),
    LessThan (..),
    LessThanEq (..),
    GreaterThan (..),
    GreaterThanEq (..),
    LessThanD (..),
    LessThanEqD (..),
    GreaterThanD (..),
    GreaterThanEqD (..),
    Regexp (..),
    RegexpFlags (..),
    RegexpFlag (..),
    FieldName (..),
    ScriptFields (..),
    ScriptFieldValue,
    Script (..),
    ScriptLanguage (..),
    ScriptSource (..),
    ScriptParams (..),
    ScriptParamValue,
    IndexName (..),
    IndexSelection (..),
    NodeSelection (..),
    NodeSelector (..),
    ForceMergeIndexSettings (..),
    defaultForceMergeIndexSettings,
    TemplateName (..),
    IndexPattern (..),
    DocId (..),
    CacheName (..),
    CacheKey (..),
    BulkOperation (..),
    ReplicaCount (..),
    ShardCount (..),
    Sort,
    SortMode (..),
    SortOrder (..),
    SortSpec (..),
    DefaultSort (..),
    Missing (..),
    OpenCloseIndex (..),
    Method,
    Boost (..),
    MatchQuery (..),
    MultiMatchQuery (..),
    BoolQuery (..),
    BoostingQuery (..),
    CommonTermsQuery (..),
    FunctionScoreQuery (..),
    BoostMode (..),
    ScoreMode (..),
    FunctionScoreFunctions (..),
    ComponentFunctionScoreFunction (..),
    FunctionScoreFunction (..),
    Weight (..),
    Seed (..),
    FieldValueFactor (..),
    Factor (..),
    FactorModifier (..),
    FactorMissingFieldValue (..),
    DisMaxQuery (..),
    FuzzyLikeThisQuery (..),
    FuzzyLikeFieldQuery (..),
    FuzzyQuery (..),
    HasChildQuery (..),
    HasParentQuery (..),
    IndicesQuery (..),
    MoreLikeThisQuery (..),
    MoreLikeThisFieldQuery (..),
    NestedQuery (..),
    PrefixQuery (..),
    QueryStringQuery (..),
    SimpleQueryStringQuery (..),
    RangeQuery (..),
    RegexpQuery (..),
    QueryString (..),
    SearchTemplateId (..),
    SearchTemplateSource (..),
    SearchTemplate (..),
    GetTemplateScript (..),
    TemplateQueryKeyValuePairs (..),
    WildcardQuery (..),
    BooleanOperator (..),
    ZeroTermsQuery (..),
    CutoffFrequency (..),
    Analyzer (..),
    Tokenizer (..),
    TokenFilter (..),
    CharFilter (..),
    MaxExpansions (..),
    Lenient (..),
    MatchQueryType (..),
    MultiMatchQueryType (..),
    Tiebreaker (..),
    MinimumMatch (..),
    DisableCoord (..),
    CommonMinimumMatch (..),
    MinimumMatchHighLow (..),
    PrefixLength (..),
    Fuzziness (..),
    IgnoreTermFrequency (..),
    MaxQueryTerms (..),
    AggregateParentScore (..),
    IgnoreUnmapped (..),
    MinChildren (..),
    MaxChildren (..),
    ScoreType (..),
    InnerHits (..),
    Score,
    Cache,
    RelationName (..),
    BoostTerms (..),
    MaxWordLength (..),
    MinWordLength (..),
    MaxDocFrequency (..),
    MinDocFrequency (..),
    PhraseSlop (..),
    StopWord (..),
    QueryPath (..),
    MinimumTermFrequency (..),
    PercentMatch (..),
    FieldDefinition (..),
    MappingField (..),
    Mapping (..),
    UpsertActionMetadata (..),
    buildUpsertActionMetadata,
    UpsertPayload (..),
    AllowLeadingWildcard (..),
    LowercaseExpanded (..),
    GeneratePhraseQueries (..),
    Locale (..),
    AnalyzeWildcard (..),
    EnablePositionIncrements (..),
    SimpleQueryFlag (..),
    FieldOrFields (..),
    Monoid (..),
    ToJSON (..),
    Interval (..),
    TimeInterval (..),
    ExecutionHint (..),
    CollectionMode (..),
    TermOrder (..),
    TermInclusion (..),
    SnapshotRepoSelection (..),
    GenericSnapshotRepo (..),
    SnapshotRepo (..),
    SnapshotRepoConversionError (..),
    SnapshotRepoType (..),
    GenericSnapshotRepoSettings (..),
    SnapshotRepoUpdateSettings (..),
    defaultSnapshotRepoUpdateSettings,
    SnapshotRepoName (..),
    SnapshotRepoPattern (..),
    SnapshotVerification (..),
    SnapshotNodeVerification (..),
    FullNodeId (..),
    NodeName (..),
    ClusterName (..),
    NodesInfo (..),
    NodesStats (..),
    NodeStats (..),
    NodeBreakersStats (..),
    NodeBreakerStats (..),
    NodeHTTPStats (..),
    NodeTransportStats (..),
    NodeFSStats (..),
    NodeDataPathStats (..),
    NodeFSTotalStats (..),
    NodeNetworkStats (..),
    NodeThreadPoolStats (..),
    NodeJVMStats (..),
    JVMBufferPoolStats (..),
    JVMGCStats (..),
    JVMPoolStats (..),
    NodeProcessStats (..),
    NodeOSStats (..),
    LoadAvgs (..),
    NodeIndicesStats (..),
    EsAddress (..),
    PluginName (..),
    NodeInfo (..),
    NodePluginInfo (..),
    NodeHTTPInfo (..),
    NodeTransportInfo (..),
    BoundTransportAddress (..),
    NodeNetworkInfo (..),
    MacAddress (..),
    NetworkInterfaceName (..),
    NodeNetworkInterface (..),
    NodeThreadPoolInfo (..),
    ThreadPoolSize (..),
    ThreadPoolType (..),
    NodeJVMInfo (..),
    JVMMemoryPool (..),
    JVMGCCollector (..),
    JVMMemoryInfo (..),
    PID (..),
    NodeOSInfo (..),
    CPUInfo (..),
    NodeProcessInfo (..),
    FsSnapshotRepo (..),
    SnapshotCreateSettings (..),
    defaultSnapshotCreateSettings,
    SnapshotSelection (..),
    SnapshotPattern (..),
    SnapshotInfo (..),
    SnapshotShardFailure (..),
    ShardId (..),
    SnapshotName (..),
    SnapshotState (..),
    SnapshotRestoreSettings (..),
    defaultSnapshotRestoreSettings,
    RestoreRenamePattern (..),
    RestoreRenameToken (..),
    RRGroupRefNum,
    rrGroupRefNum,
    mkRRGroupRefNum,
    RestoreIndexSettings (..),
    Suggest (..),
    SuggestType (..),
    PhraseSuggester (..),
    PhraseSuggesterHighlighter (..),
    PhraseSuggesterCollate (..),
    mkPhraseSuggester,
    SuggestOptions (..),
    SuggestResponse (..),
    NamedSuggestionResponse (..),
    DirectGenerators (..),
    mkDirectGenerators,
    DirectGeneratorSuggestModeTypes (..),
    Aggregation (..),
    Aggregations,
    AggregationResults,
    BucketValue (..),
    Bucket (..),
    BucketAggregation (..),
    TermsAggregation (..),
    MissingAggregation (..),
    ValueCountAggregation (..),
    FilterAggregation (..),
    CardinalityAggregation (..),
    DateHistogramAggregation (..),
    DateRangeAggregation (..),
    DateRangeAggRange (..),
    DateMathExpr (..),
    DateMathAnchor (..),
    DateMathModifier (..),
    DateMathUnit (..),
    TopHitsAggregation (..),
    StatisticsAggregation (..),
    SearchAfterKey,
    CountQuery (..),
    CountResponse (..),
    CountShards (..),
    PointInTime (..),
    OpenPointInTimeResponse (..),
    ClosePointInTime (..),
    ClosePointInTimeResponse (..),
    SumAggregation (..),
    Highlights (..),
    FieldHighlight (..),
    HighlightSettings (..),
    PlainHighlight (..),
    PostingsHighlight (..),
    FastVectorHighlight (..),
    CommonHighlight (..),
    NonPostings (..),
    HighlightEncoder (..),
    HighlightTag (..),
    HitHighlight,
    MissingResult (..),
    TermsResult (..),
    DateHistogramResult (..),
    DateRangeResult (..),
    TopHitResult (..),
    EsUsername (..),
    EsPassword (..),
    Analysis (..),
    AnalyzerDefinition (..),
    TokenizerDefinition (..),
    TokenFilterDefinition (..),
    CharFilterDefinition (..),
    Ngram (..),
    NgramFilter (..),
    EdgeNgramFilterSide (..),
    TokenChar (..),
    Shingle (..),
    Language (..),
    BHRequest (..),
    mkFullRequest,
    mkSimpleRequest,
    Endpoint (..),
    withQueries,
    mkEndpoint,
    getEndpoint,
    BHResponse (..),
    ParsedEsResponse,
  )
where

import Bloodhound.Import
import qualified Data.HashMap.Strict as HM
import Database.Bloodhound.Internal.Aggregation
import Database.Bloodhound.Internal.Analysis
import Database.Bloodhound.Internal.Client
import Database.Bloodhound.Internal.Client.BHRequest
import Database.Bloodhound.Internal.Client.Doc
import Database.Bloodhound.Internal.Count
import Database.Bloodhound.Internal.Highlight
import Database.Bloodhound.Internal.Newtypes
import Database.Bloodhound.Internal.PointInTime
import Database.Bloodhound.Internal.Query
import Database.Bloodhound.Internal.Sort
import Database.Bloodhound.Internal.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 (Search -> Search -> TrackSortScores
(Search -> Search -> TrackSortScores)
-> (Search -> Search -> TrackSortScores) -> Eq Search
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: Search -> Search -> TrackSortScores
$c/= :: Search -> Search -> TrackSortScores
== :: Search -> Search -> TrackSortScores
$c== :: 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
showList :: [Search] -> ShowS
$cshowList :: [Search] -> ShowS
show :: Search -> String
$cshow :: Search -> String
showsPrec :: Int -> Search -> ShowS
$cshowsPrec :: Int -> 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Query
query',
          Key
"sort" Key -> Maybe Sort -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Sort
sort,
          Key
"aggregations" Key -> Maybe Aggregations -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Aggregations
searchAggs,
          Key
"highlight" Key -> Maybe Highlights -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Highlights
highlight,
          Key
"from" Key -> From -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= From
sFrom,
          Key
"size" Key -> Size -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Size
sSize,
          Key
"track_scores" Key -> TrackSortScores -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TrackSortScores
sTrackSortScores,
          Key
"search_after" Key -> Maybe SearchAfterKey -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe SearchAfterKey
sAfter,
          Key
"fields" Key -> Maybe [FieldName] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [FieldName]
sFields,
          Key
"script_fields" Key -> Maybe ScriptFields -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ScriptFields
sScriptFields,
          Key
"_source" Key -> Maybe Source -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Source
sSource,
          Key
"suggest" Key -> Maybe Suggest -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Suggest
sSuggest,
          Key
"pit" Key -> Maybe PointInTime -> (Key, Value)
forall kv v. (KeyValue 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 (SearchType -> SearchType -> TrackSortScores
(SearchType -> SearchType -> TrackSortScores)
-> (SearchType -> SearchType -> TrackSortScores) -> Eq SearchType
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: SearchType -> SearchType -> TrackSortScores
$c/= :: SearchType -> SearchType -> TrackSortScores
== :: SearchType -> SearchType -> TrackSortScores
$c== :: 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
showList :: [SearchType] -> ShowS
$cshowList :: [SearchType] -> ShowS
show :: SearchType -> String
$cshow :: SearchType -> String
showsPrec :: Int -> SearchType -> ShowS
$cshowsPrec :: Int -> 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 (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 (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 (f :: * -> *) a. Alternative f => f a
empty

data Source
  = NoSource
  | SourcePatterns PatternOrPatterns
  | SourceIncludeExclude Include Exclude
  deriving (Source -> Source -> TrackSortScores
(Source -> Source -> TrackSortScores)
-> (Source -> Source -> TrackSortScores) -> Eq Source
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: Source -> Source -> TrackSortScores
$c/= :: Source -> Source -> TrackSortScores
== :: Source -> Source -> TrackSortScores
$c== :: 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
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Include
incl, Key
"excludes" Key -> Exclude -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Exclude
excl]

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

data Exclude = Exclude [Pattern] deriving (Exclude -> Exclude -> TrackSortScores
(Exclude -> Exclude -> TrackSortScores)
-> (Exclude -> Exclude -> TrackSortScores) -> Eq Exclude
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: Exclude -> Exclude -> TrackSortScores
$c/= :: Exclude -> Exclude -> TrackSortScores
== :: Exclude -> Exclude -> TrackSortScores
$c== :: 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
readListPrec :: ReadPrec [Exclude]
$creadListPrec :: ReadPrec [Exclude]
readPrec :: ReadPrec Exclude
$creadPrec :: ReadPrec Exclude
readList :: ReadS [Exclude]
$creadList :: ReadS [Exclude]
readsPrec :: Int -> ReadS Exclude
$creadsPrec :: Int -> ReadS 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
showList :: [Exclude] -> ShowS
$cshowList :: [Exclude] -> ShowS
show :: Exclude -> String
$cshow :: Exclude -> String
showsPrec :: Int -> Exclude -> ShowS
$cshowsPrec :: Int -> 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 (Pattern -> Pattern -> TrackSortScores
(Pattern -> Pattern -> TrackSortScores)
-> (Pattern -> Pattern -> TrackSortScores) -> Eq Pattern
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: Pattern -> Pattern -> TrackSortScores
$c/= :: Pattern -> Pattern -> TrackSortScores
== :: Pattern -> Pattern -> TrackSortScores
$c== :: 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
readListPrec :: ReadPrec [Pattern]
$creadListPrec :: ReadPrec [Pattern]
readPrec :: ReadPrec Pattern
$creadPrec :: ReadPrec Pattern
readList :: ReadS [Pattern]
$creadList :: ReadS [Pattern]
readsPrec :: Int -> ReadS Pattern
$creadsPrec :: Int -> ReadS 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
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> 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
  { SearchResult a -> Int
took :: Int,
    SearchResult a -> TrackSortScores
timedOut :: Bool,
    SearchResult a -> ShardResult
shards :: ShardResult,
    SearchResult a -> SearchHits a
searchHits :: SearchHits a,
    SearchResult a -> Maybe AggregationResults
aggregations :: Maybe AggregationResults,
    -- | Only one Suggestion request / response per
    --   Search is supported.
    SearchResult a -> Maybe ScrollId
scrollId :: Maybe ScrollId,
    SearchResult a -> Maybe NamedSuggestionResponse
suggest :: Maybe NamedSuggestionResponse,
    SearchResult a -> Maybe Text
pitId :: Maybe Text
  }
  deriving (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
/= :: SearchResult a -> SearchResult a -> TrackSortScores
$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
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
showList :: [SearchResult a] -> ShowS
$cshowList :: forall a. Show a => [SearchResult a] -> ShowS
show :: SearchResult a -> String
$cshow :: forall a. Show a => SearchResult a -> String
showsPrec :: Int -> SearchResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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 (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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a
empty

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

newtype SearchTemplateId = SearchTemplateId Text deriving (SearchTemplateId -> SearchTemplateId -> TrackSortScores
(SearchTemplateId -> SearchTemplateId -> TrackSortScores)
-> (SearchTemplateId -> SearchTemplateId -> TrackSortScores)
-> Eq SearchTemplateId
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
$c/= :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
== :: SearchTemplateId -> SearchTemplateId -> TrackSortScores
$c== :: 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
showList :: [SearchTemplateId] -> ShowS
$cshowList :: [SearchTemplateId] -> ShowS
show :: SearchTemplateId -> String
$cshow :: SearchTemplateId -> String
showsPrec :: Int -> SearchTemplateId -> ShowS
$cshowsPrec :: Int -> 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 (SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
(SearchTemplateSource -> SearchTemplateSource -> TrackSortScores)
-> (SearchTemplateSource
    -> SearchTemplateSource -> TrackSortScores)
-> Eq SearchTemplateSource
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
$c/= :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
== :: SearchTemplateSource -> SearchTemplateSource -> TrackSortScores
$c== :: 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
showList :: [SearchTemplateSource] -> ShowS
$cshowList :: [SearchTemplateSource] -> ShowS
show :: SearchTemplateSource -> String
$cshow :: SearchTemplateSource -> String
showsPrec :: Int -> SearchTemplateSource -> ShowS
$cshowsPrec :: Int -> 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 (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 (f :: * -> *) a. Alternative f => f a
empty

data ExpandWildcards
  = ExpandWildcardsAll
  | ExpandWildcardsOpen
  | ExpandWildcardsClosed
  | ExpandWildcardsNone
  deriving (ExpandWildcards -> ExpandWildcards -> TrackSortScores
(ExpandWildcards -> ExpandWildcards -> TrackSortScores)
-> (ExpandWildcards -> ExpandWildcards -> TrackSortScores)
-> Eq ExpandWildcards
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
$c/= :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
== :: ExpandWildcards -> ExpandWildcards -> TrackSortScores
$c== :: 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
showList :: [ExpandWildcards] -> ShowS
$cshowList :: [ExpandWildcards] -> ShowS
show :: ExpandWildcards -> String
$cshow :: ExpandWildcards -> String
showsPrec :: Int -> ExpandWildcards -> ShowS
$cshowsPrec :: Int -> 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 (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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a
empty

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

instance ToJSON SearchTemplate where
  toJSON :: SearchTemplate -> Value
toJSON SearchTemplate {Maybe TrackSortScores
Either SearchTemplateId SearchTemplateSource
TemplateQueryKeyValuePairs
profileSearchTemplate :: Maybe TrackSortScores
explainSearchTemplate :: Maybe TrackSortScores
params :: TemplateQueryKeyValuePairs
searchTemplate :: Either SearchTemplateId SearchTemplateSource
profileSearchTemplate :: SearchTemplate -> Maybe TrackSortScores
explainSearchTemplate :: SearchTemplate -> Maybe TrackSortScores
params :: SearchTemplate -> TemplateQueryKeyValuePairs
searchTemplate :: SearchTemplate -> Either SearchTemplateId SearchTemplateSource
..} =
    [(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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Key
"source" Key -> SearchTemplateSource -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Either SearchTemplateId SearchTemplateSource
searchTemplate,
        Key
"params" Key -> TemplateQueryKeyValuePairs -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TemplateQueryKeyValuePairs
params,
        Key
"explain" Key -> Maybe TrackSortScores -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TrackSortScores
explainSearchTemplate,
        Key
"profile" Key -> Maybe TrackSortScores -> (Key, Value)
forall kv v. (KeyValue 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 (GetTemplateScript -> GetTemplateScript -> TrackSortScores
(GetTemplateScript -> GetTemplateScript -> TrackSortScores)
-> (GetTemplateScript -> GetTemplateScript -> TrackSortScores)
-> Eq GetTemplateScript
forall a.
(a -> a -> TrackSortScores) -> (a -> a -> TrackSortScores) -> Eq a
/= :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
$c/= :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
== :: GetTemplateScript -> GetTemplateScript -> TrackSortScores
$c== :: 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
showList :: [GetTemplateScript] -> ShowS
$cshowList :: [GetTemplateScript] -> ShowS
show :: GetTemplateScript -> String
$cshow :: GetTemplateScript -> String
showsPrec :: Int -> GetTemplateScript -> ShowS
$cshowsPrec :: Int -> 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 (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 (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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a
empty