src/Database/Bloodhound/Types.hs · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on 90-markdown-bugs help sign in

typeable/bloodhound/src/Database/Bloodhound/Types.hs

3544 lines 153 kB history raw

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE NoMonomorphismRestriction #-}

8{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE RecordWildCards #-}

10{-# LANGUAGE UndecidableInstances #-}

12-------------------------------------------------------------------------------

13-- |

14-- Module : Database.Bloodhound.Types

16-- License : BSD-style (see the file LICENSE)

17-- Maintainer : Chris Allen <cma@bitemyapp.com

18-- Stability : provisional

19-- Portability : DeriveGeneric, RecordWildCards

20--

21-- Data types for describing actions and data structures performed to interact

22-- with Elasticsearch. The two main buckets your queries against Elasticsearch

23-- will fall into are 'Query's and 'Filter's. 'Filter's are more like

24-- traditional database constraints and often have preferable performance

25-- properties. 'Query's support human-written textual queries, such as fuzzy

26-- queries.

27-------------------------------------------------------------------------------

31module Database.Bloodhound.Types

32 ( defaultCache

33 , defaultIndexSettings

34 , defaultIndexDocumentSettings

35 , mkSort

36 , showText

37 , unpackId

38 , mkMatchQuery

39 , mkMultiMatchQuery

40 , mkBoolQuery

41 , mkRangeQuery

42 , mkQueryStringQuery

43 , mkAggregations

44 , mkTermsAggregation

45 , mkTermsScriptAggregation

46 , mkDateHistogram

47 , mkDocVersion

48 , docVersionNumber

49 , toTerms

50 , toDateHistogram

51 , omitNulls

52 , BH(..)

53 , runBH

54 , BHEnv

55 , bhServer

56 , bhManager

57 , bhRequestHook

58 , mkBHEnv

59 , MonadBH(..)

60 , Version(..)

61 , Status(..)

62 , Existence(..)

63 , NullValue(..)

64 , IndexSettings(..)

65 , UpdatableIndexSetting(..)

66 , IndexSettingsSummary(..)

67 , AllocationPolicy(..)

68 , ReplicaBounds(..)

69 , Bytes(..)

70 , FSType(..)

71 , InitialShardCount(..)

72 , NodeAttrFilter(..)

73 , NodeAttrName(..)

74 , CompoundFormat(..)

75 , IndexTemplate(..)

76 , Server(..)

77 , Reply

78 , EsResult(..)

79 , EsResultFound(..)

80 , EsError(..)

81 , EsProtocolException(..)

82 , IndexAlias(..)

83 , IndexAliasName(..)

84 , IndexAliasAction(..)

85 , IndexAliasCreate(..)

86 , IndexAliasSummary(..)

87 , IndexAliasesSummary(..)

88 , AliasRouting(..)

89 , SearchAliasRouting(..)

90 , IndexAliasRouting(..)

91 , RoutingValue(..)

92 , DocVersion

93 , ExternalDocVersion(..)

94 , VersionControl(..)

95 , DocumentParent(..)

96 , IndexDocumentSettings(..)

97 , Query(..)

98 , Search(..)

99 , SearchType(..)

100 , SearchResult(..)

101 , ScrollId(..)

102 , SearchHits(..)

103 , TrackSortScores

104 , From(..)

105 , Size(..)

106 , Source(..)

107 , PatternOrPatterns(..)

108 , Include(..)

109 , Exclude(..)

110 , Pattern(..)

111 , ShardResult(..)

112 , Hit(..)

113 , Filter(..)

114 , Seminearring(..)

115 , BoolMatch(..)

116 , Term(..)

117 , GeoPoint(..)

118 , GeoBoundingBoxConstraint(..)

119 , GeoBoundingBox(..)

120 , GeoFilterType(..)

121 , Distance(..)

122 , DistanceUnit(..)

123 , DistanceType(..)

124 , DistanceRange(..)

125 , OptimizeBbox(..)

126 , LatLon(..)

127 , RangeValue(..)

128 , RangeExecution(..)

129 , LessThan(..)

130 , LessThanEq(..)

131 , GreaterThan(..)

132 , GreaterThanEq(..)

133 , LessThanD(..)

134 , LessThanEqD(..)

135 , GreaterThanD(..)

136 , GreaterThanEqD(..)

137 , Regexp(..)

138 , RegexpFlags(..)

139 , RegexpFlag(..)

140 , FieldName(..)

141 , Script(..)

142 , IndexName(..)

143 , TemplateName(..)

144 , TemplatePattern(..)

145 , MappingName(..)

146 , DocId(..)

147 , CacheName(..)

148 , CacheKey(..)

149 , BulkOperation(..)

150 , ReplicaCount(..)

151 , ShardCount(..)

152 , Sort

153 , SortMode(..)

154 , SortOrder(..)

155 , SortSpec(..)

156 , DefaultSort(..)

157 , Missing(..)

158 , OpenCloseIndex(..)

159 , Method

160 , Boost(..)

161 , MatchQuery(..)

162 , MultiMatchQuery(..)

163 , BoolQuery(..)

164 , BoostingQuery(..)

165 , CommonTermsQuery(..)

166 , DisMaxQuery(..)

167 , FilteredQuery(..)

168 , FuzzyLikeThisQuery(..)

169 , FuzzyLikeFieldQuery(..)

170 , FuzzyQuery(..)

171 , HasChildQuery(..)

172 , HasParentQuery(..)

173 , IndicesQuery(..)

174 , MoreLikeThisQuery(..)

175 , MoreLikeThisFieldQuery(..)

176 , NestedQuery(..)

177 , PrefixQuery(..)

178 , QueryStringQuery(..)

179 , SimpleQueryStringQuery(..)

180 , RangeQuery(..)

181 , RegexpQuery(..)

182 , QueryString(..)

183 , BooleanOperator(..)

184 , ZeroTermsQuery(..)

185 , CutoffFrequency(..)

186 , Analyzer(..)

187 , MaxExpansions(..)

188 , Lenient(..)

189 , MatchQueryType(..)

190 , MultiMatchQueryType(..)

191 , Tiebreaker(..)

192 , MinimumMatch(..)

193 , DisableCoord(..)

194 , CommonMinimumMatch(..)

195 , MinimumMatchHighLow(..)

196 , PrefixLength(..)

197 , Fuzziness(..)

198 , IgnoreTermFrequency(..)

199 , MaxQueryTerms(..)

200 , ScoreType(..)

201 , Score

202 , Cache

203 , TypeName(..)

204 , BoostTerms(..)

205 , MaxWordLength(..)

206 , MinWordLength(..)

207 , MaxDocFrequency(..)

208 , MinDocFrequency(..)

209 , PhraseSlop(..)

210 , StopWord(..)

211 , QueryPath(..)

212 , MinimumTermFrequency(..)

213 , PercentMatch(..)

214 , FieldDefinition(..)

215 , MappingField(..)

216 , Mapping(..)

217 , AllowLeadingWildcard(..)

218 , LowercaseExpanded(..)

219 , GeneratePhraseQueries(..)

220 , Locale(..)

221 , AnalyzeWildcard(..)

222 , EnablePositionIncrements(..)

223 , SimpleQueryFlag(..)

224 , FieldOrFields(..)

225 , Monoid(..)

226 , ToJSON(..)

227 , Interval(..)

228 , TimeInterval(..)

229 , ExecutionHint(..)

230 , CollectionMode(..)

231 , TermOrder(..)

232 , TermInclusion(..)

233

234 , Aggregation(..)

235 , Aggregations

236 , AggregationResults

237 , Bucket(..)

238 , BucketAggregation(..)

239 , TermsAggregation(..)

240 , ValueCountAggregation(..)

241 , FilterAggregation(..)

242 , DateHistogramAggregation(..)

243 , DateRangeAggregation(..)

244 , DateRangeAggRange(..)

245 , DateMathExpr(..)

246 , DateMathAnchor(..)

247 , DateMathModifier(..)

248 , DateMathUnit(..)

249

250 , Highlights(..)

251 , FieldHighlight(..)

252 , HighlightSettings(..)

253 , PlainHighlight(..)

254 , PostingsHighlight(..)

255 , FastVectorHighlight(..)

256 , CommonHighlight(..)

257 , NonPostings(..)

258 , HighlightEncoder(..)

259 , HighlightTag(..)

260 , HitHighlight

261

262 , TermsResult(..)

263 , DateHistogramResult(..)

264 , DateRangeResult(..)

265

266 , EsUsername(..)

267 , EsPassword(..)

268 ) where

269

270import Control.Applicative

271import Control.Monad.Catch

272import Control.Monad.Except

273import Control.Monad.Reader

274import Control.Monad.State

275import Control.Monad.Writer

276import Data.Aeson

277import Data.Aeson.Types (Pair, Parser, emptyObject,

278 parseMaybe)

279import qualified Data.ByteString.Lazy.Char8 as L

280import Data.Char

281import Data.Hashable (Hashable)

282import qualified Data.HashMap.Strict as HM

283import Data.List (foldl', nub)

284import Data.List.NonEmpty (NonEmpty (..), toList)

285import qualified Data.Map.Strict as M

286import Data.Maybe

287import Data.Text (Text)

288import qualified Data.Text as T

289import Data.Time.Calendar

290import Data.Time.Clock (NominalDiffTime, UTCTime)

291import Data.Time.Clock.POSIX

292import qualified Data.Traversable as DT

293import Data.Typeable (Typeable)

294import qualified Data.Vector as V

295import GHC.Enum

296import GHC.Generics (Generic)

297import Network.HTTP.Client

298import qualified Network.HTTP.Types.Method as NHTM

299

300import Database.Bloodhound.Types.Class

301import Database.Bloodhound.Types.Internal

302

303-- $setup

304-- >>> :set -XOverloadedStrings

305-- >>> import Database.Bloodhound

306-- >>> let testServer = (Server "http://localhost:9200")

307-- >>> let testIndex = IndexName "twitter"

308-- >>> let testMapping = MappingName "tweet"

309-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

310

311-- defaultIndexSettings is exported by Database.Bloodhound as well

312-- no trailing slashes in servers, library handles building the path.

313

314-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook

315-- will be a noop. You can use the exported fields to customize it further, e.g.:

316--

317-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }

318mkBHEnv :: Server -> Manager -> BHEnv

319mkBHEnv s m = BHEnv s m return

320

321newtype BH m a = BH {

322 unBH :: ReaderT BHEnv m a

323 } deriving ( Functor

324 , Applicative

325 , Monad

326 , MonadIO

327 , MonadState s

328 , MonadWriter w

329 , MonadError e

330 , Alternative

331 , MonadPlus

332 , MonadFix

333 , MonadThrow

334 , MonadCatch

335 , MonadMask)

336

337instance MonadTrans BH where

338 lift = BH . lift

339

340instance (MonadReader r m) => MonadReader r (BH m) where

341 ask = lift ask

342 local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->

343 local f (m r)

344

345instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where

346 getBHEnv = BH getBHEnv

347

348runBH :: BHEnv -> BH m a -> m a

349runBH e f = runReaderT (unBH f) e

350

351{-| 'Version' is embedded in 'Status' -}

352data Version = Version { number :: Text

353 , build_hash :: Text

354 , build_timestamp :: UTCTime

355 , build_snapshot :: Bool

356 , lucene_version :: Text } deriving (Eq, Show, Generic, Typeable)

357

358{-| 'Status' is a data type for describing the JSON body returned by

359 Elasticsearch when you query its status. This was deprecated in 1.2.0.

360

361 <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>

362-}

363

364data Status = Status { ok :: Maybe Bool

365 , status :: Int

366 , name :: Text

367 , version :: Version

368 , tagline :: Text } deriving (Eq, Show, Generic)

369

370{-| 'IndexSettings' is used to configure the shards and replicas when you create

371 an Elasticsearch Index.

372

373 <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>

374-}

375

376data IndexSettings =

377 IndexSettings { indexShards :: ShardCount

378 , indexReplicas :: ReplicaCount } deriving (Eq, Show, Generic, Typeable)

379

380{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}

381defaultIndexSettings :: IndexSettings

382defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

383

384{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.

385

386 <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>

387-}

388data UpdatableIndexSetting = NumberOfReplicas ReplicaCount

389 -- ^ The number of replicas each shard has.

390 | AutoExpandReplicas ReplicaBounds

391 | BlocksReadOnly Bool

392 -- ^ Set to True to have the index read only. False to allow writes and metadata changes.

393 | BlocksRead Bool

394 -- ^ Set to True to disable read operations against the index.

395 | BlocksWrite Bool

396 -- ^ Set to True to disable write operations against the index.

397 | BlocksMetaData Bool

398 -- ^ Set to True to disable metadata operations against the index.

399 | RefreshInterval NominalDiffTime

400 -- ^ The async refresh interval of a shard

401 | IndexConcurrency Int

402 | FailOnMergeFailure Bool

403 | TranslogFlushThresholdOps Int

404 -- ^ When to flush on operations.

405 | TranslogFlushThresholdSize Bytes

406 -- ^ When to flush based on translog (bytes) size.

407 | TranslogFlushThresholdPeriod NominalDiffTime

408 -- ^ When to flush based on a period of not flushing.

409 | TranslogDisableFlush Bool

410 -- ^ Disables flushing. Note, should be set for a short interval and then enabled.

411 | CacheFilterMaxSize (Maybe Bytes)

412 -- ^ The maximum size of filter cache (per segment in shard).

413 | CacheFilterExpire (Maybe NominalDiffTime)

414 -- ^ The expire after access time for filter cache.

415 | GatewaySnapshotInterval NominalDiffTime

416 -- ^ The gateway snapshot interval (only applies to shared gateways).

417 | RoutingAllocationInclude (NonEmpty NodeAttrFilter)

418 -- ^ A node matching any rule will be allowed to host shards from the index.

419 | RoutingAllocationExclude (NonEmpty NodeAttrFilter)

420 -- ^ A node matching any rule will NOT be allowed to host shards from the index.

421 | RoutingAllocationRequire (NonEmpty NodeAttrFilter)

422 -- ^ Only nodes matching all rules will be allowed to host shards from the index.

423 | RoutingAllocationEnable AllocationPolicy

424 -- ^ Enables shard allocation for a specific index.

425 | RoutingAllocationShardsPerNode ShardCount

426 -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.

427 | RecoveryInitialShards InitialShardCount

428 -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.

429 | GCDeletes NominalDiffTime

430 | TTLDisablePurge Bool

431 -- ^ Disables temporarily the purge of expired docs.

432 | TranslogFSType FSType

433 | IndexCompoundFormat CompoundFormat

434 | IndexCompoundOnFlush Bool

435 | WarmerEnabled Bool

436 deriving (Eq, Show, Generic, Typeable)

437

438data AllocationPolicy = AllocAll

439 -- ^ Allows shard allocation for all shards.

440 | AllocPrimaries

441 -- ^ Allows shard allocation only for primary shards.

442 | AllocNewPrimaries

443 -- ^ Allows shard allocation only for primary shards for new indices.

444 | AllocNone

445 -- ^ No shard allocation is allowed

446 deriving (Eq, Show, Generic, Typeable)

447

448data ReplicaBounds = ReplicasBounded Int Int

449 | ReplicasLowerBounded Int

450 | ReplicasUnbounded

451 deriving (Eq, Show, Generic, Typeable)

452

453newtype Bytes = Bytes Int deriving (Eq, Show, Generic, Typeable, Ord, ToJSON, FromJSON)

454

455data FSType = FSSimple

456 | FSBuffered deriving (Eq, Show, Generic, Typeable, Ord)

457

458data InitialShardCount = QuorumShards

459 | QuorumMinus1Shards

460 | FullShards

461 | FullMinus1Shards

462 | ExplicitShards Int

463 deriving (Eq, Show, Generic, Typeable)

464

465data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName

466 , nodeAttrFilterValues :: NonEmpty Text}

467 deriving (Eq, Show, Generic, Ord)

468

469newtype NodeAttrName = NodeAttrName Text deriving (Eq, Show, Ord, Generic, Typeable)

470

471data CompoundFormat = CompoundFileFormat Bool

472 | MergeSegmentVsTotalIndex Double

473 -- ^ percentage between 0 and 1 where 0 is false, 1 is true

474 deriving (Eq, Show, Generic, Typeable)

475

476newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }

477

478data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName

479 , sSummaryFixedSettings :: IndexSettings

480 , sSummaryUpdateable :: [UpdatableIndexSetting]}

481 deriving (Eq, Show, Generic, Typeable)

482

483{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}

484type Reply = Network.HTTP.Client.Response L.ByteString

485type Method = NHTM.Method

486

487{-| 'OpenCloseIndex' is a sum type for opening and closing indices.

488

489 <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>

490-}

491data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show, Generic, Typeable)

492

493data FieldType = GeoPointType

494 | GeoShapeType

495 | FloatType

496 | IntegerType

497 | LongType

498 | ShortType

499 | ByteType deriving (Eq, Show, Generic, Typeable)

500

501data FieldDefinition =

502 FieldDefinition { fieldType :: FieldType } deriving (Eq, Show, Generic, Typeable)

503

504{-| An 'IndexTemplate' defines a template that will automatically be

505 applied to new indices created. The templates include both

506 'IndexSettings' and mappings, and a simple 'TemplatePattern' that

507 controls if the template will be applied to the index created.

508 Specify mappings as follows: @[toJSON TweetMapping, ...]@

509

510 https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html

511-}

