git.iko.soy/typeable/bloodhound
on master help sign in
Merge branch 'master' of github.com:bitemyapp/bloodhound
6a04d9dChris Allen
.travis.yml+6−5
compare with master
unifiedsplit
@@ -7,11 +7,12 @@
7# release of a major GHC version. Setting HPVER implictly sets
7# release of a major GHC version. Setting HPVER implictly sets
8# GHCVER. Omit lines with versions you don't need/want testing for.
8# GHCVER. Omit lines with versions you don't need/want testing for.
9env:
9env:
10− - GHCVER=7.6.3 ESVER=1.3.2
10+ - GHCVER=7.6.3 ESVER=1.4.0
11− - GHCVER=7.8.2 ESVER=1.0.3
11+ - GHCVER=7.8.3 ESVER=1.0.3
12− - GHCVER=7.8.2 ESVER=1.1.2
12+ - GHCVER=7.8.3 ESVER=1.1.2
13− - GHCVER=7.8.2 ESVER=1.2.3
13+ - GHCVER=7.8.3 ESVER=1.2.3
14− - GHCVER=7.8.2 ESVER=1.3.2
14+ - GHCVER=7.8.3 ESVER=1.3.2
15+ - GHCVER=7.8.3 ESVER=1.4.0
15
16
16# services:
17# services:
17# - elasticsearch
18# - elasticsearch
Database/Bloodhound/Client.hs+37−29
@@ -15,20 +15,24 @@ module Database.Bloodhound.Client
15 , searchByType
15 , searchByType
16 , refreshIndex
16 , refreshIndex
17 , mkSearch
17 , mkSearch
18+ , mkAggregateSearch
18 , bulk
19 , bulk
19 , pageSearch
20 , pageSearch
20 , mkShardCount
21 , mkShardCount
21 , mkReplicaCount
22 , mkReplicaCount
22 , getStatus
23 , getStatus
24+ , encodeBulkOperations
25+ , encodeBulkOperation
23 )
26 )
24 where
27 where
25
28
26import Data.Aeson
29import Data.Aeson
27import qualified Data.ByteString.Lazy.Char8 as L
30import qualified Data.ByteString.Lazy.Char8 as L
28import Data.ByteString.Builder
31import Data.ByteString.Builder
29−import Data.List (foldl', intercalate, intersperse)
32+import Data.List (intercalate)
30import Data.Maybe (fromMaybe)
33import Data.Maybe (fromMaybe)
31import Data.Text (Text)
34import Data.Text (Text)
35+import qualified Data.Vector as V
32import Network.HTTP.Client
36import Network.HTTP.Client
33import qualified Network.HTTP.Types.Method as NHTM
37import qualified Network.HTTP.Types.Method as NHTM
34import qualified Network.HTTP.Types.Status as NHTS
38import qualified Network.HTTP.Types.Status as NHTS
@@ -166,52 +170,53 @@ deleteDocument (Server server) (IndexName indexName)
166 (MappingName mappingName) (DocId docId) =
170 (MappingName mappingName) (DocId docId) =
167 delete $ joinPath [server, indexName, mappingName, docId]
171 delete $ joinPath [server, indexName, mappingName, docId]
168
172
169−bulk :: Server -> [BulkOperation] -> IO Reply
173+bulk :: Server -> V.Vector BulkOperation -> IO Reply
170bulk (Server server) bulkOps = post url body where
174bulk (Server server) bulkOps = post url body where
171 url = joinPath [server, "_bulk"]
175 url = joinPath [server, "_bulk"]
172− body = Just $ collapseStream bulkOps
176+ body = Just $ encodeBulkOperations bulkOps
173
177
174−collapseStream :: [BulkOperation] -> L.ByteString
178+encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
175−collapseStream stream = collapsed where
179+encodeBulkOperations stream = collapsed where
176− blobs = intersperse "\n" $ concat $ fmap getStreamChunk stream
180+ blobs = fmap encodeBulkOperation stream
177 mashedTaters = mash (mempty :: Builder) blobs
181 mashedTaters = mash (mempty :: Builder) blobs
178 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
182 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
179
183
180−mash :: Builder -> [L.ByteString] -> Builder
184+mash :: Builder -> V.Vector L.ByteString -> Builder
181−mash = foldl' (\b x -> mappend b (lazyByteString x))
185+mash = V.foldl' (\b x -> b `mappend` "\n" `mappend` (lazyByteString x))
182
186
183−mkMetadataValue :: Text -> String -> String -> String -> Value
187+mkBulkStreamValue :: Text -> String -> String -> String -> Value
184−mkMetadataValue operation indexName mappingName docId =
188+mkBulkStreamValue operation indexName mappingName docId =
185 object [operation .=
189 object [operation .=
186 object [ "_index" .= indexName
190 object [ "_index" .= indexName
187 , "_type" .= mappingName
191 , "_type" .= mappingName
188 , "_id" .= docId]]
192 , "_id" .= docId]]
189
193
190−getStreamChunk :: BulkOperation -> [L.ByteString]
194+encodeBulkOperation :: BulkOperation -> L.ByteString
191−getStreamChunk (BulkIndex (IndexName indexName)
195+encodeBulkOperation (BulkIndex (IndexName indexName)
192 (MappingName mappingName)
196 (MappingName mappingName)
193− (DocId docId) value) = blob where
197+ (DocId docId) value) = blob
194− metadata = mkMetadataValue "index" indexName mappingName docId
198+ where metadata = mkBulkStreamValue "index" indexName mappingName docId
195− blob = [encode metadata, encode value]
199+ blob = encode metadata `mappend` "\n" `mappend` encode value
196
200
197−getStreamChunk (BulkCreate (IndexName indexName)
201+encodeBulkOperation (BulkCreate (IndexName indexName)
198 (MappingName mappingName)
202 (MappingName mappingName)
199− (DocId docId) value) = blob where
203+ (DocId docId) value) = blob
200− metadata = mkMetadataValue "create" indexName mappingName docId
204+ where metadata = mkBulkStreamValue "create" indexName mappingName docId
201− blob = [encode metadata, encode value]
205+ blob = encode metadata `mappend` "\n" `mappend` encode value
202
206
203−getStreamChunk (BulkDelete (IndexName indexName)
207+encodeBulkOperation (BulkDelete (IndexName indexName)
204 (MappingName mappingName)
208 (MappingName mappingName)
205− (DocId docId)) = blob where
209+ (DocId docId)) = blob
206− metadata = mkMetadataValue "delete" indexName mappingName docId
210+ where metadata = mkBulkStreamValue "delete" indexName mappingName docId
207− blob = [encode metadata]
211+ blob = encode metadata
208
212
209−getStreamChunk (BulkUpdate (IndexName indexName)
213+encodeBulkOperation (BulkUpdate (IndexName indexName)
210 (MappingName mappingName)
214 (MappingName mappingName)
211− (DocId docId) value) = blob where
215+ (DocId docId) value) = blob
212− metadata = mkMetadataValue "update" indexName mappingName docId
216+ where metadata = mkBulkStreamValue "update" indexName mappingName docId
213− doc = object ["doc" .= value]
217+ doc = object ["doc" .= value]
214− blob = [encode metadata, encode doc]
218+ blob = encode metadata `mappend` "\n" `mappend` encode doc
219+
215
220
216getDocument :: Server -> IndexName -> MappingName
221getDocument :: Server -> IndexName -> MappingName
217 -> DocId -> IO Reply
222 -> DocId -> IO Reply
@@ -244,7 +249,10 @@ searchByType (Server server) (IndexName indexName)
244 url = joinPath [server, indexName, mappingName, "_search"]
249 url = joinPath [server, indexName, mappingName, "_search"]
245
250
246mkSearch :: Maybe Query -> Maybe Filter -> Search
251mkSearch :: Maybe Query -> Maybe Filter -> Search
247−mkSearch query filter = Search query filter Nothing False 0 10
252+mkSearch query filter = Search query filter Nothing Nothing False 0 10
253+
254+mkAggregateSearch :: Maybe Query -> Aggregations -> Search
255+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) False 0 0
248
256
249pageSearch :: Int -> Int -> Search -> Search
257pageSearch :: Int -> Int -> Search -> Search
250pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize }
258pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize }
Database/Bloodhound/Types.hs+238−16
@@ -22,6 +22,12 @@ module Database.Bloodhound.Types
22 , mkBoolQuery
22 , mkBoolQuery
23 , mkRangeQuery
23 , mkRangeQuery
24 , mkQueryStringQuery
24 , mkQueryStringQuery
25+ , mkAggregations
26+ , mkTermsAggregation
27+ , mkTermsScriptAggregation
28+ , mkDateHistogram
29+ , toTerms
30+ , toDateHistogram
25 , omitNulls
31 , omitNulls
26 , Version(..)
32 , Version(..)
27 , Status(..)
33 , Status(..)
@@ -143,16 +149,33 @@ module Database.Bloodhound.Types
143 , FieldOrFields(..)
149 , FieldOrFields(..)
144 , Monoid(..)
150 , Monoid(..)
145 , ToJSON(..)
151 , ToJSON(..)
152+ , Interval(..)
153+ , TimeInterval(..)
154+ , ExecutionHint(..)
155+ , CollectionMode(..)
156+ , TermOrder(..)
157+ , TermInclusion(..)
158+ , Aggregation(..)
159+ , Aggregations
160+ , AggregationResults
161+ , Bucket(..)
162+ , BucketAggregation(..)
163+ , TermsAggregation(..)
164+ , DateHistogramAggregation(..)
165+ , TermsResult(..)
166+ , DateHistogramResult(..)
146 ) where
167 ) where
147
168
148import Control.Applicative
169import Control.Applicative
149import Data.Aeson
170import Data.Aeson
171+import Data.Aeson.Types (parseMaybe)
150import qualified Data.ByteString.Lazy.Char8 as L
172import qualified Data.ByteString.Lazy.Char8 as L
151import Data.List (nub)
173import Data.List (nub)
152import Data.List.NonEmpty (NonEmpty (..))
174import Data.List.NonEmpty (NonEmpty (..))
153import Data.Monoid
175import Data.Monoid
154import Data.Text (Text)
176import Data.Text (Text)
155import qualified Data.Text as T
177import qualified Data.Text as T
178+import qualified Data.Map.Strict as M
156import Data.Time.Clock (UTCTime)
179import Data.Time.Clock (UTCTime)
157import qualified Data.Vector as V
180import qualified Data.Vector as V
158import GHC.Generics (Generic)
181import GHC.Generics (Generic)
@@ -473,9 +496,10 @@ type TrackSortScores = Bool
473type From = Int
496type From = Int
474type Size = Int
497type Size = Int
475
498
476−data Search = Search { queryBody :: Maybe Query
499+data Search = Search { queryBody :: Maybe Query
477− , filterBody :: Maybe Filter
500+ , filterBody :: Maybe Filter
478− , sortBody :: Maybe Sort
501+ , sortBody :: Maybe Sort
502+ , aggBody :: Maybe Aggregations
479 -- default False
503 -- default False
480 , trackSortScores :: TrackSortScores
504 , trackSortScores :: TrackSortScores
481 , from :: From
505 , from :: From
@@ -915,10 +939,11 @@ data DistanceRange =
915 , distanceTo :: Distance } deriving (Eq, Show)
939 , distanceTo :: Distance } deriving (Eq, Show)
916
940
917data FromJSON a => SearchResult a =
941data FromJSON a => SearchResult a =
918− SearchResult { took :: Int
942+ SearchResult { took :: Int
919− , timedOut :: Bool
943+ , timedOut :: Bool
920− , shards :: ShardResult
944+ , shards :: ShardResult
921− , searchHits :: SearchHits a } deriving (Eq, Show)
945+ , searchHits :: SearchHits a
946+ , aggregations :: Maybe AggregationResults } deriving (Eq, Show)
922
947
923type Score = Double
948type Score = Double
924
949
@@ -942,6 +967,201 @@ data ShardResult =
942showText :: Show a => a -> Text
967showText :: Show a => a -> Text
943showText = T.pack . show
968showText = T.pack . show
944
969
970+type Aggregations = M.Map Text Aggregation
971+
972+emptyAggregations :: Aggregations
973+emptyAggregations = M.empty
974+
975+mkAggregations :: Text -> Aggregation -> Aggregations
976+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
977+
978+data TermOrder = TermOrder{ termSortField :: Text
979+ , termSortOrder :: SortOrder } deriving (Eq, Show)
980+
981+data TermInclusion = TermInclusion Text
982+ | TermPattern Text Text deriving (Eq, Show)
983+
984+data CollectionMode = BreadthFirst
985+ | DepthFirst deriving (Eq, Show)
986+
987+data ExecutionHint = Ordinals
988+ | GlobalOrdinals
989+ | GlobalOrdinalsHash
990+ | GlobalOrdinalsLowCardinality
991+ | Map deriving (Eq, Show)
992+
993+data TimeInterval = Weeks
994+ | Days
995+ | Hours
996+ | Minutes
997+ | Seconds deriving (Eq)
998+
999+data Interval = Year
1000+ | Quarter
1001+ | Month
1002+ | Week
1003+ | Day
1004+ | Hour
1005+ | Minute
1006+ | Second
1007+ | FractionalInterval Float TimeInterval deriving (Eq, Show)
1008+
1009+data Aggregation = TermsAgg TermsAggregation
1010+ | DateHistogramAgg DateHistogramAggregation deriving (Eq, Show)
1011+
1012+
1013+data TermsAggregation = TermsAggregation { term :: Either Text Text
1014+ , termInclude :: Maybe TermInclusion
1015+ , termExclude :: Maybe TermInclusion
1016+ , termOrder :: Maybe TermOrder
1017+ , termMinDocCount :: Maybe Int
1018+ , termSize :: Maybe Int
1019+ , termShardSize :: Maybe Int
1020+ , termCollectMode :: Maybe CollectionMode
1021+ , termExecutionHint :: Maybe ExecutionHint
1022+ , termAggs :: Maybe Aggregations
1023+ } deriving (Eq, Show)
1024+
1025+data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1026+ , dateInterval :: Interval
1027+ , dateFormat :: Maybe Text
1028+ , datePreZone :: Maybe Text
1029+ , datePostZone :: Maybe Text
1030+ , datePreOffset :: Maybe Text
1031+ , datePostOffset :: Maybe Text
1032+ , dateAggs :: Maybe Aggregations
1033+ } deriving (Eq, Show)
1034+
1035+
1036+mkTermsAggregation :: Text -> TermsAggregation
1037+mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1038+
1039+mkTermsScriptAggregation :: Text -> TermsAggregation
1040+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1041+
1042+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1043+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1044+
1045+instance ToJSON TermOrder where
1046+ toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1047+
1048+instance ToJSON TermInclusion where
1049+ toJSON (TermInclusion x) = toJSON x
1050+ toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1051+ "flags" .= flags]
1052+
1053+instance ToJSON CollectionMode where
1054+ toJSON BreadthFirst = "breadth_first"
1055+ toJSON DepthFirst = "depth_first"
1056+
1057+instance ToJSON ExecutionHint where
1058+ toJSON Ordinals = "ordinals"
1059+ toJSON GlobalOrdinals = "global_ordinals"
1060+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1061+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1062+ toJSON Map = "map"
1063+
1064+instance ToJSON Interval where
1065+ toJSON Year = "year"
1066+ toJSON Quarter = "quarter"
1067+ toJSON Month = "month"
1068+ toJSON Week = "week"
1069+ toJSON Day = "day"
1070+ toJSON Hour = "hour"
1071+ toJSON Minute = "minute"
1072+ toJSON Second = "second"
1073+ toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1074+
1075+instance Show TimeInterval where
1076+ show Weeks = "w"
1077+ show Days = "d"
1078+ show Hours = "h"
1079+ show Minutes = "m"
1080+ show Seconds = "s"
1081+
1082+instance ToJSON Aggregation where
1083+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1084+ omitNulls ["terms" .= omitNulls [ toJSON' term,
1085+ "include" .= toJSON include,
1086+ "exclude" .= toJSON exclude,
1087+ "order" .= toJSON order,
1088+ "min_doc_count" .= toJSON minDocCount,
1089+ "size" .= toJSON size,
1090+ "shard_size" .= toJSON shardSize,
1091+ "collect_mode" .= toJSON collectMode,
1092+ "execution_hint" .= toJSON executionHint
1093+ ],
1094+ "aggs" .= toJSON termAggs ]
1095+ where
1096+ toJSON' x = case x of { Left y -> "field" .= toJSON y; Right y -> "script" .= toJSON y }
1097+
1098+ toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1099+ omitNulls ["date_histogram" .= omitNulls [ "field" .= toJSON field,
1100+ "interval" .= toJSON interval,
1101+ "format" .= toJSON format,
1102+ "pre_zone" .= toJSON preZone,
1103+ "post_zone" .= toJSON postZone,
1104+ "pre_offset" .= toJSON preOffset,
1105+ "post_offset" .= toJSON postOffset
1106+ ],
1107+ "aggs" .= toJSON dateHistoAggs ]
1108+
1109+type AggregationResults = M.Map Text Value
1110+
1111+class BucketAggregation a where
1112+ key :: a -> Text
1113+ docCount :: a -> Int
1114+ aggs :: a -> Maybe AggregationResults
1115+
1116+
1117+data (FromJSON a, BucketAggregation a) => Bucket a = Bucket { buckets :: [a]} deriving (Show)
1118+
1119+data TermsResult = TermsResult { termKey :: Text
1120+ , termsDocCount :: Int
1121+ , termsAggs :: Maybe AggregationResults } deriving (Show)
1122+
1123+data DateHistogramResult = DateHistogramResult { dateKey :: Int
1124+ , dateKeyStr :: Maybe Text
1125+ , dateDocCount :: Int
1126+ , dateHistogramAggs :: Maybe AggregationResults } deriving (Show)
1127+
1128+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1129+toTerms t a = M.lookup t a >>= deserialize
1130+ where deserialize = parseMaybe parseJSON
1131+
1132+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
1133+toDateHistogram t a = M.lookup t a >>= deserialize
1134+ where deserialize = parseMaybe parseJSON
1135+
1136+instance BucketAggregation TermsResult where
1137+ key = termKey
1138+ docCount = termsDocCount
1139+ aggs = termsAggs
1140+
1141+instance BucketAggregation DateHistogramResult where
1142+ key = showText . dateKey
1143+ docCount = dateDocCount
1144+ aggs = dateHistogramAggs
1145+
1146+instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
1147+ parseJSON (Object v) = Bucket <$>
1148+ v .: "buckets"
1149+ parseJSON _ = mempty
1150+
1151+instance FromJSON TermsResult where
1152+ parseJSON (Object v) = TermsResult <$>
1153+ v .: "key" <*>
1154+ v .: "doc_count" <*>
1155+ v .:? "aggregations"
1156+ parseJSON _ = mempty
1157+
1158+instance FromJSON DateHistogramResult where
1159+ parseJSON (Object v) = DateHistogramResult <$>
1160+ v .: "key" <*>
1161+ v .:? "key_as_string" <*>
1162+ v .: "doc_count" <*>
1163+ v .:? "aggregations"
1164+ parseJSON _ = mempty
945
1165
946instance Monoid Filter where
1166instance Monoid Filter where
947 mempty = IdentityFilter
1167 mempty = IdentityFilter
@@ -1026,11 +1246,11 @@ instance ToJSON Filter where
1026 toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =
1246 toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =
1027 object ["range" .=
1247 object ["range" .=
1028 object [fieldName .=
1248 object [fieldName .=
1029− object [key .= val]
1249+ object [rqFKey .= rqFVal]
1030 , "execution" .= toJSON rangeExecution
1250 , "execution" .= toJSON rangeExecution
1031 , "_cache" .= cache]]
1251 , "_cache" .= cache]]
1032 where
1252 where
1033− (key, val) = halfRangeToKV halfRange
1253+ (rqFKey, rqFVal) = halfRangeToKV halfRange
1034
1254
1035 toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =
1255 toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =
1036 object ["range" .=
1256 object ["range" .=
@@ -1244,8 +1464,8 @@ instance ToJSON RangeQuery where
1244 toJSON (RangeQuery (FieldName fieldName) (Left halfRange) boost) =
1464 toJSON (RangeQuery (FieldName fieldName) (Left halfRange) boost) =
1245 object [ fieldName .= conjoined ]
1465 object [ fieldName .= conjoined ]
1246 where conjoined = [ "boost" .= toJSON boost
1466 where conjoined = [ "boost" .= toJSON boost
1247− , key .= val ]
1467+ , rqKey .= rqVal ]
1248− (key, val) = halfRangeToKV halfRange
1468+ (rqKey, rqVal) = halfRangeToKV halfRange
1249
1469
1250
1470
1251instance ToJSON PrefixQuery where
1471instance ToJSON PrefixQuery where
@@ -1536,10 +1756,11 @@ instance (FromJSON a) => FromJSON (EsResult a) where
1536
1756
1537
1757
1538instance ToJSON Search where
1758instance ToJSON Search where
1539− toJSON (Search query sFilter sort sTrackSortScores sFrom sSize) =
1759+ toJSON (Search query sFilter sort searchAggs sTrackSortScores sFrom sSize) =
1540 omitNulls [ "query" .= query
1760 omitNulls [ "query" .= query
1541 , "filter" .= sFilter
1761 , "filter" .= sFilter
1542 , "sort" .= sort
1762 , "sort" .= sort
1763+ , "aggregations" .= searchAggs
1543 , "from" .= sFrom
1764 , "from" .= sFrom
1544 , "size" .= sSize
1765 , "size" .= sSize
1545 , "track_scores" .= sTrackSortScores ]
1766 , "track_scores" .= sTrackSortScores ]
@@ -1677,10 +1898,11 @@ instance ToJSON BoolMatch where
1677
1898
1678instance (FromJSON a) => FromJSON (SearchResult a) where
1899instance (FromJSON a) => FromJSON (SearchResult a) where
1679 parseJSON (Object v) = SearchResult <$>
1900 parseJSON (Object v) = SearchResult <$>
1680− v .: "took" <*>
1901+ v .: "took" <*>
1681− v .: "timed_out" <*>
1902+ v .: "timed_out" <*>
1682− v .: "_shards" <*>
1903+ v .: "_shards" <*>
1683− v .: "hits"
1904+ v .: "hits" <*>
1905+ v .:? "aggregations"
1684 parseJSON _ = empty
1906 parseJSON _ = empty
1685
1907
1686instance (FromJSON a) => FromJSON (SearchHits a) where
1908instance (FromJSON a) => FromJSON (SearchHits a) where
LICENSE+8−17
@@ -1,21 +1,12 @@
1−The MIT License (MIT)
1+Copyright (c) 2014, Chris Allen
2+All rights reserved.
2
3
3−Copyright (c) <2014> <Chris Allen>
4+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
4
5
5−Permission is hereby granted, free of charge, to any person obtaining a copy
6+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
6−of this software and associated documentation files (the "Software"), to deal
7−in the Software without restriction, including without limitation the rights
8−to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9−copies of the Software, and to permit persons to whom the Software is
10−furnished to do so, subject to the following conditions:
11
7
12−The above copyright notice and this permission notice shall be included in
8+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
13−all copies or substantial portions of the Software.
14
9
15−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
10+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
16−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
11+
17−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
12+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
18−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
21−THE SOFTWARE.
README.org+194−1
@@ -48,6 +48,7 @@ http://hackage.haskell.org/package/bloodhound
48-- the multi-line examples into your ghci REPL.
48-- the multi-line examples into your ghci REPL.
49
49
50:set -XDeriveGeneric
50:set -XDeriveGeneric
51+:{
51import Database.Bloodhound
52import Database.Bloodhound
52import Data.Aeson
53import Data.Aeson
53import Data.Either (Either(..))
54import Data.Either (Either(..))
@@ -71,6 +72,7 @@ let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
71
72
72-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response
73-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response
73response <- createIndex testServer defaultIndexSettings testIndex
74response <- createIndex testServer defaultIndexSettings testIndex
75+:}
74
76
75#+END_SRC
77#+END_SRC
76
78
@@ -284,7 +286,7 @@ Right (Tweet {user = "bitemyapp"
284
286
285*** Bulk create, index
287*** Bulk create, index
286
288
287−#+BEGIN_SRC haskell
289+#+BEGIN_SRC haskell
288
290
289-- don't forget the imports and derive generic setting for ghci
291-- don't forget the imports and derive generic setting for ghci
290-- at the beginning of the examples.
292-- at the beginning of the examples.
@@ -321,6 +323,40 @@ resp <- bulk testServer stream
321
323
322#+END_SRC
324#+END_SRC
323
325
326+*** Encoding individual bulk API operations
327+
328+#+BEGIN_SRC haskell
329+-- the following functions are exported in Bloodhound so
330+-- you can build up bulk operations yourself
331+encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
332+encodeBulkOperation :: BulkOperation -> L.ByteString
333+
334+-- How to use the above:
335+data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
336+instance FromJSON BulkTest
337+instance ToJSON BulkTest
338+
339+_ <- insertData
340+let firstTest = BulkTest "blah"
341+let secondTest = BulkTest "bloo"
342+let firstDoc = BulkIndex testIndex
343+ testMapping (DocId "2") (toJSON firstTest)
344+let secondDoc = BulkCreate testIndex
345+ testMapping (DocId "3") (toJSON secondTest)
346+let stream = V.fromList [firstDoc, secondDoc] :: V.Vector BulkOperation
347+
348+-- to encode yourself
349+let firstDocEncoded = encode firstDoc :: L.ByteString
350+
351+-- to encode a vector of bulk operations
352+let encodedOperations = encodeBulkOperations stream
353+
354+-- to insert into a particular server
355+-- bulk :: Server -> V.Vector BulkOperation -> IO Reply
356+_ <- bulk testServer stream
357+
358+#+END_SRC
359+
324** Search
360** Search
325
361
326*** Querying
362*** Querying
@@ -643,6 +679,163 @@ let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
643
679
644#+END_SRC
680#+END_SRC
645
681
682+*** Aggregations
683+**** Adding aggregations to search
684+Aggregations can now be added to search queries, or made on their own.
685+#+BEGIN_SRC haskell
686+type Aggregations = M.Map Text Aggregation
687+data Aggregation
688+ = TermsAgg TermsAggregation
689+ | DateHistogramAgg DateHistogramAggregation
690+#+END_SRC
691+
692+For convenience, ```mkAggregations``` exists, that will create an
693+```Aggregations``` with the aggregation provided.
694+
695+For example:
696+#+BEGIN_SRC haskell
697+ let a = mkAggregations "users" $ TermsAgg $ mkTermsAggregation "user"
698+ let search = mkAggregateSearch Nothing a
699+#+END_SRC
700+
701+Aggregations can be added to an existing search, using the
702+```aggBody``` field
703+
704+#+BEGIN_SRC haskell
705+ let search = mkSearch (Just (MatchAllQuery Nothing)) Nothing
706+ let search' = search {aggBody = Just a}
707+#+END_SRC
708+
709+Since the ```Aggregations``` structure is just a Map Text
710+Aggregation, M.insert can be used to add additional aggregations.
711+
712+#+BEGIN_SRC haskell
713+ let a' = M.insert "age" (TermsAgg $ mkTermsAggregation "age") a
714+#+END_SRC
715+
716+**** Extracting aggregations from results
717+Aggregations are part of the reply structure of every search, in the
718+form of ~Maybe AggregationResults~
719+
720+#+BEGIN_SRC haskell
721+-- Lift decode and response body to be in the IO monad.
722+let decode' = liftM decode
723+let responseBody' = liftM responseBody
724+let reply = searchByIndex testServer testIndex search
725+let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))
726+
727+-- Now that we have our response, we can extract our terms aggregation result -- which is a list of buckets.
728+
729+let terms = do { response' <- response; return $ response' >>= aggregations >>= toTerms "users" }
730+terms
731+Just (Bucket {buckets = [TermsResult {termKey = "bitemyapp", termsDocCount = 1, termsAggs = Nothing}]})
732+#+END_SRC
733+
734+Note that bucket aggregation results, such as the TermsResult is a
735+member of the type class ~BucketAggregation~:
736+
737+#+BEGIN_SRC haskell
738+class BucketAggregation a where
739+ key :: a -> Text
740+ docCount :: a -> Int
741+ aggs :: a -> Maybe AggregationResults
742+#+END_SRC haskell
743+
744+You can use the ~aggs~ function to get any nested results, if
745+there were any. For example, if there were a nested terms
746+aggregation keyed to "age" in a TermsResult named ~termresult~, you would call ~aggs termresult >>=
747+toTerms "age"~
748+
749+**** Terms Aggregation
750+#+BEGIN_SRC haskell
751+data TermsAggregation
752+ = TermsAggregation {term :: Either Text Text,
753+ termInclude :: Maybe TermInclusion,
754+ termExclude :: Maybe TermInclusion,
755+ termOrder :: Maybe TermOrder,
756+ termMinDocCount :: Maybe Int,
757+ termSize :: Maybe Int,
758+ termShardSize :: Maybe Int,
759+ termCollectMode :: Maybe CollectionMode,
760+ termExecutionHint :: Maybe ExecutionHint,
761+ termAggs :: Maybe Aggregations}
762+#+END_SRC
763+
764+Term Aggregations have two factory functions,
765+~mkTermsAggregation~, and ~mkTermsScriptAggregation~, and can
766+be used as follows:
767+
768+#+BEGIN_SRC haskell
769+let ta = TermsAgg $ mkTermsAggregation "user"
770+#+END_SRC
771+
772+There are of course other options that can be added to a Terms
773+Aggregation, such as the collection mode:
774+#+BEGIN_SRC haskell
775+let ta = mkTermsAggregation "user"
776+let ta' = ta { termCollectMode = Just BreadthFirst }
777+let ta'' = TermsAgg ta'
778+#+END_SRC
779+
780+For more documentation on how the Terms Aggregation works, see
781+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-terms-aggregation.html
782+
783+**** Date Histogram Aggregation
784+
785+#+BEGIN_SRC haskell
786+data DateHistogramAggregation
787+ = DateHistogramAggregation {dateField :: FieldName,
788+ dateInterval :: Interval,
789+ dateFormat :: Maybe Text,
790+ datePreZone :: Maybe Text,
791+ datePostZone :: Maybe Text,
792+ datePreOffset :: Maybe Text,
793+ datePostOffset :: Maybe Text,
794+ dateAggs :: Maybe Aggregations}
795+#+END_SRC haskell
796+
797+The Date Histogram Aggregation works much the same as the Terms
798+Aggregation.
799+
800+Relevant functions include ~mkDateHistogram~, and ~toDateHistogram~
801+
802+#+BEGIN_SRC haskell
803+let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") Minute)
804+#+END_SRC
805+
806+Date histograms also accept a ~FractionalInterval~:
807+
808+#+BEGIN_SRC haskell
809+FractionalInterval :: Float -> TimeInterval -> Interval
810+-- TimeInterval is the following:
811+data TimeInterval = Weeks | Days | Hours | Minutes | Seconds
812+#+END_SRC
813+
814+It can be used as follows:
815+
816+#+BEGIN_SRC haskell
817+let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") (FractionalInterval 1.5 Minutes))
818+#+END_SRC
819+
820+The ~DateHistogramResult~ is defined as:
821+
822+#+BEGIN_SRC haskell
823+data DateHistogramResult
824+ = DateHistogramResult {dateKey :: Int,
825+ dateKeyStr :: Maybe Text,
826+ dateDocCount :: Int,
827+ dateHistogramAggs :: Maybe AggregationResults}
828+#+END_SRC
829+
830+It is an instance of ~BucketAggregation~, and can have nested
831+aggregations in each bucket.
832+
833+Buckets can be extracted from a ~AggregationResult~ using
834+~toDateHistogram name~
835+
836+For more information on the Date Histogram Aggregation, see:
837+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html
838+
646* Possible future functionality
839* Possible future functionality
647
840
648** Span Queries
841** Span Queries
bloodhound.cabal+3−1
@@ -3,7 +3,7 @@ version: 0.4.0.0
3synopsis: ElasticSearch client library for Haskell
3synopsis: ElasticSearch client library for Haskell
4description: ElasticSearch made awesome for Haskell hackers
4description: ElasticSearch made awesome for Haskell hackers
5homepage: https://github.com/bitemyapp/bloodhound
5homepage: https://github.com/bitemyapp/bloodhound
6−license: MIT
6+license: BSD3
7license-file: LICENSE
7license-file: LICENSE
8author: Chris Allen
8author: Chris Allen
9maintainer: cma@bitemyapp.com
9maintainer: cma@bitemyapp.com
@@ -25,6 +25,7 @@ library
25 Database.Bloodhound.Types.Class
25 Database.Bloodhound.Types.Class
26 build-depends: base >= 4.3 && <5,
26 build-depends: base >= 4.3 && <5,
27 bytestring >= 0.10.2,
27 bytestring >= 0.10.2,
28+ containers >= 0.5.0.0,
28 aeson >= 0.7,
29 aeson >= 0.7,
29 conduit >= 1.0,
30 conduit >= 1.0,
30 http-client >= 0.3,
31 http-client >= 0.3,
@@ -45,6 +46,7 @@ test-suite tests
45 bloodhound,
46 bloodhound,
46 http-client,
47 http-client,
47 http-types,
48 http-types,
49+ containers >= 0.5.0.0,
48 hspec >= 1.8,
50 hspec >= 1.8,
49 text >= 0.11,
51 text >= 0.11,
50 time >= 1.4,
52 time >= 1.4,
changelog.md+5−2
@@ -1,6 +1,9 @@
10.4.0.0
10.4.0.0
2===================
2===================
3
3
4+* Term and date aggregation - thanks to Christopher Guiney! (@chrisguiney)
5+
6+Following three thanks to Liam Atkins (@latkins)
4* omitNulls changed to exclude empty lists and null values
7* omitNulls changed to exclude empty lists and null values
5
8
6* BoolQuery must/mustNot/Should changed from Maybe (Query|[Query]) to [Query]
9* BoolQuery must/mustNot/Should changed from Maybe (Query|[Query]) to [Query]
@@ -12,7 +15,7 @@
12
15
13* Status "ok" changed from Bool to Maybe Bool
16* Status "ok" changed from Bool to Maybe Bool
14
17
15−* Elasticsearch 1.3.x compatibility fixed with changes to geo bounding boxes
18+* Elasticsearch 1.3.x compatibility fixed with changes to geo bounding boxes - thanks to Curtis Carter! (@ccarter)
16
19
17* CI coverage expanded to 1.0.x -> 1.3.x
20* CI coverage expanded to 1.0.x -> 1.3.x
18
21
@@ -36,4 +39,4 @@
36
39
37* Fixed and rebuilt documentation
40* Fixed and rebuilt documentation
38
41
39−* RegexpFlags changed to a sum type instead of Text, thanks @MichaelXavier!
42+* RegexpFlags changed to a sum type instead of Text, thanks to @MichaelXavier!
tests/tests.hs+122−3
@@ -4,10 +4,12 @@
4module Main where
4module Main where
5
5
6import Control.Applicative
6import Control.Applicative
7+import Control.Monad
7import Data.Aeson
8import Data.Aeson
8import Data.HashMap.Strict (fromList)
9import Data.HashMap.Strict (fromList)
9import Data.List (nub)
10import Data.List (nub)
10import Data.List.NonEmpty (NonEmpty (..))
11import Data.List.NonEmpty (NonEmpty (..))
12+import qualified Data.Map.Strict as M
11import Data.Text (Text)
13import Data.Text (Text)
12import qualified Data.Text as T
14import qualified Data.Text as T
13import Data.Time.Calendar (Day (..))
15import Data.Time.Calendar (Day (..))
@@ -39,6 +41,57 @@ createExampleIndex = createIndex testServer defaultIndexSettings testIndex
39deleteExampleIndex :: IO Reply
41deleteExampleIndex :: IO Reply
40deleteExampleIndex = deleteIndex testServer testIndex
42deleteExampleIndex = deleteIndex testServer testIndex
41
43
44+data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
45+
46+es14 :: ServerVersion
47+es14 = ServerVersion 1 4 0
48+
49+es13 :: ServerVersion
50+es13 = ServerVersion 1 3 0
51+
52+es12 :: ServerVersion
53+es12 = ServerVersion 1 2 0
54+
55+es11 :: ServerVersion
56+es11 = ServerVersion 1 1 0
57+
58+es10 :: ServerVersion
59+es10 = ServerVersion 1 0 0
60+
61+serverBranch :: ServerVersion -> ServerVersion
62+serverBranch (ServerVersion majorVer minorVer patchVer) =
63+ ServerVersion majorVer minorVer patchVer
64+
65+mkServerVersion :: [Int] -> Maybe ServerVersion
66+mkServerVersion [majorVer, minorVer, patchVer] =
67+ Just (ServerVersion majorVer minorVer patchVer)
68+mkServerVersion _ = Nothing
69+
70+getServerVersion :: Server -> IO (Maybe ServerVersion)
71+getServerVersion s = liftM extractVersion (getStatus s)
72+ where
73+ version' = T.splitOn "." . number . version
74+ toInt = read . T.unpack
75+ parseVersion v = map toInt (version' v)
76+ extractVersion = join . liftM (mkServerVersion . parseVersion)
77+
78+
79+
80+testServerBranch :: IO (Maybe ServerVersion)
81+testServerBranch = getServerVersion testServer >>= \v -> return $ liftM serverBranch v
82+
83+atleast :: ServerVersion -> IO Bool
84+atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
85+
86+atmost :: ServerVersion -> IO Bool
87+atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
88+
89+is :: ServerVersion -> IO Bool
90+is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
91+
92+when' :: Monad m => m Bool -> m () -> m ()
93+when' b f = b >>= \x -> when x f
94+
42data Location = Location { lat :: Double
95data Location = Location { lat :: Double
43 , lon :: Double } deriving (Eq, Generic, Show)
96 , lon :: Double } deriving (Eq, Generic, Show)
44
97
@@ -109,6 +162,28 @@ searchExpectNoResults search = do
109 let emptyHits = fmap (hits . searchHits) result
162 let emptyHits = fmap (hits . searchHits) result
110 emptyHits `shouldBe` Right []
163 emptyHits `shouldBe` Right []
111
164
165+searchExpectAggs :: Search -> IO ()
166+searchExpectAggs search = do
167+ reply <- searchAll testServer search
168+ let isEmpty x = return (M.null x)
169+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
170+ (result >>= aggregations >>= isEmpty) `shouldBe` Just False
171+
172+searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()
173+searchValidBucketAgg search aggKey extractor = do
174+ reply <- searchAll testServer search
175+ let bucketDocs = docCount . head . buckets
176+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
177+ let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
178+ count `shouldBe` Just 1
179+
180+searchTermsAggHint :: [ExecutionHint] -> IO ()
181+searchTermsAggHint hints = do
182+ let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
183+ let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
184+ forM_ hints $ searchExpectAggs . search
185+ forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
186+
112data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
187data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
113instance FromJSON BulkTest
188instance FromJSON BulkTest
114instance ToJSON BulkTest
189instance ToJSON BulkTest
@@ -165,7 +240,7 @@ main = hspec $ do
165 testMapping (DocId "2") (toJSON firstTest)
240 testMapping (DocId "2") (toJSON firstTest)
166 let secondDoc = BulkCreate testIndex
241 let secondDoc = BulkCreate testIndex
167 testMapping (DocId "3") (toJSON secondTest)
242 testMapping (DocId "3") (toJSON secondTest)
168− let stream = [firstDoc, secondDoc]
243+ let stream = V.fromList [firstDoc, secondDoc]
169 _ <- bulk testServer stream
244 _ <- bulk testServer stream
170 _ <- refreshIndex testServer testIndex
245 _ <- refreshIndex testServer testIndex
171 fDoc <- getDocument testServer testIndex testMapping (DocId "2")
246 fDoc <- getDocument testServer testIndex testMapping (DocId "2")
@@ -237,7 +312,7 @@ main = hspec $ do
237 _ <- insertOther
312 _ <- insertOther
238 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
313 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
239 let search = Search Nothing
314 let search = Search Nothing
240− (Just IdentityFilter) (Just [sortSpec])
315+ (Just IdentityFilter) (Just [sortSpec]) Nothing
241 False 0 10
316 False 0 10
242 reply <- searchByIndex testServer testIndex search
317 reply <- searchByIndex testServer testIndex search
243 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
318 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
@@ -364,6 +439,51 @@ main = hspec $ do
364 let search = mkSearch Nothing (Just filter)
439 let search = mkSearch Nothing (Just filter)
365 searchExpectNoResults search
440 searchExpectNoResults search
366
441
442+ describe "Aggregation API" $ do
443+ it "returns term aggregation results" $ do
444+ _ <- insertData
445+ let terms = TermsAgg $ mkTermsAggregation "user"
446+ let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
447+ searchExpectAggs search
448+ searchValidBucketAgg search "users" toTerms
449+
450+ it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ do
451+ _ <- insertData
452+ let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
453+ let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
454+ searchExpectAggs search
455+ searchValidBucketAgg search "users" toTerms
456+
457+ it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ do
458+ _ <- insertData
459+ searchTermsAggHint [Map, Ordinals]
460+
461+ it "can give execution hint paramters to term aggregations" $ when' (is es12) $ do
462+ _ <- insertData
463+ searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
464+
465+ it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ do
466+ _ <- insertData
467+ searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
468+
469+ it "returns date histogram aggregation results" $ do
470+ _ <- insertData
471+ let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
472+ let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
473+ searchExpectAggs search
474+ searchValidBucketAgg search "byDate" toDateHistogram
475+
476+ it "returns date histogram using fractional date" $ do
477+ _ <- insertData
478+ let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
479+ let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
480+ let intervals = periods ++ fractionals
481+ let histogram = mkDateHistogram (FieldName "postDate")
482+ let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
483+ let expect interval = searchExpectAggs (search interval)
484+ let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
485+ forM_ intervals expect
486+ forM_ intervals valid
367
487
368 describe "ToJSON RegexpFlags" $ do
488 describe "ToJSON RegexpFlags" $ do
369 it "generates the correct JSON for AllRegexpFlags" $
489 it "generates the correct JSON for AllRegexpFlags" $
@@ -385,7 +505,6 @@ main = hspec $ do
385 flagStrs = T.splitOn "|" str
505 flagStrs = T.splitOn "|" str
386 in noDuplicates flagStrs
506 in noDuplicates flagStrs
387
507
388−
389 describe "omitNulls" $ do
508 describe "omitNulls" $ do
390 it "checks that omitNulls drops list elements when it should" $
509 it "checks that omitNulls drops list elements when it should" $
391 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
510 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))