@@ -1,23 +1,20 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
31{-# LANGUAGE FlexibleContexts #-}
42{-# LANGUAGE FlexibleInstances #-}
53{-# LANGUAGE GeneralizedNewtypeDeriving #-}
64{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE NoMonomorphismRestriction #-}
5+{-# LANGUAGE NamedFieldPuns #-}
86{-# LANGUAGE OverloadedStrings #-}
97{-# LANGUAGE RecordWildCards #-}
108{-# LANGUAGE UndecidableInstances #-}
11−{-# LANGUAGE NamedFieldPuns #-}
129
1310-------------------------------------------------------------------------------
1411-- |
1512-- Module : Database.Bloodhound.Types
16−-- Copyright : (C) 2014 Chris Allen
13+-- Copyright : (C) 2014, 2018 Chris Allen
1714-- License : BSD-style (see the file LICENSE)
1815-- Maintainer : Chris Allen <cma@bitemyapp.com
1916-- Stability : provisional
20−-- Portability : DeriveGeneric, RecordWildCards
17+-- Portability : RecordWildCards
2118--
2219-- Data types for describing actions and data structures performed to interact
2320-- with Elasticsearch. The two main buckets your queries against Elasticsearch
@@ -45,10 +42,15 @@ module Database.Bloodhound.Types
4542 , mkTermsAggregation
4643 , mkTermsScriptAggregation
4744 , mkDateHistogram
45+ , mkCardinalityAggregation
4846 , mkDocVersion
47+ , mkStatsAggregation
48+ , mkExtendedStatsAggregation
4949 , docVersionNumber
50+ , toMissing
5051 , toTerms
5152 , toDateHistogram
53+ , toTopHits
5254 , omitNulls
5355 , BH(..)
5456 , runBH
@@ -59,6 +61,9 @@ module Database.Bloodhound.Types
5961 , mkBHEnv
6062 , MonadBH(..)
6163 , Version(..)
64+ , VersionNumber(..)
65+ , MaybeNA(..)
66+ , BuildHash(..)
6267 , Status(..)
6368 , Existence(..)
6469 , NullValue(..)
@@ -66,8 +71,12 @@ module Database.Bloodhound.Types
6671 , UpdatableIndexSetting(..)
6772 , IndexSettingsSummary(..)
6873 , AllocationPolicy(..)
74+ , Compression(..)
6975 , ReplicaBounds(..)
7076 , Bytes(..)
77+ , gigabytes
78+ , megabytes
79+ , kilobytes
7180 , FSType(..)
7281 , InitialShardCount(..)
7382 , NodeAttrFilter(..)
@@ -111,8 +120,8 @@ module Database.Bloodhound.Types
111120 , Pattern(..)
112121 , ShardResult(..)
113122 , Hit(..)
123+ , HitFields(..)
114124 , Filter(..)
115− , Seminearring(..)
116125 , BoolMatch(..)
117126 , Term(..)
118127 , GeoPoint(..)
@@ -139,8 +148,22 @@ module Database.Bloodhound.Types
139148 , RegexpFlags(..)
140149 , RegexpFlag(..)
141150 , FieldName(..)
151+ , ScriptFields(..)
152+ , ScriptFieldName
153+ , ScriptFieldValue
142154 , Script(..)
155+ , ScriptLanguage(..)
156+ , ScriptInline(..)
157+ , ScriptId(..)
158+ , ScriptParams(..)
159+ , ScriptParamName
160+ , ScriptParamValue
143161 , IndexName(..)
162+ , IndexSelection(..)
163+ , NodeSelection(..)
164+ , NodeSelector(..)
165+ , ForceMergeIndexSettings(..)
166+ , defaultForceMergeIndexSettings
144167 , TemplateName(..)
145168 , TemplatePattern(..)
146169 , MappingName(..)
@@ -164,8 +187,19 @@ module Database.Bloodhound.Types
164187 , BoolQuery(..)
165188 , BoostingQuery(..)
166189 , CommonTermsQuery(..)
190+ , FunctionScoreQuery(..)
191+ , BoostMode(..)
192+ , ScoreMode(..)
193+ , FunctionScoreFunctions(..)
194+ , ComponentFunctionScoreFunction(..)
195+ , FunctionScoreFunction(..)
196+ , Weight(..)
197+ , Seed(..)
198+ , FieldValueFactor(..)
199+ , Factor(..)
200+ , FactorModifier(..)
201+ , FactorMissingFieldValue(..)
167202 , DisMaxQuery(..)
168− , FilteredQuery(..)
169203 , FuzzyLikeThisQuery(..)
170204 , FuzzyLikeFieldQuery(..)
171205 , FuzzyQuery(..)
@@ -181,10 +215,16 @@ module Database.Bloodhound.Types
181215 , RangeQuery(..)
182216 , RegexpQuery(..)
183217 , QueryString(..)
218+ , TemplateQueryInline(..)
219+ , TemplateQueryKeyValuePairs(..)
220+ , WildcardQuery(..)
184221 , BooleanOperator(..)
185222 , ZeroTermsQuery(..)
186223 , CutoffFrequency(..)
187224 , Analyzer(..)
225+ , Tokenizer(..)
226+ , TokenFilter(..)
227+ , CharFilter(..)
188228 , MaxExpansions(..)
189229 , Lenient(..)
190230 , MatchQueryType(..)
@@ -231,15 +271,108 @@ module Database.Bloodhound.Types
231271 , CollectionMode(..)
232272 , TermOrder(..)
233273 , TermInclusion(..)
274+ , SnapshotRepoSelection(..)
275+ , GenericSnapshotRepo(..)
276+ , SnapshotRepo(..)
277+ , SnapshotRepoConversionError(..)
278+ , SnapshotRepoType(..)
279+ , GenericSnapshotRepoSettings(..)
280+ , SnapshotRepoUpdateSettings(..)
281+ , defaultSnapshotRepoUpdateSettings
282+ , SnapshotRepoName(..)
283+ , SnapshotRepoPattern(..)
284+ , SnapshotVerification(..)
285+ , SnapshotNodeVerification(..)
286+ , FullNodeId(..)
287+ , NodeName(..)
288+ , ClusterName(..)
289+ , NodesInfo(..)
290+ , NodesStats(..)
291+ , NodeStats(..)
292+ , NodeBreakersStats(..)
293+ , NodeBreakerStats(..)
294+ , NodeHTTPStats(..)
295+ , NodeTransportStats(..)
296+ , NodeFSStats(..)
297+ , NodeDataPathStats(..)
298+ , NodeFSTotalStats(..)
299+ , NodeNetworkStats(..)
300+ , NodeThreadPoolsStats(..)
301+ , NodeThreadPoolStats(..)
302+ , NodeJVMStats(..)
303+ , JVMBufferPoolStats(..)
304+ , JVMGCStats(..)
305+ , JVMPoolStats(..)
306+ , NodeProcessStats(..)
307+ , NodeOSStats(..)
308+ , LoadAvgs(..)
309+ , NodeIndicesStats(..)
310+ , EsAddress(..)
311+ , PluginName(..)
312+ , NodeInfo(..)
313+ , NodePluginInfo(..)
314+ , NodeHTTPInfo(..)
315+ , NodeTransportInfo(..)
316+ , BoundTransportAddress(..)
317+ , NodeNetworkInfo(..)
318+ , MacAddress(..)
319+ , NetworkInterfaceName(..)
320+ , NodeNetworkInterface(..)
321+ , NodeThreadPoolsInfo(..)
322+ , NodeThreadPoolInfo(..)
323+ , ThreadPoolSize(..)
324+ , ThreadPoolType(..)
325+ , NodeJVMInfo(..)
326+ , JVMMemoryPool(..)
327+ , JVMGCCollector(..)
328+ , JVMMemoryInfo(..)
329+ , PID(..)
330+ , NodeOSInfo(..)
331+ , CPUInfo(..)
332+ , NodeProcessInfo(..)
333+ , FsSnapshotRepo(..)
334+ , SnapshotCreateSettings(..)
335+ , defaultSnapshotCreateSettings
336+ , SnapshotSelection(..)
337+ , SnapshotPattern(..)
338+ , SnapshotInfo(..)
339+ , SnapshotShardFailure(..)
340+ , ShardId(..)
341+ , SnapshotName(..)
342+ , SnapshotState(..)
343+ , SnapshotRestoreSettings(..)
344+ , defaultSnapshotRestoreSettings
345+ , RestoreRenamePattern(..)
346+ , RestoreRenameToken(..)
347+ , RRGroupRefNum
348+ , rrGroupRefNum
349+ , mkRRGroupRefNum
350+ , RestoreIndexSettings(..)
351+ , Suggest(..)
352+ , SuggestType(..)
353+ , PhraseSuggester(..)
354+ , PhraseSuggesterHighlighter(..)
355+ , PhraseSuggesterCollate(..)
356+ , mkPhraseSuggester
357+ , SuggestOptions(..)
358+ , SuggestResponse(..)
359+ , NamedSuggestionResponse(..)
360+ , DirectGenerators(..)
361+ , mkDirectGenerators
362+ , DirectGeneratorSuggestModeTypes (..)
234363
235364 , Aggregation(..)
236365 , Aggregations
237366 , AggregationResults
367+ , BucketValue(..)
238368 , Bucket(..)
239369 , BucketAggregation(..)
240370 , TermsAggregation(..)
371+ , MissingAggregation(..)
241372 , ValueCountAggregation(..)
242373 , FilterAggregation(..)
374+ , CardinalityAggregation(..)
375+ , MaxAggregation(..)
243376 , DateHistogramAggregation(..)
244377 , DateRangeAggregation(..)
245378 , DateRangeAggRange(..)
@@ -247,6 +380,9 @@ module Database.Bloodhound.Types
247380 , DateMathAnchor(..)
248381 , DateMathModifier(..)
249382 , DateMathUnit(..)
383+ , TopHitsAggregation(..)
384+ , StatisticsAggregation(..)
385+ , SearchAfterKey
250386
251387 , Highlights(..)
252388 , FieldHighlight(..)
@@ -260,644 +396,36 @@ module Database.Bloodhound.Types
260396 , HighlightTag(..)
261397 , HitHighlight
262398
399+ , MissingResult(..)
263400 , TermsResult(..)
264401 , DateHistogramResult(..)
265402 , DateRangeResult(..)
403+ , TopHitResult(..)
266404
267405 , EsUsername(..)
268406 , EsPassword(..)
269− ) where
270−
271−import Control.Applicative
272−import Control.Monad.Catch
273−import Control.Monad.Except
274−import Control.Monad.Reader
275−import Control.Monad.State
276−import Control.Monad.Writer
277−import Data.Aeson
278−import Data.Aeson.Types (Pair, Parser, emptyObject,
279− parseMaybe)
280−import qualified Data.ByteString.Lazy.Char8 as L
281−import Data.Char
282−import Data.Hashable (Hashable)
283−import qualified Data.HashMap.Strict as HM
284−import Data.List (foldl', nub)
285−import Data.List.NonEmpty (NonEmpty (..), toList)
286−import qualified Data.Map.Strict as M
287−import Data.Maybe
288−import Data.Scientific (Scientific)
289−import Data.Text (Text)
290−import qualified Data.Text as T
291−import Data.Time.Calendar
292−import Data.Time.Clock (NominalDiffTime, UTCTime)
293−import Data.Time.Clock.POSIX
294−import qualified Data.Traversable as DT
295−import Data.Typeable (Typeable)
296−import qualified Data.Vector as V
297−import GHC.Enum
298−import GHC.Generics (Generic)
299−import Network.HTTP.Client
300−import qualified Network.HTTP.Types.Method as NHTM
301−
302−import Database.Bloodhound.Types.Class
303−import Database.Bloodhound.Types.Internal
304−
305−-- $setup
306−-- >>> :set -XOverloadedStrings
307−-- >>> import Database.Bloodhound
308−-- >>> let testServer = (Server "http://localhost:9200")
309−-- >>> let testIndex = IndexName "twitter"
310−-- >>> let testMapping = MappingName "tweet"
311−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
312−
313−-- defaultIndexSettings is exported by Database.Bloodhound as well
314−-- no trailing slashes in servers, library handles building the path.
315−
316−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
317−-- will be a noop. You can use the exported fields to customize it further, e.g.:
318−--
319−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
320−mkBHEnv :: Server -> Manager -> BHEnv
321−mkBHEnv s m = BHEnv s m return
322−
323−newtype BH m a = BH {
324− unBH :: ReaderT BHEnv m a
325− } deriving ( Functor
326− , Applicative
327− , Monad
328− , MonadIO
329− , MonadState s
330− , MonadWriter w
331− , MonadError e
332− , Alternative
333− , MonadPlus
334− , MonadFix
335− , MonadThrow
336− , MonadCatch
337− , MonadMask)
338−
339−instance MonadTrans BH where
340− lift = BH . lift
341−
342−instance (MonadReader r m) => MonadReader r (BH m) where
343− ask = lift ask
344− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
345− local f (m r)
346−
347−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
348− getBHEnv = BH getBHEnv
349−
350−runBH :: BHEnv -> BH m a -> m a
351−runBH e f = runReaderT (unBH f) e
352−
353−{-| 'Version' is embedded in 'Status' -}
354−data Version = Version { number :: Text
355− , build_hash :: Text
356− , build_timestamp :: UTCTime
357− , build_snapshot :: Bool
358− , lucene_version :: Text } deriving (Eq, Show, Generic, Typeable)
359−
360−{-| 'Status' is a data type for describing the JSON body returned by
361− Elasticsearch when you query its status. This was deprecated in 1.2.0.
362−
363− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
364−-}
365−
366−data Status = Status { ok :: Maybe Bool
367− , status :: Int
368− , name :: Text
369− , version :: Version
370− , tagline :: Text } deriving (Eq, Show, Generic)
371−
372−{-| 'IndexSettings' is used to configure the shards and replicas when you create
373− an Elasticsearch Index.
374−
375− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
376−-}
377−
378−data IndexSettings =
379− IndexSettings { indexShards :: ShardCount
380− , indexReplicas :: ReplicaCount } deriving (Eq, Show, Generic, Typeable)
381−
382−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
383−defaultIndexSettings :: IndexSettings
384−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
385−
386−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
387−
388− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
389−-}
390−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
391− -- ^ The number of replicas each shard has.
392− | AutoExpandReplicas ReplicaBounds
393− | BlocksReadOnly Bool
394− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
395− | BlocksRead Bool
396− -- ^ Set to True to disable read operations against the index.
397− | BlocksWrite Bool
398− -- ^ Set to True to disable write operations against the index.
399− | BlocksMetaData Bool
400− -- ^ Set to True to disable metadata operations against the index.
401− | RefreshInterval NominalDiffTime
402− -- ^ The async refresh interval of a shard
403− | IndexConcurrency Int
404− | FailOnMergeFailure Bool
405− | TranslogFlushThresholdOps Int
406− -- ^ When to flush on operations.
407− | TranslogFlushThresholdSize Bytes
408− -- ^ When to flush based on translog (bytes) size.
409− | TranslogFlushThresholdPeriod NominalDiffTime
410− -- ^ When to flush based on a period of not flushing.
411− | TranslogDisableFlush Bool
412− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
413− | CacheFilterMaxSize (Maybe Bytes)
414− -- ^ The maximum size of filter cache (per segment in shard).
415− | CacheFilterExpire (Maybe NominalDiffTime)
416− -- ^ The expire after access time for filter cache.
417− | GatewaySnapshotInterval NominalDiffTime
418− -- ^ The gateway snapshot interval (only applies to shared gateways).
419− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
420− -- ^ A node matching any rule will be allowed to host shards from the index.
421− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
422− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
423− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
424− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
425− | RoutingAllocationEnable AllocationPolicy
426− -- ^ Enables shard allocation for a specific index.
427− | RoutingAllocationShardsPerNode ShardCount
428− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
429− | RecoveryInitialShards InitialShardCount
430− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
431− | GCDeletes NominalDiffTime
432− | TTLDisablePurge Bool
433− -- ^ Disables temporarily the purge of expired docs.
434− | TranslogFSType FSType
435− | IndexCompoundFormat CompoundFormat
436− | IndexCompoundOnFlush Bool
437− | WarmerEnabled Bool
438− deriving (Eq, Show, Generic, Typeable)
439−
440−data AllocationPolicy = AllocAll
441− -- ^ Allows shard allocation for all shards.
442− | AllocPrimaries
443− -- ^ Allows shard allocation only for primary shards.
444− | AllocNewPrimaries
445− -- ^ Allows shard allocation only for primary shards for new indices.
446− | AllocNone
447− -- ^ No shard allocation is allowed
448− deriving (Eq, Show, Generic, Typeable)
449−
450−data ReplicaBounds = ReplicasBounded Int Int
451− | ReplicasLowerBounded Int
452− | ReplicasUnbounded
453− deriving (Eq, Show, Generic, Typeable)
454−
455−newtype Bytes = Bytes Int deriving (Eq, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
456−
457−data FSType = FSSimple
458− | FSBuffered deriving (Eq, Show, Generic, Typeable, Ord)
459−
460−data InitialShardCount = QuorumShards
461− | QuorumMinus1Shards
462− | FullShards
463− | FullMinus1Shards
464− | ExplicitShards Int
465− deriving (Eq, Show, Generic, Typeable)
466−
467−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
468− , nodeAttrFilterValues :: NonEmpty Text}
469− deriving (Eq, Show, Generic, Ord)
470−
471−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Show, Ord, Generic, Typeable)
472−
473−data CompoundFormat = CompoundFileFormat Bool
474− | MergeSegmentVsTotalIndex Double
475− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
476− deriving (Eq, Show, Generic, Typeable)
477−
478−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
479−
480−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
481− , sSummaryFixedSettings :: IndexSettings
482− , sSummaryUpdateable :: [UpdatableIndexSetting]}
483− deriving (Eq, Show, Generic, Typeable)
484−
485−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
486−type Reply = Network.HTTP.Client.Response L.ByteString
487−type Method = NHTM.Method
488−
489−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
490−
491− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
492−-}
493−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show, Generic, Typeable)
494−
495−data FieldType = GeoPointType
496− | GeoShapeType
497− | FloatType
498− | IntegerType
499− | LongType
500− | ShortType
501− | ByteType deriving (Eq, Show, Generic, Typeable)
502−
503−data FieldDefinition =
504− FieldDefinition { fieldType :: FieldType } deriving (Eq, Show, Generic, Typeable)
505−
506−{-| An 'IndexTemplate' defines a template that will automatically be
507− applied to new indices created. The templates include both
508− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
509− controls if the template will be applied to the index created.
510− Specify mappings as follows: @[toJSON TweetMapping, ...]@
511−
512− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
513−-}
514−data IndexTemplate =
515− IndexTemplate { templatePattern :: TemplatePattern
516− , templateSettings :: Maybe IndexSettings
517− , templateMappings :: [Value]
518− }
519−
520−data MappingField =
521− MappingField { mappingFieldName :: FieldName
522− , fieldDefinition :: FieldDefinition } deriving (Eq, Show, Generic, Typeable)
523−
524−{-| Support for type reification of 'Mapping's is currently incomplete, for
525− now the mapping API verbiage expects a 'ToJSON'able blob.
526−
527− Indexes have mappings, mappings are schemas for the documents contained in the
528− index. I'd recommend having only one mapping per index, always having a mapping,
529− and keeping different kinds of documents separated if possible.
530−-}
531−data Mapping = Mapping { typeName :: TypeName
532− , mappingFields :: [MappingField] } deriving (Eq, Show, Generic, Typeable)
533−
534−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
535− operation index, create, delete, and update. 'BulkIndex' behaves like an
536− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
537−
538− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
539−-}
540−data BulkOperation =
541− BulkIndex IndexName MappingName DocId Value
542− | BulkCreate IndexName MappingName DocId Value
543− | BulkDelete IndexName MappingName DocId
544− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show, Generic, Typeable)
545−
546−{-| 'EsResult' describes the standard wrapper JSON document that you see in
547− successful Elasticsearch lookups or lookups that couldn't find the document.
548−-}
549−data EsResult a = EsResult { _index :: Text
550− , _type :: Text
551− , _id :: Text
552− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show, Generic, Typeable)
553−
554−{-| 'EsResultFound' contains the document and its metadata inside of an
555− 'EsResult' when the document was successfully found.
556−-}
557−data EsResultFound a = EsResultFound { _version :: DocVersion
558− , _source :: a } deriving (Eq, Show, Generic, Typeable)
559−
560−{-| 'EsError' is the generic type that will be returned when there was a
561− problem. If you can't parse the expected response, its a good idea to
562− try parsing this.
563−-}
564−data EsError = EsError { errorStatus :: Int
565− , errorMessage :: Text } deriving (Eq, Show, Generic, Typeable)
566−
567−{-| 'EsProtocolException' ideally should never be thrown. It will only
568−be thrown when Bloodhound can't parse a response returned by the
569−ElasticSearch server. This should be reported as a bug to the bug
570−tracker. Be sure to include the body.
571−-}
572−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
573− deriving (Eq, Show, Generic, Typeable)
574−
575−instance Exception EsProtocolException
576−
577−data IndexAlias = IndexAlias { srcIndex :: IndexName
578− , indexAlias :: IndexAliasName } deriving (Eq, Show, Generic, Typeable)
579−
580−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Show, Generic, ToJSON)
581−
582−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
583− | RemoveAlias IndexAlias deriving (Show, Eq, Generic, Typeable)
584−
585−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
586− , aliasCreateFilter :: Maybe Filter}
587− deriving (Show, Eq, Generic, Typeable)
588−
589−data AliasRouting = AllAliasRouting RoutingValue
590− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
591− deriving (Show, Eq, Generic, Typeable)
592−
593−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Show, Eq, Generic, Typeable)
594−
595−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Show, Eq, Generic, ToJSON, FromJSON, Typeable)
596−
597−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Show, Eq, Generic, ToJSON, FromJSON, Typeable)
598−
599−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Show, Eq, Generic, Typeable)
600−
601−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
602−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
603− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Show, Eq, Generic, Typeable)
604−
605−{-| 'DocVersion' is an integer version number for a document between 1
606−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
607−-}
608−newtype DocVersion = DocVersion {
609− docVersionNumber :: Int
610− } deriving (Eq, Show, Generic, Ord, ToJSON)
611−
612−-- | Smart constructor for in-range doc version
613−mkDocVersion :: Int -> Maybe DocVersion
614−mkDocVersion i
615− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
616− Just $ DocVersion i
617− | otherwise = Nothing
618−
619−
620−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
621−own version numbers instead of ones from ES.
622−-}
623−newtype ExternalDocVersion = ExternalDocVersion DocVersion
624− deriving (Eq, Show, Generic, Ord, Bounded, Enum, ToJSON)
625−
626−{-| 'VersionControl' is specified when indexing documents as a
627−optimistic concurrency control.
628−-}
629−data VersionControl = NoVersionControl
630− -- ^ Don't send a version. This is a pure overwrite.
631− | InternalVersion DocVersion
632− -- ^ Use the default ES versioning scheme. Only
633− -- index the document if the version is the same
634− -- as the one specified. Only applicable to
635− -- updates, as you should be getting Version from
636− -- a search result.
637− | ExternalGT ExternalDocVersion
638− -- ^ Use your own version numbering. Only index
639− -- the document if the version is strictly higher
640− -- OR the document doesn't exist. The given
641− -- version will be used as the new version number
642− -- for the stored document. N.B. All updates must
643− -- increment this number, meaning there is some
644− -- global, external ordering of updates.
645− | ExternalGTE ExternalDocVersion
646− -- ^ Use your own version numbering. Only index
647− -- the document if the version is equal or higher
648− -- than the stored version. Will succeed if there
649− -- is no existing document. The given version will
650− -- be used as the new version number for the
651− -- stored document. Use with care, as this could
652− -- result in data loss.
653− | ForceVersion ExternalDocVersion
654− -- ^ The document will always be indexed and the
655− -- given version will be the new version. This is
656− -- typically used for correcting errors. Use with
657− -- care, as this could result in data loss.
658− deriving (Show, Eq, Generic, Ord)
659−
660−{-| 'DocumentParent' is used to specify a parent document.
661−-}
662−newtype DocumentParent = DocumentParent DocId
663− deriving (Eq, Show, Generic, Typeable)
664−
665−{-| 'IndexDocumentSettings' are special settings supplied when indexing
666−a document. For the best backwards compatiblity when new fields are
667−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
668−-}
669−data IndexDocumentSettings =
670− IndexDocumentSettings { idsVersionControl :: VersionControl
671− , idsParent :: Maybe DocumentParent
672− } deriving (Eq, Show, Generic, Typeable)
673−
674−{-| Reasonable default settings. Chooses no version control and no parent.
675−-}
676−defaultIndexDocumentSettings :: IndexDocumentSettings
677−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
678−
679−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
680− dependent with later sorts acting as tie-breakers for earlier sorts.
681−-}
682−type Sort = [SortSpec]
683−
684−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
685− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
686− 'DistanceUnit' to express "nearness" to a single geographical point as a
687− sort specification.
688−
689−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
690−-}
691−data SortSpec = DefaultSortSpec DefaultSort
692− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show, Generic, Typeable)
693−
694−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
695− 'mkSort' convenience function for when you want to specify only the most
696− common parameters.
697−
698−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
699−-}
700−data DefaultSort =
701− DefaultSort { sortFieldName :: FieldName
702− , sortOrder :: SortOrder
703− -- default False
704− , ignoreUnmapped :: Bool
705− , sortMode :: Maybe SortMode
706− , missingSort :: Maybe Missing
707− , nestedFilter :: Maybe Filter } deriving (Eq, Show, Generic, Typeable)
708−
709−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
710− encoded into "asc" or "desc" when turned into JSON.
711−
712−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
713−-}
714−data SortOrder = Ascending
715− | Descending deriving (Eq, Show, Generic, Typeable)
716−
717−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
718− sorted last, first, or using a custom value as a substitute.
719−
720−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
721−-}
722−data Missing = LastMissing
723− | FirstMissing
724− | CustomMissing Text deriving (Eq, Show, Generic, Typeable)
725−
726−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
727−
728−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
729−-}
730−data SortMode = SortMin
731− | SortMax
732− | SortSum
733− | SortAvg deriving (Eq, Show, Generic, Typeable)
734−
735−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
736− that you can concisely describe the usual kind of 'SortSpec's you want.
737−-}
738−mkSort :: FieldName -> SortOrder -> DefaultSort
739−mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
740−
741−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
742− 'Query's cannot be cached.
743−-}
744−type Cache = Bool -- caching on/off
745−defaultCache :: Cache
746−defaultCache = False
747−
748−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
749−-}
750−type PrefixValue = Text
751−
752−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
753− JSON encoding baked in. Used all over the place.
754−-}
755−data BooleanOperator = And | Or deriving (Eq, Show, Generic, Typeable)
756−
757−{-| 'ShardCount' is part of 'IndexSettings'
758−-}
759−newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic, ToJSON, Typeable)
760−
761−{-| 'ReplicaCount' is part of 'IndexSettings'
762−-}
763−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic, ToJSON, Typeable)
764−
765−{-| 'IndexName' is used to describe which index to query/create/delete
766−-}
767−newtype IndexName = IndexName Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)
768−
769−{-| 'TemplateName' is used to describe which template to query/create/delete
770−-}
771−newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
772−
773−{-| 'TemplatePattern' represents a pattern which is matched against index names
774−-}
775−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
776−
777−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
778− the data in the indices.
779−-}
780−newtype MappingName = MappingName Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)
781−
782−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
783− Can be set by the user or created by ES itself. Often used in client
784− functions for poking at specific documents.
785−-}
786−newtype DocId = DocId Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)
787−
788−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
789−-}
790−newtype QueryString = QueryString Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)
791−
792−{-| 'FieldName' is used all over the place wherever a specific field within
793− a document needs to be specified, usually in 'Query's or 'Filter's.
794−-}
795−newtype FieldName = FieldName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
796407
797−
798−{-| 'Script' is often used in place of 'FieldName' to specify more
799−complex ways of extracting a value from a document.
800−-}
801−newtype Script = Script { scriptText :: Text } deriving (Eq, Show, Generic, Typeable)
802−
803−{-| 'CacheName' is used in 'RegexpFilter' for describing the
804− 'CacheKey' keyed caching behavior.
805−-}
806−newtype CacheName = CacheName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
807−
808−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
809−-}
810−newtype CacheKey =
811− CacheKey Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
812−newtype Existence =
813− Existence Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
814−newtype NullValue =
815− NullValue Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
816−newtype CutoffFrequency =
817− CutoffFrequency Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
818−newtype Analyzer =
819− Analyzer Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
820−newtype MaxExpansions =
821− MaxExpansions Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
822−
823−{-| 'Lenient', if set to true, will cause format based failures to be
824− ignored. I don't know what the bloody default is, Elasticsearch
825− documentation didn't say what it was. Let me know if you figure it out.
826−-}
827−newtype Lenient =
828− Lenient Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
829−newtype Tiebreaker =
830− Tiebreaker Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
831−newtype Boost =
832− Boost Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
833−newtype BoostTerms =
834− BoostTerms Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
835−
836−{-| 'MinimumMatch' controls how many should clauses in the bool query should
837− match. Can be an absolute value (2) or a percentage (30%) or a
838− combination of both.
839−-}
840−newtype MinimumMatch =
841− MinimumMatch Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
842−newtype DisableCoord =
843− DisableCoord Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
844−newtype IgnoreTermFrequency =
845− IgnoreTermFrequency Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
846−newtype MinimumTermFrequency =
847− MinimumTermFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
848−newtype MaxQueryTerms =
849− MaxQueryTerms Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
850−newtype Fuzziness =
851− Fuzziness Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
852−
853−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
854−newtype PrefixLength =
855− PrefixLength Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
856−newtype TypeName =
857− TypeName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
858−newtype PercentMatch =
859− PercentMatch Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
860−newtype StopWord =
861− StopWord Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
862−newtype QueryPath =
863− QueryPath Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
864−
865−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
866− heavy, because all terms in the index need to be examined, just in case
867− they match. Leading wildcards can be disabled by setting
868− 'AllowLeadingWildcard' to false. -}
869−newtype AllowLeadingWildcard =
870− AllowLeadingWildcard Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
871−newtype LowercaseExpanded =
872− LowercaseExpanded Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
873−newtype EnablePositionIncrements =
874− EnablePositionIncrements Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
875−
876−{-| By default, wildcard terms in a query are not analyzed.
877− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
878−-}
879−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
880−
881−{-| 'GeneratePhraseQueries' defaults to false.
882−-}
883−newtype GeneratePhraseQueries =
884− GeneratePhraseQueries Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
885−
886−{-| 'Locale' is used for string conversions - defaults to ROOT.
887−-}
888−newtype Locale = Locale Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
889−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
890−newtype MinWordLength = MinWordLength Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
891−
892−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
893− phrase matches. Default is 0.
894−-}
895−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
896−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
897−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
898−
899−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
900−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
408+ , Analysis(..)
409+ , AnalyzerDefinition(..)
410+ , TokenizerDefinition(..)
411+ , TokenFilterDefinition(..)
412+ , CharFilterDefinition(..)
413+ , Ngram(..)
414+ , TokenChar(..)
415+ , Shingle(..)
416+ , Language(..)
417+ ) where
418+
419+import Bloodhound.Import
420+
421+import Database.Bloodhound.Internal.Aggregation
422+import Database.Bloodhound.Internal.Analysis
423+import Database.Bloodhound.Internal.Client
424+import Database.Bloodhound.Internal.Highlight
425+import Database.Bloodhound.Internal.Newtypes
426+import Database.Bloodhound.Internal.Query
427+import Database.Bloodhound.Internal.Sort
428+import Database.Bloodhound.Internal.Suggest
901429
902430{-| 'unpackId' is a silly convenience function that gets used once.
903431-}
@@ -905,8 +433,6 @@ unpackId :: DocId -> Text
905433unpackId (DocId docId) = docId
906434
907435type TrackSortScores = Bool
908−newtype From = From Int deriving (Eq, Show, Generic, ToJSON)
909−newtype Size = Size Int deriving (Eq, Show, Generic, ToJSON)
910436
911437data Search = Search { queryBody :: Maybe Query
912438 , filterBody :: Maybe Filter
@@ -918,537 +444,74 @@ data Search = Search { queryBody :: Maybe Query
918444 , from :: From
919445 , size :: Size
920446 , searchType :: SearchType
447+ , searchAfterKey :: Maybe SearchAfterKey
921448 , fields :: Maybe [FieldName]
922− , source :: Maybe Source } deriving (Eq, Show, Generic, Typeable)
449+ , scriptFields :: Maybe ScriptFields
450+ , source :: Maybe Source
451+ , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
452+ } deriving (Eq, Show)
453+
454+
455+instance ToJSON Search where
456+ toJSON (Search mquery sFilter sort searchAggs
457+ highlight sTrackSortScores sFrom sSize _ sAfter sFields
458+ sScriptFields sSource sSuggest) =
459+ omitNulls [ "query" .= query'
460+ , "sort" .= sort
461+ , "aggregations" .= searchAggs
462+ , "highlight" .= highlight
463+ , "from" .= sFrom
464+ , "size" .= sSize
465+ , "track_scores" .= sTrackSortScores
466+ , "search_after" .= sAfter
467+ , "fields" .= sFields
468+ , "script_fields" .= sScriptFields
469+ , "_source" .= sSource
470+ , "suggest" .= sSuggest]
471+
472+ where query' = case sFilter of
473+ Nothing -> mquery
474+ Just x ->
475+ Just
476+ . QueryBoolQuery
477+ $ mkBoolQuery (maybeToList mquery)
478+ [x] [] []
923479
924480data SearchType = SearchTypeQueryThenFetch
925481 | SearchTypeDfsQueryThenFetch
926− | SearchTypeCount
927− | SearchTypeScan
928− | SearchTypeQueryAndFetch
929− | SearchTypeDfsQueryAndFetch
930− deriving (Eq, Show, Generic, Typeable)
482+ deriving (Eq, Show)
931483
932484data Source =
933485 NoSource
934486 | SourcePatterns PatternOrPatterns
935487 | SourceIncludeExclude Include Exclude
936− deriving (Show, Eq, Generic, Typeable)
937−
938−data PatternOrPatterns = PopPattern Pattern
939− | PopPatterns [Pattern] deriving (Eq, Show, Generic, Typeable)
940−
941−data Include = Include [Pattern] deriving (Eq, Show, Generic, Typeable)
942−data Exclude = Exclude [Pattern] deriving (Eq, Show, Generic, Typeable)
943−
944−newtype Pattern = Pattern Text deriving (Eq, Show, Generic, Typeable)
945−
946−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
947− , highlightFields :: [FieldHighlight]
948− } deriving (Show, Eq, Generic, Typeable)
949−
950−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
951− deriving (Show, Eq, Generic, Typeable)
952−
953−
954−data HighlightSettings = Plain PlainHighlight
955− | Postings PostingsHighlight
956− | FastVector FastVectorHighlight
957− deriving (Show, Eq, Generic, Typeable)
958−data PlainHighlight =
959− PlainHighlight { plainCommon :: Maybe CommonHighlight
960− , plainNonPost :: Maybe NonPostings } deriving (Show, Eq, Generic, Typeable)
961−
962− -- This requires that index_options are set to 'offset' in the mapping.
963−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Show, Eq, Generic, Typeable)
964−
965−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
966−data FastVectorHighlight =
967− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
968− , fvNonPostSettings :: Maybe NonPostings
969− , boundaryChars :: Maybe Text
970− , boundaryMaxScan :: Maybe Int
971− , fragmentOffset :: Maybe Int
972− , matchedFields :: [Text]
973− , phraseLimit :: Maybe Int
974− } deriving (Show, Eq, Generic, Typeable)
975−
976−data CommonHighlight =
977− CommonHighlight { order :: Maybe Text
978− , forceSource :: Maybe Bool
979− , tag :: Maybe HighlightTag
980− , encoder :: Maybe HighlightEncoder
981− , noMatchSize :: Maybe Int
982− , highlightQuery :: Maybe Query
983− , requireFieldMatch :: Maybe Bool
984− } deriving (Show, Eq, Generic, Typeable)
985−
986−-- Settings that are only applicable to FastVector and Plain highlighters.
987−data NonPostings =
988− NonPostings { fragmentSize :: Maybe Int
989− , numberOfFragments :: Maybe Int} deriving (Show, Eq, Generic, Typeable)
990−
991−data HighlightEncoder = DefaultEncoder
992− | HTMLEncoder
993− deriving (Show, Eq, Generic, Typeable)
994−
995−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
996−data HighlightTag = TagSchema Text
997− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
998− deriving (Show, Eq, Generic, Typeable)
999−
1000−
1001−data Query =
1002− TermQuery Term (Maybe Boost)
1003− | TermsQuery Text (NonEmpty Text)
1004− | QueryMatchQuery MatchQuery
1005− | QueryMultiMatchQuery MultiMatchQuery
1006− | QueryBoolQuery BoolQuery
1007− | QueryBoostingQuery BoostingQuery
1008− | QueryCommonTermsQuery CommonTermsQuery
1009− | ConstantScoreFilter Filter Boost
1010− | ConstantScoreQuery Query Boost
1011− | QueryDisMaxQuery DisMaxQuery
1012− | QueryFilteredQuery FilteredQuery
1013− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1014− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1015− | QueryFuzzyQuery FuzzyQuery
1016− | QueryHasChildQuery HasChildQuery
1017− | QueryHasParentQuery HasParentQuery
1018− | IdsQuery MappingName [DocId]
1019− | QueryIndicesQuery IndicesQuery
1020− | MatchAllQuery (Maybe Boost)
1021− | QueryMoreLikeThisQuery MoreLikeThisQuery
1022− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1023− | QueryNestedQuery NestedQuery
1024− | QueryPrefixQuery PrefixQuery
1025− | QueryQueryStringQuery QueryStringQuery
1026− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1027− | QueryRangeQuery RangeQuery
1028− | QueryRegexpQuery RegexpQuery
1029− deriving (Eq, Show, Generic, Typeable)
1030−
1031−data RegexpQuery =
1032− RegexpQuery { regexpQueryField :: FieldName
1033− , regexpQuery :: Regexp
1034− , regexpQueryFlags :: RegexpFlags
1035− , regexpQueryBoost :: Maybe Boost
1036− } deriving (Eq, Show, Generic, Typeable)
1037−
1038−data RangeQuery =
1039− RangeQuery { rangeQueryField :: FieldName
1040− , rangeQueryRange :: RangeValue
1041− , rangeQueryBoost :: Boost } deriving (Eq, Show, Generic, Typeable)
1042−
1043−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1044−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1045−
1046−data SimpleQueryStringQuery =
1047− SimpleQueryStringQuery
1048− { simpleQueryStringQuery :: QueryString
1049− , simpleQueryStringField :: Maybe FieldOrFields
1050− , simpleQueryStringOperator :: Maybe BooleanOperator
1051− , simpleQueryStringAnalyzer :: Maybe Analyzer
1052− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1053− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1054− , simpleQueryStringLocale :: Maybe Locale
1055− } deriving (Eq, Show, Generic, Typeable)
1056−
1057−data SimpleQueryFlag =
1058− SimpleQueryAll
1059− | SimpleQueryNone
1060− | SimpleQueryAnd
1061− | SimpleQueryOr
1062− | SimpleQueryPrefix
1063− | SimpleQueryPhrase
1064− | SimpleQueryPrecedence
1065− | SimpleQueryEscape
1066− | SimpleQueryWhitespace
1067− | SimpleQueryFuzzy
1068− | SimpleQueryNear
1069− | SimpleQuerySlop deriving (Eq, Show, Generic, Typeable)
1070−
1071−-- use_dis_max and tie_breaker when fields are plural?
1072−data QueryStringQuery =
1073− QueryStringQuery
1074− { queryStringQuery :: QueryString
1075− , queryStringDefaultField :: Maybe FieldName
1076− , queryStringOperator :: Maybe BooleanOperator
1077− , queryStringAnalyzer :: Maybe Analyzer
1078− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1079− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1080− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1081− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1082− , queryStringFuzziness :: Maybe Fuzziness
1083− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1084− , queryStringPhraseSlop :: Maybe PhraseSlop
1085− , queryStringBoost :: Maybe Boost
1086− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1087− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1088− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1089− , queryStringLenient :: Maybe Lenient
1090− , queryStringLocale :: Maybe Locale
1091− } deriving (Eq, Show, Generic, Typeable)
1092−
1093−mkQueryStringQuery :: QueryString -> QueryStringQuery
1094−mkQueryStringQuery qs =
1095− QueryStringQuery qs Nothing Nothing
1096− Nothing Nothing Nothing Nothing
1097− Nothing Nothing Nothing Nothing
1098− Nothing Nothing Nothing Nothing
1099− Nothing Nothing
1100−
1101−data FieldOrFields = FofField FieldName
1102− | FofFields (NonEmpty FieldName) deriving (Eq, Show, Generic, Typeable)
1103−
1104−data PrefixQuery =
1105− PrefixQuery
1106− { prefixQueryField :: FieldName
1107− , prefixQueryPrefixValue :: Text
1108− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show, Generic, Typeable)
1109−
1110−data NestedQuery =
1111− NestedQuery
1112− { nestedQueryPath :: QueryPath
1113− , nestedQueryScoreType :: ScoreType
1114− , nestedQuery :: Query } deriving (Eq, Show, Generic, Typeable)
1115−
1116−data MoreLikeThisFieldQuery =
1117− MoreLikeThisFieldQuery
1118− { moreLikeThisFieldText :: Text
1119− , moreLikeThisFieldFields :: FieldName
1120− -- default 0.3 (30%)
1121− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1122− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1123− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1124− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1125− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1126− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1127− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1128− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1129− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1130− , moreLikeThisFieldBoost :: Maybe Boost
1131− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1132− } deriving (Eq, Show, Generic, Typeable)
1133−
1134−data MoreLikeThisQuery =
1135− MoreLikeThisQuery
1136− { moreLikeThisText :: Text
1137− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1138− -- default 0.3 (30%)
1139− , moreLikeThisPercentMatch :: Maybe PercentMatch
1140− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1141− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1142− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1143− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1144− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1145− , moreLikeThisMinWordLength :: Maybe MinWordLength
1146− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1147− , moreLikeThisBoostTerms :: Maybe BoostTerms
1148− , moreLikeThisBoost :: Maybe Boost
1149− , moreLikeThisAnalyzer :: Maybe Analyzer
1150− } deriving (Eq, Show, Generic, Typeable)
1151−
1152−data IndicesQuery =
1153− IndicesQuery
1154− { indicesQueryIndices :: [IndexName]
1155− , indicesQuery :: Query
1156− -- default "all"
1157− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show, Generic, Typeable)
1158−
1159−data HasParentQuery =
1160− HasParentQuery
1161− { hasParentQueryType :: TypeName
1162− , hasParentQuery :: Query
1163− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show, Generic, Typeable)
1164−
1165−data HasChildQuery =
1166− HasChildQuery
1167− { hasChildQueryType :: TypeName
1168− , hasChildQuery :: Query
1169− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show, Generic, Typeable)
1170−
1171−data ScoreType =
1172− ScoreTypeMax
1173− | ScoreTypeSum
1174− | ScoreTypeAvg
1175− | ScoreTypeNone deriving (Eq, Show, Generic, Typeable)
1176−
1177−data FuzzyQuery =
1178− FuzzyQuery { fuzzyQueryField :: FieldName
1179− , fuzzyQueryValue :: Text
1180− , fuzzyQueryPrefixLength :: PrefixLength
1181− , fuzzyQueryMaxExpansions :: MaxExpansions
1182− , fuzzyQueryFuzziness :: Fuzziness
1183− , fuzzyQueryBoost :: Maybe Boost
1184− } deriving (Eq, Show, Generic, Typeable)
1185−
1186−data FuzzyLikeFieldQuery =
1187− FuzzyLikeFieldQuery
1188− { fuzzyLikeField :: FieldName
1189− -- anaphora is good for the soul.
1190− , fuzzyLikeFieldText :: Text
1191− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1192− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1193− , fuzzyLikeFieldFuzziness :: Fuzziness
1194− , fuzzyLikeFieldPrefixLength :: PrefixLength
1195− , fuzzyLikeFieldBoost :: Boost
1196− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1197− } deriving (Eq, Show, Generic, Typeable)
1198−
1199−data FuzzyLikeThisQuery =
1200− FuzzyLikeThisQuery
1201− { fuzzyLikeFields :: [FieldName]
1202− , fuzzyLikeText :: Text
1203− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1204− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1205− , fuzzyLikeFuzziness :: Fuzziness
1206− , fuzzyLikePrefixLength :: PrefixLength
1207− , fuzzyLikeBoost :: Boost
1208− , fuzzyLikeAnalyzer :: Maybe Analyzer
1209− } deriving (Eq, Show, Generic, Typeable)
1210−
1211−data FilteredQuery =
1212− FilteredQuery
1213− { filteredQuery :: Query
1214− , filteredFilter :: Filter } deriving (Eq, Show, Generic, Typeable)
1215−
1216−data DisMaxQuery =
1217− DisMaxQuery { disMaxQueries :: [Query]
1218− -- default 0.0
1219− , disMaxTiebreaker :: Tiebreaker
1220− , disMaxBoost :: Maybe Boost
1221− } deriving (Eq, Show, Generic, Typeable)
1222−
1223−data MatchQuery =
1224− MatchQuery { matchQueryField :: FieldName
1225− , matchQueryQueryString :: QueryString
1226− , matchQueryOperator :: BooleanOperator
1227− , matchQueryZeroTerms :: ZeroTermsQuery
1228− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1229− , matchQueryMatchType :: Maybe MatchQueryType
1230− , matchQueryAnalyzer :: Maybe Analyzer
1231− , matchQueryMaxExpansions :: Maybe MaxExpansions
1232− , matchQueryLenient :: Maybe Lenient
1233− , matchQueryBoost :: Maybe Boost } deriving (Eq, Show, Generic, Typeable)
1234−
1235−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1236− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1237−-}
1238−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1239−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
488+ deriving (Eq, Show)
1240489
1241−data MatchQueryType =
1242− MatchPhrase
1243− | MatchPhrasePrefix deriving (Eq, Show, Generic, Typeable)
1244−
1245−data MultiMatchQuery =
1246− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1247− , multiMatchQueryString :: QueryString
1248− , multiMatchQueryOperator :: BooleanOperator
1249− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1250− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1251− , multiMatchQueryType :: Maybe MultiMatchQueryType
1252− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1253− , multiMatchQueryAnalyzer :: Maybe Analyzer
1254− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1255− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show, Generic, Typeable)
1256−
1257−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1258− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1259− make a 'MultiMatchQuery'.
1260−-}
1261−
1262−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1263−mkMultiMatchQuery matchFields query =
1264− MultiMatchQuery matchFields query
1265− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1266−
1267−data MultiMatchQueryType =
1268− MultiMatchBestFields
1269− | MultiMatchMostFields
1270− | MultiMatchCrossFields
1271− | MultiMatchPhrase
1272− | MultiMatchPhrasePrefix deriving (Eq, Show, Generic, Typeable)
1273−
1274−data BoolQuery =
1275− BoolQuery { boolQueryMustMatch :: [Query]
1276− , boolQueryMustNotMatch :: [Query]
1277− , boolQueryShouldMatch :: [Query]
1278− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1279− , boolQueryBoost :: Maybe Boost
1280− , boolQueryDisableCoord :: Maybe DisableCoord
1281− } deriving (Eq, Show, Generic, Typeable)
1282−
1283−mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1284−mkBoolQuery must mustNot should =
1285− BoolQuery must mustNot should Nothing Nothing Nothing
1286−
1287−data BoostingQuery =
1288− BoostingQuery { positiveQuery :: Query
1289− , negativeQuery :: Query
1290− , negativeBoost :: Boost } deriving (Eq, Show, Generic, Typeable)
1291−
1292−data CommonTermsQuery =
1293− CommonTermsQuery { commonField :: FieldName
1294− , commonQuery :: QueryString
1295− , commonCutoffFrequency :: CutoffFrequency
1296− , commonLowFreqOperator :: BooleanOperator
1297− , commonHighFreqOperator :: BooleanOperator
1298− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1299− , commonBoost :: Maybe Boost
1300− , commonAnalyzer :: Maybe Analyzer
1301− , commonDisableCoord :: Maybe DisableCoord
1302− } deriving (Eq, Show, Generic, Typeable)
1303−
1304−data CommonMinimumMatch =
1305− CommonMinimumMatchHighLow MinimumMatchHighLow
1306− | CommonMinimumMatch MinimumMatch
1307− deriving (Eq, Show, Generic, Typeable)
1308−
1309−data MinimumMatchHighLow =
1310− MinimumMatchHighLow { lowFreq :: MinimumMatch
1311− , highFreq :: MinimumMatch } deriving (Eq, Show, Generic, Typeable)
1312−
1313−data Filter = AndFilter [Filter] Cache
1314− | OrFilter [Filter] Cache
1315− | NotFilter Filter Cache
1316− | IdentityFilter
1317− | BoolFilter BoolMatch
1318− | ExistsFilter FieldName -- always cached
1319− | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1320− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1321− | GeoDistanceRangeFilter GeoPoint DistanceRange
1322− | GeoPolygonFilter FieldName [LatLon]
1323− | IdsFilter MappingName [DocId]
1324− | LimitFilter Int
1325− | MissingFilter FieldName Existence NullValue
1326− | PrefixFilter FieldName PrefixValue Cache
1327− | QueryFilter Query Cache
1328− | RangeFilter FieldName RangeValue RangeExecution Cache
1329− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1330− | TermFilter Term Cache
1331− deriving (Eq, Show, Generic, Typeable)
1332−
1333−data ZeroTermsQuery = ZeroTermsNone
1334− | ZeroTermsAll deriving (Eq, Show, Generic, Typeable)
1335−
1336−data RangeExecution = RangeExecutionIndex
1337− | RangeExecutionFielddata deriving (Eq, Show, Generic, Typeable)
1338−
1339−newtype Regexp = Regexp Text deriving (Eq, Show, Generic, Typeable, FromJSON)
1340−
1341−data RegexpFlags = AllRegexpFlags
1342− | NoRegexpFlags
1343− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show, Generic, Typeable)
1344−
1345−data RegexpFlag = AnyString
1346− | Automaton
1347− | Complement
1348− | Empty
1349− | Intersection
1350− | Interval deriving (Eq, Show, Generic, Typeable)
1351−
1352−newtype LessThan = LessThan Double deriving (Eq, Show, Generic, Typeable)
1353−newtype LessThanEq = LessThanEq Double deriving (Eq, Show, Generic, Typeable)
1354−newtype GreaterThan = GreaterThan Double deriving (Eq, Show, Generic, Typeable)
1355−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show, Generic, Typeable)
1356−
1357−newtype LessThanD = LessThanD UTCTime deriving (Eq, Show, Generic, Typeable)
1358−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show, Generic, Typeable)
1359−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show, Generic, Typeable)
1360−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show, Generic, Typeable)
1361−
1362−data RangeValue = RangeDateLte LessThanEqD
1363− | RangeDateLt LessThanD
1364− | RangeDateGte GreaterThanEqD
1365− | RangeDateGt GreaterThanD
1366− | RangeDateGtLt GreaterThanD LessThanD
1367− | RangeDateGteLte GreaterThanEqD LessThanEqD
1368− | RangeDateGteLt GreaterThanEqD LessThanD
1369− | RangeDateGtLte GreaterThanD LessThanEqD
1370− | RangeDoubleLte LessThanEq
1371− | RangeDoubleLt LessThan
1372− | RangeDoubleGte GreaterThanEq
1373− | RangeDoubleGt GreaterThan
1374− | RangeDoubleGtLt GreaterThan LessThan
1375− | RangeDoubleGteLte GreaterThanEq LessThanEq
1376− | RangeDoubleGteLt GreaterThanEq LessThan
1377− | RangeDoubleGtLte GreaterThan LessThanEq
1378− deriving (Eq, Show, Generic, Typeable)
1379−
1380−rangeValueToPair :: RangeValue -> [Pair]
1381−rangeValueToPair rv = case rv of
1382− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1383− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1384− RangeDateLt (LessThanD t) -> ["lt" .= t]
1385− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1386− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1387− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1388− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1389− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1390− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1391− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1392− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1393− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1394− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1395− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1396− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1397− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1398−
1399−data Term = Term { termField :: Text
1400− , termValue :: Text } deriving (Eq, Show, Generic, Typeable)
1401−
1402−data BoolMatch = MustMatch Term Cache
1403− | MustNotMatch Term Cache
1404− | ShouldMatch [Term] Cache deriving (Eq, Show, Generic, Typeable)
1405−
1406−-- "memory" or "indexed"
1407−data GeoFilterType = GeoFilterMemory
1408− | GeoFilterIndexed deriving (Eq, Show, Generic, Typeable)
1409−
1410−data LatLon = LatLon { lat :: Double
1411− , lon :: Double } deriving (Eq, Show, Generic, Typeable)
1412−
1413−data GeoBoundingBox =
1414− GeoBoundingBox { topLeft :: LatLon
1415− , bottomRight :: LatLon } deriving (Eq, Show, Generic, Typeable)
490+instance ToJSON Source where
491+ toJSON NoSource = toJSON False
492+ toJSON (SourcePatterns patterns) = toJSON patterns
493+ toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
1416494
1417−data GeoBoundingBoxConstraint =
1418− GeoBoundingBoxConstraint { geoBBField :: FieldName
1419− , constraintBox :: GeoBoundingBox
1420− , bbConstraintcache :: Cache
1421− , geoType :: GeoFilterType
1422− } deriving (Eq, Show, Generic, Typeable)
495+data PatternOrPatterns = PopPattern Pattern
496+ | PopPatterns [Pattern] deriving (Eq, Read, Show)
1423497
1424−data GeoPoint =
1425− GeoPoint { geoField :: FieldName
1426− , latLon :: LatLon} deriving (Eq, Show, Generic, Typeable)
498+instance ToJSON PatternOrPatterns where
499+ toJSON (PopPattern pattern) = toJSON pattern
500+ toJSON (PopPatterns patterns) = toJSON patterns
1427501
1428−data DistanceUnit = Miles
1429− | Yards
1430− | Feet
1431− | Inches
1432− | Kilometers
1433− | Meters
1434− | Centimeters
1435− | Millimeters
1436− | NauticalMiles deriving (Eq, Show, Generic, Typeable)
502+data Include = Include [Pattern] deriving (Eq, Read, Show)
503+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
1437504
1438−data DistanceType = Arc
1439− | SloppyArc -- doesn't exist <1.0
1440− | Plane deriving (Eq, Show, Generic, Typeable)
505+instance ToJSON Include where
506+ toJSON (Include patterns) = toJSON patterns
1441507
1442−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1443− | NoOptimizeBbox deriving (Eq, Show, Generic, Typeable)
508+instance ToJSON Exclude where
509+ toJSON (Exclude patterns) = toJSON patterns
1444510
1445−data Distance =
1446− Distance { coefficient :: Double
1447− , unit :: DistanceUnit } deriving (Eq, Show, Generic, Typeable)
511+newtype Pattern = Pattern Text deriving (Eq, Read, Show)
1448512
1449−data DistanceRange =
1450− DistanceRange { distanceFrom :: Distance
1451− , distanceTo :: Distance } deriving (Eq, Show, Generic, Typeable)
513+instance ToJSON Pattern where
514+ toJSON (Pattern pattern) = toJSON pattern
1452515
1453516data SearchResult a =
1454517 SearchResult { took :: Int
@@ -1456,2030 +519,12 @@ data SearchResult a =
1456519 , shards :: ShardResult
1457520 , searchHits :: SearchHits a
1458521 , aggregations :: Maybe AggregationResults
1459− , scrollId :: Maybe ScrollId } deriving (Eq, Show, Generic, Typeable)
1460−
1461−newtype ScrollId = ScrollId Text deriving (Eq, Show, Generic, Ord, ToJSON, FromJSON)
1462−
1463−type Score = Maybe Double
1464−
1465−data SearchHits a =
1466− SearchHits { hitsTotal :: Int
1467− , maxScore :: Score
1468− , hits :: [Hit a] } deriving (Eq, Show, Generic, Typeable)
1469−
1470−
1471−instance Monoid (SearchHits a) where
1472− mempty = SearchHits 0 Nothing mempty
1473− mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1474− SearchHits (ta + tb) (max ma mb) (ha <> hb)
1475−
1476−
1477−data Hit a =
1478− Hit { hitIndex :: IndexName
1479− , hitType :: MappingName
1480− , hitDocId :: DocId
1481− , hitScore :: Score
1482− , hitSource :: Maybe a
1483− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show, Generic, Typeable)
1484−
1485−data ShardResult =
1486− ShardResult { shardTotal :: Int
1487− , shardsSuccessful :: Int
1488− , shardsFailed :: Int } deriving (Eq, Show, Generic, Typeable)
1489−
1490−type HitHighlight = M.Map Text [Text]
1491−
1492−showText :: Show a => a -> Text
1493−showText = T.pack . show
1494−
1495−readMay :: Read a => String -> Maybe a
1496−readMay s = case reads s of
1497− (a, ""):_ -> Just a
1498− _ -> Nothing
1499−
1500−parseReadText :: Read a => Text -> Parser a
1501−parseReadText = maybe mzero return . readMay . T.unpack
1502−
1503−type Aggregations = M.Map Text Aggregation
1504−
1505−emptyAggregations :: Aggregations
1506−emptyAggregations = M.empty
1507−
1508−mkAggregations :: Text -> Aggregation -> Aggregations
1509−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1510−
1511−data TermOrder = TermOrder{ termSortField :: Text
1512− , termSortOrder :: SortOrder } deriving (Eq, Show, Generic, Typeable)
1513−
1514−data TermInclusion = TermInclusion Text
1515− | TermPattern Text Text deriving (Eq, Show, Generic, Typeable)
1516−
1517−data CollectionMode = BreadthFirst
1518− | DepthFirst deriving (Eq, Show, Generic, Typeable)
1519−
1520−data ExecutionHint = Ordinals
1521− | GlobalOrdinals
1522− | GlobalOrdinalsHash
1523− | GlobalOrdinalsLowCardinality
1524− | Map deriving (Eq, Show, Generic, Typeable)
1525−
1526−data TimeInterval = Weeks
1527− | Days
1528− | Hours
1529− | Minutes
1530− | Seconds deriving (Eq)
1531−
1532−data Interval = Year
1533− | Quarter
1534− | Month
1535− | Week
1536− | Day
1537− | Hour
1538− | Minute
1539− | Second
1540− | FractionalInterval Float TimeInterval deriving (Eq, Show, Generic, Typeable)
1541−
1542−data Aggregation = TermsAgg TermsAggregation
1543− | DateHistogramAgg DateHistogramAggregation
1544− | ValueCountAgg ValueCountAggregation
1545− | FilterAgg FilterAggregation
1546− | DateRangeAgg DateRangeAggregation deriving (Eq, Show, Generic, Typeable)
1547−
1548−
1549−data TermsAggregation = TermsAggregation { term :: Either Text Text
1550− , termInclude :: Maybe TermInclusion
1551− , termExclude :: Maybe TermInclusion
1552− , termOrder :: Maybe TermOrder
1553− , termMinDocCount :: Maybe Int
1554− , termSize :: Maybe Int
1555− , termShardSize :: Maybe Int
1556− , termCollectMode :: Maybe CollectionMode
1557− , termExecutionHint :: Maybe ExecutionHint
1558− , termAggs :: Maybe Aggregations
1559− } deriving (Eq, Show, Generic, Typeable)
1560−
1561−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1562− , dateInterval :: Interval
1563− , dateFormat :: Maybe Text
1564− -- pre and post deprecated in 1.5
1565− , datePreZone :: Maybe Text
1566− , datePostZone :: Maybe Text
1567− , datePreOffset :: Maybe Text
1568− , datePostOffset :: Maybe Text
1569− , dateAggs :: Maybe Aggregations
1570− } deriving (Eq, Show, Generic, Typeable)
1571−
1572−
1573−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1574− , draFormat :: Maybe Text
1575− , draRanges :: NonEmpty DateRangeAggRange
1576− } deriving (Eq, Show, Generic, Typeable)
1577−
1578−data DateRangeAggRange = DateRangeFrom DateMathExpr
1579− | DateRangeTo DateMathExpr
1580− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Show, Generic, Typeable)
1581−
1582−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1583−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Show, Generic, Typeable)
1584−
1585−
1586−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1587−data DateMathAnchor = DMNow
1588− | DMDate Day deriving (Eq, Show, Generic, Typeable)
1589−
1590−data DateMathModifier = AddTime Int DateMathUnit
1591− | SubtractTime Int DateMathUnit
1592− | RoundDownTo DateMathUnit deriving (Eq, Show, Generic, Typeable)
1593−
1594−data DateMathUnit = DMYear
1595− | DMMonth
1596− | DMWeek
1597− | DMDay
1598− | DMHour
1599− | DMMinute
1600− | DMSecond deriving (Eq, Show, Generic, Typeable)
1601−
1602−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1603−data ValueCountAggregation = FieldValueCount FieldName
1604− | ScriptValueCount Script deriving (Eq, Show, Generic, Typeable)
1605−
1606−-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
1607−data FilterAggregation = FilterAggregation { faFilter :: Filter
1608− , faAggs :: Maybe Aggregations} deriving (Eq, Show, Generic, Typeable)
1609−
1610−mkTermsAggregation :: Text -> TermsAggregation
1611−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1612−
1613−mkTermsScriptAggregation :: Text -> TermsAggregation
1614−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1615−
1616−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1617−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1618−
1619−instance ToJSON Version where
1620− toJSON Version {..} = object ["number" .= number
1621− ,"build_hash" .= build_hash
1622− ,"build_timestamp" .= build_timestamp
1623− ,"build_snapshot" .= build_snapshot
1624− ,"lucene_version" .= lucene_version]
1625−
1626−instance FromJSON Version where
1627− parseJSON = withObject "Version" parse
1628− where parse o = Version
1629− <$> o .: "number"
1630− <*> o .: "build_hash"
1631− <*> o .: "build_timestamp"
1632− <*> o .: "build_snapshot"
1633− <*> o .: "lucene_version"
1634−
1635−instance ToJSON TermOrder where
1636− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1637−
1638−instance ToJSON TermInclusion where
1639− toJSON (TermInclusion x) = toJSON x
1640− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1641− "flags" .= flags]
1642−
1643−instance ToJSON CollectionMode where
1644− toJSON BreadthFirst = "breadth_first"
1645− toJSON DepthFirst = "depth_first"
1646−
1647−instance ToJSON ExecutionHint where
1648− toJSON Ordinals = "ordinals"
1649− toJSON GlobalOrdinals = "global_ordinals"
1650− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1651− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1652− toJSON Map = "map"
1653−
1654−instance ToJSON Interval where
1655− toJSON Year = "year"
1656− toJSON Quarter = "quarter"
1657− toJSON Month = "month"
1658− toJSON Week = "week"
1659− toJSON Day = "day"
1660− toJSON Hour = "hour"
1661− toJSON Minute = "minute"
1662− toJSON Second = "second"
1663− toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1664−
1665−instance Show TimeInterval where
1666− show Weeks = "w"
1667− show Days = "d"
1668− show Hours = "h"
1669− show Minutes = "m"
1670− show Seconds = "s"
1671−
1672−instance ToJSON Aggregation where
1673− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1674− omitNulls ["terms" .= omitNulls [ toJSON' term,
1675− "include" .= include,
1676− "exclude" .= exclude,
1677− "order" .= order,
1678− "min_doc_count" .= minDocCount,
1679− "size" .= size,
1680− "shard_size" .= shardSize,
1681− "collect_mode" .= collectMode,
1682− "execution_hint" .= executionHint
1683− ],
1684− "aggs" .= termAggs ]
1685− where
1686− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1687−
1688− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1689− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1690− "interval" .= interval,
1691− "format" .= format,
1692− "pre_zone" .= preZone,
1693− "post_zone" .= postZone,
1694− "pre_offset" .= preOffset,
1695− "post_offset" .= postOffset
1696− ],
1697− "aggs" .= dateHistoAggs ]
1698− toJSON (ValueCountAgg a) = object ["value_count" .= v]
1699− where v = case a of
1700− (FieldValueCount (FieldName n)) -> object ["field" .= n]
1701− (ScriptValueCount (Script s)) -> object ["script" .= s]
1702− toJSON (FilterAgg (FilterAggregation filt ags)) =
1703− omitNulls [ "filter" .= filt
1704− , "aggs" .= ags]
1705− toJSON (DateRangeAgg a) = object [ "date_range" .= a
1706− ]
1707−
1708−instance ToJSON DateRangeAggregation where
1709− toJSON DateRangeAggregation {..} =
1710− omitNulls [ "field" .= draField
1711− , "format" .= draFormat
1712− , "ranges" .= toList draRanges
1713− ]
1714−
1715−instance ToJSON DateRangeAggRange where
1716− toJSON (DateRangeFrom e) = object [ "from" .= e ]
1717− toJSON (DateRangeTo e) = object [ "to" .= e ]
1718− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1719−
1720−instance ToJSON DateMathExpr where
1721− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1722− where fmtA DMNow = "now"
1723− fmtA (DMDate date) = case toGregorian date of
1724− (y,m,d) -> showText y <> "-" <>
1725− showText m <> "-" <>
1726− showText d <> "||"
1727− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1728− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1729− fmtMod (RoundDownTo u) = "/" <> fmtU u
1730− fmtU DMYear = "y"
1731− fmtU DMMonth = "M"
1732− fmtU DMWeek = "w"
1733− fmtU DMDay = "d"
1734− fmtU DMHour = "h"
1735− fmtU DMMinute = "m"
1736− fmtU DMSecond = "s"
1737−
1738−
1739−type AggregationResults = M.Map Text Value
1740−
1741−class BucketAggregation a where
1742− key :: a -> Text
1743− docCount :: a -> Int
1744− aggs :: a -> Maybe AggregationResults
1745−
1746−
1747−data Bucket a = Bucket { buckets :: [a]} deriving (Show)
1748−
1749−data BucketValue = TextValue Text
1750− | ScientificValue Scientific
1751− | BoolValue Bool deriving (Show)
1752−
1753−data TermsResult = TermsResult { termKey :: BucketValue
1754− , termsDocCount :: Int
1755− , termsAggs :: Maybe AggregationResults } deriving (Show)
1756−
1757−data DateHistogramResult = DateHistogramResult { dateKey :: Int
1758− , dateKeyStr :: Maybe Text
1759− , dateDocCount :: Int
1760− , dateHistogramAggs :: Maybe AggregationResults } deriving (Show)
1761−
1762−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
1763− , dateRangeFrom :: Maybe UTCTime
1764− , dateRangeFromAsString :: Maybe Text
1765− , dateRangeTo :: Maybe UTCTime
1766− , dateRangeToAsString :: Maybe Text
1767− , dateRangeDocCount :: Int
1768− , dateRangeAggs :: Maybe AggregationResults } deriving (Show, Eq, Generic, Typeable)
1769−
1770−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1771−toTerms t a = M.lookup t a >>= deserialize
1772− where deserialize = parseMaybe parseJSON
1773−
1774−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
1775−toDateHistogram t a = M.lookup t a >>= deserialize
1776− where deserialize = parseMaybe parseJSON
1777−
1778−instance BucketAggregation TermsResult where
1779− key (TermsResult (TextValue t) _ _) = t
1780− key (TermsResult (ScientificValue s) _ _) = T.pack $ show s
1781− key (TermsResult (BoolValue b) _ _) = T.pack $ show b
1782− docCount = termsDocCount
1783− aggs = termsAggs
1784−
1785−instance BucketAggregation DateHistogramResult where
1786− key = showText . dateKey
1787− docCount = dateDocCount
1788− aggs = dateHistogramAggs
1789−
1790−instance BucketAggregation DateRangeResult where
1791− key = dateRangeKey
1792− docCount = dateRangeDocCount
1793− aggs = dateRangeAggs
1794−
1795−instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
1796− parseJSON (Object v) = Bucket <$>
1797− v .: "buckets"
1798− parseJSON _ = mempty
1799−
1800−instance FromJSON BucketValue where
1801− parseJSON (String t) = return $ TextValue t
1802− parseJSON (Number s) = return $ ScientificValue s
1803− parseJSON (Bool b) = return $ BoolValue b
1804− parseJSON _ = mempty
1805−
1806−instance FromJSON TermsResult where
1807− parseJSON = withObject "TermsResult" $ \o -> do
1808− termKey <- o .: "key"
1809− termsDocCount <- o .: "doc_count"
1810− termsAggs <- o .:? "aggregations"
1811− return TermsResult{..}
1812−
1813−instance FromJSON DateHistogramResult where
1814− parseJSON (Object v) = DateHistogramResult <$>
1815− v .: "key" <*>
1816− v .:? "key_as_string" <*>
1817− v .: "doc_count" <*>
1818− v .:? "aggregations"
1819− parseJSON _ = mempty
1820−
1821−instance FromJSON DateRangeResult where
1822− parseJSON = withObject "DateRangeResult" parse
1823− where parse v = DateRangeResult <$>
1824− v .: "key" <*>
1825− (fmap posixMS <$> v .:? "from") <*>
1826− v .:? "from_as_string" <*>
1827− (fmap posixMS <$> v .:? "to") <*>
1828− v .:? "to_as_string" <*>
1829− v .: "doc_count" <*>
1830− v .:? "aggregations"
1831−
1832−instance FromJSON POSIXMS where
1833− parseJSON = withScientific "POSIXMS" (return . parse)
1834− where parse n = let n' = truncate n :: Integer
1835− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
1836−
1837−instance Monoid Filter where
1838− mempty = IdentityFilter
1839− mappend a b = AndFilter [a, b] defaultCache
1840−
1841−instance Seminearring Filter where
1842− a <||> b = OrFilter [a, b] defaultCache
1843−
1844−instance ToJSON Filter where
1845− toJSON (AndFilter filters cache) =
1846− object ["and" .=
1847− object [ "filters" .= fmap toJSON filters
1848− , "_cache" .= cache]]
1849−
1850− toJSON (OrFilter filters cache) =
1851− object ["or" .=
1852− object [ "filters" .= fmap toJSON filters
1853− , "_cache" .= cache]]
1854−
1855− toJSON (NotFilter notFilter cache) =
1856− object ["not" .=
1857− object ["filter" .= notFilter
1858− , "_cache" .= cache]]
1859−
1860− toJSON (IdentityFilter) =
1861− object ["match_all" .= object []]
1862−
1863− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
1864− object ["term" .= object base]
1865− where base = [termFilterField .= termFilterValue,
1866− "_cache" .= cache]
1867−
1868− toJSON (ExistsFilter (FieldName fieldName)) =
1869− object ["exists" .= object
1870− ["field" .= fieldName]]
1871−
1872− toJSON (BoolFilter boolMatch) =
1873− object ["bool" .= boolMatch]
1874−
1875− toJSON (GeoBoundingBoxFilter bbConstraint) =
1876− object ["geo_bounding_box" .= bbConstraint]
1877−
1878− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
1879− distance distanceType optimizeBbox cache) =
1880− object ["geo_distance" .=
1881− object ["distance" .= distance
1882− , "distance_type" .= distanceType
1883− , "optimize_bbox" .= optimizeBbox
1884− , distanceGeoField .= geoDistLatLon
1885− , "_cache" .= cache]]
1886−
1887− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
1888− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
1889− object ["geo_distance_range" .=
1890− object ["from" .= geoDistRangeDistFrom
1891− , "to" .= drDistanceTo
1892− , gddrField .= drLatLon]]
1893−
1894− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
1895− object ["geo_polygon" .=
1896− object [geoPolygonFilterField .=
1897− object ["points" .= fmap toJSON latLons]]]
1898−
1899− toJSON (IdsFilter (MappingName mappingName) values) =
1900− object ["ids" .=
1901− object ["type" .= mappingName
1902− , "values" .= fmap unpackId values]]
1903−
1904− toJSON (LimitFilter limit) =
1905− object ["limit" .= object ["value" .= limit]]
1906−
1907− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
1908− object ["missing" .=
1909− object ["field" .= fieldName
1910− , "existence" .= existence
1911− , "null_value" .= nullValue]]
1912−
1913− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
1914− object ["prefix" .=
1915− object [fieldName .= fieldValue
1916− , "_cache" .= cache]]
1917−
1918− toJSON (QueryFilter query False) =
1919− object ["query" .= toJSON query ]
1920− toJSON (QueryFilter query True) =
1921− object ["fquery" .=
1922− object [ "query" .= toJSON query
1923− , "_cache" .= True ]]
1924−
1925− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
1926− object ["range" .=
1927− object [ fieldName .= object (rangeValueToPair rangeValue)
1928− , "execution" .= rangeExecution
1929− , "_cache" .= cache]]
1930−
1931− toJSON (RegexpFilter (FieldName fieldName)
1932− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
1933− object ["regexp" .=
1934− object [fieldName .=
1935− object ["value" .= regexText
1936− , "flags" .= flags]
1937− , "_name" .= cacheName
1938− , "_cache" .= cache
1939− , "_cache_key" .= cacheKey]]
1940−
1941−instance FromJSON Filter where
1942− parseJSON = withObject "Filter" parse
1943− where parse o = andFilter `taggedWith` "and"
1944− <|> orFilter `taggedWith` "or"
1945− <|> notFilter `taggedWith` "not"
1946− <|> identityFilter `taggedWith` "match_all"
1947− <|> boolFilter `taggedWith` "bool"
1948− <|> existsFilter `taggedWith` "exists"
1949− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
1950− <|> geoDistanceFilter `taggedWith` "geo_distance"
1951− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
1952− <|> geoPolygonFilter `taggedWith` "geo_polygon"
1953− <|> idsFilter `taggedWith` "ids"
1954− <|> limitFilter `taggedWith` "limit"
1955− <|> missingFilter `taggedWith` "missing"
1956− <|> prefixFilter `taggedWith` "prefix"
1957− <|> queryFilter `taggedWith` "query"
1958− <|> fqueryFilter `taggedWith` "fquery"
1959− <|> rangeFilter `taggedWith` "range"
1960− <|> regexpFilter `taggedWith` "regexp"
1961− <|> termFilter `taggedWith` "term"
1962− where taggedWith parser k = parser =<< o .: k
1963− andFilter o = AndFilter <$> o .: "filters"
1964− <*> o .:? "_cache" .!= defaultCache
1965− orFilter o = OrFilter <$> o .: "filters"
1966− <*> o .:? "_cache" .!= defaultCache
1967− notFilter o = NotFilter <$> o .: "filter"
1968− <*> o .: "_cache" .!= defaultCache
1969− identityFilter :: Object -> Parser Filter
1970− identityFilter m
1971− | HM.null m = pure IdentityFilter
1972− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
1973− boolFilter = pure . BoolFilter
1974− existsFilter o = ExistsFilter <$> o .: "field"
1975− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
1976− geoDistanceFilter o = do
1977− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
1978− [(fn, v)] -> do
1979− gp <- GeoPoint (FieldName fn) <$> parseJSON v
1980− GeoDistanceFilter gp <$> o .: "distance"
1981− <*> o .: "distance_type"
1982− <*> o .: "optimize_bbox"
1983− <*> o .:? "_cache" .!= defaultCache
1984− _ -> fail "Could not find GeoDistanceFilter field name"
1985− geoDistanceRangeFilter o = do
1986− case HM.toList (deleteSeveral ["from", "to"] o) of
1987− [(fn, v)] -> do
1988− gp <- GeoPoint (FieldName fn) <$> parseJSON v
1989− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
1990− return (GeoDistanceRangeFilter gp rng)
1991− _ -> fail "Could not find GeoDistanceRangeFilter field name"
1992− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
1993− idsFilter o = IdsFilter <$> o .: "type"
1994− <*> o .: "values"
1995− limitFilter o = LimitFilter <$> o .: "value"
1996− missingFilter o = MissingFilter <$> o .: "field"
1997− <*> o .: "existence"
1998− <*> o .: "null_value"
1999− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2000− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2001− _ -> fail "Could not parse PrefixFilter"
2002−
2003− queryFilter q = pure (QueryFilter q False)
2004− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2005− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2006− [(fn, v)] -> RangeFilter (FieldName fn)
2007− <$> parseJSON v
2008− <*> o .: "execution"
2009− <*> o .:? "_cache" .!= defaultCache
2010− _ -> fail "Could not find field name for RangeFilter"
2011− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2012− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2013− <$> o' .: "value"
2014− <*> o' .: "flags"
2015− <*> o .: "_name"
2016− <*> o .:? "_cache" .!= defaultCache
2017− <*> o .: "_cache_key"
2018− _ -> fail "Could not find field name for RegexpFilter"
2019− termFilter o = case HM.toList (HM.delete "_cache" o) of
2020− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2021− <$> o .:? "_cache" .!= defaultCache
2022− _ -> fail "Could not find term field for TermFilter"
2023−
2024−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2025−fieldTagged f o = case HM.toList o of
2026− [(k, Object o')] -> f (FieldName k) o'
2027− _ -> fail "Expected object with 1 field-named key"
2028−
2029−instance ToJSON GeoPoint where
2030− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2031− object [ geoPointField .= geoPointLatLon ]
2032−
2033−
2034−instance ToJSON Query where
2035− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2036− object [ "term" .=
2037− object [termQueryField .= object merged]]
2038− where
2039− base = [ "value" .= termQueryValue ]
2040− boosted = maybe [] (return . ("boost" .=)) boost
2041− merged = mappend base boosted
2042−
2043− toJSON (TermsQuery fieldName terms) =
2044− object [ "terms" .= object conjoined ]
2045− where conjoined = [fieldName .= terms]
2046− toJSON (IdsQuery idsQueryMappingName docIds) =
2047− object [ "ids" .= object conjoined ]
2048− where conjoined = [ "type" .= idsQueryMappingName
2049− , "values" .= fmap toJSON docIds ]
2050−
2051− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2052− object [ "query_string" .= qQueryStringQuery ]
2053−
2054− toJSON (QueryMatchQuery matchQuery) =
2055− object [ "match" .= matchQuery ]
2056−
2057− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2058− toJSON multiMatchQuery
2059−
2060− toJSON (QueryBoolQuery boolQuery) =
2061− object [ "bool" .= boolQuery ]
2062−
2063− toJSON (QueryBoostingQuery boostingQuery) =
2064− object [ "boosting" .= boostingQuery ]
2065−
2066− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2067− object [ "common" .= commonTermsQuery ]
2068−
2069− toJSON (ConstantScoreFilter csFilter boost) =
2070− object ["constant_score" .= object ["filter" .= csFilter
2071− , "boost" .= boost]]
2072−
2073− toJSON (ConstantScoreQuery query boost) =
2074− object ["constant_score" .= object ["query" .= query
2075− , "boost" .= boost]]
2076−
2077− toJSON (QueryDisMaxQuery disMaxQuery) =
2078− object [ "dis_max" .= disMaxQuery ]
2079−
2080− toJSON (QueryFilteredQuery qFilteredQuery) =
2081− object [ "filtered" .= qFilteredQuery ]
2082−
2083− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2084− object [ "fuzzy_like_this" .= fuzzyQuery ]
2085−
2086− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2087− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2088−
2089− toJSON (QueryFuzzyQuery fuzzyQuery) =
2090− object [ "fuzzy" .= fuzzyQuery ]
2091−
2092− toJSON (QueryHasChildQuery childQuery) =
2093− object [ "has_child" .= childQuery ]
2094−
2095− toJSON (QueryHasParentQuery parentQuery) =
2096− object [ "has_parent" .= parentQuery ]
2097−
2098− toJSON (QueryIndicesQuery qIndicesQuery) =
2099− object [ "indices" .= qIndicesQuery ]
2100−
2101− toJSON (MatchAllQuery boost) =
2102− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2103−
2104− toJSON (QueryMoreLikeThisQuery query) =
2105− object [ "more_like_this" .= query ]
2106−
2107− toJSON (QueryMoreLikeThisFieldQuery query) =
2108− object [ "more_like_this_field" .= query ]
2109−
2110− toJSON (QueryNestedQuery query) =
2111− object [ "nested" .= query ]
2112−
2113− toJSON (QueryPrefixQuery query) =
2114− object [ "prefix" .= query ]
2115−
2116− toJSON (QueryRangeQuery query) =
2117− object [ "range" .= query ]
2118−
2119− toJSON (QueryRegexpQuery query) =
2120− object [ "regexp" .= query ]
2121−
2122− toJSON (QuerySimpleQueryStringQuery query) =
2123− object [ "simple_query_string" .= query ]
2124−
2125−instance FromJSON Query where
2126− parseJSON v = withObject "Query" parse v
2127− where parse o = termQuery `taggedWith` "term"
2128− <|> termsQuery `taggedWith` "terms"
2129− <|> idsQuery `taggedWith` "ids"
2130− <|> queryQueryStringQuery `taggedWith` "query_string"
2131− <|> queryMatchQuery `taggedWith` "match"
2132− <|> queryMultiMatchQuery
2133− <|> queryBoolQuery `taggedWith` "bool"
2134− <|> queryBoostingQuery `taggedWith` "boosting"
2135− <|> queryCommonTermsQuery `taggedWith` "common"
2136− <|> constantScoreFilter `taggedWith` "constant_score"
2137− <|> constantScoreQuery `taggedWith` "constant_score"
2138− <|> queryDisMaxQuery `taggedWith` "dis_max"
2139− <|> queryFilteredQuery `taggedWith` "filtered"
2140− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2141− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2142− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2143− <|> queryHasChildQuery `taggedWith` "has_child"
2144− <|> queryHasParentQuery `taggedWith` "has_parent"
2145− <|> queryIndicesQuery `taggedWith` "indices"
2146− <|> matchAllQuery `taggedWith` "match_all"
2147− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2148− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2149− <|> queryNestedQuery `taggedWith` "nested"
2150− <|> queryPrefixQuery `taggedWith` "prefix"
2151− <|> queryRangeQuery `taggedWith` "range"
2152− <|> queryRegexpQuery `taggedWith` "regexp"
2153− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2154− where taggedWith parser k = parser =<< o .: k
2155− termQuery = fieldTagged $ \(FieldName fn) o ->
2156− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2157− termsQuery o = case HM.toList o of
2158− [(fn, vs)] -> do vals <- parseJSON vs
2159− case vals of
2160− x:xs -> return (TermsQuery fn (x :| xs))
2161− _ -> fail "Expected non empty list of values"
2162− _ -> fail "Expected object with 1 field-named key"
2163− idsQuery o = IdsQuery <$> o .: "type"
2164− <*> o .: "values"
2165− queryQueryStringQuery = pure . QueryQueryStringQuery
2166− queryMatchQuery = pure . QueryMatchQuery
2167− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2168− queryBoolQuery = pure . QueryBoolQuery
2169− queryBoostingQuery = pure . QueryBoostingQuery
2170− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2171− constantScoreFilter o = case HM.lookup "filter" o of
2172− Just x -> ConstantScoreFilter <$> parseJSON x
2173− <*> o .: "boost"
2174− _ -> fail "Does not appear to be a ConstantScoreFilter"
2175− constantScoreQuery o = case HM.lookup "query" o of
2176− Just x -> ConstantScoreQuery <$> parseJSON x
2177− <*> o .: "boost"
2178− _ -> fail "Does not appear to be a ConstantScoreQuery"
2179− queryDisMaxQuery = pure . QueryDisMaxQuery
2180− queryFilteredQuery = pure . QueryFilteredQuery
2181− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2182− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2183− queryFuzzyQuery = pure . QueryFuzzyQuery
2184− queryHasChildQuery = pure . QueryHasChildQuery
2185− queryHasParentQuery = pure . QueryHasParentQuery
2186− queryIndicesQuery = pure . QueryIndicesQuery
2187− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2188− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2189− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2190− queryNestedQuery = pure . QueryNestedQuery
2191− queryPrefixQuery = pure . QueryPrefixQuery
2192− queryRangeQuery = pure . QueryRangeQuery
2193− queryRegexpQuery = pure . QueryRegexpQuery
2194− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2195−
2196−
2197−omitNulls :: [(Text, Value)] -> Value
2198−omitNulls = object . filter notNull where
2199− notNull (_, Null) = False
2200− notNull (_, Array a) = (not . V.null) a
2201− notNull _ = True
2202−
2203−
2204−instance ToJSON SimpleQueryStringQuery where
2205− toJSON SimpleQueryStringQuery {..} =
2206− omitNulls (base ++ maybeAdd)
2207− where base = [ "query" .= simpleQueryStringQuery ]
2208− maybeAdd = [ "fields" .= simpleQueryStringField
2209− , "default_operator" .= simpleQueryStringOperator
2210− , "analyzer" .= simpleQueryStringAnalyzer
2211− , "flags" .= simpleQueryStringFlags
2212− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2213− , "locale" .= simpleQueryStringLocale ]
2214−
2215−instance FromJSON SimpleQueryStringQuery where
2216− parseJSON = withObject "SimpleQueryStringQuery" parse
2217− where parse o = SimpleQueryStringQuery <$> o .: "query"
2218− <*> o .:? "fields"
2219− <*> o .:? "default_operator"
2220− <*> o .:? "analyzer"
2221− <*> (parseFlags <$> o .:? "flags")
2222− <*> o .:? "lowercase_expanded_terms"
2223− <*> o .:? "locale"
2224− parseFlags (Just (x:xs)) = Just (x :| xs)
2225− parseFlags _ = Nothing
2226−
2227−instance ToJSON FieldOrFields where
2228− toJSON (FofField fieldName) =
2229− toJSON fieldName
2230− toJSON (FofFields fieldNames) =
2231− toJSON fieldNames
2232−
2233−instance FromJSON FieldOrFields where
2234− parseJSON v = FofField <$> parseJSON v
2235− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2236−
2237−instance ToJSON SimpleQueryFlag where
2238− toJSON SimpleQueryAll = "ALL"
2239− toJSON SimpleQueryNone = "NONE"
2240− toJSON SimpleQueryAnd = "AND"
2241− toJSON SimpleQueryOr = "OR"
2242− toJSON SimpleQueryPrefix = "PREFIX"
2243− toJSON SimpleQueryPhrase = "PHRASE"
2244− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2245− toJSON SimpleQueryEscape = "ESCAPE"
2246− toJSON SimpleQueryWhitespace = "WHITESPACE"
2247− toJSON SimpleQueryFuzzy = "FUZZY"
2248− toJSON SimpleQueryNear = "NEAR"
2249− toJSON SimpleQuerySlop = "SLOP"
2250−
2251−instance FromJSON SimpleQueryFlag where
2252− parseJSON = withText "SimpleQueryFlag" parse
2253− where parse "ALL" = pure SimpleQueryAll
2254− parse "NONE" = pure SimpleQueryNone
2255− parse "AND" = pure SimpleQueryAnd
2256− parse "OR" = pure SimpleQueryOr
2257− parse "PREFIX" = pure SimpleQueryPrefix
2258− parse "PHRASE" = pure SimpleQueryPhrase
2259− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2260− parse "ESCAPE" = pure SimpleQueryEscape
2261− parse "WHITESPACE" = pure SimpleQueryWhitespace
2262− parse "FUZZY" = pure SimpleQueryFuzzy
2263− parse "NEAR" = pure SimpleQueryNear
2264− parse "SLOP" = pure SimpleQuerySlop
2265− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2266−
2267−instance ToJSON RegexpQuery where
2268− toJSON (RegexpQuery (FieldName rqQueryField)
2269− (Regexp regexpQueryQuery) rqQueryFlags
2270− rqQueryBoost) =
2271− object [ rqQueryField .= omitNulls base ]
2272− where base = [ "value" .= regexpQueryQuery
2273− , "flags" .= rqQueryFlags
2274− , "boost" .= rqQueryBoost ]
2275−
2276−instance FromJSON RegexpQuery where
2277− parseJSON = withObject "RegexpQuery" parse
2278− where parse = fieldTagged $ \fn o ->
2279− RegexpQuery fn
2280− <$> o .: "value"
2281− <*> o .: "flags"
2282− <*> o .:? "boost"
2283−
2284−instance ToJSON QueryStringQuery where
2285− toJSON (QueryStringQuery qsQueryString
2286− qsDefaultField qsOperator
2287− qsAnalyzer qsAllowWildcard
2288− qsLowercaseExpanded qsEnablePositionIncrements
2289− qsFuzzyMaxExpansions qsFuzziness
2290− qsFuzzyPrefixLength qsPhraseSlop
2291− qsBoost qsAnalyzeWildcard
2292− qsGeneratePhraseQueries qsMinimumShouldMatch
2293− qsLenient qsLocale) =
2294− omitNulls base
2295− where
2296− base = [ "query" .= qsQueryString
2297− , "default_field" .= qsDefaultField
2298− , "default_operator" .= qsOperator
2299− , "analyzer" .= qsAnalyzer
2300− , "allow_leading_wildcard" .= qsAllowWildcard
2301− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2302− , "enable_position_increments" .= qsEnablePositionIncrements
2303− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2304− , "fuzziness" .= qsFuzziness
2305− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2306− , "phrase_slop" .= qsPhraseSlop
2307− , "boost" .= qsBoost
2308− , "analyze_wildcard" .= qsAnalyzeWildcard
2309− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2310− , "minimum_should_match" .= qsMinimumShouldMatch
2311− , "lenient" .= qsLenient
2312− , "locale" .= qsLocale ]
2313−
2314−instance FromJSON QueryStringQuery where
2315− parseJSON = withObject "QueryStringQuery" parse
2316− where parse o = QueryStringQuery
2317− <$> o .: "query"
2318− <*> o .:? "default_field"
2319− <*> o .:? "default_operator"
2320− <*> o .:? "analyzer"
2321− <*> o .:? "allow_leading_wildcard"
2322− <*> o .:? "lowercase_expanded_terms"
2323− <*> o .:? "enable_position_increments"
2324− <*> o .:? "fuzzy_max_expansions"
2325− <*> o .:? "fuzziness"
2326− <*> o .:? "fuzzy_prefix_length"
2327− <*> o .:? "phrase_slop"
2328− <*> o .:? "boost"
2329− <*> o .:? "analyze_wildcard"
2330− <*> o .:? "auto_generate_phrase_queries"
2331− <*> o .:? "minimum_should_match"
2332− <*> o .:? "lenient"
2333− <*> o .:? "locale"
2334−
2335−instance ToJSON RangeQuery where
2336− toJSON (RangeQuery (FieldName fieldName) range boost) =
2337− object [ fieldName .= object conjoined ]
2338− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2339−
2340−instance FromJSON RangeQuery where
2341− parseJSON = withObject "RangeQuery" parse
2342− where parse = fieldTagged $ \fn o ->
2343− RangeQuery fn
2344− <$> parseJSON (Object o)
2345− <*> o .: "boost"
2346−
2347−instance FromJSON RangeValue where
2348− parseJSON = withObject "RangeValue" parse
2349− where parse o = parseDate o
2350− <|> parseDouble o
2351− parseDate o = do lt <- o .:? "lt"
2352− lte <- o .:? "lte"
2353− gt <- o .:? "gt"
2354− gte <- o .:? "gte"
2355− case (lt, lte, gt, gte) of
2356− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2357− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2358− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2359− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2360− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2361− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2362− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2363− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2364− (Nothing, Nothing, Nothing, Nothing) -> mzero
2365− parseDouble o = do lt <- o .:? "lt"
2366− lte <- o .:? "lte"
2367− gt <- o .:? "gt"
2368− gte <- o .:? "gte"
2369− case (lt, lte, gt, gte) of
2370− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2371− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2372− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2373− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2374− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2375− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2376− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2377− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2378− (Nothing, Nothing, Nothing, Nothing) -> mzero
2379−
2380−instance ToJSON PrefixQuery where
2381− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2382− object [ fieldName .= omitNulls base ]
2383− where base = [ "value" .= queryValue
2384− , "boost" .= boost ]
2385−
2386−instance FromJSON PrefixQuery where
2387− parseJSON = withObject "PrefixQuery" parse
2388− where parse = fieldTagged $ \fn o ->
2389− PrefixQuery fn
2390− <$> o .: "value"
2391− <*> o .:? "boost"
2392−
2393−instance ToJSON NestedQuery where
2394− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2395− object [ "path" .= nqPath
2396− , "score_mode" .= nqScoreType
2397− , "query" .= nqQuery ]
2398−
2399−instance FromJSON NestedQuery where
2400− parseJSON = withObject "NestedQuery" parse
2401− where parse o = NestedQuery
2402− <$> o .: "path"
2403− <*> o .: "score_mode"
2404− <*> o .: "query"
2405−
2406−instance ToJSON MoreLikeThisFieldQuery where
2407− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2408− percent mtf mqt stopwords mindf maxdf
2409− minwl maxwl boostTerms boost analyzer) =
2410− object [ fieldName .= omitNulls base ]
2411− where base = [ "like_text" .= text
2412− , "percent_terms_to_match" .= percent
2413− , "min_term_freq" .= mtf
2414− , "max_query_terms" .= mqt
2415− , "stop_words" .= stopwords
2416− , "min_doc_freq" .= mindf
2417− , "max_doc_freq" .= maxdf
2418− , "min_word_length" .= minwl
2419− , "max_word_length" .= maxwl
2420− , "boost_terms" .= boostTerms
2421− , "boost" .= boost
2422− , "analyzer" .= analyzer ]
2423−
2424−instance FromJSON MoreLikeThisFieldQuery where
2425− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2426− where parse = fieldTagged $ \fn o ->
2427− MoreLikeThisFieldQuery
2428− <$> o .: "like_text"
2429− <*> pure fn
2430− <*> o .:? "percent_terms_to_match"
2431− <*> o .:? "min_term_freq"
2432− <*> o .:? "max_query_terms"
2433− <*> (optionalNE =<< o .:? "stop_words")
2434− <*> o .:? "min_doc_freq"
2435− <*> o .:? "max_doc_freq"
2436− <*> o .:? "min_word_length"
2437− <*> o .:? "max_word_length"
2438− <*> o .:? "boost_terms"
2439− <*> o .:? "boost"
2440− <*> o .:? "analyzer"
2441− optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2442−
2443−instance ToJSON MoreLikeThisQuery where
2444− toJSON (MoreLikeThisQuery text fields percent
2445− mtf mqt stopwords mindf maxdf
2446− minwl maxwl boostTerms boost analyzer) =
2447− omitNulls base
2448− where base = [ "like_text" .= text
2449− , "fields" .= fields
2450− , "percent_terms_to_match" .= percent
2451− , "min_term_freq" .= mtf
2452− , "max_query_terms" .= mqt
2453− , "stop_words" .= stopwords
2454− , "min_doc_freq" .= mindf
2455− , "max_doc_freq" .= maxdf
2456− , "min_word_length" .= minwl
2457− , "max_word_length" .= maxwl
2458− , "boost_terms" .= boostTerms
2459− , "boost" .= boost
2460− , "analyzer" .= analyzer ]
2461−
2462−instance FromJSON MoreLikeThisQuery where
2463− parseJSON = withObject "MoreLikeThisQuery" parse
2464− where parse o = MoreLikeThisQuery
2465− <$> o .: "like_text"
2466− <*> (optionalNE =<< o .:? "fields")
2467− <*> o .:? "percent_terms_to_match"
2468− <*> o .:? "min_term_freq"
2469− <*> o .:? "max_query_terms"
2470− <*> (optionalNE =<< o .:? "stop_words")
2471− <*> o .:? "min_doc_freq"
2472− <*> o .:? "max_doc_freq"
2473− <*> o .:? "min_word_length"
2474− <*> o .:? "max_word_length"
2475− <*> o .:? "boost_terms"
2476− <*> o .:? "boost"
2477− <*> o .:? "analyzer"
2478− optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2479−
2480−instance ToJSON IndicesQuery where
2481− toJSON (IndicesQuery indices query noMatch) =
2482− omitNulls [ "indices" .= indices
2483− , "no_match_query" .= noMatch
2484− , "query" .= query ]
2485−
2486−instance FromJSON IndicesQuery where
2487− parseJSON = withObject "IndicesQuery" parse
2488− where parse o = IndicesQuery
2489− <$> o .:? "indices" .!= []
2490− <*> o .: "query"
2491− <*> o .:? "no_match_query"
2492−
2493−instance ToJSON HasParentQuery where
2494− toJSON (HasParentQuery queryType query scoreType) =
2495− omitNulls [ "parent_type" .= queryType
2496− , "score_type" .= scoreType
2497− , "query" .= query ]
2498−
2499−instance FromJSON HasParentQuery where
2500− parseJSON = withObject "HasParentQuery" parse
2501− where parse o = HasParentQuery
2502− <$> o .: "parent_type"
2503− <*> o .: "query"
2504− <*> o .:? "score_type"
2505−
2506−instance ToJSON HasChildQuery where
2507− toJSON (HasChildQuery queryType query scoreType) =
2508− omitNulls [ "query" .= query
2509− , "score_type" .= scoreType
2510− , "type" .= queryType ]
2511−
2512−instance FromJSON HasChildQuery where
2513− parseJSON = withObject "HasChildQuery" parse
2514− where parse o = HasChildQuery
2515− <$> o .: "type"
2516− <*> o .: "query"
2517− <*> o .:? "score_type"
2518−
2519−instance ToJSON FuzzyQuery where
2520− toJSON (FuzzyQuery (FieldName fieldName) queryText
2521− prefixLength maxEx fuzziness boost) =
2522− object [ fieldName .= omitNulls base ]
2523− where base = [ "value" .= queryText
2524− , "fuzziness" .= fuzziness
2525− , "prefix_length" .= prefixLength
2526− , "boost" .= boost
2527− , "max_expansions" .= maxEx ]
2528−
2529−instance FromJSON FuzzyQuery where
2530− parseJSON = withObject "FuzzyQuery" parse
2531− where parse = fieldTagged $ \fn o ->
2532− FuzzyQuery fn
2533− <$> o .: "value"
2534− <*> o .: "prefix_length"
2535− <*> o .: "max_expansions"
2536− <*> o .: "fuzziness"
2537− <*> o .:? "boost"
2538−
2539−instance ToJSON FuzzyLikeFieldQuery where
2540− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2541− fieldText maxTerms ignoreFreq fuzziness prefixLength
2542− boost analyzer) =
2543− object [ fieldName .=
2544− omitNulls [ "like_text" .= fieldText
2545− , "max_query_terms" .= maxTerms
2546− , "ignore_tf" .= ignoreFreq
2547− , "fuzziness" .= fuzziness
2548− , "prefix_length" .= prefixLength
2549− , "analyzer" .= analyzer
2550− , "boost" .= boost ]]
2551−
2552−instance FromJSON FuzzyLikeFieldQuery where
2553− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2554− where parse = fieldTagged $ \fn o ->
2555− FuzzyLikeFieldQuery fn
2556− <$> o .: "like_text"
2557− <*> o .: "max_query_terms"
2558− <*> o .: "ignore_tf"
2559− <*> o .: "fuzziness"
2560− <*> o .: "prefix_length"
2561− <*> o .: "boost"
2562− <*> o .:? "analyzer"
2563−
2564−instance ToJSON FuzzyLikeThisQuery where
2565− toJSON (FuzzyLikeThisQuery fields text maxTerms
2566− ignoreFreq fuzziness prefixLength boost analyzer) =
2567− omitNulls base
2568− where base = [ "fields" .= fields
2569− , "like_text" .= text
2570− , "max_query_terms" .= maxTerms
2571− , "ignore_tf" .= ignoreFreq
2572− , "fuzziness" .= fuzziness
2573− , "prefix_length" .= prefixLength
2574− , "analyzer" .= analyzer
2575− , "boost" .= boost ]
2576−
2577−instance FromJSON FuzzyLikeThisQuery where
2578− parseJSON = withObject "FuzzyLikeThisQuery" parse
2579− where parse o = FuzzyLikeThisQuery
2580− <$> o .:? "fields" .!= []
2581− <*> o .: "like_text"
2582− <*> o .: "max_query_terms"
2583− <*> o .: "ignore_tf"
2584− <*> o .: "fuzziness"
2585− <*> o .: "prefix_length"
2586− <*> o .: "boost"
2587− <*> o .:? "analyzer"
2588−
2589−instance ToJSON FilteredQuery where
2590− toJSON (FilteredQuery query fFilter) =
2591− object [ "query" .= query
2592− , "filter" .= fFilter ]
2593−
2594−instance FromJSON FilteredQuery where
2595− parseJSON = withObject "FilteredQuery" parse
2596− where parse o = FilteredQuery
2597− <$> o .: "query"
2598− <*> o .: "filter"
2599−
2600−instance ToJSON DisMaxQuery where
2601− toJSON (DisMaxQuery queries tiebreaker boost) =
2602− omitNulls base
2603− where base = [ "queries" .= queries
2604− , "boost" .= boost
2605− , "tie_breaker" .= tiebreaker ]
2606−
2607−instance FromJSON DisMaxQuery where
2608− parseJSON = withObject "DisMaxQuery" parse
2609− where parse o = DisMaxQuery
2610− <$> o .:? "queries" .!= []
2611− <*> o .: "tie_breaker"
2612− <*> o .:? "boost"
2613−
2614−instance ToJSON CommonTermsQuery where
2615− toJSON (CommonTermsQuery (FieldName fieldName)
2616− (QueryString query) cf lfo hfo msm
2617− boost analyzer disableCoord) =
2618− object [fieldName .= omitNulls base ]
2619− where base = [ "query" .= query
2620− , "cutoff_frequency" .= cf
2621− , "low_freq_operator" .= lfo
2622− , "minimum_should_match" .= msm
2623− , "boost" .= boost
2624− , "analyzer" .= analyzer
2625− , "disable_coord" .= disableCoord
2626− , "high_freq_operator" .= hfo ]
2627−
2628−instance FromJSON CommonTermsQuery where
2629− parseJSON = withObject "CommonTermsQuery" parse
2630− where parse = fieldTagged $ \fn o ->
2631− CommonTermsQuery fn
2632− <$> o .: "query"
2633− <*> o .: "cutoff_frequency"
2634− <*> o .: "low_freq_operator"
2635− <*> o .: "high_freq_operator"
2636− <*> o .:? "minimum_should_match"
2637− <*> o .:? "boost"
2638− <*> o .:? "analyzer"
2639− <*> o .:? "disable_coord"
2640−
2641−instance ToJSON CommonMinimumMatch where
2642− toJSON (CommonMinimumMatch mm) = toJSON mm
2643− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2644− object [ "low_freq" .= lowF
2645− , "high_freq" .= highF ]
2646−
2647−instance FromJSON CommonMinimumMatch where
2648− parseJSON v = parseMinimum v
2649− <|> parseMinimumHighLow v
2650− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2651− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2652− MinimumMatchHighLow
2653− <$> o .: "low_freq"
2654− <*> o .: "high_freq")
2655−
2656−
2657−instance ToJSON BoostingQuery where
2658− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2659− object [ "positive" .= bqPositiveQuery
2660− , "negative" .= bqNegativeQuery
2661− , "negative_boost" .= bqNegativeBoost ]
2662−
2663−instance FromJSON BoostingQuery where
2664− parseJSON = withObject "BoostingQuery" parse
2665− where parse o = BoostingQuery
2666− <$> o .: "positive"
2667− <*> o .: "negative"
2668− <*> o .: "negative_boost"
2669−
2670−instance ToJSON BoolQuery where
2671− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
2672− omitNulls base
2673− where base = [ "must" .= mustM
2674− , "must_not" .= notM
2675− , "should" .= shouldM
2676− , "minimum_should_match" .= bqMin
2677− , "boost" .= boost
2678− , "disable_coord" .= disableCoord ]
2679−
2680−instance FromJSON BoolQuery where
2681− parseJSON = withObject "BoolQuery" parse
2682− where parse o = BoolQuery
2683− <$> o .:? "must" .!= []
2684− <*> o .:? "must_not" .!= []
2685− <*> o .:? "should" .!= []
2686− <*> o .:? "minimum_should_match"
2687− <*> o .:? "boost"
2688− <*> o .:? "disable_coord"
2689−
2690−instance ToJSON MatchQuery where
2691− toJSON (MatchQuery (FieldName fieldName)
2692− (QueryString mqQueryString) booleanOperator
2693− zeroTermsQuery cutoffFrequency matchQueryType
2694− analyzer maxExpansions lenient boost) =
2695− object [ fieldName .= omitNulls base ]
2696− where base = [ "query" .= mqQueryString
2697− , "operator" .= booleanOperator
2698− , "zero_terms_query" .= zeroTermsQuery
2699− , "cutoff_frequency" .= cutoffFrequency
2700− , "type" .= matchQueryType
2701− , "analyzer" .= analyzer
2702− , "max_expansions" .= maxExpansions
2703− , "lenient" .= lenient
2704− , "boost" .= boost ]
2705−
2706−instance FromJSON MatchQuery where
2707− parseJSON = withObject "MatchQuery" parse
2708− where parse = fieldTagged $ \fn o ->
2709− MatchQuery fn
2710− <$> o .: "query"
2711− <*> o .: "operator"
2712− <*> o .: "zero_terms_query"
2713− <*> o .:? "cutoff_frequency"
2714− <*> o .:? "type"
2715− <*> o .:? "analyzer"
2716− <*> o .:? "max_expansions"
2717− <*> o .:? "lenient"
2718− <*> o .:? "boost"
2719−
2720−instance ToJSON MultiMatchQuery where
2721− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2722− ztQ tb mmqt cf analyzer maxEx lenient) =
2723− object ["multi_match" .= omitNulls base]
2724− where base = [ "fields" .= fmap toJSON fields
2725− , "query" .= query
2726− , "operator" .= boolOp
2727− , "zero_terms_query" .= ztQ
2728− , "tiebreaker" .= tb
2729− , "type" .= mmqt
2730− , "cutoff_frequency" .= cf
2731− , "analyzer" .= analyzer
2732− , "max_expansions" .= maxEx
2733− , "lenient" .= lenient ]
2734−
2735−instance FromJSON MultiMatchQuery where
2736− parseJSON = withObject "MultiMatchQuery" parse
2737− where parse raw = do o <- raw .: "multi_match"
2738− MultiMatchQuery
2739− <$> o .:? "fields" .!= []
2740− <*> o .: "query"
2741− <*> o .: "operator"
2742− <*> o .: "zero_terms_query"
2743− <*> o .:? "tiebreaker"
2744− <*> o .:? "type"
2745− <*> o .:? "cutoff_frequency"
2746− <*> o .:? "analyzer"
2747− <*> o .:? "max_expansions"
2748− <*> o .:? "lenient"
2749−
2750−instance ToJSON MultiMatchQueryType where
2751− toJSON MultiMatchBestFields = "best_fields"
2752− toJSON MultiMatchMostFields = "most_fields"
2753− toJSON MultiMatchCrossFields = "cross_fields"
2754− toJSON MultiMatchPhrase = "phrase"
2755− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2756−
2757−instance FromJSON MultiMatchQueryType where
2758− parseJSON = withText "MultiMatchPhrasePrefix" parse
2759− where parse "best_fields" = pure MultiMatchBestFields
2760− parse "most_fields" = pure MultiMatchMostFields
2761− parse "cross_fields" = pure MultiMatchCrossFields
2762− parse "phrase" = pure MultiMatchPhrase
2763− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2764− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2765−
2766−instance ToJSON BooleanOperator where
2767− toJSON And = String "and"
2768− toJSON Or = String "or"
2769−
2770−instance FromJSON BooleanOperator where
2771− parseJSON = withText "BooleanOperator" parse
2772− where parse "and" = pure And
2773− parse "or" = pure Or
2774− parse o = fail ("Unexpected BooleanOperator: " <> show o)
2775−
2776−instance ToJSON ZeroTermsQuery where
2777− toJSON ZeroTermsNone = String "none"
2778− toJSON ZeroTermsAll = String "all"
2779−
2780−instance FromJSON ZeroTermsQuery where
2781− parseJSON = withText "ZeroTermsQuery" parse
2782− where parse "none" = pure ZeroTermsNone
2783− parse "all" = pure ZeroTermsAll
2784− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
2785−
2786−instance ToJSON MatchQueryType where
2787− toJSON MatchPhrase = "phrase"
2788− toJSON MatchPhrasePrefix = "phrase_prefix"
2789−
2790−instance FromJSON MatchQueryType where
2791− parseJSON = withText "MatchQueryType" parse
2792− where parse "phrase" = pure MatchPhrase
2793− parse "phrase_prefix" = pure MatchPhrasePrefix
2794− parse t = fail ("Unexpected MatchQueryType: " <> show t)
2795−
2796−instance FromJSON Status where
2797− parseJSON (Object v) = Status <$>
2798− v .:? "ok" <*>
2799− v .: "status" <*>
2800− v .: "name" <*>
2801− v .: "version" <*>
2802− v .: "tagline"
2803− parseJSON _ = empty
2804−
2805−
2806−instance ToJSON IndexSettings where
2807− toJSON (IndexSettings s r) = object ["settings" .=
2808− object ["index" .=
2809− object ["number_of_shards" .= s, "number_of_replicas" .= r]
2810− ]
2811− ]
2812−
2813−instance FromJSON IndexSettings where
2814− parseJSON = withObject "IndexSettings" parse
2815− where parse o = do s <- o .: "settings"
2816− i <- s .: "index"
2817− IndexSettings <$> i .: "number_of_shards"
2818− <*> i .: "number_of_replicas"
2819−
2820−instance ToJSON UpdatableIndexSetting where
2821− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
2822− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
2823− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
2824− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
2825− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
2826− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
2827− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
2828− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
2829− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
2830− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
2831− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
2832− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
2833− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
2834− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
2835− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
2836− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
2837− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
2838− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
2839− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
2840− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
2841− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
2842− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
2843− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
2844− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
2845− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
2846− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
2847− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
2848− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
2849−
2850−instance FromJSON UpdatableIndexSetting where
2851− parseJSON = withObject "UpdatableIndexSetting" parse
2852− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
2853− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
2854− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
2855− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
2856− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
2857− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
2858− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
2859− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
2860− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
2861− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
2862− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
2863− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
2864− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
2865− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
2866− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
2867− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
2868− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
2869− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
2870− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
2871− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
2872− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
2873− <|> compoundFormat `taggedAt` ["index", "compound_format"]
2874− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
2875− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
2876− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
2877− <|> blocksRead `taggedAt` ["blocks", "read"]
2878− <|> blocksWrite `taggedAt` ["blocks", "write"]
2879− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
2880− where taggedAt f ks = taggedAt' f (Object o) ks
2881− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON =<< unStringlyTypeJSON v))
2882− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
2883− taggedAt' f v' ks) v
2884− numberOfReplicas = pure . NumberOfReplicas
2885− autoExpandReplicas = pure . AutoExpandReplicas
2886− refreshInterval = pure . RefreshInterval . ndtJSON
2887− indexConcurrency = pure . IndexConcurrency
2888− failOnMergeFailure = pure . FailOnMergeFailure
2889− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
2890− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
2891− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
2892− translogDisableFlush = pure . TranslogDisableFlush
2893− cacheFilterMaxSize = pure . CacheFilterMaxSize
2894− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
2895− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
2896− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
2897− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
2898− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
2899− routingAllocationEnable = pure . RoutingAllocationEnable
2900− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
2901− recoveryInitialShards = pure . RecoveryInitialShards
2902− gcDeletes = pure . GCDeletes . ndtJSON
2903− ttlDisablePurge = pure . TTLDisablePurge
2904− translogFSType = pure . TranslogFSType
2905− compoundFormat = pure . IndexCompoundFormat
2906− compoundOnFlush = pure . IndexCompoundOnFlush
2907− warmerEnabled = pure . WarmerEnabled
2908− blocksReadOnly = pure . BlocksReadOnly
2909− blocksRead = pure . BlocksRead
2910− blocksWrite = pure . BlocksWrite
2911− blocksMetaData = pure . BlocksMetaData
2912−
2913−instance FromJSON IndexSettingsSummary where
2914− parseJSON = withObject "IndexSettingsSummary" parse
2915− where parse o = case HM.toList o of
2916− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
2917− <$> parseJSON v
2918− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
2919− _ -> fail "Expected single-key object with index name"
2920− redundant (NumberOfReplicas _) = True
2921− redundant _ = False
2922−
2923−-- | For some reason in the settings API, all leaf values get returned
2924−-- as strings. This function attepmts to recover from this for all
2925−-- non-recursive JSON types. If nothing can be done or the same value
2926−-- would be return, it returns 'mzero'
2927−unStringlyTypeJSON :: MonadPlus m => Value -> m Value
2928−unStringlyTypeJSON (String "true") = return (Bool True)
2929−unStringlyTypeJSON (String "false") = return (Bool False)
2930−unStringlyTypeJSON (String "null") = return Null
2931−unStringlyTypeJSON (String t) = case readMay (T.unpack t) of
2932− Just n -> return (Number n)
2933− Nothing -> mzero
2934−unStringlyTypeJSON _ = mzero
2935−
2936−
2937−parseSettings :: Object -> Parser [UpdatableIndexSetting]
2938−parseSettings o = do
2939− o' <- o .: "index"
2940− -- slice the index object into singleton hashmaps and try to parse each
2941− parses <- forM (HM.toList o') $ \(k, v) -> do
2942− -- blocks are now nested into the "index" key, which is not how they're serialized
2943− let atRoot = Object (HM.singleton k v)
2944− let atIndex = Object (HM.singleton "index" atRoot)
2945− optional (parseJSON atRoot <|> parseJSON atIndex)
2946− return (catMaybes parses)
2947−
2948−oPath :: ToJSON a => NonEmpty Text -> a -> Value
2949−oPath (k :| []) v = object [k .= v]
2950−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
2951−
2952−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
2953−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
2954− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
2955−
2956−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
2957−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
2958− where parse o = case HM.toList o of
2959− [] -> fail "Expected non-empty list of NodeAttrFilters"
2960− x:xs -> DT.mapM (uncurry parse') (x :| xs)
2961− parse' n = withText "Text" $ \t ->
2962− case T.splitOn "," t of
2963− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
2964− [] -> fail "Expected non-empty list of filter values"
2965−
2966−instance ToJSON ReplicaBounds where
2967− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
2968− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
2969− toJSON ReplicasUnbounded = Bool False
2970−
2971−instance FromJSON ReplicaBounds where
2972− parseJSON v = withText "ReplicaBounds" parseText v
2973− <|> withBool "ReplicaBounds" parseBool v
2974− where parseText t = case T.splitOn "-" t of
2975− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
2976− [a, b] -> ReplicasBounded <$> parseReadText a
2977− <*> parseReadText b
2978− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
2979− parseBool False = pure ReplicasUnbounded
2980− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
2981−
2982−instance ToJSON AllocationPolicy where
2983− toJSON AllocAll = String "all"
2984− toJSON AllocPrimaries = String "primaries"
2985− toJSON AllocNewPrimaries = String "new_primaries"
2986− toJSON AllocNone = String "none"
2987−
2988−instance FromJSON AllocationPolicy where
2989− parseJSON = withText "AllocationPolicy" parse
2990− where parse "all" = pure AllocAll
2991− parse "primaries" = pure AllocPrimaries
2992− parse "new_primaries" = pure AllocNewPrimaries
2993− parse "none" = pure AllocNone
2994− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
2995−
2996−instance ToJSON InitialShardCount where
2997− toJSON QuorumShards = String "quorum"
2998− toJSON QuorumMinus1Shards = String "quorum-1"
2999− toJSON FullShards = String "full"
3000− toJSON FullMinus1Shards = String "full-1"
3001− toJSON (ExplicitShards x) = toJSON x
3002−
3003−instance FromJSON InitialShardCount where
3004− parseJSON v = withText "InitialShardCount" parseText v
3005− <|> ExplicitShards <$> parseJSON v
3006− where parseText "quorum" = pure QuorumShards
3007− parseText "quorum-1" = pure QuorumMinus1Shards
3008− parseText "full" = pure FullShards
3009− parseText "full-1" = pure FullMinus1Shards
3010− parseText _ = mzero
3011−
3012−instance ToJSON FSType where
3013− toJSON FSSimple = "simple"
3014− toJSON FSBuffered = "buffered"
3015−
3016−instance FromJSON FSType where
3017− parseJSON = withText "FSType" parse
3018− where parse "simple" = pure FSSimple
3019− parse "buffered" = pure FSBuffered
3020− parse t = fail ("Invalid FSType: " <> show t)
3021−
3022−instance ToJSON CompoundFormat where
3023− toJSON (CompoundFileFormat x) = Bool x
3024− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3025−
3026−instance FromJSON CompoundFormat where
3027− parseJSON v = CompoundFileFormat <$> parseJSON v
3028− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3029−
3030−instance ToJSON NominalDiffTimeJSON where
3031− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3032−
3033−instance FromJSON NominalDiffTimeJSON where
3034− parseJSON = withText "NominalDiffTime" parse
3035− where parse t = case T.takeEnd 1 t of
3036− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3037− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3038−
3039−instance ToJSON IndexTemplate where
3040− toJSON (IndexTemplate p s m) = merge
3041− (object [ "template" .= p
3042− , "mappings" .= foldl' merge (object []) m
3043− ])
3044− (toJSON s)
3045− where
3046− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3047− merge o Null = o
3048− merge _ _ = undefined
3049−
3050−instance (FromJSON a) => FromJSON (EsResult a) where
3051− parseJSON jsonVal@(Object v) = do
3052− found <- v .:? "found" .!= False
3053− fr <- if found
3054− then parseJSON jsonVal
3055− else return Nothing
3056− EsResult <$> v .: "_index" <*>
3057− v .: "_type" <*>
3058− v .: "_id" <*>
3059− pure fr
3060− parseJSON _ = empty
3061−
3062−instance (FromJSON a) => FromJSON (EsResultFound a) where
3063− parseJSON (Object v) = EsResultFound <$>
3064− v .: "_version" <*>
3065− v .: "_source"
3066− parseJSON _ = empty
3067−
3068−instance FromJSON EsError where
3069− parseJSON (Object v) = EsError <$>
3070− v .: "status" <*>
3071− v .: "error"
3072− parseJSON _ = empty
3073−
3074−instance FromJSON IndexAliasesSummary where
3075− parseJSON = withObject "IndexAliasesSummary" parse
3076− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3077− go ixn = withObject "index aliases" $ \ia -> do
3078− aliases <- ia .:? "aliases" .!= mempty
3079− forM (HM.toList aliases) $ \(aName, v) -> do
3080− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3081− IndexAliasSummary indexAlias <$> parseJSON v
3082−
3083−
3084−instance ToJSON IndexAliasAction where
3085− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3086− where Object iaObj = toJSON ia
3087− Object optsObj = toJSON opts
3088− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3089− where Object iaObj = toJSON ia
3090−
3091−instance ToJSON IndexAlias where
3092− toJSON IndexAlias {..} = object ["index" .= srcIndex
3093− , "alias" .= indexAlias
3094− ]
3095−
3096−instance ToJSON IndexAliasCreate where
3097− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3098− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3099− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3100−
3101−instance ToJSON AliasRouting where
3102− toJSON (AllAliasRouting v) = object ["routing" .= v]
3103− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3104− where prs = [("search_routing" .=) <$> srch
3105− ,("index_routing" .=) <$> idx]
3106−
3107−instance FromJSON AliasRouting where
3108− parseJSON = withObject "AliasRouting" parse
3109− where parse o = parseAll o <|> parseGranular o
3110− parseAll o = AllAliasRouting <$> o .: "routing"
3111− parseGranular o = do
3112− sr <- o .:? "search_routing"
3113− ir <- o .:? "index_routing"
3114− if isNothing sr && isNothing ir
3115− then fail "Both search_routing and index_routing can't be blank"
3116− else return (GranularAliasRouting sr ir)
3117−
3118−instance FromJSON IndexAliasCreate where
3119− parseJSON v = withObject "IndexAliasCreate" parse v
3120− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3121− <*> o .:? "filter"
3122−
3123−instance ToJSON SearchAliasRouting where
3124− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3125−
3126−instance FromJSON SearchAliasRouting where
3127− parseJSON = withText "SearchAliasRouting" parse
3128− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3129−
3130−instance ToJSON Search where
3131− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3132− omitNulls [ "query" .= query
3133− , "filter" .= sFilter
3134− , "sort" .= sort
3135− , "aggregations" .= searchAggs
3136− , "highlight" .= highlight
3137− , "from" .= sFrom
3138− , "size" .= sSize
3139− , "track_scores" .= sTrackSortScores
3140− , "fields" .= sFields
3141− , "_source" .= sSource]
3142−
3143−
3144−instance ToJSON Source where
3145− toJSON NoSource = toJSON False
3146− toJSON (SourcePatterns patterns) = toJSON patterns
3147− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3148−
3149−instance ToJSON PatternOrPatterns where
3150− toJSON (PopPattern pattern) = toJSON pattern
3151− toJSON (PopPatterns patterns) = toJSON patterns
3152−
3153−instance ToJSON Include where
3154− toJSON (Include patterns) = toJSON patterns
3155−
3156−instance ToJSON Exclude where
3157− toJSON (Exclude patterns) = toJSON patterns
3158−
3159−instance ToJSON Pattern where
3160− toJSON (Pattern pattern) = toJSON pattern
3161−
3162−
3163−instance ToJSON FieldHighlight where
3164− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3165− object [ fName .= fSettings ]
3166− toJSON (FieldHighlight (FieldName fName) Nothing) =
3167− object [ fName .= emptyObject ]
3168−
3169−instance ToJSON Highlights where
3170− toJSON (Highlights global fields) =
3171− omitNulls (("fields" .= fields)
3172− : highlightSettingsPairs global)
3173−
3174−instance ToJSON HighlightSettings where
3175− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3176−
3177−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3178−highlightSettingsPairs Nothing = []
3179−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3180−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3181−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3182−
3183−
3184−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3185−plainHighPairs Nothing = []
3186−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3187− [ "type" .= String "plain"]
3188− ++ commonHighlightPairs plCom
3189− ++ nonPostingsToPairs plNonPost
3190−
3191−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3192−postHighPairs Nothing = []
3193−postHighPairs (Just (PostingsHighlight pCom)) =
3194− ("type" .= String "postings")
3195− : commonHighlightPairs pCom
3196−
3197−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3198−fastVectorHighPairs Nothing = []
3199−fastVectorHighPairs (Just
3200− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3201− fvBoundMaxScan fvFragOff fvMatchedFields
3202− fvPhraseLim)) =
3203− [ "type" .= String "fvh"
3204− , "boundary_chars" .= fvBoundChars
3205− , "boundary_max_scan" .= fvBoundMaxScan
3206− , "fragment_offset" .= fvFragOff
3207− , "matched_fields" .= fvMatchedFields
3208− , "phraseLimit" .= fvPhraseLim]
3209− ++ commonHighlightPairs fvCom
3210− ++ nonPostingsToPairs fvNonPostSettings
3211−
3212−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3213−deleteSeveral ks hm = foldr HM.delete hm ks
3214−
3215−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3216−commonHighlightPairs Nothing = []
3217−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3218− chNoMatchSize chHighlightQuery
3219− chRequireFieldMatch)) =
3220− [ "order" .= chScore
3221− , "force_source" .= chForceSource
3222− , "encoder" .= chEncoder
3223− , "no_match_size" .= chNoMatchSize
3224− , "highlight_query" .= chHighlightQuery
3225− , "require_fieldMatch" .= chRequireFieldMatch]
3226− ++ highlightTagToPairs chTag
3227−
3228−
3229−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3230−nonPostingsToPairs Nothing = []
3231−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3232− [ "fragment_size" .= npFragSize
3233− , "number_of_fragments" .= npNumOfFrags]
3234−
3235−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3236−parseNEJSON [] = fail "Expected non-empty list"
3237−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3238−
3239−
3240−instance ToJSON HighlightEncoder where
3241− toJSON DefaultEncoder = String "default"
3242− toJSON HTMLEncoder = String "html"
3243−
3244−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3245−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3246−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3247− , "post_tags" .= post]
3248−highlightTagToPairs Nothing = []
3249−
3250−instance ToJSON SortSpec where
3251− toJSON (DefaultSortSpec
3252− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3253− dsSortMode dsMissingSort dsNestedFilter)) =
3254− object [dsSortFieldName .= omitNulls base] where
3255− base = [ "order" .= dsSortOrder
3256− , "ignore_unmapped" .= dsIgnoreUnmapped
3257− , "mode" .= dsSortMode
3258− , "missing" .= dsMissingSort
3259− , "nested_filter" .= dsNestedFilter ]
3260−
3261− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3262− object [ "unit" .= units
3263− , field .= gdsLatLon
3264− , "order" .= gdsSortOrder ]
3265−
3266−
3267−instance ToJSON SortOrder where
3268− toJSON Ascending = String "asc"
3269− toJSON Descending = String "desc"
3270−
3271−
3272−instance ToJSON SortMode where
3273− toJSON SortMin = String "min"
3274− toJSON SortMax = String "max"
3275− toJSON SortSum = String "sum"
3276− toJSON SortAvg = String "avg"
3277−
3278−
3279−instance ToJSON Missing where
3280− toJSON LastMissing = String "_last"
3281− toJSON FirstMissing = String "_first"
3282− toJSON (CustomMissing txt) = String txt
3283−
3284−
3285−instance ToJSON ScoreType where
3286− toJSON ScoreTypeMax = "max"
3287− toJSON ScoreTypeAvg = "avg"
3288− toJSON ScoreTypeSum = "sum"
3289− toJSON ScoreTypeNone = "none"
3290−
3291−instance FromJSON ScoreType where
3292− parseJSON = withText "ScoreType" parse
3293− where parse "max" = pure ScoreTypeMax
3294− parse "avg" = pure ScoreTypeAvg
3295− parse "sum" = pure ScoreTypeSum
3296− parse "none" = pure ScoreTypeNone
3297− parse t = fail ("Unexpected ScoreType: " <> show t)
3298−
3299−instance ToJSON Distance where
3300− toJSON (Distance dCoefficient dUnit) =
3301− String boltedTogether where
3302− coefText = showText dCoefficient
3303− (String unitText) = toJSON dUnit
3304− boltedTogether = mappend coefText unitText
3305−
3306−instance FromJSON Distance where
3307− parseJSON = withText "Distance" parse
3308− where parse t = Distance <$> parseCoeff nT
3309− <*> parseJSON (String unitT)
3310− where (nT, unitT) = T.span validForNumber t
3311− -- may be a better way to do this
3312− validForNumber '-' = True
3313− validForNumber '.' = True
3314− validForNumber 'e' = True
3315− validForNumber c = isNumber c
3316− parseCoeff "" = fail "Empty string cannot be parsed as number"
3317− parseCoeff s = return (read (T.unpack s))
3318−
3319−instance ToJSON DistanceUnit where
3320− toJSON Miles = String "mi"
3321− toJSON Yards = String "yd"
3322− toJSON Feet = String "ft"
3323− toJSON Inches = String "in"
3324− toJSON Kilometers = String "km"
3325− toJSON Meters = String "m"
3326− toJSON Centimeters = String "cm"
3327− toJSON Millimeters = String "mm"
3328− toJSON NauticalMiles = String "nmi"
3329−
3330−
3331−instance FromJSON DistanceUnit where
3332− parseJSON = withText "DistanceUnit" parse
3333− where parse "mi" = pure Miles
3334− parse "yd" = pure Yards
3335− parse "ft" = pure Feet
3336− parse "in" = pure Inches
3337− parse "km" = pure Kilometers
3338− parse "m" = pure Meters
3339− parse "cm" = pure Centimeters
3340− parse "mm" = pure Millimeters
3341− parse "nmi" = pure NauticalMiles
3342− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3343−
3344−instance ToJSON DistanceType where
3345− toJSON Arc = String "arc"
3346− toJSON SloppyArc = String "sloppy_arc"
3347− toJSON Plane = String "plane"
3348−
3349−instance FromJSON DistanceType where
3350− parseJSON = withText "DistanceType" parse
3351− where parse "arc" = pure Arc
3352− parse "sloppy_arc" = pure SloppyArc
3353− parse "plane" = pure Plane
3354− parse t = fail ("Unrecognized DistanceType: " <> show t)
3355−
3356−
3357−instance ToJSON OptimizeBbox where
3358− toJSON NoOptimizeBbox = String "none"
3359− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3360−
3361−instance FromJSON OptimizeBbox where
3362− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3363− <|> parseOptimize v
3364− where parseNoOptimize "none" = pure NoOptimizeBbox
3365− parseNoOptimize _ = mzero
3366− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3367−
3368−instance ToJSON GeoBoundingBoxConstraint where
3369− toJSON (GeoBoundingBoxConstraint
3370− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3371− object [gbbcGeoBBField .= gbbcConstraintBox
3372− , "_cache" .= cache
3373− , "type" .= type']
3374−
3375−instance FromJSON GeoBoundingBoxConstraint where
3376− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3377− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3378− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3379− <$> parseJSON v
3380− <*> o .:? "_cache" .!= defaultCache
3381− <*> o .: "type"
3382− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3383−
3384−instance ToJSON GeoFilterType where
3385− toJSON GeoFilterMemory = String "memory"
3386− toJSON GeoFilterIndexed = String "indexed"
3387−
3388−instance FromJSON GeoFilterType where
3389− parseJSON = withText "GeoFilterType" parse
3390− where parse "memory" = pure GeoFilterMemory
3391− parse "indexed" = pure GeoFilterIndexed
3392− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3393−
3394−instance ToJSON GeoBoundingBox where
3395− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3396− object ["top_left" .= gbbTopLeft
3397− , "bottom_right" .= gbbBottomRight]
3398−
3399−instance FromJSON GeoBoundingBox where
3400− parseJSON = withObject "GeoBoundingBox" parse
3401− where parse o = GeoBoundingBox
3402− <$> o .: "top_left"
3403− <*> o .: "bottom_right"
3404−
3405−instance ToJSON LatLon where
3406− toJSON (LatLon lLat lLon) =
3407− object ["lat" .= lLat
3408− , "lon" .= lLon]
3409−
3410−instance FromJSON LatLon where
3411− parseJSON = withObject "LatLon" parse
3412− where parse o = LatLon <$> o .: "lat"
3413− <*> o .: "lon"
3414−
3415−-- index for smaller ranges, fielddata for longer ranges
3416−instance ToJSON RangeExecution where
3417− toJSON RangeExecutionIndex = "index"
3418− toJSON RangeExecutionFielddata = "fielddata"
3419−
3420−
3421−instance FromJSON RangeExecution where
3422− parseJSON = withText "RangeExecution" parse
3423− where parse "index" = pure RangeExecutionIndex
3424− parse "fielddata" = pure RangeExecutionFielddata
3425− parse t = error ("Unrecognized RangeExecution " <> show t)
3426−
3427−instance ToJSON RegexpFlags where
3428− toJSON AllRegexpFlags = String "ALL"
3429− toJSON NoRegexpFlags = String "NONE"
3430− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3431− where flagStrs = map flagStr . nub $ h:fs
3432− flagStr AnyString = "ANYSTRING"
3433− flagStr Automaton = "AUTOMATON"
3434− flagStr Complement = "COMPLEMENT"
3435− flagStr Empty = "EMPTY"
3436− flagStr Intersection = "INTERSECTION"
3437− flagStr Interval = "INTERVAL"
3438−
3439−instance FromJSON RegexpFlags where
3440− parseJSON = withText "RegexpFlags" parse
3441− where parse "ALL" = pure AllRegexpFlags
3442− parse "NONE" = pure NoRegexpFlags
3443− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3444−
3445−instance FromJSON RegexpFlag where
3446− parseJSON = withText "RegexpFlag" parse
3447− where parse "ANYSTRING" = pure AnyString
3448− parse "AUTOMATON" = pure Automaton
3449− parse "COMPLEMENT" = pure Complement
3450− parse "EMPTY" = pure Empty
3451− parse "INTERSECTION" = pure Intersection
3452− parse "INTERVAL" = pure Interval
3453− parse f = fail ("Unknown RegexpFlag: " <> show f)
3454−
3455−instance ToJSON Term where
3456− toJSON (Term field value) = object ["term" .= object
3457− [field .= value]]
3458−
3459−instance FromJSON Term where
3460− parseJSON = withObject "Term" parse
3461− where parse o = do termObj <- o .: "term"
3462− case HM.toList termObj of
3463− [(fn, v)] -> Term fn <$> parseJSON v
3464− _ -> fail "Expected object with 1 field-named key"
3465−
3466−instance ToJSON BoolMatch where
3467− toJSON (MustMatch term cache) = object ["must" .= term,
3468− "_cache" .= cache]
3469− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3470− "_cache" .= cache]
3471− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3472− "_cache" .= cache]
3473−
3474−instance FromJSON BoolMatch where
3475− parseJSON = withObject "BoolMatch" parse
3476− where parse o = mustMatch `taggedWith` "must"
3477− <|> mustNotMatch `taggedWith` "must_not"
3478− <|> shouldMatch `taggedWith` "should"
3479− where taggedWith parser k = parser =<< o .: k
3480− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3481− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3482− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
522+ , scrollId :: Maybe ScrollId
523+ -- ^ Only one Suggestion request / response per
524+ -- Search is supported.
525+ , suggest :: Maybe NamedSuggestionResponse
526+ }
527+ deriving (Eq, Show)
3483528
3484529instance (FromJSON a) => FromJSON (SearchResult a) where
3485530 parseJSON (Object v) = SearchResult <$>
@@ -3488,71 +533,10 @@ instance (FromJSON a) => FromJSON (SearchResult a) where
3488533 v .: "_shards" <*>
3489534 v .: "hits" <*>
3490535 v .:? "aggregations" <*>
3491− v .:? "_scroll_id"
3492− parseJSON _ = empty
3493−
3494−instance (FromJSON a) => FromJSON (SearchHits a) where
3495− parseJSON (Object v) = SearchHits <$>
3496− v .: "total" <*>
3497− v .: "max_score" <*>
3498− v .: "hits"
3499− parseJSON _ = empty
3500−
3501−instance (FromJSON a) => FromJSON (Hit a) where
3502− parseJSON (Object v) = Hit <$>
3503− v .: "_index" <*>
3504− v .: "_type" <*>
3505− v .: "_id" <*>
3506− v .: "_score" <*>
3507− v .:? "_source" <*>
3508− v .:? "highlight"
536+ v .:? "_scroll_id" <*>
537+ v .:? "suggest"
3509538 parseJSON _ = empty
3510539
3511−instance FromJSON ShardResult where
3512− parseJSON (Object v) = ShardResult <$>
3513− v .: "total" <*>
3514− v .: "successful" <*>
3515− v .: "failed"
3516− parseJSON _ = empty
3517−
3518−
3519−instance FromJSON DocVersion where
3520− parseJSON v = do
3521− i <- parseJSON v
3522− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3523−
3524−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3525−instance FromJSON ReplicaCount where
3526− parseJSON v = parseAsInt v
3527− <|> parseAsString v
3528− where parseAsInt = fmap ReplicaCount . parseJSON
3529− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3530−
3531−instance FromJSON ShardCount where
3532− parseJSON v = parseAsInt v
3533− <|> parseAsString v
3534− where parseAsInt = fmap ShardCount . parseJSON
3535− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3536−
3537−instance Bounded DocVersion where
3538− minBound = DocVersion 1
3539− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3540−
3541−instance Enum DocVersion where
3542− succ x
3543− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3544− | otherwise = succError "DocVersion"
3545− pred x
3546− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3547− | otherwise = predError "DocVersion"
3548− toEnum i =
3549− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3550− fromEnum = docVersionNumber
3551− enumFrom = boundedEnumFrom
3552− enumFromThen = boundedEnumFromThen
3553−
3554−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3555−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Show, Eq)
3556−
3557−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3558−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Show, Eq)
540+newtype ScrollId =
541+ ScrollId Text
542+ deriving (Eq, Show, Ord, ToJSON, FromJSON)