99788cc · typeable/bloodhound

git.iko.soy/typeable/bloodhound

WIP v1 savepoint

I'm trying out the technique of loading a corresponding V5 module into GHCi, :browse-ing the exports, explicitly setting those for the V1 and then pulling definitions out of the old V1 types module. Working well so far.

commit99788cc992341d2cc1557657cd282b9d52ebcaf8 authorMichael Xavier <michael@michaelxavier.net> dateTue 20 Mar 2018, 15:47 (9 years ago) parent5b6c05f

10 files changed+2462−87

compare with master

unifiedsplit

src/Bloodhound/Import.hs+38−56 src/Database/V1/Bloodhound/Internal/Aggregation.hs+91−10 src/Database/V1/Bloodhound/Internal/Client.hs+133−16 src/Database/V1/Bloodhound/Internal/Newtypes.hs+161 src/Database/V1/Bloodhound/Internal/Query.hs+1683 src/Database/V1/Bloodhound/Internal/Sort.hs+79 src/Database/V1/Bloodhound/Internal/StringlyTyped.hs+25 src/Database/V1/Bloodhound/Internal/Suggest.hs+252 src/Database/V1/Bloodhound/Types.hs−2 src/Database/V5/Bloodhound/Internal/Query.hs−3

src/Bloodhound/Import.hs+38−56

@@ -7,65 +7,44 @@ module Bloodhound.Import

77 , parseReadText

88 , readMay

99 , showText

10+ , deleteSeveral

1011 ) where

1112

12−import Control.Applicative as X (Alternative(..), optional)

13−import Control.Exception as X (Exception)

14−import Control.Monad as X ( MonadPlus(..)

15− , (<=<)

16− , forM

17− )

18−import Control.Monad.Fix as X (MonadFix)

19−import Control.Monad.IO.Class as X (MonadIO(..))

20−import Control.Monad.Catch as X ( MonadCatch

21− , MonadMask

22− , MonadThrow

23− )

24−import Control.Monad.Except as X (MonadError)

25−import Control.Monad.Reader as X ( MonadReader (..)

26− , MonadTrans (..)

27− , ReaderT (..)

28− )

29−import Control.Monad.State as X (MonadState)

30−import Control.Monad.Writer as X (MonadWriter)

31−import Data.Aeson as X

32−import Data.Aeson.Types as X ( Pair

33− , Parser

34− , emptyObject

35− , parseEither

36− , parseMaybe

37− , typeMismatch

38− )

39−import Data.Bifunctor as X (first)

40−import Data.Char as X (isNumber)

41−import Data.Hashable as X (Hashable)

42−import Data.List as X ( foldl'

43− , intercalate

44− , nub

45− )

46−import Data.List.NonEmpty as X ( NonEmpty (..)

47− , toList

48− )

49−import Data.Maybe as X ( catMaybes

50− , fromMaybe

51− , isNothing

52− , maybeToList

53− )

54−import Data.Scientific as X (Scientific)

55−import Data.Semigroup as X (Semigroup(..))

56−import Data.Text as X (Text)

57−import Data.Time.Calendar as X ( Day(..)

58− , showGregorian

59− )

60−import Data.Time.Clock as X ( NominalDiffTime

61− , UTCTime

62− )

63−import Data.Time.Clock.POSIX as X

13+import Control.Applicative as X (Alternative (..), optional)

14+import Control.Exception as X (Exception)

15+import Control.Monad as X (MonadPlus (..), forM, (<=<))

16+import Control.Monad.Catch as X (MonadCatch, MonadMask,

17+ MonadThrow)

18+import Control.Monad.Except as X (MonadError)

19+import Control.Monad.Fix as X (MonadFix)

20+import Control.Monad.IO.Class as X (MonadIO (..))

21+import Control.Monad.Reader as X (MonadReader (..),

22+ MonadTrans (..), ReaderT (..))

23+import Control.Monad.State as X (MonadState)

24+import Control.Monad.Writer as X (MonadWriter)

25+import Data.Aeson as X

26+import Data.Aeson.Types as X (Pair, Parser, emptyObject,

27+ parseEither, parseMaybe,

28+ typeMismatch)

29+import Data.Bifunctor as X (first)

30+import Data.Char as X (isNumber)

31+import Data.Hashable as X (Hashable)

32+import qualified Data.HashMap.Strict as HM

33+import Data.List as X (foldl', intercalate, nub)

34+import Data.List.NonEmpty as X (NonEmpty (..), toList)

35+import Data.Maybe as X (catMaybes, fromMaybe,

36+ isNothing, maybeToList)

37+import Data.Scientific as X (Scientific)

38+import Data.Semigroup as X (Semigroup (..))

39+import Data.Text as X (Text)

40+import Data.Time.Calendar as X (Day (..), showGregorian)

41+import Data.Time.Clock as X (NominalDiffTime, UTCTime)

42+import Data.Time.Clock.POSIX as X

6443

65−import qualified Data.ByteString.Lazy as BL

66−import qualified Data.Text as T

67−import qualified Data.Traversable as DT

68−import qualified Data.Vector as V

44+import qualified Data.ByteString.Lazy as BL

45+import qualified Data.Text as T

46+import qualified Data.Traversable as DT

47+import qualified Data.Vector as V

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

7049

7150type LByteString = BL.ByteString

@@ -92,3 +71,6 @@ omitNulls = object . filter notNull where

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

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

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

74+

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

76+deleteSeveral ks hm = foldr HM.delete hm ks

src/Database/V1/Bloodhound/Internal/Aggregation.hs+91−10

@@ -1,9 +1,17 @@

1+{-# LANGUAGE RecordWildCards #-}

13module Database.V1.Bloodhound.Internal.Aggregation where

35import Bloodhound.Import

7+import qualified Data.HashMap.Strict as HM

8+import qualified Data.Map.Strict as M

59import Data.Text

6−import qualified Data.Text as T

10+import qualified Data.Text as T

11+

12+import Database.V1.Bloodhound.Internal.Newtypes

13+import Database.V1.Bloodhound.Internal.Query

14+import Database.V1.Bloodhound.Internal.Sort

715

816

917type Aggregations = M.Map Text Aggregation

@@ -22,7 +30,7 @@ data Aggregation = TermsAgg TermsAggregation

2230 | DateRangeAgg DateRangeAggregation

2331 | MissingAgg MissingAggregation

2432 | TopHitsAgg TopHitsAggregation

25− deriving (Eq, Read, Show, Generic, Typeable)

33+ deriving (Eq, Show)

2634

2735

2836instance ToJSON Aggregation where

@@ -84,7 +92,7 @@ data TopHitsAggregation = TopHitsAggregation

8492

8593data MissingAggregation = MissingAggregation

8694 { maField :: Text

87− } deriving (Eq, Read, Show, Generic, Typeable)

95+ } deriving (Eq, Show)

8896

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

9098 , termInclude :: Maybe TermInclusion

@@ -96,11 +104,11 @@ data TermsAggregation = TermsAggregation { term :: Either Text Text

96104 , termCollectMode :: Maybe CollectionMode

97105 , termExecutionHint :: Maybe ExecutionHint

98106 , termAggs :: Maybe Aggregations

99− } deriving (Eq, Read, Show, Generic, Typeable)

107+ } deriving (Eq, Show)

100108

101109data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,

102110 precisionThreshold :: Maybe Int

103− } deriving (Eq, Read, Show, Generic, Typeable)

111+ } deriving (Eq, Show)

104112

105113data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName

106114 , dateInterval :: Interval

@@ -111,25 +119,25 @@ data DateHistogramAggregation = DateHistogramAggregation { dateField :: Fie

111119 , datePreOffset :: Maybe Text

112120 , datePostOffset :: Maybe Text

113121 , dateAggs :: Maybe Aggregations

114− } deriving (Eq, Read, Show, Generic, Typeable)

122+ } deriving (Eq, Show)

115123

116124

117125data DateRangeAggregation = DateRangeAggregation { draField :: FieldName

118126 , draFormat :: Maybe Text

119127 , draRanges :: NonEmpty DateRangeAggRange

120− } deriving (Eq, Read, Show, Generic, Typeable)

128+ } deriving (Eq, Show)

121129

122130data DateRangeAggRange = DateRangeFrom DateMathExpr

123131 | DateRangeTo DateMathExpr

124− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)

132+ | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Show)

125133

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

127135data ValueCountAggregation = FieldValueCount FieldName

128− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)

136+ | ScriptValueCount Script deriving (Eq, Show)

129137

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

131139data FilterAggregation = FilterAggregation { faFilter :: Filter

132− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)

140+ , faAggs :: Maybe Aggregations} deriving (Eq, Show)

133141

134142mkTermsAggregation :: Text -> TermsAggregation

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

@@ -143,3 +151,76 @@ mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothi

143151mkCardinalityAggregation :: FieldName -> CardinalityAggregation

144152mkCardinalityAggregation t = CardinalityAggregation t Nothing

145153

154+data TermInclusion = TermInclusion Text

155+ | TermPattern Text Text deriving (Eq, Show)

156+

157+instance ToJSON TermInclusion where

158+ toJSON (TermInclusion x) = toJSON x

159+ toJSON (TermPattern pattern flags) =

160+ omitNulls [ "pattern" .= pattern

161+ , "flags" .= flags]

162+

163+data TermOrder = TermOrder

164+ { termSortField :: Text

165+ , termSortOrder :: SortOrder } deriving (Eq, Show)

166+

167+instance ToJSON TermOrder where

168+ toJSON (TermOrder termSortField termSortOrder) =

169+ object [termSortField .= termSortOrder]

170+

171+

172+data ExecutionHint = Ordinals

173+ | GlobalOrdinals

174+ | GlobalOrdinalsHash

175+ | GlobalOrdinalsLowCardinality

176+ | Map deriving (Eq, Show)

177+

178+instance ToJSON ExecutionHint where

179+ toJSON Ordinals = "ordinals"

180+ toJSON GlobalOrdinals = "global_ordinals"

181+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"

182+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"

183+ toJSON Map = "map"

184+

185+

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

187+data DateMathExpr =

188+ DateMathExpr DateMathAnchor [DateMathModifier]

189+ deriving (Eq, Show)

190+

191+instance ToJSON DateMathExpr where

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

193+ where fmtA DMNow = "now"

194+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"

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

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

197+ fmtMod (RoundDownTo u) = "/" <> fmtU u

198+ fmtU DMYear = "y"

199+ fmtU DMMonth = "M"

200+ fmtU DMWeek = "w"

201+ fmtU DMDay = "d"

202+ fmtU DMHour = "h"

203+ fmtU DMMinute = "m"

204+ fmtU DMSecond = "s"

205+

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

207+data DateMathAnchor =

208+ DMNow

209+ | DMDate Day

210+ deriving (Eq, Show)

211+

212+data DateMathModifier =

213+ AddTime Int DateMathUnit

214+ | SubtractTime Int DateMathUnit

215+ | RoundDownTo DateMathUnit

216+ deriving (Eq, Show)

217+

218+data DateMathUnit =

219+ DMYear

220+ | DMMonth

221+ | DMWeek

222+ | DMDay

223+ | DMHour

224+ | DMMinute

225+ | DMSecond

226+ deriving (Eq, Show)

src/Database/V1/Bloodhound/Internal/Client.hs+133−16

@@ -1,13 +1,21 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

4+{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE UndecidableInstances #-}

17module Database.V1.Bloodhound.Internal.Client where

9+import Bloodhound.Import

310

4−import Control.Applicative as A

5−import Control.Monad.Reader

6−import Data.Aeson

7−import Data.Text (Text)

8−import Data.Typeable (Typeable)

9−import GHC.Generics (Generic)

11+import Control.Applicative as A

12+import Data.Text (Text)

13+import qualified Data.Version as Vers

1014import Network.HTTP.Client

15+import Text.Read (Read (..))

16+import qualified Text.Read as TR

17+

18+import Database.V1.Bloodhound.Internal.Newtypes

1119

1220

1321{-| Common environment for Elasticsearch calls. Connections will be

@@ -24,7 +32,7 @@ instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) wher

2432

2533{-| 'Server' is used with the client functions to point at the ES instance

2634-}

27−newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)

35+newtype Server = Server Text deriving (Eq, Show, FromJSON)

2836

2937{-| All API calls to Elasticsearch operate within

3038 MonadBH

@@ -89,11 +97,11 @@ data Version = Version { number :: VersionNumber

8997 , build_hash :: BuildHash

9098 , build_timestamp :: UTCTime

9199 , build_snapshot :: Bool

92− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)

100+ , lucene_version :: VersionNumber } deriving (Eq, Show)

93101

94102-- | Traditional software versioning number

95103newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version

96− } deriving (Eq, Read, Show, Generic, Typeable, Ord)

104+ } deriving (Eq, Show, Ord)

97105

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

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

@@ -105,7 +113,7 @@ data Status = Status { ok :: Maybe Bool

105113 , status :: Int

106114 , name :: Text

107115 , version :: Version

108− , tagline :: Text } deriving (Eq, Read, Show, Generic)

116+ , tagline :: Text } deriving (Eq, Show)

109117

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

111119 an Elasticsearch Index.