512data IndexTemplate =

513 IndexTemplate { templatePattern :: TemplatePattern

514 , templateSettings :: Maybe IndexSettings

515 , templateMappings :: [Value]

516 }

517

518data MappingField =

519 MappingField { mappingFieldName :: FieldName

520 , fieldDefinition :: FieldDefinition } deriving (Eq, Show, Generic, Typeable)

521

522{-| Support for type reification of 'Mapping's is currently incomplete, for

523 now the mapping API verbiage expects a 'ToJSON'able blob.

524

525 Indexes have mappings, mappings are schemas for the documents contained in the

526 index. I'd recommend having only one mapping per index, always having a mapping,

527 and keeping different kinds of documents separated if possible.

528-}

529data Mapping = Mapping { typeName :: TypeName

530 , mappingFields :: [MappingField] } deriving (Eq, Show, Generic, Typeable)

531

532{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk

533 operation index, create, delete, and update. 'BulkIndex' behaves like an

534 "upsert", 'BulkCreate' will fail if a document already exists at the DocId.

535

536 <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>

537-}

538data BulkOperation =

539 BulkIndex IndexName MappingName DocId Value

540 | BulkCreate IndexName MappingName DocId Value

541 | BulkDelete IndexName MappingName DocId

542 | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show, Generic, Typeable)

543

544{-| 'EsResult' describes the standard wrapper JSON document that you see in

545 successful Elasticsearch lookups or lookups that couldn't find the document.

546-}

547data EsResult a = EsResult { _index :: Text

548 , _type :: Text

549 , _id :: Text

550 , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show, Generic, Typeable)

551

552{-| 'EsResultFound' contains the document and its metadata inside of an

553 'EsResult' when the document was successfully found.

554-}

555data EsResultFound a = EsResultFound { _version :: DocVersion

556 , _source :: a } deriving (Eq, Show, Generic, Typeable)

557

558{-| 'EsError' is the generic type that will be returned when there was a

559 problem. If you can't parse the expected response, its a good idea to

560 try parsing this.

561-}

562data EsError = EsError { errorStatus :: Int

563 , errorMessage :: Text } deriving (Eq, Show, Generic, Typeable)

564

565{-| 'EsProtocolException' ideally should never be thrown. It will only

566be thrown when Bloodhound can't parse a response returned by the

567ElasticSearch server. This should be reported as a bug to the bug

568tracker. Be sure to include the body.

569-}

570data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }

571 deriving (Eq, Show, Generic, Typeable)

572

573instance Exception EsProtocolException

574

575data IndexAlias = IndexAlias { srcIndex :: IndexName

576 , indexAlias :: IndexAliasName } deriving (Eq, Show, Generic, Typeable)

577

578newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Show, Generic, ToJSON)

579

580data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate

581 | RemoveAlias IndexAlias deriving (Show, Eq, Generic, Typeable)

582

583data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting

584 , aliasCreateFilter :: Maybe Filter}

585 deriving (Show, Eq, Generic, Typeable)

586

587data AliasRouting = AllAliasRouting RoutingValue

588 | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)

589 deriving (Show, Eq, Generic, Typeable)

590

591newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Show, Eq, Generic, Typeable)

592

593newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Show, Eq, Generic, ToJSON, FromJSON, Typeable)

594

595newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Show, Eq, Generic, ToJSON, FromJSON, Typeable)

596

597newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Show, Eq, Generic, Typeable)

598

599{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}

600data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias

601 , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Show, Eq, Generic, Typeable)

602

603{-| 'DocVersion' is an integer version number for a document between 1

604and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.

605-}

606newtype DocVersion = DocVersion {

607 docVersionNumber :: Int

608 } deriving (Eq, Show, Generic, Ord, ToJSON)

609

610-- | Smart constructor for in-range doc version

611mkDocVersion :: Int -> Maybe DocVersion

612mkDocVersion i

613 | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =

614 Just $ DocVersion i

615 | otherwise = Nothing

616

617

618{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its

619own version numbers instead of ones from ES.

620-}

621newtype ExternalDocVersion = ExternalDocVersion DocVersion

622 deriving (Eq, Show, Generic, Ord, Bounded, Enum, ToJSON)

623

624{-| 'VersionControl' is specified when indexing documents as a

625optimistic concurrency control.

626-}

627data VersionControl = NoVersionControl

628 -- ^ Don't send a version. This is a pure overwrite.

629 | InternalVersion DocVersion

630 -- ^ Use the default ES versioning scheme. Only

631 -- index the document if the version is the same

632 -- as the one specified. Only applicable to

633 -- updates, as you should be getting Version from

634 -- a search result.

635 | ExternalGT ExternalDocVersion

636 -- ^ Use your own version numbering. Only index

637 -- the document if the version is strictly higher

638 -- OR the document doesn't exist. The given

639 -- version will be used as the new version number

640 -- for the stored document. N.B. All updates must

641 -- increment this number, meaning there is some

642 -- global, external ordering of updates.

643 | ExternalGTE ExternalDocVersion

644 -- ^ Use your own version numbering. Only index

645 -- the document if the version is equal or higher

646 -- than the stored version. Will succeed if there

647 -- is no existing document. The given version will

648 -- be used as the new version number for the

649 -- stored document. Use with care, as this could

650 -- result in data loss.

651 | ForceVersion ExternalDocVersion

652 -- ^ The document will always be indexed and the

653 -- given version will be the new version. This is

654 -- typically used for correcting errors. Use with

655 -- care, as this could result in data loss.

656 deriving (Show, Eq, Generic, Ord)

657

658{-| 'DocumentParent' is used to specify a parent document.

659-}

660newtype DocumentParent = DocumentParent DocId

661 deriving (Eq, Show, Generic, Typeable)

662

663{-| 'IndexDocumentSettings' are special settings supplied when indexing

664a document. For the best backwards compatiblity when new fields are

665added, you should probably prefer to start with 'defaultIndexDocumentSettings'

666-}

667data IndexDocumentSettings =

668 IndexDocumentSettings { idsVersionControl :: VersionControl

669 , idsParent :: Maybe DocumentParent

670 } deriving (Eq, Show, Generic, Typeable)

671

672{-| Reasonable default settings. Chooses no version control and no parent.

673-}

674defaultIndexDocumentSettings :: IndexDocumentSettings

675defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing

676

677{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order

678 dependent with later sorts acting as tie-breakers for earlier sorts.

679-}

680type Sort = [SortSpec]

681

682{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and

683 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and

684 'DistanceUnit' to express "nearness" to a single geographical point as a

685 sort specification.

686

687<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>

688-}

689data SortSpec = DefaultSortSpec DefaultSort

690 | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show, Generic, Typeable)

691

692{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a

693 'mkSort' convenience function for when you want to specify only the most

694 common parameters.

695

696<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>

697-}

698data DefaultSort =

699 DefaultSort { sortFieldName :: FieldName

700 , sortOrder :: SortOrder

701 -- default False

702 , ignoreUnmapped :: Bool

703 , sortMode :: Maybe SortMode

704 , missingSort :: Maybe Missing

705 , nestedFilter :: Maybe Filter } deriving (Eq, Show, Generic, Typeable)

706

707{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get

708 encoded into "asc" or "desc" when turned into JSON.

709

710<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>

711-}

712data SortOrder = Ascending

713 | Descending deriving (Eq, Show, Generic, Typeable)

714

715{-| 'Missing' prescribes how to handle missing fields. A missing field can be

716 sorted last, first, or using a custom value as a substitute.

717

718<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>

719-}

720data Missing = LastMissing

721 | FirstMissing

722 | CustomMissing Text deriving (Eq, Show, Generic, Typeable)

723

724{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.

725

726http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option

727-}

728data SortMode = SortMin

729 | SortMax

730 | SortSum

731 | SortAvg deriving (Eq, Show, Generic, Typeable)

732

733{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so

734 that you can concisely describe the usual kind of 'SortSpec's you want.

735-}

736mkSort :: FieldName -> SortOrder -> DefaultSort

737mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing

738

739{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.

740 'Query's cannot be cached.

741-}

742type Cache = Bool -- caching on/off

743defaultCache :: Cache

744defaultCache = False

745

746{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.

747-}

748type PrefixValue = Text

749

750{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible

751 JSON encoding baked in. Used all over the place.

752-}

753data BooleanOperator = And | Or deriving (Eq, Show, Generic, Typeable)

754

755{-| 'ShardCount' is part of 'IndexSettings'

756-}

757newtype ShardCount = ShardCount Int deriving (Eq, Show, Generic, ToJSON, Typeable)

758

759{-| 'ReplicaCount' is part of 'IndexSettings'

760-}

761newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic, ToJSON, Typeable)

762

763{-| 'IndexName' is used to describe which index to query/create/delete

764-}

765newtype IndexName = IndexName Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)

766

767{-| 'TemplateName' is used to describe which template to query/create/delete

768-}

769newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

770

771{-| 'TemplatePattern' represents a pattern which is matched against index names

772-}

773newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

774

775{-| 'MappingName' is part of mappings which are how ES describes and schematizes

776 the data in the indices.

777-}

778newtype MappingName = MappingName Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)

779

780{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.

781 Can be set by the user or created by ES itself. Often used in client

782 functions for poking at specific documents.

783-}

784newtype DocId = DocId Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)

785

786{-| 'QueryString' is used to wrap query text bodies, be they human written or not.

787-}

788newtype QueryString = QueryString Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable)

789

790{-| 'FieldName' is used all over the place wherever a specific field within

791 a document needs to be specified, usually in 'Query's or 'Filter's.

792-}

793newtype FieldName = FieldName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

794

795

796{-| 'Script' is often used in place of 'FieldName' to specify more

797complex ways of extracting a value from a document.

798-}

799newtype Script = Script { scriptText :: Text } deriving (Eq, Show, Generic, Typeable)

800

801{-| 'CacheName' is used in 'RegexpFilter' for describing the

802 'CacheKey' keyed caching behavior.

803-}

804newtype CacheName = CacheName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

805

806{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.

807-}

808newtype CacheKey =

809 CacheKey Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

810newtype Existence =

811 Existence Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

812newtype NullValue =

813 NullValue Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

814newtype CutoffFrequency =

815 CutoffFrequency Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

816newtype Analyzer =

817 Analyzer Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

818newtype MaxExpansions =

819 MaxExpansions Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

820

821{-| 'Lenient', if set to true, will cause format based failures to be

822 ignored. I don't know what the bloody default is, Elasticsearch

823 documentation didn't say what it was. Let me know if you figure it out.

824-}

825newtype Lenient =

826 Lenient Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

827newtype Tiebreaker =

828 Tiebreaker Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

829newtype Boost =

830 Boost Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

831newtype BoostTerms =

832 BoostTerms Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

833

834{-| 'MinimumMatch' controls how many should clauses in the bool query should

835 match. Can be an absolute value (2) or a percentage (30%) or a

836 combination of both.

837-}

838newtype MinimumMatch =

839 MinimumMatch Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

840newtype DisableCoord =

841 DisableCoord Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

842newtype IgnoreTermFrequency =

843 IgnoreTermFrequency Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

844newtype MinimumTermFrequency =

845 MinimumTermFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

846newtype MaxQueryTerms =

847 MaxQueryTerms Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

848newtype Fuzziness =

849 Fuzziness Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

850

851{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}

852newtype PrefixLength =

853 PrefixLength Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

854newtype TypeName =

855 TypeName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

856newtype PercentMatch =

857 PercentMatch Double deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

858newtype StopWord =

859 StopWord Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

860newtype QueryPath =

861 QueryPath Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

862

863{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly

864 heavy, because all terms in the index need to be examined, just in case

865 they match. Leading wildcards can be disabled by setting

866 'AllowLeadingWildcard' to false. -}

867newtype AllowLeadingWildcard =

868 AllowLeadingWildcard Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

869newtype LowercaseExpanded =

870 LowercaseExpanded Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

871newtype EnablePositionIncrements =

872 EnablePositionIncrements Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

873

874{-| By default, wildcard terms in a query are not analyzed.

875 Setting 'AnalyzeWildcard' to true enables best-effort analysis.

876-}

877newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

878

879{-| 'GeneratePhraseQueries' defaults to false.

880-}

881newtype GeneratePhraseQueries =

882 GeneratePhraseQueries Bool deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

883

884{-| 'Locale' is used for string conversions - defaults to ROOT.

885-}

886newtype Locale = Locale Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

887newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

888newtype MinWordLength = MinWordLength Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

889

890{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact

891 phrase matches. Default is 0.

892-}

893newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

894newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

895newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)

896

897-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ

898newtype POSIXMS = POSIXMS { posixMS :: UTCTime }

899

900{-| 'unpackId' is a silly convenience function that gets used once.

901-}

902unpackId :: DocId -> Text

903unpackId (DocId docId) = docId

904

905type TrackSortScores = Bool

906newtype From = From Int deriving (Eq, Show, Generic, ToJSON)

907newtype Size = Size Int deriving (Eq, Show, Generic, ToJSON)

908

909data Search = Search { queryBody :: Maybe Query

910 , filterBody :: Maybe Filter

911 , sortBody :: Maybe Sort

912 , aggBody :: Maybe Aggregations

913 , highlight :: Maybe Highlights

914 -- default False

915 , trackSortScores :: TrackSortScores

916 , from :: From

917 , size :: Size

918 , searchType :: SearchType

919 , fields :: Maybe [FieldName]

920 , source :: Maybe Source } deriving (Eq, Show, Generic, Typeable)

921

922data SearchType = SearchTypeQueryThenFetch

923 | SearchTypeDfsQueryThenFetch

924 | SearchTypeCount

925 | SearchTypeScan

926 | SearchTypeQueryAndFetch

927 | SearchTypeDfsQueryAndFetch

928 deriving (Eq, Show, Generic, Typeable)

929

930data Source =

931 NoSource

932 | SourcePatterns PatternOrPatterns

933 | SourceIncludeExclude Include Exclude

934 deriving (Show, Eq, Generic, Typeable)

935

936data PatternOrPatterns = PopPattern Pattern

937 | PopPatterns [Pattern] deriving (Eq, Show, Generic, Typeable)

938

939data Include = Include [Pattern] deriving (Eq, Show, Generic, Typeable)

940data Exclude = Exclude [Pattern] deriving (Eq, Show, Generic, Typeable)

941

942newtype Pattern = Pattern Text deriving (Eq, Show, Generic, Typeable)

943

944data Highlights = Highlights { globalsettings :: Maybe HighlightSettings

945 , highlightFields :: [FieldHighlight]

946 } deriving (Show, Eq, Generic, Typeable)

947

948data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)

949 deriving (Show, Eq, Generic, Typeable)

950

951

952data HighlightSettings = Plain PlainHighlight

953 | Postings PostingsHighlight

954 | FastVector FastVectorHighlight

955 deriving (Show, Eq, Generic, Typeable)

956data PlainHighlight =

957 PlainHighlight { plainCommon :: Maybe CommonHighlight

958 , plainNonPost :: Maybe NonPostings } deriving (Show, Eq, Generic, Typeable)

959

960 -- This requires that index_options are set to 'offset' in the mapping.

961data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Show, Eq, Generic, Typeable)

962

963-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.

964data FastVectorHighlight =

965 FastVectorHighlight { fvCommon :: Maybe CommonHighlight

966 , fvNonPostSettings :: Maybe NonPostings

967 , boundaryChars :: Maybe Text

968 , boundaryMaxScan :: Maybe Int

969 , fragmentOffset :: Maybe Int

970 , matchedFields :: [Text]

971 , phraseLimit :: Maybe Int

972 } deriving (Show, Eq, Generic, Typeable)

973

974data CommonHighlight =

975 CommonHighlight { order :: Maybe Text

976 , forceSource :: Maybe Bool

977 , tag :: Maybe HighlightTag

978 , encoder :: Maybe HighlightEncoder

979 , noMatchSize :: Maybe Int

980 , highlightQuery :: Maybe Query

981 , requireFieldMatch :: Maybe Bool

982 } deriving (Show, Eq, Generic, Typeable)

983

984-- Settings that are only applicable to FastVector and Plain highlighters.

985data NonPostings =

986 NonPostings { fragmentSize :: Maybe Int

987 , numberOfFragments :: Maybe Int} deriving (Show, Eq, Generic, Typeable)

988

989data HighlightEncoder = DefaultEncoder

990 | HTMLEncoder

991 deriving (Show, Eq, Generic, Typeable)

992

993-- NOTE: Should the tags use some kind of HTML type, rather than Text?

994data HighlightTag = TagSchema Text

995 | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh

996 deriving (Show, Eq, Generic, Typeable)

997

998

999data Query =

1000 TermQuery Term (Maybe Boost)

1001 | TermsQuery Text (NonEmpty Text)

1002 | QueryMatchQuery MatchQuery

1003 | QueryMultiMatchQuery MultiMatchQuery

1004 | QueryBoolQuery BoolQuery

1005 | QueryBoostingQuery BoostingQuery

1006 | QueryCommonTermsQuery CommonTermsQuery

1007 | ConstantScoreFilter Filter Boost

1008 | ConstantScoreQuery Query Boost

1009 | QueryDisMaxQuery DisMaxQuery

1010 | QueryFilteredQuery FilteredQuery

1011 | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery

1012 | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery

1013 | QueryFuzzyQuery FuzzyQuery

1014 | QueryHasChildQuery HasChildQuery

1015 | QueryHasParentQuery HasParentQuery

1016 | IdsQuery MappingName [DocId]

