@@ -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,2028 +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 -> BucketValue
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 = termKey
1780− docCount = termsDocCount
1781− aggs = termsAggs
1782−
1783−instance BucketAggregation DateHistogramResult where
1784− key = TextValue . showText . dateKey
1785− docCount = dateDocCount
1786− aggs = dateHistogramAggs
1787−
1788−instance BucketAggregation DateRangeResult where
1789− key = TextValue . dateRangeKey
1790− docCount = dateRangeDocCount
1791− aggs = dateRangeAggs
1792−
1793−instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
1794− parseJSON (Object v) = Bucket <$>
1795− v .: "buckets"
1796− parseJSON _ = mempty
1797−
1798−instance FromJSON BucketValue where
1799− parseJSON (String t) = return $ TextValue t
1800− parseJSON (Number s) = return $ ScientificValue s
1801− parseJSON (Bool b) = return $ BoolValue b
1802− parseJSON _ = mempty
1803−
1804−instance FromJSON TermsResult where
1805− parseJSON (Object v) = TermsResult <$>
1806− v .: "key" <*>
1807− v .: "doc_count" <*>
1808− v .:? "aggregations"
1809− parseJSON _ = mempty
1810−
1811−instance FromJSON DateHistogramResult where
1812− parseJSON (Object v) = DateHistogramResult <$>
1813− v .: "key" <*>
1814− v .:? "key_as_string" <*>
1815− v .: "doc_count" <*>
1816− v .:? "aggregations"
1817− parseJSON _ = mempty
1818−
1819−instance FromJSON DateRangeResult where
1820− parseJSON = withObject "DateRangeResult" parse
1821− where parse v = DateRangeResult <$>
1822− v .: "key" <*>
1823− (fmap posixMS <$> v .:? "from") <*>
1824− v .:? "from_as_string" <*>
1825− (fmap posixMS <$> v .:? "to") <*>
1826− v .:? "to_as_string" <*>
1827− v .: "doc_count" <*>
1828− v .:? "aggregations"
1829−
1830−instance FromJSON POSIXMS where
1831− parseJSON = withScientific "POSIXMS" (return . parse)
1832− where parse n = let n' = truncate n :: Integer
1833− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
1834−
1835−instance Monoid Filter where
1836− mempty = IdentityFilter
1837− mappend a b = AndFilter [a, b] defaultCache
1838−
1839−instance Seminearring Filter where
1840− a <||> b = OrFilter [a, b] defaultCache
1841−
1842−instance ToJSON Filter where
1843− toJSON (AndFilter filters cache) =
1844− object ["and" .=
1845− object [ "filters" .= fmap toJSON filters
1846− , "_cache" .= cache]]
1847−
1848− toJSON (OrFilter filters cache) =
1849− object ["or" .=
1850− object [ "filters" .= fmap toJSON filters
1851− , "_cache" .= cache]]
1852−
1853− toJSON (NotFilter notFilter cache) =
1854− object ["not" .=
1855− object ["filter" .= notFilter
1856− , "_cache" .= cache]]
1857−
1858− toJSON (IdentityFilter) =
1859− object ["match_all" .= object []]
1860−
1861− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
1862− object ["term" .= object base]
1863− where base = [termFilterField .= termFilterValue,
1864− "_cache" .= cache]
1865−
1866− toJSON (ExistsFilter (FieldName fieldName)) =
1867− object ["exists" .= object
1868− ["field" .= fieldName]]
1869−
1870− toJSON (BoolFilter boolMatch) =
1871− object ["bool" .= boolMatch]
1872−
1873− toJSON (GeoBoundingBoxFilter bbConstraint) =
1874− object ["geo_bounding_box" .= bbConstraint]
1875−
1876− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
1877− distance distanceType optimizeBbox cache) =
1878− object ["geo_distance" .=
1879− object ["distance" .= distance
1880− , "distance_type" .= distanceType
1881− , "optimize_bbox" .= optimizeBbox
1882− , distanceGeoField .= geoDistLatLon
1883− , "_cache" .= cache]]
1884−
1885− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
1886− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
1887− object ["geo_distance_range" .=
1888− object ["from" .= geoDistRangeDistFrom
1889− , "to" .= drDistanceTo
1890− , gddrField .= drLatLon]]
1891−
1892− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
1893− object ["geo_polygon" .=
1894− object [geoPolygonFilterField .=
1895− object ["points" .= fmap toJSON latLons]]]
1896−
1897− toJSON (IdsFilter (MappingName mappingName) values) =
1898− object ["ids" .=
1899− object ["type" .= mappingName
1900− , "values" .= fmap unpackId values]]
1901−
1902− toJSON (LimitFilter limit) =
1903− object ["limit" .= object ["value" .= limit]]
1904−
1905− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
1906− object ["missing" .=
1907− object ["field" .= fieldName
1908− , "existence" .= existence
1909− , "null_value" .= nullValue]]
1910−
1911− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
1912− object ["prefix" .=
1913− object [fieldName .= fieldValue
1914− , "_cache" .= cache]]
1915−
1916− toJSON (QueryFilter query False) =
1917− object ["query" .= toJSON query ]
1918− toJSON (QueryFilter query True) =
1919− object ["fquery" .=
1920− object [ "query" .= toJSON query
1921− , "_cache" .= True ]]
1922−
1923− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
1924− object ["range" .=
1925− object [ fieldName .= object (rangeValueToPair rangeValue)
1926− , "execution" .= rangeExecution
1927− , "_cache" .= cache]]
1928−
1929− toJSON (RegexpFilter (FieldName fieldName)
1930− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
1931− object ["regexp" .=
1932− object [fieldName .=
1933− object ["value" .= regexText
1934− , "flags" .= flags]
1935− , "_name" .= cacheName
1936− , "_cache" .= cache
1937− , "_cache_key" .= cacheKey]]
1938−
1939−instance FromJSON Filter where
1940− parseJSON = withObject "Filter" parse
1941− where parse o = andFilter `taggedWith` "and"
1942− <|> orFilter `taggedWith` "or"
1943− <|> notFilter `taggedWith` "not"
1944− <|> identityFilter `taggedWith` "match_all"
1945− <|> boolFilter `taggedWith` "bool"
1946− <|> existsFilter `taggedWith` "exists"
1947− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
1948− <|> geoDistanceFilter `taggedWith` "geo_distance"
1949− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
1950− <|> geoPolygonFilter `taggedWith` "geo_polygon"
1951− <|> idsFilter `taggedWith` "ids"
1952− <|> limitFilter `taggedWith` "limit"
1953− <|> missingFilter `taggedWith` "missing"
1954− <|> prefixFilter `taggedWith` "prefix"
1955− <|> queryFilter `taggedWith` "query"
1956− <|> fqueryFilter `taggedWith` "fquery"
1957− <|> rangeFilter `taggedWith` "range"
1958− <|> regexpFilter `taggedWith` "regexp"
1959− <|> termFilter `taggedWith` "term"
1960− where taggedWith parser k = parser =<< o .: k
1961− andFilter o = AndFilter <$> o .: "filters"
1962− <*> o .:? "_cache" .!= defaultCache
1963− orFilter o = OrFilter <$> o .: "filters"
1964− <*> o .:? "_cache" .!= defaultCache
1965− notFilter o = NotFilter <$> o .: "filter"
1966− <*> o .: "_cache" .!= defaultCache
1967− identityFilter :: Object -> Parser Filter
1968− identityFilter m
1969− | HM.null m = pure IdentityFilter
1970− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
1971− boolFilter = pure . BoolFilter
1972− existsFilter o = ExistsFilter <$> o .: "field"
1973− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
1974− geoDistanceFilter o = do
1975− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
1976− [(fn, v)] -> do
1977− gp <- GeoPoint (FieldName fn) <$> parseJSON v
1978− GeoDistanceFilter gp <$> o .: "distance"
1979− <*> o .: "distance_type"
1980− <*> o .: "optimize_bbox"
1981− <*> o .:? "_cache" .!= defaultCache
1982− _ -> fail "Could not find GeoDistanceFilter field name"
1983− geoDistanceRangeFilter o = do
1984− case HM.toList (deleteSeveral ["from", "to"] o) of
1985− [(fn, v)] -> do
1986− gp <- GeoPoint (FieldName fn) <$> parseJSON v
1987− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
1988− return (GeoDistanceRangeFilter gp rng)
1989− _ -> fail "Could not find GeoDistanceRangeFilter field name"
1990− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
1991− idsFilter o = IdsFilter <$> o .: "type"
1992− <*> o .: "values"
1993− limitFilter o = LimitFilter <$> o .: "value"
1994− missingFilter o = MissingFilter <$> o .: "field"
1995− <*> o .: "existence"
1996− <*> o .: "null_value"
1997− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
1998− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
1999− _ -> fail "Could not parse PrefixFilter"
2000−
2001− queryFilter q = pure (QueryFilter q False)
2002− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2003− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2004− [(fn, v)] -> RangeFilter (FieldName fn)
2005− <$> parseJSON v
2006− <*> o .: "execution"
2007− <*> o .:? "_cache" .!= defaultCache
2008− _ -> fail "Could not find field name for RangeFilter"
2009− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2010− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2011− <$> o' .: "value"
2012− <*> o' .: "flags"
2013− <*> o .: "_name"
2014− <*> o .:? "_cache" .!= defaultCache
2015− <*> o .: "_cache_key"
2016− _ -> fail "Could not find field name for RegexpFilter"
2017− termFilter o = case HM.toList (HM.delete "_cache" o) of
2018− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2019− <$> o .:? "_cache" .!= defaultCache
2020− _ -> fail "Could not find term field for TermFilter"
2021−
2022−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2023−fieldTagged f o = case HM.toList o of
2024− [(k, Object o')] -> f (FieldName k) o'
2025− _ -> fail "Expected object with 1 field-named key"
2026−
2027−instance ToJSON GeoPoint where
2028− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2029− object [ geoPointField .= geoPointLatLon ]
2030−
2031−
2032−instance ToJSON Query where
2033− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2034− object [ "term" .=
2035− object [termQueryField .= object merged]]
2036− where
2037− base = [ "value" .= termQueryValue ]
2038− boosted = maybe [] (return . ("boost" .=)) boost
2039− merged = mappend base boosted
2040−
2041− toJSON (TermsQuery fieldName terms) =
2042− object [ "terms" .= object conjoined ]
2043− where conjoined = [fieldName .= terms]
2044− toJSON (IdsQuery idsQueryMappingName docIds) =
2045− object [ "ids" .= object conjoined ]
2046− where conjoined = [ "type" .= idsQueryMappingName
2047− , "values" .= fmap toJSON docIds ]
2048−
2049− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2050− object [ "query_string" .= qQueryStringQuery ]
2051−
2052− toJSON (QueryMatchQuery matchQuery) =
2053− object [ "match" .= matchQuery ]
2054−
2055− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2056− toJSON multiMatchQuery
2057−
2058− toJSON (QueryBoolQuery boolQuery) =
2059− object [ "bool" .= boolQuery ]
2060−
2061− toJSON (QueryBoostingQuery boostingQuery) =
2062− object [ "boosting" .= boostingQuery ]
2063−
2064− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2065− object [ "common" .= commonTermsQuery ]
2066−
2067− toJSON (ConstantScoreFilter csFilter boost) =
2068− object ["constant_score" .= object ["filter" .= csFilter
2069− , "boost" .= boost]]
2070−
2071− toJSON (ConstantScoreQuery query boost) =
2072− object ["constant_score" .= object ["query" .= query
2073− , "boost" .= boost]]
2074−
2075− toJSON (QueryDisMaxQuery disMaxQuery) =
2076− object [ "dis_max" .= disMaxQuery ]
2077−
2078− toJSON (QueryFilteredQuery qFilteredQuery) =
2079− object [ "filtered" .= qFilteredQuery ]
2080−
2081− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2082− object [ "fuzzy_like_this" .= fuzzyQuery ]
2083−
2084− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2085− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2086−
2087− toJSON (QueryFuzzyQuery fuzzyQuery) =
2088− object [ "fuzzy" .= fuzzyQuery ]
2089−
2090− toJSON (QueryHasChildQuery childQuery) =
2091− object [ "has_child" .= childQuery ]
2092−
2093− toJSON (QueryHasParentQuery parentQuery) =
2094− object [ "has_parent" .= parentQuery ]
2095−
2096− toJSON (QueryIndicesQuery qIndicesQuery) =
2097− object [ "indices" .= qIndicesQuery ]
2098−
2099− toJSON (MatchAllQuery boost) =
2100− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2101−
2102− toJSON (QueryMoreLikeThisQuery query) =
2103− object [ "more_like_this" .= query ]
2104−
2105− toJSON (QueryMoreLikeThisFieldQuery query) =
2106− object [ "more_like_this_field" .= query ]
2107−
2108− toJSON (QueryNestedQuery query) =
2109− object [ "nested" .= query ]
2110−
2111− toJSON (QueryPrefixQuery query) =
2112− object [ "prefix" .= query ]
2113−
2114− toJSON (QueryRangeQuery query) =
2115− object [ "range" .= query ]
2116−
2117− toJSON (QueryRegexpQuery query) =
2118− object [ "regexp" .= query ]
2119−
2120− toJSON (QuerySimpleQueryStringQuery query) =
2121− object [ "simple_query_string" .= query ]
2122−
2123−instance FromJSON Query where
2124− parseJSON v = withObject "Query" parse v
2125− where parse o = termQuery `taggedWith` "term"
2126− <|> termsQuery `taggedWith` "terms"
2127− <|> idsQuery `taggedWith` "ids"
2128− <|> queryQueryStringQuery `taggedWith` "query_string"
2129− <|> queryMatchQuery `taggedWith` "match"
2130− <|> queryMultiMatchQuery
2131− <|> queryBoolQuery `taggedWith` "bool"
2132− <|> queryBoostingQuery `taggedWith` "boosting"
2133− <|> queryCommonTermsQuery `taggedWith` "common"
2134− <|> constantScoreFilter `taggedWith` "constant_score"
2135− <|> constantScoreQuery `taggedWith` "constant_score"
2136− <|> queryDisMaxQuery `taggedWith` "dis_max"
2137− <|> queryFilteredQuery `taggedWith` "filtered"
2138− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2139− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2140− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2141− <|> queryHasChildQuery `taggedWith` "has_child"
2142− <|> queryHasParentQuery `taggedWith` "has_parent"
2143− <|> queryIndicesQuery `taggedWith` "indices"
2144− <|> matchAllQuery `taggedWith` "match_all"
2145− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2146− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2147− <|> queryNestedQuery `taggedWith` "nested"
2148− <|> queryPrefixQuery `taggedWith` "prefix"
2149− <|> queryRangeQuery `taggedWith` "range"
2150− <|> queryRegexpQuery `taggedWith` "regexp"
2151− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2152− where taggedWith parser k = parser =<< o .: k
2153− termQuery = fieldTagged $ \(FieldName fn) o ->
2154− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2155− termsQuery o = case HM.toList o of
2156− [(fn, vs)] -> do vals <- parseJSON vs
2157− case vals of
2158− x:xs -> return (TermsQuery fn (x :| xs))
2159− _ -> fail "Expected non empty list of values"
2160− _ -> fail "Expected object with 1 field-named key"
2161− idsQuery o = IdsQuery <$> o .: "type"
2162− <*> o .: "values"
2163− queryQueryStringQuery = pure . QueryQueryStringQuery
2164− queryMatchQuery = pure . QueryMatchQuery
2165− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2166− queryBoolQuery = pure . QueryBoolQuery
2167− queryBoostingQuery = pure . QueryBoostingQuery
2168− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2169− constantScoreFilter o = case HM.lookup "filter" o of
2170− Just x -> ConstantScoreFilter <$> parseJSON x
2171− <*> o .: "boost"
2172− _ -> fail "Does not appear to be a ConstantScoreFilter"
2173− constantScoreQuery o = case HM.lookup "query" o of
2174− Just x -> ConstantScoreQuery <$> parseJSON x
2175− <*> o .: "boost"
2176− _ -> fail "Does not appear to be a ConstantScoreQuery"
2177− queryDisMaxQuery = pure . QueryDisMaxQuery
2178− queryFilteredQuery = pure . QueryFilteredQuery
2179− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2180− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2181− queryFuzzyQuery = pure . QueryFuzzyQuery
2182− queryHasChildQuery = pure . QueryHasChildQuery
2183− queryHasParentQuery = pure . QueryHasParentQuery
2184− queryIndicesQuery = pure . QueryIndicesQuery
2185− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2186− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2187− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2188− queryNestedQuery = pure . QueryNestedQuery
2189− queryPrefixQuery = pure . QueryPrefixQuery
2190− queryRangeQuery = pure . QueryRangeQuery
2191− queryRegexpQuery = pure . QueryRegexpQuery
2192− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2193−
2194−
2195−omitNulls :: [(Text, Value)] -> Value
2196−omitNulls = object . filter notNull where
2197− notNull (_, Null) = False
2198− notNull (_, Array a) = (not . V.null) a
2199− notNull _ = True
2200−
2201−
2202−instance ToJSON SimpleQueryStringQuery where
2203− toJSON SimpleQueryStringQuery {..} =
2204− omitNulls (base ++ maybeAdd)
2205− where base = [ "query" .= simpleQueryStringQuery ]
2206− maybeAdd = [ "fields" .= simpleQueryStringField
2207− , "default_operator" .= simpleQueryStringOperator
2208− , "analyzer" .= simpleQueryStringAnalyzer
2209− , "flags" .= simpleQueryStringFlags
2210− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2211− , "locale" .= simpleQueryStringLocale ]
2212−
2213−instance FromJSON SimpleQueryStringQuery where
2214− parseJSON = withObject "SimpleQueryStringQuery" parse
2215− where parse o = SimpleQueryStringQuery <$> o .: "query"
2216− <*> o .:? "fields"
2217− <*> o .:? "default_operator"
2218− <*> o .:? "analyzer"
2219− <*> (parseFlags <$> o .:? "flags")
2220− <*> o .:? "lowercase_expanded_terms"
2221− <*> o .:? "locale"
2222− parseFlags (Just (x:xs)) = Just (x :| xs)
2223− parseFlags _ = Nothing
2224−
2225−instance ToJSON FieldOrFields where
2226− toJSON (FofField fieldName) =
2227− toJSON fieldName
2228− toJSON (FofFields fieldNames) =
2229− toJSON fieldNames
2230−
2231−instance FromJSON FieldOrFields where
2232− parseJSON v = FofField <$> parseJSON v
2233− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2234−
2235−instance ToJSON SimpleQueryFlag where
2236− toJSON SimpleQueryAll = "ALL"
2237− toJSON SimpleQueryNone = "NONE"
2238− toJSON SimpleQueryAnd = "AND"
2239− toJSON SimpleQueryOr = "OR"
2240− toJSON SimpleQueryPrefix = "PREFIX"
2241− toJSON SimpleQueryPhrase = "PHRASE"
2242− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2243− toJSON SimpleQueryEscape = "ESCAPE"
2244− toJSON SimpleQueryWhitespace = "WHITESPACE"
2245− toJSON SimpleQueryFuzzy = "FUZZY"
2246− toJSON SimpleQueryNear = "NEAR"
2247− toJSON SimpleQuerySlop = "SLOP"
2248−
2249−instance FromJSON SimpleQueryFlag where
2250− parseJSON = withText "SimpleQueryFlag" parse
2251− where parse "ALL" = pure SimpleQueryAll
2252− parse "NONE" = pure SimpleQueryNone
2253− parse "AND" = pure SimpleQueryAnd
2254− parse "OR" = pure SimpleQueryOr
2255− parse "PREFIX" = pure SimpleQueryPrefix
2256− parse "PHRASE" = pure SimpleQueryPhrase
2257− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2258− parse "ESCAPE" = pure SimpleQueryEscape
2259− parse "WHITESPACE" = pure SimpleQueryWhitespace
2260− parse "FUZZY" = pure SimpleQueryFuzzy
2261− parse "NEAR" = pure SimpleQueryNear
2262− parse "SLOP" = pure SimpleQuerySlop
2263− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2264−
2265−instance ToJSON RegexpQuery where
2266− toJSON (RegexpQuery (FieldName rqQueryField)
2267− (Regexp regexpQueryQuery) rqQueryFlags
2268− rqQueryBoost) =
2269− object [ rqQueryField .= omitNulls base ]
2270− where base = [ "value" .= regexpQueryQuery
2271− , "flags" .= rqQueryFlags
2272− , "boost" .= rqQueryBoost ]
2273−
2274−instance FromJSON RegexpQuery where
2275− parseJSON = withObject "RegexpQuery" parse
2276− where parse = fieldTagged $ \fn o ->
2277− RegexpQuery fn
2278− <$> o .: "value"
2279− <*> o .: "flags"
2280− <*> o .:? "boost"
2281−
2282−instance ToJSON QueryStringQuery where
2283− toJSON (QueryStringQuery qsQueryString
2284− qsDefaultField qsOperator
2285− qsAnalyzer qsAllowWildcard
2286− qsLowercaseExpanded qsEnablePositionIncrements
2287− qsFuzzyMaxExpansions qsFuzziness
2288− qsFuzzyPrefixLength qsPhraseSlop
2289− qsBoost qsAnalyzeWildcard
2290− qsGeneratePhraseQueries qsMinimumShouldMatch
2291− qsLenient qsLocale) =
2292− omitNulls base
2293− where
2294− base = [ "query" .= qsQueryString
2295− , "default_field" .= qsDefaultField
2296− , "default_operator" .= qsOperator
2297− , "analyzer" .= qsAnalyzer
2298− , "allow_leading_wildcard" .= qsAllowWildcard
2299− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2300− , "enable_position_increments" .= qsEnablePositionIncrements
2301− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2302− , "fuzziness" .= qsFuzziness
2303− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2304− , "phrase_slop" .= qsPhraseSlop
2305− , "boost" .= qsBoost
2306− , "analyze_wildcard" .= qsAnalyzeWildcard
2307− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2308− , "minimum_should_match" .= qsMinimumShouldMatch
2309− , "lenient" .= qsLenient
2310− , "locale" .= qsLocale ]
2311−
2312−instance FromJSON QueryStringQuery where
2313− parseJSON = withObject "QueryStringQuery" parse
2314− where parse o = QueryStringQuery
2315− <$> o .: "query"
2316− <*> o .:? "default_field"
2317− <*> o .:? "default_operator"
2318− <*> o .:? "analyzer"
2319− <*> o .:? "allow_leading_wildcard"
2320− <*> o .:? "lowercase_expanded_terms"
2321− <*> o .:? "enable_position_increments"
2322− <*> o .:? "fuzzy_max_expansions"
2323− <*> o .:? "fuzziness"
2324− <*> o .:? "fuzzy_prefix_length"
2325− <*> o .:? "phrase_slop"
2326− <*> o .:? "boost"
2327− <*> o .:? "analyze_wildcard"
2328− <*> o .:? "auto_generate_phrase_queries"
2329− <*> o .:? "minimum_should_match"
2330− <*> o .:? "lenient"
2331− <*> o .:? "locale"
2332−
2333−instance ToJSON RangeQuery where
2334− toJSON (RangeQuery (FieldName fieldName) range boost) =
2335− object [ fieldName .= object conjoined ]
2336− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2337−
2338−instance FromJSON RangeQuery where
2339− parseJSON = withObject "RangeQuery" parse
2340− where parse = fieldTagged $ \fn o ->
2341− RangeQuery fn
2342− <$> parseJSON (Object o)
2343− <*> o .: "boost"
2344−
2345−instance FromJSON RangeValue where
2346− parseJSON = withObject "RangeValue" parse
2347− where parse o = parseDate o
2348− <|> parseDouble o
2349− parseDate o = do lt <- o .:? "lt"
2350− lte <- o .:? "lte"
2351− gt <- o .:? "gt"
2352− gte <- o .:? "gte"
2353− case (lt, lte, gt, gte) of
2354− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2355− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2356− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2357− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2358− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2359− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2360− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2361− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2362− (Nothing, Nothing, Nothing, Nothing) -> mzero
2363− parseDouble o = do lt <- o .:? "lt"
2364− lte <- o .:? "lte"
2365− gt <- o .:? "gt"
2366− gte <- o .:? "gte"
2367− case (lt, lte, gt, gte) of
2368− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2369− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2370− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2371− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2372− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2373− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2374− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2375− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2376− (Nothing, Nothing, Nothing, Nothing) -> mzero
2377−
2378−instance ToJSON PrefixQuery where
2379− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2380− object [ fieldName .= omitNulls base ]
2381− where base = [ "value" .= queryValue
2382− , "boost" .= boost ]
2383−
2384−instance FromJSON PrefixQuery where
2385− parseJSON = withObject "PrefixQuery" parse
2386− where parse = fieldTagged $ \fn o ->
2387− PrefixQuery fn
2388− <$> o .: "value"
2389− <*> o .:? "boost"
2390−
2391−instance ToJSON NestedQuery where
2392− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2393− object [ "path" .= nqPath
2394− , "score_mode" .= nqScoreType
2395− , "query" .= nqQuery ]
2396−
2397−instance FromJSON NestedQuery where
2398− parseJSON = withObject "NestedQuery" parse
2399− where parse o = NestedQuery
2400− <$> o .: "path"
2401− <*> o .: "score_mode"
2402− <*> o .: "query"
2403−
2404−instance ToJSON MoreLikeThisFieldQuery where
2405− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2406− percent mtf mqt stopwords mindf maxdf
2407− minwl maxwl boostTerms boost analyzer) =
2408− object [ fieldName .= omitNulls base ]
2409− where base = [ "like_text" .= text
2410− , "percent_terms_to_match" .= percent
2411− , "min_term_freq" .= mtf
2412− , "max_query_terms" .= mqt
2413− , "stop_words" .= stopwords
2414− , "min_doc_freq" .= mindf
2415− , "max_doc_freq" .= maxdf
2416− , "min_word_length" .= minwl
2417− , "max_word_length" .= maxwl
2418− , "boost_terms" .= boostTerms
2419− , "boost" .= boost
2420− , "analyzer" .= analyzer ]
2421−
2422−instance FromJSON MoreLikeThisFieldQuery where
2423− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2424− where parse = fieldTagged $ \fn o ->
2425− MoreLikeThisFieldQuery
2426− <$> o .: "like_text"
2427− <*> pure fn
2428− <*> o .:? "percent_terms_to_match"
2429− <*> o .:? "min_term_freq"
2430− <*> o .:? "max_query_terms"
2431− <*> (optionalNE =<< o .:? "stop_words")
2432− <*> o .:? "min_doc_freq"
2433− <*> o .:? "max_doc_freq"
2434− <*> o .:? "min_word_length"
2435− <*> o .:? "max_word_length"
2436− <*> o .:? "boost_terms"
2437− <*> o .:? "boost"
2438− <*> o .:? "analyzer"
2439− optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2440−
2441−instance ToJSON MoreLikeThisQuery where
2442− toJSON (MoreLikeThisQuery text fields percent
2443− mtf mqt stopwords mindf maxdf
2444− minwl maxwl boostTerms boost analyzer) =
2445− omitNulls base
2446− where base = [ "like_text" .= text
2447− , "fields" .= fields
2448− , "percent_terms_to_match" .= percent
2449− , "min_term_freq" .= mtf
2450− , "max_query_terms" .= mqt
2451− , "stop_words" .= stopwords
2452− , "min_doc_freq" .= mindf
2453− , "max_doc_freq" .= maxdf
2454− , "min_word_length" .= minwl
2455− , "max_word_length" .= maxwl
2456− , "boost_terms" .= boostTerms
2457− , "boost" .= boost
2458− , "analyzer" .= analyzer ]
2459−
2460−instance FromJSON MoreLikeThisQuery where
2461− parseJSON = withObject "MoreLikeThisQuery" parse
2462− where parse o = MoreLikeThisQuery
2463− <$> o .: "like_text"
2464− <*> (optionalNE =<< o .:? "fields")
2465− <*> o .:? "percent_terms_to_match"
2466− <*> o .:? "min_term_freq"
2467− <*> o .:? "max_query_terms"
2468− <*> (optionalNE =<< o .:? "stop_words")
2469− <*> o .:? "min_doc_freq"
2470− <*> o .:? "max_doc_freq"
2471− <*> o .:? "min_word_length"
2472− <*> o .:? "max_word_length"
2473− <*> o .:? "boost_terms"
2474− <*> o .:? "boost"
2475− <*> o .:? "analyzer"
2476− optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2477−
2478−instance ToJSON IndicesQuery where
2479− toJSON (IndicesQuery indices query noMatch) =
2480− omitNulls [ "indices" .= indices
2481− , "no_match_query" .= noMatch
2482− , "query" .= query ]
2483−
2484−instance FromJSON IndicesQuery where
2485− parseJSON = withObject "IndicesQuery" parse
2486− where parse o = IndicesQuery
2487− <$> o .:? "indices" .!= []
2488− <*> o .: "query"
2489− <*> o .:? "no_match_query"
2490−
2491−instance ToJSON HasParentQuery where
2492− toJSON (HasParentQuery queryType query scoreType) =
2493− omitNulls [ "parent_type" .= queryType
2494− , "score_type" .= scoreType
2495− , "query" .= query ]
2496−
2497−instance FromJSON HasParentQuery where
2498− parseJSON = withObject "HasParentQuery" parse
2499− where parse o = HasParentQuery
2500− <$> o .: "parent_type"
2501− <*> o .: "query"
2502− <*> o .:? "score_type"
2503−
2504−instance ToJSON HasChildQuery where
2505− toJSON (HasChildQuery queryType query scoreType) =
2506− omitNulls [ "query" .= query
2507− , "score_type" .= scoreType
2508− , "type" .= queryType ]
2509−
2510−instance FromJSON HasChildQuery where
2511− parseJSON = withObject "HasChildQuery" parse
2512− where parse o = HasChildQuery
2513− <$> o .: "type"
2514− <*> o .: "query"
2515− <*> o .:? "score_type"
2516−
2517−instance ToJSON FuzzyQuery where
2518− toJSON (FuzzyQuery (FieldName fieldName) queryText
2519− prefixLength maxEx fuzziness boost) =
2520− object [ fieldName .= omitNulls base ]
2521− where base = [ "value" .= queryText
2522− , "fuzziness" .= fuzziness
2523− , "prefix_length" .= prefixLength
2524− , "boost" .= boost
2525− , "max_expansions" .= maxEx ]
2526−
2527−instance FromJSON FuzzyQuery where
2528− parseJSON = withObject "FuzzyQuery" parse
2529− where parse = fieldTagged $ \fn o ->
2530− FuzzyQuery fn
2531− <$> o .: "value"
2532− <*> o .: "prefix_length"
2533− <*> o .: "max_expansions"
2534− <*> o .: "fuzziness"
2535− <*> o .:? "boost"
2536−
2537−instance ToJSON FuzzyLikeFieldQuery where
2538− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2539− fieldText maxTerms ignoreFreq fuzziness prefixLength
2540− boost analyzer) =
2541− object [ fieldName .=
2542− omitNulls [ "like_text" .= fieldText
2543− , "max_query_terms" .= maxTerms
2544− , "ignore_tf" .= ignoreFreq
2545− , "fuzziness" .= fuzziness
2546− , "prefix_length" .= prefixLength
2547− , "analyzer" .= analyzer
2548− , "boost" .= boost ]]
2549−
2550−instance FromJSON FuzzyLikeFieldQuery where
2551− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2552− where parse = fieldTagged $ \fn o ->
2553− FuzzyLikeFieldQuery fn
2554− <$> o .: "like_text"
2555− <*> o .: "max_query_terms"
2556− <*> o .: "ignore_tf"
2557− <*> o .: "fuzziness"
2558− <*> o .: "prefix_length"
2559− <*> o .: "boost"
2560− <*> o .:? "analyzer"
2561−
2562−instance ToJSON FuzzyLikeThisQuery where
2563− toJSON (FuzzyLikeThisQuery fields text maxTerms
2564− ignoreFreq fuzziness prefixLength boost analyzer) =
2565− omitNulls base
2566− where base = [ "fields" .= fields
2567− , "like_text" .= text
2568− , "max_query_terms" .= maxTerms
2569− , "ignore_tf" .= ignoreFreq
2570− , "fuzziness" .= fuzziness
2571− , "prefix_length" .= prefixLength
2572− , "analyzer" .= analyzer
2573− , "boost" .= boost ]
2574−
2575−instance FromJSON FuzzyLikeThisQuery where
2576− parseJSON = withObject "FuzzyLikeThisQuery" parse
2577− where parse o = FuzzyLikeThisQuery
2578− <$> o .:? "fields" .!= []
2579− <*> o .: "like_text"
2580− <*> o .: "max_query_terms"
2581− <*> o .: "ignore_tf"
2582− <*> o .: "fuzziness"
2583− <*> o .: "prefix_length"
2584− <*> o .: "boost"
2585− <*> o .:? "analyzer"
2586−
2587−instance ToJSON FilteredQuery where
2588− toJSON (FilteredQuery query fFilter) =
2589− object [ "query" .= query
2590− , "filter" .= fFilter ]
2591−
2592−instance FromJSON FilteredQuery where
2593− parseJSON = withObject "FilteredQuery" parse
2594− where parse o = FilteredQuery
2595− <$> o .: "query"
2596− <*> o .: "filter"
2597−
2598−instance ToJSON DisMaxQuery where
2599− toJSON (DisMaxQuery queries tiebreaker boost) =
2600− omitNulls base
2601− where base = [ "queries" .= queries
2602− , "boost" .= boost
2603− , "tie_breaker" .= tiebreaker ]
2604−
2605−instance FromJSON DisMaxQuery where
2606− parseJSON = withObject "DisMaxQuery" parse
2607− where parse o = DisMaxQuery
2608− <$> o .:? "queries" .!= []
2609− <*> o .: "tie_breaker"
2610− <*> o .:? "boost"
2611−
2612−instance ToJSON CommonTermsQuery where
2613− toJSON (CommonTermsQuery (FieldName fieldName)
2614− (QueryString query) cf lfo hfo msm
2615− boost analyzer disableCoord) =
2616− object [fieldName .= omitNulls base ]
2617− where base = [ "query" .= query
2618− , "cutoff_frequency" .= cf
2619− , "low_freq_operator" .= lfo
2620− , "minimum_should_match" .= msm
2621− , "boost" .= boost
2622− , "analyzer" .= analyzer
2623− , "disable_coord" .= disableCoord
2624− , "high_freq_operator" .= hfo ]
2625−
2626−instance FromJSON CommonTermsQuery where
2627− parseJSON = withObject "CommonTermsQuery" parse
2628− where parse = fieldTagged $ \fn o ->
2629− CommonTermsQuery fn
2630− <$> o .: "query"
2631− <*> o .: "cutoff_frequency"
2632− <*> o .: "low_freq_operator"
2633− <*> o .: "high_freq_operator"
2634− <*> o .:? "minimum_should_match"
2635− <*> o .:? "boost"
2636− <*> o .:? "analyzer"
2637− <*> o .:? "disable_coord"
2638−
2639−instance ToJSON CommonMinimumMatch where
2640− toJSON (CommonMinimumMatch mm) = toJSON mm
2641− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2642− object [ "low_freq" .= lowF
2643− , "high_freq" .= highF ]
2644−
2645−instance FromJSON CommonMinimumMatch where
2646− parseJSON v = parseMinimum v
2647− <|> parseMinimumHighLow v
2648− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2649− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2650− MinimumMatchHighLow
2651− <$> o .: "low_freq"
2652− <*> o .: "high_freq")
2653−
2654−
2655−instance ToJSON BoostingQuery where
2656− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2657− object [ "positive" .= bqPositiveQuery
2658− , "negative" .= bqNegativeQuery
2659− , "negative_boost" .= bqNegativeBoost ]
2660−
2661−instance FromJSON BoostingQuery where
2662− parseJSON = withObject "BoostingQuery" parse
2663− where parse o = BoostingQuery
2664− <$> o .: "positive"
2665− <*> o .: "negative"
2666− <*> o .: "negative_boost"
2667−
2668−instance ToJSON BoolQuery where
2669− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
2670− omitNulls base
2671− where base = [ "must" .= mustM
2672− , "must_not" .= notM
2673− , "should" .= shouldM
2674− , "minimum_should_match" .= bqMin
2675− , "boost" .= boost
2676− , "disable_coord" .= disableCoord ]
2677−
2678−instance FromJSON BoolQuery where
2679− parseJSON = withObject "BoolQuery" parse
2680− where parse o = BoolQuery
2681− <$> o .:? "must" .!= []
2682− <*> o .:? "must_not" .!= []
2683− <*> o .:? "should" .!= []
2684− <*> o .:? "minimum_should_match"
2685− <*> o .:? "boost"
2686− <*> o .:? "disable_coord"
2687−
2688−instance ToJSON MatchQuery where
2689− toJSON (MatchQuery (FieldName fieldName)
2690− (QueryString mqQueryString) booleanOperator
2691− zeroTermsQuery cutoffFrequency matchQueryType
2692− analyzer maxExpansions lenient boost) =
2693− object [ fieldName .= omitNulls base ]
2694− where base = [ "query" .= mqQueryString
2695− , "operator" .= booleanOperator
2696− , "zero_terms_query" .= zeroTermsQuery
2697− , "cutoff_frequency" .= cutoffFrequency
2698− , "type" .= matchQueryType
2699− , "analyzer" .= analyzer
2700− , "max_expansions" .= maxExpansions
2701− , "lenient" .= lenient
2702− , "boost" .= boost ]
2703−
2704−instance FromJSON MatchQuery where
2705− parseJSON = withObject "MatchQuery" parse
2706− where parse = fieldTagged $ \fn o ->
2707− MatchQuery fn
2708− <$> o .: "query"
2709− <*> o .: "operator"
2710− <*> o .: "zero_terms_query"
2711− <*> o .:? "cutoff_frequency"
2712− <*> o .:? "type"
2713− <*> o .:? "analyzer"
2714− <*> o .:? "max_expansions"
2715− <*> o .:? "lenient"
2716− <*> o .:? "boost"
2717−
2718−instance ToJSON MultiMatchQuery where
2719− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2720− ztQ tb mmqt cf analyzer maxEx lenient) =
2721− object ["multi_match" .= omitNulls base]
2722− where base = [ "fields" .= fmap toJSON fields
2723− , "query" .= query
2724− , "operator" .= boolOp
2725− , "zero_terms_query" .= ztQ
2726− , "tiebreaker" .= tb
2727− , "type" .= mmqt
2728− , "cutoff_frequency" .= cf
2729− , "analyzer" .= analyzer
2730− , "max_expansions" .= maxEx
2731− , "lenient" .= lenient ]
2732−
2733−instance FromJSON MultiMatchQuery where
2734− parseJSON = withObject "MultiMatchQuery" parse
2735− where parse raw = do o <- raw .: "multi_match"
2736− MultiMatchQuery
2737− <$> o .:? "fields" .!= []
2738− <*> o .: "query"
2739− <*> o .: "operator"
2740− <*> o .: "zero_terms_query"
2741− <*> o .:? "tiebreaker"
2742− <*> o .:? "type"
2743− <*> o .:? "cutoff_frequency"
2744− <*> o .:? "analyzer"
2745− <*> o .:? "max_expansions"
2746− <*> o .:? "lenient"
2747−
2748−instance ToJSON MultiMatchQueryType where
2749− toJSON MultiMatchBestFields = "best_fields"
2750− toJSON MultiMatchMostFields = "most_fields"
2751− toJSON MultiMatchCrossFields = "cross_fields"
2752− toJSON MultiMatchPhrase = "phrase"
2753− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2754−
2755−instance FromJSON MultiMatchQueryType where
2756− parseJSON = withText "MultiMatchPhrasePrefix" parse
2757− where parse "best_fields" = pure MultiMatchBestFields
2758− parse "most_fields" = pure MultiMatchMostFields
2759− parse "cross_fields" = pure MultiMatchCrossFields
2760− parse "phrase" = pure MultiMatchPhrase
2761− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2762− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2763−
2764−instance ToJSON BooleanOperator where
2765− toJSON And = String "and"
2766− toJSON Or = String "or"
2767−
2768−instance FromJSON BooleanOperator where
2769− parseJSON = withText "BooleanOperator" parse
2770− where parse "and" = pure And
2771− parse "or" = pure Or
2772− parse o = fail ("Unexpected BooleanOperator: " <> show o)
2773−
2774−instance ToJSON ZeroTermsQuery where
2775− toJSON ZeroTermsNone = String "none"
2776− toJSON ZeroTermsAll = String "all"
2777−
2778−instance FromJSON ZeroTermsQuery where
2779− parseJSON = withText "ZeroTermsQuery" parse
2780− where parse "none" = pure ZeroTermsNone
2781− parse "all" = pure ZeroTermsAll
2782− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
2783−
2784−instance ToJSON MatchQueryType where
2785− toJSON MatchPhrase = "phrase"
2786− toJSON MatchPhrasePrefix = "phrase_prefix"
2787−
2788−instance FromJSON MatchQueryType where
2789− parseJSON = withText "MatchQueryType" parse
2790− where parse "phrase" = pure MatchPhrase
2791− parse "phrase_prefix" = pure MatchPhrasePrefix
2792− parse t = fail ("Unexpected MatchQueryType: " <> show t)
2793−
2794−instance FromJSON Status where
2795− parseJSON (Object v) = Status <$>
2796− v .:? "ok" <*>
2797− v .: "status" <*>
2798− v .: "name" <*>
2799− v .: "version" <*>
2800− v .: "tagline"
2801− parseJSON _ = empty
2802−
2803−
2804−instance ToJSON IndexSettings where
2805− toJSON (IndexSettings s r) = object ["settings" .=
2806− object ["index" .=
2807− object ["number_of_shards" .= s, "number_of_replicas" .= r]
2808− ]
2809− ]
2810−
2811−instance FromJSON IndexSettings where
2812− parseJSON = withObject "IndexSettings" parse
2813− where parse o = do s <- o .: "settings"
2814− i <- s .: "index"
2815− IndexSettings <$> i .: "number_of_shards"
2816− <*> i .: "number_of_replicas"
2817−
2818−instance ToJSON UpdatableIndexSetting where
2819− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
2820− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
2821− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
2822− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
2823− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
2824− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
2825− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
2826− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
2827− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
2828− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
2829− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
2830− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
2831− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
2832− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
2833− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
2834− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
2835− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
2836− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
2837− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
2838− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
2839− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
2840− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
2841− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
2842− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
2843− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
2844− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
2845− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
2846− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
2847−
2848−instance FromJSON UpdatableIndexSetting where
2849− parseJSON = withObject "UpdatableIndexSetting" parse
2850− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
2851− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
2852− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
2853− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
2854− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
2855− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
2856− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
2857− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
2858− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
2859− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
2860− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
2861− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
2862− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
2863− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
2864− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
2865− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
2866− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
2867− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
2868− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
2869− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
2870− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
2871− <|> compoundFormat `taggedAt` ["index", "compound_format"]
2872− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
2873− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
2874− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
2875− <|> blocksRead `taggedAt` ["blocks", "read"]
2876− <|> blocksWrite `taggedAt` ["blocks", "write"]
2877− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
2878− where taggedAt f ks = taggedAt' f (Object o) ks
2879− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON =<< unStringlyTypeJSON v))
2880− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
2881− taggedAt' f v' ks) v
2882− numberOfReplicas = pure . NumberOfReplicas
2883− autoExpandReplicas = pure . AutoExpandReplicas
2884− refreshInterval = pure . RefreshInterval . ndtJSON
2885− indexConcurrency = pure . IndexConcurrency
2886− failOnMergeFailure = pure . FailOnMergeFailure
2887− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
2888− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
2889− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
2890− translogDisableFlush = pure . TranslogDisableFlush
2891− cacheFilterMaxSize = pure . CacheFilterMaxSize
2892− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
2893− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
2894− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
2895− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
2896− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
2897− routingAllocationEnable = pure . RoutingAllocationEnable
2898− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
2899− recoveryInitialShards = pure . RecoveryInitialShards
2900− gcDeletes = pure . GCDeletes . ndtJSON
2901− ttlDisablePurge = pure . TTLDisablePurge
2902− translogFSType = pure . TranslogFSType
2903− compoundFormat = pure . IndexCompoundFormat
2904− compoundOnFlush = pure . IndexCompoundOnFlush
2905− warmerEnabled = pure . WarmerEnabled
2906− blocksReadOnly = pure . BlocksReadOnly
2907− blocksRead = pure . BlocksRead
2908− blocksWrite = pure . BlocksWrite
2909− blocksMetaData = pure . BlocksMetaData
2910−
2911−instance FromJSON IndexSettingsSummary where
2912− parseJSON = withObject "IndexSettingsSummary" parse
2913− where parse o = case HM.toList o of
2914− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
2915− <$> parseJSON v
2916− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
2917− _ -> fail "Expected single-key object with index name"
2918− redundant (NumberOfReplicas _) = True
2919− redundant _ = False
2920−
2921−-- | For some reason in the settings API, all leaf values get returned
2922−-- as strings. This function attepmts to recover from this for all
2923−-- non-recursive JSON types. If nothing can be done or the same value
2924−-- would be return, it returns 'mzero'
2925−unStringlyTypeJSON :: MonadPlus m => Value -> m Value
2926−unStringlyTypeJSON (String "true") = return (Bool True)
2927−unStringlyTypeJSON (String "false") = return (Bool False)
2928−unStringlyTypeJSON (String "null") = return Null
2929−unStringlyTypeJSON (String t) = case readMay (T.unpack t) of
2930− Just n -> return (Number n)
2931− Nothing -> mzero
2932−unStringlyTypeJSON _ = mzero
2933−
2934−
2935−parseSettings :: Object -> Parser [UpdatableIndexSetting]
2936−parseSettings o = do
2937− o' <- o .: "index"
2938− -- slice the index object into singleton hashmaps and try to parse each
2939− parses <- forM (HM.toList o') $ \(k, v) -> do
2940− -- blocks are now nested into the "index" key, which is not how they're serialized
2941− let atRoot = Object (HM.singleton k v)
2942− let atIndex = Object (HM.singleton "index" atRoot)
2943− optional (parseJSON atRoot <|> parseJSON atIndex)
2944− return (catMaybes parses)
2945−
2946−oPath :: ToJSON a => NonEmpty Text -> a -> Value
2947−oPath (k :| []) v = object [k .= v]
2948−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
2949−
2950−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
2951−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
2952− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
2953−
2954−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
2955−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
2956− where parse o = case HM.toList o of
2957− [] -> fail "Expected non-empty list of NodeAttrFilters"
2958− x:xs -> DT.mapM (uncurry parse') (x :| xs)
2959− parse' n = withText "Text" $ \t ->
2960− case T.splitOn "," t of
2961− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
2962− [] -> fail "Expected non-empty list of filter values"
2963−
2964−instance ToJSON ReplicaBounds where
2965− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
2966− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
2967− toJSON ReplicasUnbounded = Bool False
2968−
2969−instance FromJSON ReplicaBounds where
2970− parseJSON v = withText "ReplicaBounds" parseText v
2971− <|> withBool "ReplicaBounds" parseBool v
2972− where parseText t = case T.splitOn "-" t of
2973− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
2974− [a, b] -> ReplicasBounded <$> parseReadText a
2975− <*> parseReadText b
2976− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
2977− parseBool False = pure ReplicasUnbounded
2978− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
2979−
2980−instance ToJSON AllocationPolicy where
2981− toJSON AllocAll = String "all"
2982− toJSON AllocPrimaries = String "primaries"
2983− toJSON AllocNewPrimaries = String "new_primaries"
2984− toJSON AllocNone = String "none"
2985−
2986−instance FromJSON AllocationPolicy where
2987− parseJSON = withText "AllocationPolicy" parse
2988− where parse "all" = pure AllocAll
2989− parse "primaries" = pure AllocPrimaries
2990− parse "new_primaries" = pure AllocNewPrimaries
2991− parse "none" = pure AllocNone
2992− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
2993−
2994−instance ToJSON InitialShardCount where
2995− toJSON QuorumShards = String "quorum"
2996− toJSON QuorumMinus1Shards = String "quorum-1"
2997− toJSON FullShards = String "full"
2998− toJSON FullMinus1Shards = String "full-1"
2999− toJSON (ExplicitShards x) = toJSON x
3000−
3001−instance FromJSON InitialShardCount where
3002− parseJSON v = withText "InitialShardCount" parseText v
3003− <|> ExplicitShards <$> parseJSON v
3004− where parseText "quorum" = pure QuorumShards
3005− parseText "quorum-1" = pure QuorumMinus1Shards
3006− parseText "full" = pure FullShards
3007− parseText "full-1" = pure FullMinus1Shards
3008− parseText _ = mzero
3009−
3010−instance ToJSON FSType where
3011− toJSON FSSimple = "simple"
3012− toJSON FSBuffered = "buffered"
3013−
3014−instance FromJSON FSType where
3015− parseJSON = withText "FSType" parse
3016− where parse "simple" = pure FSSimple
3017− parse "buffered" = pure FSBuffered
3018− parse t = fail ("Invalid FSType: " <> show t)
3019−
3020−instance ToJSON CompoundFormat where
3021− toJSON (CompoundFileFormat x) = Bool x
3022− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3023−
3024−instance FromJSON CompoundFormat where
3025− parseJSON v = CompoundFileFormat <$> parseJSON v
3026− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3027−
3028−instance ToJSON NominalDiffTimeJSON where
3029− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3030−
3031−instance FromJSON NominalDiffTimeJSON where
3032− parseJSON = withText "NominalDiffTime" parse
3033− where parse t = case T.takeEnd 1 t of
3034− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3035− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3036−
3037−instance ToJSON IndexTemplate where
3038− toJSON (IndexTemplate p s m) = merge
3039− (object [ "template" .= p
3040− , "mappings" .= foldl' merge (object []) m
3041− ])
3042− (toJSON s)
3043− where
3044− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3045− merge o Null = o
3046− merge _ _ = undefined
3047−
3048−instance (FromJSON a) => FromJSON (EsResult a) where
3049− parseJSON jsonVal@(Object v) = do
3050− found <- v .:? "found" .!= False
3051− fr <- if found
3052− then parseJSON jsonVal
3053− else return Nothing
3054− EsResult <$> v .: "_index" <*>
3055− v .: "_type" <*>
3056− v .: "_id" <*>
3057− pure fr
3058− parseJSON _ = empty
3059−
3060−instance (FromJSON a) => FromJSON (EsResultFound a) where
3061− parseJSON (Object v) = EsResultFound <$>
3062− v .: "_version" <*>
3063− v .: "_source"
3064− parseJSON _ = empty
3065−
3066−instance FromJSON EsError where
3067− parseJSON (Object v) = EsError <$>
3068− v .: "status" <*>
3069− v .: "error"
3070− parseJSON _ = empty
3071−
3072−instance FromJSON IndexAliasesSummary where
3073− parseJSON = withObject "IndexAliasesSummary" parse
3074− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3075− go ixn = withObject "index aliases" $ \ia -> do
3076− aliases <- ia .:? "aliases" .!= mempty
3077− forM (HM.toList aliases) $ \(aName, v) -> do
3078− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3079− IndexAliasSummary indexAlias <$> parseJSON v
3080−
3081−
3082−instance ToJSON IndexAliasAction where
3083− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3084− where Object iaObj = toJSON ia
3085− Object optsObj = toJSON opts
3086− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3087− where Object iaObj = toJSON ia
3088−
3089−instance ToJSON IndexAlias where
3090− toJSON IndexAlias {..} = object ["index" .= srcIndex
3091− , "alias" .= indexAlias
3092− ]
3093−
3094−instance ToJSON IndexAliasCreate where
3095− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3096− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3097− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3098−
3099−instance ToJSON AliasRouting where
3100− toJSON (AllAliasRouting v) = object ["routing" .= v]
3101− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3102− where prs = [("search_routing" .=) <$> srch
3103− ,("index_routing" .=) <$> idx]
3104−
3105−instance FromJSON AliasRouting where
3106− parseJSON = withObject "AliasRouting" parse
3107− where parse o = parseAll o <|> parseGranular o
3108− parseAll o = AllAliasRouting <$> o .: "routing"
3109− parseGranular o = do
3110− sr <- o .:? "search_routing"
3111− ir <- o .:? "index_routing"
3112− if isNothing sr && isNothing ir
3113− then fail "Both search_routing and index_routing can't be blank"
3114− else return (GranularAliasRouting sr ir)
3115−
3116−instance FromJSON IndexAliasCreate where
3117− parseJSON v = withObject "IndexAliasCreate" parse v
3118− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3119− <*> o .:? "filter"
3120−
3121−instance ToJSON SearchAliasRouting where
3122− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3123−
3124−instance FromJSON SearchAliasRouting where
3125− parseJSON = withText "SearchAliasRouting" parse
3126− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3127−
3128−instance ToJSON Search where
3129− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3130− omitNulls [ "query" .= query
3131− , "filter" .= sFilter
3132− , "sort" .= sort
3133− , "aggregations" .= searchAggs
3134− , "highlight" .= highlight
3135− , "from" .= sFrom
3136− , "size" .= sSize
3137− , "track_scores" .= sTrackSortScores
3138− , "fields" .= sFields
3139− , "_source" .= sSource]
3140−
3141−
3142−instance ToJSON Source where
3143− toJSON NoSource = toJSON False
3144− toJSON (SourcePatterns patterns) = toJSON patterns
3145− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3146−
3147−instance ToJSON PatternOrPatterns where
3148− toJSON (PopPattern pattern) = toJSON pattern
3149− toJSON (PopPatterns patterns) = toJSON patterns
3150−
3151−instance ToJSON Include where
3152− toJSON (Include patterns) = toJSON patterns
3153−
3154−instance ToJSON Exclude where
3155− toJSON (Exclude patterns) = toJSON patterns
3156−
3157−instance ToJSON Pattern where
3158− toJSON (Pattern pattern) = toJSON pattern
3159−
3160−
3161−instance ToJSON FieldHighlight where
3162− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3163− object [ fName .= fSettings ]
3164− toJSON (FieldHighlight (FieldName fName) Nothing) =
3165− object [ fName .= emptyObject ]
3166−
3167−instance ToJSON Highlights where
3168− toJSON (Highlights global fields) =
3169− omitNulls (("fields" .= fields)
3170− : highlightSettingsPairs global)
3171−
3172−instance ToJSON HighlightSettings where
3173− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3174−
3175−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3176−highlightSettingsPairs Nothing = []
3177−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3178−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3179−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3180−
3181−
3182−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3183−plainHighPairs Nothing = []
3184−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3185− [ "type" .= String "plain"]
3186− ++ commonHighlightPairs plCom
3187− ++ nonPostingsToPairs plNonPost
3188−
3189−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3190−postHighPairs Nothing = []
3191−postHighPairs (Just (PostingsHighlight pCom)) =
3192− ("type" .= String "postings")
3193− : commonHighlightPairs pCom
3194−
3195−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3196−fastVectorHighPairs Nothing = []
3197−fastVectorHighPairs (Just
3198− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3199− fvBoundMaxScan fvFragOff fvMatchedFields
3200− fvPhraseLim)) =
3201− [ "type" .= String "fvh"
3202− , "boundary_chars" .= fvBoundChars
3203− , "boundary_max_scan" .= fvBoundMaxScan
3204− , "fragment_offset" .= fvFragOff
3205− , "matched_fields" .= fvMatchedFields
3206− , "phraseLimit" .= fvPhraseLim]
3207− ++ commonHighlightPairs fvCom
3208− ++ nonPostingsToPairs fvNonPostSettings
3209−
3210−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3211−deleteSeveral ks hm = foldr HM.delete hm ks
3212−
3213−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3214−commonHighlightPairs Nothing = []
3215−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3216− chNoMatchSize chHighlightQuery
3217− chRequireFieldMatch)) =
3218− [ "order" .= chScore
3219− , "force_source" .= chForceSource
3220− , "encoder" .= chEncoder
3221− , "no_match_size" .= chNoMatchSize
3222− , "highlight_query" .= chHighlightQuery
3223− , "require_fieldMatch" .= chRequireFieldMatch]
3224− ++ highlightTagToPairs chTag
3225−
3226−
3227−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3228−nonPostingsToPairs Nothing = []
3229−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3230− [ "fragment_size" .= npFragSize
3231− , "number_of_fragments" .= npNumOfFrags]
3232−
3233−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3234−parseNEJSON [] = fail "Expected non-empty list"
3235−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3236−
3237−
3238−instance ToJSON HighlightEncoder where
3239− toJSON DefaultEncoder = String "default"
3240− toJSON HTMLEncoder = String "html"
3241−
3242−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3243−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3244−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3245− , "post_tags" .= post]
3246−highlightTagToPairs Nothing = []
3247−
3248−instance ToJSON SortSpec where
3249− toJSON (DefaultSortSpec
3250− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3251− dsSortMode dsMissingSort dsNestedFilter)) =
3252− object [dsSortFieldName .= omitNulls base] where
3253− base = [ "order" .= dsSortOrder
3254− , "ignore_unmapped" .= dsIgnoreUnmapped
3255− , "mode" .= dsSortMode
3256− , "missing" .= dsMissingSort
3257− , "nested_filter" .= dsNestedFilter ]
3258−
3259− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3260− object [ "unit" .= units
3261− , field .= gdsLatLon
3262− , "order" .= gdsSortOrder ]
3263−
3264−
3265−instance ToJSON SortOrder where
3266− toJSON Ascending = String "asc"
3267− toJSON Descending = String "desc"
3268−
3269−
3270−instance ToJSON SortMode where
3271− toJSON SortMin = String "min"
3272− toJSON SortMax = String "max"
3273− toJSON SortSum = String "sum"
3274− toJSON SortAvg = String "avg"
3275−
3276−
3277−instance ToJSON Missing where
3278− toJSON LastMissing = String "_last"
3279− toJSON FirstMissing = String "_first"
3280− toJSON (CustomMissing txt) = String txt
3281−
3282−
3283−instance ToJSON ScoreType where
3284− toJSON ScoreTypeMax = "max"
3285− toJSON ScoreTypeAvg = "avg"
3286− toJSON ScoreTypeSum = "sum"
3287− toJSON ScoreTypeNone = "none"
3288−
3289−instance FromJSON ScoreType where
3290− parseJSON = withText "ScoreType" parse
3291− where parse "max" = pure ScoreTypeMax
3292− parse "avg" = pure ScoreTypeAvg
3293− parse "sum" = pure ScoreTypeSum
3294− parse "none" = pure ScoreTypeNone
3295− parse t = fail ("Unexpected ScoreType: " <> show t)
3296−
3297−instance ToJSON Distance where
3298− toJSON (Distance dCoefficient dUnit) =
3299− String boltedTogether where
3300− coefText = showText dCoefficient
3301− (String unitText) = toJSON dUnit
3302− boltedTogether = mappend coefText unitText
3303−
3304−instance FromJSON Distance where
3305− parseJSON = withText "Distance" parse
3306− where parse t = Distance <$> parseCoeff nT
3307− <*> parseJSON (String unitT)
3308− where (nT, unitT) = T.span validForNumber t
3309− -- may be a better way to do this
3310− validForNumber '-' = True
3311− validForNumber '.' = True
3312− validForNumber 'e' = True
3313− validForNumber c = isNumber c
3314− parseCoeff "" = fail "Empty string cannot be parsed as number"
3315− parseCoeff s = return (read (T.unpack s))
3316−
3317−instance ToJSON DistanceUnit where
3318− toJSON Miles = String "mi"
3319− toJSON Yards = String "yd"
3320− toJSON Feet = String "ft"
3321− toJSON Inches = String "in"
3322− toJSON Kilometers = String "km"
3323− toJSON Meters = String "m"
3324− toJSON Centimeters = String "cm"
3325− toJSON Millimeters = String "mm"
3326− toJSON NauticalMiles = String "nmi"
3327−
3328−
3329−instance FromJSON DistanceUnit where
3330− parseJSON = withText "DistanceUnit" parse
3331− where parse "mi" = pure Miles
3332− parse "yd" = pure Yards
3333− parse "ft" = pure Feet
3334− parse "in" = pure Inches
3335− parse "km" = pure Kilometers
3336− parse "m" = pure Meters
3337− parse "cm" = pure Centimeters
3338− parse "mm" = pure Millimeters
3339− parse "nmi" = pure NauticalMiles
3340− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3341−
3342−instance ToJSON DistanceType where
3343− toJSON Arc = String "arc"
3344− toJSON SloppyArc = String "sloppy_arc"
3345− toJSON Plane = String "plane"
3346−
3347−instance FromJSON DistanceType where
3348− parseJSON = withText "DistanceType" parse
3349− where parse "arc" = pure Arc
3350− parse "sloppy_arc" = pure SloppyArc
3351− parse "plane" = pure Plane
3352− parse t = fail ("Unrecognized DistanceType: " <> show t)
3353−
3354−
3355−instance ToJSON OptimizeBbox where
3356− toJSON NoOptimizeBbox = String "none"
3357− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3358−
3359−instance FromJSON OptimizeBbox where
3360− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3361− <|> parseOptimize v
3362− where parseNoOptimize "none" = pure NoOptimizeBbox
3363− parseNoOptimize _ = mzero
3364− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3365−
3366−instance ToJSON GeoBoundingBoxConstraint where
3367− toJSON (GeoBoundingBoxConstraint
3368− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3369− object [gbbcGeoBBField .= gbbcConstraintBox
3370− , "_cache" .= cache
3371− , "type" .= type']
3372−
3373−instance FromJSON GeoBoundingBoxConstraint where
3374− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3375− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3376− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3377− <$> parseJSON v
3378− <*> o .:? "_cache" .!= defaultCache
3379− <*> o .: "type"
3380− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3381−
3382−instance ToJSON GeoFilterType where
3383− toJSON GeoFilterMemory = String "memory"
3384− toJSON GeoFilterIndexed = String "indexed"
3385−
3386−instance FromJSON GeoFilterType where
3387− parseJSON = withText "GeoFilterType" parse
3388− where parse "memory" = pure GeoFilterMemory
3389− parse "indexed" = pure GeoFilterIndexed
3390− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3391−
3392−instance ToJSON GeoBoundingBox where
3393− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3394− object ["top_left" .= gbbTopLeft
3395− , "bottom_right" .= gbbBottomRight]
3396−
3397−instance FromJSON GeoBoundingBox where
3398− parseJSON = withObject "GeoBoundingBox" parse
3399− where parse o = GeoBoundingBox
3400− <$> o .: "top_left"
3401− <*> o .: "bottom_right"
3402−
3403−instance ToJSON LatLon where
3404− toJSON (LatLon lLat lLon) =
3405− object ["lat" .= lLat
3406− , "lon" .= lLon]
3407−
3408−instance FromJSON LatLon where
3409− parseJSON = withObject "LatLon" parse
3410− where parse o = LatLon <$> o .: "lat"
3411− <*> o .: "lon"
3412−
3413−-- index for smaller ranges, fielddata for longer ranges
3414−instance ToJSON RangeExecution where
3415− toJSON RangeExecutionIndex = "index"
3416− toJSON RangeExecutionFielddata = "fielddata"
3417−
3418−
3419−instance FromJSON RangeExecution where
3420− parseJSON = withText "RangeExecution" parse
3421− where parse "index" = pure RangeExecutionIndex
3422− parse "fielddata" = pure RangeExecutionFielddata
3423− parse t = error ("Unrecognized RangeExecution " <> show t)
3424−
3425−instance ToJSON RegexpFlags where
3426− toJSON AllRegexpFlags = String "ALL"
3427− toJSON NoRegexpFlags = String "NONE"
3428− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3429− where flagStrs = map flagStr . nub $ h:fs
3430− flagStr AnyString = "ANYSTRING"
3431− flagStr Automaton = "AUTOMATON"
3432− flagStr Complement = "COMPLEMENT"
3433− flagStr Empty = "EMPTY"
3434− flagStr Intersection = "INTERSECTION"
3435− flagStr Interval = "INTERVAL"
3436−
3437−instance FromJSON RegexpFlags where
3438− parseJSON = withText "RegexpFlags" parse
3439− where parse "ALL" = pure AllRegexpFlags
3440− parse "NONE" = pure NoRegexpFlags
3441− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3442−
3443−instance FromJSON RegexpFlag where
3444− parseJSON = withText "RegexpFlag" parse
3445− where parse "ANYSTRING" = pure AnyString
3446− parse "AUTOMATON" = pure Automaton
3447− parse "COMPLEMENT" = pure Complement
3448− parse "EMPTY" = pure Empty
3449− parse "INTERSECTION" = pure Intersection
3450− parse "INTERVAL" = pure Interval
3451− parse f = fail ("Unknown RegexpFlag: " <> show f)
3452−
3453−instance ToJSON Term where
3454− toJSON (Term field value) = object ["term" .= object
3455− [field .= value]]
3456−
3457−instance FromJSON Term where
3458− parseJSON = withObject "Term" parse
3459− where parse o = do termObj <- o .: "term"
3460− case HM.toList termObj of
3461− [(fn, v)] -> Term fn <$> parseJSON v
3462− _ -> fail "Expected object with 1 field-named key"
3463−
3464−instance ToJSON BoolMatch where
3465− toJSON (MustMatch term cache) = object ["must" .= term,
3466− "_cache" .= cache]
3467− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3468− "_cache" .= cache]
3469− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3470− "_cache" .= cache]
3471−
3472−instance FromJSON BoolMatch where
3473− parseJSON = withObject "BoolMatch" parse
3474− where parse o = mustMatch `taggedWith` "must"
3475− <|> mustNotMatch `taggedWith` "must_not"
3476− <|> shouldMatch `taggedWith` "should"
3477− where taggedWith parser k = parser =<< o .: k
3478− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3479− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3480− 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)
3481528
3482529instance (FromJSON a) => FromJSON (SearchResult a) where
3483530 parseJSON (Object v) = SearchResult <$>
@@ -3486,71 +533,10 @@ instance (FromJSON a) => FromJSON (SearchResult a) where
3486533 v .: "_shards" <*>
3487534 v .: "hits" <*>
3488535 v .:? "aggregations" <*>
3489− v .:? "_scroll_id"
3490− parseJSON _ = empty
3491−
3492−instance (FromJSON a) => FromJSON (SearchHits a) where
3493− parseJSON (Object v) = SearchHits <$>
3494− v .: "total" <*>
3495− v .: "max_score" <*>
3496− v .: "hits"
3497− parseJSON _ = empty
3498−
3499−instance (FromJSON a) => FromJSON (Hit a) where
3500− parseJSON (Object v) = Hit <$>
3501− v .: "_index" <*>
3502− v .: "_type" <*>
3503− v .: "_id" <*>
3504− v .: "_score" <*>
3505− v .:? "_source" <*>
3506− v .:? "highlight"
536+ v .:? "_scroll_id" <*>
537+ v .:? "suggest"
3507538 parseJSON _ = empty
3508539
3509−instance FromJSON ShardResult where
3510− parseJSON (Object v) = ShardResult <$>
3511− v .: "total" <*>
3512− v .: "successful" <*>
3513− v .: "failed"
3514− parseJSON _ = empty
3515−
3516−
3517−instance FromJSON DocVersion where
3518− parseJSON v = do
3519− i <- parseJSON v
3520− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3521−
3522−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3523−instance FromJSON ReplicaCount where
3524− parseJSON v = parseAsInt v
3525− <|> parseAsString v
3526− where parseAsInt = fmap ReplicaCount . parseJSON
3527− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3528−
3529−instance FromJSON ShardCount where
3530− parseJSON v = parseAsInt v
3531− <|> parseAsString v
3532− where parseAsInt = fmap ShardCount . parseJSON
3533− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3534−
3535−instance Bounded DocVersion where
3536− minBound = DocVersion 1
3537− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3538−
3539−instance Enum DocVersion where
3540− succ x
3541− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3542− | otherwise = succError "DocVersion"
3543− pred x
3544− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3545− | otherwise = predError "DocVersion"
3546− toEnum i =
3547− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3548− fromEnum = docVersionNumber
3549− enumFrom = boundedEnumFrom
3550− enumFromThen = boundedEnumFromThen
3551−
3552−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3553−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Show, Eq)
3554−
3555−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3556−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Show, Eq)
540+newtype ScrollId =
541+ ScrollId Text
542+ deriving (Eq, Show, Ord, ToJSON, FromJSON)