@@ -115,7 +123,7 @@ data Status = Status { ok :: Maybe Bool

115123

116124data IndexSettings =

117125 IndexSettings { indexShards :: ShardCount

118− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)

126+ , indexReplicas :: ReplicaCount } deriving (Eq, Show)

119127

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

121129defaultIndexSettings :: IndexSettings

@@ -133,7 +141,7 @@ data IndexOptimizationSettings =

133141 -- ^ Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.

134142 , flushAfterOptimize :: Bool

135143 -- ^ Should a flush be performed after the optimize.

136− } deriving (Eq, Show, Generic, Typeable)

144+ } deriving (Eq, Show)

137145

138146

139147{-| 'defaultIndexOptimizationSettings' implements the default settings that

@@ -195,7 +203,7 @@ data UpdatableIndexSetting = NumberOfReplicas ReplicaCount

195203 | IndexCompoundFormat CompoundFormat

196204 | IndexCompoundOnFlush Bool

197205 | WarmerEnabled Bool

198− deriving (Eq, Show, Generic, Typeable)

206+ deriving (Eq, Show)

199207

200208data AllocationPolicy = AllocAll

201209 -- ^ Allows shard allocation for all shards.

@@ -205,12 +213,12 @@ data AllocationPolicy = AllocAll

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

206214 | AllocNone

207215 -- ^ No shard allocation is allowed

208− deriving (Eq, Read, Show, Generic, Typeable)

216+ deriving (Eq, Show)

209217

210218data ReplicaBounds = ReplicasBounded Int Int

211219 | ReplicasLowerBounded Int

212220 | ReplicasUnbounded

213− deriving (Eq, Read, Show, Generic, Typeable)

221+ deriving (Eq, Show)

214222

215223-- | A measure of bytes used for various configurations. You may want

216224-- to use smart constructors like 'gigabytes' for larger values.

@@ -223,7 +231,7 @@ data ReplicaBounds = ReplicasBounded Int Int

223231--

224232-- >>> kilobytes 9

225233-- Bytes 9000

226−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)

234+newtype Bytes = Bytes Int deriving (Eq, Show, Ord, ToJSON, FromJSON)

227235

228236gigabytes :: Int -> Bytes

229237gigabytes n = megabytes (1000 * n)

@@ -235,3 +243,112 @@ megabytes n = kilobytes (1000 * n)

235243

236244kilobytes :: Int -> Bytes

237245kilobytes n = Bytes (1000 * n)

246+

247+

248+data Interval = Year

249+ | Quarter

250+ | Month

251+ | Week

252+ | Day

253+ | Hour

254+ | Minute

255+ | Second deriving (Eq, Show)

256+

257+instance ToJSON Interval where

258+ toJSON Year = "year"

259+ toJSON Quarter = "quarter"

260+ toJSON Month = "month"

261+ toJSON Week = "week"

262+ toJSON Day = "day"

263+ toJSON Hour = "hour"

264+ toJSON Minute = "minute"

265+ toJSON Second = "second"

266+

267+parseStringInterval :: (Monad m) => String -> m NominalDiffTime

268+parseStringInterval s = case span isNumber s of

269+ ("", _) -> fail "Invalid interval"

270+ (nS, unitS) -> case (readMay nS, readMay unitS) of

271+ (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))

272+ (Nothing, _) -> fail "Invalid interval number"

273+ (_, Nothing) -> fail "Invalid interval unit"

274+ where

275+ unitNDT Seconds = 1

276+ unitNDT Minutes = 60

277+ unitNDT Hours = 60 * 60

278+ unitNDT Days = 24 * 60 * 60

279+ unitNDT Weeks = 7 * 24 * 60 * 60

280+

281+data TimeInterval = Weeks

282+ | Days

283+ | Hours

284+ | Minutes

285+ | Seconds deriving Eq

286+

287+instance Show TimeInterval where

288+ show Weeks = "w"

289+ show Days = "d"

290+ show Hours = "h"

291+ show Minutes = "m"

292+ show Seconds = "s"

293+

294+instance Read TimeInterval where

295+ readPrec = f =<< TR.get

296+ where

297+ f 'w' = return Weeks

298+ f 'd' = return Days

299+ f 'h' = return Hours

300+ f 'm' = return Minutes

301+ f 's' = return Seconds

302+ f _ = fail "TimeInterval expected one of w, d, h, m, s"

303+

304+-- | Typically a 7 character hex string.

305+newtype BuildHash = BuildHash { buildHash :: Text }

306+ deriving (Eq, Ord, Show, FromJSON, ToJSON)

307+

308+data NodeAttrFilter = NodeAttrFilter

309+ { nodeAttrFilterName :: NodeAttrName

310+ , nodeAttrFilterValues :: NonEmpty Text }

311+ deriving (Eq, Ord, Show)

312+

313+newtype NodeAttrName = NodeAttrName Text deriving (Eq, Ord, Show)

314+

315+data InitialShardCount = QuorumShards

316+ | QuorumMinus1Shards

317+ | FullShards

318+ | FullMinus1Shards

319+ | ExplicitShards Int

320+ deriving (Eq, Show)

321+

322+instance FromJSON InitialShardCount where

323+ parseJSON v = withText "InitialShardCount" parseText v

324+ <|> ExplicitShards <$> parseJSON v

325+ where parseText "quorum" = pure QuorumShards

326+ parseText "quorum-1" = pure QuorumMinus1Shards

327+ parseText "full" = pure FullShards

328+ parseText "full-1" = pure FullMinus1Shards

329+ parseText _ = mzero

330+

331+instance ToJSON InitialShardCount where

332+ toJSON QuorumShards = String "quorum"

333+ toJSON QuorumMinus1Shards = String "quorum-1"

334+ toJSON FullShards = String "full"

335+ toJSON FullMinus1Shards = String "full-1"

336+ toJSON (ExplicitShards x) = toJSON x

337+

338+data FSType = FSSimple

339+ | FSBuffered deriving (Eq, Show)

340+

341+instance ToJSON FSType where

342+ toJSON FSSimple = "simple"

343+ toJSON FSBuffered = "buffered"

344+

345+instance FromJSON FSType where

346+ parseJSON = withText "FSType" parse

347+ where parse "simple" = pure FSSimple

348+ parse "buffered" = pure FSBuffered

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

350+

351+data CompoundFormat = CompoundFileFormat Bool

352+ | MergeSegmentVsTotalIndex Double

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

354+ deriving (Eq, Show)

src/Database/V1/Bloodhound/Internal/Newtypes.hsnew file+161

@@ -0,0 +1,161 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE OverloadedStrings #-}

4+module Database.V1.Bloodhound.Internal.Newtypes where

7+import Bloodhound.Import

10+newtype From = From Int deriving (Eq, Show, ToJSON)

11+newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON)

12+

13+

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

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

16+-}

17+newtype FieldName =

18+ FieldName Text

19+ deriving (Eq, Read, Show, ToJSON, FromJSON)

20+

21+newtype Boost =

22+ Boost Double

23+ deriving (Eq, Show, ToJSON, FromJSON)

24+

25+newtype BoostTerms =

26+ BoostTerms Double

27+ deriving (Eq, Show, ToJSON, FromJSON)

28+

29+{-| 'ReplicaCount' is part of 'IndexSettings' -}

30+newtype ReplicaCount =

31+ ReplicaCount Int

32+ deriving (Eq, Show, ToJSON)

33+

34+{-| 'ShardCount' is part of 'IndexSettings' -}

35+newtype ShardCount =

36+ ShardCount Int

37+ deriving (Eq, Show, ToJSON)

38+

39+

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

41+-}

42+newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON)

43+

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

45+-}

46+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)

47+

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

49+ the data in the indices.

50+-}

51+newtype MappingName = MappingName Text deriving (Eq, Show, ToJSON, FromJSON)

52+

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

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

55+ functions for poking at specific documents.

56+-}

57+newtype DocId = DocId Text deriving (Eq, Show, ToJSON, FromJSON)

58+

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

60+-}

61+newtype QueryString = QueryString Text deriving (Eq, Show, ToJSON, FromJSON)

62+

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

64+complex ways of extracting a value from a document.

65+-}

66+newtype Script = Script { scriptText :: Text } deriving (Eq, Show)

67+

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

69+ 'CacheKey' keyed caching behavior.

70+-}

71+newtype CacheName = CacheName Text deriving (Eq, Show, ToJSON, FromJSON)

72+

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

74+-}

75+newtype CacheKey =

76+ CacheKey Text deriving (Eq, Show, ToJSON, FromJSON)

77+newtype Existence =

78+ Existence Bool deriving (Eq, Show, ToJSON, FromJSON)

79+newtype NullValue =

80+ NullValue Bool deriving (Eq, Show, ToJSON, FromJSON)

81+newtype CutoffFrequency =

82+ CutoffFrequency Double deriving (Eq, Show, ToJSON, FromJSON)

83+newtype Analyzer =

84+ Analyzer Text deriving (Eq, Show, ToJSON, FromJSON)

85+newtype MaxExpansions =

86+ MaxExpansions Int deriving (Eq, Show, ToJSON, FromJSON)

87+

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

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

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

91+-}

92+newtype Lenient =

93+ Lenient Bool deriving (Eq, Show, ToJSON, FromJSON)

94+newtype Tiebreaker =

95+ Tiebreaker Double deriving (Eq, Show, ToJSON, FromJSON)

96+

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

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

99+ combination of both.

100+-}

101+newtype MinimumMatch =

102+ MinimumMatch Int deriving (Eq, Show, ToJSON, FromJSON)

103+newtype DisableCoord =

104+ DisableCoord Bool deriving (Eq, Show, ToJSON, FromJSON)

105+newtype IgnoreTermFrequency =

106+ IgnoreTermFrequency Bool deriving (Eq, Show, ToJSON, FromJSON)

107+newtype MinimumTermFrequency =

108+ MinimumTermFrequency Int deriving (Eq, Show, ToJSON, FromJSON)

109+newtype MaxQueryTerms =

110+ MaxQueryTerms Int deriving (Eq, Show, ToJSON, FromJSON)

111+newtype Fuzziness =

112+ Fuzziness Double deriving (Eq, Show, ToJSON, FromJSON)

113+

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

115+newtype PrefixLength =

116+ PrefixLength Int deriving (Eq, Show, ToJSON, FromJSON)

117+newtype TypeName =

118+ TypeName Text deriving (Eq, Show, ToJSON, FromJSON)

119+newtype PercentMatch =

120+ PercentMatch Double deriving (Eq, Show, ToJSON, FromJSON)

121+newtype StopWord =

122+ StopWord Text deriving (Eq, Show, ToJSON, FromJSON)

123+newtype QueryPath =

124+ QueryPath Text deriving (Eq, Show, ToJSON, FromJSON)

125+

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

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

128+ they match. Leading wildcards can be disabled by setting

129+ 'AllowLeadingWildcard' to false. -}

130+newtype AllowLeadingWildcard =

131+ AllowLeadingWildcard Bool deriving (Eq, Show, ToJSON, FromJSON)

132+newtype LowercaseExpanded =

133+ LowercaseExpanded Bool deriving (Eq, Show, ToJSON, FromJSON)

134+newtype EnablePositionIncrements =

135+ EnablePositionIncrements Bool deriving (Eq, Show, ToJSON, FromJSON)

136+

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

138+ Setting 'AnalyzeWildcard' to true enables best-effort analysis.

139+-}

140+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, ToJSON, FromJSON)

141+

142+{-| 'GeneratePhraseQueries' defaults to false.

143+-}

144+newtype GeneratePhraseQueries =

145+ GeneratePhraseQueries Bool deriving (Eq, Show, ToJSON, FromJSON)

146+

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

148+-}

149+newtype Locale = Locale Text deriving (Eq, Show, ToJSON, FromJSON)

150+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, ToJSON, FromJSON)

151+newtype MinWordLength = MinWordLength Int deriving (Eq, Show, ToJSON, FromJSON)

152+

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

154+ phrase matches. Default is 0.

155+-}

156+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, ToJSON, FromJSON)

157+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, ToJSON, FromJSON)

158+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, ToJSON, FromJSON)

159+

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

161+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }

src/Database/V1/Bloodhound/Internal/Query.hsnew file+1683

@@ -0,0 +1,1683 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

5+module Database.V1.Bloodhound.Internal.Query

6+ ( module X

7+ , module Database.V1.Bloodhound.Internal.Query

8+ ) where

10+

11+import Bloodhound.Import

12+

13+import qualified Data.HashMap.Strict as HM

14+import qualified Data.Text as T

15+

16+import Database.Bloodhound.Common.Script as X

17+import Database.V5.Bloodhound.Internal.Newtypes

18+

19+

20+data GeoPoint =

21+ GeoPoint { geoField :: FieldName

22+ , latLon :: LatLon} deriving (Eq, Show)

23+

24+instance ToJSON GeoPoint where

25+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

26+ object [ geoPointField .= geoPointLatLon ]

27+

28+

29+data LatLon = LatLon { lat :: Double

30+ , lon :: Double } deriving (Eq, Show)

31+

32+instance ToJSON LatLon where

33+ toJSON (LatLon lLat lLon) =

34+ object ["lat" .= lLat

35+ , "lon" .= lLon]

36+

37+instance FromJSON LatLon where