1017 | QueryIndicesQuery IndicesQuery

1018 | MatchAllQuery (Maybe Boost)

1019 | QueryMoreLikeThisQuery MoreLikeThisQuery

1020 | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery

1021 | QueryNestedQuery NestedQuery

1022 | QueryPrefixQuery PrefixQuery

1023 | QueryQueryStringQuery QueryStringQuery

1024 | QuerySimpleQueryStringQuery SimpleQueryStringQuery

1025 | QueryRangeQuery RangeQuery

1026 | QueryRegexpQuery RegexpQuery

1027 deriving (Eq, Show, Generic, Typeable)

1028

1029data RegexpQuery =

1030 RegexpQuery { regexpQueryField :: FieldName

1031 , regexpQuery :: Regexp

1032 , regexpQueryFlags :: RegexpFlags

1033 , regexpQueryBoost :: Maybe Boost

1034 } deriving (Eq, Show, Generic, Typeable)

1035

1036data RangeQuery =

1037 RangeQuery { rangeQueryField :: FieldName

1038 , rangeQueryRange :: RangeValue

1039 , rangeQueryBoost :: Boost } deriving (Eq, Show, Generic, Typeable)

1040

1041mkRangeQuery :: FieldName -> RangeValue -> RangeQuery

1042mkRangeQuery f r = RangeQuery f r (Boost 1.0)

1043

1044data SimpleQueryStringQuery =

1045 SimpleQueryStringQuery

1046 { simpleQueryStringQuery :: QueryString

1047 , simpleQueryStringField :: Maybe FieldOrFields

1048 , simpleQueryStringOperator :: Maybe BooleanOperator

1049 , simpleQueryStringAnalyzer :: Maybe Analyzer

1050 , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)

1051 , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded

1052 , simpleQueryStringLocale :: Maybe Locale

1053 } deriving (Eq, Show, Generic, Typeable)

1054

1055data SimpleQueryFlag =

1056 SimpleQueryAll

1057 | SimpleQueryNone

1058 | SimpleQueryAnd

1059 | SimpleQueryOr

1060 | SimpleQueryPrefix

1061 | SimpleQueryPhrase

1062 | SimpleQueryPrecedence

1063 | SimpleQueryEscape

1064 | SimpleQueryWhitespace

1065 | SimpleQueryFuzzy

1066 | SimpleQueryNear

1067 | SimpleQuerySlop deriving (Eq, Show, Generic, Typeable)

1068

1069-- use_dis_max and tie_breaker when fields are plural?

1070data QueryStringQuery =

1071 QueryStringQuery

1072 { queryStringQuery :: QueryString

1073 , queryStringDefaultField :: Maybe FieldName

1074 , queryStringOperator :: Maybe BooleanOperator

1075 , queryStringAnalyzer :: Maybe Analyzer

1076 , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard

1077 , queryStringLowercaseExpanded :: Maybe LowercaseExpanded

1078 , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements

1079 , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions

1080 , queryStringFuzziness :: Maybe Fuzziness

1081 , queryStringFuzzyPrefixLength :: Maybe PrefixLength

1082 , queryStringPhraseSlop :: Maybe PhraseSlop

1083 , queryStringBoost :: Maybe Boost

1084 , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard

1085 , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries

1086 , queryStringMinimumShouldMatch :: Maybe MinimumMatch

1087 , queryStringLenient :: Maybe Lenient

1088 , queryStringLocale :: Maybe Locale

1089 } deriving (Eq, Show, Generic, Typeable)

1090

1091mkQueryStringQuery :: QueryString -> QueryStringQuery

1092mkQueryStringQuery qs =

1093 QueryStringQuery qs Nothing Nothing

1094 Nothing Nothing Nothing Nothing

1095 Nothing Nothing Nothing Nothing

1096 Nothing Nothing Nothing Nothing

1097 Nothing Nothing

1098

1099data FieldOrFields = FofField FieldName

1100 | FofFields (NonEmpty FieldName) deriving (Eq, Show, Generic, Typeable)

1101

1102data PrefixQuery =

1103 PrefixQuery

1104 { prefixQueryField :: FieldName

1105 , prefixQueryPrefixValue :: Text

1106 , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show, Generic, Typeable)

1107

1108data NestedQuery =

1109 NestedQuery

1110 { nestedQueryPath :: QueryPath

1111 , nestedQueryScoreType :: ScoreType

1112 , nestedQuery :: Query } deriving (Eq, Show, Generic, Typeable)

1113

1114data MoreLikeThisFieldQuery =

1115 MoreLikeThisFieldQuery

1116 { moreLikeThisFieldText :: Text

1117 , moreLikeThisFieldFields :: FieldName

1118 -- default 0.3 (30%)

1119 , moreLikeThisFieldPercentMatch :: Maybe PercentMatch

1120 , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency

1121 , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms

1122 , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)

1123 , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency

1124 , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency

1125 , moreLikeThisFieldMinWordLength :: Maybe MinWordLength

1126 , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength

1127 , moreLikeThisFieldBoostTerms :: Maybe BoostTerms

1128 , moreLikeThisFieldBoost :: Maybe Boost

1129 , moreLikeThisFieldAnalyzer :: Maybe Analyzer

1130 } deriving (Eq, Show, Generic, Typeable)

1131

1132data MoreLikeThisQuery =

1133 MoreLikeThisQuery

1134 { moreLikeThisText :: Text

1135 , moreLikeThisFields :: Maybe (NonEmpty FieldName)

1136 -- default 0.3 (30%)

1137 , moreLikeThisPercentMatch :: Maybe PercentMatch

1138 , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency

1139 , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms

1140 , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)

1141 , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency

1142 , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency

1143 , moreLikeThisMinWordLength :: Maybe MinWordLength

1144 , moreLikeThisMaxWordLength :: Maybe MaxWordLength

1145 , moreLikeThisBoostTerms :: Maybe BoostTerms

1146 , moreLikeThisBoost :: Maybe Boost

1147 , moreLikeThisAnalyzer :: Maybe Analyzer

1148 } deriving (Eq, Show, Generic, Typeable)

1149

1150data IndicesQuery =

1151 IndicesQuery

1152 { indicesQueryIndices :: [IndexName]

1153 , indicesQuery :: Query

1154 -- default "all"

1155 , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show, Generic, Typeable)

1156

1157data HasParentQuery =

1158 HasParentQuery

1159 { hasParentQueryType :: TypeName

1160 , hasParentQuery :: Query

1161 , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show, Generic, Typeable)

1162

1163data HasChildQuery =

1164 HasChildQuery

1165 { hasChildQueryType :: TypeName

1166 , hasChildQuery :: Query

1167 , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show, Generic, Typeable)

1168

1169data ScoreType =

1170 ScoreTypeMax

1171 | ScoreTypeSum

1172 | ScoreTypeAvg

1173 | ScoreTypeNone deriving (Eq, Show, Generic, Typeable)

1174

1175data FuzzyQuery =

1176 FuzzyQuery { fuzzyQueryField :: FieldName

1177 , fuzzyQueryValue :: Text

1178 , fuzzyQueryPrefixLength :: PrefixLength

1179 , fuzzyQueryMaxExpansions :: MaxExpansions

1180 , fuzzyQueryFuzziness :: Fuzziness

1181 , fuzzyQueryBoost :: Maybe Boost

1182 } deriving (Eq, Show, Generic, Typeable)

1183

1184data FuzzyLikeFieldQuery =

1185 FuzzyLikeFieldQuery

1186 { fuzzyLikeField :: FieldName

1187 -- anaphora is good for the soul.

1188 , fuzzyLikeFieldText :: Text

1189 , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms

1190 , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency

1191 , fuzzyLikeFieldFuzziness :: Fuzziness

1192 , fuzzyLikeFieldPrefixLength :: PrefixLength

1193 , fuzzyLikeFieldBoost :: Boost

1194 , fuzzyLikeFieldAnalyzer :: Maybe Analyzer

1195 } deriving (Eq, Show, Generic, Typeable)

1196

1197data FuzzyLikeThisQuery =

1198 FuzzyLikeThisQuery

1199 { fuzzyLikeFields :: [FieldName]

1200 , fuzzyLikeText :: Text

1201 , fuzzyLikeMaxQueryTerms :: MaxQueryTerms

1202 , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency

1203 , fuzzyLikeFuzziness :: Fuzziness

1204 , fuzzyLikePrefixLength :: PrefixLength

1205 , fuzzyLikeBoost :: Boost

1206 , fuzzyLikeAnalyzer :: Maybe Analyzer

1207 } deriving (Eq, Show, Generic, Typeable)

1208

1209data FilteredQuery =

1210 FilteredQuery

1211 { filteredQuery :: Query

1212 , filteredFilter :: Filter } deriving (Eq, Show, Generic, Typeable)

1213

1214data DisMaxQuery =

1215 DisMaxQuery { disMaxQueries :: [Query]

1216 -- default 0.0

1217 , disMaxTiebreaker :: Tiebreaker

1218 , disMaxBoost :: Maybe Boost

1219 } deriving (Eq, Show, Generic, Typeable)

1220

1221data MatchQuery =

1222 MatchQuery { matchQueryField :: FieldName

1223 , matchQueryQueryString :: QueryString

1224 , matchQueryOperator :: BooleanOperator

1225 , matchQueryZeroTerms :: ZeroTermsQuery

1226 , matchQueryCutoffFrequency :: Maybe CutoffFrequency

1227 , matchQueryMatchType :: Maybe MatchQueryType

1228 , matchQueryAnalyzer :: Maybe Analyzer

1229 , matchQueryMaxExpansions :: Maybe MaxExpansions

1230 , matchQueryLenient :: Maybe Lenient

1231 , matchQueryBoost :: Maybe Boost } deriving (Eq, Show, Generic, Typeable)

1232

1233{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,

1234 enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'

1235-}

1236mkMatchQuery :: FieldName -> QueryString -> MatchQuery

1237mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing

1238

1239data MatchQueryType =

1240 MatchPhrase

1241 | MatchPhrasePrefix deriving (Eq, Show, Generic, Typeable)

1242

1243data MultiMatchQuery =

1244 MultiMatchQuery { multiMatchQueryFields :: [FieldName]

1245 , multiMatchQueryString :: QueryString

1246 , multiMatchQueryOperator :: BooleanOperator

1247 , multiMatchQueryZeroTerms :: ZeroTermsQuery

1248 , multiMatchQueryTiebreaker :: Maybe Tiebreaker

1249 , multiMatchQueryType :: Maybe MultiMatchQueryType

1250 , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency

1251 , multiMatchQueryAnalyzer :: Maybe Analyzer

1252 , multiMatchQueryMaxExpansions :: Maybe MaxExpansions

1253 , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show, Generic, Typeable)

1254

1255{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,

1256 enabling you to provide only the list of 'FieldName's and 'QueryString' to

1257 make a 'MultiMatchQuery'.

1258-}

1259

1260mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery

1261mkMultiMatchQuery matchFields query =

1262 MultiMatchQuery matchFields query

1263 Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing

1264

1265data MultiMatchQueryType =

1266 MultiMatchBestFields

1267 | MultiMatchMostFields

1268 | MultiMatchCrossFields

1269 | MultiMatchPhrase

1270 | MultiMatchPhrasePrefix deriving (Eq, Show, Generic, Typeable)

1271

1272data BoolQuery =

1273 BoolQuery { boolQueryMustMatch :: [Query]

1274 , boolQueryMustNotMatch :: [Query]

1275 , boolQueryShouldMatch :: [Query]

1276 , boolQueryMinimumShouldMatch :: Maybe MinimumMatch

1277 , boolQueryBoost :: Maybe Boost

1278 , boolQueryDisableCoord :: Maybe DisableCoord

1279 } deriving (Eq, Show, Generic, Typeable)

1280

1281mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery

1282mkBoolQuery must mustNot should =

1283 BoolQuery must mustNot should Nothing Nothing Nothing

1284

1285data BoostingQuery =

1286 BoostingQuery { positiveQuery :: Query

1287 , negativeQuery :: Query

1288 , negativeBoost :: Boost } deriving (Eq, Show, Generic, Typeable)

1289

1290data CommonTermsQuery =

1291 CommonTermsQuery { commonField :: FieldName

1292 , commonQuery :: QueryString

1293 , commonCutoffFrequency :: CutoffFrequency

1294 , commonLowFreqOperator :: BooleanOperator

1295 , commonHighFreqOperator :: BooleanOperator

1296 , commonMinimumShouldMatch :: Maybe CommonMinimumMatch

1297 , commonBoost :: Maybe Boost

1298 , commonAnalyzer :: Maybe Analyzer

1299 , commonDisableCoord :: Maybe DisableCoord

1300 } deriving (Eq, Show, Generic, Typeable)

1301

1302data CommonMinimumMatch =

1303 CommonMinimumMatchHighLow MinimumMatchHighLow

1304 | CommonMinimumMatch MinimumMatch

1305 deriving (Eq, Show, Generic, Typeable)

1306

1307data MinimumMatchHighLow =

1308 MinimumMatchHighLow { lowFreq :: MinimumMatch

1309 , highFreq :: MinimumMatch } deriving (Eq, Show, Generic, Typeable)

1310

1311data Filter = AndFilter [Filter] Cache

1312 | OrFilter [Filter] Cache

1313 | NotFilter Filter Cache

1314 | IdentityFilter

1315 | BoolFilter BoolMatch

1316 | ExistsFilter FieldName -- always cached

1317 | GeoBoundingBoxFilter GeoBoundingBoxConstraint

1318 | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache

1319 | GeoDistanceRangeFilter GeoPoint DistanceRange

1320 | GeoPolygonFilter FieldName [LatLon]

1321 | IdsFilter MappingName [DocId]

1322 | LimitFilter Int

1323 | MissingFilter FieldName Existence NullValue

1324 | PrefixFilter FieldName PrefixValue Cache

1325 | QueryFilter Query Cache

1326 | RangeFilter FieldName RangeValue RangeExecution Cache

1327 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey

1328 | TermFilter Term Cache

1329 deriving (Eq, Show, Generic, Typeable)

1330

1331data ZeroTermsQuery = ZeroTermsNone

1332 | ZeroTermsAll deriving (Eq, Show, Generic, Typeable)

1333

1334data RangeExecution = RangeExecutionIndex

1335 | RangeExecutionFielddata deriving (Eq, Show, Generic, Typeable)

1336

1337newtype Regexp = Regexp Text deriving (Eq, Show, Generic, Typeable, FromJSON)

1338

1339data RegexpFlags = AllRegexpFlags

1340 | NoRegexpFlags

1341 | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show, Generic, Typeable)

1342

1343data RegexpFlag = AnyString

1344 | Automaton

1345 | Complement

1346 | Empty

1347 | Intersection

1348 | Interval deriving (Eq, Show, Generic, Typeable)

1349

1350newtype LessThan = LessThan Double deriving (Eq, Show, Generic, Typeable)

1351newtype LessThanEq = LessThanEq Double deriving (Eq, Show, Generic, Typeable)

1352newtype GreaterThan = GreaterThan Double deriving (Eq, Show, Generic, Typeable)

1353newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show, Generic, Typeable)

1354

1355newtype LessThanD = LessThanD UTCTime deriving (Eq, Show, Generic, Typeable)

1356newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show, Generic, Typeable)

1357newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show, Generic, Typeable)

1358newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show, Generic, Typeable)

1359

1360data RangeValue = RangeDateLte LessThanEqD

1361 | RangeDateLt LessThanD

1362 | RangeDateGte GreaterThanEqD

1363 | RangeDateGt GreaterThanD

1364 | RangeDateGtLt GreaterThanD LessThanD

1365 | RangeDateGteLte GreaterThanEqD LessThanEqD

1366 | RangeDateGteLt GreaterThanEqD LessThanD

1367 | RangeDateGtLte GreaterThanD LessThanEqD

1368 | RangeDoubleLte LessThanEq

1369 | RangeDoubleLt LessThan

1370 | RangeDoubleGte GreaterThanEq

1371 | RangeDoubleGt GreaterThan

1372 | RangeDoubleGtLt GreaterThan LessThan

1373 | RangeDoubleGteLte GreaterThanEq LessThanEq

1374 | RangeDoubleGteLt GreaterThanEq LessThan

1375 | RangeDoubleGtLte GreaterThan LessThanEq

1376 deriving (Eq, Show, Generic, Typeable)

1377

1378rangeValueToPair :: RangeValue -> [Pair]

1379rangeValueToPair rv = case rv of

1380 RangeDateLte (LessThanEqD t) -> ["lte" .= t]

1381 RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]

1382 RangeDateLt (LessThanD t) -> ["lt" .= t]

1383 RangeDateGt (GreaterThanD t) -> ["gt" .= t]

1384 RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]

1385 RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]

1386 RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]

1387 RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]

1388 RangeDoubleLte (LessThanEq t) -> ["lte" .= t]

1389 RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]

1390 RangeDoubleLt (LessThan t) -> ["lt" .= t]

1391 RangeDoubleGt (GreaterThan t) -> ["gt" .= t]

1392 RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]

1393 RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]

1394 RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]

1395 RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]

1396

1397data Term = Term { termField :: Text

1398 , termValue :: Text } deriving (Eq, Show, Generic, Typeable)

1399

1400data BoolMatch = MustMatch Term Cache

1401 | MustNotMatch Term Cache

