895df29 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

fix sub-aggs and add top_hits agg

commit895df29b9fb1e7dc3dbaa15d148aead5ad73820e authorJosh Berman <berman.josh@gmail.com> dateSun 15 Jan 2017, 20:20 (10 years ago) parent79d4eda

2 files changed+108−10

compare with master

unifiedsplit

src/Database/V1/Bloodhound/Types.hs+54−5 src/Database/V5/Bloodhound/Types.hs+54−5

src/Database/V1/Bloodhound/Types.hs+54−5

@@ -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 ]

src/Database/V5/Bloodhound/Types.hs+54−5

@@ -51,6 +51,7 @@ module Database.V5.Bloodhound.Types

5151 , toMissing

5252 , toTerms

5353 , toDateHistogram

54+ , toTopHits

5455 , omitNulls

5556 , BH(..)

5657 , runBH

@@ -339,6 +340,7 @@ module Database.V5.Bloodhound.Types

339340 , DateMathAnchor(..)

340341 , DateMathModifier(..)

341342 , DateMathUnit(..)

343+ , TopHitsAggregation(..)

342344

343345 , Highlights(..)

344346 , FieldHighlight(..)

@@ -356,6 +358,7 @@ module Database.V5.Bloodhound.Types

356358 , TermsResult(..)

357359 , DateHistogramResult(..)

358360 , DateRangeResult(..)

361+ , TopHitResult(..)

359362

360363 , EsUsername(..)

361364 , EsPassword(..)

@@ -1705,7 +1708,15 @@ data Aggregation = TermsAgg TermsAggregation

17051708 | ValueCountAgg ValueCountAggregation

17061709 | FilterAgg FilterAggregation

17071710 | DateRangeAgg DateRangeAggregation

1708− | MissingAgg MissingAggregation deriving (Eq, Read, Show, Generic, Typeable)

1711+ | MissingAgg MissingAggregation

1712+ | TopHitsAgg TopHitsAggregation

1713+ deriving (Eq, Read, Show, Generic, Typeable)

1714+

1715+data TopHitsAggregation = TopHitsAggregation

1716+ { taFrom :: Maybe From

1717+ , taSize :: Maybe Size

1718+ , taSort :: Maybe Sort

1719+ } deriving (Eq, Read, Show)

17091720

17101721data MissingAggregation = MissingAggregation

17111722 { maField :: Text

@@ -1905,6 +1916,13 @@ instance ToJSON Aggregation where

19051916 toJSON (MissingAgg (MissingAggregation{..})) =

19061917 object ["missing" .= object ["field" .= maField]]

19071918

1919+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =

1920+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize

1921+ , "from" .= mfrom

1922+ , "sort" .= msort

1923+ ]

1924+ ]

1925+

19081926instance ToJSON DateRangeAggregation where

19091927 toJSON DateRangeAggregation {..} =

19101928 omitNulls [ "field" .= draField

@@ -1949,6 +1967,9 @@ data BucketValue = TextValue Text

19491967

19501968data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)

19511969

1970+data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)

1971+ } deriving Show

1972+

19521973data TermsResult = TermsResult { termKey :: BucketValue

19531974 , termsDocCount :: Int

19541975 , termsAggs :: Maybe AggregationResults } deriving (Read, Show)

@@ -1975,6 +1996,9 @@ toDateHistogram = toAggResult

19751996toMissing :: Text -> AggregationResults -> Maybe MissingResult

19761997toMissing = toAggResult

19771998

1999+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)

2000+toTopHits = toAggResult

2001+

19782002toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a

19792003toAggResult t a = M.lookup t a >>= deserialize

19802004 where deserialize = parseMaybe parseJSON

@@ -2010,10 +2034,10 @@ instance FromJSON MissingResult where

20102034 where parse v = MissingResult <$> v .: "doc_count"

20112035

20122036instance FromJSON TermsResult where

2013− parseJSON (Object v) = TermsResult <$>

2037+ parseJSON (Object v) = TermsResult <$>

20142038 v .: "key" <*>

20152039 v .: "doc_count" <*>

2016− v .:? "aggregations"

2040+ (pure $ getNamedSubAgg v ["key", "doc_count"])

20172041 parseJSON _ = mempty

20182042

20192043instance FromJSON DateHistogramResult where

@@ -2021,7 +2045,11 @@ instance FromJSON DateHistogramResult where

20212045 v .: "key" <*>

20222046 v .:? "key_as_string" <*>

20232047 v .: "doc_count" <*>

2024− v .:? "aggregations"

2048+ (pure $ getNamedSubAgg v [ "key"

2049+ , "doc_count"

2050+ , "key_as_string"

2051+ ]

2052+ )

20252053 parseJSON _ = mempty

20262054

20272055instance FromJSON DateRangeResult where

@@ -2033,18 +2061,39 @@ instance FromJSON DateRangeResult where

20332061 (fmap posixMS <$> v .:? "to") <*>

20342062 v .:? "to_as_string" <*>

20352063 v .: "doc_count" <*>

2036− v .:? "aggregations"

2064+ (pure $ getNamedSubAgg v [ "key"

2065+ , "from"

2066+ , "from_as_string"

2067+ , "to"

2068+ , "to_as_string"

2069+ , "doc_count"

2070+ ]

2071+ )

20372072

20382073instance FromJSON POSIXMS where

20392074 parseJSON = withScientific "POSIXMS" (return . parse)

20402075 where parse n = let n' = truncate n :: Integer

20412076 in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))

20422077

2078+instance (FromJSON a) => FromJSON (TopHitResult a) where

2079+ parseJSON (Object v) = TopHitResult <$>

2080+ v .: "hits"

2081+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"

2082+

20432083fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a

20442084fieldTagged f o = case HM.toList o of

20452085 [(k, Object o')] -> f (FieldName k) o'

20462086 _ -> fail "Expected object with 1 field-named key"

20472087

2088+-- Try to get an AggregationResults when we don't know the

2089+-- field name. We filter out the known keys to try to minimize the noise.

2090+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults

2091+getNamedSubAgg o knownKeys = maggRes

2092+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o

2093+ maggRes

2094+ | HM.null unknownKeys = Nothing

2095+ | otherwise = Just . M.fromList $ HM.toList unknownKeys

2096+

20482097instance ToJSON GeoPoint where

20492098 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

20502099 object [ geoPointField .= geoPointLatLon ]