38+ parseJSON = withObject "LatLon" parse

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

40+ <*> o .: "lon"

41+

42+data DistanceUnit = Miles

43+ | Yards

44+ | Feet

45+ | Inches

46+ | Kilometers

47+ | Meters

48+ | Centimeters

49+ | Millimeters

50+ | NauticalMiles deriving (Eq, Show)

51+

52+instance ToJSON DistanceUnit where

53+ toJSON Miles = String "mi"

54+ toJSON Yards = String "yd"

55+ toJSON Feet = String "ft"

56+ toJSON Inches = String "in"

57+ toJSON Kilometers = String "km"

58+ toJSON Meters = String "m"

59+ toJSON Centimeters = String "cm"

60+ toJSON Millimeters = String "mm"

61+ toJSON NauticalMiles = String "nmi"

62+

63+instance FromJSON DistanceUnit where

64+ parseJSON = withText "DistanceUnit" parse

65+ where parse "mi" = pure Miles

66+ parse "yd" = pure Yards

67+ parse "ft" = pure Feet

68+ parse "in" = pure Inches

69+ parse "km" = pure Kilometers

70+ parse "m" = pure Meters

71+ parse "cm" = pure Centimeters

72+ parse "mm" = pure Millimeters

73+ parse "nmi" = pure NauticalMiles

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

75+

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

77+ 'Query's cannot be cached.

78+-}

79+type Cache = Bool -- caching on/off

80+

81+

82+data Filter = AndFilter [Filter] Cache

83+ | OrFilter [Filter] Cache

84+ | NotFilter Filter Cache

85+ | IdentityFilter

86+ | BoolFilter BoolMatch

87+ | ExistsFilter FieldName -- always cached

88+ | GeoBoundingBoxFilter GeoBoundingBoxConstraint

89+ | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache

90+ | GeoDistanceRangeFilter GeoPoint DistanceRange

91+ | GeoPolygonFilter FieldName [LatLon]

92+ | IdsFilter MappingName [DocId]

93+ | LimitFilter Int

94+ | MissingFilter FieldName Existence NullValue

95+ | PrefixFilter FieldName PrefixValue Cache

96+ | QueryFilter Query Cache

97+ | RangeFilter FieldName RangeValue RangeExecution Cache

98+ | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey

99+ | TermFilter Term Cache

100+ deriving (Eq, Show)

101+

102+

103+data BoolMatch = MustMatch Term Cache

104+ | MustNotMatch Term Cache

105+ | ShouldMatch [Term] Cache deriving (Eq, Show)

106+

107+data Term = Term { termField :: Text

108+ , termValue :: Text } deriving (Eq, Show)

109+

110+

111+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType

112+ | NoOptimizeBbox deriving (Eq, Show)

113+

114+

115+data Distance =

116+ Distance { coefficient :: Double

117+ , unit :: DistanceUnit } deriving (Eq, Show)

118+

119+data DistanceRange =

120+ DistanceRange { distanceFrom :: Distance

121+ , distanceTo :: Distance } deriving (Eq, Show)

122+

123+-- "memory" or "indexed"

124+data GeoFilterType = GeoFilterMemory

125+ | GeoFilterIndexed deriving (Eq, Show)

126+

127+data GeoBoundingBoxConstraint =

128+ GeoBoundingBoxConstraint { geoBBField :: FieldName

129+ , constraintBox :: GeoBoundingBox

130+ , bbConstraintcache :: Cache

131+ , geoType :: GeoFilterType

132+ } deriving (Eq, Show)

133+

134+

135+data DistanceType = Arc

136+ | SloppyArc -- doesn't exist <1.0

137+ | Plane deriving (Eq, Show)

138+

139+data GeoBoundingBox =

140+ GeoBoundingBox { topLeft :: LatLon

141+ , bottomRight :: LatLon } deriving (Eq, Show)

142+

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

144+-}

145+type PrefixValue = Text

146+

147+

148+data RangeValue = RangeDateLte LessThanEqD

149+ | RangeDateLt LessThanD

150+ | RangeDateGte GreaterThanEqD

151+ | RangeDateGt GreaterThanD

152+ | RangeDateGtLt GreaterThanD LessThanD

153+ | RangeDateGteLte GreaterThanEqD LessThanEqD

154+ | RangeDateGteLt GreaterThanEqD LessThanD

155+ | RangeDateGtLte GreaterThanD LessThanEqD

156+ | RangeDoubleLte LessThanEq

157+ | RangeDoubleLt LessThan

158+ | RangeDoubleGte GreaterThanEq

159+ | RangeDoubleGt GreaterThan

160+ | RangeDoubleGtLt GreaterThan LessThan

161+ | RangeDoubleGteLte GreaterThanEq LessThanEq

162+ | RangeDoubleGteLt GreaterThanEq LessThan

163+ | RangeDoubleGtLte GreaterThan LessThanEq

164+ deriving (Eq, Show)

165+

166+

167+newtype LessThan = LessThan Double deriving (Eq, Show)

168+newtype LessThanEq = LessThanEq Double deriving (Eq, Show)

169+newtype GreaterThan = GreaterThan Double deriving (Eq, Show)

170+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)

171+

172+newtype LessThanD = LessThanD UTCTime deriving (Eq, Show)

173+newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show)

174+newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show)

175+newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show)

176+

177+

178+data Query =

179+ TermQuery Term (Maybe Boost)

180+ | TermsQuery Text (NonEmpty Text)

181+ | QueryMatchQuery MatchQuery

182+ | QueryMultiMatchQuery MultiMatchQuery

183+ | QueryBoolQuery BoolQuery

184+ | QueryBoostingQuery BoostingQuery

185+ | QueryCommonTermsQuery CommonTermsQuery

186+ | ConstantScoreFilter Filter Boost

187+ | ConstantScoreQuery Query Boost

188+ | QueryDisMaxQuery DisMaxQuery

189+ | QueryFilteredQuery FilteredQuery

190+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery

191+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery

192+ | QueryFuzzyQuery FuzzyQuery

193+ | QueryHasChildQuery HasChildQuery

194+ | QueryHasParentQuery HasParentQuery

195+ | IdsQuery MappingName [DocId]

196+ | QueryIndicesQuery IndicesQuery

197+ | MatchAllQuery (Maybe Boost)

198+ | QueryMoreLikeThisQuery MoreLikeThisQuery

199+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery

200+ | QueryNestedQuery NestedQuery

201+ | QueryPrefixQuery PrefixQuery

202+ | QueryQueryStringQuery QueryStringQuery

203+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery

204+ | QueryRangeQuery RangeQuery

205+ | QueryRegexpQuery RegexpQuery

206+ | QueryTemplateQueryInline TemplateQueryInline

207+ deriving (Eq, Show)

208+

209+data RegexpQuery =

210+ RegexpQuery { regexpQueryField :: FieldName

211+ , regexpQuery :: Regexp

212+ , regexpQueryFlags :: RegexpFlags

213+ , regexpQueryBoost :: Maybe Boost

214+ } deriving (Eq, Show)

215+

216+data RangeQuery =

217+ RangeQuery { rangeQueryField :: FieldName

218+ , rangeQueryRange :: RangeValue

219+ , rangeQueryBoost :: Boost } deriving (Eq, Show)

220+

221+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery

222+mkRangeQuery f r = RangeQuery f r (Boost 1.0)

223+

224+data SimpleQueryStringQuery =

225+ SimpleQueryStringQuery

226+ { simpleQueryStringQuery :: QueryString

227+ , simpleQueryStringField :: Maybe FieldOrFields

228+ , simpleQueryStringOperator :: Maybe BooleanOperator

229+ , simpleQueryStringAnalyzer :: Maybe Analyzer

230+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)

231+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded

232+ , simpleQueryStringLocale :: Maybe Locale

233+ } deriving (Eq, Show)

234+

235+data SimpleQueryFlag =

236+ SimpleQueryAll

237+ | SimpleQueryNone

238+ | SimpleQueryAnd

239+ | SimpleQueryOr

240+ | SimpleQueryPrefix

241+ | SimpleQueryPhrase

242+ | SimpleQueryPrecedence

243+ | SimpleQueryEscape

244+ | SimpleQueryWhitespace

245+ | SimpleQueryFuzzy

246+ | SimpleQueryNear

247+ | SimpleQuerySlop deriving (Eq, Show)

248+

249+-- use_dis_max and tie_breaker when fields are plural?

250+data QueryStringQuery =

251+ QueryStringQuery

252+ { queryStringQuery :: QueryString

253+ , queryStringDefaultField :: Maybe FieldName

254+ , queryStringOperator :: Maybe BooleanOperator

255+ , queryStringAnalyzer :: Maybe Analyzer

256+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard

257+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded

258+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements

259+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions

260+ , queryStringFuzziness :: Maybe Fuzziness

261+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength

262+ , queryStringPhraseSlop :: Maybe PhraseSlop

263+ , queryStringBoost :: Maybe Boost

264+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard

265+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries

266+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch

267+ , queryStringLenient :: Maybe Lenient

268+ , queryStringLocale :: Maybe Locale

269+ } deriving (Eq, Show)

270+

271+mkQueryStringQuery :: QueryString -> QueryStringQuery

272+mkQueryStringQuery qs =

273+ QueryStringQuery qs Nothing Nothing

274+ Nothing Nothing Nothing Nothing

275+ Nothing Nothing Nothing Nothing

276+ Nothing Nothing Nothing Nothing

277+ Nothing Nothing

278+

279+data FieldOrFields = FofField FieldName

280+ | FofFields (NonEmpty FieldName) deriving (Eq, Show)

281+

282+data PrefixQuery =

283+ PrefixQuery

284+ { prefixQueryField :: FieldName

285+ , prefixQueryPrefixValue :: Text

286+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)

287+

288+data NestedQuery =

289+ NestedQuery

290+ { nestedQueryPath :: QueryPath

291+ , nestedQueryScoreType :: ScoreType

292+ , nestedQuery :: Query } deriving (Eq, Show)

293+

294+data MoreLikeThisFieldQuery =

295+ MoreLikeThisFieldQuery

296+ { moreLikeThisFieldText :: Text

297+ , moreLikeThisFieldFields :: FieldName

298+ -- default 0.3 (30%)

299+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch

300+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency

301+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms

302+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)

303+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency

304+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency

305+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength

306+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength

307+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms

308+ , moreLikeThisFieldBoost :: Maybe Boost

309+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer

310+ } deriving (Eq, Show)

311+

312+data MoreLikeThisQuery =

313+ MoreLikeThisQuery

314+ { moreLikeThisText :: Text

315+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)

316+ -- default 0.3 (30%)

317+ , moreLikeThisPercentMatch :: Maybe PercentMatch

318+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency

319+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms

320+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)

321+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency

322+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency

323+ , moreLikeThisMinWordLength :: Maybe MinWordLength

324+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength

325+ , moreLikeThisBoostTerms :: Maybe BoostTerms

326+ , moreLikeThisBoost :: Maybe Boost

327+ , moreLikeThisAnalyzer :: Maybe Analyzer

328+ } deriving (Eq, Show)

329+

330+data IndicesQuery =

331+ IndicesQuery

332+ { indicesQueryIndices :: [IndexName]

333+ , indicesQuery :: Query

334+ -- default "all"

335+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)

336+

337+data HasParentQuery =

338+ HasParentQuery

339+ { hasParentQueryType :: TypeName

340+ , hasParentQuery :: Query

341+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)

342+

343+data HasChildQuery =

344+ HasChildQuery

345+ { hasChildQueryType :: TypeName

346+ , hasChildQuery :: Query

347+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)

348+

349+data ScoreType =

350+ ScoreTypeMax

351+ | ScoreTypeSum

352+ | ScoreTypeAvg

353+ | ScoreTypeNone deriving (Eq, Show)

354+

355+data FuzzyQuery =

356+ FuzzyQuery { fuzzyQueryField :: FieldName

357+ , fuzzyQueryValue :: Text

358+ , fuzzyQueryPrefixLength :: PrefixLength

359+ , fuzzyQueryMaxExpansions :: MaxExpansions

360+ , fuzzyQueryFuzziness :: Fuzziness

361+ , fuzzyQueryBoost :: Maybe Boost

362+ } deriving (Eq, Show)

363+

364+data FuzzyLikeFieldQuery =

365+ FuzzyLikeFieldQuery

366+ { fuzzyLikeField :: FieldName

367+ -- anaphora is good for the soul.

368+ , fuzzyLikeFieldText :: Text

369+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms

370+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency

371+ , fuzzyLikeFieldFuzziness :: Fuzziness

372+ , fuzzyLikeFieldPrefixLength :: PrefixLength

373+ , fuzzyLikeFieldBoost :: Boost

374+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer

375+ } deriving (Eq, Show)

376+

377+data FuzzyLikeThisQuery =

378+ FuzzyLikeThisQuery

379+ { fuzzyLikeFields :: [FieldName]

380+ , fuzzyLikeText :: Text

381+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms

382+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency

383+ , fuzzyLikeFuzziness :: Fuzziness

384+ , fuzzyLikePrefixLength :: PrefixLength

385+ , fuzzyLikeBoost :: Boost

386+ , fuzzyLikeAnalyzer :: Maybe Analyzer

387+ } deriving (Eq, Show)