1402 | ShouldMatch [Term] Cache deriving (Eq, Show, Generic, Typeable)

1403

1404-- "memory" or "indexed"

1405data GeoFilterType = GeoFilterMemory

1406 | GeoFilterIndexed deriving (Eq, Show, Generic, Typeable)

1407

1408data LatLon = LatLon { lat :: Double

1409 , lon :: Double } deriving (Eq, Show, Generic, Typeable)

1410

1411data GeoBoundingBox =

1412 GeoBoundingBox { topLeft :: LatLon

1413 , bottomRight :: LatLon } deriving (Eq, Show, Generic, Typeable)

1414

1415data GeoBoundingBoxConstraint =

1416 GeoBoundingBoxConstraint { geoBBField :: FieldName

1417 , constraintBox :: GeoBoundingBox

1418 , bbConstraintcache :: Cache

1419 , geoType :: GeoFilterType

1420 } deriving (Eq, Show, Generic, Typeable)

1421

1422data GeoPoint =

1423 GeoPoint { geoField :: FieldName

1424 , latLon :: LatLon} deriving (Eq, Show, Generic, Typeable)

1425

1426data DistanceUnit = Miles

1427 | Yards

1428 | Feet

1429 | Inches

1430 | Kilometers

1431 | Meters

1432 | Centimeters

1433 | Millimeters

1434 | NauticalMiles deriving (Eq, Show, Generic, Typeable)

1435

1436data DistanceType = Arc

1437 | SloppyArc -- doesn't exist <1.0

1438 | Plane deriving (Eq, Show, Generic, Typeable)

1439

1440data OptimizeBbox = OptimizeGeoFilterType GeoFilterType

1441 | NoOptimizeBbox deriving (Eq, Show, Generic, Typeable)

1442

1443data Distance =

1444 Distance { coefficient :: Double

1445 , unit :: DistanceUnit } deriving (Eq, Show, Generic, Typeable)

1446

1447data DistanceRange =

1448 DistanceRange { distanceFrom :: Distance

1449 , distanceTo :: Distance } deriving (Eq, Show, Generic, Typeable)

1450

1451data SearchResult a =

1452 SearchResult { took :: Int

1453 , timedOut :: Bool

1454 , shards :: ShardResult

1455 , searchHits :: SearchHits a

1456 , aggregations :: Maybe AggregationResults

1457 , scrollId :: Maybe ScrollId } deriving (Eq, Show, Generic, Typeable)

1458

1459newtype ScrollId = ScrollId Text deriving (Eq, Show, Generic, Ord, ToJSON, FromJSON)

1460

1461type Score = Maybe Double

1462

1463data SearchHits a =

1464 SearchHits { hitsTotal :: Int

1465 , maxScore :: Score

1466 , hits :: [Hit a] } deriving (Eq, Show, Generic, Typeable)

1467

1468

1469instance Monoid (SearchHits a) where

1470 mempty = SearchHits 0 Nothing mempty

1471 mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =

1472 SearchHits (ta + tb) (max ma mb) (ha <> hb)

1473

1474

1475data Hit a =

1476 Hit { hitIndex :: IndexName

1477 , hitType :: MappingName

1478 , hitDocId :: DocId

1479 , hitScore :: Score

1480 , hitSource :: Maybe a

1481 , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show, Generic, Typeable)

1482

1483data ShardResult =

1484 ShardResult { shardTotal :: Int

1485 , shardsSuccessful :: Int

1486 , shardsFailed :: Int } deriving (Eq, Show, Generic, Typeable)

1487

1488type HitHighlight = M.Map Text [Text]

1489

1490showText :: Show a => a -> Text

1491showText = T.pack . show

1492

1493readMay :: Read a => String -> Maybe a

1494readMay s = case reads s of

1495 (a, ""):_ -> Just a

1496 _ -> Nothing

1497

1498parseReadText :: Read a => Text -> Parser a

1499parseReadText = maybe mzero return . readMay . T.unpack

1500

1501type Aggregations = M.Map Text Aggregation

1502

1503emptyAggregations :: Aggregations

1504emptyAggregations = M.empty

1505

1506mkAggregations :: Text -> Aggregation -> Aggregations

1507mkAggregations name aggregation = M.insert name aggregation emptyAggregations

1508

1509data TermOrder = TermOrder{ termSortField :: Text

1510 , termSortOrder :: SortOrder } deriving (Eq, Show, Generic, Typeable)

1511

1512data TermInclusion = TermInclusion Text

1513 | TermPattern Text Text deriving (Eq, Show, Generic, Typeable)

1514

1515data CollectionMode = BreadthFirst

1516 | DepthFirst deriving (Eq, Show, Generic, Typeable)

1517

1518data ExecutionHint = Ordinals

1519 | GlobalOrdinals

1520 | GlobalOrdinalsHash

1521 | GlobalOrdinalsLowCardinality

1522 | Map deriving (Eq, Show, Generic, Typeable)

1523

1524data TimeInterval = Weeks

1525 | Days

1526 | Hours

1527 | Minutes

1528 | Seconds deriving (Eq)

1529

1530data Interval = Year

1531 | Quarter

1532 | Month

1533 | Week

1534 | Day

1535 | Hour

1536 | Minute

1537 | Second

1538 | FractionalInterval Float TimeInterval deriving (Eq, Show, Generic, Typeable)

1539

1540data Aggregation = TermsAgg TermsAggregation

1541 | DateHistogramAgg DateHistogramAggregation

1542 | ValueCountAgg ValueCountAggregation

1543 | FilterAgg FilterAggregation

1544 | DateRangeAgg DateRangeAggregation deriving (Eq, Show, Generic, Typeable)

1545

1546

1547data TermsAggregation = TermsAggregation { term :: Either Text Text

1548 , termInclude :: Maybe TermInclusion

1549 , termExclude :: Maybe TermInclusion

1550 , termOrder :: Maybe TermOrder

1551 , termMinDocCount :: Maybe Int

1552 , termSize :: Maybe Int

1553 , termShardSize :: Maybe Int

1554 , termCollectMode :: Maybe CollectionMode

1555 , termExecutionHint :: Maybe ExecutionHint

1556 , termAggs :: Maybe Aggregations

1557 } deriving (Eq, Show, Generic, Typeable)

1558

1559data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName

1560 , dateInterval :: Interval

1561 , dateFormat :: Maybe Text

1562 -- pre and post deprecated in 1.5

1563 , datePreZone :: Maybe Text

1564 , datePostZone :: Maybe Text

1565 , datePreOffset :: Maybe Text

1566 , datePostOffset :: Maybe Text

1567 , dateAggs :: Maybe Aggregations

1568 } deriving (Eq, Show, Generic, Typeable)

1569

1570

1571data DateRangeAggregation = DateRangeAggregation { draField :: FieldName

1572 , draFormat :: Maybe Text

1573 , draRanges :: NonEmpty DateRangeAggRange

1574 } deriving (Eq, Show, Generic, Typeable)

1575

1576data DateRangeAggRange = DateRangeFrom DateMathExpr

1577 | DateRangeTo DateMathExpr

1578 | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Show, Generic, Typeable)

1579

1580-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.

1581data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Show, Generic, Typeable)

1582

1583

1584-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.

1585data DateMathAnchor = DMNow

1586 | DMDate Day deriving (Eq, Show, Generic, Typeable)

1587

1588data DateMathModifier = AddTime Int DateMathUnit

1589 | SubtractTime Int DateMathUnit

1590 | RoundDownTo DateMathUnit deriving (Eq, Show, Generic, Typeable)

1591

1592data DateMathUnit = DMYear

1593 | DMMonth

1594 | DMWeek

1595 | DMDay

1596 | DMHour

1597 | DMMinute

1598 | DMSecond deriving (Eq, Show, Generic, Typeable)

1599

1600-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.

1601data ValueCountAggregation = FieldValueCount FieldName

1602 | ScriptValueCount Script deriving (Eq, Show, Generic, Typeable)

1603

1604-- | 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.

1605data FilterAggregation = FilterAggregation { faFilter :: Filter

1606 , faAggs :: Maybe Aggregations} deriving (Eq, Show, Generic, Typeable)

1607

1608mkTermsAggregation :: Text -> TermsAggregation

1609mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

1610

1611mkTermsScriptAggregation :: Text -> TermsAggregation

1612mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

1613

1614mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation

1615mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing

1616

1617instance ToJSON Version where

1618 toJSON Version {..} = object ["number" .= number

1619 ,"build_hash" .= build_hash

1620 ,"build_timestamp" .= build_timestamp

1621 ,"build_snapshot" .= build_snapshot

1622 ,"lucene_version" .= lucene_version]

1623

1624instance FromJSON Version where

1625 parseJSON = withObject "Version" parse

1626 where parse o = Version

1627 <$> o .: "number"

1628 <*> o .: "build_hash"

1629 <*> o .: "build_timestamp"

1630 <*> o .: "build_snapshot"

1631 <*> o .: "lucene_version"

1632

1633instance ToJSON TermOrder where

1634 toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]

1635

1636instance ToJSON TermInclusion where

1637 toJSON (TermInclusion x) = toJSON x

1638 toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,

1639 "flags" .= flags]

1640

1641instance ToJSON CollectionMode where

1642 toJSON BreadthFirst = "breadth_first"

1643 toJSON DepthFirst = "depth_first"

1644

1645instance ToJSON ExecutionHint where

1646 toJSON Ordinals = "ordinals"

1647 toJSON GlobalOrdinals = "global_ordinals"

1648 toJSON GlobalOrdinalsHash = "global_ordinals_hash"

1649 toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"

1650 toJSON Map = "map"

1651

1652instance ToJSON Interval where

1653 toJSON Year = "year"

1654 toJSON Quarter = "quarter"

1655 toJSON Month = "month"

1656 toJSON Week = "week"

1657 toJSON Day = "day"

1658 toJSON Hour = "hour"

1659 toJSON Minute = "minute"

1660 toJSON Second = "second"

1661 toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval

1662

1663instance Show TimeInterval where

1664 show Weeks = "w"

1665 show Days = "d"

1666 show Hours = "h"

1667 show Minutes = "m"

1668 show Seconds = "s"

1669

1670instance ToJSON Aggregation where

1671 toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =

1672 omitNulls ["terms" .= omitNulls [ toJSON' term,

1673 "include" .= include,

1674 "exclude" .= exclude,

1675 "order" .= order,

1676 "min_doc_count" .= minDocCount,

1677 "size" .= size,

1678 "shard_size" .= shardSize,

1679 "collect_mode" .= collectMode,

1680 "execution_hint" .= executionHint

1681 ],

1682 "aggs" .= termAggs ]

1683 where

1684 toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }

1685

1686 toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =

1687 omitNulls ["date_histogram" .= omitNulls [ "field" .= field,

1688 "interval" .= interval,

1689 "format" .= format,

1690 "pre_zone" .= preZone,

1691 "post_zone" .= postZone,

1692 "pre_offset" .= preOffset,

1693 "post_offset" .= postOffset

1694 ],

1695 "aggs" .= dateHistoAggs ]

1696 toJSON (ValueCountAgg a) = object ["value_count" .= v]

1697 where v = case a of

1698 (FieldValueCount (FieldName n)) -> object ["field" .= n]

1699 (ScriptValueCount (Script s)) -> object ["script" .= s]

1700 toJSON (FilterAgg (FilterAggregation filt ags)) =

1701 omitNulls [ "filter" .= filt

1702 , "aggs" .= ags]

1703 toJSON (DateRangeAgg a) = object [ "date_range" .= a

1704 ]

1705

1706instance ToJSON DateRangeAggregation where

1707 toJSON DateRangeAggregation {..} =

1708 omitNulls [ "field" .= draField

1709 , "format" .= draFormat

1710 , "ranges" .= toList draRanges

1711 ]

1712

1713instance ToJSON DateRangeAggRange where

1714 toJSON (DateRangeFrom e) = object [ "from" .= e ]

1715 toJSON (DateRangeTo e) = object [ "to" .= e ]

1716 toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]

1717

1718instance ToJSON DateMathExpr where

1719 toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))

1720 where fmtA DMNow = "now"

1721 fmtA (DMDate date) = case toGregorian date of

1722 (y,m,d) -> showText y <> "-" <>

1723 showText m <> "-" <>

1724 showText d <> "||"

1725 fmtMod (AddTime n u) = "+" <> showText n <> fmtU u

1726 fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u

1727 fmtMod (RoundDownTo u) = "/" <> fmtU u

1728 fmtU DMYear = "y"

1729 fmtU DMMonth = "M"

1730 fmtU DMWeek = "w"

1731 fmtU DMDay = "d"

1732 fmtU DMHour = "h"

1733 fmtU DMMinute = "m"

1734 fmtU DMSecond = "s"

1735

1736

1737type AggregationResults = M.Map Text Value

1738

1739class BucketAggregation a where

1740 key :: a -> Text

1741 docCount :: a -> Int

1742 aggs :: a -> Maybe AggregationResults

1743

1744

1745data Bucket a = Bucket { buckets :: [a]} deriving (Show)

1746

1747data TermsResult = TermsResult { termKey :: Text

1748 , termsDocCount :: Int

1749 , termsAggs :: Maybe AggregationResults } deriving (Show)

1750

1751data DateHistogramResult = DateHistogramResult { dateKey :: Int

1752 , dateKeyStr :: Maybe Text

1753 , dateDocCount :: Int

1754 , dateHistogramAggs :: Maybe AggregationResults } deriving (Show)

1755

1756data DateRangeResult = DateRangeResult { dateRangeKey :: Text

1757 , dateRangeFrom :: Maybe UTCTime

1758 , dateRangeFromAsString :: Maybe Text

1759 , dateRangeTo :: Maybe UTCTime

1760 , dateRangeToAsString :: Maybe Text

1761 , dateRangeDocCount :: Int

1762 , dateRangeAggs :: Maybe AggregationResults } deriving (Show, Eq, Generic, Typeable)

1763

1764toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)

1765toTerms t a = M.lookup t a >>= deserialize

1766 where deserialize = parseMaybe parseJSON

1767

1768toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)

1769toDateHistogram t a = M.lookup t a >>= deserialize

1770 where deserialize = parseMaybe parseJSON

1771

1772instance BucketAggregation TermsResult where

1773 key = termKey

1774 docCount = termsDocCount

1775 aggs = termsAggs

1776

1777instance BucketAggregation DateHistogramResult where

1778 key = showText . dateKey

1779 docCount = dateDocCount

1780 aggs = dateHistogramAggs

1781

1782instance BucketAggregation DateRangeResult where

1783 key = dateRangeKey

1784 docCount = dateRangeDocCount

1785 aggs = dateRangeAggs

1786

1787instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where

1788 parseJSON (Object v) = Bucket <$>

1789 v .: "buckets"

1790 parseJSON _ = mempty

1791

1792instance FromJSON TermsResult where

1793 parseJSON (Object v) = TermsResult <$>

1794 v .: "key" <*>

1795 v .: "doc_count" <*>

1796 v .:? "aggregations"

1797 parseJSON _ = mempty

1798

1799instance FromJSON DateHistogramResult where

1800 parseJSON (Object v) = DateHistogramResult <$>

1801 v .: "key" <*>

1802 v .:? "key_as_string" <*>

1803 v .: "doc_count" <*>

1804 v .:? "aggregations"

1805 parseJSON _ = mempty

1806

1807instance FromJSON DateRangeResult where

1808 parseJSON = withObject "DateRangeResult" parse

1809 where parse v = DateRangeResult <$>

1810 v .: "key" <*>

1811 (fmap posixMS <$> v .:? "from") <*>

1812 v .:? "from_as_string" <*>

1813 (fmap posixMS <$> v .:? "to") <*>

1814 v .:? "to_as_string" <*>

1815 v .: "doc_count" <*>

1816 v .:? "aggregations"

1817

1818instance FromJSON POSIXMS where

1819 parseJSON = withScientific "POSIXMS" (return . parse)

1820 where parse n = let n' = truncate n :: Integer

1821 in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))

1822

1823instance Monoid Filter where

1824 mempty = IdentityFilter

1825 mappend a b = AndFilter [a, b] defaultCache

1826

1827instance Seminearring Filter where

1828 a <||> b = OrFilter [a, b] defaultCache

1829

1830instance ToJSON Filter where

1831 toJSON (AndFilter filters cache) =

1832 object ["and" .=

1833 object [ "filters" .= fmap toJSON filters

1834 , "_cache" .= cache]]

1835

1836 toJSON (OrFilter filters cache) =

1837 object ["or" .=

1838 object [ "filters" .= fmap toJSON filters

1839 , "_cache" .= cache]]

1840

1841 toJSON (NotFilter notFilter cache) =

1842 object ["not" .=

1843 object ["filter" .= notFilter

1844 , "_cache" .= cache]]

1845

1846 toJSON (IdentityFilter) =

1847 object ["match_all" .= object []]

1848

1849 toJSON (TermFilter (Term termFilterField termFilterValue) cache) =

1850 object ["term" .= object base]

1851 where base = [termFilterField .= termFilterValue,

1852 "_cache" .= cache]

1853

1854 toJSON (ExistsFilter (FieldName fieldName)) =

1855 object ["exists" .= object

1856 ["field" .= fieldName]]

1857

1858 toJSON (BoolFilter boolMatch) =

1859 object ["bool" .= boolMatch]

1860

1861 toJSON (GeoBoundingBoxFilter bbConstraint) =

