895df29 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

fix sub-aggs and add top_hits agg

895df29Josh Berman10 years ago

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

compare with master

unifiedsplit

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

51 , toMissing

52 , toTerms

53 , toDateHistogram

54+ , toTopHits

54 , omitNulls

55 , omitNulls

55 , BH(..)

56 , BH(..)

56 , runBH

57 , runBH

@@ -340,6 +341,7 @@ module Database.V1.Bloodhound.Types

340 , DateMathAnchor(..)

341 , DateMathAnchor(..)

341 , DateMathModifier(..)

342 , DateMathModifier(..)

342 , DateMathUnit(..)

343 , DateMathUnit(..)

344+ , TopHitsAggregation(..)

343

345

344 , Highlights(..)

346 , Highlights(..)

345 , FieldHighlight(..)

347 , FieldHighlight(..)

@@ -357,6 +359,7 @@ module Database.V1.Bloodhound.Types

357 , TermsResult(..)

359 , TermsResult(..)

358 , DateHistogramResult(..)

360 , DateHistogramResult(..)

359 , DateRangeResult(..)

361 , DateRangeResult(..)

362+ , TopHitResult(..)

360

363

361 , EsUsername(..)

364 , EsUsername(..)

362 , EsPassword(..)

365 , EsPassword(..)

@@ -1722,7 +1725,15 @@ data Aggregation = TermsAgg TermsAggregation

1722 | ValueCountAgg ValueCountAggregation

1725 | ValueCountAgg ValueCountAggregation

1723 | FilterAgg FilterAggregation

1726 | FilterAgg FilterAggregation

1724 | DateRangeAgg DateRangeAggregation

1727 | DateRangeAgg DateRangeAggregation

1728+ | MissingAgg MissingAggregation

1729+ | TopHitsAgg TopHitsAggregation

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

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)

1726

1737

1727data MissingAggregation = MissingAggregation

1738data MissingAggregation = MissingAggregation

1728 { maField :: Text

1739 { maField :: Text

@@ -1923,6 +1934,13 @@ instance ToJSON Aggregation where

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

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

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

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

1925

1936

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

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

1939+ , "from" .= mfrom

1940+ , "sort" .= msort

1941+ ]

1942+ ]

1943+

1926instance ToJSON DateRangeAggregation where

1944instance ToJSON DateRangeAggregation where

1927 toJSON DateRangeAggregation {..} =

1945 toJSON DateRangeAggregation {..} =

