git.iko.soy/typeable/bloodhound
on master help sign in
Add terms and date histogram aggregations
4fe4bfeChristopher Guiney
Database/Bloodhound/Client.hs+1−1
compare with master
unifiedsplit
@@ -244,7 +244,7 @@ searchByType (Server server) (IndexName indexName)
244 url = joinPath [server, indexName, mappingName, "_search"]
244 url = joinPath [server, indexName, mappingName, "_search"]
245
245
246mkSearch :: Maybe Query -> Maybe Filter -> Search
246mkSearch :: Maybe Query -> Maybe Filter -> Search
247−mkSearch query filter = Search query filter Nothing False 0 10
247+mkSearch query filter = Search query filter Nothing Nothing False 0 10
248
248
249pageSearch :: Int -> Int -> Search -> Search
249pageSearch :: Int -> Int -> Search -> Search
250pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize }
250pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize }
Database/Bloodhound/Types.hs+213−9
@@ -22,6 +22,10 @@ module Database.Bloodhound.Types
22 , mkBoolQuery
22 , mkBoolQuery
23 , mkRangeQuery
23 , mkRangeQuery
24 , mkQueryStringQuery
24 , mkQueryStringQuery
25+ , mkTermsAggregation
26+ , mkDateHistogram
27+ , toTerms
28+ , toDateHistogram
25 , Version(..)
29 , Version(..)
26 , Status(..)
30 , Status(..)
27 , Existence(..)
31 , Existence(..)
@@ -142,15 +146,29 @@ module Database.Bloodhound.Types
142 , FieldOrFields(..)
146 , FieldOrFields(..)
143 , Monoid(..)
147 , Monoid(..)
144 , ToJSON(..)
148 , ToJSON(..)
149+ , Interval(..)
150+ , TimeInterval(..)
151+ , ExecutionHint
152+ , CollectionMode
153+ , TermOrder
154+ , TermInclusion
155+ , Aggregations
156+ , AggregationResults
157+ , Bucket(..)
158+ , BucketAggregation(..)
159+ , TermsResult
160+ , DateHistogramResult
145 ) where
161 ) where
146
162
147import Control.Applicative
163import Control.Applicative
148import Data.Aeson
164import Data.Aeson
165+import Data.Aeson.Types (parseMaybe)
149import qualified Data.ByteString.Lazy.Char8 as L
166import qualified Data.ByteString.Lazy.Char8 as L
150import Data.List (nub)
167import Data.List (nub)
151import Data.List.NonEmpty (NonEmpty(..))
168import Data.List.NonEmpty (NonEmpty(..))
152import Data.Monoid
169import Data.Monoid
153import Data.Text (Text)
170import Data.Text (Text)
171+import qualified Data.Map.Strict as M
154import qualified Data.Text as T
172import qualified Data.Text as T
155import Data.Time.Clock (UTCTime)
173import Data.Time.Clock (UTCTime)
156import GHC.Generics (Generic)
174import GHC.Generics (Generic)
@@ -474,6 +492,7 @@ type Size = Int
474data Search = Search { queryBody :: Maybe Query
492data Search = Search { queryBody :: Maybe Query
475 , filterBody :: Maybe Filter
493 , filterBody :: Maybe Filter
476 , sortBody :: Maybe Sort
494 , sortBody :: Maybe Sort
495+ , aggBody :: Maybe Aggregations
477 -- default False
496 -- default False
478 , trackSortScores :: TrackSortScores
497 , trackSortScores :: TrackSortScores
479 , from :: From
498 , from :: From
@@ -913,10 +932,11 @@ data DistanceRange =
913 , distanceTo :: Distance } deriving (Eq, Show)
932 , distanceTo :: Distance } deriving (Eq, Show)
914
933
915data FromJSON a => SearchResult a =
934data FromJSON a => SearchResult a =
916− SearchResult { took :: Int
935+ SearchResult { took :: Int
917− , timedOut :: Bool
936+ , timedOut :: Bool
918− , shards :: ShardResult
937+ , shards :: ShardResult
919− , searchHits :: SearchHits a } deriving (Eq, Show)
938+ , searchHits :: SearchHits a
939+ , aggregations :: Maybe AggregationResults } deriving (Eq, Show)
920
940
921type Score = Double
941type Score = Double
922
942
@@ -940,6 +960,188 @@ data ShardResult =
940showText :: Show a => a -> Text
960showText :: Show a => a -> Text
941showText = T.pack . show
961showText = T.pack . show
942
962
963+type Aggregations = M.Map Text Aggregation
964+
965+data TermOrder = TermOrder{ termSortField :: Text
966+ , termSortOrder :: SortOrder } deriving (Eq, Show)
967+
968+data TermInclusion = TermInclusion Text
969+ | TermPattern { pattern :: Text
970+ , flags :: Text } deriving (Eq, Show)
971+
972+data CollectionMode = BreadthFirst
973+ | DepthFirst deriving (Eq, Show)
974+
975+data ExecutionHint = GlobalOrdinals
976+ | GlobalOrdinalsHash
977+ | GlobalOrdinalsLowCardinality
978+ | Map deriving(Eq, Show)
979+
980+data TimeInterval = Years
981+ | Quarters
982+ | Months
983+ | Weeks
984+ | Days
985+ | Hours
986+ | Minutes
987+ | Seconds deriving (Eq)
988+
989+data Interval = Year
990+ | Quarter
991+ | Month
992+ | Week
993+ | Day
994+ | Hour
995+ | Minute
996+ | Second
997+ | FractionalInterval { fraction :: Float
998+ , interval :: TimeInterval } deriving (Eq, Show)
999+
1000+data Aggregation = TermsAggregation { term :: Text
1001+ , termScript :: Maybe Text
1002+ , termInclude :: Maybe TermInclusion
1003+ , termExclude :: Maybe TermInclusion
1004+ , termOrder :: Maybe TermOrder
1005+ , termMinDocCount :: Maybe Int
1006+ , termSize :: Maybe Int
1007+ , termShardSize :: Maybe Int
1008+ , termCollectMode :: Maybe CollectionMode
1009+ , termAggs :: Maybe Aggregations
1010+ }
1011+ | DateHistogramAggregation { dateField :: FieldName
1012+ , dateInterval :: Interval
1013+ , dateFormat :: Maybe Text
1014+ , datePreZone :: Maybe Text
1015+ , datePostZone :: Maybe Text
1016+ , datePreOffset :: Maybe Text
1017+ , datePostOffset :: Maybe Text
1018+ , dateAggs :: Maybe Aggregations
1019+ } deriving (Eq, Show)
1020+
1021+mkTermsAggregation :: Text -> Aggregation
1022+mkTermsAggregation t = TermsAggregation t Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1023+
1024+mkDateHistogram :: FieldName -> Interval -> Aggregation
1025+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1026+
1027+instance ToJSON TermOrder where
1028+ toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1029+
1030+instance ToJSON TermInclusion where
1031+ toJSON (TermInclusion x) = toJSON x
1032+ toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1033+ "flags" .= flags]
1034+
1035+instance ToJSON CollectionMode where
1036+ toJSON BreadthFirst = "breadth_first"
1037+ toJSON DepthFirst = "depth_first"
1038+
1039+instance ToJSON ExecutionHint where
1040+ toJSON GlobalOrdinals = "global_ordinals"
1041+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1042+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1043+ toJSON Map = "map"
1044+
1045+instance ToJSON Interval where
1046+ toJSON Year = "year"
1047+ toJSON Quarter = "quarter"
1048+ toJSON Month = "month"
1049+ toJSON Week = "week"
1050+ toJSON Day = "day"
1051+ toJSON Hour = "hour"
1052+ toJSON Minute = "minute"
1053+ toJSON Second = "second"
1054+ toJSON (FractionalInterval fraction interval) = toJSON $ (show fraction) ++ (show interval)
1055+
1056+instance Show TimeInterval where
1057+ show Years = "y"
1058+ show Quarters = "q"
1059+ show Months = "M"
1060+ show Weeks = "w"
1061+ show Days = "d"
1062+ show Hours = "h"
1063+ show Minutes = "m"
1064+ show Seconds = "s"
1065+
1066+instance ToJSON Aggregation where
1067+ toJSON (TermsAggregation term termScript termInclude termExclude termOrder termMinDocCount termSize termShardSize termCollectMode termAggs) =
1068+ omitNulls ["terms" .= (omitNulls [ "field" .= (toJSON $ term) ,
1069+ "script" .= (toJSON termScript),
1070+ "include" .= (toJSON termInclude),
1071+ "exclude" .= (toJSON termExclude),
1072+ "order" .= (toJSON termOrder),
1073+ "min_doc_count" .= (toJSON termMinDocCount),
1074+ "size" .= (toJSON termSize),
1075+ "shard_size" .= (toJSON termShardSize),
1076+ "collect_mode" .= (toJSON termCollectMode)
1077+ ]),
1078+ "aggs" .= (toJSON termAggs) ]
1079+
1080+ toJSON (DateHistogramAggregation dateField dateInterval dateFormat datePreZone datePostZone datePreOffset datePostOffset dateAggs) =
1081+ omitNulls ["date_histogram" .= (omitNulls [ "field" .= (toJSON dateField),
1082+ "interval" .= (toJSON dateInterval),
1083+ "format" .= (toJSON dateFormat),
1084+ "pre_zone" .= (toJSON datePreZone),
1085+ "post_zone" .= (toJSON datePostZone),
1086+ "pre_offset" .= (toJSON datePreOffset),
1087+ "post_offset" .= (toJSON datePostOffset)
1088+ ]),
1089+ "aggs" .= (toJSON dateAggs) ]
1090+
1091+type AggregationResults = M.Map Text Value
1092+
1093+class BucketAggregation a where
1094+ key :: a -> Text
1095+ docCount :: a -> Int
1096+ aggs :: a -> Maybe AggregationResults
1097+
1098+
1099+data (FromJSON a, BucketAggregation a) => Bucket a = Bucket { buckets :: [a]} deriving (Show)
1100+
1101+data TermsResult = TermsResult { termKey :: Text
1102+ , termsDocCount :: Int
1103+ , termsAggs :: Maybe AggregationResults } deriving (Show)
1104+
1105+data DateHistogramResult = DateHistogramResult { dateKey :: Int
1106+ , dateKeyStr :: Text
1107+ , dateDocCount :: Int
1108+ , dateHistogramAggs :: Maybe AggregationResults } deriving (Show)
1109+
1110+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1111+toTerms t a = M.lookup t a >>= deserialize
1112+ where deserialize = parseMaybe parseJSON
1113+
1114+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
1115+toDateHistogram t a = M.lookup t a >>= deserialize
1116+ where deserialize = parseMaybe parseJSON
1117+
1118+instance BucketAggregation TermsResult where
1119+ key = termKey
1120+ docCount = termsDocCount
1121+ aggs = termsAggs
1122+
1123+instance BucketAggregation DateHistogramResult where
1124+ key = dateKeyStr
1125+ docCount = dateDocCount
1126+ aggs = dateHistogramAggs
1127+
1128+instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
1129+ parseJSON (Object v) = Bucket <$>
1130+ v .: "buckets"
1131+ parseJSON _ = mempty
1132+
1133+instance FromJSON TermsResult where
1134+ parseJSON (Object v) = TermsResult <$>
1135+ v .: "key" <*>
1136+ v .: "doc_count" <*>
1137+ v .:? "aggregations"
1138+
1139+instance FromJSON DateHistogramResult where
1140+ parseJSON (Object v) = DateHistogramResult <$>
1141+ v .: "key" <*>
1142+ v .: "key_as_string" <*>
1143+ v .: "doc_count" <*>
1144+ v .:? "aggregations"
943
1145
944instance Monoid Filter where
1146instance Monoid Filter where
945 mempty = IdentityFilter
1147 mempty = IdentityFilter
@@ -1533,10 +1735,11 @@ instance (FromJSON a) => FromJSON (EsResult a) where
1533
1735
1534
1736
1535instance ToJSON Search where
1737instance ToJSON Search where
1536− toJSON (Search query sFilter sort sTrackSortScores sFrom sSize) =
1738+ toJSON (Search query sFilter sort aggs sTrackSortScores sFrom sSize) =
1537 omitNulls [ "query" .= query
1739 omitNulls [ "query" .= query
1538 , "filter" .= sFilter
1740 , "filter" .= sFilter
1539 , "sort" .= sort
1741 , "sort" .= sort
1742+ , "aggregations" .= aggs
1540 , "from" .= sFrom
1743 , "from" .= sFrom
1541 , "size" .= sSize
1744 , "size" .= sSize
1542 , "track_scores" .= sTrackSortScores ]
1745 , "track_scores" .= sTrackSortScores ]
@@ -1674,10 +1877,11 @@ instance ToJSON BoolMatch where
1674
1877
1675instance (FromJSON a) => FromJSON (SearchResult a) where
1878instance (FromJSON a) => FromJSON (SearchResult a) where
1676 parseJSON (Object v) = SearchResult <$>
1879 parseJSON (Object v) = SearchResult <$>
1677− v .: "took" <*>
1880+ v .: "took" <*>
1678− v .: "timed_out" <*>
1881+ v .: "timed_out" <*>
1679− v .: "_shards" <*>
1882+ v .: "_shards" <*>
1680− v .: "hits"
1883+ v .: "hits" <*>
1884+ v .:? "aggregations"
1681 parseJSON _ = empty
1885 parseJSON _ = empty
1682
1886
1683instance (FromJSON a) => FromJSON (SearchHits a) where
1887instance (FromJSON a) => FromJSON (SearchHits a) where
bloodhound.cabal+2
@@ -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,
@@ -44,6 +45,7 @@ test-suite tests
44 bloodhound,
45 bloodhound,
45 http-client,
46 http-client,
46 http-types,
47 http-types,
48+ containers >= 0.5.0.0,
47 hspec >= 1.8,
49 hspec >= 1.8,
48 text >= 0.11,
50 text >= 0.11,
49 time >= 1.4,
51 time >= 1.4,
tests/tests.hs+36−2
@@ -6,7 +6,8 @@ module Main where
6import Control.Applicative
6import Control.Applicative
7import Database.Bloodhound
7import Database.Bloodhound
8import Data.Aeson
8import Data.Aeson
9−import Data.List (nub)
9+import Data.Aeson.Types (parseMaybe)
10+import Data.List (nub, elemIndex)
10import Data.List.NonEmpty (NonEmpty(..))
11import Data.List.NonEmpty (NonEmpty(..))
11import Data.Time.Calendar (Day(..))
12import Data.Time.Calendar (Day(..))
12import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
13import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
@@ -19,6 +20,7 @@ import Prelude hiding (filter, putStrLn)
19import Test.Hspec
20import Test.Hspec
20import Test.Hspec.QuickCheck (prop)
21import Test.Hspec.QuickCheck (prop)
21import Test.QuickCheck
22import Test.QuickCheck
23+import qualified Data.Map.Strict as M
22
24
23testServer :: Server
25testServer :: Server
24testServer = Server "http://localhost:9200"
26testServer = Server "http://localhost:9200"
@@ -107,6 +109,21 @@ searchExpectNoResults search = do
107 let emptyHits = fmap (hits . searchHits) result
109 let emptyHits = fmap (hits . searchHits) result
108 emptyHits `shouldBe` Right []
110 emptyHits `shouldBe` Right []
109
111
112+searchExpectAggs :: Search -> IO ()
113+searchExpectAggs search = do
114+ reply <- searchAll testServer search
115+ let isEmpty x = return (M.null x)
116+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
117+ (result >>= aggregations >>= isEmpty) `shouldBe` Just False
118+
119+searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()
120+searchValidBucketAgg search aggKey extractor = do
121+ reply <- searchAll testServer search
122+ let bucketDocs = docCount . head . buckets
123+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
124+ let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
125+ count `shouldBe` Just 1
126+
110data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
127data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
111instance FromJSON BulkTest
128instance FromJSON BulkTest
112instance ToJSON BulkTest
129instance ToJSON BulkTest
@@ -235,7 +252,7 @@ main = hspec $ do
235 _ <- insertOther
252 _ <- insertOther
236 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
253 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
237 let search = Search Nothing
254 let search = Search Nothing
238− (Just IdentityFilter) (Just [sortSpec])
255+ (Just IdentityFilter) (Just [sortSpec]) Nothing
239 False 0 10
256 False 0 10
240 reply <- searchByIndex testServer testIndex search
257 reply <- searchByIndex testServer testIndex search
241 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
258 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
@@ -362,6 +379,21 @@ main = hspec $ do
362 let search = mkSearch Nothing (Just filter)
379 let search = mkSearch Nothing (Just filter)
363 searchExpectNoResults search
380 searchExpectNoResults search
364
381
382+ describe "Aggregation API" $ do
383+ it "returns term aggregation results" $ do
384+ _ <- insertData
385+ let aggs = M.insert "users" (mkTermsAggregation "user") M.empty
386+ let search = (mkSearch Nothing Nothing) {aggBody = Just(aggs)}
387+ searchExpectAggs search
388+ searchValidBucketAgg search "users" toTerms
389+
390+ it "returns date histogram aggregation results" $ do
391+ _ <- insertData
392+ let aggs = M.insert "byDate" (mkDateHistogram (FieldName "postDate") Minute) M.empty
393+ let search = (mkSearch Nothing Nothing) {aggBody = Just(aggs)}
394+ searchExpectAggs search
395+ searchValidBucketAgg search "byDate" toDateHistogram
396+
365
397
366 describe "ToJSON RegexpFlags" $ do
398 describe "ToJSON RegexpFlags" $ do
367 it "generates the correct JSON for AllRegexpFlags" $
399 it "generates the correct JSON for AllRegexpFlags" $
@@ -382,3 +414,5 @@ main = hspec $ do
382 let String str = toJSON flags
414 let String str = toJSON flags
383 flagStrs = T.splitOn "|" str
415 flagStrs = T.splitOn "|" str
384 in noDuplicates flagStrs
416 in noDuplicates flagStrs
417+
418+