1862 object ["geo_bounding_box" .= bbConstraint]

1863

1864 toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)

1865 distance distanceType optimizeBbox cache) =

1866 object ["geo_distance" .=

1867 object ["distance" .= distance

1868 , "distance_type" .= distanceType

1869 , "optimize_bbox" .= optimizeBbox

1870 , distanceGeoField .= geoDistLatLon

1871 , "_cache" .= cache]]

1872

1873 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)

1874 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =

1875 object ["geo_distance_range" .=

1876 object ["from" .= geoDistRangeDistFrom

1877 , "to" .= drDistanceTo

1878 , gddrField .= drLatLon]]

1879

1880 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =

1881 object ["geo_polygon" .=

1882 object [geoPolygonFilterField .=

1883 object ["points" .= fmap toJSON latLons]]]

1884

1885 toJSON (IdsFilter (MappingName mappingName) values) =

1886 object ["ids" .=

1887 object ["type" .= mappingName

1888 , "values" .= fmap unpackId values]]

1889

1890 toJSON (LimitFilter limit) =

1891 object ["limit" .= object ["value" .= limit]]

1892

1893 toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =

1894 object ["missing" .=

1895 object ["field" .= fieldName

1896 , "existence" .= existence

1897 , "null_value" .= nullValue]]

1898

1899 toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =

1900 object ["prefix" .=

1901 object [fieldName .= fieldValue

1902 , "_cache" .= cache]]

1903

1904 toJSON (QueryFilter query False) =

1905 object ["query" .= toJSON query ]

1906 toJSON (QueryFilter query True) =

1907 object ["fquery" .=

1908 object [ "query" .= toJSON query

1909 , "_cache" .= True ]]

1910

1911 toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =

1912 object ["range" .=

1913 object [ fieldName .= object (rangeValueToPair rangeValue)

1914 , "execution" .= rangeExecution

1915 , "_cache" .= cache]]

1916

1917 toJSON (RegexpFilter (FieldName fieldName)

1918 (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =

1919 object ["regexp" .=

1920 object [fieldName .=

1921 object ["value" .= regexText

1922 , "flags" .= flags]

1923 , "_name" .= cacheName

1924 , "_cache" .= cache

1925 , "_cache_key" .= cacheKey]]

1926

1927instance FromJSON Filter where

1928 parseJSON = withObject "Filter" parse

1929 where parse o = andFilter `taggedWith` "and"

1930 <|> orFilter `taggedWith` "or"

1931 <|> notFilter `taggedWith` "not"

1932 <|> identityFilter `taggedWith` "match_all"

1933 <|> boolFilter `taggedWith` "bool"

1934 <|> existsFilter `taggedWith` "exists"

1935 <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"

1936 <|> geoDistanceFilter `taggedWith` "geo_distance"

1937 <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"

1938 <|> geoPolygonFilter `taggedWith` "geo_polygon"

1939 <|> idsFilter `taggedWith` "ids"

1940 <|> limitFilter `taggedWith` "limit"

1941 <|> missingFilter `taggedWith` "missing"

1942 <|> prefixFilter `taggedWith` "prefix"

1943 <|> queryFilter `taggedWith` "query"

1944 <|> fqueryFilter `taggedWith` "fquery"

1945 <|> rangeFilter `taggedWith` "range"

1946 <|> regexpFilter `taggedWith` "regexp"

1947 <|> termFilter `taggedWith` "term"

1948 where taggedWith parser k = parser =<< o .: k

1949 andFilter o = AndFilter <$> o .: "filters"

1950 <*> o .:? "_cache" .!= defaultCache

1951 orFilter o = OrFilter <$> o .: "filters"

1952 <*> o .:? "_cache" .!= defaultCache

1953 notFilter o = NotFilter <$> o .: "filter"

1954 <*> o .: "_cache" .!= defaultCache

1955 identityFilter :: Object -> Parser Filter

1956 identityFilter m

1957 | HM.null m = pure IdentityFilter

1958 | otherwise = fail ("Identityfilter expected empty object but got " <> show m)

1959 boolFilter = pure . BoolFilter

1960 existsFilter o = ExistsFilter <$> o .: "field"

1961 geoBoundingBoxFilter = pure . GeoBoundingBoxFilter

1962 geoDistanceFilter o = do

1963 case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of

1964 [(fn, v)] -> do

1965 gp <- GeoPoint (FieldName fn) <$> parseJSON v

1966 GeoDistanceFilter gp <$> o .: "distance"

1967 <*> o .: "distance_type"

1968 <*> o .: "optimize_bbox"

1969 <*> o .:? "_cache" .!= defaultCache

1970 _ -> fail "Could not find GeoDistanceFilter field name"

1971 geoDistanceRangeFilter o = do

1972 case HM.toList (deleteSeveral ["from", "to"] o) of

1973 [(fn, v)] -> do

1974 gp <- GeoPoint (FieldName fn) <$> parseJSON v

1975 rng <- DistanceRange <$> o .: "from" <*> o .: "to"

1976 return (GeoDistanceRangeFilter gp rng)

1977 _ -> fail "Could not find GeoDistanceRangeFilter field name"

1978 geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"

1979 idsFilter o = IdsFilter <$> o .: "type"

1980 <*> o .: "values"

1981 limitFilter o = LimitFilter <$> o .: "value"

1982 missingFilter o = MissingFilter <$> o .: "field"

1983 <*> o .: "existence"

1984 <*> o .: "null_value"

1985 prefixFilter o = case HM.toList (HM.delete "_cache" o) of

1986 [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache

1987 _ -> fail "Could not parse PrefixFilter"

1988

1989 queryFilter q = pure (QueryFilter q False)

1990 fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True

1991 rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of

1992 [(fn, v)] -> RangeFilter (FieldName fn)

1993 <$> parseJSON v

1994 <*> o .: "execution"

1995 <*> o .:? "_cache" .!= defaultCache

1996 _ -> fail "Could not find field name for RangeFilter"

1997 regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of

1998 [(fn, Object o')] -> RegexpFilter (FieldName fn)

1999 <$> o' .: "value"

2000 <*> o' .: "flags"

2001 <*> o .: "_name"

2002 <*> o .:? "_cache" .!= defaultCache

2003 <*> o .: "_cache_key"

2004 _ -> fail "Could not find field name for RegexpFilter"

2005 termFilter o = case HM.toList (HM.delete "_cache" o) of

2006 [(termField, String termVal)] -> TermFilter (Term termField termVal)

2007 <$> o .:? "_cache" .!= defaultCache

2008 _ -> fail "Could not find term field for TermFilter"

2009

2010fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a

2011fieldTagged f o = case HM.toList o of

2012 [(k, Object o')] -> f (FieldName k) o'

2013 _ -> fail "Expected object with 1 field-named key"

2014

2015instance ToJSON GeoPoint where

2016 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

2017 object [ geoPointField .= geoPointLatLon ]

2018

2019

2020instance ToJSON Query where

2021 toJSON (TermQuery (Term termQueryField termQueryValue) boost) =

2022 object [ "term" .=

2023 object [termQueryField .= object merged]]

2024 where

2025 base = [ "value" .= termQueryValue ]

2026 boosted = maybe [] (return . ("boost" .=)) boost

2027 merged = mappend base boosted

2028

2029 toJSON (TermsQuery fieldName terms) =

2030 object [ "terms" .= object conjoined ]

2031 where conjoined = [fieldName .= terms]

2032 toJSON (IdsQuery idsQueryMappingName docIds) =

2033 object [ "ids" .= object conjoined ]

2034 where conjoined = [ "type" .= idsQueryMappingName

2035 , "values" .= fmap toJSON docIds ]

2036

2037 toJSON (QueryQueryStringQuery qQueryStringQuery) =

2038 object [ "query_string" .= qQueryStringQuery ]

2039

2040 toJSON (QueryMatchQuery matchQuery) =

2041 object [ "match" .= matchQuery ]

2042

2043 toJSON (QueryMultiMatchQuery multiMatchQuery) =

2044 toJSON multiMatchQuery

2045

2046 toJSON (QueryBoolQuery boolQuery) =

2047 object [ "bool" .= boolQuery ]

2048

2049 toJSON (QueryBoostingQuery boostingQuery) =

2050 object [ "boosting" .= boostingQuery ]

2051

2052 toJSON (QueryCommonTermsQuery commonTermsQuery) =

2053 object [ "common" .= commonTermsQuery ]

2054

2055 toJSON (ConstantScoreFilter csFilter boost) =

2056 object ["constant_score" .= object ["filter" .= csFilter

2057 , "boost" .= boost]]

2058

2059 toJSON (ConstantScoreQuery query boost) =

2060 object ["constant_score" .= object ["query" .= query

2061 , "boost" .= boost]]

2062

2063 toJSON (QueryDisMaxQuery disMaxQuery) =

2064 object [ "dis_max" .= disMaxQuery ]

2065

2066 toJSON (QueryFilteredQuery qFilteredQuery) =

2067 object [ "filtered" .= qFilteredQuery ]

2068

2069 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =

2070 object [ "fuzzy_like_this" .= fuzzyQuery ]

2071

2072 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =

2073 object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]

2074

2075 toJSON (QueryFuzzyQuery fuzzyQuery) =

2076 object [ "fuzzy" .= fuzzyQuery ]

2077

2078 toJSON (QueryHasChildQuery childQuery) =

2079 object [ "has_child" .= childQuery ]

2080

2081 toJSON (QueryHasParentQuery parentQuery) =

2082 object [ "has_parent" .= parentQuery ]

2083

2084 toJSON (QueryIndicesQuery qIndicesQuery) =

2085 object [ "indices" .= qIndicesQuery ]

2086

2087 toJSON (MatchAllQuery boost) =

2088 object [ "match_all" .= omitNulls [ "boost" .= boost ] ]

2089

2090 toJSON (QueryMoreLikeThisQuery query) =

2091 object [ "more_like_this" .= query ]

2092

2093 toJSON (QueryMoreLikeThisFieldQuery query) =

2094 object [ "more_like_this_field" .= query ]

2095

2096 toJSON (QueryNestedQuery query) =

2097 object [ "nested" .= query ]

2098

2099 toJSON (QueryPrefixQuery query) =

2100 object [ "prefix" .= query ]

2101

2102 toJSON (QueryRangeQuery query) =

2103 object [ "range" .= query ]

2104

2105 toJSON (QueryRegexpQuery query) =

2106 object [ "regexp" .= query ]

2107

2108 toJSON (QuerySimpleQueryStringQuery query) =

2109 object [ "simple_query_string" .= query ]

2110

2111instance FromJSON Query where

2112 parseJSON v = withObject "Query" parse v

2113 where parse o = termQuery `taggedWith` "term"

2114 <|> termsQuery `taggedWith` "terms"

2115 <|> idsQuery `taggedWith` "ids"

2116 <|> queryQueryStringQuery `taggedWith` "query_string"

2117 <|> queryMatchQuery `taggedWith` "match"

2118 <|> queryMultiMatchQuery

2119 <|> queryBoolQuery `taggedWith` "bool"

2120 <|> queryBoostingQuery `taggedWith` "boosting"

2121 <|> queryCommonTermsQuery `taggedWith` "common"

2122 <|> constantScoreFilter `taggedWith` "constant_score"

2123 <|> constantScoreQuery `taggedWith` "constant_score"

2124 <|> queryDisMaxQuery `taggedWith` "dis_max"

2125 <|> queryFilteredQuery `taggedWith` "filtered"

2126 <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"

2127 <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"

2128 <|> queryFuzzyQuery `taggedWith` "fuzzy"

2129 <|> queryHasChildQuery `taggedWith` "has_child"

2130 <|> queryHasParentQuery `taggedWith` "has_parent"

2131 <|> queryIndicesQuery `taggedWith` "indices"

2132 <|> matchAllQuery `taggedWith` "match_all"

2133 <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"

2134 <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"

2135 <|> queryNestedQuery `taggedWith` "nested"

2136 <|> queryPrefixQuery `taggedWith` "prefix"

2137 <|> queryRangeQuery `taggedWith` "range"

2138 <|> queryRegexpQuery `taggedWith` "regexp"

2139 <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"

2140 where taggedWith parser k = parser =<< o .: k

2141 termQuery = fieldTagged $ \(FieldName fn) o ->

2142 TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"

2143 termsQuery o = case HM.toList o of

2144 [(fn, vs)] -> do vals <- parseJSON vs

2145 case vals of

2146 x:xs -> return (TermsQuery fn (x :| xs))

2147 _ -> fail "Expected non empty list of values"

2148 _ -> fail "Expected object with 1 field-named key"

2149 idsQuery o = IdsQuery <$> o .: "type"

2150 <*> o .: "values"

2151 queryQueryStringQuery = pure . QueryQueryStringQuery

2152 queryMatchQuery = pure . QueryMatchQuery

2153 queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v

2154 queryBoolQuery = pure . QueryBoolQuery

2155 queryBoostingQuery = pure . QueryBoostingQuery

2156 queryCommonTermsQuery = pure . QueryCommonTermsQuery

2157 constantScoreFilter o = case HM.lookup "filter" o of

2158 Just x -> ConstantScoreFilter <$> parseJSON x

2159 <*> o .: "boost"

2160 _ -> fail "Does not appear to be a ConstantScoreFilter"

2161 constantScoreQuery o = case HM.lookup "query" o of

2162 Just x -> ConstantScoreQuery <$> parseJSON x

2163 <*> o .: "boost"

2164 _ -> fail "Does not appear to be a ConstantScoreQuery"

2165 queryDisMaxQuery = pure . QueryDisMaxQuery

2166 queryFilteredQuery = pure . QueryFilteredQuery

2167 queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery

2168 queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery

2169 queryFuzzyQuery = pure . QueryFuzzyQuery

2170 queryHasChildQuery = pure . QueryHasChildQuery

2171 queryHasParentQuery = pure . QueryHasParentQuery

2172 queryIndicesQuery = pure . QueryIndicesQuery

2173 matchAllQuery o = MatchAllQuery <$> o .:? "boost"

2174 queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery

2175 queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery

2176 queryNestedQuery = pure . QueryNestedQuery

2177 queryPrefixQuery = pure . QueryPrefixQuery

2178 queryRangeQuery = pure . QueryRangeQuery

2179 queryRegexpQuery = pure . QueryRegexpQuery

2180 querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery

2181

2182

2183omitNulls :: [(Text, Value)] -> Value

2184omitNulls = object . filter notNull where

2185 notNull (_, Null) = False

2186 notNull (_, Array a) = (not . V.null) a

2187 notNull _ = True

2188

2189

2190instance ToJSON SimpleQueryStringQuery where

2191 toJSON SimpleQueryStringQuery {..} =

2192 omitNulls (base ++ maybeAdd)

2193 where base = [ "query" .= simpleQueryStringQuery ]

2194 maybeAdd = [ "fields" .= simpleQueryStringField

2195 , "default_operator" .= simpleQueryStringOperator

2196 , "analyzer" .= simpleQueryStringAnalyzer

2197 , "flags" .= simpleQueryStringFlags

2198 , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded

2199 , "locale" .= simpleQueryStringLocale ]

2200

2201instance FromJSON SimpleQueryStringQuery where

2202 parseJSON = withObject "SimpleQueryStringQuery" parse

2203 where parse o = SimpleQueryStringQuery <$> o .: "query"

2204 <*> o .:? "fields"

2205 <*> o .:? "default_operator"

2206 <*> o .:? "analyzer"

2207 <*> (parseFlags <$> o .:? "flags")

2208 <*> o .:? "lowercase_expanded_terms"

2209 <*> o .:? "locale"

2210 parseFlags (Just (x:xs)) = Just (x :| xs)

2211 parseFlags _ = Nothing

2212

2213instance ToJSON FieldOrFields where

2214 toJSON (FofField fieldName) =

2215 toJSON fieldName

2216 toJSON (FofFields fieldNames) =

2217 toJSON fieldNames

2218

2219instance FromJSON FieldOrFields where

2220 parseJSON v = FofField <$> parseJSON v

2221 <|> FofFields <$> (parseNEJSON =<< parseJSON v)

2222

2223instance ToJSON SimpleQueryFlag where

2224 toJSON SimpleQueryAll = "ALL"

2225 toJSON SimpleQueryNone = "NONE"

2226 toJSON SimpleQueryAnd = "AND"

2227 toJSON SimpleQueryOr = "OR"

2228 toJSON SimpleQueryPrefix = "PREFIX"

2229 toJSON SimpleQueryPhrase = "PHRASE"

2230 toJSON SimpleQueryPrecedence = "PRECEDENCE"

2231 toJSON SimpleQueryEscape = "ESCAPE"

2232 toJSON SimpleQueryWhitespace = "WHITESPACE"

2233 toJSON SimpleQueryFuzzy = "FUZZY"

2234 toJSON SimpleQueryNear = "NEAR"

2235 toJSON SimpleQuerySlop = "SLOP"

2236

2237instance FromJSON SimpleQueryFlag where

2238 parseJSON = withText "SimpleQueryFlag" parse

2239 where parse "ALL" = pure SimpleQueryAll

2240 parse "NONE" = pure SimpleQueryNone

2241 parse "AND" = pure SimpleQueryAnd

2242 parse "OR" = pure SimpleQueryOr

2243 parse "PREFIX" = pure SimpleQueryPrefix

2244 parse "PHRASE" = pure SimpleQueryPhrase

2245 parse "PRECEDENCE" = pure SimpleQueryPrecedence

2246 parse "ESCAPE" = pure SimpleQueryEscape

2247 parse "WHITESPACE" = pure SimpleQueryWhitespace

2248 parse "FUZZY" = pure SimpleQueryFuzzy

2249 parse "NEAR" = pure SimpleQueryNear

2250 parse "SLOP" = pure SimpleQuerySlop

2251 parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)

2252

2253instance ToJSON RegexpQuery where

2254 toJSON (RegexpQuery (FieldName rqQueryField)

2255 (Regexp regexpQueryQuery) rqQueryFlags

2256 rqQueryBoost) =

2257 object [ rqQueryField .= omitNulls base ]

2258 where base = [ "value" .= regexpQueryQuery

2259 , "flags" .= rqQueryFlags

2260 , "boost" .= rqQueryBoost ]

2261

2262instance FromJSON RegexpQuery where

2263 parseJSON = withObject "RegexpQuery" parse

2264 where parse = fieldTagged $ \fn o ->

2265 RegexpQuery fn

2266 <$> o .: "value"

2267 <*> o .: "flags"

2268 <*> o .:? "boost"

2269

2270instance ToJSON QueryStringQuery where

2271 toJSON (QueryStringQuery qsQueryString

2272 qsDefaultField qsOperator

2273 qsAnalyzer qsAllowWildcard

2274 qsLowercaseExpanded qsEnablePositionIncrements

2275 qsFuzzyMaxExpansions qsFuzziness

2276 qsFuzzyPrefixLength qsPhraseSlop

2277 qsBoost qsAnalyzeWildcard

2278 qsGeneratePhraseQueries qsMinimumShouldMatch

2279 qsLenient qsLocale) =

2280 omitNulls base

2281 where

2282 base = [ "query" .= qsQueryString

2283 , "default_field" .= qsDefaultField

2284 , "default_operator" .= qsOperator

2285 , "analyzer" .= qsAnalyzer

2286 , "allow_leading_wildcard" .= qsAllowWildcard

2287 , "lowercase_expanded_terms" .= qsLowercaseExpanded

2288 , "enable_position_increments" .= qsEnablePositionIncrements

2289 , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions

2290 , "fuzziness" .= qsFuzziness

2291 , "fuzzy_prefix_length" .= qsFuzzyPrefixLength

2292 , "phrase_slop" .= qsPhraseSlop

2293 , "boost" .= qsBoost

2294 , "analyze_wildcard" .= qsAnalyzeWildcard

2295 , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries

2296 , "minimum_should_match" .= qsMinimumShouldMatch

2297 , "lenient" .= qsLenient

2298 , "locale" .= qsLocale ]

2299

2300instance FromJSON QueryStringQuery where

2301 parseJSON = withObject "QueryStringQuery" parse

2302 where parse o = QueryStringQuery

2303 <$> o .: "query"

2304 <*> o .:? "default_field"

2305 <*> o .:? "default_operator"

2306 <*> o .:? "analyzer"

2307 <*> o .:? "allow_leading_wildcard"

2308 <*> o .:? "lowercase_expanded_terms"

2309 <*> o .:? "enable_position_increments"

2310 <*> o .:? "fuzzy_max_expansions"

2311 <*> o .:? "fuzziness"

2312 <*> o .:? "fuzzy_prefix_length"

2313 <*> o .:? "phrase_slop"

2314 <*> o .:? "boost"

2315 <*> o .:? "analyze_wildcard"

2316 <*> o .:? "auto_generate_phrase_queries"

2317 <*> o .:? "minimum_should_match"

2318 <*> o .:? "lenient"

2319 <*> o .:? "locale"

2320

2321instance ToJSON RangeQuery where

2322 toJSON (RangeQuery (FieldName fieldName) range boost) =

2323 object [ fieldName .= object conjoined ]

2324 where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)

2325

2326instance FromJSON RangeQuery where

2327 parseJSON = withObject "RangeQuery" parse

2328 where parse = fieldTagged $ \fn o ->

2329 RangeQuery fn

2330 <$> parseJSON (Object o)

2331 <*> o .: "boost"

2332

2333instance FromJSON RangeValue where

2334 parseJSON = withObject "RangeValue" parse

2335 where parse o = parseDate o

2336 <|> parseDouble o

2337 parseDate o = do lt <- o .:? "lt"

2338 lte <- o .:? "lte"

2339 gt <- o .:? "gt"

2340 gte <- o .:? "gte"

2341 case (lt, lte, gt, gte) of

2342 (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))

2343 (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))

2344 (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))

2345 (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))

