@@ -51,6 +51,7 @@ module Database.V1.Bloodhound.Types
5151 , toMissing
5252 , toTerms
5353 , toDateHistogram
54+ , toTopHits
5455 , omitNulls
5556 , BH(..)
5657 , runBH
@@ -340,6 +341,7 @@ module Database.V1.Bloodhound.Types
340341 , DateMathAnchor(..)
341342 , DateMathModifier(..)
342343 , DateMathUnit(..)
344+ , TopHitsAggregation(..)
343345
344346 , Highlights(..)
345347 , FieldHighlight(..)
@@ -357,6 +359,7 @@ module Database.V1.Bloodhound.Types
357359 , TermsResult(..)
358360 , DateHistogramResult(..)
359361 , DateRangeResult(..)
362+ , TopHitResult(..)
360363
361364 , EsUsername(..)
362365 , EsPassword(..)
@@ -1722,7 +1725,15 @@ data Aggregation = TermsAgg TermsAggregation
17221725 | ValueCountAgg ValueCountAggregation
17231726 | FilterAgg FilterAggregation
17241727 | DateRangeAgg DateRangeAggregation
1725− | MissingAgg MissingAggregation deriving (Eq, Read, Show, Generic, Typeable)
1728+ | MissingAgg MissingAggregation
1729+ | TopHitsAgg TopHitsAggregation
1730+ deriving (Eq, Read, Show, Generic, Typeable)
1731+
1732+data TopHitsAggregation = TopHitsAggregation
1733+ { taFrom :: Maybe From
1734+ , taSize :: Maybe Size
1735+ , taSort :: Maybe Sort
1736+ } deriving (Eq, Read, Show)
17261737
17271738data MissingAggregation = MissingAggregation
17281739 { maField :: Text
@@ -1923,6 +1934,13 @@ instance ToJSON Aggregation where
19231934 toJSON (MissingAgg (MissingAggregation{..})) =
19241935 object ["missing" .= object ["field" .= maField]]
19251936
1937+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1938+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1939+ , "from" .= mfrom
1940+ , "sort" .= msort
1941+ ]
1942+ ]
1943+
19261944instance ToJSON DateRangeAggregation where
19271945 toJSON DateRangeAggregation {..} =
19281946 omitNulls [ "field" .= draField
@@ -1967,6 +1985,9 @@ data BucketValue = TextValue Text
19671985
19681986data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
19691987
1988+data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
1989+ } deriving Show
1990+
19701991data TermsResult = TermsResult { termKey :: BucketValue
19711992 , termsDocCount :: Int
19721993 , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
@@ -1993,6 +2014,9 @@ toDateHistogram = toAggResult
19932014toMissing :: Text -> AggregationResults -> Maybe MissingResult
19942015toMissing = toAggResult
19952016
2017+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2018+toTopHits = toAggResult
2019+
19962020toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
19972021toAggResult t a = M.lookup t a >>= deserialize
19982022 where deserialize = parseMaybe parseJSON
@@ -2028,10 +2052,10 @@ instance FromJSON MissingResult where
20282052 where parse v = MissingResult <$> v .: "doc_count"
20292053
20302054instance FromJSON TermsResult where
2031− parseJSON (Object v) = TermsResult <$>
2055+ parseJSON (Object v) = TermsResult <$>
20322056 v .: "key" <*>
20332057 v .: "doc_count" <*>
2034− v .:? "aggregations"
2058+ (pure $ getNamedSubAgg v ["key", "doc_count"])
20352059 parseJSON _ = mempty
20362060
20372061instance FromJSON DateHistogramResult where
@@ -2039,7 +2063,11 @@ instance FromJSON DateHistogramResult where
20392063 v .: "key" <*>
20402064 v .:? "key_as_string" <*>
20412065 v .: "doc_count" <*>
2042− v .:? "aggregations"
2066+ (pure $ getNamedSubAgg v [ "key"
2067+ , "doc_count"
2068+ , "key_as_string"
2069+ ]
2070+ )
20432071 parseJSON _ = mempty
20442072
20452073instance FromJSON DateRangeResult where
@@ -2051,13 +2079,25 @@ instance FromJSON DateRangeResult where
20512079 (fmap posixMS <$> v .:? "to") <*>
20522080 v .:? "to_as_string" <*>
20532081 v .: "doc_count" <*>
2054− v .:? "aggregations"
2082+ (pure $ getNamedSubAgg v [ "key"
2083+ , "from"
2084+ , "from_as_string"
2085+ , "to"
2086+ , "to_as_string"
2087+ , "doc_count"
2088+ ]
2089+ )
20552090
20562091instance FromJSON POSIXMS where
20572092 parseJSON = withScientific "POSIXMS" (return . parse)
20582093 where parse n = let n' = truncate n :: Integer
20592094 in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
20602095
2096+instance (FromJSON a) => FromJSON (TopHitResult a) where
2097+ parseJSON (Object v) = TopHitResult <$>
2098+ v .: "hits"
2099+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2100+
20612101instance Monoid Filter where
20622102 mempty = IdentityFilter
20632103 mappend a b = AndFilter [a, b] defaultCache
@@ -2250,6 +2290,15 @@ fieldTagged f o = case HM.toList o of
22502290 [(k, Object o')] -> f (FieldName k) o'
22512291 _ -> fail "Expected object with 1 field-named key"
22522292
2293+-- Try to get an AggregationResults when we don't know the
2294+-- field name. We filter out the known keys to try to minimize the noise.
2295+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2296+getNamedSubAgg o knownKeys = maggRes
2297+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2298+ maggRes
2299+ | HM.null unknownKeys = Nothing
2300+ | otherwise = Just . M.fromList $ HM.toList unknownKeys
2301+
22532302instance ToJSON GeoPoint where
22542303 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
22552304 object [ geoPointField .= geoPointLatLon ]