388+

389+data FilteredQuery =

390+ FilteredQuery

391+ { filteredQuery :: Query

392+ , filteredFilter :: Filter } deriving (Eq, Show)

393+

394+data DisMaxQuery =

395+ DisMaxQuery { disMaxQueries :: [Query]

396+ -- default 0.0

397+ , disMaxTiebreaker :: Tiebreaker

398+ , disMaxBoost :: Maybe Boost

399+ } deriving (Eq, Show)

400+

401+data MatchQuery =

402+ MatchQuery { matchQueryField :: FieldName

403+ , matchQueryQueryString :: QueryString

404+ , matchQueryOperator :: BooleanOperator

405+ , matchQueryZeroTerms :: ZeroTermsQuery

406+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency

407+ , matchQueryMatchType :: Maybe MatchQueryType

408+ , matchQueryAnalyzer :: Maybe Analyzer

409+ , matchQueryMaxExpansions :: Maybe MaxExpansions

410+ , matchQueryLenient :: Maybe Lenient

411+ , matchQueryBoost :: Maybe Boost } deriving (Eq, Show)

412+

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

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

415+-}

416+mkMatchQuery :: FieldName -> QueryString -> MatchQuery

417+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing

418+

419+data MatchQueryType =

420+ MatchPhrase

421+ | MatchPhrasePrefix deriving (Eq, Show)

422+

423+data MultiMatchQuery =

424+ MultiMatchQuery { multiMatchQueryFields :: [FieldName]

425+ , multiMatchQueryString :: QueryString

426+ , multiMatchQueryOperator :: BooleanOperator

427+ , multiMatchQueryZeroTerms :: ZeroTermsQuery

428+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker

429+ , multiMatchQueryType :: Maybe MultiMatchQueryType

430+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency

431+ , multiMatchQueryAnalyzer :: Maybe Analyzer

432+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions

433+ , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show)

434+

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

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

437+ make a 'MultiMatchQuery'.

438+-}

439+

440+mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery

441+mkMultiMatchQuery matchFields query =

442+ MultiMatchQuery matchFields query

443+ Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing

444+

445+data MultiMatchQueryType =

446+ MultiMatchBestFields

447+ | MultiMatchMostFields

448+ | MultiMatchCrossFields

449+ | MultiMatchPhrase

450+ | MultiMatchPhrasePrefix deriving (Eq, Show)

451+

452+data BoolQuery =

453+ BoolQuery { boolQueryMustMatch :: [Query]

454+ , boolQueryMustNotMatch :: [Query]

455+ , boolQueryShouldMatch :: [Query]

456+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch

457+ , boolQueryBoost :: Maybe Boost

458+ , boolQueryDisableCoord :: Maybe DisableCoord

459+ } deriving (Eq, Show)

460+

461+mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery

462+mkBoolQuery must mustNot should =

463+ BoolQuery must mustNot should Nothing Nothing Nothing

464+

465+data BoostingQuery =

466+ BoostingQuery { positiveQuery :: Query

467+ , negativeQuery :: Query

468+ , negativeBoost :: Boost } deriving (Eq, Show)

469+

470+data CommonTermsQuery =

471+ CommonTermsQuery { commonField :: FieldName

472+ , commonQuery :: QueryString

473+ , commonCutoffFrequency :: CutoffFrequency

474+ , commonLowFreqOperator :: BooleanOperator

475+ , commonHighFreqOperator :: BooleanOperator

476+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch

477+ , commonBoost :: Maybe Boost

478+ , commonAnalyzer :: Maybe Analyzer

479+ , commonDisableCoord :: Maybe DisableCoord

480+ } deriving (Eq, Show)

481+

482+data CommonMinimumMatch =

483+ CommonMinimumMatchHighLow MinimumMatchHighLow

484+ | CommonMinimumMatch MinimumMatch

485+ deriving (Eq, Show)

486+

487+data MinimumMatchHighLow =

488+ MinimumMatchHighLow { lowFreq :: MinimumMatch

489+ , highFreq :: MinimumMatch } deriving (Eq, Show)

490+

491+

492+data TemplateQueryInline =

493+ TemplateQueryInline { inline :: Query

494+ , params :: TemplateQueryKeyValuePairs

495+ }

496+ deriving (Eq, Show)

497+

498+instance ToJSON TemplateQueryInline where

499+ toJSON TemplateQueryInline{..} = object [ "query" .= inline

500+ , "params" .= params

501+ ]

502+

503+instance FromJSON TemplateQueryInline where

504+ parseJSON = withObject "TemplateQueryInline" parse

505+ where parse o = TemplateQueryInline

506+ <$> o .: "query"

507+ <*> o .: "params"

508+

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

510+ JSON encoding baked in. Used all over the place.

511+-}

512+data BooleanOperator = And | Or deriving (Eq, Show)

513+

514+type TemplateQueryKey = Text

515+type TemplateQueryValue = Text

516+

517+newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)

518+ deriving (Eq, Show)

519+

520+instance ToJSON TemplateQueryKeyValuePairs where

521+ toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x

522+

523+instance FromJSON TemplateQueryKeyValuePairs where

524+ parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o

525+ where getValue (String x) = Just x

526+ getValue _ = Nothing

527+ parseJSON _ = fail "error parsing TemplateQueryKeyValuePairs"

528+

529+newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)

530+

531+data RegexpFlags = AllRegexpFlags

532+ | NoRegexpFlags

533+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)

534+

535+data RegexpFlag = AnyString

536+ | Automaton

537+ | Complement

538+ | Empty

539+ | Intersection

540+ | Interval deriving (Eq, Show)

541+

542+data RangeExecution = RangeExecutionIndex

543+ | RangeExecutionFielddata deriving (Eq, Show)

544+

545+data ZeroTermsQuery = ZeroTermsNone

546+ | ZeroTermsAll deriving (Eq, Show)

547+

548+instance ToJSON Query where

549+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =

550+ object [ "term" .=

551+ object [termQueryField .= object merged]]

552+ where

553+ base = [ "value" .= termQueryValue ]

554+ boosted = maybe [] (return . ("boost" .=)) boost

555+ merged = mappend base boosted

556+

557+ toJSON (TermsQuery fieldName terms) =

558+ object [ "terms" .= object conjoined ]

559+ where conjoined = [fieldName .= terms]

560+

561+ toJSON (IdsQuery idsQueryMappingName docIds) =

562+ object [ "ids" .= object conjoined ]

563+ where conjoined = [ "type" .= idsQueryMappingName

564+ , "values" .= fmap toJSON docIds ]

565+

566+ toJSON (QueryQueryStringQuery qQueryStringQuery) =

567+ object [ "query_string" .= qQueryStringQuery ]

568+

569+ toJSON (QueryMatchQuery matchQuery) =

570+ object [ "match" .= matchQuery ]

571+

572+ toJSON (QueryMultiMatchQuery multiMatchQuery) =

573+ toJSON multiMatchQuery

574+

575+ toJSON (QueryBoolQuery boolQuery) =

576+ object [ "bool" .= boolQuery ]

577+

578+ toJSON (QueryBoostingQuery boostingQuery) =

579+ object [ "boosting" .= boostingQuery ]

580+

581+ toJSON (QueryCommonTermsQuery commonTermsQuery) =

582+ object [ "common" .= commonTermsQuery ]

583+

584+ toJSON (ConstantScoreFilter csFilter boost) =

585+ object ["constant_score" .= object ["filter" .= csFilter

586+ , "boost" .= boost]]

587+

588+ toJSON (ConstantScoreQuery query boost) =

589+ object ["constant_score" .= object ["query" .= query

590+ , "boost" .= boost]]

591+

592+ toJSON (QueryDisMaxQuery disMaxQuery) =

593+ object [ "dis_max" .= disMaxQuery ]

594+

595+ toJSON (QueryFilteredQuery qFilteredQuery) =

596+ object [ "filtered" .= qFilteredQuery ]

597+

598+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =

599+ object [ "fuzzy_like_this" .= fuzzyQuery ]

600+

601+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =

602+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]

603+

604+ toJSON (QueryFuzzyQuery fuzzyQuery) =

605+ object [ "fuzzy" .= fuzzyQuery ]

606+

607+ toJSON (QueryHasChildQuery childQuery) =

608+ object [ "has_child" .= childQuery ]

609+

610+ toJSON (QueryHasParentQuery parentQuery) =

611+ object [ "has_parent" .= parentQuery ]

612+

613+ toJSON (QueryIndicesQuery qIndicesQuery) =

614+ object [ "indices" .= qIndicesQuery ]

615+

616+ toJSON (MatchAllQuery boost) =

617+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]

618+

619+ toJSON (QueryMoreLikeThisQuery query) =

620+ object [ "more_like_this" .= query ]

621+

622+ toJSON (QueryMoreLikeThisFieldQuery query) =

623+ object [ "more_like_this_field" .= query ]

624+

625+ toJSON (QueryNestedQuery query) =

626+ object [ "nested" .= query ]

627+

628+ toJSON (QueryPrefixQuery query) =

629+ object [ "prefix" .= query ]

630+

631+ toJSON (QueryRangeQuery query) =

632+ object [ "range" .= query ]

633+

634+ toJSON (QueryRegexpQuery query) =

635+ object [ "regexp" .= query ]

636+

637+ toJSON (QuerySimpleQueryStringQuery query) =

638+ object [ "simple_query_string" .= query ]

639+

640+ toJSON (QueryTemplateQueryInline templateQuery) =

641+ object [ "template" .= templateQuery ]

642+

643+instance FromJSON Query where

644+ parseJSON v = withObject "Query" parse v

645+ where parse o = termQuery `taggedWith` "term"

646+ <|> termsQuery `taggedWith` "terms"

647+ <|> idsQuery `taggedWith` "ids"

648+ <|> queryQueryStringQuery `taggedWith` "query_string"

649+ <|> queryMatchQuery `taggedWith` "match"

650+ <|> queryMultiMatchQuery

651+ <|> queryBoolQuery `taggedWith` "bool"

652+ <|> queryBoostingQuery `taggedWith` "boosting"

653+ <|> queryCommonTermsQuery `taggedWith` "common"

654+ <|> constantScoreFilter `taggedWith` "constant_score"

655+ <|> constantScoreQuery `taggedWith` "constant_score"

656+ <|> queryDisMaxQuery `taggedWith` "dis_max"

657+ <|> queryFilteredQuery `taggedWith` "filtered"

658+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"

659+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"

660+ <|> queryFuzzyQuery `taggedWith` "fuzzy"

661+ <|> queryHasChildQuery `taggedWith` "has_child"

662+ <|> queryHasParentQuery `taggedWith` "has_parent"

663+ <|> queryIndicesQuery `taggedWith` "indices"

664+ <|> matchAllQuery `taggedWith` "match_all"

665+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"

666+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"

667+ <|> queryNestedQuery `taggedWith` "nested"

668+ <|> queryPrefixQuery `taggedWith` "prefix"

669+ <|> queryRangeQuery `taggedWith` "range"

670+ <|> queryRegexpQuery `taggedWith` "regexp"

671+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"

672+ <|> queryTemplateQueryInline `taggedWith` "template"

673+ where taggedWith parser k = parser =<< o .: k

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

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

676+ termsQuery o = case HM.toList o of

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

678+ case vals of

679+ x:xs -> return (TermsQuery fn (x :| xs))

680+ _ -> fail "Expected non empty list of values"

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

682+ idsQuery o = IdsQuery <$> o .: "type"

683+ <*> o .: "values"

684+ queryQueryStringQuery = pure . QueryQueryStringQuery

685+ queryMatchQuery = pure . QueryMatchQuery

686+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v

687+ queryBoolQuery = pure . QueryBoolQuery

688+ queryBoostingQuery = pure . QueryBoostingQuery

689+ queryCommonTermsQuery = pure . QueryCommonTermsQuery

690+ constantScoreFilter o = case HM.lookup "filter" o of

691+ Just x -> ConstantScoreFilter <$> parseJSON x

692+ <*> o .: "boost"

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

694+ constantScoreQuery o = case HM.lookup "query" o of

695+ Just x -> ConstantScoreQuery <$> parseJSON x

696+ <*> o .: "boost"

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

698+ queryDisMaxQuery = pure . QueryDisMaxQuery

699+ queryFilteredQuery = pure . QueryFilteredQuery

700+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery

701+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery

702+ queryFuzzyQuery = pure . QueryFuzzyQuery

703+ queryHasChildQuery = pure . QueryHasChildQuery

704+ queryHasParentQuery = pure . QueryHasParentQuery

705+ queryIndicesQuery = pure . QueryIndicesQuery

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

707+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery

708+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery

709+ queryNestedQuery = pure . QueryNestedQuery

710+ queryPrefixQuery = pure . QueryPrefixQuery

711+ queryRangeQuery = pure . QueryRangeQuery

712+ queryRegexpQuery = pure . QueryRegexpQuery

713+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery

714+ queryTemplateQueryInline = pure . QueryTemplateQueryInline

715+

716+instance ToJSON SimpleQueryStringQuery where

717+ toJSON SimpleQueryStringQuery {..} =

