git.iko.soy/typeable/bloodhound
on master help sign in
Split out Aggregation and sort
c08d951Chris Allen
bloodhound.cabal+2
compare with master
unifiedsplit
@@ -37,10 +37,12 @@ library
37 Database.V5.Bloodhound.Client
37 Database.V5.Bloodhound.Client
38 Database.V5.Bloodhound.Types
38 Database.V5.Bloodhound.Types
39 Database.V5.Bloodhound.Types.Class
39 Database.V5.Bloodhound.Types.Class
40+ Database.V5.Bloodhound.Internal.Aggregation
40 Database.V5.Bloodhound.Internal.Analysis
41 Database.V5.Bloodhound.Internal.Analysis
41 Database.V5.Bloodhound.Internal.Client
42 Database.V5.Bloodhound.Internal.Client
42 Database.V5.Bloodhound.Internal.Newtypes
43 Database.V5.Bloodhound.Internal.Newtypes
43 Database.V5.Bloodhound.Internal.Query
44 Database.V5.Bloodhound.Internal.Query
45+ Database.V5.Bloodhound.Internal.Sort
44 Database.V5.Bloodhound.Internal.StringlyTyped
46 Database.V5.Bloodhound.Internal.StringlyTyped
45 Database.V1.Bloodhound
47 Database.V1.Bloodhound
46 Database.V1.Bloodhound.Client
48 Database.V1.Bloodhound.Client
src/Database/V5/Bloodhound/Internal/Aggregation.hsnew file+306
@@ -0,0 +1,306 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.V5.Bloodhound.Internal.Aggregation where
6+
7+import Bloodhound.Import
8+
9+import qualified Data.Map.Strict as M
10+import qualified Data.Text as T
11+
12+import Database.V5.Bloodhound.Internal.Client
13+import Database.V5.Bloodhound.Internal.Newtypes
14+import Database.V5.Bloodhound.Internal.Query
15+import Database.V5.Bloodhound.Internal.Sort
16+
17+type Aggregations = M.Map Text Aggregation
18+
19+emptyAggregations :: Aggregations
20+emptyAggregations = M.empty
21+
22+mkAggregations :: Text -> Aggregation -> Aggregations
23+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
24+
25+data Aggregation = TermsAgg TermsAggregation
26+ | CardinalityAgg CardinalityAggregation
27+ | DateHistogramAgg DateHistogramAggregation
28+ | ValueCountAgg ValueCountAggregation
29+ | FilterAgg FilterAggregation
30+ | DateRangeAgg DateRangeAggregation
31+ | MissingAgg MissingAggregation
32+ | TopHitsAgg TopHitsAggregation
33+ | StatsAgg StatisticsAggregation
34+ deriving (Eq, Show)
35+
36+instance ToJSON Aggregation where
37+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
38+ omitNulls ["terms" .= omitNulls [ toJSON' term,
39+ "include" .= include,
40+ "exclude" .= exclude,
41+ "order" .= order,
42+ "min_doc_count" .= minDocCount,
43+ "size" .= size,
44+ "shard_size" .= shardSize,
45+ "collect_mode" .= collectMode,
46+ "execution_hint" .= executionHint
47+ ],
48+ "aggs" .= termAggs ]
49+ where
50+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
51+
52+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
53+ object ["cardinality" .= omitNulls [ "field" .= field,
54+ "precisionThreshold" .= precisionThreshold
55+ ]
56+ ]
57+
58+ toJSON (DateHistogramAgg
59+ (DateHistogramAggregation field interval format
60+ preZone postZone preOffset postOffset dateHistoAggs)) =
61+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
62+ "interval" .= interval,
63+ "format" .= format,
64+ "pre_zone" .= preZone,
65+ "post_zone" .= postZone,
66+ "pre_offset" .= preOffset,
67+ "post_offset" .= postOffset
68+ ],
69+ "aggs" .= dateHistoAggs ]
70+ toJSON (ValueCountAgg a) = object ["value_count" .= v]
71+ where v = case a of
72+ (FieldValueCount (FieldName n)) ->
73+ object ["field" .= n]
74+ (ScriptValueCount s) ->
75+ object ["script" .= s]
76+ toJSON (FilterAgg (FilterAggregation filt ags)) =
77+ omitNulls [ "filter" .= filt
78+ , "aggs" .= ags]
79+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
80+ ]
81+ toJSON (MissingAgg (MissingAggregation{..})) =
82+ object ["missing" .= object ["field" .= maField]]
83+
84+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
85+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
86+ , "from" .= mfrom
87+ , "sort" .= msort
88+ ]
89+ ]
90+
91+ toJSON (StatsAgg (StatisticsAggregation typ field)) =
92+ object [stType .= omitNulls [ "field" .= field ]]
93+ where
94+ stType | typ == Basic = "stats"
95+ | otherwise = "extended_stats"
96+
97+data TopHitsAggregation = TopHitsAggregation
98+ { taFrom :: Maybe From
99+ , taSize :: Maybe Size
100+ , taSort :: Maybe Sort
101+ } deriving (Eq, Show)
102+
103+data MissingAggregation = MissingAggregation
104+ { maField :: Text
105+ } deriving (Eq, Show)
106+
107+data TermsAggregation = TermsAggregation
108+ { term :: Either Text Text
109+ , termInclude :: Maybe TermInclusion
110+ , termExclude :: Maybe TermInclusion
111+ , termOrder :: Maybe TermOrder
112+ , termMinDocCount :: Maybe Int
113+ , termSize :: Maybe Int
114+ , termShardSize :: Maybe Int
115+ , termCollectMode :: Maybe CollectionMode
116+ , termExecutionHint :: Maybe ExecutionHint
117+ , termAggs :: Maybe Aggregations
118+ } deriving (Eq, Show)
119+
120+data CardinalityAggregation = CardinalityAggregation
121+ { cardinalityField :: FieldName,
122+ precisionThreshold :: Maybe Int
123+ } deriving (Eq, Show)
124+
125+data DateHistogramAggregation = DateHistogramAggregation
126+ { dateField :: FieldName
127+ , dateInterval :: Interval
128+ , dateFormat :: Maybe Text
129+ -- pre and post deprecated in 1.5
130+ , datePreZone :: Maybe Text
131+ , datePostZone :: Maybe Text
132+ , datePreOffset :: Maybe Text
133+ , datePostOffset :: Maybe Text
134+ , dateAggs :: Maybe Aggregations
135+ } deriving (Eq, Show)
136+
137+data DateRangeAggregation = DateRangeAggregation
138+ { draField :: FieldName
139+ , draFormat :: Maybe Text
140+ , draRanges :: NonEmpty DateRangeAggRange
141+ } deriving (Eq, Show)
142+
143+instance ToJSON DateRangeAggregation where
144+ toJSON DateRangeAggregation {..} =
145+ omitNulls [ "field" .= draField
146+ , "format" .= draFormat
147+ , "ranges" .= toList draRanges
148+ ]
149+
150+data DateRangeAggRange =
151+ DateRangeFrom DateMathExpr
152+ | DateRangeTo DateMathExpr
153+ | DateRangeFromAndTo DateMathExpr DateMathExpr
154+ deriving (Eq, Show)
155+
156+instance ToJSON DateRangeAggRange where
157+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
158+ toJSON (DateRangeTo e) = object [ "to" .= e ]
159+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
160+
161+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
162+data ValueCountAggregation =
163+ FieldValueCount FieldName
164+ | ScriptValueCount Script
165+ deriving (Eq, Show)
166+
167+-- | 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.
168+data FilterAggregation = FilterAggregation
169+ { faFilter :: Filter
170+ , faAggs :: Maybe Aggregations }
171+ deriving (Eq, Show)
172+
173+data StatisticsAggregation = StatisticsAggregation
174+ { statsType :: StatsType
175+ , statsField :: FieldName }
176+ deriving (Eq, Show)
177+
178+data StatsType
179+ = Basic
180+ | Extended
181+ deriving (Eq, Show)
182+
183+mkTermsAggregation :: Text -> TermsAggregation
184+mkTermsAggregation t =
185+ TermsAggregation (Left t)
186+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
187+
188+mkTermsScriptAggregation :: Text -> TermsAggregation
189+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
190+
191+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
192+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
193+
194+mkCardinalityAggregation :: FieldName -> CardinalityAggregation
195+mkCardinalityAggregation t = CardinalityAggregation t Nothing
196+
197+mkStatsAggregation :: FieldName -> StatisticsAggregation
198+mkStatsAggregation = StatisticsAggregation Basic
199+
200+mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
201+mkExtendedStatsAggregation = StatisticsAggregation Extended
202+
203+type AggregationResults = M.Map Text Value
204+
205+class BucketAggregation a where
206+ key :: a -> BucketValue
207+ docCount :: a -> Int
208+ aggs :: a -> Maybe AggregationResults
209+
210+data Bucket a = Bucket
211+ { buckets :: [a]
212+ } deriving (Read, Show)
213+
214+instance (FromJSON a) => FromJSON (Bucket a) where
215+ parseJSON (Object v) = Bucket <$>
216+ v .: "buckets"
217+ parseJSON _ = mempty
218+
219+data BucketValue = TextValue Text
220+ | ScientificValue Scientific
221+ | BoolValue Bool deriving (Read, Show)
222+
223+instance FromJSON BucketValue where
224+ parseJSON (String t) = return $ TextValue t
225+ parseJSON (Number s) = return $ ScientificValue s
226+ parseJSON (Bool b) = return $ BoolValue b
227+ parseJSON _ = mempty
228+
229+data TermInclusion = TermInclusion Text
230+ | TermPattern Text Text deriving (Eq, Show)
231+
232+instance ToJSON TermInclusion where
233+ toJSON (TermInclusion x) = toJSON x
234+ toJSON (TermPattern pattern flags) =
235+ omitNulls [ "pattern" .= pattern
236+ , "flags" .= flags]
237+
238+data TermOrder = TermOrder
239+ { termSortField :: Text
240+ , termSortOrder :: SortOrder } deriving (Eq, Show)
241+
242+instance ToJSON TermOrder where
243+ toJSON (TermOrder termSortField termSortOrder) =
244+ object [termSortField .= termSortOrder]
245+
246+data CollectionMode = BreadthFirst
247+ | DepthFirst deriving (Eq, Show)
248+
249+instance ToJSON CollectionMode where
250+ toJSON BreadthFirst = "breadth_first"
251+ toJSON DepthFirst = "depth_first"
252+
253+data ExecutionHint = Ordinals
254+ | GlobalOrdinals
255+ | GlobalOrdinalsHash
256+ | GlobalOrdinalsLowCardinality
257+ | Map deriving (Eq, Show)
258+
259+instance ToJSON ExecutionHint where
260+ toJSON Ordinals = "ordinals"
261+ toJSON GlobalOrdinals = "global_ordinals"
262+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
263+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
264+ toJSON Map = "map"
265+
266+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
267+data DateMathExpr =
268+ DateMathExpr DateMathAnchor [DateMathModifier]
269+ deriving (Eq, Show)
270+
271+instance ToJSON DateMathExpr where
272+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
273+ where fmtA DMNow = "now"
274+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
275+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
276+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
277+ fmtMod (RoundDownTo u) = "/" <> fmtU u
278+ fmtU DMYear = "y"
279+ fmtU DMMonth = "M"
280+ fmtU DMWeek = "w"
281+ fmtU DMDay = "d"
282+ fmtU DMHour = "h"
283+ fmtU DMMinute = "m"
284+ fmtU DMSecond = "s"
285+
286+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
287+data DateMathAnchor =
288+ DMNow
289+ | DMDate Day
290+ deriving (Eq, Show)
291+
292+data DateMathModifier =
293+ AddTime Int DateMathUnit
294+ | SubtractTime Int DateMathUnit
295+ | RoundDownTo DateMathUnit
296+ deriving (Eq, Show)
297+
298+data DateMathUnit =
299+ DMYear
300+ | DMMonth
301+ | DMWeek
302+ | DMDay
303+ | DMHour
304+ | DMMinute
305+ | DMSecond
306+ deriving (Eq, Show)
src/Database/V5/Bloodhound/Internal/Analysis.hs+2
@@ -3,6 +3,8 @@
3
3
4module Database.V5.Bloodhound.Internal.Analysis where
4module Database.V5.Bloodhound.Internal.Analysis where
5
5
6+import Bloodhound.Import
7+
6import Data.Aeson
8import Data.Aeson
7import Data.Aeson.Types (Parser)
9import Data.Aeson.Types (Parser)
8import qualified Data.Map.Strict as M
10import qualified Data.Map.Strict as M
src/Database/V5/Bloodhound/Internal/Newtypes.hs+3
@@ -5,6 +5,9 @@ module Database.V5.Bloodhound.Internal.Newtypes where
5
5
6import Bloodhound.Import
6import Bloodhound.Import
7
7
8+newtype From = From Int deriving (Eq, Show, ToJSON)
9+newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON)
10+
8-- Slight misnomer.
11-- Slight misnomer.
9type Score = Maybe Double
12type Score = Maybe Double
10
13
src/Database/V5/Bloodhound/Internal/Sort.hsnew file+107
@@ -0,0 +1,107 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.V5.Bloodhound.Internal.Sort where
6+
7+import Bloodhound.Import
8+
9+import Database.V5.Bloodhound.Internal.Newtypes
10+import Database.V5.Bloodhound.Internal.Query
11+
12+{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
13+
14+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
15+-}
16+data SortMode = SortMin
17+ | SortMax
18+ | SortSum
19+ | SortAvg deriving (Eq, Show)
20+
21+instance ToJSON SortMode where
22+ toJSON SortMin = String "min"
23+ toJSON SortMax = String "max"
24+ toJSON SortSum = String "sum"
25+ toJSON SortAvg = String "avg"
26+
27+{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
28+ that you can concisely describe the usual kind of 'SortSpec's you want.
29+-}
30+mkSort :: FieldName -> SortOrder -> DefaultSort
31+mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
32+
33+{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
34+ dependent with later sorts acting as tie-breakers for earlier sorts.
35+-}
36+type Sort = [SortSpec]
37+
38+{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
39+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
40+ 'DistanceUnit' to express "nearness" to a single geographical point as a
41+ sort specification.
42+
43+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
44+-}
45+data SortSpec =
46+ DefaultSortSpec DefaultSort
47+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit
48+ deriving (Eq, Show)
49+
50+instance ToJSON SortSpec where
51+ toJSON (DefaultSortSpec
52+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
53+ dsSortMode dsMissingSort dsNestedFilter)) =
54+ object [dsSortFieldName .= omitNulls base] where
55+ base = [ "order" .= dsSortOrder
56+ , "unmapped_type" .= dsIgnoreUnmapped
57+ , "mode" .= dsSortMode
58+ , "missing" .= dsMissingSort
59+ , "nested_filter" .= dsNestedFilter ]
60+
61+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
62+ object [ "unit" .= units
63+ , field .= gdsLatLon
64+ , "order" .= gdsSortOrder ]
65+
66+{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
67+ 'mkSort' convenience function for when you want to specify only the most
68+ common parameters.
69+
70+ The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
71+
72+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
73+-}
74+data DefaultSort =
75+ DefaultSort { sortFieldName :: FieldName
76+ , sortOrder :: SortOrder
77+ -- default False
78+ , ignoreUnmapped :: Maybe Text
79+ , sortMode :: Maybe SortMode
80+ , missingSort :: Maybe Missing
81+ , nestedFilter :: Maybe Filter } deriving (Eq, Show)
82+
83+{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
84+ encoded into "asc" or "desc" when turned into JSON.
85+
86+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
87+-}
88+data SortOrder = Ascending
89+ | Descending deriving (Eq, Show)
90+
91+instance ToJSON SortOrder where
92+ toJSON Ascending = String "asc"
93+ toJSON Descending = String "desc"
94+
95+{-| 'Missing' prescribes how to handle missing fields. A missing field can be
96+ sorted last, first, or using a custom value as a substitute.
97+
98+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
99+-}
100+data Missing = LastMissing
101+ | FirstMissing
102+ | CustomMissing Text deriving (Eq, Show)
103+
104+instance ToJSON Missing where
105+ toJSON LastMissing = String "_last"
106+ toJSON FirstMissing = String "_first"
107+ toJSON (CustomMissing txt) = String txt
src/Database/V5/Bloodhound/Types.hs+32−420
@@ -414,112 +414,16 @@ module Database.V5.Bloodhound.Types
414
414
415import Bloodhound.Import
415import Bloodhound.Import
416
416
417−import qualified Data.HashMap.Strict as HM
417+import qualified Data.HashMap.Strict as HM
418−import qualified Data.Map.Strict as M
418+import qualified Data.Map.Strict as M
419−import qualified Data.Text as T
420
419
421import Database.V5.Bloodhound.Types.Class
420import Database.V5.Bloodhound.Types.Class
422import Database.V5.Bloodhound.Internal.Analysis
421import Database.V5.Bloodhound.Internal.Analysis
422+import Database.V5.Bloodhound.Internal.Aggregation
423import Database.V5.Bloodhound.Internal.Client
423import Database.V5.Bloodhound.Internal.Client
424import Database.V5.Bloodhound.Internal.Newtypes
424import Database.V5.Bloodhound.Internal.Newtypes
425import Database.V5.Bloodhound.Internal.Query
425import Database.V5.Bloodhound.Internal.Query
426−
426+import Database.V5.Bloodhound.Internal.Sort
427−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
428− dependent with later sorts acting as tie-breakers for earlier sorts.
429−-}
430−type Sort = [SortSpec]
431−
432−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
433− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
434− 'DistanceUnit' to express "nearness" to a single geographical point as a
435− sort specification.
436−
437−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
438−-}
439−data SortSpec =
440− DefaultSortSpec DefaultSort
441− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit
442− deriving (Eq, Show)
443−
444−instance ToJSON SortSpec where
445− toJSON (DefaultSortSpec
446− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
447− dsSortMode dsMissingSort dsNestedFilter)) =
448− object [dsSortFieldName .= omitNulls base] where
449− base = [ "order" .= dsSortOrder
450− , "unmapped_type" .= dsIgnoreUnmapped
451− , "mode" .= dsSortMode
452− , "missing" .= dsMissingSort
453− , "nested_filter" .= dsNestedFilter ]
454−
455− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
456− object [ "unit" .= units
457− , field .= gdsLatLon
458− , "order" .= gdsSortOrder ]
459−
460−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
461− 'mkSort' convenience function for when you want to specify only the most
462− common parameters.
463−
464− The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
465−
466−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
467−-}
468−data DefaultSort =
469− DefaultSort { sortFieldName :: FieldName
470− , sortOrder :: SortOrder
471− -- default False
472− , ignoreUnmapped :: Maybe Text
473− , sortMode :: Maybe SortMode
474− , missingSort :: Maybe Missing
475− , nestedFilter :: Maybe Filter } deriving (Eq, Show)
476−
477−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
478− encoded into "asc" or "desc" when turned into JSON.
479−
480−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
481−-}
482−data SortOrder = Ascending
483− | Descending deriving (Eq, Show)
484−
485−instance ToJSON SortOrder where
486− toJSON Ascending = String "asc"
487− toJSON Descending = String "desc"
488−
489−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
490− sorted last, first, or using a custom value as a substitute.
491−
492−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
493−-}
494−data Missing = LastMissing
495− | FirstMissing
496− | CustomMissing Text deriving (Eq, Show)
497−
498−instance ToJSON Missing where
499− toJSON LastMissing = String "_last"
500− toJSON FirstMissing = String "_first"
501− toJSON (CustomMissing txt) = String txt
502−
503−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
504−
505−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
506−-}
507−data SortMode = SortMin
508− | SortMax
509− | SortSum
510− | SortAvg deriving (Eq, Show)
511−
512−instance ToJSON SortMode where
513− toJSON SortMin = String "min"
514− toJSON SortMax = String "max"
515− toJSON SortSum = String "sum"
516− toJSON SortAvg = String "avg"
517−
518−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
519− that you can concisely describe the usual kind of 'SortSpec's you want.
520−-}
521−mkSort :: FieldName -> SortOrder -> DefaultSort
522−mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
523
427
524{-| 'unpackId' is a silly convenience function that gets used once.
428{-| 'unpackId' is a silly convenience function that gets used once.
525-}
429-}
@@ -527,8 +431,6 @@ unpackId :: DocId -> Text
527unpackId (DocId docId) = docId
431unpackId (DocId docId) = docId
528
432
529type TrackSortScores = Bool
433type TrackSortScores = Bool
530−newtype From = From Int deriving (Eq, Show, ToJSON)
531−newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON)
532
434
533data Search = Search { queryBody :: Maybe Query
435data Search = Search { queryBody :: Maybe Query
534 , filterBody :: Maybe Filter
436 , filterBody :: Maybe Filter
@@ -546,6 +448,31 @@ data Search = Search { queryBody :: Maybe Query
546 , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
448 , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
547 } deriving (Eq, Show)
449 } deriving (Eq, Show)
548
450
451+
452+instance ToJSON Search where
453+ toJSON (Search mquery sFilter sort searchAggs
454+ highlight sTrackSortScores sFrom sSize _ sFields
455+ sScriptFields sSource sSuggest) =
456+ omitNulls [ "query" .= query'
457+ , "sort" .= sort
458+ , "aggregations" .= searchAggs
459+ , "highlight" .= highlight
460+ , "from" .= sFrom
461+ , "size" .= sSize
462+ , "track_scores" .= sTrackSortScores
463+ , "fields" .= sFields
464+ , "script_fields" .= sScriptFields
465+ , "_source" .= sSource
466+ , "suggest" .= sSuggest]
467+
468+ where query' = case sFilter of
469+ Nothing -> mquery
470+ Just x ->
471+ Just
472+ . QueryBoolQuery
473+ $ mkBoolQuery (maybeToList mquery)
474+ [x] [] []
475+
549data SearchType = SearchTypeQueryThenFetch
476data SearchType = SearchTypeQueryThenFetch
550 | SearchTypeDfsQueryThenFetch
477 | SearchTypeDfsQueryThenFetch
551 deriving (Eq, Show)
478 deriving (Eq, Show)
@@ -644,7 +571,6 @@ data SearchResult a =
644 }
571 }
645 deriving (Eq, Show)
572 deriving (Eq, Show)
646
573
647−
648instance (FromJSON a) => FromJSON (SearchResult a) where
574instance (FromJSON a) => FromJSON (SearchResult a) where
649 parseJSON (Object v) = SearchResult <$>
575 parseJSON (Object v) = SearchResult <$>
650 v .: "took" <*>
576 v .: "took" <*>
@@ -674,7 +600,8 @@ instance (FromJSON a) => FromJSON (SearchHits a) where
674 parseJSON _ = empty
600 parseJSON _ = empty
675
601
676instance Semigroup (SearchHits a) where
602instance Semigroup (SearchHits a) where
677− (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
603+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) =
604+ SearchHits (ta + tb) (max ma mb) (ha <> hb)
678
605
679instance Monoid (SearchHits a) where
606instance Monoid (SearchHits a) where
680 mempty = SearchHits 0 Nothing mempty
607 mempty = SearchHits 0 Nothing mempty
@@ -710,297 +637,6 @@ instance FromJSON HitFields where
710
637
711type HitHighlight = M.Map Text [Text]
638type HitHighlight = M.Map Text [Text]
712
639
713−type Aggregations = M.Map Text Aggregation
714−
715−emptyAggregations :: Aggregations
716−emptyAggregations = M.empty
717−
718−mkAggregations :: Text -> Aggregation -> Aggregations
719−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
720−
721−data TermOrder = TermOrder
722− { termSortField :: Text
723− , termSortOrder :: SortOrder } deriving (Eq, Show)
724−
725−instance ToJSON TermOrder where
726− toJSON (TermOrder termSortField termSortOrder) =
727− object [termSortField .= termSortOrder]
728−
729−data TermInclusion = TermInclusion Text
730− | TermPattern Text Text deriving (Eq, Show)
731−
732−instance ToJSON TermInclusion where
733− toJSON (TermInclusion x) = toJSON x
734− toJSON (TermPattern pattern flags) =
735− omitNulls [ "pattern" .= pattern
736− , "flags" .= flags]
737−
738−data CollectionMode = BreadthFirst
739− | DepthFirst deriving (Eq, Show)
740−
741−instance ToJSON CollectionMode where
742− toJSON BreadthFirst = "breadth_first"
743− toJSON DepthFirst = "depth_first"
744−
745−data ExecutionHint = Ordinals
746− | GlobalOrdinals
747− | GlobalOrdinalsHash
748− | GlobalOrdinalsLowCardinality
749− | Map deriving (Eq, Show)
750−
751−instance ToJSON ExecutionHint where
752− toJSON Ordinals = "ordinals"
753− toJSON GlobalOrdinals = "global_ordinals"
754− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
755− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
756− toJSON Map = "map"
757−
758−data Aggregation = TermsAgg TermsAggregation
759− | CardinalityAgg CardinalityAggregation
760− | DateHistogramAgg DateHistogramAggregation
761− | ValueCountAgg ValueCountAggregation
762− | FilterAgg FilterAggregation
763− | DateRangeAgg DateRangeAggregation
764− | MissingAgg MissingAggregation
765− | TopHitsAgg TopHitsAggregation
766− | StatsAgg StatisticsAggregation
767− deriving (Eq, Show)
768−
769−instance ToJSON Aggregation where
770− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
771− omitNulls ["terms" .= omitNulls [ toJSON' term,
772− "include" .= include,
773− "exclude" .= exclude,
774− "order" .= order,
775− "min_doc_count" .= minDocCount,
776− "size" .= size,
777− "shard_size" .= shardSize,
778− "collect_mode" .= collectMode,
779− "execution_hint" .= executionHint
780− ],
781− "aggs" .= termAggs ]
782− where
783− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
784−
785− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
786− object ["cardinality" .= omitNulls [ "field" .= field,
787− "precisionThreshold" .= precisionThreshold
788− ]
789− ]
790−
791− toJSON (DateHistogramAgg
792− (DateHistogramAggregation field interval format
793− preZone postZone preOffset postOffset dateHistoAggs)) =
794− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
795− "interval" .= interval,
796− "format" .= format,
797− "pre_zone" .= preZone,
798− "post_zone" .= postZone,
799− "pre_offset" .= preOffset,
800− "post_offset" .= postOffset
801− ],
802− "aggs" .= dateHistoAggs ]
803− toJSON (ValueCountAgg a) = object ["value_count" .= v]
804− where v = case a of
805− (FieldValueCount (FieldName n)) ->
806− object ["field" .= n]
807− (ScriptValueCount s) ->
808− object ["script" .= s]
809− toJSON (FilterAgg (FilterAggregation filt ags)) =
810− omitNulls [ "filter" .= filt
811− , "aggs" .= ags]
812− toJSON (DateRangeAgg a) = object [ "date_range" .= a
813− ]
814− toJSON (MissingAgg (MissingAggregation{..})) =
815− object ["missing" .= object ["field" .= maField]]
816−
817− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
818− omitNulls ["top_hits" .= omitNulls [ "size" .= msize
819− , "from" .= mfrom
820− , "sort" .= msort
821− ]
822− ]
823−
824− toJSON (StatsAgg (StatisticsAggregation typ field)) =
825− object [stType .= omitNulls [ "field" .= field ]]
826− where
827− stType | typ == Basic = "stats"
828− | otherwise = "extended_stats"
829−
830−data TopHitsAggregation = TopHitsAggregation
831− { taFrom :: Maybe From
832− , taSize :: Maybe Size
833− , taSort :: Maybe Sort
834− } deriving (Eq, Show)
835−
836−data MissingAggregation = MissingAggregation
837− { maField :: Text
838− } deriving (Eq, Show)
839−
840−data TermsAggregation = TermsAggregation
841− { term :: Either Text Text
842− , termInclude :: Maybe TermInclusion
843− , termExclude :: Maybe TermInclusion
844− , termOrder :: Maybe TermOrder
845− , termMinDocCount :: Maybe Int
846− , termSize :: Maybe Int
847− , termShardSize :: Maybe Int
848− , termCollectMode :: Maybe CollectionMode
849− , termExecutionHint :: Maybe ExecutionHint
850− , termAggs :: Maybe Aggregations
851− } deriving (Eq, Show)
852−
853−data CardinalityAggregation = CardinalityAggregation
854− { cardinalityField :: FieldName,
855− precisionThreshold :: Maybe Int
856− } deriving (Eq, Show)
857−
858−data DateHistogramAggregation = DateHistogramAggregation
859− { dateField :: FieldName
860− , dateInterval :: Interval
861− , dateFormat :: Maybe Text
862− -- pre and post deprecated in 1.5
863− , datePreZone :: Maybe Text
864− , datePostZone :: Maybe Text
865− , datePreOffset :: Maybe Text
866− , datePostOffset :: Maybe Text
867− , dateAggs :: Maybe Aggregations
868− } deriving (Eq, Show)
869−
870−data DateRangeAggregation = DateRangeAggregation
871− { draField :: FieldName
872− , draFormat :: Maybe Text
873− , draRanges :: NonEmpty DateRangeAggRange
874− } deriving (Eq, Show)
875−
876−instance ToJSON DateRangeAggregation where
877− toJSON DateRangeAggregation {..} =
878− omitNulls [ "field" .= draField
879− , "format" .= draFormat
880− , "ranges" .= toList draRanges
881− ]
882−
883−data DateRangeAggRange =
884− DateRangeFrom DateMathExpr
885− | DateRangeTo DateMathExpr
886− | DateRangeFromAndTo DateMathExpr DateMathExpr
887− deriving (Eq, Show)
888−
889−instance ToJSON DateRangeAggRange where
890− toJSON (DateRangeFrom e) = object [ "from" .= e ]
891− toJSON (DateRangeTo e) = object [ "to" .= e ]
892− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
893−
894−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
895−data DateMathExpr =
896− DateMathExpr DateMathAnchor [DateMathModifier]
897− deriving (Eq, Show)
898−
899−instance ToJSON DateMathExpr where
900− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
901− where fmtA DMNow = "now"
902− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
903− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
904− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
905− fmtMod (RoundDownTo u) = "/" <> fmtU u
906− fmtU DMYear = "y"
907− fmtU DMMonth = "M"
908− fmtU DMWeek = "w"
909− fmtU DMDay = "d"
910− fmtU DMHour = "h"
911− fmtU DMMinute = "m"
912− fmtU DMSecond = "s"
913−
914−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
915−data DateMathAnchor =
916− DMNow
917− | DMDate Day
918− deriving (Eq, Show)
919−
920−data DateMathModifier =
921− AddTime Int DateMathUnit
922− | SubtractTime Int DateMathUnit
923− | RoundDownTo DateMathUnit
924− deriving (Eq, Show)
925−
926−data DateMathUnit =
927− DMYear
928− | DMMonth
929− | DMWeek
930− | DMDay
931− | DMHour
932− | DMMinute
933− | DMSecond
934− deriving (Eq, Show)
935−
936−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
937−data ValueCountAggregation =
938− FieldValueCount FieldName
939− | ScriptValueCount Script
940− deriving (Eq, Show)
941−
942−-- | 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.
943−data FilterAggregation = FilterAggregation
944− { faFilter :: Filter
945− , faAggs :: Maybe Aggregations }
946− deriving (Eq, Show)
947−
948−data StatisticsAggregation = StatisticsAggregation
949− { statsType :: StatsType
950− , statsField :: FieldName }
951− deriving (Eq, Show)
952−
953−data StatsType
954− = Basic
955− | Extended
956− deriving (Eq, Show)
957−
958−mkTermsAggregation :: Text -> TermsAggregation
959−mkTermsAggregation t =
960− TermsAggregation (Left t)
961− Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
962−
963−mkTermsScriptAggregation :: Text -> TermsAggregation
964−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
965−
966−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
967−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
968−
969−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
970−mkCardinalityAggregation t = CardinalityAggregation t Nothing
971−
972−mkStatsAggregation :: FieldName -> StatisticsAggregation
973−mkStatsAggregation = StatisticsAggregation Basic
974−
975−mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
976−mkExtendedStatsAggregation = StatisticsAggregation Extended
977−
978−type AggregationResults = M.Map Text Value
979−
980−class BucketAggregation a where
981− key :: a -> BucketValue
982− docCount :: a -> Int
983− aggs :: a -> Maybe AggregationResults
984−
985−data Bucket a = Bucket
986− { buckets :: [a]
987− } deriving (Read, Show)
988−
989−instance (FromJSON a) => FromJSON (Bucket a) where
990− parseJSON (Object v) = Bucket <$>
991− v .: "buckets"
992− parseJSON _ = mempty
993−
994−data BucketValue = TextValue Text
995− | ScientificValue Scientific
996− | BoolValue Bool deriving (Read, Show)
997−
998−instance FromJSON BucketValue where
999− parseJSON (String t) = return $ TextValue t
1000− parseJSON (Number s) = return $ ScientificValue s
1001− parseJSON (Bool b) = return $ BoolValue b
1002− parseJSON _ = mempty
1003−
1004data MissingResult = MissingResult
640data MissingResult = MissingResult
1005 { missingDocCount :: Int
641 { missingDocCount :: Int
1006 } deriving (Show)
642 } deriving (Show)
@@ -1093,7 +729,7 @@ instance BucketAggregation DateRangeResult where
1093 docCount = dateRangeDocCount
729 docCount = dateRangeDocCount
1094 aggs = dateRangeAggs
730 aggs = dateRangeAggs
1095
731
1096−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
732+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1097toTerms = toAggResult
733toTerms = toAggResult
1098
734
1099toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
735toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
@@ -1118,30 +754,6 @@ getNamedSubAgg o knownKeys = maggRes
1118 | HM.null unknownKeys = Nothing
754 | HM.null unknownKeys = Nothing
1119 | otherwise = Just . M.fromList $ HM.toList unknownKeys
755 | otherwise = Just . M.fromList $ HM.toList unknownKeys
1120
756
1121−instance ToJSON Search where
1122− toJSON (Search mquery sFilter sort searchAggs
1123− highlight sTrackSortScores sFrom sSize _ sFields
1124− sScriptFields sSource sSuggest) =
1125− omitNulls [ "query" .= query'
1126− , "sort" .= sort
1127− , "aggregations" .= searchAggs
1128− , "highlight" .= highlight
1129− , "from" .= sFrom
1130− , "size" .= sSize
1131− , "track_scores" .= sTrackSortScores
1132− , "fields" .= sFields
1133− , "script_fields" .= sScriptFields
1134− , "_source" .= sSource
1135− , "suggest" .= sSuggest]
1136−
1137− where query' = case sFilter of
1138− Nothing -> mquery
1139− Just x ->
1140− Just
1141− . QueryBoolQuery
1142− $ mkBoolQuery (maybeToList mquery)
1143− [x] [] []
1144−
1145instance ToJSON Source where
757instance ToJSON Source where
1146 toJSON NoSource = toJSON False
758 toJSON NoSource = toJSON False
1147 toJSON (SourcePatterns patterns) = toJSON patterns
759 toJSON (SourcePatterns patterns) = toJSON patterns