1928 omitNulls [ "field" .= draField

1946 omitNulls [ "field" .= draField

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

1967

1985

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

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

1969

1987

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

1989+ } deriving Show

1990+

1970data TermsResult = TermsResult { termKey :: BucketValue

1991data TermsResult = TermsResult { termKey :: BucketValue

1971 , termsDocCount :: Int

1992 , termsDocCount :: Int

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

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

@@ -1993,6 +2014,9 @@ toDateHistogram = toAggResult

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

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

1994toMissing = toAggResult

2015toMissing = toAggResult

1995

2016

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

2018+toTopHits = toAggResult

2019+

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

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

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

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

1998 where deserialize = parseMaybe parseJSON

2022 where deserialize = parseMaybe parseJSON

@@ -2028,10 +2052,10 @@ instance FromJSON MissingResult where

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

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

2029

2053

2030instance FromJSON TermsResult where

2054instance FromJSON TermsResult where

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

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

2032 v .: "key" <*>

2056 v .: "key" <*>

2033 v .: "doc_count" <*>

2057 v .: "doc_count" <*>

2034− v .:? "aggregations"

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

2035 parseJSON _ = mempty

2059 parseJSON _ = mempty

2036

2060

2037instance FromJSON DateHistogramResult where

2061instance FromJSON DateHistogramResult where

@@ -2039,7 +2063,11 @@ instance FromJSON DateHistogramResult where

2039 v .: "key" <*>

2063 v .: "key" <*>

2040 v .:? "key_as_string" <*>

2064 v .:? "key_as_string" <*>

2041 v .: "doc_count" <*>

2065 v .: "doc_count" <*>

2042− v .:? "aggregations"

2066+ (pure $ getNamedSubAgg v [ "key"

2067+ , "doc_count"

2068+ , "key_as_string"

2069+ ]

2070+ )

2043 parseJSON _ = mempty

2071 parseJSON _ = mempty

2044

2072

2045instance FromJSON DateRangeResult where

2073instance FromJSON DateRangeResult where

@@ -2051,13 +2079,25 @@ instance FromJSON DateRangeResult where

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

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

2052 v .:? "to_as_string" <*>

2080 v .:? "to_as_string" <*>

2053 v .: "doc_count" <*>

2081 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+ )

2055

2090

2056instance FromJSON POSIXMS where

2091instance FromJSON POSIXMS where

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

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

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

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

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

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

2060

2095

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+

2061instance Monoid Filter where

2101instance Monoid Filter where

2062 mempty = IdentityFilter

2102 mempty = IdentityFilter

2063 mappend a b = AndFilter [a, b] defaultCache

2103 mappend a b = AndFilter [a, b] defaultCache

@@ -2250,6 +2290,15 @@ fieldTagged f o = case HM.toList o of

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

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

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

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

2252

2292

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+

2253instance ToJSON GeoPoint where

2302instance ToJSON GeoPoint where

2254 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

2303 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

2255 object [ geoPointField .= geoPointLatLon ]

2304 object [ geoPointField .= geoPointLatLon ]

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

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

51 , toMissing

52 , toTerms

53 , toDateHistogram

54+ , toTopHits

54 , omitNulls

55 , omitNulls

55 , BH(..)

56 , BH(..)

56 , runBH

57 , runBH

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

339 , DateMathAnchor(..)

340 , DateMathAnchor(..)

340 , DateMathModifier(..)

341 , DateMathModifier(..)

341 , DateMathUnit(..)

342 , DateMathUnit(..)

343+ , TopHitsAggregation(..)

342

344

343 , Highlights(..)

345 , Highlights(..)

344 , FieldHighlight(..)

346 , FieldHighlight(..)

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

356 , TermsResult(..)

358 , TermsResult(..)

357 , DateHistogramResult(..)

359 , DateHistogramResult(..)

358 , DateRangeResult(..)

360 , DateRangeResult(..)

361+ , TopHitResult(..)

359

362

360 , EsUsername(..)

363 , EsUsername(..)

361 , EsPassword(..)

364 , EsPassword(..)

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

1705 | ValueCountAgg ValueCountAggregation

1708 | ValueCountAgg ValueCountAggregation

1706 | FilterAgg FilterAggregation

1709 | FilterAgg FilterAggregation

1707 | DateRangeAgg DateRangeAggregation

1710 | DateRangeAgg DateRangeAggregation

1711+ | MissingAgg MissingAggregation

1712+ | TopHitsAgg TopHitsAggregation

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

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)

1709

1720

1710data MissingAggregation = MissingAggregation

1721data MissingAggregation = MissingAggregation

1711 { maField :: Text

1722 { maField :: Text

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

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

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

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

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

1907

1918

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

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

1921+ , "from" .= mfrom

1922+ , "sort" .= msort

1923+ ]

1924+ ]

1925+

1908instance ToJSON DateRangeAggregation where

1926instance ToJSON DateRangeAggregation where

1909 toJSON DateRangeAggregation {..} =

1927 toJSON DateRangeAggregation {..} =

1910 omitNulls [ "field" .= draField

1928 omitNulls [ "field" .= draField

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

1949

1967

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

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

1951

1969

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

1971+ } deriving Show

1972+

1952data TermsResult = TermsResult { termKey :: BucketValue

1973data TermsResult = TermsResult { termKey :: BucketValue

1953 , termsDocCount :: Int

1974 , termsDocCount :: Int

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

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

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

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

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

1976toMissing = toAggResult

1997toMissing = toAggResult

1977

1998

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

2000+toTopHits = toAggResult

2001+

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

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

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

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

1980 where deserialize = parseMaybe parseJSON

2004 where deserialize = parseMaybe parseJSON

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

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

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

2011

2035

2012instance FromJSON TermsResult where

2036instance FromJSON TermsResult where

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

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

2014 v .: "key" <*>

2038 v .: "key" <*>

2015 v .: "doc_count" <*>

2039 v .: "doc_count" <*>

2016− v .:? "aggregations"

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

2017 parseJSON _ = mempty

2041 parseJSON _ = mempty

2018

2042

2019instance FromJSON DateHistogramResult where

2043instance FromJSON DateHistogramResult where

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

2021 v .: "key" <*>

2045 v .: "key" <*>

2022 v .:? "key_as_string" <*>

2046 v .:? "key_as_string" <*>

2023 v .: "doc_count" <*>

2047 v .: "doc_count" <*>

2024− v .:? "aggregations"

2048+ (pure $ getNamedSubAgg v [ "key"

2049+ , "doc_count"

2050+ , "key_as_string"

2051+ ]

2052+ )

2025 parseJSON _ = mempty

2053 parseJSON _ = mempty

2026

2054

2027instance FromJSON DateRangeResult where

2055instance FromJSON DateRangeResult where

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

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

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

2034 v .:? "to_as_string" <*>

2062 v .:? "to_as_string" <*>

2035 v .: "doc_count" <*>

2063 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+ )

2037

2072

2038instance FromJSON POSIXMS where

2073instance FromJSON POSIXMS where

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

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

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

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

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

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

2042

2077

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+

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

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

2044fieldTagged f o = case HM.toList o of

2084fieldTagged f o = case HM.toList o of

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

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

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

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

2047

2087

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+

2048instance ToJSON GeoPoint where

2097instance ToJSON GeoPoint where

2049 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

2098 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

2050 object [ geoPointField .= geoPointLatLon ]

2099 object [ geoPointField .= geoPointLatLon ]