@@ -1,10 +1,7 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
31{-# LANGUAGE FlexibleContexts #-}
42{-# LANGUAGE FlexibleInstances #-}
53{-# LANGUAGE GeneralizedNewtypeDeriving #-}
64{-# LANGUAGE MultiParamTypeClasses #-}
7−-- {-# LANGUAGE NoMonomorphismRestriction #-}
85{-# LANGUAGE NamedFieldPuns #-}
96{-# LANGUAGE OverloadedStrings #-}
107{-# LANGUAGE RecordWildCards #-}
@@ -13,11 +10,11 @@
1310-------------------------------------------------------------------------------
1411-- |
1512-- Module : Database.Bloodhound.Types
16−-- Copyright : (C) 2014, 2015, 2016 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
@@ -61,6 +62,7 @@ module Database.Bloodhound.Types
6162 , MonadBH(..)
6263 , Version(..)
6364 , VersionNumber(..)
65+ , MaybeNA(..)
6466 , BuildHash(..)
6567 , Status(..)
6668 , Existence(..)
@@ -69,6 +71,7 @@ module Database.Bloodhound.Types
6971 , UpdatableIndexSetting(..)
7072 , IndexSettingsSummary(..)
7173 , AllocationPolicy(..)
74+ , Compression(..)
7275 , ReplicaBounds(..)
7376 , Bytes(..)
7477 , gigabytes
@@ -117,8 +120,8 @@ module Database.Bloodhound.Types
117120 , Pattern(..)
118121 , ShardResult(..)
119122 , Hit(..)
123+ , HitFields(..)
120124 , Filter(..)
121− , Seminearring(..)
122125 , BoolMatch(..)
123126 , Term(..)
124127 , GeoPoint(..)
@@ -145,13 +148,22 @@ module Database.Bloodhound.Types
145148 , RegexpFlags(..)
146149 , RegexpFlag(..)
147150 , FieldName(..)
151+ , ScriptFields(..)
152+ , ScriptFieldName
153+ , ScriptFieldValue
148154 , Script(..)
155+ , ScriptLanguage(..)
156+ , ScriptInline(..)
157+ , ScriptId(..)
158+ , ScriptParams(..)
159+ , ScriptParamName
160+ , ScriptParamValue
149161 , IndexName(..)
150162 , IndexSelection(..)
151163 , NodeSelection(..)
152164 , NodeSelector(..)
153− , IndexOptimizationSettings(..)
154− , defaultIndexOptimizationSettings
165+ , ForceMergeIndexSettings(..)
166+ , defaultForceMergeIndexSettings
155167 , TemplateName(..)
156168 , TemplatePattern(..)
157169 , MappingName(..)
@@ -175,8 +187,19 @@ module Database.Bloodhound.Types
175187 , BoolQuery(..)
176188 , BoostingQuery(..)
177189 , 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(..)
178202 , DisMaxQuery(..)
179− , FilteredQuery(..)
180203 , FuzzyLikeThisQuery(..)
181204 , FuzzyLikeFieldQuery(..)
182205 , FuzzyQuery(..)
@@ -192,10 +215,16 @@ module Database.Bloodhound.Types
192215 , RangeQuery(..)
193216 , RegexpQuery(..)
194217 , QueryString(..)
218+ , TemplateQueryInline(..)
219+ , TemplateQueryKeyValuePairs(..)
220+ , WildcardQuery(..)
195221 , BooleanOperator(..)
196222 , ZeroTermsQuery(..)
197223 , CutoffFrequency(..)
198224 , Analyzer(..)
225+ , Tokenizer(..)
226+ , TokenFilter(..)
227+ , CharFilter(..)
199228 , MaxExpansions(..)
200229 , Lenient(..)
201230 , MatchQueryType(..)
@@ -258,6 +287,26 @@ module Database.Bloodhound.Types
258287 , NodeName(..)
259288 , ClusterName(..)
260289 , 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(..)
261310 , EsAddress(..)
262311 , PluginName(..)
263312 , NodeInfo(..)
@@ -299,6 +348,18 @@ module Database.Bloodhound.Types
299348 , rrGroupRefNum
300349 , mkRRGroupRefNum
301350 , 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 (..)
302363
303364 , Aggregation(..)
304365 , Aggregations
@@ -310,6 +371,8 @@ module Database.Bloodhound.Types
310371 , MissingAggregation(..)
311372 , ValueCountAggregation(..)
312373 , FilterAggregation(..)
374+ , CardinalityAggregation(..)
375+ , MaxAggregation(..)
313376 , DateHistogramAggregation(..)
314377 , DateRangeAggregation(..)
315378 , DateRangeAggRange(..)
@@ -317,6 +380,9 @@ module Database.Bloodhound.Types
317380 , DateMathAnchor(..)
318381 , DateMathModifier(..)
319382 , DateMathUnit(..)
383+ , TopHitsAggregation(..)
384+ , StatisticsAggregation(..)
385+ , SearchAfterKey
320386
321387 , Highlights(..)
322388 , FieldHighlight(..)
@@ -334,724 +400,32 @@ module Database.Bloodhound.Types
334400 , TermsResult(..)
335401 , DateHistogramResult(..)
336402 , DateRangeResult(..)
403+ , TopHitResult(..)
337404
338405 , EsUsername(..)
339406 , EsPassword(..)
340− ) where
341407
342−import Control.Applicative as A
343−import Control.Arrow (first)
344−import Control.Monad.Catch
345−import Control.Monad.Except
346−import Control.Monad.Reader
347−import Control.Monad.State
348−import Control.Monad.Writer
349−import Data.Aeson
350−import Data.Aeson.Types (Pair, Parser, emptyObject,
351− parseEither, parseMaybe)
352−import qualified Data.ByteString.Lazy.Char8 as L
353−import Data.Char
354−import Data.Hashable (Hashable)
355−import qualified Data.HashMap.Strict as HM
356−import Data.List (foldl', intercalate, nub)
357−import Data.List.NonEmpty (NonEmpty (..), toList)
358−import qualified Data.Map.Strict as M
359−import Data.Maybe
360−import Data.Scientific (Scientific)
361−import Data.Text (Text)
362−import qualified Data.Text as T
363−import Data.Time.Calendar
364−import Data.Time.Clock (NominalDiffTime, UTCTime)
365−import Data.Time.Clock.POSIX
366−import qualified Data.Traversable as DT
367−import Data.Typeable (Typeable)
368−import qualified Data.Vector as V
369−import qualified Data.Version as Vers
370−import GHC.Enum
371−import GHC.Generics (Generic)
372−import Network.HTTP.Client
373−import qualified Network.HTTP.Types.Method as NHTM
374−import qualified Text.ParserCombinators.ReadP as RP
375−import qualified Text.Read as TR
376−
377−import Database.Bloodhound.Types.Class
378−import Database.Bloodhound.Types.Internal
379−
380−-- $setup
381−-- >>> :set -XOverloadedStrings
382−-- >>> import Data.Aeson
383−-- >>> import Database.Bloodhound
384−-- >>> let testServer = (Server "http://localhost:9200")
385−-- >>> let testIndex = IndexName "twitter"
386−-- >>> let testMapping = MappingName "tweet"
387−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
388−
389−-- defaultIndexSettings is exported by Database.Bloodhound as well
390−-- no trailing slashes in servers, library handles building the path.
391−
392−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
393−-- will be a noop. You can use the exported fields to customize it further, e.g.:
394−--
395−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
396−mkBHEnv :: Server -> Manager -> BHEnv
397−mkBHEnv s m = BHEnv s m return
398−
399−newtype BH m a = BH {
400− unBH :: ReaderT BHEnv m a
401− } deriving ( Functor
402− , A.Applicative
403− , Monad
404− , MonadIO
405− , MonadState s
406− , MonadWriter w
407− , MonadError e
408− , Alternative
409− , MonadPlus
410− , MonadFix
411− , MonadThrow
412− , MonadCatch
413− , MonadMask)
414−
415−instance MonadTrans BH where
416− lift = BH . lift
417−
418−instance (MonadReader r m) => MonadReader r (BH m) where
419− ask = lift ask
420− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
421− local f (m r)
422−
423−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
424− getBHEnv = BH getBHEnv
425−
426−runBH :: BHEnv -> BH m a -> m a
427−runBH e f = runReaderT (unBH f) e
428−
429−{-| 'Version' is embedded in 'Status' -}
430−data Version = Version { number :: VersionNumber
431− , build_hash :: BuildHash
432− , build_timestamp :: UTCTime
433− , build_snapshot :: Bool
434− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
435−
436−-- | Traditional software versioning number
437−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
438− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
439−
440−{-| 'Status' is a data type for describing the JSON body returned by
441− Elasticsearch when you query its status. This was deprecated in 1.2.0.
442−
443− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
444−-}
445−
446−data Status = Status { ok :: Maybe Bool
447− , status :: Int
448− , name :: Text
449− , version :: Version
450− , tagline :: Text } deriving (Eq, Read, Show, Generic)
451−
452−{-| 'IndexSettings' is used to configure the shards and replicas when you create
453− an Elasticsearch Index.
454−
455− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
456−-}
457−
458−data IndexSettings =
459− IndexSettings { indexShards :: ShardCount
460− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
461−
462−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
463−defaultIndexSettings :: IndexSettings
464−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
465−
466−
467−{-| 'IndexOptimizationSettings' is used to configure index optimization. See
468− <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>
469− for more info.
470−-}
471−data IndexOptimizationSettings =
472− IndexOptimizationSettings { maxNumSegments :: Maybe Int
473− -- ^ 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.
474− , onlyExpungeDeletes :: Bool
475− -- ^ 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.
476− , flushAfterOptimize :: Bool
477− -- ^ Should a flush be performed after the optimize.
478− } deriving (Eq, Show, Generic, Typeable)
479−
480−
481−{-| 'defaultIndexOptimizationSettings' implements the default settings that
482− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
483− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
484−-}
485−defaultIndexOptimizationSettings :: IndexOptimizationSettings
486−defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True
487−
488−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
489−
490− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
491−-}
492−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
493− -- ^ The number of replicas each shard has.
494− | AutoExpandReplicas ReplicaBounds
495− | BlocksReadOnly Bool
496− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
497− | BlocksRead Bool
498− -- ^ Set to True to disable read operations against the index.
499− | BlocksWrite Bool
500− -- ^ Set to True to disable write operations against the index.
501− | BlocksMetaData Bool
502− -- ^ Set to True to disable metadata operations against the index.
503− | RefreshInterval NominalDiffTime
504− -- ^ The async refresh interval of a shard
505− | IndexConcurrency Int
506− | FailOnMergeFailure Bool
507− | TranslogFlushThresholdOps Int
508− -- ^ When to flush on operations.
509− | TranslogFlushThresholdSize Bytes
510− -- ^ When to flush based on translog (bytes) size.
511− | TranslogFlushThresholdPeriod NominalDiffTime
512− -- ^ When to flush based on a period of not flushing.
513− | TranslogDisableFlush Bool
514− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
515− | CacheFilterMaxSize (Maybe Bytes)
516− -- ^ The maximum size of filter cache (per segment in shard).
517− | CacheFilterExpire (Maybe NominalDiffTime)
518− -- ^ The expire after access time for filter cache.
519− | GatewaySnapshotInterval NominalDiffTime
520− -- ^ The gateway snapshot interval (only applies to shared gateways).
521− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
522− -- ^ A node matching any rule will be allowed to host shards from the index.
523− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
524− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
525− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
526− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
527− | RoutingAllocationEnable AllocationPolicy
528− -- ^ Enables shard allocation for a specific index.
529− | RoutingAllocationShardsPerNode ShardCount
530− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
531− | RecoveryInitialShards InitialShardCount
532− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
533− | GCDeletes NominalDiffTime
534− | TTLDisablePurge Bool
535− -- ^ Disables temporarily the purge of expired docs.
536− | TranslogFSType FSType
537− | IndexCompoundFormat CompoundFormat
538− | IndexCompoundOnFlush Bool
539− | WarmerEnabled Bool
540− deriving (Eq, Show, Generic, Typeable)
541−
542−data AllocationPolicy = AllocAll
543− -- ^ Allows shard allocation for all shards.
544− | AllocPrimaries
545− -- ^ Allows shard allocation only for primary shards.
546− | AllocNewPrimaries
547− -- ^ Allows shard allocation only for primary shards for new indices.
548− | AllocNone
549− -- ^ No shard allocation is allowed
550− deriving (Eq, Read, Show, Generic, Typeable)
551−
552−data ReplicaBounds = ReplicasBounded Int Int
553− | ReplicasLowerBounded Int
554− | ReplicasUnbounded
555− deriving (Eq, Read, Show, Generic, Typeable)
556−
557−-- | A measure of bytes used for various configurations. You may want
558−-- to use smart constructors like 'gigabytes' for larger values.
559−--
560−-- >>> gigabytes 9
561−-- Bytes 9000000000
562−--
563−-- >>> megabytes 9
564−-- Bytes 9000000
565−--
566−-- >>> kilobytes 9
567−-- Bytes 9000
568−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
569−
570−gigabytes :: Int -> Bytes
571−gigabytes n = megabytes (1000 * n)
572−
573−
574−megabytes :: Int -> Bytes
575−megabytes n = kilobytes (1000 * n)
576−
577−
578−kilobytes :: Int -> Bytes
579−kilobytes n = Bytes (1000 * n)
580−
581−
582−data FSType = FSSimple
583− | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
584−
585−data InitialShardCount = QuorumShards
586− | QuorumMinus1Shards
587− | FullShards
588− | FullMinus1Shards
589− | ExplicitShards Int
590− deriving (Eq, Read, Show, Generic, Typeable)
591−
592−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
593− , nodeAttrFilterValues :: NonEmpty Text}
594− deriving (Eq, Read, Show, Generic, Ord)
595−
596−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
597−
598−data CompoundFormat = CompoundFileFormat Bool
599− | MergeSegmentVsTotalIndex Double
600− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
601− deriving (Eq, Read, Show, Generic, Typeable)
602−
603−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
604−
605−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
606− , sSummaryFixedSettings :: IndexSettings
607− , sSummaryUpdateable :: [UpdatableIndexSetting]}
608− deriving (Eq, Show, Generic, Typeable)
609−
610−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
611−type Reply = Network.HTTP.Client.Response L.ByteString
612−type Method = NHTM.Method
613−
614−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
615−
616− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
617−-}
618−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
619−
620−data FieldType = GeoPointType
621− | GeoShapeType
622− | FloatType
623− | IntegerType
624− | LongType
625− | ShortType
626− | ByteType deriving (Eq, Read, Show, Generic, Typeable)
627−
628−data FieldDefinition =
629− FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
630−
631−{-| An 'IndexTemplate' defines a template that will automatically be
632− applied to new indices created. The templates include both
633− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
634− controls if the template will be applied to the index created.
635− Specify mappings as follows: @[toJSON TweetMapping, ...]@
636−
637− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
638−-}
639−data IndexTemplate =
640− IndexTemplate { templatePattern :: TemplatePattern
641− , templateSettings :: Maybe IndexSettings
642− , templateMappings :: [Value]
643− }
644−
645−data MappingField =
646− MappingField { mappingFieldName :: FieldName
647− , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
648−
649−{-| Support for type reification of 'Mapping's is currently incomplete, for
650− now the mapping API verbiage expects a 'ToJSON'able blob.
651−
652− Indexes have mappings, mappings are schemas for the documents contained in the
653− index. I'd recommend having only one mapping per index, always having a mapping,
654− and keeping different kinds of documents separated if possible.
655−-}
656−data Mapping = Mapping { typeName :: TypeName
657− , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
658−
659−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
660− operation index, create, delete, and update. 'BulkIndex' behaves like an
661− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
662−
663− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
664−-}
665−data BulkOperation =
666− BulkIndex IndexName MappingName DocId Value
667− | BulkCreate IndexName MappingName DocId Value
668− | BulkDelete IndexName MappingName DocId
669− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
670−
671−{-| 'EsResult' describes the standard wrapper JSON document that you see in
672− successful Elasticsearch lookups or lookups that couldn't find the document.
673−-}
674−data EsResult a = EsResult { _index :: Text
675− , _type :: Text
676− , _id :: Text
677− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
678−
679−{-| 'EsResultFound' contains the document and its metadata inside of an
680− 'EsResult' when the document was successfully found.
681−-}
682−data EsResultFound a = EsResultFound { _version :: DocVersion
683− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
684−
685−{-| 'EsError' is the generic type that will be returned when there was a
686− problem. If you can't parse the expected response, its a good idea to
687− try parsing this.
688−-}
689−data EsError = EsError { errorStatus :: Int
690− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
691−
692−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
693−returned by the ElasticSearch server. If you encounter this error, please
694−verify that your domain data types and FromJSON instances are working properly
695−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
696−sure that your mappings are correct, then this error may be an indication of an
697−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
698−and be sure to include the exception body.
699−-}
700−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
701− deriving (Eq, Read, Show, Generic, Typeable)
702−
703−instance Exception EsProtocolException
704−
705−data IndexAlias = IndexAlias { srcIndex :: IndexName
706− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
707−
708−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
709−
710−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
711− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
712−
713−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
714− , aliasCreateFilter :: Maybe Filter}
715− deriving (Read, Show, Eq, Generic, Typeable)
716−
717−data AliasRouting = AllAliasRouting RoutingValue
718− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
719− deriving (Read, Show, Eq, Generic, Typeable)
720−
721−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
722−
723−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
724−
725−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
726−
727−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
728−
729−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
730−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
731− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
732−
733−{-| 'DocVersion' is an integer version number for a document between 1
734−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
735−-}
736−newtype DocVersion = DocVersion {
737− docVersionNumber :: Int
738− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
739−
740−-- | Smart constructor for in-range doc version
741−mkDocVersion :: Int -> Maybe DocVersion
742−mkDocVersion i
743− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
744− Just $ DocVersion i
745− | otherwise = Nothing
746−
747−
748−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
749−own version numbers instead of ones from ES.
750−-}
751−newtype ExternalDocVersion = ExternalDocVersion DocVersion
752− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
753−
754−{-| 'VersionControl' is specified when indexing documents as a
755−optimistic concurrency control.
756−-}
757−data VersionControl = NoVersionControl
758− -- ^ Don't send a version. This is a pure overwrite.
759− | InternalVersion DocVersion
760− -- ^ Use the default ES versioning scheme. Only
761− -- index the document if the version is the same
762− -- as the one specified. Only applicable to
763− -- updates, as you should be getting Version from
764− -- a search result.
765− | ExternalGT ExternalDocVersion
766− -- ^ Use your own version numbering. Only index
767− -- the document if the version is strictly higher
768− -- OR the document doesn't exist. The given
769− -- version will be used as the new version number
770− -- for the stored document. N.B. All updates must
771− -- increment this number, meaning there is some
772− -- global, external ordering of updates.
773− | ExternalGTE ExternalDocVersion
774− -- ^ Use your own version numbering. Only index
775− -- the document if the version is equal or higher
776− -- than the stored version. Will succeed if there
777− -- is no existing document. The given version will
778− -- be used as the new version number for the
779− -- stored document. Use with care, as this could
780− -- result in data loss.
781− | ForceVersion ExternalDocVersion
782− -- ^ The document will always be indexed and the
783− -- given version will be the new version. This is
784− -- typically used for correcting errors. Use with
785− -- care, as this could result in data loss.
786− deriving (Read, Show, Eq, Generic, Ord)
787−
788−{-| 'DocumentParent' is used to specify a parent document.
789−-}
790−newtype DocumentParent = DocumentParent DocId
791− deriving (Eq, Read, Show, Generic, Typeable)
792−
793−{-| 'IndexDocumentSettings' are special settings supplied when indexing
794−a document. For the best backwards compatiblity when new fields are
795−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
796−-}
797−data IndexDocumentSettings =
798− IndexDocumentSettings { idsVersionControl :: VersionControl
799− , idsParent :: Maybe DocumentParent
800− } deriving (Eq, Read, Show, Generic, Typeable)
801−
802−{-| Reasonable default settings. Chooses no version control and no parent.
803−-}
804−defaultIndexDocumentSettings :: IndexDocumentSettings
805−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
806−
807−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
808− dependent with later sorts acting as tie-breakers for earlier sorts.
809−-}
810−type Sort = [SortSpec]
811−
812−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
813− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
814− 'DistanceUnit' to express "nearness" to a single geographical point as a
815− sort specification.
816−
817−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
818−-}
819−data SortSpec = DefaultSortSpec DefaultSort
820− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
821−
822−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
823− 'mkSort' convenience function for when you want to specify only the most
824− common parameters.
825−
826−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
827−-}
828−data DefaultSort =
829− DefaultSort { sortFieldName :: FieldName
830− , sortOrder :: SortOrder
831− -- default False
832− , ignoreUnmapped :: Bool
833− , sortMode :: Maybe SortMode
834− , missingSort :: Maybe Missing
835− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
836−
837−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
838− encoded into "asc" or "desc" when turned into JSON.
839−
840−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
841−-}
842−data SortOrder = Ascending
843− | Descending deriving (Eq, Read, Show, Generic, Typeable)
844−
845−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
846− sorted last, first, or using a custom value as a substitute.
847−
848−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
849−-}
850−data Missing = LastMissing
851− | FirstMissing
852− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
853−
854−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
855−
856−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
857−-}
858−data SortMode = SortMin
859− | SortMax
860− | SortSum
861− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
862−
863−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
864− that you can concisely describe the usual kind of 'SortSpec's you want.
865−-}
866−mkSort :: FieldName -> SortOrder -> DefaultSort
867−mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
868−
869−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
870− 'Query's cannot be cached.
871−-}
872−type Cache = Bool -- caching on/off
873−defaultCache :: Cache
874−defaultCache = False
875−
876−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
877−-}
878−type PrefixValue = Text
879−
880−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
881− JSON encoding baked in. Used all over the place.
882−-}
883−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
884−
885−{-| 'ShardCount' is part of 'IndexSettings'
886−-}
887−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
888−
889−{-| 'ReplicaCount' is part of 'IndexSettings'
890−-}
891−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
892−
893−{-| 'IndexName' is used to describe which index to query/create/delete
894−-}
895−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
896−
897−{-| 'IndexSelection' is used for APIs which take a single index, a list of
898− indexes, or the special @_all@ index.
899−-}
900−--TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
901−data IndexSelection = IndexList (NonEmpty IndexName)
902− | AllIndexes deriving (Eq, Generic, Show, Typeable)
903−
904−{-| 'NodeSelection' is used for most cluster APIs. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/cluster.html#cluster-nodes here> for more details.
905−-}
906−data NodeSelection = LocalNode
907− -- ^ Whatever node receives this request
908− | NodeList (NonEmpty NodeSelector)
909− | AllNodes deriving (Eq, Generic, Show, Typeable)
910−
911−
912−-- | An exact match or pattern to identify a node. Note that All of
913−-- these options support wildcarding, so your node name, server, attr
914−-- name can all contain * characters to be a fuzzy match.
915−data NodeSelector = NodeByName NodeName
916− | NodeByFullNodeId FullNodeId
917− | NodeByHost Server
918− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
919− | NodeByAttribute NodeAttrName Text
920− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
921− deriving (Eq, Generic, Show, Typeable)
922−
923−{-| 'TemplateName' is used to describe which template to query/create/delete
924−-}
925−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
926−
927−{-| 'TemplatePattern' represents a pattern which is matched against index names
928−-}
929−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
930−
931−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
932− the data in the indices.
933−-}
934−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
935−
936−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
937− Can be set by the user or created by ES itself. Often used in client
938− functions for poking at specific documents.
939−-}
940−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
941−
942−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
943−-}
944−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
945−
946−{-| 'FieldName' is used all over the place wherever a specific field within
947− a document needs to be specified, usually in 'Query's or 'Filter's.
948−-}
949−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
950−
951−
952−{-| 'Script' is often used in place of 'FieldName' to specify more
953−complex ways of extracting a value from a document.
954−-}
955−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
956−
957−{-| 'CacheName' is used in 'RegexpFilter' for describing the
958− 'CacheKey' keyed caching behavior.
959−-}
960−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
961−
962−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
963−-}
964−newtype CacheKey =
965− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
966−newtype Existence =
967− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
968−newtype NullValue =
969− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
970−newtype CutoffFrequency =
971− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
972−newtype Analyzer =
973− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
974−newtype MaxExpansions =
975− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
976−
977−{-| 'Lenient', if set to true, will cause format based failures to be
978− ignored. I don't know what the bloody default is, Elasticsearch
979− documentation didn't say what it was. Let me know if you figure it out.
980−-}
981−newtype Lenient =
982− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
983−newtype Tiebreaker =
984− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
985−newtype Boost =
986− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
987−newtype BoostTerms =
988− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
989−
990−{-| 'MinimumMatch' controls how many should clauses in the bool query should
991− match. Can be an absolute value (2) or a percentage (30%) or a
992− combination of both.
993−-}
994−newtype MinimumMatch =
995− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
996−newtype DisableCoord =
997− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
998−newtype IgnoreTermFrequency =
999− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1000−newtype MinimumTermFrequency =
1001− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1002−newtype MaxQueryTerms =
1003− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1004−newtype Fuzziness =
1005− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1006−
1007−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1008−newtype PrefixLength =
1009− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1010−newtype TypeName =
1011− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1012−newtype PercentMatch =
1013− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1014−newtype StopWord =
1015− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1016−newtype QueryPath =
1017− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1018−
1019−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1020− heavy, because all terms in the index need to be examined, just in case
1021− they match. Leading wildcards can be disabled by setting
1022− 'AllowLeadingWildcard' to false. -}
1023−newtype AllowLeadingWildcard =
1024− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1025−newtype LowercaseExpanded =
1026− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1027−newtype EnablePositionIncrements =
1028− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1029−
1030−{-| By default, wildcard terms in a query are not analyzed.
1031− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1032−-}
1033−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1034−
1035−{-| 'GeneratePhraseQueries' defaults to false.
1036−-}
1037−newtype GeneratePhraseQueries =
1038− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1039−
1040−{-| 'Locale' is used for string conversions - defaults to ROOT.
1041−-}
1042−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1043−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1044−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1045−
1046−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1047− phrase matches. Default is 0.
1048−-}
1049−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1050−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1051−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1052−
1053−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1054−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
1055429
1056430{-| 'unpackId' is a silly convenience function that gets used once.
1057431-}
@@ -1059,8 +433,6 @@ unpackId :: DocId -> Text
1059433unpackId (DocId docId) = docId
1060434
1061435type TrackSortScores = Bool
1062−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1063−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)
1064436
1065437data Search = Search { queryBody :: Maybe Query
1066438 , filterBody :: Maybe Filter
@@ -1072,537 +444,74 @@ data Search = Search { queryBody :: Maybe Query
1072444 , from :: From
1073445 , size :: Size
1074446 , searchType :: SearchType
447+ , searchAfterKey :: Maybe SearchAfterKey
1075448 , fields :: Maybe [FieldName]
1076− , source :: Maybe Source } deriving (Eq, Read, 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] [] []
1077479
1078480data SearchType = SearchTypeQueryThenFetch
1079481 | SearchTypeDfsQueryThenFetch
1080− | SearchTypeCount
1081− | SearchTypeScan
1082− | SearchTypeQueryAndFetch
1083− | SearchTypeDfsQueryAndFetch
1084− deriving (Eq, Read, Show, Generic, Typeable)
482+ deriving (Eq, Show)
1085483
1086484data Source =
1087485 NoSource
1088486 | SourcePatterns PatternOrPatterns
1089487 | SourceIncludeExclude Include Exclude
1090− deriving (Read, Show, Eq, Generic, Typeable)
1091−
1092−data PatternOrPatterns = PopPattern Pattern
1093− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1094−
1095−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1096−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1097−
1098−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1099−
1100−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1101− , highlightFields :: [FieldHighlight]
1102− } deriving (Read, Show, Eq, Generic, Typeable)
1103−
1104−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1105− deriving (Read, Show, Eq, Generic, Typeable)
1106−
1107−
1108−data HighlightSettings = Plain PlainHighlight
1109− | Postings PostingsHighlight
1110− | FastVector FastVectorHighlight
1111− deriving (Read, Show, Eq, Generic, Typeable)
1112−data PlainHighlight =
1113− PlainHighlight { plainCommon :: Maybe CommonHighlight
1114− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1115−
1116− -- This requires that index_options are set to 'offset' in the mapping.
1117−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1118−
1119−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1120−data FastVectorHighlight =
1121− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1122− , fvNonPostSettings :: Maybe NonPostings
1123− , boundaryChars :: Maybe Text
1124− , boundaryMaxScan :: Maybe Int
1125− , fragmentOffset :: Maybe Int
1126− , matchedFields :: [Text]
1127− , phraseLimit :: Maybe Int
1128− } deriving (Read, Show, Eq, Generic, Typeable)
1129−
1130−data CommonHighlight =
1131− CommonHighlight { order :: Maybe Text
1132− , forceSource :: Maybe Bool
1133− , tag :: Maybe HighlightTag
1134− , encoder :: Maybe HighlightEncoder
1135− , noMatchSize :: Maybe Int
1136− , highlightQuery :: Maybe Query
1137− , requireFieldMatch :: Maybe Bool
1138− } deriving (Read, Show, Eq, Generic, Typeable)
1139−
1140−-- Settings that are only applicable to FastVector and Plain highlighters.
1141−data NonPostings =
1142− NonPostings { fragmentSize :: Maybe Int
1143− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1144−
1145−data HighlightEncoder = DefaultEncoder
1146− | HTMLEncoder
1147− deriving (Read, Show, Eq, Generic, Typeable)
1148−
1149−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1150−data HighlightTag = TagSchema Text
1151− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1152− deriving (Read, Show, Eq, Generic, Typeable)
1153−
1154−
1155−data Query =
1156− TermQuery Term (Maybe Boost)
1157− | TermsQuery Text (NonEmpty Text)
1158− | QueryMatchQuery MatchQuery
1159− | QueryMultiMatchQuery MultiMatchQuery
1160− | QueryBoolQuery BoolQuery
1161− | QueryBoostingQuery BoostingQuery
1162− | QueryCommonTermsQuery CommonTermsQuery
1163− | ConstantScoreFilter Filter Boost
1164− | ConstantScoreQuery Query Boost
1165− | QueryDisMaxQuery DisMaxQuery
1166− | QueryFilteredQuery FilteredQuery
1167− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1168− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1169− | QueryFuzzyQuery FuzzyQuery
1170− | QueryHasChildQuery HasChildQuery
1171− | QueryHasParentQuery HasParentQuery
1172− | IdsQuery MappingName [DocId]
1173− | QueryIndicesQuery IndicesQuery
1174− | MatchAllQuery (Maybe Boost)
1175− | QueryMoreLikeThisQuery MoreLikeThisQuery
1176− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1177− | QueryNestedQuery NestedQuery
1178− | QueryPrefixQuery PrefixQuery
1179− | QueryQueryStringQuery QueryStringQuery
1180− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1181− | QueryRangeQuery RangeQuery
1182− | QueryRegexpQuery RegexpQuery
1183− deriving (Eq, Read, Show, Generic, Typeable)
1184−
1185−data RegexpQuery =
1186− RegexpQuery { regexpQueryField :: FieldName
1187− , regexpQuery :: Regexp
1188− , regexpQueryFlags :: RegexpFlags
1189− , regexpQueryBoost :: Maybe Boost
1190− } deriving (Eq, Read, Show, Generic, Typeable)
1191−
1192−data RangeQuery =
1193− RangeQuery { rangeQueryField :: FieldName
1194− , rangeQueryRange :: RangeValue
1195− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1196−
1197−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1198−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1199−
1200−data SimpleQueryStringQuery =
1201− SimpleQueryStringQuery
1202− { simpleQueryStringQuery :: QueryString
1203− , simpleQueryStringField :: Maybe FieldOrFields
1204− , simpleQueryStringOperator :: Maybe BooleanOperator
1205− , simpleQueryStringAnalyzer :: Maybe Analyzer
1206− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1207− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1208− , simpleQueryStringLocale :: Maybe Locale
1209− } deriving (Eq, Read, Show, Generic, Typeable)
488+ deriving (Eq, Show)
1210489
1211−data SimpleQueryFlag =
1212− SimpleQueryAll
1213− | SimpleQueryNone
1214− | SimpleQueryAnd
1215− | SimpleQueryOr
1216− | SimpleQueryPrefix
1217− | SimpleQueryPhrase
1218− | SimpleQueryPrecedence
1219− | SimpleQueryEscape
1220− | SimpleQueryWhitespace
1221− | SimpleQueryFuzzy
1222− | SimpleQueryNear
1223− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1224−
1225−-- use_dis_max and tie_breaker when fields are plural?
1226−data QueryStringQuery =
1227− QueryStringQuery
1228− { queryStringQuery :: QueryString
1229− , queryStringDefaultField :: Maybe FieldName
1230− , queryStringOperator :: Maybe BooleanOperator
1231− , queryStringAnalyzer :: Maybe Analyzer
1232− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1233− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1234− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1235− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1236− , queryStringFuzziness :: Maybe Fuzziness
1237− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1238− , queryStringPhraseSlop :: Maybe PhraseSlop
1239− , queryStringBoost :: Maybe Boost
1240− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1241− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1242− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1243− , queryStringLenient :: Maybe Lenient
1244− , queryStringLocale :: Maybe Locale
1245− } deriving (Eq, Read, Show, Generic, Typeable)
1246−
1247−mkQueryStringQuery :: QueryString -> QueryStringQuery
1248−mkQueryStringQuery qs =
1249− QueryStringQuery qs Nothing Nothing
1250− Nothing Nothing Nothing Nothing
1251− Nothing Nothing Nothing Nothing
1252− Nothing Nothing Nothing Nothing
1253− Nothing Nothing
1254−
1255−data FieldOrFields = FofField FieldName
1256− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1257−
1258−data PrefixQuery =
1259− PrefixQuery
1260− { prefixQueryField :: FieldName
1261− , prefixQueryPrefixValue :: Text
1262− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1263−
1264−data NestedQuery =
1265− NestedQuery
1266− { nestedQueryPath :: QueryPath
1267− , nestedQueryScoreType :: ScoreType
1268− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1269−
1270−data MoreLikeThisFieldQuery =
1271− MoreLikeThisFieldQuery
1272− { moreLikeThisFieldText :: Text
1273− , moreLikeThisFieldFields :: FieldName
1274− -- default 0.3 (30%)
1275− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1276− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1277− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1278− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1279− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1280− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1281− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1282− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1283− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1284− , moreLikeThisFieldBoost :: Maybe Boost
1285− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1286− } deriving (Eq, Read, Show, Generic, Typeable)
1287−
1288−data MoreLikeThisQuery =
1289− MoreLikeThisQuery
1290− { moreLikeThisText :: Text
1291− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1292− -- default 0.3 (30%)
1293− , moreLikeThisPercentMatch :: Maybe PercentMatch
1294− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1295− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1296− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1297− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1298− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1299− , moreLikeThisMinWordLength :: Maybe MinWordLength
1300− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1301− , moreLikeThisBoostTerms :: Maybe BoostTerms
1302− , moreLikeThisBoost :: Maybe Boost
1303− , moreLikeThisAnalyzer :: Maybe Analyzer
1304− } deriving (Eq, Read, Show, Generic, Typeable)
1305−
1306−data IndicesQuery =
1307− IndicesQuery
1308− { indicesQueryIndices :: [IndexName]
1309− , indicesQuery :: Query
1310− -- default "all"
1311− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1312−
1313−data HasParentQuery =
1314− HasParentQuery
1315− { hasParentQueryType :: TypeName
1316− , hasParentQuery :: Query
1317− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1318−
1319−data HasChildQuery =
1320− HasChildQuery
1321− { hasChildQueryType :: TypeName
1322− , hasChildQuery :: Query
1323− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1324−
1325−data ScoreType =
1326− ScoreTypeMax
1327− | ScoreTypeSum
1328− | ScoreTypeAvg
1329− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1330−
1331−data FuzzyQuery =
1332− FuzzyQuery { fuzzyQueryField :: FieldName
1333− , fuzzyQueryValue :: Text
1334− , fuzzyQueryPrefixLength :: PrefixLength
1335− , fuzzyQueryMaxExpansions :: MaxExpansions
1336− , fuzzyQueryFuzziness :: Fuzziness
1337− , fuzzyQueryBoost :: Maybe Boost
1338− } deriving (Eq, Read, Show, Generic, Typeable)
1339−
1340−data FuzzyLikeFieldQuery =
1341− FuzzyLikeFieldQuery
1342− { fuzzyLikeField :: FieldName
1343− -- anaphora is good for the soul.
1344− , fuzzyLikeFieldText :: Text
1345− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1346− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1347− , fuzzyLikeFieldFuzziness :: Fuzziness
1348− , fuzzyLikeFieldPrefixLength :: PrefixLength
1349− , fuzzyLikeFieldBoost :: Boost
1350− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1351− } deriving (Eq, Read, Show, Generic, Typeable)
1352−
1353−data FuzzyLikeThisQuery =
1354− FuzzyLikeThisQuery
1355− { fuzzyLikeFields :: [FieldName]
1356− , fuzzyLikeText :: Text
1357− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1358− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1359− , fuzzyLikeFuzziness :: Fuzziness
1360− , fuzzyLikePrefixLength :: PrefixLength
1361− , fuzzyLikeBoost :: Boost
1362− , fuzzyLikeAnalyzer :: Maybe Analyzer
1363− } deriving (Eq, Read, Show, Generic, Typeable)
1364−
1365−data FilteredQuery =
1366− FilteredQuery
1367− { filteredQuery :: Query
1368− , filteredFilter :: Filter } deriving (Eq, Read, Show, Generic, Typeable)
1369−
1370−data DisMaxQuery =
1371− DisMaxQuery { disMaxQueries :: [Query]
1372− -- default 0.0
1373− , disMaxTiebreaker :: Tiebreaker
1374− , disMaxBoost :: Maybe Boost
1375− } deriving (Eq, Read, Show, Generic, Typeable)
1376−
1377−data MatchQuery =
1378− MatchQuery { matchQueryField :: FieldName
1379− , matchQueryQueryString :: QueryString
1380− , matchQueryOperator :: BooleanOperator
1381− , matchQueryZeroTerms :: ZeroTermsQuery
1382− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1383− , matchQueryMatchType :: Maybe MatchQueryType
1384− , matchQueryAnalyzer :: Maybe Analyzer
1385− , matchQueryMaxExpansions :: Maybe MaxExpansions
1386− , matchQueryLenient :: Maybe Lenient
1387− , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1388−
1389−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1390− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1391−-}
1392−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1393−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1394−
1395−data MatchQueryType =
1396− MatchPhrase
1397− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1398−
1399−data MultiMatchQuery =
1400− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1401− , multiMatchQueryString :: QueryString
1402− , multiMatchQueryOperator :: BooleanOperator
1403− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1404− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1405− , multiMatchQueryType :: Maybe MultiMatchQueryType
1406− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1407− , multiMatchQueryAnalyzer :: Maybe Analyzer
1408− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1409− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1410−
1411−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1412− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1413− make a 'MultiMatchQuery'.
1414−-}
1415−
1416−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1417−mkMultiMatchQuery matchFields query =
1418− MultiMatchQuery matchFields query
1419− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1420−
1421−data MultiMatchQueryType =
1422− MultiMatchBestFields
1423− | MultiMatchMostFields
1424− | MultiMatchCrossFields
1425− | MultiMatchPhrase
1426− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1427−
1428−data BoolQuery =
1429− BoolQuery { boolQueryMustMatch :: [Query]
1430− , boolQueryMustNotMatch :: [Query]
1431− , boolQueryShouldMatch :: [Query]
1432− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1433− , boolQueryBoost :: Maybe Boost
1434− , boolQueryDisableCoord :: Maybe DisableCoord
1435− } deriving (Eq, Read, Show, Generic, Typeable)
1436−
1437−mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1438−mkBoolQuery must mustNot should =
1439− BoolQuery must mustNot should Nothing Nothing Nothing
1440−
1441−data BoostingQuery =
1442− BoostingQuery { positiveQuery :: Query
1443− , negativeQuery :: Query
1444− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1445−
1446−data CommonTermsQuery =
1447− CommonTermsQuery { commonField :: FieldName
1448− , commonQuery :: QueryString
1449− , commonCutoffFrequency :: CutoffFrequency
1450− , commonLowFreqOperator :: BooleanOperator
1451− , commonHighFreqOperator :: BooleanOperator
1452− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1453− , commonBoost :: Maybe Boost
1454− , commonAnalyzer :: Maybe Analyzer
1455− , commonDisableCoord :: Maybe DisableCoord
1456− } deriving (Eq, Read, Show, Generic, Typeable)
1457−
1458−data CommonMinimumMatch =
1459− CommonMinimumMatchHighLow MinimumMatchHighLow
1460− | CommonMinimumMatch MinimumMatch
1461− deriving (Eq, Read, Show, Generic, Typeable)
1462−
1463−data MinimumMatchHighLow =
1464− MinimumMatchHighLow { lowFreq :: MinimumMatch
1465− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1466−
1467−data Filter = AndFilter [Filter] Cache
1468− | OrFilter [Filter] Cache
1469− | NotFilter Filter Cache
1470− | IdentityFilter
1471− | BoolFilter BoolMatch
1472− | ExistsFilter FieldName -- always cached
1473− | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1474− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1475− | GeoDistanceRangeFilter GeoPoint DistanceRange
1476− | GeoPolygonFilter FieldName [LatLon]
1477− | IdsFilter MappingName [DocId]
1478− | LimitFilter Int
1479− | MissingFilter FieldName Existence NullValue
1480− | PrefixFilter FieldName PrefixValue Cache
1481− | QueryFilter Query Cache
1482− | RangeFilter FieldName RangeValue RangeExecution Cache
1483− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1484− | TermFilter Term Cache
1485− deriving (Eq, Read, Show, Generic, Typeable)
1486−
1487−data ZeroTermsQuery = ZeroTermsNone
1488− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1489−
1490−data RangeExecution = RangeExecutionIndex
1491− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1492−
1493−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1494−
1495−data RegexpFlags = AllRegexpFlags
1496− | NoRegexpFlags
1497− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1498−
1499−data RegexpFlag = AnyString
1500− | Automaton
1501− | Complement
1502− | Empty
1503− | Intersection
1504− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1505−
1506−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1507−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1508−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1509−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1510−
1511−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1512−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1513−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1514−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1515−
1516−data RangeValue = RangeDateLte LessThanEqD
1517− | RangeDateLt LessThanD
1518− | RangeDateGte GreaterThanEqD
1519− | RangeDateGt GreaterThanD
1520− | RangeDateGtLt GreaterThanD LessThanD
1521− | RangeDateGteLte GreaterThanEqD LessThanEqD
1522− | RangeDateGteLt GreaterThanEqD LessThanD
1523− | RangeDateGtLte GreaterThanD LessThanEqD
1524− | RangeDoubleLte LessThanEq
1525− | RangeDoubleLt LessThan
1526− | RangeDoubleGte GreaterThanEq
1527− | RangeDoubleGt GreaterThan
1528− | RangeDoubleGtLt GreaterThan LessThan
1529− | RangeDoubleGteLte GreaterThanEq LessThanEq
1530− | RangeDoubleGteLt GreaterThanEq LessThan
1531− | RangeDoubleGtLte GreaterThan LessThanEq
1532− deriving (Eq, Read, Show, Generic, Typeable)
1533−
1534−rangeValueToPair :: RangeValue -> [Pair]
1535−rangeValueToPair rv = case rv of
1536− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1537− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1538− RangeDateLt (LessThanD t) -> ["lt" .= t]
1539− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1540− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1541− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1542− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1543− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1544− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1545− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1546− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1547− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1548− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1549− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1550− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1551− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1552−
1553−data Term = Term { termField :: Text
1554− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1555−
1556−data BoolMatch = MustMatch Term Cache
1557− | MustNotMatch Term Cache
1558− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1559−
1560−-- "memory" or "indexed"
1561−data GeoFilterType = GeoFilterMemory
1562− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1563−
1564−data LatLon = LatLon { lat :: Double
1565− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1566−
1567−data GeoBoundingBox =
1568− GeoBoundingBox { topLeft :: LatLon
1569− , bottomRight :: LatLon } deriving (Eq, Read, 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 ]
1570494
1571−data GeoBoundingBoxConstraint =
1572− GeoBoundingBoxConstraint { geoBBField :: FieldName
1573− , constraintBox :: GeoBoundingBox
1574− , bbConstraintcache :: Cache
1575− , geoType :: GeoFilterType
1576− } deriving (Eq, Read, Show, Generic, Typeable)
495+data PatternOrPatterns = PopPattern Pattern
496+ | PopPatterns [Pattern] deriving (Eq, Read, Show)
1577497
1578−data GeoPoint =
1579− GeoPoint { geoField :: FieldName
1580− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
498+instance ToJSON PatternOrPatterns where
499+ toJSON (PopPattern pattern) = toJSON pattern
500+ toJSON (PopPatterns patterns) = toJSON patterns
1581501
1582−data DistanceUnit = Miles
1583− | Yards
1584− | Feet
1585− | Inches
1586− | Kilometers
1587− | Meters
1588− | Centimeters
1589− | Millimeters
1590− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
502+data Include = Include [Pattern] deriving (Eq, Read, Show)
503+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
1591504
1592−data DistanceType = Arc
1593− | SloppyArc -- doesn't exist <1.0
1594− | Plane deriving (Eq, Read, Show, Generic, Typeable)
505+instance ToJSON Include where
506+ toJSON (Include patterns) = toJSON patterns
1595507
1596−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1597− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
508+instance ToJSON Exclude where
509+ toJSON (Exclude patterns) = toJSON patterns
1598510
1599−data Distance =
1600− Distance { coefficient :: Double
1601− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
511+newtype Pattern = Pattern Text deriving (Eq, Read, Show)
1602512
1603−data DistanceRange =
1604− DistanceRange { distanceFrom :: Distance
1605− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
513+instance ToJSON Pattern where
514+ toJSON (Pattern pattern) = toJSON pattern
1606515
1607516data SearchResult a =
1608517 SearchResult { took :: Int
@@ -1610,2069 +519,12 @@ data SearchResult a =
1610519 , shards :: ShardResult
1611520 , searchHits :: SearchHits a
1612521 , aggregations :: Maybe AggregationResults
1613− , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)
1614−
1615−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1616−
1617−type Score = Maybe Double
1618−
1619−data SearchHits a =
1620− SearchHits { hitsTotal :: Int
1621− , maxScore :: Score
1622− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1623−
1624−
1625−instance Monoid (SearchHits a) where
1626− mempty = SearchHits 0 Nothing mempty
1627− mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1628− SearchHits (ta + tb) (max ma mb) (ha <> hb)
1629−
1630−
1631−data Hit a =
1632− Hit { hitIndex :: IndexName
1633− , hitType :: MappingName
1634− , hitDocId :: DocId
1635− , hitScore :: Score
1636− , hitSource :: Maybe a
1637− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1638−
1639−data ShardResult =
1640− ShardResult { shardTotal :: Int
1641− , shardsSuccessful :: Int
1642− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1643−
1644−type HitHighlight = M.Map Text [Text]
1645−
1646−showText :: Show a => a -> Text
1647−showText = T.pack . show
1648−
1649−readMay :: Read a => String -> Maybe a
1650−readMay s = case reads s of
1651− (a, ""):_ -> Just a
1652− _ -> Nothing
1653−
1654−parseReadText :: Read a => Text -> Parser a
1655−parseReadText = maybe mzero return . readMay . T.unpack
1656−
1657−type Aggregations = M.Map Text Aggregation
1658−
1659−emptyAggregations :: Aggregations
1660−emptyAggregations = M.empty
1661−
1662−mkAggregations :: Text -> Aggregation -> Aggregations
1663−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1664−
1665−data TermOrder = TermOrder{ termSortField :: Text
1666− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1667−
1668−data TermInclusion = TermInclusion Text
1669− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1670−
1671−data CollectionMode = BreadthFirst
1672− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1673−
1674−data ExecutionHint = Ordinals
1675− | GlobalOrdinals
1676− | GlobalOrdinalsHash
1677− | GlobalOrdinalsLowCardinality
1678− | Map deriving (Eq, Read, Show, Generic, Typeable)
1679−
1680−data TimeInterval = Weeks
1681− | Days
1682− | Hours
1683− | Minutes
1684− | Seconds deriving Eq
1685−
1686−data Interval = Year
1687− | Quarter
1688− | Month
1689− | Week
1690− | Day
1691− | Hour
1692− | Minute
1693− | Second
1694− | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)
1695−
1696−data Aggregation = TermsAgg TermsAggregation
1697− | DateHistogramAgg DateHistogramAggregation
1698− | ValueCountAgg ValueCountAggregation
1699− | FilterAgg FilterAggregation
1700− | DateRangeAgg DateRangeAggregation
1701− | MissingAgg MissingAggregation deriving (Eq, Read, Show, Generic, Typeable)
1702−
1703−data MissingAggregation = MissingAggregation
1704− { maField :: Text
1705− } deriving (Eq, Read, Show, Generic, Typeable)
1706−
1707−data TermsAggregation = TermsAggregation { term :: Either Text Text
1708− , termInclude :: Maybe TermInclusion
1709− , termExclude :: Maybe TermInclusion
1710− , termOrder :: Maybe TermOrder
1711− , termMinDocCount :: Maybe Int
1712− , termSize :: Maybe Int
1713− , termShardSize :: Maybe Int
1714− , termCollectMode :: Maybe CollectionMode
1715− , termExecutionHint :: Maybe ExecutionHint
1716− , termAggs :: Maybe Aggregations
1717− } deriving (Eq, Read, Show, Generic, Typeable)
1718−
1719−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1720− , dateInterval :: Interval
1721− , dateFormat :: Maybe Text
1722− -- pre and post deprecated in 1.5
1723− , datePreZone :: Maybe Text
1724− , datePostZone :: Maybe Text
1725− , datePreOffset :: Maybe Text
1726− , datePostOffset :: Maybe Text
1727− , dateAggs :: Maybe Aggregations
1728− } deriving (Eq, Read, Show, Generic, Typeable)
1729−
1730−
1731−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1732− , draFormat :: Maybe Text
1733− , draRanges :: NonEmpty DateRangeAggRange
1734− } deriving (Eq, Read, Show, Generic, Typeable)
1735−
1736−data DateRangeAggRange = DateRangeFrom DateMathExpr
1737− | DateRangeTo DateMathExpr
1738− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1739−
1740−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1741−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1742−
1743−
1744−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1745−data DateMathAnchor = DMNow
1746− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1747−
1748−data DateMathModifier = AddTime Int DateMathUnit
1749− | SubtractTime Int DateMathUnit
1750− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1751−
1752−data DateMathUnit = DMYear
1753− | DMMonth
1754− | DMWeek
1755− | DMDay
1756− | DMHour
1757− | DMMinute
1758− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1759−
1760−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1761−data ValueCountAggregation = FieldValueCount FieldName
1762− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1763−
1764−-- | 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.
1765−data FilterAggregation = FilterAggregation { faFilter :: Filter
1766− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1767−
1768−mkTermsAggregation :: Text -> TermsAggregation
1769−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1770−
1771−mkTermsScriptAggregation :: Text -> TermsAggregation
1772−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1773−
1774−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1775−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1776−
1777−instance ToJSON Version where
1778− toJSON Version {..} = object ["number" .= number
1779− ,"build_hash" .= build_hash
1780− ,"build_timestamp" .= build_timestamp
1781− ,"build_snapshot" .= build_snapshot
1782− ,"lucene_version" .= lucene_version]
1783−
1784−instance FromJSON Version where
1785− parseJSON = withObject "Version" parse
1786− where parse o = Version
1787− <$> o .: "number"
1788− <*> o .: "build_hash"
1789− <*> o .: "build_timestamp"
1790− <*> o .: "build_snapshot"
1791− <*> o .: "lucene_version"
1792−
1793−instance ToJSON VersionNumber where
1794− toJSON = toJSON . Vers.showVersion . versionNumber
1795−
1796−instance FromJSON VersionNumber where
1797− parseJSON = withText "VersionNumber" (parse . T.unpack)
1798− where
1799− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1800− [(v, _)] -> pure (VersionNumber v)
1801− [] -> fail ("Invalid version string " ++ s)
1802− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1803−
1804−instance ToJSON TermOrder where
1805− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1806−
1807−instance ToJSON TermInclusion where
1808− toJSON (TermInclusion x) = toJSON x
1809− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1810− "flags" .= flags]
1811−
1812−instance ToJSON CollectionMode where
1813− toJSON BreadthFirst = "breadth_first"
1814− toJSON DepthFirst = "depth_first"
1815−
1816−instance ToJSON ExecutionHint where
1817− toJSON Ordinals = "ordinals"
1818− toJSON GlobalOrdinals = "global_ordinals"
1819− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1820− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1821− toJSON Map = "map"
1822−
1823−instance ToJSON Interval where
1824− toJSON Year = "year"
1825− toJSON Quarter = "quarter"
1826− toJSON Month = "month"
1827− toJSON Week = "week"
1828− toJSON Day = "day"
1829− toJSON Hour = "hour"
1830− toJSON Minute = "minute"
1831− toJSON Second = "second"
1832− toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1833−
1834−instance Show TimeInterval where
1835− show Weeks = "w"
1836− show Days = "d"
1837− show Hours = "h"
1838− show Minutes = "m"
1839− show Seconds = "s"
1840−
1841−instance Read TimeInterval where
1842− readPrec = f =<< TR.get
1843− where
1844− f 'w' = return Weeks
1845− f 'd' = return Days
1846− f 'h' = return Hours
1847− f 'm' = return Minutes
1848− f 's' = return Seconds
1849− f _ = fail "TimeInterval expected one of w, d, h, m, s"
1850−
1851−instance ToJSON Aggregation where
1852− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1853− omitNulls ["terms" .= omitNulls [ toJSON' term,
1854− "include" .= include,
1855− "exclude" .= exclude,
1856− "order" .= order,
1857− "min_doc_count" .= minDocCount,
1858− "size" .= size,
1859− "shard_size" .= shardSize,
1860− "collect_mode" .= collectMode,
1861− "execution_hint" .= executionHint
1862− ],
1863− "aggs" .= termAggs ]
1864− where
1865− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1866−
1867− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1868− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1869− "interval" .= interval,
1870− "format" .= format,
1871− "pre_zone" .= preZone,
1872− "post_zone" .= postZone,
1873− "pre_offset" .= preOffset,
1874− "post_offset" .= postOffset
1875− ],
1876− "aggs" .= dateHistoAggs ]
1877− toJSON (ValueCountAgg a) = object ["value_count" .= v]
1878− where v = case a of
1879− (FieldValueCount (FieldName n)) -> object ["field" .= n]
1880− (ScriptValueCount (Script s)) -> object ["script" .= s]
1881− toJSON (FilterAgg (FilterAggregation filt ags)) =
1882− omitNulls [ "filter" .= filt
1883− , "aggs" .= ags]
1884− toJSON (DateRangeAgg a) = object [ "date_range" .= a
1885− ]
1886− toJSON (MissingAgg (MissingAggregation{..})) =
1887− object ["missing" .= object ["field" .= maField]]
1888−
1889−instance ToJSON DateRangeAggregation where
1890− toJSON DateRangeAggregation {..} =
1891− omitNulls [ "field" .= draField
1892− , "format" .= draFormat
1893− , "ranges" .= toList draRanges
1894− ]
1895−
1896−instance ToJSON DateRangeAggRange where
1897− toJSON (DateRangeFrom e) = object [ "from" .= e ]
1898− toJSON (DateRangeTo e) = object [ "to" .= e ]
1899− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1900−
1901−instance ToJSON DateMathExpr where
1902− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1903− where fmtA DMNow = "now"
1904− fmtA (DMDate date) = case toGregorian date of
1905− (y,m,d) -> showText y <> "-" <>
1906− showText m <> "-" <>
1907− showText d <> "||"
1908− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1909− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1910− fmtMod (RoundDownTo u) = "/" <> fmtU u
1911− fmtU DMYear = "y"
1912− fmtU DMMonth = "M"
1913− fmtU DMWeek = "w"
1914− fmtU DMDay = "d"
1915− fmtU DMHour = "h"
1916− fmtU DMMinute = "m"
1917− fmtU DMSecond = "s"
1918−
1919−
1920−type AggregationResults = M.Map Text Value
1921−
1922−class BucketAggregation a where
1923− key :: a -> BucketValue
1924− docCount :: a -> Int
1925− aggs :: a -> Maybe AggregationResults
1926−
1927−
1928−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
1929−
1930−data BucketValue = TextValue Text
1931− | ScientificValue Scientific
1932− | BoolValue Bool deriving (Read, Show)
1933−
1934−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
1935−
1936−data TermsResult = TermsResult { termKey :: BucketValue
1937− , termsDocCount :: Int
1938− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
1939−
1940−data DateHistogramResult = DateHistogramResult { dateKey :: Int
1941− , dateKeyStr :: Maybe Text
1942− , dateDocCount :: Int
1943− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
1944−
1945−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
1946− , dateRangeFrom :: Maybe UTCTime
1947− , dateRangeFromAsString :: Maybe Text
1948− , dateRangeTo :: Maybe UTCTime
1949− , dateRangeToAsString :: Maybe Text
1950− , dateRangeDocCount :: Int
1951− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
1952−
1953−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1954−toTerms = toAggResult
1955−
1956−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
1957−toDateHistogram = toAggResult
1958−
1959−toMissing :: Text -> AggregationResults -> Maybe MissingResult
1960−toMissing = toAggResult
1961−
1962−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
1963−toAggResult t a = M.lookup t a >>= deserialize
1964− where deserialize = parseMaybe parseJSON
1965−
1966−instance BucketAggregation TermsResult where
1967− key = termKey
1968− docCount = termsDocCount
1969− aggs = termsAggs
1970−
1971−instance BucketAggregation DateHistogramResult where
1972− key = TextValue . showText . dateKey
1973− docCount = dateDocCount
1974− aggs = dateHistogramAggs
1975−
1976−instance BucketAggregation DateRangeResult where
1977− key = TextValue . dateRangeKey
1978− docCount = dateRangeDocCount
1979− aggs = dateRangeAggs
1980−
1981−instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
1982− parseJSON (Object v) = Bucket <$>
1983− v .: "buckets"
1984− parseJSON _ = mempty
1985−
1986−instance FromJSON BucketValue where
1987− parseJSON (String t) = return $ TextValue t
1988− parseJSON (Number s) = return $ ScientificValue s
1989− parseJSON (Bool b) = return $ BoolValue b
1990− parseJSON _ = mempty
1991−
1992−instance FromJSON MissingResult where
1993− parseJSON = withObject "MissingResult" parse
1994− where parse v = MissingResult <$> v .: "doc_count"
1995−
1996−instance FromJSON TermsResult where
1997− parseJSON (Object v) = TermsResult <$>
1998− v .: "key" <*>
1999− v .: "doc_count" <*>
2000− v .:? "aggregations"
2001− parseJSON _ = mempty
2002−
2003−instance FromJSON DateHistogramResult where
2004− parseJSON (Object v) = DateHistogramResult <$>
2005− v .: "key" <*>
2006− v .:? "key_as_string" <*>
2007− v .: "doc_count" <*>
2008− v .:? "aggregations"
2009− parseJSON _ = mempty
2010−
2011−instance FromJSON DateRangeResult where
2012− parseJSON = withObject "DateRangeResult" parse
2013− where parse v = DateRangeResult <$>
2014− v .: "key" <*>
2015− (fmap posixMS <$> v .:? "from") <*>
2016− v .:? "from_as_string" <*>
2017− (fmap posixMS <$> v .:? "to") <*>
2018− v .:? "to_as_string" <*>
2019− v .: "doc_count" <*>
2020− v .:? "aggregations"
2021−
2022−instance FromJSON POSIXMS where
2023− parseJSON = withScientific "POSIXMS" (return . parse)
2024− where parse n = let n' = truncate n :: Integer
2025− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2026−
2027−instance Monoid Filter where
2028− mempty = IdentityFilter
2029− mappend a b = AndFilter [a, b] defaultCache
2030−
2031−instance Seminearring Filter where
2032− a <||> b = OrFilter [a, b] defaultCache
2033−
2034−instance ToJSON Filter where
2035− toJSON (AndFilter filters cache) =
2036− object ["and" .=
2037− object [ "filters" .= fmap toJSON filters
2038− , "_cache" .= cache]]
2039−
2040− toJSON (OrFilter filters cache) =
2041− object ["or" .=
2042− object [ "filters" .= fmap toJSON filters
2043− , "_cache" .= cache]]
2044−
2045− toJSON (NotFilter notFilter cache) =
2046− object ["not" .=
2047− object ["filter" .= notFilter
2048− , "_cache" .= cache]]
2049−
2050− toJSON (IdentityFilter) =
2051− object ["match_all" .= object []]
2052−
2053− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
2054− object ["term" .= object base]
2055− where base = [termFilterField .= termFilterValue,
2056− "_cache" .= cache]
2057−
2058− toJSON (ExistsFilter (FieldName fieldName)) =
2059− object ["exists" .= object
2060− ["field" .= fieldName]]
2061−
2062− toJSON (BoolFilter boolMatch) =
2063− object ["bool" .= boolMatch]
2064−
2065− toJSON (GeoBoundingBoxFilter bbConstraint) =
2066− object ["geo_bounding_box" .= bbConstraint]
2067−
2068− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
2069− distance distanceType optimizeBbox cache) =
2070− object ["geo_distance" .=
2071− object ["distance" .= distance
2072− , "distance_type" .= distanceType
2073− , "optimize_bbox" .= optimizeBbox
2074− , distanceGeoField .= geoDistLatLon
2075− , "_cache" .= cache]]
2076−
2077− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
2078− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
2079− object ["geo_distance_range" .=
2080− object ["from" .= geoDistRangeDistFrom
2081− , "to" .= drDistanceTo
2082− , gddrField .= drLatLon]]
2083−
2084− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
2085− object ["geo_polygon" .=
2086− object [geoPolygonFilterField .=
2087− object ["points" .= fmap toJSON latLons]]]
2088−
2089− toJSON (IdsFilter (MappingName mappingName) values) =
2090− object ["ids" .=
2091− object ["type" .= mappingName
2092− , "values" .= fmap unpackId values]]
2093−
2094− toJSON (LimitFilter limit) =
2095− object ["limit" .= object ["value" .= limit]]
2096−
2097− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
2098− object ["missing" .=
2099− object ["field" .= fieldName
2100− , "existence" .= existence
2101− , "null_value" .= nullValue]]
2102−
2103− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
2104− object ["prefix" .=
2105− object [fieldName .= fieldValue
2106− , "_cache" .= cache]]
2107−
2108− toJSON (QueryFilter query False) =
2109− object ["query" .= toJSON query ]
2110− toJSON (QueryFilter query True) =
2111− object ["fquery" .=
2112− object [ "query" .= toJSON query
2113− , "_cache" .= True ]]
2114−
2115− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
2116− object ["range" .=
2117− object [ fieldName .= object (rangeValueToPair rangeValue)
2118− , "execution" .= rangeExecution
2119− , "_cache" .= cache]]
2120−
2121− toJSON (RegexpFilter (FieldName fieldName)
2122− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
2123− object ["regexp" .=
2124− object [fieldName .=
2125− object ["value" .= regexText
2126− , "flags" .= flags]
2127− , "_name" .= cacheName
2128− , "_cache" .= cache
2129− , "_cache_key" .= cacheKey]]
2130−
2131−instance FromJSON Filter where
2132− parseJSON = withObject "Filter" parse
2133− where parse o = andFilter `taggedWith` "and"
2134− <|> orFilter `taggedWith` "or"
2135− <|> notFilter `taggedWith` "not"
2136− <|> identityFilter `taggedWith` "match_all"
2137− <|> boolFilter `taggedWith` "bool"
2138− <|> existsFilter `taggedWith` "exists"
2139− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
2140− <|> geoDistanceFilter `taggedWith` "geo_distance"
2141− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
2142− <|> geoPolygonFilter `taggedWith` "geo_polygon"
2143− <|> idsFilter `taggedWith` "ids"
2144− <|> limitFilter `taggedWith` "limit"
2145− <|> missingFilter `taggedWith` "missing"
2146− <|> prefixFilter `taggedWith` "prefix"
2147− <|> queryFilter `taggedWith` "query"
2148− <|> fqueryFilter `taggedWith` "fquery"
2149− <|> rangeFilter `taggedWith` "range"
2150− <|> regexpFilter `taggedWith` "regexp"
2151− <|> termFilter `taggedWith` "term"
2152− where taggedWith parser k = parser =<< o .: k
2153− andFilter o = AndFilter <$> o .: "filters"
2154− <*> o .:? "_cache" .!= defaultCache
2155− orFilter o = OrFilter <$> o .: "filters"
2156− <*> o .:? "_cache" .!= defaultCache
2157− notFilter o = NotFilter <$> o .: "filter"
2158− <*> o .: "_cache" .!= defaultCache
2159− identityFilter :: Object -> Parser Filter
2160− identityFilter m
2161− | HM.null m = pure IdentityFilter
2162− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
2163− boolFilter = pure . BoolFilter
2164− existsFilter o = ExistsFilter <$> o .: "field"
2165− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
2166− geoDistanceFilter o = do
2167− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
2168− [(fn, v)] -> do
2169− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2170− GeoDistanceFilter gp <$> o .: "distance"
2171− <*> o .: "distance_type"
2172− <*> o .: "optimize_bbox"
2173− <*> o .:? "_cache" .!= defaultCache
2174− _ -> fail "Could not find GeoDistanceFilter field name"
2175− geoDistanceRangeFilter o = do
2176− case HM.toList (deleteSeveral ["from", "to"] o) of
2177− [(fn, v)] -> do
2178− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2179− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
2180− return (GeoDistanceRangeFilter gp rng)
2181− _ -> fail "Could not find GeoDistanceRangeFilter field name"
2182− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
2183− idsFilter o = IdsFilter <$> o .: "type"
2184− <*> o .: "values"
2185− limitFilter o = LimitFilter <$> o .: "value"
2186− missingFilter o = MissingFilter <$> o .: "field"
2187− <*> o .: "existence"
2188− <*> o .: "null_value"
2189− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2190− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2191− _ -> fail "Could not parse PrefixFilter"
2192−
2193− queryFilter q = pure (QueryFilter q False)
2194− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2195− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2196− [(fn, v)] -> RangeFilter (FieldName fn)
2197− <$> parseJSON v
2198− <*> o .: "execution"
2199− <*> o .:? "_cache" .!= defaultCache
2200− _ -> fail "Could not find field name for RangeFilter"
2201− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2202− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2203− <$> o' .: "value"
2204− <*> o' .: "flags"
2205− <*> o .: "_name"
2206− <*> o .:? "_cache" .!= defaultCache
2207− <*> o .: "_cache_key"
2208− _ -> fail "Could not find field name for RegexpFilter"
2209− termFilter o = case HM.toList (HM.delete "_cache" o) of
2210− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2211− <$> o .:? "_cache" .!= defaultCache
2212− _ -> fail "Could not find term field for TermFilter"
2213−
2214−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2215−fieldTagged f o = case HM.toList o of
2216− [(k, Object o')] -> f (FieldName k) o'
2217− _ -> fail "Expected object with 1 field-named key"
2218−
2219−instance ToJSON GeoPoint where
2220− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2221− object [ geoPointField .= geoPointLatLon ]
2222−
2223−
2224−instance ToJSON Query where
2225− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2226− object [ "term" .=
2227− object [termQueryField .= object merged]]
2228− where
2229− base = [ "value" .= termQueryValue ]
2230− boosted = maybe [] (return . ("boost" .=)) boost
2231− merged = mappend base boosted
2232−
2233− toJSON (TermsQuery fieldName terms) =
2234− object [ "terms" .= object conjoined ]
2235− where conjoined = [fieldName .= terms]
2236−
2237− toJSON (IdsQuery idsQueryMappingName docIds) =
2238− object [ "ids" .= object conjoined ]
2239− where conjoined = [ "type" .= idsQueryMappingName
2240− , "values" .= fmap toJSON docIds ]
2241−
2242− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2243− object [ "query_string" .= qQueryStringQuery ]
2244−
2245− toJSON (QueryMatchQuery matchQuery) =
2246− object [ "match" .= matchQuery ]
2247−
2248− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2249− toJSON multiMatchQuery
2250−
2251− toJSON (QueryBoolQuery boolQuery) =
2252− object [ "bool" .= boolQuery ]
2253−
2254− toJSON (QueryBoostingQuery boostingQuery) =
2255− object [ "boosting" .= boostingQuery ]
2256−
2257− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2258− object [ "common" .= commonTermsQuery ]
2259−
2260− toJSON (ConstantScoreFilter csFilter boost) =
2261− object ["constant_score" .= object ["filter" .= csFilter
2262− , "boost" .= boost]]
2263−
2264− toJSON (ConstantScoreQuery query boost) =
2265− object ["constant_score" .= object ["query" .= query
2266− , "boost" .= boost]]
2267−
2268− toJSON (QueryDisMaxQuery disMaxQuery) =
2269− object [ "dis_max" .= disMaxQuery ]
2270−
2271− toJSON (QueryFilteredQuery qFilteredQuery) =
2272− object [ "filtered" .= qFilteredQuery ]
2273−
2274− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2275− object [ "fuzzy_like_this" .= fuzzyQuery ]
2276−
2277− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2278− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2279−
2280− toJSON (QueryFuzzyQuery fuzzyQuery) =
2281− object [ "fuzzy" .= fuzzyQuery ]
2282−
2283− toJSON (QueryHasChildQuery childQuery) =
2284− object [ "has_child" .= childQuery ]
2285−
2286− toJSON (QueryHasParentQuery parentQuery) =
2287− object [ "has_parent" .= parentQuery ]
2288−
2289− toJSON (QueryIndicesQuery qIndicesQuery) =
2290− object [ "indices" .= qIndicesQuery ]
2291−
2292− toJSON (MatchAllQuery boost) =
2293− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2294−
2295− toJSON (QueryMoreLikeThisQuery query) =
2296− object [ "more_like_this" .= query ]
2297−
2298− toJSON (QueryMoreLikeThisFieldQuery query) =
2299− object [ "more_like_this_field" .= query ]
2300−
2301− toJSON (QueryNestedQuery query) =
2302− object [ "nested" .= query ]
2303−
2304− toJSON (QueryPrefixQuery query) =
2305− object [ "prefix" .= query ]
2306−
2307− toJSON (QueryRangeQuery query) =
2308− object [ "range" .= query ]
2309−
2310− toJSON (QueryRegexpQuery query) =
2311− object [ "regexp" .= query ]
2312−
2313− toJSON (QuerySimpleQueryStringQuery query) =
2314− object [ "simple_query_string" .= query ]
2315−
2316−instance FromJSON Query where
2317− parseJSON v = withObject "Query" parse v
2318− where parse o = termQuery `taggedWith` "term"
2319− <|> termsQuery `taggedWith` "terms"
2320− <|> idsQuery `taggedWith` "ids"
2321− <|> queryQueryStringQuery `taggedWith` "query_string"
2322− <|> queryMatchQuery `taggedWith` "match"
2323− <|> queryMultiMatchQuery
2324− <|> queryBoolQuery `taggedWith` "bool"
2325− <|> queryBoostingQuery `taggedWith` "boosting"
2326− <|> queryCommonTermsQuery `taggedWith` "common"
2327− <|> constantScoreFilter `taggedWith` "constant_score"
2328− <|> constantScoreQuery `taggedWith` "constant_score"
2329− <|> queryDisMaxQuery `taggedWith` "dis_max"
2330− <|> queryFilteredQuery `taggedWith` "filtered"
2331− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2332− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2333− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2334− <|> queryHasChildQuery `taggedWith` "has_child"
2335− <|> queryHasParentQuery `taggedWith` "has_parent"
2336− <|> queryIndicesQuery `taggedWith` "indices"
2337− <|> matchAllQuery `taggedWith` "match_all"
2338− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2339− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2340− <|> queryNestedQuery `taggedWith` "nested"
2341− <|> queryPrefixQuery `taggedWith` "prefix"
2342− <|> queryRangeQuery `taggedWith` "range"
2343− <|> queryRegexpQuery `taggedWith` "regexp"
2344− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2345− where taggedWith parser k = parser =<< o .: k
2346− termQuery = fieldTagged $ \(FieldName fn) o ->
2347− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2348− termsQuery o = case HM.toList o of
2349− [(fn, vs)] -> do vals <- parseJSON vs
2350− case vals of
2351− x:xs -> return (TermsQuery fn (x :| xs))
2352− _ -> fail "Expected non empty list of values"
2353− _ -> fail "Expected object with 1 field-named key"
2354− idsQuery o = IdsQuery <$> o .: "type"
2355− <*> o .: "values"
2356− queryQueryStringQuery = pure . QueryQueryStringQuery
2357− queryMatchQuery = pure . QueryMatchQuery
2358− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2359− queryBoolQuery = pure . QueryBoolQuery
2360− queryBoostingQuery = pure . QueryBoostingQuery
2361− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2362− constantScoreFilter o = case HM.lookup "filter" o of
2363− Just x -> ConstantScoreFilter <$> parseJSON x
2364− <*> o .: "boost"
2365− _ -> fail "Does not appear to be a ConstantScoreFilter"
2366− constantScoreQuery o = case HM.lookup "query" o of
2367− Just x -> ConstantScoreQuery <$> parseJSON x
2368− <*> o .: "boost"
2369− _ -> fail "Does not appear to be a ConstantScoreQuery"
2370− queryDisMaxQuery = pure . QueryDisMaxQuery
2371− queryFilteredQuery = pure . QueryFilteredQuery
2372− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2373− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2374− queryFuzzyQuery = pure . QueryFuzzyQuery
2375− queryHasChildQuery = pure . QueryHasChildQuery
2376− queryHasParentQuery = pure . QueryHasParentQuery
2377− queryIndicesQuery = pure . QueryIndicesQuery
2378− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2379− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2380− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2381− queryNestedQuery = pure . QueryNestedQuery
2382− queryPrefixQuery = pure . QueryPrefixQuery
2383− queryRangeQuery = pure . QueryRangeQuery
2384− queryRegexpQuery = pure . QueryRegexpQuery
2385− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2386−
2387−
2388−omitNulls :: [(Text, Value)] -> Value
2389−omitNulls = object . filter notNull where
2390− notNull (_, Null) = False
2391− notNull (_, Array a) = (not . V.null) a
2392− notNull _ = True
2393−
2394−
2395−instance ToJSON SimpleQueryStringQuery where
2396− toJSON SimpleQueryStringQuery {..} =
2397− omitNulls (base ++ maybeAdd)
2398− where base = [ "query" .= simpleQueryStringQuery ]
2399− maybeAdd = [ "fields" .= simpleQueryStringField
2400− , "default_operator" .= simpleQueryStringOperator
2401− , "analyzer" .= simpleQueryStringAnalyzer
2402− , "flags" .= simpleQueryStringFlags
2403− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2404− , "locale" .= simpleQueryStringLocale ]
2405−
2406−instance FromJSON SimpleQueryStringQuery where
2407− parseJSON = withObject "SimpleQueryStringQuery" parse
2408− where parse o = SimpleQueryStringQuery <$> o .: "query"
2409− <*> o .:? "fields"
2410− <*> o .:? "default_operator"
2411− <*> o .:? "analyzer"
2412− <*> (parseFlags <$> o .:? "flags")
2413− <*> o .:? "lowercase_expanded_terms"
2414− <*> o .:? "locale"
2415− parseFlags (Just (x:xs)) = Just (x :| xs)
2416− parseFlags _ = Nothing
2417−
2418−instance ToJSON FieldOrFields where
2419− toJSON (FofField fieldName) =
2420− toJSON fieldName
2421− toJSON (FofFields fieldNames) =
2422− toJSON fieldNames
2423−
2424−instance FromJSON FieldOrFields where
2425− parseJSON v = FofField <$> parseJSON v
2426− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2427−
2428−instance ToJSON SimpleQueryFlag where
2429− toJSON SimpleQueryAll = "ALL"
2430− toJSON SimpleQueryNone = "NONE"
2431− toJSON SimpleQueryAnd = "AND"
2432− toJSON SimpleQueryOr = "OR"
2433− toJSON SimpleQueryPrefix = "PREFIX"
2434− toJSON SimpleQueryPhrase = "PHRASE"
2435− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2436− toJSON SimpleQueryEscape = "ESCAPE"
2437− toJSON SimpleQueryWhitespace = "WHITESPACE"
2438− toJSON SimpleQueryFuzzy = "FUZZY"
2439− toJSON SimpleQueryNear = "NEAR"
2440− toJSON SimpleQuerySlop = "SLOP"
2441−
2442−instance FromJSON SimpleQueryFlag where
2443− parseJSON = withText "SimpleQueryFlag" parse
2444− where parse "ALL" = pure SimpleQueryAll
2445− parse "NONE" = pure SimpleQueryNone
2446− parse "AND" = pure SimpleQueryAnd
2447− parse "OR" = pure SimpleQueryOr
2448− parse "PREFIX" = pure SimpleQueryPrefix
2449− parse "PHRASE" = pure SimpleQueryPhrase
2450− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2451− parse "ESCAPE" = pure SimpleQueryEscape
2452− parse "WHITESPACE" = pure SimpleQueryWhitespace
2453− parse "FUZZY" = pure SimpleQueryFuzzy
2454− parse "NEAR" = pure SimpleQueryNear
2455− parse "SLOP" = pure SimpleQuerySlop
2456− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2457−
2458−instance ToJSON RegexpQuery where
2459− toJSON (RegexpQuery (FieldName rqQueryField)
2460− (Regexp regexpQueryQuery) rqQueryFlags
2461− rqQueryBoost) =
2462− object [ rqQueryField .= omitNulls base ]
2463− where base = [ "value" .= regexpQueryQuery
2464− , "flags" .= rqQueryFlags
2465− , "boost" .= rqQueryBoost ]
2466−
2467−instance FromJSON RegexpQuery where
2468− parseJSON = withObject "RegexpQuery" parse
2469− where parse = fieldTagged $ \fn o ->
2470− RegexpQuery fn
2471− <$> o .: "value"
2472− <*> o .: "flags"
2473− <*> o .:? "boost"
2474−
2475−instance ToJSON QueryStringQuery where
2476− toJSON (QueryStringQuery qsQueryString
2477− qsDefaultField qsOperator
2478− qsAnalyzer qsAllowWildcard
2479− qsLowercaseExpanded qsEnablePositionIncrements
2480− qsFuzzyMaxExpansions qsFuzziness
2481− qsFuzzyPrefixLength qsPhraseSlop
2482− qsBoost qsAnalyzeWildcard
2483− qsGeneratePhraseQueries qsMinimumShouldMatch
2484− qsLenient qsLocale) =
2485− omitNulls base
2486− where
2487− base = [ "query" .= qsQueryString
2488− , "default_field" .= qsDefaultField
2489− , "default_operator" .= qsOperator
2490− , "analyzer" .= qsAnalyzer
2491− , "allow_leading_wildcard" .= qsAllowWildcard
2492− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2493− , "enable_position_increments" .= qsEnablePositionIncrements
2494− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2495− , "fuzziness" .= qsFuzziness
2496− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2497− , "phrase_slop" .= qsPhraseSlop
2498− , "boost" .= qsBoost
2499− , "analyze_wildcard" .= qsAnalyzeWildcard
2500− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2501− , "minimum_should_match" .= qsMinimumShouldMatch
2502− , "lenient" .= qsLenient
2503− , "locale" .= qsLocale ]
2504−
2505−instance FromJSON QueryStringQuery where
2506− parseJSON = withObject "QueryStringQuery" parse
2507− where parse o = QueryStringQuery
2508− <$> o .: "query"
2509− <*> o .:? "default_field"
2510− <*> o .:? "default_operator"
2511− <*> o .:? "analyzer"
2512− <*> o .:? "allow_leading_wildcard"
2513− <*> o .:? "lowercase_expanded_terms"
2514− <*> o .:? "enable_position_increments"
2515− <*> o .:? "fuzzy_max_expansions"
2516− <*> o .:? "fuzziness"
2517− <*> o .:? "fuzzy_prefix_length"
2518− <*> o .:? "phrase_slop"
2519− <*> o .:? "boost"
2520− <*> o .:? "analyze_wildcard"
2521− <*> o .:? "auto_generate_phrase_queries"
2522− <*> o .:? "minimum_should_match"
2523− <*> o .:? "lenient"
2524− <*> o .:? "locale"
2525−
2526−instance ToJSON RangeQuery where
2527− toJSON (RangeQuery (FieldName fieldName) range boost) =
2528− object [ fieldName .= object conjoined ]
2529− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2530−
2531−instance FromJSON RangeQuery where
2532− parseJSON = withObject "RangeQuery" parse
2533− where parse = fieldTagged $ \fn o ->
2534− RangeQuery fn
2535− <$> parseJSON (Object o)
2536− <*> o .: "boost"
2537−
2538−instance FromJSON RangeValue where
2539− parseJSON = withObject "RangeValue" parse
2540− where parse o = parseDate o
2541− <|> parseDouble o
2542− parseDate o = do lt <- o .:? "lt"
2543− lte <- o .:? "lte"
2544− gt <- o .:? "gt"
2545− gte <- o .:? "gte"
2546− case (lt, lte, gt, gte) of
2547− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2548− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2549− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2550− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2551− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2552− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2553− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2554− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2555− (Nothing, Nothing, Nothing, Nothing) -> mzero
2556− parseDouble o = do lt <- o .:? "lt"
2557− lte <- o .:? "lte"
2558− gt <- o .:? "gt"
2559− gte <- o .:? "gte"
2560− case (lt, lte, gt, gte) of
2561− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2562− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2563− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2564− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2565− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2566− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2567− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2568− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2569− (Nothing, Nothing, Nothing, Nothing) -> mzero
2570−
2571−instance ToJSON PrefixQuery where
2572− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2573− object [ fieldName .= omitNulls base ]
2574− where base = [ "value" .= queryValue
2575− , "boost" .= boost ]
2576−
2577−instance FromJSON PrefixQuery where
2578− parseJSON = withObject "PrefixQuery" parse
2579− where parse = fieldTagged $ \fn o ->
2580− PrefixQuery fn
2581− <$> o .: "value"
2582− <*> o .:? "boost"
2583−
2584−instance ToJSON NestedQuery where
2585− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2586− object [ "path" .= nqPath
2587− , "score_mode" .= nqScoreType
2588− , "query" .= nqQuery ]
2589−
2590−instance FromJSON NestedQuery where
2591− parseJSON = withObject "NestedQuery" parse
2592− where parse o = NestedQuery
2593− <$> o .: "path"
2594− <*> o .: "score_mode"
2595− <*> o .: "query"
2596−
2597−instance ToJSON MoreLikeThisFieldQuery where
2598− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2599− percent mtf mqt stopwords mindf maxdf
2600− minwl maxwl boostTerms boost analyzer) =
2601− object [ fieldName .= omitNulls base ]
2602− where base = [ "like_text" .= text
2603− , "percent_terms_to_match" .= percent
2604− , "min_term_freq" .= mtf
2605− , "max_query_terms" .= mqt
2606− , "stop_words" .= stopwords
2607− , "min_doc_freq" .= mindf
2608− , "max_doc_freq" .= maxdf
2609− , "min_word_length" .= minwl
2610− , "max_word_length" .= maxwl
2611− , "boost_terms" .= boostTerms
2612− , "boost" .= boost
2613− , "analyzer" .= analyzer ]
2614−
2615−instance FromJSON MoreLikeThisFieldQuery where
2616− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2617− where parse = fieldTagged $ \fn o ->
2618− MoreLikeThisFieldQuery
2619− <$> o .: "like_text"
2620− <*> pure fn
2621− <*> o .:? "percent_terms_to_match"
2622− <*> o .:? "min_term_freq"
2623− <*> o .:? "max_query_terms"
2624− -- <*> (optionalNE =<< o .:? "stop_words")
2625− <*> o .:? "stop_words"
2626− <*> o .:? "min_doc_freq"
2627− <*> o .:? "max_doc_freq"
2628− <*> o .:? "min_word_length"
2629− <*> o .:? "max_word_length"
2630− <*> o .:? "boost_terms"
2631− <*> o .:? "boost"
2632− <*> o .:? "analyzer"
2633− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2634−
2635−instance ToJSON MoreLikeThisQuery where
2636− toJSON (MoreLikeThisQuery text fields percent
2637− mtf mqt stopwords mindf maxdf
2638− minwl maxwl boostTerms boost analyzer) =
2639− omitNulls base
2640− where base = [ "like_text" .= text
2641− , "fields" .= fields
2642− , "percent_terms_to_match" .= percent
2643− , "min_term_freq" .= mtf
2644− , "max_query_terms" .= mqt
2645− , "stop_words" .= stopwords
2646− , "min_doc_freq" .= mindf
2647− , "max_doc_freq" .= maxdf
2648− , "min_word_length" .= minwl
2649− , "max_word_length" .= maxwl
2650− , "boost_terms" .= boostTerms
2651− , "boost" .= boost
2652− , "analyzer" .= analyzer ]
2653−
2654−instance FromJSON MoreLikeThisQuery where
2655− parseJSON = withObject "MoreLikeThisQuery" parse
2656− where parse o = MoreLikeThisQuery
2657− <$> o .: "like_text"
2658− -- <*> (optionalNE =<< o .:? "fields")
2659− <*> o .:? "fields"
2660− <*> o .:? "percent_terms_to_match"
2661− <*> o .:? "min_term_freq"
2662− <*> o .:? "max_query_terms"
2663− -- <*> (optionalNE =<< o .:? "stop_words")
2664− <*> o .:? "stop_words"
2665− <*> o .:? "min_doc_freq"
2666− <*> o .:? "max_doc_freq"
2667− <*> o .:? "min_word_length"
2668− <*> o .:? "max_word_length"
2669− <*> o .:? "boost_terms"
2670− <*> o .:? "boost"
2671− <*> o .:? "analyzer"
2672− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2673−
2674−instance ToJSON IndicesQuery where
2675− toJSON (IndicesQuery indices query noMatch) =
2676− omitNulls [ "indices" .= indices
2677− , "no_match_query" .= noMatch
2678− , "query" .= query ]
2679−
2680−instance FromJSON IndicesQuery where
2681− parseJSON = withObject "IndicesQuery" parse
2682− where parse o = IndicesQuery
2683− <$> o .:? "indices" .!= []
2684− <*> o .: "query"
2685− <*> o .:? "no_match_query"
2686−
2687−instance ToJSON HasParentQuery where
2688− toJSON (HasParentQuery queryType query scoreType) =
2689− omitNulls [ "parent_type" .= queryType
2690− , "score_type" .= scoreType
2691− , "query" .= query ]
2692−
2693−instance FromJSON HasParentQuery where
2694− parseJSON = withObject "HasParentQuery" parse
2695− where parse o = HasParentQuery
2696− <$> o .: "parent_type"
2697− <*> o .: "query"
2698− <*> o .:? "score_type"
2699−
2700−instance ToJSON HasChildQuery where
2701− toJSON (HasChildQuery queryType query scoreType) =
2702− omitNulls [ "query" .= query
2703− , "score_type" .= scoreType
2704− , "type" .= queryType ]
2705−
2706−instance FromJSON HasChildQuery where
2707− parseJSON = withObject "HasChildQuery" parse
2708− where parse o = HasChildQuery
2709− <$> o .: "type"
2710− <*> o .: "query"
2711− <*> o .:? "score_type"
2712−
2713−instance ToJSON FuzzyQuery where
2714− toJSON (FuzzyQuery (FieldName fieldName) queryText
2715− prefixLength maxEx fuzziness boost) =
2716− object [ fieldName .= omitNulls base ]
2717− where base = [ "value" .= queryText
2718− , "fuzziness" .= fuzziness
2719− , "prefix_length" .= prefixLength
2720− , "boost" .= boost
2721− , "max_expansions" .= maxEx ]
2722−
2723−instance FromJSON FuzzyQuery where
2724− parseJSON = withObject "FuzzyQuery" parse
2725− where parse = fieldTagged $ \fn o ->
2726− FuzzyQuery fn
2727− <$> o .: "value"
2728− <*> o .: "prefix_length"
2729− <*> o .: "max_expansions"
2730− <*> o .: "fuzziness"
2731− <*> o .:? "boost"
2732−
2733−instance ToJSON FuzzyLikeFieldQuery where
2734− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2735− fieldText maxTerms ignoreFreq fuzziness prefixLength
2736− boost analyzer) =
2737− object [ fieldName .=
2738− omitNulls [ "like_text" .= fieldText
2739− , "max_query_terms" .= maxTerms
2740− , "ignore_tf" .= ignoreFreq
2741− , "fuzziness" .= fuzziness
2742− , "prefix_length" .= prefixLength
2743− , "analyzer" .= analyzer
2744− , "boost" .= boost ]]
2745−
2746−instance FromJSON FuzzyLikeFieldQuery where
2747− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2748− where parse = fieldTagged $ \fn o ->
2749− FuzzyLikeFieldQuery fn
2750− <$> o .: "like_text"
2751− <*> o .: "max_query_terms"
2752− <*> o .: "ignore_tf"
2753− <*> o .: "fuzziness"
2754− <*> o .: "prefix_length"
2755− <*> o .: "boost"
2756− <*> o .:? "analyzer"
2757−
2758−instance ToJSON FuzzyLikeThisQuery where
2759− toJSON (FuzzyLikeThisQuery fields text maxTerms
2760− ignoreFreq fuzziness prefixLength boost analyzer) =
2761− omitNulls base
2762− where base = [ "fields" .= fields
2763− , "like_text" .= text
2764− , "max_query_terms" .= maxTerms
2765− , "ignore_tf" .= ignoreFreq
2766− , "fuzziness" .= fuzziness
2767− , "prefix_length" .= prefixLength
2768− , "analyzer" .= analyzer
2769− , "boost" .= boost ]
2770−
2771−instance FromJSON FuzzyLikeThisQuery where
2772− parseJSON = withObject "FuzzyLikeThisQuery" parse
2773− where parse o = FuzzyLikeThisQuery
2774− <$> o .:? "fields" .!= []
2775− <*> o .: "like_text"
2776− <*> o .: "max_query_terms"
2777− <*> o .: "ignore_tf"
2778− <*> o .: "fuzziness"
2779− <*> o .: "prefix_length"
2780− <*> o .: "boost"
2781− <*> o .:? "analyzer"
2782−
2783−instance ToJSON FilteredQuery where
2784− toJSON (FilteredQuery query fFilter) =
2785− object [ "query" .= query
2786− , "filter" .= fFilter ]
2787−
2788−instance FromJSON FilteredQuery where
2789− parseJSON = withObject "FilteredQuery" parse
2790− where parse o = FilteredQuery
2791− <$> o .: "query"
2792− <*> o .: "filter"
2793−
2794−instance ToJSON DisMaxQuery where
2795− toJSON (DisMaxQuery queries tiebreaker boost) =
2796− omitNulls base
2797− where base = [ "queries" .= queries
2798− , "boost" .= boost
2799− , "tie_breaker" .= tiebreaker ]
2800−
2801−instance FromJSON DisMaxQuery where
2802− parseJSON = withObject "DisMaxQuery" parse
2803− where parse o = DisMaxQuery
2804− <$> o .:? "queries" .!= []
2805− <*> o .: "tie_breaker"
2806− <*> o .:? "boost"
2807−
2808−instance ToJSON CommonTermsQuery where
2809− toJSON (CommonTermsQuery (FieldName fieldName)
2810− (QueryString query) cf lfo hfo msm
2811− boost analyzer disableCoord) =
2812− object [fieldName .= omitNulls base ]
2813− where base = [ "query" .= query
2814− , "cutoff_frequency" .= cf
2815− , "low_freq_operator" .= lfo
2816− , "minimum_should_match" .= msm
2817− , "boost" .= boost
2818− , "analyzer" .= analyzer
2819− , "disable_coord" .= disableCoord
2820− , "high_freq_operator" .= hfo ]
2821−
2822−instance FromJSON CommonTermsQuery where
2823− parseJSON = withObject "CommonTermsQuery" parse
2824− where parse = fieldTagged $ \fn o ->
2825− CommonTermsQuery fn
2826− <$> o .: "query"
2827− <*> o .: "cutoff_frequency"
2828− <*> o .: "low_freq_operator"
2829− <*> o .: "high_freq_operator"
2830− <*> o .:? "minimum_should_match"
2831− <*> o .:? "boost"
2832− <*> o .:? "analyzer"
2833− <*> o .:? "disable_coord"
2834−
2835−instance ToJSON CommonMinimumMatch where
2836− toJSON (CommonMinimumMatch mm) = toJSON mm
2837− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2838− object [ "low_freq" .= lowF
2839− , "high_freq" .= highF ]
2840−
2841−instance FromJSON CommonMinimumMatch where
2842− parseJSON v = parseMinimum v
2843− <|> parseMinimumHighLow v
2844− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2845− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2846− MinimumMatchHighLow
2847− <$> o .: "low_freq"
2848− <*> o .: "high_freq")
2849−
2850−
2851−instance ToJSON BoostingQuery where
2852− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2853− object [ "positive" .= bqPositiveQuery
2854− , "negative" .= bqNegativeQuery
2855− , "negative_boost" .= bqNegativeBoost ]
2856−
2857−instance FromJSON BoostingQuery where
2858− parseJSON = withObject "BoostingQuery" parse
2859− where parse o = BoostingQuery
2860− <$> o .: "positive"
2861− <*> o .: "negative"
2862− <*> o .: "negative_boost"
2863−
2864−instance ToJSON BoolQuery where
2865− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
2866− omitNulls base
2867− where base = [ "must" .= mustM
2868− , "must_not" .= notM
2869− , "should" .= shouldM
2870− , "minimum_should_match" .= bqMin
2871− , "boost" .= boost
2872− , "disable_coord" .= disableCoord ]
2873−
2874−instance FromJSON BoolQuery where
2875− parseJSON = withObject "BoolQuery" parse
2876− where parse o = BoolQuery
2877− <$> o .:? "must" .!= []
2878− <*> o .:? "must_not" .!= []
2879− <*> o .:? "should" .!= []
2880− <*> o .:? "minimum_should_match"
2881− <*> o .:? "boost"
2882− <*> o .:? "disable_coord"
2883−
2884−instance ToJSON MatchQuery where
2885− toJSON (MatchQuery (FieldName fieldName)
2886− (QueryString mqQueryString) booleanOperator
2887− zeroTermsQuery cutoffFrequency matchQueryType
2888− analyzer maxExpansions lenient boost) =
2889− object [ fieldName .= omitNulls base ]
2890− where base = [ "query" .= mqQueryString
2891− , "operator" .= booleanOperator
2892− , "zero_terms_query" .= zeroTermsQuery
2893− , "cutoff_frequency" .= cutoffFrequency
2894− , "type" .= matchQueryType
2895− , "analyzer" .= analyzer
2896− , "max_expansions" .= maxExpansions
2897− , "lenient" .= lenient
2898− , "boost" .= boost ]
2899−
2900−instance FromJSON MatchQuery where
2901− parseJSON = withObject "MatchQuery" parse
2902− where parse = fieldTagged $ \fn o ->
2903− MatchQuery fn
2904− <$> o .: "query"
2905− <*> o .: "operator"
2906− <*> o .: "zero_terms_query"
2907− <*> o .:? "cutoff_frequency"
2908− <*> o .:? "type"
2909− <*> o .:? "analyzer"
2910− <*> o .:? "max_expansions"
2911− <*> o .:? "lenient"
2912− <*> o .:? "boost"
2913−
2914−instance ToJSON MultiMatchQuery where
2915− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2916− ztQ tb mmqt cf analyzer maxEx lenient) =
2917− object ["multi_match" .= omitNulls base]
2918− where base = [ "fields" .= fmap toJSON fields
2919− , "query" .= query
2920− , "operator" .= boolOp
2921− , "zero_terms_query" .= ztQ
2922− , "tiebreaker" .= tb
2923− , "type" .= mmqt
2924− , "cutoff_frequency" .= cf
2925− , "analyzer" .= analyzer
2926− , "max_expansions" .= maxEx
2927− , "lenient" .= lenient ]
2928−
2929−instance FromJSON MultiMatchQuery where
2930− parseJSON = withObject "MultiMatchQuery" parse
2931− where parse raw = do o <- raw .: "multi_match"
2932− MultiMatchQuery
2933− <$> o .:? "fields" .!= []
2934− <*> o .: "query"
2935− <*> o .: "operator"
2936− <*> o .: "zero_terms_query"
2937− <*> o .:? "tiebreaker"
2938− <*> o .:? "type"
2939− <*> o .:? "cutoff_frequency"
2940− <*> o .:? "analyzer"
2941− <*> o .:? "max_expansions"
2942− <*> o .:? "lenient"
2943−
2944−instance ToJSON MultiMatchQueryType where
2945− toJSON MultiMatchBestFields = "best_fields"
2946− toJSON MultiMatchMostFields = "most_fields"
2947− toJSON MultiMatchCrossFields = "cross_fields"
2948− toJSON MultiMatchPhrase = "phrase"
2949− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2950−
2951−instance FromJSON MultiMatchQueryType where
2952− parseJSON = withText "MultiMatchPhrasePrefix" parse
2953− where parse "best_fields" = pure MultiMatchBestFields
2954− parse "most_fields" = pure MultiMatchMostFields
2955− parse "cross_fields" = pure MultiMatchCrossFields
2956− parse "phrase" = pure MultiMatchPhrase
2957− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2958− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2959−
2960−instance ToJSON BooleanOperator where
2961− toJSON And = String "and"
2962− toJSON Or = String "or"
2963−
2964−instance FromJSON BooleanOperator where
2965− parseJSON = withText "BooleanOperator" parse
2966− where parse "and" = pure And
2967− parse "or" = pure Or
2968− parse o = fail ("Unexpected BooleanOperator: " <> show o)
2969−
2970−instance ToJSON ZeroTermsQuery where
2971− toJSON ZeroTermsNone = String "none"
2972− toJSON ZeroTermsAll = String "all"
2973−
2974−instance FromJSON ZeroTermsQuery where
2975− parseJSON = withText "ZeroTermsQuery" parse
2976− where parse "none" = pure ZeroTermsNone
2977− parse "all" = pure ZeroTermsAll
2978− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
2979−
2980−instance ToJSON MatchQueryType where
2981− toJSON MatchPhrase = "phrase"
2982− toJSON MatchPhrasePrefix = "phrase_prefix"
2983−
2984−instance FromJSON MatchQueryType where
2985− parseJSON = withText "MatchQueryType" parse
2986− where parse "phrase" = pure MatchPhrase
2987− parse "phrase_prefix" = pure MatchPhrasePrefix
2988− parse t = fail ("Unexpected MatchQueryType: " <> show t)
2989−
2990−instance FromJSON Status where
2991− parseJSON (Object v) = Status <$>
2992− v .:? "ok" <*>
2993− v .: "status" <*>
2994− v .: "name" <*>
2995− v .: "version" <*>
2996− v .: "tagline"
2997− parseJSON _ = empty
2998−
2999−
3000−instance ToJSON IndexSettings where
3001− toJSON (IndexSettings s r) = object ["settings" .=
3002− object ["index" .=
3003− object ["number_of_shards" .= s, "number_of_replicas" .= r]
3004− ]
3005− ]
3006−
3007−instance FromJSON IndexSettings where
3008− parseJSON = withObject "IndexSettings" parse
3009− where parse o = do s <- o .: "settings"
3010− i <- s .: "index"
3011− IndexSettings <$> i .: "number_of_shards"
3012− <*> i .: "number_of_replicas"
3013−
3014−instance ToJSON UpdatableIndexSetting where
3015− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3016− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3017− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3018− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3019− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3020− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3021− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3022− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3023− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3024− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3025− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3026− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3027− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3028− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3029− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3030− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3031− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3032− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3033− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3034− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3035− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3036− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3037− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3038− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3039− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3040− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3041− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3042− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3043−
3044−instance FromJSON UpdatableIndexSetting where
3045− parseJSON = withObject "UpdatableIndexSetting" parse
3046− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3047− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3048− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3049− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3050− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3051− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3052− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3053− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3054− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3055− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3056− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3057− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3058− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3059− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3060− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3061− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3062− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3063− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3064− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3065− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3066− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3067− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3068− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3069− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3070− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3071− <|> blocksRead `taggedAt` ["blocks", "read"]
3072− <|> blocksWrite `taggedAt` ["blocks", "write"]
3073− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3074− where taggedAt f ks = taggedAt' f (Object o) ks
3075− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3076− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3077− taggedAt' f v' ks) v
3078− numberOfReplicas = pure . NumberOfReplicas
3079− autoExpandReplicas = pure . AutoExpandReplicas
3080− refreshInterval = pure . RefreshInterval . ndtJSON
3081− indexConcurrency = pure . IndexConcurrency
3082− failOnMergeFailure = pure . FailOnMergeFailure
3083− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3084− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3085− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3086− translogDisableFlush = pure . TranslogDisableFlush
3087− cacheFilterMaxSize = pure . CacheFilterMaxSize
3088− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3089− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3090− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3091− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3092− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3093− routingAllocationEnable = pure . RoutingAllocationEnable
3094− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3095− recoveryInitialShards = pure . RecoveryInitialShards
3096− gcDeletes = pure . GCDeletes . ndtJSON
3097− ttlDisablePurge = pure . TTLDisablePurge
3098− translogFSType = pure . TranslogFSType
3099− compoundFormat = pure . IndexCompoundFormat
3100− compoundOnFlush = pure . IndexCompoundOnFlush
3101− warmerEnabled = pure . WarmerEnabled
3102− blocksReadOnly = pure . BlocksReadOnly
3103− blocksRead = pure . BlocksRead
3104− blocksWrite = pure . BlocksWrite
3105− blocksMetaData = pure . BlocksMetaData
3106−
3107−instance FromJSON IndexSettingsSummary where
3108− parseJSON = withObject "IndexSettingsSummary" parse
3109− where parse o = case HM.toList o of
3110− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3111− <$> parseJSON v
3112− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3113− _ -> fail "Expected single-key object with index name"
3114− redundant (NumberOfReplicas _) = True
3115− redundant _ = False
3116−
3117−-- | For some reason in several settings APIs, all leaf values get returned
3118−-- as strings. This function attepmts to recover from this for all
3119−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3120−unStringlyTypeJSON :: Value -> Value
3121−unStringlyTypeJSON (String "true") = Bool True
3122−unStringlyTypeJSON (String "false") = Bool False
3123−unStringlyTypeJSON (String "null") = Null
3124−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3125− Just n -> Number n
3126− Nothing -> v
3127−unStringlyTypeJSON v = v
3128−
3129−
3130−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3131−parseSettings o = do
3132− o' <- o .: "index"
3133− -- slice the index object into singleton hashmaps and try to parse each
3134− parses <- forM (HM.toList o') $ \(k, v) -> do
3135− -- blocks are now nested into the "index" key, which is not how they're serialized
3136− let atRoot = Object (HM.singleton k v)
3137− let atIndex = Object (HM.singleton "index" atRoot)
3138− optional (parseJSON atRoot <|> parseJSON atIndex)
3139− return (catMaybes parses)
3140−
3141−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3142−oPath (k :| []) v = object [k .= v]
3143−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3144−
3145−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3146−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3147− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3148−
3149−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3150−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3151− where parse o = case HM.toList o of
3152− [] -> fail "Expected non-empty list of NodeAttrFilters"
3153− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3154− parse' n = withText "Text" $ \t ->
3155− case T.splitOn "," t of
3156− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3157− [] -> fail "Expected non-empty list of filter values"
3158−
3159−instance ToJSON ReplicaBounds where
3160− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3161− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3162− toJSON ReplicasUnbounded = Bool False
3163−
3164−instance FromJSON ReplicaBounds where
3165− parseJSON v = withText "ReplicaBounds" parseText v
3166− <|> withBool "ReplicaBounds" parseBool v
3167− where parseText t = case T.splitOn "-" t of
3168− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3169− [a, b] -> ReplicasBounded <$> parseReadText a
3170− <*> parseReadText b
3171− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3172− parseBool False = pure ReplicasUnbounded
3173− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3174−
3175−instance ToJSON AllocationPolicy where
3176− toJSON AllocAll = String "all"
3177− toJSON AllocPrimaries = String "primaries"
3178− toJSON AllocNewPrimaries = String "new_primaries"
3179− toJSON AllocNone = String "none"
3180−
3181−instance FromJSON AllocationPolicy where
3182− parseJSON = withText "AllocationPolicy" parse
3183− where parse "all" = pure AllocAll
3184− parse "primaries" = pure AllocPrimaries
3185− parse "new_primaries" = pure AllocNewPrimaries
3186− parse "none" = pure AllocNone
3187− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3188−
3189−instance ToJSON InitialShardCount where
3190− toJSON QuorumShards = String "quorum"
3191− toJSON QuorumMinus1Shards = String "quorum-1"
3192− toJSON FullShards = String "full"
3193− toJSON FullMinus1Shards = String "full-1"
3194− toJSON (ExplicitShards x) = toJSON x
3195−
3196−instance FromJSON InitialShardCount where
3197− parseJSON v = withText "InitialShardCount" parseText v
3198− <|> ExplicitShards <$> parseJSON v
3199− where parseText "quorum" = pure QuorumShards
3200− parseText "quorum-1" = pure QuorumMinus1Shards
3201− parseText "full" = pure FullShards
3202− parseText "full-1" = pure FullMinus1Shards
3203− parseText _ = mzero
3204−
3205−instance ToJSON FSType where
3206− toJSON FSSimple = "simple"
3207− toJSON FSBuffered = "buffered"
3208−
3209−instance FromJSON FSType where
3210− parseJSON = withText "FSType" parse
3211− where parse "simple" = pure FSSimple
3212− parse "buffered" = pure FSBuffered
3213− parse t = fail ("Invalid FSType: " <> show t)
3214−
3215−instance ToJSON CompoundFormat where
3216− toJSON (CompoundFileFormat x) = Bool x
3217− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3218−
3219−instance FromJSON CompoundFormat where
3220− parseJSON v = CompoundFileFormat <$> parseJSON v
3221− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3222−
3223−instance ToJSON NominalDiffTimeJSON where
3224− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3225−
3226−instance FromJSON NominalDiffTimeJSON where
3227− parseJSON = withText "NominalDiffTime" parse
3228− where parse t = case T.takeEnd 1 t of
3229− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3230− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3231−
3232−instance ToJSON IndexTemplate where
3233− toJSON (IndexTemplate p s m) = merge
3234− (object [ "template" .= p
3235− , "mappings" .= foldl' merge (object []) m
3236− ])
3237− (toJSON s)
3238− where
3239− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3240− merge o Null = o
3241− merge _ _ = undefined
3242−
3243−instance (FromJSON a) => FromJSON (EsResult a) where
3244− parseJSON jsonVal@(Object v) = do
3245− found <- v .:? "found" .!= False
3246− fr <- if found
3247− then parseJSON jsonVal
3248− else return Nothing
3249− EsResult <$> v .: "_index" <*>
3250− v .: "_type" <*>
3251− v .: "_id" <*>
3252− pure fr
3253− parseJSON _ = empty
3254−
3255−instance (FromJSON a) => FromJSON (EsResultFound a) where
3256− parseJSON (Object v) = EsResultFound <$>
3257− v .: "_version" <*>
3258− v .: "_source"
3259− parseJSON _ = empty
3260−
3261−instance FromJSON EsError where
3262− parseJSON (Object v) = EsError <$>
3263− v .: "status" <*>
3264− v .: "error"
3265− parseJSON _ = empty
3266−
3267−instance FromJSON IndexAliasesSummary where
3268− parseJSON = withObject "IndexAliasesSummary" parse
3269− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3270− go ixn = withObject "index aliases" $ \ia -> do
3271− aliases <- ia .:? "aliases" .!= mempty
3272− forM (HM.toList aliases) $ \(aName, v) -> do
3273− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3274− IndexAliasSummary indexAlias <$> parseJSON v
3275−
3276−
3277−instance ToJSON IndexAliasAction where
3278− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3279− where Object iaObj = toJSON ia
3280− Object optsObj = toJSON opts
3281− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3282− where Object iaObj = toJSON ia
3283−
3284−instance ToJSON IndexAlias where
3285− toJSON IndexAlias {..} = object ["index" .= srcIndex
3286− , "alias" .= indexAlias
3287− ]
3288−
3289−instance ToJSON IndexAliasCreate where
3290− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3291− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3292− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3293−
3294−instance ToJSON AliasRouting where
3295− toJSON (AllAliasRouting v) = object ["routing" .= v]
3296− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3297− where prs = [("search_routing" .=) <$> srch
3298− ,("index_routing" .=) <$> idx]
3299−
3300−instance FromJSON AliasRouting where
3301− parseJSON = withObject "AliasRouting" parse
3302− where parse o = parseAll o <|> parseGranular o
3303− parseAll o = AllAliasRouting <$> o .: "routing"
3304− parseGranular o = do
3305− sr <- o .:? "search_routing"
3306− ir <- o .:? "index_routing"
3307− if isNothing sr && isNothing ir
3308− then fail "Both search_routing and index_routing can't be blank"
3309− else return (GranularAliasRouting sr ir)
3310−
3311−instance FromJSON IndexAliasCreate where
3312− parseJSON v = withObject "IndexAliasCreate" parse v
3313− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3314− <*> o .:? "filter"
3315−
3316−instance ToJSON SearchAliasRouting where
3317− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3318−
3319−instance FromJSON SearchAliasRouting where
3320− parseJSON = withText "SearchAliasRouting" parse
3321− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3322−
3323−instance ToJSON Search where
3324− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3325− omitNulls [ "query" .= query
3326− , "filter" .= sFilter
3327− , "sort" .= sort
3328− , "aggregations" .= searchAggs
3329− , "highlight" .= highlight
3330− , "from" .= sFrom
3331− , "size" .= sSize
3332− , "track_scores" .= sTrackSortScores
3333− , "fields" .= sFields
3334− , "_source" .= sSource]
3335−
3336−
3337−instance ToJSON Source where
3338− toJSON NoSource = toJSON False
3339− toJSON (SourcePatterns patterns) = toJSON patterns
3340− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3341−
3342−instance ToJSON PatternOrPatterns where
3343− toJSON (PopPattern pattern) = toJSON pattern
3344− toJSON (PopPatterns patterns) = toJSON patterns
3345−
3346−instance ToJSON Include where
3347− toJSON (Include patterns) = toJSON patterns
3348−
3349−instance ToJSON Exclude where
3350− toJSON (Exclude patterns) = toJSON patterns
3351−
3352−instance ToJSON Pattern where
3353− toJSON (Pattern pattern) = toJSON pattern
3354−
3355−
3356−instance ToJSON FieldHighlight where
3357− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3358− object [ fName .= fSettings ]
3359− toJSON (FieldHighlight (FieldName fName) Nothing) =
3360− object [ fName .= emptyObject ]
3361−
3362−instance ToJSON Highlights where
3363− toJSON (Highlights global fields) =
3364− omitNulls (("fields" .= fields)
3365− : highlightSettingsPairs global)
3366−
3367−instance ToJSON HighlightSettings where
3368− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3369−
3370−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3371−highlightSettingsPairs Nothing = []
3372−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3373−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3374−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3375−
3376−
3377−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3378−plainHighPairs Nothing = []
3379−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3380− [ "type" .= String "plain"]
3381− ++ commonHighlightPairs plCom
3382− ++ nonPostingsToPairs plNonPost
3383−
3384−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3385−postHighPairs Nothing = []
3386−postHighPairs (Just (PostingsHighlight pCom)) =
3387− ("type" .= String "postings")
3388− : commonHighlightPairs pCom
3389−
3390−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3391−fastVectorHighPairs Nothing = []
3392−fastVectorHighPairs (Just
3393− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3394− fvBoundMaxScan fvFragOff fvMatchedFields
3395− fvPhraseLim)) =
3396− [ "type" .= String "fvh"
3397− , "boundary_chars" .= fvBoundChars
3398− , "boundary_max_scan" .= fvBoundMaxScan
3399− , "fragment_offset" .= fvFragOff
3400− , "matched_fields" .= fvMatchedFields
3401− , "phraseLimit" .= fvPhraseLim]
3402− ++ commonHighlightPairs fvCom
3403− ++ nonPostingsToPairs fvNonPostSettings
3404−
3405−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3406−deleteSeveral ks hm = foldr HM.delete hm ks
3407−
3408−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3409−commonHighlightPairs Nothing = []
3410−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3411− chNoMatchSize chHighlightQuery
3412− chRequireFieldMatch)) =
3413− [ "order" .= chScore
3414− , "force_source" .= chForceSource
3415− , "encoder" .= chEncoder
3416− , "no_match_size" .= chNoMatchSize
3417− , "highlight_query" .= chHighlightQuery
3418− , "require_fieldMatch" .= chRequireFieldMatch]
3419− ++ highlightTagToPairs chTag
3420−
3421−
3422−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3423−nonPostingsToPairs Nothing = []
3424−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3425− [ "fragment_size" .= npFragSize
3426− , "number_of_fragments" .= npNumOfFrags]
3427−
3428−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3429−parseNEJSON [] = fail "Expected non-empty list"
3430−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3431−
3432−
3433−instance ToJSON HighlightEncoder where
3434− toJSON DefaultEncoder = String "default"
3435− toJSON HTMLEncoder = String "html"
3436−
3437−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3438−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3439−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3440− , "post_tags" .= post]
3441−highlightTagToPairs Nothing = []
3442−
3443−instance ToJSON SortSpec where
3444− toJSON (DefaultSortSpec
3445− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3446− dsSortMode dsMissingSort dsNestedFilter)) =
3447− object [dsSortFieldName .= omitNulls base] where
3448− base = [ "order" .= dsSortOrder
3449− , "ignore_unmapped" .= dsIgnoreUnmapped
3450− , "mode" .= dsSortMode
3451− , "missing" .= dsMissingSort
3452− , "nested_filter" .= dsNestedFilter ]
3453−
3454− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3455− object [ "unit" .= units
3456− , field .= gdsLatLon
3457− , "order" .= gdsSortOrder ]
3458−
3459−
3460−instance ToJSON SortOrder where
3461− toJSON Ascending = String "asc"
3462− toJSON Descending = String "desc"
3463−
3464−
3465−instance ToJSON SortMode where
3466− toJSON SortMin = String "min"
3467− toJSON SortMax = String "max"
3468− toJSON SortSum = String "sum"
3469− toJSON SortAvg = String "avg"
3470−
3471−
3472−instance ToJSON Missing where
3473− toJSON LastMissing = String "_last"
3474− toJSON FirstMissing = String "_first"
3475− toJSON (CustomMissing txt) = String txt
3476−
3477−
3478−instance ToJSON ScoreType where
3479− toJSON ScoreTypeMax = "max"
3480− toJSON ScoreTypeAvg = "avg"
3481− toJSON ScoreTypeSum = "sum"
3482− toJSON ScoreTypeNone = "none"
3483−
3484−instance FromJSON ScoreType where
3485− parseJSON = withText "ScoreType" parse
3486− where parse "max" = pure ScoreTypeMax
3487− parse "avg" = pure ScoreTypeAvg
3488− parse "sum" = pure ScoreTypeSum
3489− parse "none" = pure ScoreTypeNone
3490− parse t = fail ("Unexpected ScoreType: " <> show t)
3491−
3492−instance ToJSON Distance where
3493− toJSON (Distance dCoefficient dUnit) =
3494− String boltedTogether where
3495− coefText = showText dCoefficient
3496− (String unitText) = toJSON dUnit
3497− boltedTogether = mappend coefText unitText
3498−
3499−instance FromJSON Distance where
3500− parseJSON = withText "Distance" parse
3501− where parse t = Distance <$> parseCoeff nT
3502− <*> parseJSON (String unitT)
3503− where (nT, unitT) = T.span validForNumber t
3504− -- may be a better way to do this
3505− validForNumber '-' = True
3506− validForNumber '.' = True
3507− validForNumber 'e' = True
3508− validForNumber c = isNumber c
3509− parseCoeff "" = fail "Empty string cannot be parsed as number"
3510− parseCoeff s = return (read (T.unpack s))
3511−
3512−instance ToJSON DistanceUnit where
3513− toJSON Miles = String "mi"
3514− toJSON Yards = String "yd"
3515− toJSON Feet = String "ft"
3516− toJSON Inches = String "in"
3517− toJSON Kilometers = String "km"
3518− toJSON Meters = String "m"
3519− toJSON Centimeters = String "cm"
3520− toJSON Millimeters = String "mm"
3521− toJSON NauticalMiles = String "nmi"
3522−
3523−
3524−instance FromJSON DistanceUnit where
3525− parseJSON = withText "DistanceUnit" parse
3526− where parse "mi" = pure Miles
3527− parse "yd" = pure Yards
3528− parse "ft" = pure Feet
3529− parse "in" = pure Inches
3530− parse "km" = pure Kilometers
3531− parse "m" = pure Meters
3532− parse "cm" = pure Centimeters
3533− parse "mm" = pure Millimeters
3534− parse "nmi" = pure NauticalMiles
3535− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3536−
3537−instance ToJSON DistanceType where
3538− toJSON Arc = String "arc"
3539− toJSON SloppyArc = String "sloppy_arc"
3540− toJSON Plane = String "plane"
3541−
3542−instance FromJSON DistanceType where
3543− parseJSON = withText "DistanceType" parse
3544− where parse "arc" = pure Arc
3545− parse "sloppy_arc" = pure SloppyArc
3546− parse "plane" = pure Plane
3547− parse t = fail ("Unrecognized DistanceType: " <> show t)
3548−
3549−
3550−instance ToJSON OptimizeBbox where
3551− toJSON NoOptimizeBbox = String "none"
3552− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3553−
3554−instance FromJSON OptimizeBbox where
3555− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3556− <|> parseOptimize v
3557− where parseNoOptimize "none" = pure NoOptimizeBbox
3558− parseNoOptimize _ = mzero
3559− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3560−
3561−instance ToJSON GeoBoundingBoxConstraint where
3562− toJSON (GeoBoundingBoxConstraint
3563− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3564− object [gbbcGeoBBField .= gbbcConstraintBox
3565− , "_cache" .= cache
3566− , "type" .= type']
3567−
3568−instance FromJSON GeoBoundingBoxConstraint where
3569− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3570− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3571− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3572− <$> parseJSON v
3573− <*> o .:? "_cache" .!= defaultCache
3574− <*> o .: "type"
3575− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3576−
3577−instance ToJSON GeoFilterType where
3578− toJSON GeoFilterMemory = String "memory"
3579− toJSON GeoFilterIndexed = String "indexed"
3580−
3581−instance FromJSON GeoFilterType where
3582− parseJSON = withText "GeoFilterType" parse
3583− where parse "memory" = pure GeoFilterMemory
3584− parse "indexed" = pure GeoFilterIndexed
3585− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3586−
3587−instance ToJSON GeoBoundingBox where
3588− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3589− object ["top_left" .= gbbTopLeft
3590− , "bottom_right" .= gbbBottomRight]
3591−
3592−instance FromJSON GeoBoundingBox where
3593− parseJSON = withObject "GeoBoundingBox" parse
3594− where parse o = GeoBoundingBox
3595− <$> o .: "top_left"
3596− <*> o .: "bottom_right"
3597−
3598−instance ToJSON LatLon where
3599− toJSON (LatLon lLat lLon) =
3600− object ["lat" .= lLat
3601− , "lon" .= lLon]
3602−
3603−instance FromJSON LatLon where
3604− parseJSON = withObject "LatLon" parse
3605− where parse o = LatLon <$> o .: "lat"
3606− <*> o .: "lon"
3607−
3608−-- index for smaller ranges, fielddata for longer ranges
3609−instance ToJSON RangeExecution where
3610− toJSON RangeExecutionIndex = "index"
3611− toJSON RangeExecutionFielddata = "fielddata"
3612−
3613−
3614−instance FromJSON RangeExecution where
3615− parseJSON = withText "RangeExecution" parse
3616− where parse "index" = pure RangeExecutionIndex
3617− parse "fielddata" = pure RangeExecutionFielddata
3618− parse t = error ("Unrecognized RangeExecution " <> show t)
3619−
3620−instance ToJSON RegexpFlags where
3621− toJSON AllRegexpFlags = String "ALL"
3622− toJSON NoRegexpFlags = String "NONE"
3623− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3624− where flagStrs = map flagStr . nub $ h:fs
3625− flagStr AnyString = "ANYSTRING"
3626− flagStr Automaton = "AUTOMATON"
3627− flagStr Complement = "COMPLEMENT"
3628− flagStr Empty = "EMPTY"
3629− flagStr Intersection = "INTERSECTION"
3630− flagStr Interval = "INTERVAL"
3631−
3632−instance FromJSON RegexpFlags where
3633− parseJSON = withText "RegexpFlags" parse
3634− where parse "ALL" = pure AllRegexpFlags
3635− parse "NONE" = pure NoRegexpFlags
3636− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3637−
3638−instance FromJSON RegexpFlag where
3639− parseJSON = withText "RegexpFlag" parse
3640− where parse "ANYSTRING" = pure AnyString
3641− parse "AUTOMATON" = pure Automaton
3642− parse "COMPLEMENT" = pure Complement
3643− parse "EMPTY" = pure Empty
3644− parse "INTERSECTION" = pure Intersection
3645− parse "INTERVAL" = pure Interval
3646− parse f = fail ("Unknown RegexpFlag: " <> show f)
3647−
3648−instance ToJSON Term where
3649− toJSON (Term field value) = object ["term" .= object
3650− [field .= value]]
3651−
3652−instance FromJSON Term where
3653− parseJSON = withObject "Term" parse
3654− where parse o = do termObj <- o .: "term"
3655− case HM.toList termObj of
3656− [(fn, v)] -> Term fn <$> parseJSON v
3657− _ -> fail "Expected object with 1 field-named key"
3658−
3659−instance ToJSON BoolMatch where
3660− toJSON (MustMatch term cache) = object ["must" .= term,
3661− "_cache" .= cache]
3662− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3663− "_cache" .= cache]
3664− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3665− "_cache" .= cache]
3666−
3667−instance FromJSON BoolMatch where
3668− parseJSON = withObject "BoolMatch" parse
3669− where parse o = mustMatch `taggedWith` "must"
3670− <|> mustNotMatch `taggedWith` "must_not"
3671− <|> shouldMatch `taggedWith` "should"
3672− where taggedWith parser k = parser =<< o .: k
3673− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3674− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3675− 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)
3676528
3677529instance (FromJSON a) => FromJSON (SearchResult a) where
3678530 parseJSON (Object v) = SearchResult <$>
@@ -3681,874 +533,10 @@ instance (FromJSON a) => FromJSON (SearchResult a) where
3681533 v .: "_shards" <*>
3682534 v .: "hits" <*>
3683535 v .:? "aggregations" <*>
3684− v .:? "_scroll_id"
3685− parseJSON _ = empty
3686−
3687−instance (FromJSON a) => FromJSON (SearchHits a) where
3688− parseJSON (Object v) = SearchHits <$>
3689− v .: "total" <*>
3690− v .: "max_score" <*>
3691− v .: "hits"
3692− parseJSON _ = empty
3693−
3694−instance (FromJSON a) => FromJSON (Hit a) where
3695− parseJSON (Object v) = Hit <$>
3696− v .: "_index" <*>
3697− v .: "_type" <*>
3698− v .: "_id" <*>
3699− v .: "_score" <*>
3700− v .:? "_source" <*>
3701− v .:? "highlight"
536+ v .:? "_scroll_id" <*>
537+ v .:? "suggest"
3702538 parseJSON _ = empty
3703539
3704−instance FromJSON ShardResult where
3705− parseJSON (Object v) = ShardResult <$>
3706− v .: "total" <*>
3707− v .: "successful" <*>
3708− v .: "failed"
3709− parseJSON _ = empty
3710−
3711−
3712−instance FromJSON DocVersion where
3713− parseJSON v = do
3714− i <- parseJSON v
3715− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3716−
3717−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3718−instance FromJSON ReplicaCount where
3719− parseJSON v = parseAsInt v
3720− <|> parseAsString v
3721− where parseAsInt = fmap ReplicaCount . parseJSON
3722− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3723−
3724−instance FromJSON ShardCount where
3725− parseJSON v = parseAsInt v
3726− <|> parseAsString v
3727− where parseAsInt = fmap ShardCount . parseJSON
3728− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3729−
3730−instance Bounded DocVersion where
3731− minBound = DocVersion 1
3732− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3733−
3734−instance Enum DocVersion where
3735− succ x
3736− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3737− | otherwise = succError "DocVersion"
3738− pred x
3739− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3740− | otherwise = predError "DocVersion"
3741− toEnum i =
3742− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3743− fromEnum = docVersionNumber
3744− enumFrom = boundedEnumFrom
3745− enumFromThen = boundedEnumFromThen
3746−
3747−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3748−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3749−
3750−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3751−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3752−
3753−
3754−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3755− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3756−
3757−
3758−-- | Either specifies an exact repo name or one with globs in it,
3759−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3760−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3761− | RepoPattern Text
3762− deriving (Eq, Generic, Show, Typeable)
3763−
3764−-- | The unique name of a snapshot repository.
3765−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3766− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3767−
3768−
3769−-- | A generic representation of a snapshot repo. This is what gets
3770−-- sent to and parsed from the server. For repo types enabled by
3771−-- plugins that aren't exported by this library, consider making a
3772−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3773−-- type, consider submitting a pull request to have it included in the
3774−-- library proper
3775−data GenericSnapshotRepo = GenericSnapshotRepo {
3776− gSnapshotRepoName :: SnapshotRepoName
3777− , gSnapshotRepoType :: SnapshotRepoType
3778− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3779− } deriving (Eq, Generic, Show, Typeable)
3780−
3781−
3782−instance SnapshotRepo GenericSnapshotRepo where
3783− toGSnapshotRepo = id
3784− fromGSnapshotRepo = Right
3785−
3786−
3787−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3788− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3789−
3790−
3791−-- | Opaque representation of snapshot repo settings. Instances of
3792−-- 'SnapshotRepo' will produce this.
3793−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3794− deriving (Eq, Generic, Show, Typeable, ToJSON)
3795−
3796−
3797− -- Regardless of whether you send strongly typed json, my version of
3798− -- ES sends back stringly typed json in the settings, e.g. booleans
3799− -- as strings, so we'll try to convert them.
3800−instance FromJSON GenericSnapshotRepoSettings where
3801− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3802−
3803−-- | The result of running 'verifySnapshotRepo'.
3804−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3805− deriving (Eq, Generic, Show, Typeable)
3806−
3807−
3808−instance FromJSON SnapshotVerification where
3809− parseJSON = withObject "SnapshotVerification" parse
3810− where
3811− parse o = do
3812− o2 <- o .: "nodes"
3813− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3814− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3815− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3816−
3817−
3818−-- | A node that has verified a snapshot
3819−data SnapshotNodeVerification = SnapshotNodeVerification {
3820− snvFullId :: FullNodeId
3821− , snvNodeName :: NodeName
3822− } deriving (Eq, Generic, Show, Typeable)
3823−
3824−
3825−-- | Unique, automatically-generated name assigned to nodes that are
3826−-- usually returned in node-oriented APIs.
3827−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3828− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3829−
3830−
3831−-- | A human-readable node name that is supplied by the user in the
3832−-- node config or automatically generated by ElasticSearch.
3833−newtype NodeName = NodeName { nodeName :: Text }
3834− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3835−
3836−newtype ClusterName = ClusterName { clusterName :: Text }
3837− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3838−
3839−data NodesInfo = NodesInfo {
3840− nodesInfo :: [NodeInfo]
3841− , nodesClusterName :: ClusterName
3842− } deriving (Eq, Show, Generic, Typeable)
3843−
3844−-- | A quirky address format used throughout ElasticSearch. An example
3845−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
3846−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
3847−newtype EsAddress = EsAddress { esAddress :: Text }
3848− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3849−
3850−-- | Typically a 7 character hex string.
3851−newtype BuildHash = BuildHash { buildHash :: Text }
3852− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
3853−
3854−newtype PluginName = PluginName { pluginName :: Text }
3855− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3856−
3857−data NodeInfo = NodeInfo {
3858− nodeInfoHTTPAddress :: EsAddress
3859− , nodeInfoBuild :: BuildHash
3860− , nodeInfoESVersion :: VersionNumber
3861− , nodeInfoIP :: Server
3862− , nodeInfoHost :: Server
3863− , nodeInfoTransportAddress :: EsAddress
3864− , nodeInfoName :: NodeName
3865− , nodeInfoFullId :: FullNodeId
3866− , nodeInfoPlugins :: [NodePluginInfo]
3867− , nodeInfoHTTP :: NodeHTTPInfo
3868− , nodeInfoTransport :: NodeTransportInfo
3869− , nodeInfoNetwork :: NodeNetworkInfo
3870− , nodeInfoThreadPool :: NodeThreadPoolsInfo
3871− , nodeInfoJVM :: NodeJVMInfo
3872− , nodeInfoProcess :: NodeProcessInfo
3873− , nodeInfoOS :: NodeOSInfo
3874− , nodeInfoSettings :: Object
3875− -- ^ The members of the settings objects are not consistent,
3876− -- dependent on plugins, etc.
3877− } deriving (Eq, Show, Generic, Typeable)
3878−
3879−data NodePluginInfo = NodePluginInfo {
3880− nodePluginSite :: Bool
3881− -- ^ Is this a site plugin?
3882− , nodePluginJVM :: Bool
3883− -- ^ Is this plugin running on the JVM
3884− , nodePluginDescription :: Text
3885− , nodePluginVersion :: VersionNumber
3886− , nodePluginName :: PluginName
3887− } deriving (Eq, Show, Generic, Typeable)
3888−
3889−data NodeHTTPInfo = NodeHTTPInfo {
3890− nodeHTTPMaxContentLength :: Bytes
3891− , nodeHTTPTransportAddress :: BoundTransportAddress
3892− } deriving (Eq, Show, Generic, Typeable)
3893−
3894−data NodeTransportInfo = NodeTransportInfo {
3895− nodeTransportProfiles :: [BoundTransportAddress]
3896− , nodeTransportAddress :: BoundTransportAddress
3897− } deriving (Eq, Show, Generic, Typeable)
3898−
3899−data BoundTransportAddress = BoundTransportAddress {
3900− publishAddress :: EsAddress
3901− , boundAddress :: EsAddress
3902− } deriving (Eq, Show, Generic, Typeable)
3903−
3904−data NodeNetworkInfo = NodeNetworkInfo {
3905− nodeNetworkPrimaryInterface :: NodeNetworkInterface
3906− , nodeNetworkRefreshInterval :: NominalDiffTime
3907− } deriving (Eq, Show, Generic, Typeable)
3908−
3909−newtype MacAddress = MacAddress { macAddress :: Text }
3910− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3911−
3912−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
3913− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3914−
3915−data NodeNetworkInterface = NodeNetworkInterface {
3916− nodeNetIfaceMacAddress :: MacAddress
3917− , nodeNetIfaceName :: NetworkInterfaceName
3918− , nodeNetIfaceAddress :: Server
3919− } deriving (Eq, Show, Generic, Typeable)
3920−
3921−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
3922− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
3923− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
3924− , nodeThreadPoolsPercolate :: NodeThreadPoolInfo
3925− , nodeThreadPoolsListener :: NodeThreadPoolInfo
3926− , nodeThreadPoolsFetchShardStarted :: NodeThreadPoolInfo
3927− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
3928− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
3929− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
3930− , nodeThreadPoolsOptimize :: NodeThreadPoolInfo
3931− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
3932− , nodeThreadPoolsSuggest :: NodeThreadPoolInfo
3933− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
3934− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
3935− , nodeThreadPoolsGet :: NodeThreadPoolInfo
3936− , nodeThreadPoolsFetchShardStore :: NodeThreadPoolInfo
3937− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
3938− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
3939− } deriving (Eq, Show, Generic, Typeable)
3940−
3941−data NodeThreadPoolInfo = NodeThreadPoolInfo {
3942− nodeThreadPoolQueueSize :: ThreadPoolSize
3943− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
3944− , nodeThreadPoolMin :: Maybe Int
3945− , nodeThreadPoolMax :: Maybe Int
3946− , nodeThreadPoolType :: ThreadPoolType
3947− } deriving (Eq, Show, Generic, Typeable)
3948−
3949−data ThreadPoolSize = ThreadPoolBounded Int
3950− | ThreadPoolUnbounded
3951− deriving (Eq, Show, Generic, Typeable)
3952−
3953−data ThreadPoolType = ThreadPoolScaling
3954− | ThreadPoolFixed
3955− | ThreadPoolCached
3956− deriving (Eq, Show, Generic, Typeable)
3957−
3958−data NodeJVMInfo = NodeJVMInfo {
3959− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
3960− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
3961− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
3962− , nodeJVMInfoStartTime :: UTCTime
3963− , nodeJVMInfoVMVendor :: Text
3964− , nodeJVMVMVersion :: VersionNumber
3965− -- ^ JVM doesn't seme to follow normal version conventions
3966− , nodeJVMVMName :: Text
3967− , nodeJVMVersion :: VersionNumber
3968− , nodeJVMPID :: PID
3969− } deriving (Eq, Show, Generic, Typeable)
3970−
3971−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
3972−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
3973−
3974−data JVMMemoryInfo = JVMMemoryInfo {
3975− jvmMemoryInfoDirectMax :: Bytes
3976− , jvmMemoryInfoNonHeapMax :: Bytes
3977− , jvmMemoryInfoNonHeapInit :: Bytes
3978− , jvmMemoryInfoHeapMax :: Bytes
3979− , jvmMemoryInfoHeapInit :: Bytes
3980− } deriving (Eq, Show, Generic, Typeable)
3981−
3982−newtype JVMMemoryPool = JVMMemoryPool {
3983− jvmMemoryPool :: Text
3984− } deriving (Eq, Show, Generic, Typeable, FromJSON)
3985−
3986−newtype JVMGCCollector = JVMGCCollector {
3987− jvmGCCollector :: Text
3988− } deriving (Eq, Show, Generic, Typeable, FromJSON)
3989−
3990−newtype PID = PID {
3991− pid :: Int
3992− } deriving (Eq, Show, Generic, Typeable, FromJSON)
3993−
3994−data NodeOSInfo = NodeOSInfo {
3995− nodeOSSwap :: Bytes
3996− , nodeOSMem :: Bytes
3997− , nodeOSCPUInfo :: CPUInfo
3998− , nodeOSAvailableProcessors :: Int
3999− , nodeOSRefreshInterval :: NominalDiffTime
4000− } deriving (Eq, Show, Generic, Typeable)
4001−
4002−data CPUInfo = CPUInfo {
4003− cpuCacheSize :: Bytes
4004− , cpuCoresPerSocket :: Int
4005− , cpuTotalSockets :: Int
4006− , cpuTotalCores :: Int
4007− , cpuMHZ :: Int
4008− , cpuModel :: Text
4009− , cpuVendor :: Text
4010− } deriving (Eq, Show, Generic, Typeable)
4011−
4012−data NodeProcessInfo = NodeProcessInfo {
4013− nodeProcessMLockAll :: Bool
4014− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4015− , nodeProcessMaxFileDescriptors :: Int
4016− , nodeProcessId :: PID
4017− , nodeProcessRefreshInterval :: NominalDiffTime
4018− } deriving (Eq, Show, Generic, Typeable)
4019−
4020−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4021− repoUpdateVerify :: Bool
4022− -- ^ After creation/update, synchronously check that nodes can
4023− -- write to this repo. Defaults to True. You may use False if you
4024− -- need a faster response and plan on verifying manually later
4025− -- with 'verifySnapshotRepo'.
4026− } deriving (Eq, Show, Generic, Typeable)
4027−
4028−
4029−-- | Reasonable defaults for repo creation/update
4030−--
4031−-- * repoUpdateVerify True
4032−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4033−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4034−
4035−
4036−-- | A filesystem-based snapshot repo that ships with
4037−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4038−-- used with 'updateSnapshotRepo'
4039−data FsSnapshotRepo = FsSnapshotRepo {
4040− fsrName :: SnapshotRepoName
4041− , fsrLocation :: FilePath
4042− , fsrCompressMetadata :: Bool
4043− , fsrChunkSize :: Maybe Bytes
4044− -- ^ Size by which to split large files during snapshotting.
4045− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4046− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4047− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4048− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4049− } deriving (Eq, Generic, Show, Typeable)
4050−
4051−
4052−instance SnapshotRepo FsSnapshotRepo where
4053− toGSnapshotRepo FsSnapshotRepo {..} =
4054− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4055− where
4056− Object settings = object $ [ "location" .= fsrLocation
4057− , "compress" .= fsrCompressMetadata
4058− ] ++ optionalPairs
4059− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4060− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4061− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4062− ]
4063− fromGSnapshotRepo GenericSnapshotRepo {..}
4064− | gSnapshotRepoType == fsRepoType = do
4065− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4066− parseRepo $ do
4067− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4068− <*> o .:? "compress" .!= False
4069− <*> o .:? "chunk_size"
4070− <*> o .:? "max_restore_bytes_per_sec"
4071− <*> o .:? "max_snapshot_bytes_per_sec"
4072− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4073−
4074−
4075−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4076−parseRepo parser = case parseEither (const parser) () of
4077− Left e -> Left (OtherRepoConversionError (T.pack e))
4078− Right a -> Right a
4079−
4080−
4081−fsRepoType :: SnapshotRepoType
4082−fsRepoType = SnapshotRepoType "fs"
4083−
4084−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4085−class SnapshotRepo r where
4086− toGSnapshotRepo :: r -> GenericSnapshotRepo
4087− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4088−
4089−
4090−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4091− -- ^ Expected type and actual type
4092− | OtherRepoConversionError Text
4093− deriving (Show, Eq, Generic, Typeable)
4094−
4095−
4096−instance Exception SnapshotRepoConversionError
4097−
4098−
4099−data SnapshotCreateSettings = SnapshotCreateSettings {
4100− snapWaitForCompletion :: Bool
4101− -- ^ Should the API call return immediately after initializing
4102− -- the snapshot or wait until completed? Note that if this is
4103− -- enabled it could wait a long time, so you should adjust your
4104− -- 'ManagerSettings' accordingly to set long timeouts or
4105− -- explicitly handle timeouts.
4106− , snapIndices :: Maybe IndexSelection
4107− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4108− -- will essentially be a no-op snapshot.
4109− , snapIgnoreUnavailable :: Bool
4110− -- ^ If set to True, any matched indices that don't exist will be
4111− -- ignored. Otherwise it will be an error and fail.
4112− , snapIncludeGlobalState :: Bool
4113− , snapPartial :: Bool
4114− -- ^ If some indices failed to snapshot (e.g. if not all primary
4115− -- shards are available), should the process proceed?
4116− } deriving (Eq, Generic, Show, Typeable)
4117−
4118−
4119−-- | Reasonable defaults for snapshot creation
4120−--
4121−-- * snapWaitForCompletion False
4122−-- * snapIndices Nothing
4123−-- * snapIgnoreUnavailable False
4124−-- * snapIncludeGlobalState True
4125−-- * snapPartial False
4126−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4127−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4128− snapWaitForCompletion = False
4129− , snapIndices = Nothing
4130− , snapIgnoreUnavailable = False
4131− , snapIncludeGlobalState = True
4132− , snapPartial = False
4133− }
4134−
4135−
4136−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4137− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4138−
4139−
4140−-- | Either specifies an exact snapshot name or one with globs in it,
4141−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4142−-- ES < 1.7
4143−data SnapshotPattern = ExactSnap SnapshotName
4144− | SnapPattern Text
4145− deriving (Eq, Generic, Show, Typeable)
4146−
4147−
4148−-- | General information about the state of a snapshot. Has some
4149−-- redundancies with 'SnapshotStatus'
4150−data SnapshotInfo = SnapshotInfo {
4151− snapInfoShards :: ShardResult
4152− , snapInfoFailures :: [SnapshotShardFailure]
4153− , snapInfoDuration :: NominalDiffTime
4154− , snapInfoEndTime :: UTCTime
4155− , snapInfoStartTime :: UTCTime
4156− , snapInfoState :: SnapshotState
4157− , snapInfoIndices :: [IndexName]
4158− , snapInfoName :: SnapshotName
4159− } deriving (Eq, Generic, Show, Typeable)
4160−
4161−
4162−instance FromJSON SnapshotInfo where
4163− parseJSON = withObject "SnapshotInfo" parse
4164− where
4165− parse o = SnapshotInfo <$> o .: "shards"
4166− <*> o .: "failures"
4167− <*> (unMS <$> o .: "duration_in_millis")
4168− <*> (posixMS <$> o .: "end_time_in_millis")
4169− <*> (posixMS <$> o .: "start_time_in_millis")
4170− <*> o .: "state"
4171− <*> o .: "indices"
4172− <*> o .: "snapshot"
4173−
4174−data SnapshotShardFailure = SnapshotShardFailure {
4175− snapShardFailureIndex :: IndexName
4176− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4177− , snapShardFailureReason :: Text
4178− , snapShardFailureShardId :: ShardId
4179− } deriving (Eq, Show, Generic, Typeable)
4180−
4181−
4182−instance FromJSON SnapshotShardFailure where
4183− parseJSON = withObject "SnapshotShardFailure" parse
4184− where
4185− parse o = SnapshotShardFailure <$> o .: "index"
4186− <*> o .:? "node_id"
4187− <*> o .: "reason"
4188− <*> o .: "shard_id"
4189−
4190−
4191−newtype ShardId = ShardId { shardId :: Int }
4192− deriving (Eq, Show, Generic, Typeable, FromJSON)
4193−
4194−-- | Milliseconds
4195−newtype MS = MS NominalDiffTime
4196−
4197−
4198−-- keeps the unexported constructor warnings at bay
4199−unMS :: MS -> NominalDiffTime
4200−unMS (MS t) = t
4201−
4202−
4203−instance FromJSON MS where
4204− parseJSON = withScientific "MS" (return . MS . parse)
4205− where
4206− parse n = fromInteger ((truncate n) * 1000)
4207−
4208−
4209−data SnapshotState = SnapshotInit
4210− | SnapshotStarted
4211− | SnapshotSuccess
4212− | SnapshotFailed
4213− | SnapshotAborted
4214− | SnapshotMissing
4215− | SnapshotWaiting
4216− deriving (Show, Eq, Generic, Typeable)
4217−
4218−instance FromJSON SnapshotState where
4219− parseJSON = withText "SnapshotState" parse
4220− where
4221− parse "INIT" = return SnapshotInit
4222− parse "STARTED" = return SnapshotStarted
4223− parse "SUCCESS" = return SnapshotSuccess
4224− parse "FAILED" = return SnapshotFailed
4225− parse "ABORTED" = return SnapshotAborted
4226− parse "MISSING" = return SnapshotMissing
4227− parse "WAITING" = return SnapshotWaiting
4228− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4229−
4230−
4231−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4232− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4233−
4234−
4235−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4236− snapRestoreWaitForCompletion :: Bool
4237− -- ^ Should the API call return immediately after initializing
4238− -- the restore or wait until completed? Note that if this is
4239− -- enabled, it could wait a long time, so you should adjust your
4240− -- 'ManagerSettings' accordingly to set long timeouts or
4241− -- explicitly handle timeouts.
4242− , snapRestoreIndices :: Maybe IndexSelection
4243− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4244− -- permissable and will essentially be a no-op restore.
4245− , snapRestoreIgnoreUnavailable :: Bool
4246− -- ^ If set to True, any indices that do not exist will be ignored
4247− -- during snapshot rather than failing the restore.
4248− , snapRestoreIncludeGlobalState :: Bool
4249− -- ^ If set to false, will ignore any global state in the snapshot
4250− -- and will not restore it.
4251− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4252− -- ^ A regex pattern for matching indices. Used with
4253− -- 'snapRestoreRenameReplacement', the restore can reference the
4254− -- matched index and create a new index name upon restore.
4255− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4256− -- ^ Expression of how index renames should be constructed.
4257− , snapRestorePartial :: Bool
4258− -- ^ If some indices fail to restore, should the process proceed?
4259− , snapRestoreIncludeAliases :: Bool
4260− -- ^ Should the restore also restore the aliases captured in the
4261− -- snapshot.
4262− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4263− -- ^ Settings to apply during the restore process. __NOTE:__ This
4264− -- option is not supported in ES < 1.5 and should be set to
4265− -- Nothing in that case.
4266− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4267− -- ^ This type could be more rich but it isn't clear which
4268− -- settings are allowed to be ignored during restore, so we're
4269− -- going with including this feature in a basic form rather than
4270− -- omitting it. One example here would be
4271− -- "index.refresh_interval". Any setting specified here will
4272− -- revert back to the server default during the restore process.
4273− } deriving (Eq, Generic, Show, Typeable)
4274−
4275−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4276−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4277− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4278−
4279−
4280−-- | A single token in a index renaming scheme for a restore. These
4281−-- are concatenated into a string before being sent to
4282−-- ElasticSearch. Check out these Java
4283−-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
4284−data RestoreRenameToken = RRTLit Text
4285− -- ^ Just a literal string of characters
4286− | RRSubWholeMatch
4287− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4288− | RRSubGroup RRGroupRefNum
4289− -- ^ A specific reference to a group number
4290− deriving (Show, Eq, Generic, Typeable)
4291−
4292−
4293−-- | A group number for regex matching. Only values from 1-9 are
4294−-- supported. Construct with 'mkRRGroupRefNum'
4295−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4296− deriving (Show, Eq, Generic, Typeable, Ord)
4297−
4298−instance Bounded RRGroupRefNum where
4299− minBound = RRGroupRefNum 1
4300− maxBound = RRGroupRefNum 9
4301−
4302−
4303−-- | Only allows valid group number references (1-9).
4304−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4305−mkRRGroupRefNum i
4306− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4307− Just $ RRGroupRefNum i
4308− | otherwise = Nothing
4309−
4310−
4311−-- | Reasonable defaults for snapshot restores
4312−--
4313−-- * snapRestoreWaitForCompletion False
4314−-- * snapRestoreIndices Nothing
4315−-- * snapRestoreIgnoreUnavailable False
4316−-- * snapRestoreIncludeGlobalState True
4317−-- * snapRestoreRenamePattern Nothing
4318−-- * snapRestoreRenameReplacement Nothing
4319−-- * snapRestorePartial False
4320−-- * snapRestoreIncludeAliases True
4321−-- * snapRestoreIndexSettingsOverrides Nothing
4322−-- * snapRestoreIgnoreIndexSettings Nothing
4323−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4324−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4325− snapRestoreWaitForCompletion = False
4326− , snapRestoreIndices = Nothing
4327− , snapRestoreIgnoreUnavailable = False
4328− , snapRestoreIncludeGlobalState = True
4329− , snapRestoreRenamePattern = Nothing
4330− , snapRestoreRenameReplacement = Nothing
4331− , snapRestorePartial = False
4332− , snapRestoreIncludeAliases = True
4333− , snapRestoreIndexSettingsOverrides = Nothing
4334− , snapRestoreIgnoreIndexSettings = Nothing
4335− }
4336−
4337−
4338−-- | Index settings that can be overridden. The docs only mention you
4339−-- can update number of replicas, but there may be more. You
4340−-- definitely cannot override shard count.
4341−data RestoreIndexSettings = RestoreIndexSettings {
4342− restoreOverrideReplicas :: Maybe ReplicaCount
4343− } deriving (Show, Eq, Generic, Typeable)
4344−
4345−
4346−instance ToJSON RestoreIndexSettings where
4347− toJSON RestoreIndexSettings {..} = object prs
4348− where
4349− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4350−
4351−
4352−instance FromJSON NodesInfo where
4353− parseJSON = withObject "NodesInfo" parse
4354− where
4355− parse o = do
4356− nodes <- o .: "nodes"
4357− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4358− node <- parseJSON v
4359− parseNodeInfo (FullNodeId fullNID) node
4360− cn <- o .: "cluster_name"
4361− return (NodesInfo infos cn)
4362−
4363−
4364−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
4365−parseNodeInfo nid o =
4366− NodeInfo <$> o .: "http_address"
4367− <*> o .: "build"
4368− <*> o .: "version"
4369− <*> o .: "ip"
4370− <*> o .: "host"
4371− <*> o .: "transport_address"
4372− <*> o .: "name"
4373− <*> pure nid
4374− <*> o .: "plugins"
4375− <*> o .: "http"
4376− <*> o .: "transport"
4377− <*> o .: "network"
4378− <*> o .: "thread_pool"
4379− <*> o .: "jvm"
4380− <*> o .: "process"
4381− <*> o .: "os"
4382− <*> o .: "settings"
4383−
4384−instance FromJSON NodePluginInfo where
4385− parseJSON = withObject "NodePluginInfo" parse
4386− where
4387− parse o = NodePluginInfo <$> o .: "site"
4388− <*> o .: "jvm"
4389− <*> o .: "description"
4390− <*> o .: "version"
4391− <*> o .: "name"
4392−
4393−instance FromJSON NodeHTTPInfo where
4394− parseJSON = withObject "NodeHTTPInfo" parse
4395− where
4396− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
4397− <*> parseJSON (Object o)
4398−
4399−instance FromJSON BoundTransportAddress where
4400− parseJSON = withObject "BoundTransportAddress" parse
4401− where
4402− parse o = BoundTransportAddress <$> o .: "publish_address"
4403− <*> o .: "bound_address"
4404−
4405−instance FromJSON NodeOSInfo where
4406− parseJSON = withObject "NodeOSInfo" parse
4407− where
4408− parse o = do
4409− swap <- o .: "swap"
4410− mem <- o .: "mem"
4411− NodeOSInfo <$> swap .: "total_in_bytes"
4412− <*> mem .: "total_in_bytes"
4413− <*> o .: "cpu"
4414− <*> o .: "available_processors"
4415− <*> (unMS <$> o .: "refresh_interval_in_millis")
4416−
4417−
4418−instance FromJSON CPUInfo where
4419− parseJSON = withObject "CPUInfo" parse
4420− where
4421− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
4422− <*> o .: "cores_per_socket"
4423− <*> o .: "total_sockets"
4424− <*> o .: "total_cores"
4425− <*> o .: "mhz"
4426− <*> o .: "model"
4427− <*> o .: "vendor"
4428−
4429−instance FromJSON NodeProcessInfo where
4430− parseJSON = withObject "NodeProcessInfo" parse
4431− where
4432− parse o = NodeProcessInfo <$> o .: "mlockall"
4433− <*> o .: "max_file_descriptors"
4434− <*> o .: "id"
4435− <*> (unMS <$> o .: "refresh_interval_in_millis")
4436−
4437−instance FromJSON NodeJVMInfo where
4438− parseJSON = withObject "NodeJVMInfo" parse
4439− where
4440− parse o = NodeJVMInfo <$> o .: "memory_pools"
4441− <*> o .: "gc_collectors"
4442− <*> o .: "mem"
4443− <*> (posixMS <$> o .: "start_time_in_millis")
4444− <*> o .: "vm_vendor"
4445− <*> o .: "vm_version"
4446− <*> o .: "vm_name"
4447− <*> (unJVMVersion <$> o .: "version")
4448− <*> o .: "pid"
4449−
4450−instance FromJSON JVMVersion where
4451− parseJSON (String t) =
4452− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
4453− parseJSON v = JVMVersion <$> parseJSON v
4454−
4455−instance FromJSON JVMMemoryInfo where
4456− parseJSON = withObject "JVMMemoryInfo" parse
4457− where
4458− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
4459− <*> o .: "non_heap_max_in_bytes"
4460− <*> o .: "non_heap_init_in_bytes"
4461− <*> o .: "heap_max_in_bytes"
4462− <*> o .: "heap_init_in_bytes"
4463−
4464−instance FromJSON NodeThreadPoolsInfo where
4465− parseJSON = withObject "NodeThreadPoolsInfo" parse
4466− where
4467− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
4468− <*> o .: "management"
4469− <*> o .: "percolate"
4470− <*> o .: "listener"
4471− <*> o .: "fetch_shard_started"
4472− <*> o .: "search"
4473− <*> o .: "flush"
4474− <*> o .: "warmer"
4475− <*> o .: "optimize"
4476− <*> o .: "bulk"
4477− <*> o .: "suggest"
4478− <*> o .: "merge"
4479− <*> o .: "snapshot"
4480− <*> o .: "get"
4481− <*> o .: "fetch_shard_store"
4482− <*> o .: "index"
4483− <*> o .: "generic"
4484−
4485−instance FromJSON NodeThreadPoolInfo where
4486− parseJSON = withObject "NodeThreadPoolInfo" parse
4487− where
4488− parse o = do
4489− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
4490− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
4491− <*> pure ka
4492− <*> o .:? "min"
4493− <*> o .:? "max"
4494− <*> o .: "type"
4495−
4496−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
4497−parseStringInterval s = case span isNumber s of
4498− ("", _) -> fail "Invalid interval"
4499− (nS, unitS) -> case (readMay nS, readMay unitS) of
4500− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
4501− (Nothing, _) -> fail "Invalid interval number"
4502− (_, Nothing) -> fail "Invalid interval unit"
4503− where
4504− unitNDT Seconds = 1
4505− unitNDT Minutes = 60
4506− unitNDT Hours = 60 * 60
4507− unitNDT Days = 24 * 60 * 60
4508− unitNDT Weeks = 7 * 24 * 60 * 60
4509−
4510−instance FromJSON ThreadPoolSize where
4511− parseJSON v = parseAsNumber v <|> parseAsString v
4512− where
4513− parseAsNumber = parseAsInt <=< parseJSON
4514− parseAsInt (-1) = return ThreadPoolUnbounded
4515− parseAsInt n
4516− | n >= 0 = return (ThreadPoolBounded n)
4517− | otherwise = fail "Thread pool size must be >= -1."
4518− parseAsString = withText "ThreadPoolSize" $ \t ->
4519− case first (readMay . T.unpack) (T.span isNumber t) of
4520− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
4521− (Just n, "") -> return (ThreadPoolBounded n)
4522− _ -> fail ("Invalid thread pool size " <> T.unpack t)
4523−
4524−instance FromJSON ThreadPoolType where
4525− parseJSON = withText "ThreadPoolType" parse
4526− where
4527− parse "scaling" = return ThreadPoolScaling
4528− parse "fixed" = return ThreadPoolFixed
4529− parse "cached" = return ThreadPoolCached
4530− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
4531−
4532−instance FromJSON NodeTransportInfo where
4533− parseJSON = withObject "NodeTransportInfo" parse
4534− where
4535− parse o = NodeTransportInfo <$> (parseProfiles =<< o .: "profiles")
4536− <*> parseJSON (Object o)
4537− parseProfiles (Object o) | HM.null o = return []
4538− parseProfiles v@(Array _) = parseJSON v
4539− parseProfiles Null = return []
4540− parseProfiles _ = fail "Could not parse profiles"
4541−
4542−instance FromJSON NodeNetworkInfo where
4543− parseJSON = withObject "NodeNetworkInfo" parse
4544− where
4545− parse o = NodeNetworkInfo <$> o .: "primary_interface"
4546− <*> (unMS <$> o .: "refresh_interval_in_millis")
4547−
4548−
4549−instance FromJSON NodeNetworkInterface where
4550− parseJSON = withObject "NodeNetworkInterface" parse
4551− where
4552− parse o = NodeNetworkInterface <$> o .: "mac_address"
4553− <*> o .: "name"
4554− <*> o .: "address"
540+newtype ScrollId =
541+ ScrollId Text
542+ deriving (Eq, Show, Ord, ToJSON, FromJSON)