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