718+ omitNulls (base ++ maybeAdd)

719+ where base = [ "query" .= simpleQueryStringQuery ]

720+ maybeAdd = [ "fields" .= simpleQueryStringField

721+ , "default_operator" .= simpleQueryStringOperator

722+ , "analyzer" .= simpleQueryStringAnalyzer

723+ , "flags" .= simpleQueryStringFlags

724+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded

725+ , "locale" .= simpleQueryStringLocale ]

726+

727+instance FromJSON SimpleQueryStringQuery where

728+ parseJSON = withObject "SimpleQueryStringQuery" parse

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

730+ <*> o .:? "fields"

731+ <*> o .:? "default_operator"

732+ <*> o .:? "analyzer"

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

734+ <*> o .:? "lowercase_expanded_terms"

735+ <*> o .:? "locale"

736+ parseFlags (Just (x:xs)) = Just (x :| xs)

737+ parseFlags _ = Nothing

738+

739+instance ToJSON FieldOrFields where

740+ toJSON (FofField fieldName) =

741+ toJSON fieldName

742+ toJSON (FofFields fieldNames) =

743+ toJSON fieldNames

744+

745+instance FromJSON FieldOrFields where

746+ parseJSON v = FofField <$> parseJSON v

747+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)

748+

749+instance ToJSON SimpleQueryFlag where

750+ toJSON SimpleQueryAll = "ALL"

751+ toJSON SimpleQueryNone = "NONE"

752+ toJSON SimpleQueryAnd = "AND"

753+ toJSON SimpleQueryOr = "OR"

754+ toJSON SimpleQueryPrefix = "PREFIX"

755+ toJSON SimpleQueryPhrase = "PHRASE"

756+ toJSON SimpleQueryPrecedence = "PRECEDENCE"

757+ toJSON SimpleQueryEscape = "ESCAPE"

758+ toJSON SimpleQueryWhitespace = "WHITESPACE"

759+ toJSON SimpleQueryFuzzy = "FUZZY"

760+ toJSON SimpleQueryNear = "NEAR"

761+ toJSON SimpleQuerySlop = "SLOP"

762+

763+instance FromJSON SimpleQueryFlag where

764+ parseJSON = withText "SimpleQueryFlag" parse

765+ where parse "ALL" = pure SimpleQueryAll

766+ parse "NONE" = pure SimpleQueryNone

767+ parse "AND" = pure SimpleQueryAnd

768+ parse "OR" = pure SimpleQueryOr

769+ parse "PREFIX" = pure SimpleQueryPrefix

770+ parse "PHRASE" = pure SimpleQueryPhrase

771+ parse "PRECEDENCE" = pure SimpleQueryPrecedence

772+ parse "ESCAPE" = pure SimpleQueryEscape

773+ parse "WHITESPACE" = pure SimpleQueryWhitespace

774+ parse "FUZZY" = pure SimpleQueryFuzzy

775+ parse "NEAR" = pure SimpleQueryNear

776+ parse "SLOP" = pure SimpleQuerySlop

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

778+

779+instance ToJSON RegexpQuery where

780+ toJSON (RegexpQuery (FieldName rqQueryField)

781+ (Regexp regexpQueryQuery) rqQueryFlags

782+ rqQueryBoost) =

783+ object [ rqQueryField .= omitNulls base ]

784+ where base = [ "value" .= regexpQueryQuery

785+ , "flags" .= rqQueryFlags

786+ , "boost" .= rqQueryBoost ]

787+

788+instance FromJSON RegexpQuery where

789+ parseJSON = withObject "RegexpQuery" parse

790+ where parse = fieldTagged $ \fn o ->

791+ RegexpQuery fn

792+ <$> o .: "value"

793+ <*> o .: "flags"

794+ <*> o .:? "boost"

795+

796+instance ToJSON QueryStringQuery where

797+ toJSON (QueryStringQuery qsQueryString

798+ qsDefaultField qsOperator

799+ qsAnalyzer qsAllowWildcard

800+ qsLowercaseExpanded qsEnablePositionIncrements

801+ qsFuzzyMaxExpansions qsFuzziness

802+ qsFuzzyPrefixLength qsPhraseSlop

803+ qsBoost qsAnalyzeWildcard

804+ qsGeneratePhraseQueries qsMinimumShouldMatch

805+ qsLenient qsLocale) =

806+ omitNulls base

807+ where

808+ base = [ "query" .= qsQueryString

809+ , "default_field" .= qsDefaultField

810+ , "default_operator" .= qsOperator

811+ , "analyzer" .= qsAnalyzer

812+ , "allow_leading_wildcard" .= qsAllowWildcard

813+ , "lowercase_expanded_terms" .= qsLowercaseExpanded

814+ , "enable_position_increments" .= qsEnablePositionIncrements

815+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions

816+ , "fuzziness" .= qsFuzziness

817+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength

818+ , "phrase_slop" .= qsPhraseSlop

819+ , "boost" .= qsBoost

820+ , "analyze_wildcard" .= qsAnalyzeWildcard

821+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries

822+ , "minimum_should_match" .= qsMinimumShouldMatch

823+ , "lenient" .= qsLenient

824+ , "locale" .= qsLocale ]

825+

826+instance FromJSON QueryStringQuery where

827+ parseJSON = withObject "QueryStringQuery" parse

828+ where parse o = QueryStringQuery

829+ <$> o .: "query"

830+ <*> o .:? "default_field"

831+ <*> o .:? "default_operator"

832+ <*> o .:? "analyzer"

833+ <*> o .:? "allow_leading_wildcard"

834+ <*> o .:? "lowercase_expanded_terms"

835+ <*> o .:? "enable_position_increments"

836+ <*> o .:? "fuzzy_max_expansions"

837+ <*> o .:? "fuzziness"

838+ <*> o .:? "fuzzy_prefix_length"

839+ <*> o .:? "phrase_slop"

840+ <*> o .:? "boost"

841+ <*> o .:? "analyze_wildcard"

842+ <*> o .:? "auto_generate_phrase_queries"

843+ <*> o .:? "minimum_should_match"

844+ <*> o .:? "lenient"

845+ <*> o .:? "locale"

846+

847+instance ToJSON RangeQuery where

848+ toJSON (RangeQuery (FieldName fieldName) range boost) =

849+ object [ fieldName .= object conjoined ]

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

851+

852+instance FromJSON RangeQuery where

853+ parseJSON = withObject "RangeQuery" parse

854+ where parse = fieldTagged $ \fn o ->

855+ RangeQuery fn

856+ <$> parseJSON (Object o)

857+ <*> o .: "boost"

858+

859+instance FromJSON RangeValue where

860+ parseJSON = withObject "RangeValue" parse

861+ where parse o = parseDate o

862+ <|> parseDouble o

863+ parseDate o = do lt <- o .:? "lt"

864+ lte <- o .:? "lte"

865+ gt <- o .:? "gt"

866+ gte <- o .:? "gte"

867+ case (lt, lte, gt, gte) of

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

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

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

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

872+ (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))

873+ (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))

874+ (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))

875+ (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))

876+ (Nothing, Nothing, Nothing, Nothing) -> mzero

877+ parseDouble o = do lt <- o .:? "lt"

878+ lte <- o .:? "lte"

879+ gt <- o .:? "gt"

880+ gte <- o .:? "gte"

881+ case (lt, lte, gt, gte) of

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

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

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

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

886+ (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))

887+ (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))

888+ (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))

889+ (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))

890+ (Nothing, Nothing, Nothing, Nothing) -> mzero

891+

892+instance ToJSON PrefixQuery where

893+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =

894+ object [ fieldName .= omitNulls base ]

895+ where base = [ "value" .= queryValue

896+ , "boost" .= boost ]

897+

898+instance FromJSON PrefixQuery where

899+ parseJSON = withObject "PrefixQuery" parse

900+ where parse = fieldTagged $ \fn o ->

901+ PrefixQuery fn

902+ <$> o .: "value"

903+ <*> o .:? "boost"

904+

905+instance ToJSON NestedQuery where

906+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =

907+ object [ "path" .= nqPath

908+ , "score_mode" .= nqScoreType

909+ , "query" .= nqQuery ]

910+

911+instance FromJSON NestedQuery where

912+ parseJSON = withObject "NestedQuery" parse

913+ where parse o = NestedQuery

914+ <$> o .: "path"

915+ <*> o .: "score_mode"

916+ <*> o .: "query"

917+

918+instance ToJSON MoreLikeThisFieldQuery where

919+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)

920+ percent mtf mqt stopwords mindf maxdf

921+ minwl maxwl boostTerms boost analyzer) =

922+ object [ fieldName .= omitNulls base ]

923+ where base = [ "like_text" .= text

924+ , "percent_terms_to_match" .= percent

925+ , "min_term_freq" .= mtf

926+ , "max_query_terms" .= mqt

927+ , "stop_words" .= stopwords

928+ , "min_doc_freq" .= mindf

929+ , "max_doc_freq" .= maxdf

930+ , "min_word_length" .= minwl

931+ , "max_word_length" .= maxwl

932+ , "boost_terms" .= boostTerms

933+ , "boost" .= boost

934+ , "analyzer" .= analyzer ]

935+

936+instance FromJSON MoreLikeThisFieldQuery where

937+ parseJSON = withObject "MoreLikeThisFieldQuery" parse

938+ where parse = fieldTagged $ \fn o ->

939+ MoreLikeThisFieldQuery

940+ <$> o .: "like_text"

941+ <*> pure fn

942+ <*> o .:? "percent_terms_to_match"

943+ <*> o .:? "min_term_freq"

944+ <*> o .:? "max_query_terms"

945+ -- <*> (optionalNE =<< o .:? "stop_words")

946+ <*> o .:? "stop_words"

947+ <*> o .:? "min_doc_freq"

948+ <*> o .:? "max_doc_freq"

949+ <*> o .:? "min_word_length"

950+ <*> o .:? "max_word_length"

951+ <*> o .:? "boost_terms"

952+ <*> o .:? "boost"

953+ <*> o .:? "analyzer"

954+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)

955+

956+instance ToJSON MoreLikeThisQuery where

957+ toJSON (MoreLikeThisQuery text fields percent

958+ mtf mqt stopwords mindf maxdf

959+ minwl maxwl boostTerms boost analyzer) =

960+ omitNulls base

961+ where base = [ "like_text" .= text

962+ , "fields" .= fields

963+ , "percent_terms_to_match" .= percent

964+ , "min_term_freq" .= mtf

965+ , "max_query_terms" .= mqt

966+ , "stop_words" .= stopwords

967+ , "min_doc_freq" .= mindf

968+ , "max_doc_freq" .= maxdf

969+ , "min_word_length" .= minwl

970+ , "max_word_length" .= maxwl

971+ , "boost_terms" .= boostTerms

972+ , "boost" .= boost

973+ , "analyzer" .= analyzer ]

974+

975+instance FromJSON MoreLikeThisQuery where

976+ parseJSON = withObject "MoreLikeThisQuery" parse

977+ where parse o = MoreLikeThisQuery

978+ <$> o .: "like_text"

979+ -- <*> (optionalNE =<< o .:? "fields")

980+ <*> o .:? "fields"

981+ <*> o .:? "percent_terms_to_match"

982+ <*> o .:? "min_term_freq"

983+ <*> o .:? "max_query_terms"

984+ -- <*> (optionalNE =<< o .:? "stop_words")

985+ <*> o .:? "stop_words"

986+ <*> o .:? "min_doc_freq"

987+ <*> o .:? "max_doc_freq"

988+ <*> o .:? "min_word_length"

989+ <*> o .:? "max_word_length"

990+ <*> o .:? "boost_terms"

991+ <*> o .:? "boost"

992+ <*> o .:? "analyzer"

993+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)

994+

995+instance ToJSON IndicesQuery where

996+ toJSON (IndicesQuery indices query noMatch) =

997+ omitNulls [ "indices" .= indices

998+ , "no_match_query" .= noMatch

999+ , "query" .= query ]

1000+

1001+instance FromJSON IndicesQuery where

1002+ parseJSON = withObject "IndicesQuery" parse

1003+ where parse o = IndicesQuery

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

1005+ <*> o .: "query"

1006+ <*> o .:? "no_match_query"

1007+

1008+instance ToJSON HasParentQuery where

1009+ toJSON (HasParentQuery queryType query scoreType) =

1010+ omitNulls [ "parent_type" .= queryType

1011+ , "score_type" .= scoreType

1012+ , "query" .= query ]

1013+

1014+instance FromJSON HasParentQuery where

1015+ parseJSON = withObject "HasParentQuery" parse

1016+ where parse o = HasParentQuery

1017+ <$> o .: "parent_type"

1018+ <*> o .: "query"

1019+ <*> o .:? "score_type"

1020+

1021+instance ToJSON HasChildQuery where

1022+ toJSON (HasChildQuery queryType query scoreType) =

1023+ omitNulls [ "query" .= query

1024+ , "score_type" .= scoreType

1025+ , "type" .= queryType ]

1026+

1027+instance FromJSON HasChildQuery where

1028+ parseJSON = withObject "HasChildQuery" parse

1029+ where parse o = HasChildQuery

1030+ <$> o .: "type"

1031+ <*> o .: "query"

