mirror of
https://github.com/typeable/bloodhound.git
synced 2024-09-11 08:25:32 +03:00
fix sub-aggs and add top_hits agg
This commit is contained in:
Josh Berman
parent
79d4eda49f
commit
895df29b9f
@ -51,6 +51,7 @@ module Database.V1.Bloodhound.Types
|
||||
, toMissing
|
||||
, toTerms
|
||||
, toDateHistogram
|
||||
, toTopHits
|
||||
, omitNulls
|
||||
, BH(..)
|
||||
, runBH
|
||||
@ -340,6 +341,7 @@ module Database.V1.Bloodhound.Types
|
||||
, DateMathAnchor(..)
|
||||
, DateMathModifier(..)
|
||||
, DateMathUnit(..)
|
||||
, TopHitsAggregation(..)
|
||||
|
||||
, Highlights(..)
|
||||
, FieldHighlight(..)
|
||||
@ -357,6 +359,7 @@ module Database.V1.Bloodhound.Types
|
||||
, TermsResult(..)
|
||||
, DateHistogramResult(..)
|
||||
, DateRangeResult(..)
|
||||
, TopHitResult(..)
|
||||
|
||||
, EsUsername(..)
|
||||
, EsPassword(..)
|
||||
@ -1722,7 +1725,15 @@ data Aggregation = TermsAgg TermsAggregation
|
||||
| ValueCountAgg ValueCountAggregation
|
||||
| FilterAgg FilterAggregation
|
||||
| DateRangeAgg DateRangeAggregation
|
||||
| MissingAgg MissingAggregation deriving (Eq, Read, Show, Generic, Typeable)
|
||||
| MissingAgg MissingAggregation
|
||||
| TopHitsAgg TopHitsAggregation
|
||||
deriving (Eq, Read, Show, Generic, Typeable)
|
||||
|
||||
data TopHitsAggregation = TopHitsAggregation
|
||||
{ taFrom :: Maybe From
|
||||
, taSize :: Maybe Size
|
||||
, taSort :: Maybe Sort
|
||||
} deriving (Eq, Read, Show)
|
||||
|
||||
data MissingAggregation = MissingAggregation
|
||||
{ maField :: Text
|
||||
@ -1923,6 +1934,13 @@ instance ToJSON Aggregation where
|
||||
toJSON (MissingAgg (MissingAggregation{..})) =
|
||||
object ["missing" .= object ["field" .= maField]]
|
||||
|
||||
toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
|
||||
omitNulls ["top_hits" .= omitNulls [ "size" .= msize
|
||||
, "from" .= mfrom
|
||||
, "sort" .= msort
|
||||
]
|
||||
]
|
||||
|
||||
instance ToJSON DateRangeAggregation where
|
||||
toJSON DateRangeAggregation {..} =
|
||||
omitNulls [ "field" .= draField
|
||||
@ -1967,6 +1985,9 @@ data BucketValue = TextValue Text
|
||||
|
||||
data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
|
||||
|
||||
data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
|
||||
} deriving Show
|
||||
|
||||
data TermsResult = TermsResult { termKey :: BucketValue
|
||||
, termsDocCount :: Int
|
||||
, termsAggs :: Maybe AggregationResults } deriving (Read, Show)
|
||||
@ -1993,6 +2014,9 @@ toDateHistogram = toAggResult
|
||||
toMissing :: Text -> AggregationResults -> Maybe MissingResult
|
||||
toMissing = toAggResult
|
||||
|
||||
toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
|
||||
toTopHits = toAggResult
|
||||
|
||||
toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
|
||||
toAggResult t a = M.lookup t a >>= deserialize
|
||||
where deserialize = parseMaybe parseJSON
|
||||
@ -2028,10 +2052,10 @@ instance FromJSON MissingResult where
|
||||
where parse v = MissingResult <$> v .: "doc_count"
|
||||
|
||||
instance FromJSON TermsResult where
|
||||
parseJSON (Object v) = TermsResult <$>
|
||||
parseJSON (Object v) = TermsResult <$>
|
||||
v .: "key" <*>
|
||||
v .: "doc_count" <*>
|
||||
v .:? "aggregations"
|
||||
(pure $ getNamedSubAgg v ["key", "doc_count"])
|
||||
parseJSON _ = mempty
|
||||
|
||||
instance FromJSON DateHistogramResult where
|
||||
@ -2039,7 +2063,11 @@ instance FromJSON DateHistogramResult where
|
||||
v .: "key" <*>
|
||||
v .:? "key_as_string" <*>
|
||||
v .: "doc_count" <*>
|
||||
v .:? "aggregations"
|
||||
(pure $ getNamedSubAgg v [ "key"
|
||||
, "doc_count"
|
||||
, "key_as_string"
|
||||
]
|
||||
)
|
||||
parseJSON _ = mempty
|
||||
|
||||
instance FromJSON DateRangeResult where
|
||||
@ -2051,13 +2079,25 @@ instance FromJSON DateRangeResult where
|
||||
(fmap posixMS <$> v .:? "to") <*>
|
||||
v .:? "to_as_string" <*>
|
||||
v .: "doc_count" <*>
|
||||
v .:? "aggregations"
|
||||
(pure $ getNamedSubAgg v [ "key"
|
||||
, "from"
|
||||
, "from_as_string"
|
||||
, "to"
|
||||
, "to_as_string"
|
||||
, "doc_count"
|
||||
]
|
||||
)
|
||||
|
||||
instance FromJSON POSIXMS where
|
||||
parseJSON = withScientific "POSIXMS" (return . parse)
|
||||
where parse n = let n' = truncate n :: Integer
|
||||
in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
|
||||
|
||||
instance (FromJSON a) => FromJSON (TopHitResult a) where
|
||||
parseJSON (Object v) = TopHitResult <$>
|
||||
v .: "hits"
|
||||
parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
|
||||
|
||||
instance Monoid Filter where
|
||||
mempty = IdentityFilter
|
||||
mappend a b = AndFilter [a, b] defaultCache
|
||||
@ -2250,6 +2290,15 @@ fieldTagged f o = case HM.toList o of
|
||||
[(k, Object o')] -> f (FieldName k) o'
|
||||
_ -> fail "Expected object with 1 field-named key"
|
||||
|
||||
-- Try to get an AggregationResults when we don't know the
|
||||
-- field name. We filter out the known keys to try to minimize the noise.
|
||||
getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
|
||||
getNamedSubAgg o knownKeys = maggRes
|
||||
where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
|
||||
maggRes
|
||||
| HM.null unknownKeys = Nothing
|
||||
| otherwise = Just . M.fromList $ HM.toList unknownKeys
|
||||
|
||||
instance ToJSON GeoPoint where
|
||||
toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
|
||||
object [ geoPointField .= geoPointLatLon ]
|
||||
|
||||
@ -51,6 +51,7 @@ module Database.V5.Bloodhound.Types
|
||||
, toMissing
|
||||
, toTerms
|
||||
, toDateHistogram
|
||||
, toTopHits
|
||||
, omitNulls
|
||||
, BH(..)
|
||||
, runBH
|
||||
@ -339,6 +340,7 @@ module Database.V5.Bloodhound.Types
|
||||
, DateMathAnchor(..)
|
||||
, DateMathModifier(..)
|
||||
, DateMathUnit(..)
|
||||
, TopHitsAggregation(..)
|
||||
|
||||
, Highlights(..)
|
||||
, FieldHighlight(..)
|
||||
@ -356,6 +358,7 @@ module Database.V5.Bloodhound.Types
|
||||
, TermsResult(..)
|
||||
, DateHistogramResult(..)
|
||||
, DateRangeResult(..)
|
||||
, TopHitResult(..)
|
||||
|
||||
, EsUsername(..)
|
||||
, EsPassword(..)
|
||||
@ -1705,7 +1708,15 @@ data Aggregation = TermsAgg TermsAggregation
|
||||
| ValueCountAgg ValueCountAggregation
|
||||
| FilterAgg FilterAggregation
|
||||
| DateRangeAgg DateRangeAggregation
|
||||
| MissingAgg MissingAggregation deriving (Eq, Read, Show, Generic, Typeable)
|
||||
| MissingAgg MissingAggregation
|
||||
| TopHitsAgg TopHitsAggregation
|
||||
deriving (Eq, Read, Show, Generic, Typeable)
|
||||
|
||||
data TopHitsAggregation = TopHitsAggregation
|
||||
{ taFrom :: Maybe From
|
||||
, taSize :: Maybe Size
|
||||
, taSort :: Maybe Sort
|
||||
} deriving (Eq, Read, Show)
|
||||
|
||||
data MissingAggregation = MissingAggregation
|
||||
{ maField :: Text
|
||||
@ -1905,6 +1916,13 @@ instance ToJSON Aggregation where
|
||||
toJSON (MissingAgg (MissingAggregation{..})) =
|
||||
object ["missing" .= object ["field" .= maField]]
|
||||
|
||||
toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
|
||||
omitNulls ["top_hits" .= omitNulls [ "size" .= msize
|
||||
, "from" .= mfrom
|
||||
, "sort" .= msort
|
||||
]
|
||||
]
|
||||
|
||||
instance ToJSON DateRangeAggregation where
|
||||
toJSON DateRangeAggregation {..} =
|
||||
omitNulls [ "field" .= draField
|
||||
@ -1949,6 +1967,9 @@ data BucketValue = TextValue Text
|
||||
|
||||
data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
|
||||
|
||||
data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
|
||||
} deriving Show
|
||||
|
||||
data TermsResult = TermsResult { termKey :: BucketValue
|
||||
, termsDocCount :: Int
|
||||
, termsAggs :: Maybe AggregationResults } deriving (Read, Show)
|
||||
@ -1975,6 +1996,9 @@ toDateHistogram = toAggResult
|
||||
toMissing :: Text -> AggregationResults -> Maybe MissingResult
|
||||
toMissing = toAggResult
|
||||
|
||||
toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
|
||||
toTopHits = toAggResult
|
||||
|
||||
toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
|
||||
toAggResult t a = M.lookup t a >>= deserialize
|
||||
where deserialize = parseMaybe parseJSON
|
||||
@ -2010,10 +2034,10 @@ instance FromJSON MissingResult where
|
||||
where parse v = MissingResult <$> v .: "doc_count"
|
||||
|
||||
instance FromJSON TermsResult where
|
||||
parseJSON (Object v) = TermsResult <$>
|
||||
parseJSON (Object v) = TermsResult <$>
|
||||
v .: "key" <*>
|
||||
v .: "doc_count" <*>
|
||||
v .:? "aggregations"
|
||||
(pure $ getNamedSubAgg v ["key", "doc_count"])
|
||||
parseJSON _ = mempty
|
||||
|
||||
instance FromJSON DateHistogramResult where
|
||||
@ -2021,7 +2045,11 @@ instance FromJSON DateHistogramResult where
|
||||
v .: "key" <*>
|
||||
v .:? "key_as_string" <*>
|
||||
v .: "doc_count" <*>
|
||||
v .:? "aggregations"
|
||||
(pure $ getNamedSubAgg v [ "key"
|
||||
, "doc_count"
|
||||
, "key_as_string"
|
||||
]
|
||||
)
|
||||
parseJSON _ = mempty
|
||||
|
||||
instance FromJSON DateRangeResult where
|
||||
@ -2033,18 +2061,39 @@ instance FromJSON DateRangeResult where
|
||||
(fmap posixMS <$> v .:? "to") <*>
|
||||
v .:? "to_as_string" <*>
|
||||
v .: "doc_count" <*>
|
||||
v .:? "aggregations"
|
||||
(pure $ getNamedSubAgg v [ "key"
|
||||
, "from"
|
||||
, "from_as_string"
|
||||
, "to"
|
||||
, "to_as_string"
|
||||
, "doc_count"
|
||||
]
|
||||
)
|
||||
|
||||
instance FromJSON POSIXMS where
|
||||
parseJSON = withScientific "POSIXMS" (return . parse)
|
||||
where parse n = let n' = truncate n :: Integer
|
||||
in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
|
||||
|
||||
instance (FromJSON a) => FromJSON (TopHitResult a) where
|
||||
parseJSON (Object v) = TopHitResult <$>
|
||||
v .: "hits"
|
||||
parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
|
||||
|
||||
fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
|
||||
fieldTagged f o = case HM.toList o of
|
||||
[(k, Object o')] -> f (FieldName k) o'
|
||||
_ -> fail "Expected object with 1 field-named key"
|
||||
|
||||
-- Try to get an AggregationResults when we don't know the
|
||||
-- field name. We filter out the known keys to try to minimize the noise.
|
||||
getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
|
||||
getNamedSubAgg o knownKeys = maggRes
|
||||
where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
|
||||
maggRes
|
||||
| HM.null unknownKeys = Nothing
|
||||
| otherwise = Just . M.fromList $ HM.toList unknownKeys
|
||||
|
||||
instance ToJSON GeoPoint where
|
||||
toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
|
||||
object [ geoPointField .= geoPointLatLon ]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user