2346 (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))

2347 (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))

2348 (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))

2349 (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))

2350 (Nothing, Nothing, Nothing, Nothing) -> mzero

2351 parseDouble o = do lt <- o .:? "lt"

2352 lte <- o .:? "lte"

2353 gt <- o .:? "gt"

2354 gte <- o .:? "gte"

2355 case (lt, lte, gt, gte) of

2356 (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))

2357 (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))

2358 (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))

2359 (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))

2360 (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))

2361 (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))

2362 (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))

2363 (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))

2364 (Nothing, Nothing, Nothing, Nothing) -> mzero

2365

2366instance ToJSON PrefixQuery where

2367 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =

2368 object [ fieldName .= omitNulls base ]

2369 where base = [ "value" .= queryValue

2370 , "boost" .= boost ]

2371

2372instance FromJSON PrefixQuery where

2373 parseJSON = withObject "PrefixQuery" parse

2374 where parse = fieldTagged $ \fn o ->

2375 PrefixQuery fn

2376 <$> o .: "value"

2377 <*> o .:? "boost"

2378

2379instance ToJSON NestedQuery where

2380 toJSON (NestedQuery nqPath nqScoreType nqQuery) =

2381 object [ "path" .= nqPath

2382 , "score_mode" .= nqScoreType

2383 , "query" .= nqQuery ]

2384

2385instance FromJSON NestedQuery where

2386 parseJSON = withObject "NestedQuery" parse

2387 where parse o = NestedQuery

2388 <$> o .: "path"

2389 <*> o .: "score_mode"

2390 <*> o .: "query"

2391

2392instance ToJSON MoreLikeThisFieldQuery where

2393 toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)

2394 percent mtf mqt stopwords mindf maxdf

2395 minwl maxwl boostTerms boost analyzer) =

2396 object [ fieldName .= omitNulls base ]

2397 where base = [ "like_text" .= text

2398 , "percent_terms_to_match" .= percent

2399 , "min_term_freq" .= mtf

2400 , "max_query_terms" .= mqt

2401 , "stop_words" .= stopwords

2402 , "min_doc_freq" .= mindf

2403 , "max_doc_freq" .= maxdf

2404 , "min_word_length" .= minwl

2405 , "max_word_length" .= maxwl

2406 , "boost_terms" .= boostTerms

2407 , "boost" .= boost

2408 , "analyzer" .= analyzer ]

2409

2410instance FromJSON MoreLikeThisFieldQuery where

2411 parseJSON = withObject "MoreLikeThisFieldQuery" parse

2412 where parse = fieldTagged $ \fn o ->

2413 MoreLikeThisFieldQuery

2414 <$> o .: "like_text"

2415 <*> pure fn

2416 <*> o .:? "percent_terms_to_match"

2417 <*> o .:? "min_term_freq"

2418 <*> o .:? "max_query_terms"

2419 <*> (optionalNE =<< o .:? "stop_words")

2420 <*> o .:? "min_doc_freq"

2421 <*> o .:? "max_doc_freq"

2422 <*> o .:? "min_word_length"

2423 <*> o .:? "max_word_length"

2424 <*> o .:? "boost_terms"

2425 <*> o .:? "boost"

2426 <*> o .:? "analyzer"

2427 optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)

2428

2429instance ToJSON MoreLikeThisQuery where

2430 toJSON (MoreLikeThisQuery text fields percent

2431 mtf mqt stopwords mindf maxdf

2432 minwl maxwl boostTerms boost analyzer) =

2433 omitNulls base

2434 where base = [ "like_text" .= text

2435 , "fields" .= fields

2436 , "percent_terms_to_match" .= percent

2437 , "min_term_freq" .= mtf

2438 , "max_query_terms" .= mqt

2439 , "stop_words" .= stopwords

2440 , "min_doc_freq" .= mindf

2441 , "max_doc_freq" .= maxdf

2442 , "min_word_length" .= minwl

2443 , "max_word_length" .= maxwl

2444 , "boost_terms" .= boostTerms

2445 , "boost" .= boost

2446 , "analyzer" .= analyzer ]

2447

2448instance FromJSON MoreLikeThisQuery where

2449 parseJSON = withObject "MoreLikeThisQuery" parse

2450 where parse o = MoreLikeThisQuery

2451 <$> o .: "like_text"

2452 <*> (optionalNE =<< o .:? "fields")

2453 <*> o .:? "percent_terms_to_match"

2454 <*> o .:? "min_term_freq"

2455 <*> o .:? "max_query_terms"

2456 <*> (optionalNE =<< o .:? "stop_words")

2457 <*> o .:? "min_doc_freq"

2458 <*> o .:? "max_doc_freq"

2459 <*> o .:? "min_word_length"

2460 <*> o .:? "max_word_length"

2461 <*> o .:? "boost_terms"

2462 <*> o .:? "boost"

2463 <*> o .:? "analyzer"

2464 optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)

2465

2466instance ToJSON IndicesQuery where

2467 toJSON (IndicesQuery indices query noMatch) =

2468 omitNulls [ "indices" .= indices

2469 , "no_match_query" .= noMatch

2470 , "query" .= query ]

2471

2472instance FromJSON IndicesQuery where

2473 parseJSON = withObject "IndicesQuery" parse

2474 where parse o = IndicesQuery

2475 <$> o .:? "indices" .!= []

2476 <*> o .: "query"

2477 <*> o .:? "no_match_query"

2478

2479instance ToJSON HasParentQuery where

2480 toJSON (HasParentQuery queryType query scoreType) =

2481 omitNulls [ "parent_type" .= queryType

2482 , "score_type" .= scoreType

2483 , "query" .= query ]

2484

2485instance FromJSON HasParentQuery where

2486 parseJSON = withObject "HasParentQuery" parse

2487 where parse o = HasParentQuery

2488 <$> o .: "parent_type"

2489 <*> o .: "query"

2490 <*> o .:? "score_type"

2491

2492instance ToJSON HasChildQuery where

2493 toJSON (HasChildQuery queryType query scoreType) =

2494 omitNulls [ "query" .= query

2495 , "score_type" .= scoreType

2496 , "type" .= queryType ]

2497

2498instance FromJSON HasChildQuery where

2499 parseJSON = withObject "HasChildQuery" parse

2500 where parse o = HasChildQuery

2501 <$> o .: "type"

2502 <*> o .: "query"

2503 <*> o .:? "score_type"

2504

2505instance ToJSON FuzzyQuery where

2506 toJSON (FuzzyQuery (FieldName fieldName) queryText

2507 prefixLength maxEx fuzziness boost) =

2508 object [ fieldName .= omitNulls base ]

2509 where base = [ "value" .= queryText

2510 , "fuzziness" .= fuzziness

2511 , "prefix_length" .= prefixLength

2512 , "boost" .= boost

2513 , "max_expansions" .= maxEx ]

2514

2515instance FromJSON FuzzyQuery where

2516 parseJSON = withObject "FuzzyQuery" parse

2517 where parse = fieldTagged $ \fn o ->

2518 FuzzyQuery fn

2519 <$> o .: "value"

2520 <*> o .: "prefix_length"

2521 <*> o .: "max_expansions"

2522 <*> o .: "fuzziness"

2523 <*> o .:? "boost"

2524

2525instance ToJSON FuzzyLikeFieldQuery where

2526 toJSON (FuzzyLikeFieldQuery (FieldName fieldName)

2527 fieldText maxTerms ignoreFreq fuzziness prefixLength

2528 boost analyzer) =

2529 object [ fieldName .=

2530 omitNulls [ "like_text" .= fieldText

2531 , "max_query_terms" .= maxTerms

2532 , "ignore_tf" .= ignoreFreq

2533 , "fuzziness" .= fuzziness

2534 , "prefix_length" .= prefixLength

2535 , "analyzer" .= analyzer

2536 , "boost" .= boost ]]

2537

2538instance FromJSON FuzzyLikeFieldQuery where

2539 parseJSON = withObject "FuzzyLikeFieldQuery" parse

2540 where parse = fieldTagged $ \fn o ->

2541 FuzzyLikeFieldQuery fn

2542 <$> o .: "like_text"

2543 <*> o .: "max_query_terms"

2544 <*> o .: "ignore_tf"

2545 <*> o .: "fuzziness"

2546 <*> o .: "prefix_length"

2547 <*> o .: "boost"

2548 <*> o .:? "analyzer"

2549

2550instance ToJSON FuzzyLikeThisQuery where

2551 toJSON (FuzzyLikeThisQuery fields text maxTerms

2552 ignoreFreq fuzziness prefixLength boost analyzer) =

2553 omitNulls base

2554 where base = [ "fields" .= fields

2555 , "like_text" .= text

2556 , "max_query_terms" .= maxTerms

2557 , "ignore_tf" .= ignoreFreq

2558 , "fuzziness" .= fuzziness

2559 , "prefix_length" .= prefixLength

2560 , "analyzer" .= analyzer

2561 , "boost" .= boost ]

2562

2563instance FromJSON FuzzyLikeThisQuery where

2564 parseJSON = withObject "FuzzyLikeThisQuery" parse

2565 where parse o = FuzzyLikeThisQuery

2566 <$> o .:? "fields" .!= []

2567 <*> o .: "like_text"

2568 <*> o .: "max_query_terms"

2569 <*> o .: "ignore_tf"

2570 <*> o .: "fuzziness"

2571 <*> o .: "prefix_length"

2572 <*> o .: "boost"

2573 <*> o .:? "analyzer"

2574

2575instance ToJSON FilteredQuery where

2576 toJSON (FilteredQuery query fFilter) =

2577 object [ "query" .= query

2578 , "filter" .= fFilter ]

2579

2580instance FromJSON FilteredQuery where

2581 parseJSON = withObject "FilteredQuery" parse

2582 where parse o = FilteredQuery

2583 <$> o .: "query"

2584 <*> o .: "filter"

2585

2586instance ToJSON DisMaxQuery where

2587 toJSON (DisMaxQuery queries tiebreaker boost) =

2588 omitNulls base

2589 where base = [ "queries" .= queries

2590 , "boost" .= boost

2591 , "tie_breaker" .= tiebreaker ]

2592

2593instance FromJSON DisMaxQuery where

2594 parseJSON = withObject "DisMaxQuery" parse

2595 where parse o = DisMaxQuery

2596 <$> o .:? "queries" .!= []

2597 <*> o .: "tie_breaker"

2598 <*> o .:? "boost"

2599

2600instance ToJSON CommonTermsQuery where

2601 toJSON (CommonTermsQuery (FieldName fieldName)

2602 (QueryString query) cf lfo hfo msm

2603 boost analyzer disableCoord) =

2604 object [fieldName .= omitNulls base ]

2605 where base = [ "query" .= query

2606 , "cutoff_frequency" .= cf

2607 , "low_freq_operator" .= lfo

2608 , "minimum_should_match" .= msm

2609 , "boost" .= boost

2610 , "analyzer" .= analyzer

2611 , "disable_coord" .= disableCoord

2612 , "high_freq_operator" .= hfo ]

2613

2614instance FromJSON CommonTermsQuery where

2615 parseJSON = withObject "CommonTermsQuery" parse

2616 where parse = fieldTagged $ \fn o ->

2617 CommonTermsQuery fn

2618 <$> o .: "query"

2619 <*> o .: "cutoff_frequency"

2620 <*> o .: "low_freq_operator"

2621 <*> o .: "high_freq_operator"

2622 <*> o .:? "minimum_should_match"

2623 <*> o .:? "boost"

2624 <*> o .:? "analyzer"

2625 <*> o .:? "disable_coord"

2626

2627instance ToJSON CommonMinimumMatch where

2628 toJSON (CommonMinimumMatch mm) = toJSON mm

2629 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =

2630 object [ "low_freq" .= lowF

2631 , "high_freq" .= highF ]

2632

2633instance FromJSON CommonMinimumMatch where

2634 parseJSON v = parseMinimum v

2635 <|> parseMinimumHighLow v

2636 where parseMinimum = fmap CommonMinimumMatch . parseJSON

2637 parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->

2638 MinimumMatchHighLow

2639 <$> o .: "low_freq"

2640 <*> o .: "high_freq")

2641

2642

2643instance ToJSON BoostingQuery where

2644 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =

2645 object [ "positive" .= bqPositiveQuery

2646 , "negative" .= bqNegativeQuery

2647 , "negative_boost" .= bqNegativeBoost ]

2648

2649instance FromJSON BoostingQuery where

2650 parseJSON = withObject "BoostingQuery" parse

2651 where parse o = BoostingQuery

2652 <$> o .: "positive"

2653 <*> o .: "negative"

2654 <*> o .: "negative_boost"

2655

2656instance ToJSON BoolQuery where

2657 toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =

2658 omitNulls base

2659 where base = [ "must" .= mustM

2660 , "must_not" .= notM

2661 , "should" .= shouldM

2662 , "minimum_should_match" .= bqMin

2663 , "boost" .= boost

2664 , "disable_coord" .= disableCoord ]

2665

2666instance FromJSON BoolQuery where

