git.iko.soy/typeable/bloodhound
on master help sign in
WIP v1 savepoint
99788ccMichael Xavier
src/Bloodhound/Import.hs+38−56
compare with master
unifiedsplit
@@ -7,65 +7,44 @@ module Bloodhound.Import
7 , parseReadText
7 , parseReadText
8 , readMay
8 , readMay
9 , showText
9 , showText
10+ , deleteSeveral
10 ) where
11 ) where
11
12
12−import Control.Applicative as X (Alternative(..), optional)
13+import Control.Applicative as X (Alternative (..), optional)
13−import Control.Exception as X (Exception)
14+import Control.Exception as X (Exception)
14−import Control.Monad as X ( MonadPlus(..)
15+import Control.Monad as X (MonadPlus (..), forM, (<=<))
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
16+import Control.Monad.Catch as X (MonadCatch, MonadMask,
21− , MonadMask
22− , MonadThrow
17+ MonadThrow)
23− )
24−import Control.Monad.Except as X (MonadError)
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 (..))
25−import Control.Monad.Reader as X ( MonadReader (..)
21+import Control.Monad.Reader as X (MonadReader (..),
26− , MonadTrans (..)
22+ MonadTrans (..), ReaderT (..))
27− , ReaderT (..)
28− )
29−import Control.Monad.State as X (MonadState)
23+import Control.Monad.State as X (MonadState)
30−import Control.Monad.Writer as X (MonadWriter)
24+import Control.Monad.Writer as X (MonadWriter)
31−import Data.Aeson as X
25+import Data.Aeson as X
32−import Data.Aeson.Types as X ( Pair
26+import Data.Aeson.Types as X (Pair, Parser, emptyObject,
33− , Parser
34− , emptyObject
35− , parseEither
27+ parseEither, parseMaybe,
36− , parseMaybe
37− , typeMismatch
28+ typeMismatch)
38− )
39−import Data.Bifunctor as X (first)
29+import Data.Bifunctor as X (first)
40−import Data.Char as X (isNumber)
30+import Data.Char as X (isNumber)
41−import Data.Hashable as X (Hashable)
31+import Data.Hashable as X (Hashable)
32+import qualified Data.HashMap.Strict as HM
42−import Data.List as X ( foldl'
33+import Data.List as X (foldl', intercalate, nub)
43− , intercalate
44− , nub
45− )
46−import Data.List.NonEmpty as X ( NonEmpty (..)
34+import Data.List.NonEmpty as X (NonEmpty (..), toList)
47− , toList
48− )
49−import Data.Maybe as X ( catMaybes
35+import Data.Maybe as X (catMaybes, fromMaybe,
50− , fromMaybe
51− , isNothing
52− , maybeToList
36+ isNothing, maybeToList)
53− )
54−import Data.Scientific as X (Scientific)
37+import Data.Scientific as X (Scientific)
55−import Data.Semigroup as X (Semigroup(..))
38+import Data.Semigroup as X (Semigroup (..))
56−import Data.Text as X (Text)
39+import Data.Text as X (Text)
57−import Data.Time.Calendar as X ( Day(..)
40+import Data.Time.Calendar as X (Day (..), showGregorian)
58− , showGregorian
59− )
60−import Data.Time.Clock as X ( NominalDiffTime
41+import Data.Time.Clock as X (NominalDiffTime, UTCTime)
61− , UTCTime
62− )
63−import Data.Time.Clock.POSIX as X
42+import Data.Time.Clock.POSIX as X
64
43
65−import qualified Data.ByteString.Lazy as BL
44+import qualified Data.ByteString.Lazy as BL
66−import qualified Data.Text as T
45+import qualified Data.Text as T
67−import qualified Data.Traversable as DT
46+import qualified Data.Traversable as DT
68−import qualified Data.Vector as V
47+import qualified Data.Vector as V
69import qualified Network.HTTP.Types.Method as NHTM
48import qualified Network.HTTP.Types.Method as NHTM
70
49
71type LByteString = BL.ByteString
50type LByteString = BL.ByteString
@@ -92,3 +71,6 @@ omitNulls = object . filter notNull where
92parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
71parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
93parseNEJSON [] = fail "Expected non-empty list"
72parseNEJSON [] = fail "Expected non-empty list"
94parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
73parseNEJSON (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 #-}
2+
1module Database.V1.Bloodhound.Internal.Aggregation where
3module Database.V1.Bloodhound.Internal.Aggregation where
2
4
3import Bloodhound.Import
5import Bloodhound.Import
4
6
7+import qualified Data.HashMap.Strict as HM
8+import qualified Data.Map.Strict as M
5import Data.Text
9import 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
7
15
8
16
9type Aggregations = M.Map Text Aggregation
17type Aggregations = M.Map Text Aggregation
@@ -22,7 +30,7 @@ data Aggregation = TermsAgg TermsAggregation
22 | DateRangeAgg DateRangeAggregation
30 | DateRangeAgg DateRangeAggregation
23 | MissingAgg MissingAggregation
31 | MissingAgg MissingAggregation
24 | TopHitsAgg TopHitsAggregation
32 | TopHitsAgg TopHitsAggregation
25− deriving (Eq, Read, Show, Generic, Typeable)
33+ deriving (Eq, Show)
26
34
27
35
28instance ToJSON Aggregation where
36instance ToJSON Aggregation where
@@ -84,7 +92,7 @@ data TopHitsAggregation = TopHitsAggregation
84
92
85data MissingAggregation = MissingAggregation
93data MissingAggregation = MissingAggregation
86 { maField :: Text
94 { maField :: Text
87− } deriving (Eq, Read, Show, Generic, Typeable)
95+ } deriving (Eq, Show)
88
96
89data TermsAggregation = TermsAggregation { term :: Either Text Text
97data TermsAggregation = TermsAggregation { term :: Either Text Text
90 , termInclude :: Maybe TermInclusion
98 , termInclude :: Maybe TermInclusion
@@ -96,11 +104,11 @@ data TermsAggregation = TermsAggregation { term :: Either Text Text
96 , termCollectMode :: Maybe CollectionMode
104 , termCollectMode :: Maybe CollectionMode
97 , termExecutionHint :: Maybe ExecutionHint
105 , termExecutionHint :: Maybe ExecutionHint
98 , termAggs :: Maybe Aggregations
106 , termAggs :: Maybe Aggregations
99− } deriving (Eq, Read, Show, Generic, Typeable)
107+ } deriving (Eq, Show)
100
108
101data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
109data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
102 precisionThreshold :: Maybe Int
110 precisionThreshold :: Maybe Int
103− } deriving (Eq, Read, Show, Generic, Typeable)
111+ } deriving (Eq, Show)
104
112
105data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
113data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
106 , dateInterval :: Interval
114 , dateInterval :: Interval
@@ -111,25 +119,25 @@ data DateHistogramAggregation = DateHistogramAggregation { dateField :: Fie
111 , datePreOffset :: Maybe Text
119 , datePreOffset :: Maybe Text
112 , datePostOffset :: Maybe Text
120 , datePostOffset :: Maybe Text
113 , dateAggs :: Maybe Aggregations
121 , dateAggs :: Maybe Aggregations
114− } deriving (Eq, Read, Show, Generic, Typeable)
122+ } deriving (Eq, Show)
115
123
116
124
117data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
125data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
118 , draFormat :: Maybe Text
126 , draFormat :: Maybe Text
119 , draRanges :: NonEmpty DateRangeAggRange
127 , draRanges :: NonEmpty DateRangeAggRange
120− } deriving (Eq, Read, Show, Generic, Typeable)
128+ } deriving (Eq, Show)
121
129
122data DateRangeAggRange = DateRangeFrom DateMathExpr
130data DateRangeAggRange = DateRangeFrom DateMathExpr
123 | DateRangeTo DateMathExpr
131 | DateRangeTo DateMathExpr
124− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
132+ | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Show)
125
133
126-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
134-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
127data ValueCountAggregation = FieldValueCount FieldName
135data ValueCountAggregation = FieldValueCount FieldName
128− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
136+ | ScriptValueCount Script deriving (Eq, Show)
129
137
130-- | 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.
138-- | 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.
131data FilterAggregation = FilterAggregation { faFilter :: Filter
139data FilterAggregation = FilterAggregation { faFilter :: Filter
132− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
140+ , faAggs :: Maybe Aggregations} deriving (Eq, Show)
133
141
134mkTermsAggregation :: Text -> TermsAggregation
142mkTermsAggregation :: Text -> TermsAggregation
135mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
143mkTermsAggregation 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
143mkCardinalityAggregation :: FieldName -> CardinalityAggregation
151mkCardinalityAggregation :: FieldName -> CardinalityAggregation
144mkCardinalityAggregation t = CardinalityAggregation t Nothing
152mkCardinalityAggregation t = CardinalityAggregation t Nothing
145
153
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 #-}
6+
1module Database.V1.Bloodhound.Internal.Client where
7module Database.V1.Bloodhound.Internal.Client where
2
8
9+import Bloodhound.Import
3
10
4−import Control.Applicative as A
11+import Control.Applicative as A
5−import Control.Monad.Reader
6−import Data.Aeson
7−import Data.Text (Text)
12+import Data.Text (Text)
8−import Data.Typeable (Typeable)
13+import qualified Data.Version as Vers
9−import GHC.Generics (Generic)
10import Network.HTTP.Client
14import Network.HTTP.Client
15+import Text.Read (Read (..))
16+import qualified Text.Read as TR
17+
18+import Database.V1.Bloodhound.Internal.Newtypes
11
19
12
20
13{-| Common environment for Elasticsearch calls. Connections will be
21{-| Common environment for Elasticsearch calls. Connections will be
@@ -24,7 +32,7 @@ instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) wher
24
32
25{-| 'Server' is used with the client functions to point at the ES instance
33{-| 'Server' is used with the client functions to point at the ES instance
26-}
34-}
27−newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)
35+newtype Server = Server Text deriving (Eq, Show, FromJSON)
28
36
29{-| All API calls to Elasticsearch operate within
37{-| All API calls to Elasticsearch operate within
30 MonadBH
38 MonadBH
@@ -89,11 +97,11 @@ data Version = Version { number :: VersionNumber
89 , build_hash :: BuildHash
97 , build_hash :: BuildHash
90 , build_timestamp :: UTCTime
98 , build_timestamp :: UTCTime
91 , build_snapshot :: Bool
99 , build_snapshot :: Bool
92− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
100+ , lucene_version :: VersionNumber } deriving (Eq, Show)
93
101
94-- | Traditional software versioning number
102-- | Traditional software versioning number
95newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
103newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
96− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
104+ } deriving (Eq, Show, Ord)
97
105
98{-| 'Status' is a data type for describing the JSON body returned by
106{-| 'Status' is a data type for describing the JSON body returned by
99 Elasticsearch when you query its status. This was deprecated in 1.2.0.
107 Elasticsearch when you query its status. This was deprecated in 1.2.0.
@@ -105,7 +113,7 @@ data Status = Status { ok :: Maybe Bool
105 , status :: Int
113 , status :: Int
106 , name :: Text
114 , name :: Text
107 , version :: Version
115 , version :: Version
108− , tagline :: Text } deriving (Eq, Read, Show, Generic)
116+ , tagline :: Text } deriving (Eq, Show)
109
117
110{-| 'IndexSettings' is used to configure the shards and replicas when you create
118{-| 'IndexSettings' is used to configure the shards and replicas when you create
111 an Elasticsearch Index.
119 an Elasticsearch Index.
@@ -115,7 +123,7 @@ data Status = Status { ok :: Maybe Bool
115
123
116data IndexSettings =
124data IndexSettings =
117 IndexSettings { indexShards :: ShardCount
125 IndexSettings { indexShards :: ShardCount
118− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
126+ , indexReplicas :: ReplicaCount } deriving (Eq, Show)
119
127
120{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
128{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
121defaultIndexSettings :: IndexSettings
129defaultIndexSettings :: IndexSettings
@@ -133,7 +141,7 @@ data IndexOptimizationSettings =
133 -- ^ 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.
141 -- ^ 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.
134 , flushAfterOptimize :: Bool
142 , flushAfterOptimize :: Bool
135 -- ^ Should a flush be performed after the optimize.
143 -- ^ Should a flush be performed after the optimize.
136− } deriving (Eq, Show, Generic, Typeable)
144+ } deriving (Eq, Show)
137
145
138
146
139{-| 'defaultIndexOptimizationSettings' implements the default settings that
147{-| 'defaultIndexOptimizationSettings' implements the default settings that
@@ -195,7 +203,7 @@ data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
195 | IndexCompoundFormat CompoundFormat
203 | IndexCompoundFormat CompoundFormat
196 | IndexCompoundOnFlush Bool
204 | IndexCompoundOnFlush Bool
197 | WarmerEnabled Bool
205 | WarmerEnabled Bool
198− deriving (Eq, Show, Generic, Typeable)
206+ deriving (Eq, Show)
199
207
200data AllocationPolicy = AllocAll
208data AllocationPolicy = AllocAll
201 -- ^ Allows shard allocation for all shards.
209 -- ^ Allows shard allocation for all shards.
@@ -205,12 +213,12 @@ data AllocationPolicy = AllocAll
205 -- ^ Allows shard allocation only for primary shards for new indices.
213 -- ^ Allows shard allocation only for primary shards for new indices.
206 | AllocNone
214 | AllocNone
207 -- ^ No shard allocation is allowed
215 -- ^ No shard allocation is allowed
208− deriving (Eq, Read, Show, Generic, Typeable)
216+ deriving (Eq, Show)
209
217
210data ReplicaBounds = ReplicasBounded Int Int
218data ReplicaBounds = ReplicasBounded Int Int
211 | ReplicasLowerBounded Int
219 | ReplicasLowerBounded Int
212 | ReplicasUnbounded
220 | ReplicasUnbounded
213− deriving (Eq, Read, Show, Generic, Typeable)
221+ deriving (Eq, Show)
214
222
215-- | A measure of bytes used for various configurations. You may want
223-- | A measure of bytes used for various configurations. You may want
216-- to use smart constructors like 'gigabytes' for larger values.
224-- to use smart constructors like 'gigabytes' for larger values.
@@ -223,7 +231,7 @@ data ReplicaBounds = ReplicasBounded Int Int
223--
231--
224-- >>> kilobytes 9
232-- >>> kilobytes 9
225-- Bytes 9000
233-- 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)
227
235
228gigabytes :: Int -> Bytes
236gigabytes :: Int -> Bytes
229gigabytes n = megabytes (1000 * n)
237gigabytes n = megabytes (1000 * n)
@@ -235,3 +243,112 @@ megabytes n = kilobytes (1000 * n)
235
243
236kilobytes :: Int -> Bytes
244kilobytes :: Int -> Bytes
237kilobytes n = Bytes (1000 * n)
245kilobytes 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 #-}
3+
4+module Database.V1.Bloodhound.Internal.Newtypes where
5+
6+
7+import Bloodhound.Import
8+
9+
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 #-}
4+
5+module Database.V1.Bloodhound.Internal.Query
6+ ( module X
7+ , module Database.V1.Bloodhound.Internal.Query
8+ ) where
9+
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 #-}
2+
3+module Database.V1.Bloodhound.Internal.Sort where
4+
5+
6+import Bloodhound.Import
7+
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 #-}
2+
1module Database.V1.Bloodhound.Internal.StringlyTyped where
3module Database.V1.Bloodhound.Internal.StringlyTyped where
4+
5+import Bloodhound.Import
6+
7+import qualified Data.Text as T
8+
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 #-}
3+
4+module Database.V1.Bloodhound.Internal.Suggest where
5+
6+
7+import Bloodhound.Import
8+
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
422
422
423import Database.V1.Bloodhound.Internal.Client
423import Database.V1.Bloodhound.Internal.Client
424import Database.V1.Bloodhound.Types.Class
424import Database.V1.Bloodhound.Types.Class
425−import Database.V1.Bloodhound.Types.Internal
426−
427
425
428
426
429
427
src/Database/V5/Bloodhound/Internal/Query.hs−3
@@ -1595,6 +1595,3 @@ fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
1595fieldTagged f o = case HM.toList o of
1595fieldTagged f o = case HM.toList o of
1596 [(k, Object o')] -> f (FieldName k) o'
1596 [(k, Object o')] -> f (FieldName k) o'
1597 _ -> fail "Expected object with 1 field-named key"
1597 _ -> 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