1032+ <*> o .:? "score_type"

1033+

1034+instance ToJSON FuzzyQuery where

1035+ toJSON (FuzzyQuery (FieldName fieldName) queryText

1036+ prefixLength maxEx fuzziness boost) =

1037+ object [ fieldName .= omitNulls base ]

1038+ where base = [ "value" .= queryText

1039+ , "fuzziness" .= fuzziness

1040+ , "prefix_length" .= prefixLength

1041+ , "boost" .= boost

1042+ , "max_expansions" .= maxEx ]

1043+

1044+instance FromJSON FuzzyQuery where

1045+ parseJSON = withObject "FuzzyQuery" parse

1046+ where parse = fieldTagged $ \fn o ->

1047+ FuzzyQuery fn

1048+ <$> o .: "value"

1049+ <*> o .: "prefix_length"

1050+ <*> o .: "max_expansions"

1051+ <*> o .: "fuzziness"

1052+ <*> o .:? "boost"

1053+

1054+instance ToJSON FuzzyLikeFieldQuery where

1055+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)

1056+ fieldText maxTerms ignoreFreq fuzziness prefixLength

1057+ boost analyzer) =

1058+ object [ fieldName .=

1059+ omitNulls [ "like_text" .= fieldText

1060+ , "max_query_terms" .= maxTerms

1061+ , "ignore_tf" .= ignoreFreq

1062+ , "fuzziness" .= fuzziness

1063+ , "prefix_length" .= prefixLength

1064+ , "analyzer" .= analyzer

1065+ , "boost" .= boost ]]

1066+

1067+instance FromJSON FuzzyLikeFieldQuery where

1068+ parseJSON = withObject "FuzzyLikeFieldQuery" parse

1069+ where parse = fieldTagged $ \fn o ->

1070+ FuzzyLikeFieldQuery fn

1071+ <$> o .: "like_text"

1072+ <*> o .: "max_query_terms"

1073+ <*> o .: "ignore_tf"

1074+ <*> o .: "fuzziness"

1075+ <*> o .: "prefix_length"

1076+ <*> o .: "boost"

1077+ <*> o .:? "analyzer"

1078+

1079+instance ToJSON FuzzyLikeThisQuery where

1080+ toJSON (FuzzyLikeThisQuery fields text maxTerms

1081+ ignoreFreq fuzziness prefixLength boost analyzer) =

1082+ omitNulls base

1083+ where base = [ "fields" .= fields

1084+ , "like_text" .= text

1085+ , "max_query_terms" .= maxTerms

1086+ , "ignore_tf" .= ignoreFreq

1087+ , "fuzziness" .= fuzziness

1088+ , "prefix_length" .= prefixLength

1089+ , "analyzer" .= analyzer

1090+ , "boost" .= boost ]

1091+

1092+instance FromJSON FuzzyLikeThisQuery where

1093+ parseJSON = withObject "FuzzyLikeThisQuery" parse

1094+ where parse o = FuzzyLikeThisQuery

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

1096+ <*> o .: "like_text"

1097+ <*> o .: "max_query_terms"

1098+ <*> o .: "ignore_tf"

1099+ <*> o .: "fuzziness"

1100+ <*> o .: "prefix_length"

1101+ <*> o .: "boost"

1102+ <*> o .:? "analyzer"

1103+

1104+instance ToJSON FilteredQuery where

1105+ toJSON (FilteredQuery query fFilter) =

1106+ object [ "query" .= query

1107+ , "filter" .= fFilter ]

1108+

1109+instance FromJSON FilteredQuery where

1110+ parseJSON = withObject "FilteredQuery" parse

1111+ where parse o = FilteredQuery

1112+ <$> o .: "query"

1113+ <*> o .: "filter"

1114+

1115+instance ToJSON DisMaxQuery where

1116+ toJSON (DisMaxQuery queries tiebreaker boost) =

1117+ omitNulls base

1118+ where base = [ "queries" .= queries

1119+ , "boost" .= boost

1120+ , "tie_breaker" .= tiebreaker ]

1121+

1122+instance FromJSON DisMaxQuery where

1123+ parseJSON = withObject "DisMaxQuery" parse

1124+ where parse o = DisMaxQuery

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

1126+ <*> o .: "tie_breaker"

1127+ <*> o .:? "boost"

1128+

1129+instance ToJSON CommonTermsQuery where

1130+ toJSON (CommonTermsQuery (FieldName fieldName)

1131+ (QueryString query) cf lfo hfo msm

1132+ boost analyzer disableCoord) =

1133+ object [fieldName .= omitNulls base ]

1134+ where base = [ "query" .= query

1135+ , "cutoff_frequency" .= cf

1136+ , "low_freq_operator" .= lfo

1137+ , "minimum_should_match" .= msm

1138+ , "boost" .= boost

1139+ , "analyzer" .= analyzer

1140+ , "disable_coord" .= disableCoord

1141+ , "high_freq_operator" .= hfo ]

1142+

1143+instance FromJSON CommonTermsQuery where

1144+ parseJSON = withObject "CommonTermsQuery" parse

1145+ where parse = fieldTagged $ \fn o ->

1146+ CommonTermsQuery fn

1147+ <$> o .: "query"

1148+ <*> o .: "cutoff_frequency"

1149+ <*> o .: "low_freq_operator"

1150+ <*> o .: "high_freq_operator"

1151+ <*> o .:? "minimum_should_match"

1152+ <*> o .:? "boost"

1153+ <*> o .:? "analyzer"

1154+ <*> o .:? "disable_coord"

1155+

1156+instance ToJSON CommonMinimumMatch where

1157+ toJSON (CommonMinimumMatch mm) = toJSON mm

1158+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =

1159+ object [ "low_freq" .= lowF

1160+ , "high_freq" .= highF ]

1161+

1162+instance FromJSON CommonMinimumMatch where

1163+ parseJSON v = parseMinimum v

1164+ <|> parseMinimumHighLow v

1165+ where parseMinimum = fmap CommonMinimumMatch . parseJSON

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

1167+ MinimumMatchHighLow

1168+ <$> o .: "low_freq"

1169+ <*> o .: "high_freq")

1170+

1171+

1172+instance ToJSON BoostingQuery where

1173+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =

1174+ object [ "positive" .= bqPositiveQuery

1175+ , "negative" .= bqNegativeQuery

1176+ , "negative_boost" .= bqNegativeBoost ]

1177+

1178+instance FromJSON BoostingQuery where

1179+ parseJSON = withObject "BoostingQuery" parse

1180+ where parse o = BoostingQuery

1181+ <$> o .: "positive"

1182+ <*> o .: "negative"

1183+ <*> o .: "negative_boost"

1184+

1185+instance ToJSON BoolQuery where

1186+ toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =

1187+ omitNulls base

1188+ where base = [ "must" .= mustM

1189+ , "must_not" .= notM

1190+ , "should" .= shouldM

1191+ , "minimum_should_match" .= bqMin

1192+ , "boost" .= boost

1193+ , "disable_coord" .= disableCoord ]

1194+

1195+instance FromJSON BoolQuery where

1196+ parseJSON = withObject "BoolQuery" parse

1197+ where parse o = BoolQuery

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

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

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

1201+ <*> o .:? "minimum_should_match"

1202+ <*> o .:? "boost"

1203+ <*> o .:? "disable_coord"

1204+

1205+instance ToJSON MatchQuery where

1206+ toJSON (MatchQuery (FieldName fieldName)

1207+ (QueryString mqQueryString) booleanOperator

1208+ zeroTermsQuery cutoffFrequency matchQueryType

1209+ analyzer maxExpansions lenient boost) =

1210+ object [ fieldName .= omitNulls base ]

1211+ where base = [ "query" .= mqQueryString

1212+ , "operator" .= booleanOperator

1213+ , "zero_terms_query" .= zeroTermsQuery

1214+ , "cutoff_frequency" .= cutoffFrequency

1215+ , "type" .= matchQueryType

1216+ , "analyzer" .= analyzer

1217+ , "max_expansions" .= maxExpansions

1218+ , "lenient" .= lenient

1219+ , "boost" .= boost ]

1220+

1221+instance FromJSON MatchQuery where

1222+ parseJSON = withObject "MatchQuery" parse

1223+ where parse = fieldTagged $ \fn o ->

1224+ MatchQuery fn

1225+ <$> o .: "query"

1226+ <*> o .: "operator"

1227+ <*> o .: "zero_terms_query"

1228+ <*> o .:? "cutoff_frequency"

1229+ <*> o .:? "type"

1230+ <*> o .:? "analyzer"

1231+ <*> o .:? "max_expansions"

1232+ <*> o .:? "lenient"

1233+ <*> o .:? "boost"

1234+

1235+instance ToJSON MultiMatchQuery where

1236+ toJSON (MultiMatchQuery fields (QueryString query) boolOp

1237+ ztQ tb mmqt cf analyzer maxEx lenient) =

1238+ object ["multi_match" .= omitNulls base]

1239+ where base = [ "fields" .= fmap toJSON fields

1240+ , "query" .= query

1241+ , "operator" .= boolOp

1242+ , "zero_terms_query" .= ztQ

1243+ , "tie_breaker" .= tb

1244+ , "type" .= mmqt

1245+ , "cutoff_frequency" .= cf

1246+ , "analyzer" .= analyzer

1247+ , "max_expansions" .= maxEx

1248+ , "lenient" .= lenient ]

1249+

1250+instance FromJSON MultiMatchQuery where

1251+ parseJSON = withObject "MultiMatchQuery" parse

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

1253+ MultiMatchQuery

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

1255+ <*> o .: "query"

1256+ <*> o .: "operator"

1257+ <*> o .: "zero_terms_query"

1258+ <*> o .:? "tie_breaker"

1259+ <*> o .:? "type"

1260+ <*> o .:? "cutoff_frequency"

1261+ <*> o .:? "analyzer"

1262+ <*> o .:? "max_expansions"

1263+ <*> o .:? "lenient"

1264+

1265+instance ToJSON Filter where

1266+ toJSON (AndFilter filters cache) =

1267+ object ["and" .=

1268+ object [ "filters" .= fmap toJSON filters

1269+ , "_cache" .= cache]]

1270+

1271+ toJSON (OrFilter filters cache) =

1272+ object ["or" .=

1273+ object [ "filters" .= fmap toJSON filters

1274+ , "_cache" .= cache]]

1275+

1276+ toJSON (NotFilter notFilter cache) =

1277+ object ["not" .=

1278+ object ["filter" .= notFilter

1279+ , "_cache" .= cache]]

1280+

1281+ toJSON (IdentityFilter) =

1282+ object ["match_all" .= object []]

1283+

1284+ toJSON (TermFilter (Term termFilterField termFilterValue) cache) =

1285+ object ["term" .= object base]

1286+ where base = [termFilterField .= termFilterValue,

1287+ "_cache" .= cache]

1288+

1289+ toJSON (ExistsFilter (FieldName fieldName)) =

1290+ object ["exists" .= object

1291+ ["field" .= fieldName]]

1292+

1293+ toJSON (BoolFilter boolMatch) =

1294+ object ["bool" .= boolMatch]

1295+

1296+ toJSON (GeoBoundingBoxFilter bbConstraint) =

1297+ object ["geo_bounding_box" .= bbConstraint]

1298+

1299+ toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)

1300+ distance distanceType optimizeBbox cache) =

1301+ object ["geo_distance" .=

1302+ object ["distance" .= distance

1303+ , "distance_type" .= distanceType

1304+ , "optimize_bbox" .= optimizeBbox

1305+ , distanceGeoField .= geoDistLatLon

1306+ , "_cache" .= cache]]

1307+

1308+ toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)

1309+ (DistanceRange geoDistRangeDistFrom drDistanceTo)) =

1310+ object ["geo_distance_range" .=

1311+ object ["from" .= geoDistRangeDistFrom

1312+ , "to" .= drDistanceTo

1313+ , gddrField .= drLatLon]]

1314+

1315+ toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =

1316+ object ["geo_polygon" .=

1317+ object [geoPolygonFilterField .=

1318+ object ["points" .= fmap toJSON latLons]]]

1319+

1320+ toJSON (IdsFilter (MappingName mappingName) values) =

1321+ object ["ids" .=

1322+ object ["type" .= mappingName

1323+ , "values" .= fmap unpackId values]]

1324+

1325+ toJSON (LimitFilter limit) =

1326+ object ["limit" .= object ["value" .= limit]]

1327+

1328+ toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =

1329+ object ["missing" .=

1330+ object [ "field" .= fieldName

1331+ , "existence" .= existence

1332+ , "null_value" .= nullValue]]

1333+

1334+ toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =

1335+ object ["prefix" .=

1336+ object [fieldName .= fieldValue

1337+ , "_cache" .= cache]]

1338+

1339+ toJSON (QueryFilter query False) =

1340+ object ["query" .= toJSON query ]

1341+ toJSON (QueryFilter query True) =

1342+ object ["fquery" .=

1343+ object [ "query" .= toJSON query

1344+ , "_cache" .= True ]]

1345+

1346+ toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =

1347+ object ["range" .=

1348+ object [ fieldName .= object (rangeValueToPair rangeValue)

1349+ , "execution" .= rangeExecution

1350+ , "_cache" .= cache]]