2667 parseJSON = withObject "BoolQuery" parse

2668 where parse o = BoolQuery

2669 <$> o .:? "must" .!= []

2670 <*> o .:? "must_not" .!= []

2671 <*> o .:? "should" .!= []

2672 <*> o .:? "minimum_should_match"

2673 <*> o .:? "boost"

2674 <*> o .:? "disable_coord"

2675

2676instance ToJSON MatchQuery where

2677 toJSON (MatchQuery (FieldName fieldName)

2678 (QueryString mqQueryString) booleanOperator

2679 zeroTermsQuery cutoffFrequency matchQueryType

2680 analyzer maxExpansions lenient boost) =

2681 object [ fieldName .= omitNulls base ]

2682 where base = [ "query" .= mqQueryString

2683 , "operator" .= booleanOperator

2684 , "zero_terms_query" .= zeroTermsQuery

2685 , "cutoff_frequency" .= cutoffFrequency

2686 , "type" .= matchQueryType

2687 , "analyzer" .= analyzer

2688 , "max_expansions" .= maxExpansions

2689 , "lenient" .= lenient

2690 , "boost" .= boost ]

2691

2692instance FromJSON MatchQuery where

2693 parseJSON = withObject "MatchQuery" parse

2694 where parse = fieldTagged $ \fn o ->

2695 MatchQuery fn

2696 <$> o .: "query"

2697 <*> o .: "operator"

2698 <*> o .: "zero_terms_query"

2699 <*> o .:? "cutoff_frequency"

2700 <*> o .:? "type"

2701 <*> o .:? "analyzer"

2702 <*> o .:? "max_expansions"

2703 <*> o .:? "lenient"

2704 <*> o .:? "boost"

2705

2706instance ToJSON MultiMatchQuery where

2707 toJSON (MultiMatchQuery fields (QueryString query) boolOp

2708 ztQ tb mmqt cf analyzer maxEx lenient) =

2709 object ["multi_match" .= omitNulls base]

2710 where base = [ "fields" .= fmap toJSON fields

2711 , "query" .= query

2712 , "operator" .= boolOp

2713 , "zero_terms_query" .= ztQ

2714 , "tiebreaker" .= tb

2715 , "type" .= mmqt

2716 , "cutoff_frequency" .= cf

2717 , "analyzer" .= analyzer

2718 , "max_expansions" .= maxEx

2719 , "lenient" .= lenient ]

2720

2721instance FromJSON MultiMatchQuery where

2722 parseJSON = withObject "MultiMatchQuery" parse

2723 where parse raw = do o <- raw .: "multi_match"

2724 MultiMatchQuery

2725 <$> o .:? "fields" .!= []

2726 <*> o .: "query"

2727 <*> o .: "operator"

2728 <*> o .: "zero_terms_query"

2729 <*> o .:? "tiebreaker"

2730 <*> o .:? "type"

2731 <*> o .:? "cutoff_frequency"

2732 <*> o .:? "analyzer"

2733 <*> o .:? "max_expansions"

2734 <*> o .:? "lenient"

2735

2736instance ToJSON MultiMatchQueryType where

2737 toJSON MultiMatchBestFields = "best_fields"

2738 toJSON MultiMatchMostFields = "most_fields"

2739 toJSON MultiMatchCrossFields = "cross_fields"

2740 toJSON MultiMatchPhrase = "phrase"

2741 toJSON MultiMatchPhrasePrefix = "phrase_prefix"

2742

2743instance FromJSON MultiMatchQueryType where

2744 parseJSON = withText "MultiMatchPhrasePrefix" parse

2745 where parse "best_fields" = pure MultiMatchBestFields

2746 parse "most_fields" = pure MultiMatchMostFields

2747 parse "cross_fields" = pure MultiMatchCrossFields

2748 parse "phrase" = pure MultiMatchPhrase

2749 parse "phrase_prefix" = pure MultiMatchPhrasePrefix

2750 parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)

2751

2752instance ToJSON BooleanOperator where

2753 toJSON And = String "and"

2754 toJSON Or = String "or"

2755

2756instance FromJSON BooleanOperator where

2757 parseJSON = withText "BooleanOperator" parse

2758 where parse "and" = pure And

2759 parse "or" = pure Or

2760 parse o = fail ("Unexpected BooleanOperator: " <> show o)

2761

2762instance ToJSON ZeroTermsQuery where

2763 toJSON ZeroTermsNone = String "none"

2764 toJSON ZeroTermsAll = String "all"

2765

2766instance FromJSON ZeroTermsQuery where

2767 parseJSON = withText "ZeroTermsQuery" parse

2768 where parse "none" = pure ZeroTermsNone

2769 parse "all" = pure ZeroTermsAll

2770 parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)

2771

2772instance ToJSON MatchQueryType where

2773 toJSON MatchPhrase = "phrase"

2774 toJSON MatchPhrasePrefix = "phrase_prefix"

2775

2776instance FromJSON MatchQueryType where

2777 parseJSON = withText "MatchQueryType" parse

2778 where parse "phrase" = pure MatchPhrase

2779 parse "phrase_prefix" = pure MatchPhrasePrefix

2780 parse t = fail ("Unexpected MatchQueryType: " <> show t)

2781

2782instance FromJSON Status where

2783 parseJSON (Object v) = Status <$>

2784 v .:? "ok" <*>

2785 v .: "status" <*>

2786 v .: "name" <*>

2787 v .: "version" <*>

2788 v .: "tagline"

2789 parseJSON _ = empty

2790

2791

2792instance ToJSON IndexSettings where

2793 toJSON (IndexSettings s r) = object ["settings" .=

2794 object ["index" .=

2795 object ["number_of_shards" .= s, "number_of_replicas" .= r]

2796 ]

2797 ]

2798

2799instance FromJSON IndexSettings where

2800 parseJSON = withObject "IndexSettings" parse

2801 where parse o = do s <- o .: "settings"

2802 i <- s .: "index"

2803 IndexSettings <$> i .: "number_of_shards"

2804 <*> i .: "number_of_replicas"

2805

2806instance ToJSON UpdatableIndexSetting where

2807 toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x

2808 toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x

2809 toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)

2810 toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x

2811 toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x

2812 toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x

2813 toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x

2814 toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)

2815 toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x

2816 toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x

2817 toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)

2818 toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)

2819 toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)

2820 toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)

2821 toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)

2822 toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x

2823 toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x

2824 toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x

2825 toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)

2826 toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x

2827 toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x

2828 toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x

2829 toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x

2830 toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x

2831 toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x

2832 toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x

2833 toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x

2834 toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x

2835

2836instance FromJSON UpdatableIndexSetting where

2837 parseJSON = withObject "UpdatableIndexSetting" parse

2838 where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]

2839 <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]

2840 <|> refreshInterval `taggedAt` ["index", "refresh_interval"]

2841 <|> indexConcurrency `taggedAt` ["index", "concurrency"]

2842 <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]

2843 <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]

2844 <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]

2845 <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]

2846 <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]

2847 <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]

2848 <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]

2849 <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]

2850 <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]

2851 <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]

2852 <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]

2853 <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]

2854 <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]

2855 <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]

2856 <|> gcDeletes `taggedAt` ["index", "gc_deletes"]

2857 <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]

2858 <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]

2859 <|> compoundFormat `taggedAt` ["index", "compound_format"]

2860 <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]

2861 <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]

2862 <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]

2863 <|> blocksRead `taggedAt` ["blocks", "read"]

2864 <|> blocksWrite `taggedAt` ["blocks", "write"]

2865 <|> blocksMetaData `taggedAt` ["blocks", "metadata"]

2866 where taggedAt f ks = taggedAt' f (Object o) ks

2867 taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON =<< unStringlyTypeJSON v))

2868 taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k

2869 taggedAt' f v' ks) v

2870 numberOfReplicas = pure . NumberOfReplicas

2871 autoExpandReplicas = pure . AutoExpandReplicas

2872 refreshInterval = pure . RefreshInterval . ndtJSON

2873 indexConcurrency = pure . IndexConcurrency

2874 failOnMergeFailure = pure . FailOnMergeFailure

2875 translogFlushThresholdOps = pure . TranslogFlushThresholdOps

2876 translogFlushThresholdSize = pure . TranslogFlushThresholdSize

2877 translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON

2878 translogDisableFlush = pure . TranslogDisableFlush

2879 cacheFilterMaxSize = pure . CacheFilterMaxSize

2880 cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON

2881 gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON

2882 routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter

2883 routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter

2884 routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter

2885 routingAllocationEnable = pure . RoutingAllocationEnable

2886 routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode

2887 recoveryInitialShards = pure . RecoveryInitialShards

2888 gcDeletes = pure . GCDeletes . ndtJSON

2889 ttlDisablePurge = pure . TTLDisablePurge

2890 translogFSType = pure . TranslogFSType

2891 compoundFormat = pure . IndexCompoundFormat

2892 compoundOnFlush = pure . IndexCompoundOnFlush

2893 warmerEnabled = pure . WarmerEnabled

2894 blocksReadOnly = pure . BlocksReadOnly

2895 blocksRead = pure . BlocksRead

2896 blocksWrite = pure . BlocksWrite

2897 blocksMetaData = pure . BlocksMetaData

2898

2899instance FromJSON IndexSettingsSummary where

2900 parseJSON = withObject "IndexSettingsSummary" parse

2901 where parse o = case HM.toList o of

2902 [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)

2903 <$> parseJSON v

2904 <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")

2905 _ -> fail "Expected single-key object with index name"

2906 redundant (NumberOfReplicas _) = True

2907 redundant _ = False

2908

2909-- | For some reason in the settings API, all leaf values get returned

2910-- as strings. This function attepmts to recover from this for all

2911-- non-recursive JSON types. If nothing can be done or the same value

2912-- would be return, it returns 'mzero'

2913unStringlyTypeJSON :: MonadPlus m => Value -> m Value

2914unStringlyTypeJSON (String "true") = return (Bool True)

2915unStringlyTypeJSON (String "false") = return (Bool False)

2916unStringlyTypeJSON (String "null") = return Null

2917unStringlyTypeJSON (String t) = case readMay (T.unpack t) of

2918 Just n -> return (Number n)

2919 Nothing -> mzero

2920unStringlyTypeJSON _ = mzero

2921

2922

2923parseSettings :: Object -> Parser [UpdatableIndexSetting]

2924parseSettings o = do

2925 o' <- o .: "index"

2926 -- slice the index object into singleton hashmaps and try to parse each

2927 parses <- forM (HM.toList o') $ \(k, v) -> do

2928 -- blocks are now nested into the "index" key, which is not how they're serialized

2929 let atRoot = Object (HM.singleton k v)

2930 let atIndex = Object (HM.singleton "index" atRoot)

2931 optional (parseJSON atRoot <|> parseJSON atIndex)

2932 return (catMaybes parses)

2933

2934oPath :: ToJSON a => NonEmpty Text -> a -> Value

2935oPath (k :| []) v = object [k .= v]

2936oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]

2937

2938attrFilterJSON :: NonEmpty NodeAttrFilter -> Value

2939attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)

2940 | NodeAttrFilter (NodeAttrName n) vs <- toList fs]

2941

2942parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)

2943parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse

2944 where parse o = case HM.toList o of

2945 [] -> fail "Expected non-empty list of NodeAttrFilters"

2946 x:xs -> DT.mapM (uncurry parse') (x :| xs)

2947 parse' n = withText "Text" $ \t ->

2948 case T.splitOn "," t of

2949 fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))

2950 [] -> fail "Expected non-empty list of filter values"

2951

2952instance ToJSON ReplicaBounds where

2953 toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)

2954 toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")

2955 toJSON ReplicasUnbounded = Bool False

2956

2957instance FromJSON ReplicaBounds where

2958 parseJSON v = withText "ReplicaBounds" parseText v

2959 <|> withBool "ReplicaBounds" parseBool v

2960 where parseText t = case T.splitOn "-" t of

2961 [a, "all"] -> ReplicasLowerBounded <$> parseReadText a

2962 [a, b] -> ReplicasBounded <$> parseReadText a

2963 <*> parseReadText b

2964 _ -> fail ("Could not parse ReplicaBounds: " <> show t)

2965 parseBool False = pure ReplicasUnbounded

2966 parseBool _ = fail "ReplicasUnbounded cannot be represented with True"

2967

2968instance ToJSON AllocationPolicy where

2969 toJSON AllocAll = String "all"

2970 toJSON AllocPrimaries = String "primaries"

2971 toJSON AllocNewPrimaries = String "new_primaries"

2972 toJSON AllocNone = String "none"

2973

2974instance FromJSON AllocationPolicy where

2975 parseJSON = withText "AllocationPolicy" parse

2976 where parse "all" = pure AllocAll

2977 parse "primaries" = pure AllocPrimaries

2978 parse "new_primaries" = pure AllocNewPrimaries

2979 parse "none" = pure AllocNone

2980 parse t = fail ("Invlaid AllocationPolicy: " <> show t)

2981

2982instance ToJSON InitialShardCount where

2983 toJSON QuorumShards = String "quorum"

2984 toJSON QuorumMinus1Shards = String "quorum-1"

2985 toJSON FullShards = String "full"

2986 toJSON FullMinus1Shards = String "full-1"

2987 toJSON (ExplicitShards x) = toJSON x

2988

2989instance FromJSON InitialShardCount where

2990 parseJSON v = withText "InitialShardCount" parseText v

2991 <|> ExplicitShards <$> parseJSON v

2992 where parseText "quorum" = pure QuorumShards

2993 parseText "quorum-1" = pure QuorumMinus1Shards

2994 parseText "full" = pure FullShards

2995 parseText "full-1" = pure FullMinus1Shards

2996 parseText _ = mzero

2997

2998instance ToJSON FSType where

2999 toJSON FSSimple = "simple"

3000 toJSON FSBuffered = "buffered"

3001

3002instance FromJSON FSType where

3003 parseJSON = withText "FSType" parse

3004 where parse "simple" = pure FSSimple

3005 parse "buffered" = pure FSBuffered

3006 parse t = fail ("Invalid FSType: " <> show t)

3007

3008instance ToJSON CompoundFormat where

3009 toJSON (CompoundFileFormat x) = Bool x

3010 toJSON (MergeSegmentVsTotalIndex x) = toJSON x

3011

3012instance FromJSON CompoundFormat where

3013 parseJSON v = CompoundFileFormat <$> parseJSON v

3014 <|> MergeSegmentVsTotalIndex <$> parseJSON v

3015

3016instance ToJSON NominalDiffTimeJSON where

3017 toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")

3018

3019instance FromJSON NominalDiffTimeJSON where

3020 parseJSON = withText "NominalDiffTime" parse

3021 where parse t = case T.takeEnd 1 t of

3022 "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)

3023 _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"

3024

3025instance ToJSON IndexTemplate where

3026 toJSON (IndexTemplate p s m) = merge

3027 (object [ "template" .= p

3028 , "mappings" .= foldl' merge (object []) m

3029 ])

3030 (toJSON s)

3031 where

3032 merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2

3033 merge o Null = o

3034 merge _ _ = undefined

3035

3036instance (FromJSON a) => FromJSON (EsResult a) where

3037 parseJSON jsonVal@(Object v) = do

3038 found <- v .:? "found" .!= False

3039 fr <- if found

3040 then parseJSON jsonVal

3041 else return Nothing

3042 EsResult <$> v .: "_index" <*>

3043 v .: "_type" <*>

3044 v .: "_id" <*>

3045 pure fr

3046 parseJSON _ = empty

3047

3048instance (FromJSON a) => FromJSON (EsResultFound a) where

3049 parseJSON (Object v) = EsResultFound <$>

3050 v .: "_version" <*>

3051 v .: "_source"

3052 parseJSON _ = empty

3053

3054instance FromJSON EsError where

3055 parseJSON (Object v) = EsError <$>

3056 v .: "status" <*>

3057 v .: "error"

3058 parseJSON _ = empty

3059

3060instance FromJSON IndexAliasesSummary where

3061 parseJSON = withObject "IndexAliasesSummary" parse

3062 where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)

3063 go ixn = withObject "index aliases" $ \ia -> do

3064 aliases <- ia .:? "aliases" .!= mempty

3065 forM (HM.toList aliases) $ \(aName, v) -> do

3066 let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))

3067 IndexAliasSummary indexAlias <$> parseJSON v

3068

3069

3070instance ToJSON IndexAliasAction where

3071 toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]

3072 where Object iaObj = toJSON ia

3073 Object optsObj = toJSON opts

3074 toJSON (RemoveAlias ia) = object ["remove" .= iaObj]

3075 where Object iaObj = toJSON ia

3076

3077instance ToJSON IndexAlias where

3078 toJSON IndexAlias {..} = object ["index" .= srcIndex

3079 , "alias" .= indexAlias

3080 ]

3081

3082instance ToJSON IndexAliasCreate where

3083 toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)

3084 where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter

3085 Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting

3086

3087instance ToJSON AliasRouting where

3088 toJSON (AllAliasRouting v) = object ["routing" .= v]

3089 toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)

3090 where prs = [("search_routing" .=) <$> srch

3091 ,("index_routing" .=) <$> idx]

3092

3093instance FromJSON AliasRouting where

3094 parseJSON = withObject "AliasRouting" parse

3095 where parse o = parseAll o <|> parseGranular o

3096 parseAll o = AllAliasRouting <$> o .: "routing"

