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