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