3097 parseGranular o = do

3098 sr <- o .:? "search_routing"

3099 ir <- o .:? "index_routing"

3100 if isNothing sr && isNothing ir

3101 then fail "Both search_routing and index_routing can't be blank"

3102 else return (GranularAliasRouting sr ir)

3103

3104instance FromJSON IndexAliasCreate where

3105 parseJSON v = withObject "IndexAliasCreate" parse v

3106 where parse o = IndexAliasCreate <$> optional (parseJSON v)

3107 <*> o .:? "filter"

3108

3109instance ToJSON SearchAliasRouting where

3110 toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))

3111

3112instance FromJSON SearchAliasRouting where

3113 parseJSON = withText "SearchAliasRouting" parse

3114 where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)

3115

3116instance ToJSON Search where

3117 toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =

3118 omitNulls [ "query" .= query

3119 , "filter" .= sFilter

3120 , "sort" .= sort

3121 , "aggregations" .= searchAggs

3122 , "highlight" .= highlight

3123 , "from" .= sFrom

3124 , "size" .= sSize

3125 , "track_scores" .= sTrackSortScores

3126 , "fields" .= sFields

3127 , "_source" .= sSource]

3128

3129

3130instance ToJSON Source where

3131 toJSON NoSource = toJSON False

3132 toJSON (SourcePatterns patterns) = toJSON patterns

3133 toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]

3134

3135instance ToJSON PatternOrPatterns where

3136 toJSON (PopPattern pattern) = toJSON pattern

3137 toJSON (PopPatterns patterns) = toJSON patterns

3138

3139instance ToJSON Include where

3140 toJSON (Include patterns) = toJSON patterns

3141

3142instance ToJSON Exclude where

3143 toJSON (Exclude patterns) = toJSON patterns

3144

3145instance ToJSON Pattern where

3146 toJSON (Pattern pattern) = toJSON pattern

3147

3148

3149instance ToJSON FieldHighlight where

3150 toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =

3151 object [ fName .= fSettings ]

3152 toJSON (FieldHighlight (FieldName fName) Nothing) =

3153 object [ fName .= emptyObject ]

3154

3155instance ToJSON Highlights where

3156 toJSON (Highlights global fields) =

3157 omitNulls (("fields" .= fields)

3158 : highlightSettingsPairs global)

3159

3160instance ToJSON HighlightSettings where

3161 toJSON hs = omitNulls (highlightSettingsPairs (Just hs))

3162

3163highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]

3164highlightSettingsPairs Nothing = []

3165highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)

3166highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)

3167highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)

3168

3169

3170plainHighPairs :: Maybe PlainHighlight -> [Pair]

3171plainHighPairs Nothing = []

3172plainHighPairs (Just (PlainHighlight plCom plNonPost)) =

3173 [ "type" .= String "plain"]

3174 ++ commonHighlightPairs plCom

3175 ++ nonPostingsToPairs plNonPost

3176

3177postHighPairs :: Maybe PostingsHighlight -> [Pair]

3178postHighPairs Nothing = []

3179postHighPairs (Just (PostingsHighlight pCom)) =

3180 ("type" .= String "postings")

3181 : commonHighlightPairs pCom

3182

3183fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]

3184fastVectorHighPairs Nothing = []

3185fastVectorHighPairs (Just

3186 (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars

3187 fvBoundMaxScan fvFragOff fvMatchedFields

3188 fvPhraseLim)) =

3189 [ "type" .= String "fvh"

3190 , "boundary_chars" .= fvBoundChars

3191 , "boundary_max_scan" .= fvBoundMaxScan

3192 , "fragment_offset" .= fvFragOff

3193 , "matched_fields" .= fvMatchedFields

3194 , "phraseLimit" .= fvPhraseLim]

3195 ++ commonHighlightPairs fvCom

3196 ++ nonPostingsToPairs fvNonPostSettings

3197

3198deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v

3199deleteSeveral ks hm = foldr HM.delete hm ks

3200

3201commonHighlightPairs :: Maybe CommonHighlight -> [Pair]

3202commonHighlightPairs Nothing = []

3203commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder

3204 chNoMatchSize chHighlightQuery

3205 chRequireFieldMatch)) =

3206 [ "order" .= chScore

3207 , "force_source" .= chForceSource

3208 , "encoder" .= chEncoder

3209 , "no_match_size" .= chNoMatchSize

3210 , "highlight_query" .= chHighlightQuery

3211 , "require_fieldMatch" .= chRequireFieldMatch]

3212 ++ highlightTagToPairs chTag

3213

3214

3215nonPostingsToPairs :: Maybe NonPostings -> [Pair]

3216nonPostingsToPairs Nothing = []

3217nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =

3218 [ "fragment_size" .= npFragSize

3219 , "number_of_fragments" .= npNumOfFrags]

3220

3221parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)

3222parseNEJSON [] = fail "Expected non-empty list"

3223parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)

3224

3225

3226instance ToJSON HighlightEncoder where

3227 toJSON DefaultEncoder = String "default"

3228 toJSON HTMLEncoder = String "html"

3229

3230highlightTagToPairs :: Maybe HighlightTag -> [Pair]

3231highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]

3232highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre

3233 , "post_tags" .= post]

3234highlightTagToPairs Nothing = []

3235

3236instance ToJSON SortSpec where

3237 toJSON (DefaultSortSpec

3238 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

3239 dsSortMode dsMissingSort dsNestedFilter)) =

3240 object [dsSortFieldName .= omitNulls base] where

3241 base = [ "order" .= dsSortOrder

3242 , "ignore_unmapped" .= dsIgnoreUnmapped

3243 , "mode" .= dsSortMode

3244 , "missing" .= dsMissingSort

3245 , "nested_filter" .= dsNestedFilter ]

3246

3247 toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =

3248 object [ "unit" .= units

3249 , field .= gdsLatLon

3250 , "order" .= gdsSortOrder ]

3251

3252

3253instance ToJSON SortOrder where

3254 toJSON Ascending = String "asc"

3255 toJSON Descending = String "desc"

3256

3257

3258instance ToJSON SortMode where

3259 toJSON SortMin = String "min"

3260 toJSON SortMax = String "max"

3261 toJSON SortSum = String "sum"

3262 toJSON SortAvg = String "avg"

3263

3264

3265instance ToJSON Missing where

3266 toJSON LastMissing = String "_last"

3267 toJSON FirstMissing = String "_first"

3268 toJSON (CustomMissing txt) = String txt

3269

3270

3271instance ToJSON ScoreType where

3272 toJSON ScoreTypeMax = "max"

3273 toJSON ScoreTypeAvg = "avg"

3274 toJSON ScoreTypeSum = "sum"

3275 toJSON ScoreTypeNone = "none"

3276

3277instance FromJSON ScoreType where

3278 parseJSON = withText "ScoreType" parse

3279 where parse "max" = pure ScoreTypeMax

3280 parse "avg" = pure ScoreTypeAvg

3281 parse "sum" = pure ScoreTypeSum

3282 parse "none" = pure ScoreTypeNone

3283 parse t = fail ("Unexpected ScoreType: " <> show t)

3284

3285instance ToJSON Distance where

3286 toJSON (Distance dCoefficient dUnit) =

3287 String boltedTogether where

3288 coefText = showText dCoefficient

3289 (String unitText) = toJSON dUnit

3290 boltedTogether = mappend coefText unitText

3291

3292instance FromJSON Distance where

3293 parseJSON = withText "Distance" parse

3294 where parse t = Distance <$> parseCoeff nT

3295 <*> parseJSON (String unitT)

3296 where (nT, unitT) = T.span validForNumber t

3297 -- may be a better way to do this

3298 validForNumber '-' = True

3299 validForNumber '.' = True

3300 validForNumber 'e' = True

3301 validForNumber c = isNumber c

3302 parseCoeff "" = fail "Empty string cannot be parsed as number"

3303 parseCoeff s = return (read (T.unpack s))

3304

3305instance ToJSON DistanceUnit where

3306 toJSON Miles = String "mi"

3307 toJSON Yards = String "yd"

3308 toJSON Feet = String "ft"

3309 toJSON Inches = String "in"

3310 toJSON Kilometers = String "km"

3311 toJSON Meters = String "m"

3312 toJSON Centimeters = String "cm"

3313 toJSON Millimeters = String "mm"

3314 toJSON NauticalMiles = String "nmi"

3315

3316

3317instance FromJSON DistanceUnit where

3318 parseJSON = withText "DistanceUnit" parse

3319 where parse "mi" = pure Miles

3320 parse "yd" = pure Yards

3321 parse "ft" = pure Feet

3322 parse "in" = pure Inches

3323 parse "km" = pure Kilometers

3324 parse "m" = pure Meters

3325 parse "cm" = pure Centimeters

3326 parse "mm" = pure Millimeters

3327 parse "nmi" = pure NauticalMiles

3328 parse u = fail ("Unrecognized DistanceUnit: " <> show u)

3329

3330instance ToJSON DistanceType where

3331 toJSON Arc = String "arc"

3332 toJSON SloppyArc = String "sloppy_arc"

3333 toJSON Plane = String "plane"

3334

3335instance FromJSON DistanceType where

3336 parseJSON = withText "DistanceType" parse

3337 where parse "arc" = pure Arc

3338 parse "sloppy_arc" = pure SloppyArc

3339 parse "plane" = pure Plane

3340 parse t = fail ("Unrecognized DistanceType: " <> show t)

3341

3342

3343instance ToJSON OptimizeBbox where

3344 toJSON NoOptimizeBbox = String "none"

3345 toJSON (OptimizeGeoFilterType gft) = toJSON gft

3346

3347instance FromJSON OptimizeBbox where

3348 parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v

3349 <|> parseOptimize v

3350 where parseNoOptimize "none" = pure NoOptimizeBbox

3351 parseNoOptimize _ = mzero

3352 parseOptimize = fmap OptimizeGeoFilterType . parseJSON

3353

3354instance ToJSON GeoBoundingBoxConstraint where

3355 toJSON (GeoBoundingBoxConstraint

3356 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =

3357 object [gbbcGeoBBField .= gbbcConstraintBox

3358 , "_cache" .= cache

3359 , "type" .= type']

3360

3361instance FromJSON GeoBoundingBoxConstraint where

3362 parseJSON = withObject "GeoBoundingBoxConstraint" parse

3363 where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of

3364 [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)

3365 <$> parseJSON v

3366 <*> o .:? "_cache" .!= defaultCache

3367 <*> o .: "type"

3368 _ -> fail "Could not find field name for GeoBoundingBoxConstraint"

3369

3370instance ToJSON GeoFilterType where

3371 toJSON GeoFilterMemory = String "memory"

3372 toJSON GeoFilterIndexed = String "indexed"

3373

3374instance FromJSON GeoFilterType where

3375 parseJSON = withText "GeoFilterType" parse

3376 where parse "memory" = pure GeoFilterMemory

3377 parse "indexed" = pure GeoFilterIndexed

3378 parse t = fail ("Unrecognized GeoFilterType: " <> show t)

3379

3380instance ToJSON GeoBoundingBox where

3381 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =

3382 object ["top_left" .= gbbTopLeft

3383 , "bottom_right" .= gbbBottomRight]

3384

3385instance FromJSON GeoBoundingBox where

3386 parseJSON = withObject "GeoBoundingBox" parse

3387 where parse o = GeoBoundingBox

3388 <$> o .: "top_left"

3389 <*> o .: "bottom_right"

3390

3391instance ToJSON LatLon where

3392 toJSON (LatLon lLat lLon) =

3393 object ["lat" .= lLat

3394 , "lon" .= lLon]

3395

3396instance FromJSON LatLon where

3397 parseJSON = withObject "LatLon" parse

3398 where parse o = LatLon <$> o .: "lat"

3399 <*> o .: "lon"

3400

3401-- index for smaller ranges, fielddata for longer ranges

3402instance ToJSON RangeExecution where

3403 toJSON RangeExecutionIndex = "index"

3404 toJSON RangeExecutionFielddata = "fielddata"

3405

3406

3407instance FromJSON RangeExecution where

3408 parseJSON = withText "RangeExecution" parse

3409 where parse "index" = pure RangeExecutionIndex

3410 parse "fielddata" = pure RangeExecutionFielddata

3411 parse t = error ("Unrecognized RangeExecution " <> show t)

3412

3413instance ToJSON RegexpFlags where

3414 toJSON AllRegexpFlags = String "ALL"

3415 toJSON NoRegexpFlags = String "NONE"

3416 toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs

3417 where flagStrs = map flagStr . nub $ h:fs

3418 flagStr AnyString = "ANYSTRING"

3419 flagStr Automaton = "AUTOMATON"

3420 flagStr Complement = "COMPLEMENT"

3421 flagStr Empty = "EMPTY"

3422 flagStr Intersection = "INTERSECTION"

3423 flagStr Interval = "INTERVAL"

3424

3425instance FromJSON RegexpFlags where

3426 parseJSON = withText "RegexpFlags" parse

3427 where parse "ALL" = pure AllRegexpFlags

3428 parse "NONE" = pure NoRegexpFlags

3429 parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)

3430

3431instance FromJSON RegexpFlag where

3432 parseJSON = withText "RegexpFlag" parse

3433 where parse "ANYSTRING" = pure AnyString

3434 parse "AUTOMATON" = pure Automaton

3435 parse "COMPLEMENT" = pure Complement

3436 parse "EMPTY" = pure Empty

3437 parse "INTERSECTION" = pure Intersection

3438 parse "INTERVAL" = pure Interval

3439 parse f = fail ("Unknown RegexpFlag: " <> show f)

3440

3441instance ToJSON Term where

3442 toJSON (Term field value) = object ["term" .= object

3443 [field .= value]]

3444

3445instance FromJSON Term where

3446 parseJSON = withObject "Term" parse

3447 where parse o = do termObj <- o .: "term"

3448 case HM.toList termObj of

3449 [(fn, v)] -> Term fn <$> parseJSON v

3450 _ -> fail "Expected object with 1 field-named key"

3451

3452instance ToJSON BoolMatch where

3453 toJSON (MustMatch term cache) = object ["must" .= term,

3454 "_cache" .= cache]

3455 toJSON (MustNotMatch term cache) = object ["must_not" .= term,

3456 "_cache" .= cache]

3457 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,

3458 "_cache" .= cache]

3459

3460instance FromJSON BoolMatch where

3461 parseJSON = withObject "BoolMatch" parse

3462 where parse o = mustMatch `taggedWith` "must"

3463 <|> mustNotMatch `taggedWith` "must_not"

3464 <|> shouldMatch `taggedWith` "should"

3465 where taggedWith parser k = parser =<< o .: k

3466 mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache

3467 mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache

3468 shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache

3469

3470instance (FromJSON a) => FromJSON (SearchResult a) where

3471 parseJSON (Object v) = SearchResult <$>

3472 v .: "took" <*>

3473 v .: "timed_out" <*>

3474 v .: "_shards" <*>

3475 v .: "hits" <*>

3476 v .:? "aggregations" <*>

3477 v .:? "_scroll_id"

3478 parseJSON _ = empty

3479

3480instance (FromJSON a) => FromJSON (SearchHits a) where

3481 parseJSON (Object v) = SearchHits <$>

3482 v .: "total" <*>

3483 v .: "max_score" <*>

3484 v .: "hits"

3485 parseJSON _ = empty

3486

3487instance (FromJSON a) => FromJSON (Hit a) where

3488 parseJSON (Object v) = Hit <$>

3489 v .: "_index" <*>

3490 v .: "_type" <*>

3491 v .: "_id" <*>

3492 v .: "_score" <*>

3493 v .:? "_source" <*>

3494 v .:? "highlight"

3495 parseJSON _ = empty

3496

3497instance FromJSON ShardResult where

3498 parseJSON (Object v) = ShardResult <$>

3499 v .: "total" <*>

3500 v .: "successful" <*>

3501 v .: "failed"

3502 parseJSON _ = empty

3503

3504

3505instance FromJSON DocVersion where

3506 parseJSON v = do

3507 i <- parseJSON v

3508 maybe (fail "DocVersion out of range") return $ mkDocVersion i

3509

3510-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings

3511instance FromJSON ReplicaCount where

3512 parseJSON v = parseAsInt v

3513 <|> parseAsString v

3514 where parseAsInt = fmap ReplicaCount . parseJSON

3515 parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)

3516

3517instance FromJSON ShardCount where

3518 parseJSON v = parseAsInt v

3519 <|> parseAsString v

3520 where parseAsInt = fmap ShardCount . parseJSON

3521 parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)

3522

3523instance Bounded DocVersion where

3524 minBound = DocVersion 1

3525 maxBound = DocVersion 9200000000000000000 -- 9.2e+18

3526

3527instance Enum DocVersion where

3528 succ x

3529 | x /= maxBound = DocVersion (succ $ docVersionNumber x)

3530 | otherwise = succError "DocVersion"

3531 pred x

3532 | x /= minBound = DocVersion (pred $ docVersionNumber x)

3533 | otherwise = predError "DocVersion"

3534 toEnum i =

3535 fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i

3536 fromEnum = docVersionNumber

3537 enumFrom = boundedEnumFrom

3538 enumFromThen = boundedEnumFromThen

3539

3540-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.

3541newtype EsUsername = EsUsername { esUsername :: Text } deriving (Show, Eq)

3542

3543-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.

3544newtype EsPassword = EsPassword { esPassword :: Text } deriving (Show, Eq)