1351+

1352+ toJSON (RegexpFilter (FieldName fieldName)

1353+ (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =

1354+ object ["regexp" .=

1355+ object [fieldName .=

1356+ object ["value" .= regexText

1357+ , "flags" .= flags]

1358+ , "_name" .= cacheName

1359+ , "_cache" .= cache

1360+ , "_cache_key" .= cacheKey]]

1361+

1362+instance FromJSON Filter where

1363+ parseJSON = withObject "Filter" parse

1364+ where parse o = andFilter `taggedWith` "and"

1365+ <|> orFilter `taggedWith` "or"

1366+ <|> notFilter `taggedWith` "not"

1367+ <|> identityFilter `taggedWith` "match_all"

1368+ <|> boolFilter `taggedWith` "bool"

1369+ <|> existsFilter `taggedWith` "exists"

1370+ <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"

1371+ <|> geoDistanceFilter `taggedWith` "geo_distance"

1372+ <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"

1373+ <|> geoPolygonFilter `taggedWith` "geo_polygon"

1374+ <|> idsFilter `taggedWith` "ids"

1375+ <|> limitFilter `taggedWith` "limit"

1376+ <|> missingFilter `taggedWith` "missing"

1377+ <|> prefixFilter `taggedWith` "prefix"

1378+ <|> queryFilter `taggedWith` "query"

1379+ <|> fqueryFilter `taggedWith` "fquery"

1380+ <|> rangeFilter `taggedWith` "range"

1381+ <|> regexpFilter `taggedWith` "regexp"

1382+ <|> termFilter `taggedWith` "term"

1383+ where taggedWith parser k = parser =<< o .: k

1384+ andFilter o = AndFilter <$> o .: "filters"

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

1386+ orFilter o = OrFilter <$> o .: "filters"

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

1388+ notFilter o = NotFilter <$> o .: "filter"

1389+ <*> o .: "_cache" .!= defaultCache

1390+ identityFilter :: Object -> Parser Filter

1391+ identityFilter m

1392+ | HM.null m = pure IdentityFilter

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

1394+ boolFilter = pure . BoolFilter

1395+ existsFilter o = ExistsFilter <$> o .: "field"

1396+ geoBoundingBoxFilter = pure . GeoBoundingBoxFilter

1397+ geoDistanceFilter o = do

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

1399+ [(fn, v)] -> do

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

1401+ GeoDistanceFilter gp <$> o .: "distance"

1402+ <*> o .: "distance_type"

1403+ <*> o .: "optimize_bbox"

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

1405+ _ -> fail "Could not find GeoDistanceFilter field name"

1406+ geoDistanceRangeFilter o = do

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

1408+ [(fn, v)] -> do

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

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

1411+ return (GeoDistanceRangeFilter gp rng)

1412+ _ -> fail "Could not find GeoDistanceRangeFilter field name"

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

1414+ idsFilter o = IdsFilter <$> o .: "type"

1415+ <*> o .: "values"

1416+ limitFilter o = LimitFilter <$> o .: "value"

1417+ missingFilter o = MissingFilter <$> o .: "field"

1418+ <*> o .: "existence"

1419+ <*> o .: "null_value"

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

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

1422+ _ -> fail "Could not parse PrefixFilter"

1423+

1424+ queryFilter q = pure (QueryFilter q False)

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

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

1427+ [(fn, v)] -> RangeFilter (FieldName fn)

1428+ <$> parseJSON v

1429+ <*> o .: "execution"

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

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

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

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

1434+ <$> o' .: "value"

1435+ <*> o' .: "flags"

1436+ <*> o .: "_name"

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

1438+ <*> o .: "_cache_key"

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

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

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

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

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

1444+

1445+instance ToJSON BooleanOperator where

1446+ toJSON And = String "and"

1447+ toJSON Or = String "or"

1448+

1449+instance FromJSON BooleanOperator where

1450+ parseJSON = withText "BooleanOperator" parse

1451+ where parse "and" = pure And

1452+ parse "or" = pure Or

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

1454+

1455+instance ToJSON ZeroTermsQuery where

1456+ toJSON ZeroTermsNone = String "none"

1457+ toJSON ZeroTermsAll = String "all"

1458+

1459+instance FromJSON ZeroTermsQuery where

1460+ parseJSON = withText "ZeroTermsQuery" parse

1461+ where parse "none" = pure ZeroTermsNone

1462+ parse "all" = pure ZeroTermsAll

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

1464+

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

1466+fieldTagged f o = case HM.toList o of

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

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

1469+

1470+instance ToJSON RangeExecution where

1471+ toJSON RangeExecutionIndex = "index"

1472+ toJSON RangeExecutionFielddata = "fielddata"

1473+

1474+

1475+instance FromJSON RangeExecution where

1476+ parseJSON = withText "RangeExecution" parse

1477+ where parse "index" = pure RangeExecutionIndex

1478+ parse "fielddata" = pure RangeExecutionFielddata

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

1480+

1481+instance ToJSON RegexpFlags where

1482+ toJSON AllRegexpFlags = String "ALL"

1483+ toJSON NoRegexpFlags = String "NONE"

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

1485+ where flagStrs = map flagStr . nub $ h:fs

1486+ flagStr AnyString = "ANYSTRING"

1487+ flagStr Automaton = "AUTOMATON"

1488+ flagStr Complement = "COMPLEMENT"

1489+ flagStr Empty = "EMPTY"

1490+ flagStr Intersection = "INTERSECTION"

1491+ flagStr Interval = "INTERVAL"

1492+

1493+instance FromJSON RegexpFlags where

1494+ parseJSON = withText "RegexpFlags" parse

1495+ where parse "ALL" = pure AllRegexpFlags

1496+ parse "NONE" = pure NoRegexpFlags

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

1498+

1499+instance FromJSON RegexpFlag where

1500+ parseJSON = withText "RegexpFlag" parse

1501+ where parse "ANYSTRING" = pure AnyString

1502+ parse "AUTOMATON" = pure Automaton

1503+ parse "COMPLEMENT" = pure Complement

1504+ parse "EMPTY" = pure Empty

1505+ parse "INTERSECTION" = pure Intersection

1506+ parse "INTERVAL" = pure Interval

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

1508+

1509+rangeValueToPair :: RangeValue -> [Pair]

1510+rangeValueToPair rv = case rv of

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1527+

1528+instance ToJSON ScoreType where

1529+ toJSON ScoreTypeMax = "max"

1530+ toJSON ScoreTypeAvg = "avg"

1531+ toJSON ScoreTypeSum = "sum"

1532+ toJSON ScoreTypeNone = "none"

1533+

1534+instance FromJSON ScoreType where

1535+ parseJSON = withText "ScoreType" parse

1536+ where parse "max" = pure ScoreTypeMax

1537+ parse "avg" = pure ScoreTypeAvg

1538+ parse "sum" = pure ScoreTypeSum

1539+ parse "none" = pure ScoreTypeNone

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

1541+

1542+instance ToJSON MatchQueryType where

1543+ toJSON MatchPhrase = "phrase"

1544+ toJSON MatchPhrasePrefix = "phrase_prefix"

1545+

1546+instance FromJSON MatchQueryType where

1547+ parseJSON = withText "MatchQueryType" parse

1548+ where parse "phrase" = pure MatchPhrase

1549+ parse "phrase_prefix" = pure MatchPhrasePrefix

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

1551+

1552+instance ToJSON MultiMatchQueryType where

1553+ toJSON MultiMatchBestFields = "best_fields"

1554+ toJSON MultiMatchMostFields = "most_fields"

1555+ toJSON MultiMatchCrossFields = "cross_fields"

1556+ toJSON MultiMatchPhrase = "phrase"

1557+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"

1558+

1559+instance FromJSON MultiMatchQueryType where

1560+ parseJSON = withText "MultiMatchPhrasePrefix" parse

1561+ where parse "best_fields" = pure MultiMatchBestFields

1562+ parse "most_fields" = pure MultiMatchMostFields

1563+ parse "cross_fields" = pure MultiMatchCrossFields

1564+ parse "phrase" = pure MultiMatchPhrase

1565+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix

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

1567+

1568+defaultCache :: Cache

1569+defaultCache = False

1570+

1571+instance ToJSON BoolMatch where

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

1573+ "_cache" .= cache]

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

1575+ "_cache" .= cache]

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

1577+ "_cache" .= cache]

1578+

1579+instance FromJSON BoolMatch where

1580+ parseJSON = withObject "BoolMatch" parse

1581+ where parse o = mustMatch `taggedWith` "must"

1582+ <|> mustNotMatch `taggedWith` "must_not"

1583+ <|> shouldMatch `taggedWith` "should"

1584+ where taggedWith parser k = parser =<< o .: k

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

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

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

1588+

1589+instance ToJSON GeoBoundingBoxConstraint where

1590+ toJSON (GeoBoundingBoxConstraint

1591+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =

1592+ object [gbbcGeoBBField .= gbbcConstraintBox

1593+ , "_cache" .= cache

1594+ , "type" .= type']

1595+

1596+instance FromJSON GeoBoundingBoxConstraint where

1597+ parseJSON = withObject "GeoBoundingBoxConstraint" parse

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

1599+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)

1600+ <$> parseJSON v

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

1602+ <*> o .: "type"

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

1604+

1605+instance ToJSON Distance where

1606+ toJSON (Distance dCoefficient dUnit) =

1607+ String boltedTogether where

1608+ coefText = showText dCoefficient

1609+ (String unitText) = toJSON dUnit

1610+ boltedTogether = mappend coefText unitText

1611+

1612+instance FromJSON Distance where

1613+ parseJSON = withText "Distance" parse

1614+ where parse t = Distance <$> parseCoeff nT

1615+ <*> parseJSON (String unitT)

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

1617+ -- may be a better way to do this

1618+ validForNumber '-' = True

1619+ validForNumber '.' = True

1620+ validForNumber 'e' = True

1621+ validForNumber c = isNumber c

1622+ parseCoeff "" = fail "Empty string cannot be parsed as number"

1623+ parseCoeff s = return (read (T.unpack s))

1624+

1625+instance ToJSON DistanceType where

1626+ toJSON Arc = String "arc"

1627+ toJSON SloppyArc = String "sloppy_arc"

1628+ toJSON Plane = String "plane"

1629+

1630+instance FromJSON DistanceType where

1631+ parseJSON = withText "DistanceType" parse

1632+ where parse "arc" = pure Arc

1633+ parse "sloppy_arc" = pure SloppyArc

1634+ parse "plane" = pure Plane

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

1636+

1637+instance ToJSON OptimizeBbox where

1638+ toJSON NoOptimizeBbox = String "none"

1639+ toJSON (OptimizeGeoFilterType gft) = toJSON gft

1640+

1641+instance FromJSON OptimizeBbox where

1642+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v

1643+ <|> parseOptimize v

1644+ where parseNoOptimize "none" = pure NoOptimizeBbox

1645+ parseNoOptimize _ = mzero

1646+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON

1647+

1648+instance ToJSON Term where

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

1650+ [field .= value]]

1651+

1652+instance FromJSON Term where

1653+ parseJSON = withObject "Term" parse

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

1655+ case HM.toList termObj of

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

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

1658+

1659+instance ToJSON GeoBoundingBox where

1660+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =

1661+ object ["top_left" .= gbbTopLeft

1662+ , "bottom_right" .= gbbBottomRight]

1663+

1664+instance FromJSON GeoBoundingBox where

1665+ parseJSON = withObject "GeoBoundingBox" parse

1666+ where parse o = GeoBoundingBox

1667+ <$> o .: "top_left"

1668+ <*> o .: "bottom_right"

1669+

1670+instance ToJSON GeoFilterType where

1671+ toJSON GeoFilterMemory = String "memory"

1672+ toJSON GeoFilterIndexed = String "indexed"

1673+

1674+instance FromJSON GeoFilterType where

1675+ parseJSON = withText "GeoFilterType" parse

1676+ where parse "memory" = pure GeoFilterMemory

1677+ parse "indexed" = pure GeoFilterIndexed

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

1679+

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

1681+-}

1682+unpackId :: DocId -> Text

1683+unpackId (DocId docId) = docId

src/Database/V1/Bloodhound/Internal/Sort.hsnew file+79

@@ -0,0 +1,79 @@

1+{-# LANGUAGE OverloadedStrings #-}

3+module Database.V1.Bloodhound.Internal.Sort where

6+import Bloodhound.Import

8+import Database.V1.Bloodhound.Internal.Newtypes

9+import Database.V1.Bloodhound.Internal.Query

10+

11+

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

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

14+-}

15+type Sort = [SortSpec]

16+

17+

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

19+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and

20+ 'DistanceUnit' to express "nearness" to a single geographical point as a

21+ sort specification.

22+

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

24+-}

25+data SortSpec = DefaultSortSpec DefaultSort

26+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Show)

27+

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

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

30+ common parameters.

31+

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

33+-}

34+data DefaultSort =

35+ DefaultSort { sortFieldName :: FieldName

36+ , sortOrder :: SortOrder

37+ -- default False

38+ , ignoreUnmapped :: Bool

39+ , sortMode :: Maybe SortMode

40+ , missingSort :: Maybe Missing

41+ , nestedFilter :: Maybe Filter } deriving (Eq, Show)

42+

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

44+ encoded into "asc" or "desc" when turned into JSON.

45+

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

47+-}

48+data SortOrder = Ascending

49+ | Descending deriving (Eq, Show)

50+

51+

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

53+

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

55+-}

56+data SortMode = SortMin

57+ | SortMax

58+ | SortSum

59+ | SortAvg deriving (Eq, Show)

60+

61+instance ToJSON SortMode where

62+ toJSON SortMin = String "min"

63+ toJSON SortMax = String "max"

64+ toJSON SortSum = String "sum"

65+ toJSON SortAvg = String "avg"

66+

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

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

69+

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

71+-}

72+data Missing = LastMissing

73+ | FirstMissing

74+ | CustomMissing Text deriving (Eq, Show)

75+

76+instance ToJSON Missing where

77+ toJSON LastMissing = String "_last"

78+ toJSON FirstMissing = String "_first"

79+ toJSON (CustomMissing txt) = String txt

src/Database/V1/Bloodhound/Internal/StringlyTyped.hs+25

@@ -1 +1,26 @@

1+{-# LANGUAGE OverloadedStrings #-}

13module Database.V1.Bloodhound.Internal.StringlyTyped where

5+import Bloodhound.Import

7+import qualified Data.Text as T

9+newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }

10+

11+

12+instance FromJSON StringlyTypedDouble where

13+ parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON

14+

15+

16+-- | For some reason in several settings APIs, all leaf values get returned

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

18+-- non-recursive JSON types. If nothing can be done, the value is left alone.

19+unStringlyTypeJSON :: Value -> Value

20+unStringlyTypeJSON (String "true") = Bool True

21+unStringlyTypeJSON (String "false") = Bool False

22+unStringlyTypeJSON (String "null") = Null

23+unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of

24+ Just n -> Number n

25+ Nothing -> v

26+unStringlyTypeJSON v = v

src/Database/V1/Bloodhound/Internal/Suggest.hsnew file+252

@@ -0,0 +1,252 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecordWildCards #-}

4+module Database.V1.Bloodhound.Internal.Suggest where

7+import Bloodhound.Import

9+import qualified Data.HashMap.Strict as HM

10+

11+import Database.V5.Bloodhound.Internal.Newtypes

12+import Database.V5.Bloodhound.Internal.Query

13+

14+data Suggest = Suggest { suggestText :: Text

15+ , suggestName :: Text

16+ , suggestType :: SuggestType

17+ }

18+ deriving (Show, Eq)

19+

20+instance ToJSON Suggest where

21+ toJSON Suggest{..} = object [ "text" .= suggestText

22+ , suggestName .= suggestType

23+ ]

24+

25+instance FromJSON Suggest where

26+ parseJSON (Object o) = do

27+ suggestText' <- o .: "text"

28+ let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o

29+ suggestName' <- case dropTextList of

30+ [(x, _)] -> return x

31+ _ -> fail "error parsing Suggest field name"

32+ suggestType' <- o .: suggestName'

33+ return $ Suggest suggestText' suggestName' suggestType'

34+ parseJSON x = typeMismatch "Suggest" x

35+

36+data SuggestType = SuggestTypePhraseSuggester PhraseSuggester

37+ deriving (Show, Eq)

38+

39+instance ToJSON SuggestType where

40+ toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]

41+

42+instance FromJSON SuggestType where

43+ parseJSON = withObject "SuggestType" parse

44+ where parse o = phraseSuggester `taggedWith` "phrase"

45+ where taggedWith parser k = parser =<< o .: k

46+ phraseSuggester = pure . SuggestTypePhraseSuggester

47+

48+data PhraseSuggester =

49+ PhraseSuggester { phraseSuggesterField :: FieldName

50+ , phraseSuggesterGramSize :: Maybe Int

51+ , phraseSuggesterRealWordErrorLikelihood :: Maybe Int

52+ , phraseSuggesterConfidence :: Maybe Int

53+ , phraseSuggesterMaxErrors :: Maybe Int

54+ , phraseSuggesterSeparator :: Maybe Text

55+ , phraseSuggesterSize :: Maybe Size

56+ , phraseSuggesterAnalyzer :: Maybe Analyzer

57+ , phraseSuggesterShardSize :: Maybe Int

58+ , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter

59+ , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate

60+ , phraseSuggesterCandidateGenerators :: [DirectGenerators]

61+ }

62+ deriving (Show, Eq)

63+

64+instance ToJSON PhraseSuggester where

65+ toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField

66+ , "gram_size" .= phraseSuggesterGramSize

67+ , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood

68+ , "confidence" .= phraseSuggesterConfidence

69+ , "max_errors" .= phraseSuggesterMaxErrors

70+ , "separator" .= phraseSuggesterSeparator

71+ , "size" .= phraseSuggesterSize

72+ , "analyzer" .= phraseSuggesterAnalyzer

73+ , "shard_size" .= phraseSuggesterShardSize

74+ , "highlight" .= phraseSuggesterHighlight

75+ , "collate" .= phraseSuggesterCollate

76+ , "direct_generator" .= phraseSuggesterCandidateGenerators

77+ ]

78+

79+instance FromJSON PhraseSuggester where

80+ parseJSON = withObject "PhraseSuggester" parse

81+ where parse o = PhraseSuggester

82+ <$> o .: "field"

83+ <*> o .:? "gram_size"

84+ <*> o .:? "real_word_error_likelihood"

85+ <*> o .:? "confidence"

86+ <*> o .:? "max_errors"

87+ <*> o .:? "separator"

88+ <*> o .:? "size"

89+ <*> o .:? "analyzer"

90+ <*> o .:? "shard_size"

91+ <*> o .:? "highlight"

92+ <*> o .:? "collate"

93+ <*> o .:? "direct_generator" .!= []

94+

95+mkPhraseSuggester :: FieldName -> PhraseSuggester

96+mkPhraseSuggester fName =

97+ PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing

98+ Nothing Nothing Nothing Nothing []

99+

100+data PhraseSuggesterHighlighter =

101+ PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text

102+ , phraseSuggesterHighlighterPostTag :: Text

103+ }

104+ deriving (Show, Eq)

105+

106+instance ToJSON PhraseSuggesterHighlighter where

107+ toJSON PhraseSuggesterHighlighter{..} =

108+ object [ "pre_tag" .= phraseSuggesterHighlighterPreTag

109+ , "post_tag" .= phraseSuggesterHighlighterPostTag

110+ ]

111+

112+instance FromJSON PhraseSuggesterHighlighter where

113+ parseJSON = withObject "PhraseSuggesterHighlighter" parse

114+ where parse o = PhraseSuggesterHighlighter

115+ <$> o .: "pre_tag"

116+ <*> o .: "post_tag"

117+

118+data PhraseSuggesterCollate =

119+ PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline

120+ , phraseSuggesterCollatePrune :: Bool

121+ }

122+ deriving (Show, Eq)

123+

124+instance ToJSON PhraseSuggesterCollate where

125+ toJSON PhraseSuggesterCollate{..} = object [ "query" .= object

126+ [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)

127+ ]

128+ , "params" .= (params phraseSuggesterCollateTemplateQuery)

129+ , "prune" .= phraseSuggesterCollatePrune

130+ ]

131+

132+instance FromJSON PhraseSuggesterCollate where

133+ parseJSON (Object o) = do

134+ query' <- o .: "query"

135+ inline' <- query' .: "inline"

136+ params' <- o .: "params"

137+ prune' <- o .:? "prune" .!= False

138+ return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'

139+ parseJSON x = typeMismatch "PhraseSuggesterCollate" x

140+

141+data DirectGenerators = DirectGenerators

142+ { directGeneratorsField :: FieldName

143+ , directGeneratorsSize :: Maybe Int

144+ , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes

145+ , directGeneratorMaxEdits :: Maybe Double

146+ , directGeneratorPrefixLength :: Maybe Int

147+ , directGeneratorMinWordLength :: Maybe Int

148+ , directGeneratorMaxInspections :: Maybe Int

149+ , directGeneratorMinDocFreq :: Maybe Double

150+ , directGeneratorMaxTermFreq :: Maybe Double

151+ , directGeneratorPreFilter :: Maybe Text

152+ , directGeneratorPostFilter :: Maybe Text

153+ }

154+ deriving (Show, Eq)

155+

156+

157+instance ToJSON DirectGenerators where

158+ toJSON DirectGenerators{..} = omitNulls [ "field" .= directGeneratorsField

159+ , "size" .= directGeneratorsSize

160+ , "suggest_mode" .= directGeneratorSuggestMode

161+ , "max_edits" .= directGeneratorMaxEdits

162+ , "prefix_length" .= directGeneratorPrefixLength

163+ , "min_word_length" .= directGeneratorMinWordLength

164+ , "max_inspections" .= directGeneratorMaxInspections

165+ , "min_doc_freq" .= directGeneratorMinDocFreq

166+ , "max_term_freq" .= directGeneratorMaxTermFreq

167+ , "pre_filter" .= directGeneratorPreFilter

168+ , "post_filter" .= directGeneratorPostFilter

169+ ]

170+

171+instance FromJSON DirectGenerators where

172+ parseJSON = withObject "DirectGenerators" parse

173+ where parse o = DirectGenerators

174+ <$> o .: "field"

175+ <*> o .:? "size"

176+ <*> o .: "suggest_mode"

177+ <*> o .:? "max_edits"

178+ <*> o .:? "prefix_length"

179+ <*> o .:? "min_word_length"

180+ <*> o .:? "max_inspections"

181+ <*> o .:? "min_doc_freq"

182+ <*> o .:? "max_term_freq"

183+ <*> o .:? "pre_filter"

184+ <*> o .:? "post_filter"

185+

186+mkDirectGenerators :: FieldName -> DirectGenerators

187+mkDirectGenerators fn = DirectGenerators fn Nothing DirectGeneratorSuggestModeMissing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

188+

189+data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing

190+ | DirectGeneratorSuggestModePopular

191+ | DirectGeneratorSuggestModeAlways

192+ deriving (Show, Eq)

193+

194+instance ToJSON DirectGeneratorSuggestModeTypes where

195+ toJSON DirectGeneratorSuggestModeMissing = "missing"

196+ toJSON DirectGeneratorSuggestModePopular = "popular"

197+ toJSON DirectGeneratorSuggestModeAlways = "always"

198+

199+instance FromJSON DirectGeneratorSuggestModeTypes where

200+ parseJSON = withText "DirectGeneratorSuggestModeTypes" parse

201+ where parse "missing" = pure DirectGeneratorSuggestModeMissing

202+ parse "popular" = pure DirectGeneratorSuggestModePopular

203+ parse "always" = pure DirectGeneratorSuggestModeAlways

204+ parse f = fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)

205+

206+data SuggestOptions =

207+ SuggestOptions { suggestOptionsText :: Text

208+ , suggestOptionsScore :: Double

209+ , suggestOptionsFreq :: Maybe Int

210+ , suggestOptionsHighlighted :: Maybe Text

211+ }

212+ deriving (Eq, Read, Show)

213+

214+instance FromJSON SuggestOptions where

215+ parseJSON = withObject "SuggestOptions" parse

216+ where parse o = SuggestOptions

217+ <$> o .: "text"

218+ <*> o .: "score"

219+ <*> o .:? "freq"

220+ <*> o .:? "highlighted"

221+

222+data SuggestResponse =

223+ SuggestResponse { suggestResponseText :: Text

224+ , suggestResponseOffset :: Int

225+ , suggestResponseLength :: Int

226+ , suggestResponseOptions :: [SuggestOptions]

227+ }

228+ deriving (Eq, Read, Show)

229+

230+instance FromJSON SuggestResponse where

231+ parseJSON = withObject "SuggestResponse" parse

232+ where parse o = SuggestResponse

233+ <$> o .: "text"

234+ <*> o .: "offset"

235+ <*> o .: "length"

236+ <*> o .: "options"

237+

238+data NamedSuggestionResponse =

239+ NamedSuggestionResponse { nsrName :: Text

240+ , nsrResponses :: [SuggestResponse]

241+ }

242+ deriving (Eq, Read, Show)

243+

244+instance FromJSON NamedSuggestionResponse where

245+ parseJSON (Object o) = do

246+ suggestionName' <- case HM.toList o of

247+ [(x, _)] -> return x

248+ _ -> fail "error parsing NamedSuggestionResponse name"

249+ suggestionResponses' <- o .: suggestionName'

250+ return $ NamedSuggestionResponse suggestionName' suggestionResponses'

251+

252+ parseJSON x = typeMismatch "NamedSuggestionResponse" x

src/Database/V1/Bloodhound/Types.hs−2

@@ -422,8 +422,6 @@ import qualified Text.Read as TR

422422

423423import Database.V1.Bloodhound.Internal.Client

424424import Database.V1.Bloodhound.Types.Class

425−import Database.V1.Bloodhound.Types.Internal

426−

427425

428426

429427

src/Database/V5/Bloodhound/Internal/Query.hs−3

@@ -1595,6 +1595,3 @@ fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a

15951595fieldTagged f o = case HM.toList o of

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

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

1598−

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

1600−deleteSeveral ks hm = foldr HM.delete hm ks