@@ -22,6 +22,10 @@ module Database.Bloodhound.Types
2222 , mkBoolQuery
2323 , mkRangeQuery
2424 , mkQueryStringQuery
25+ , mkTermsAggregation
26+ , mkDateHistogram
27+ , toTerms
28+ , toDateHistogram
2529 , Version(..)
2630 , Status(..)
2731 , Existence(..)
@@ -142,15 +146,29 @@ module Database.Bloodhound.Types
142146 , FieldOrFields(..)
143147 , Monoid(..)
144148 , 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
145161 ) where
146162
147163import Control.Applicative
148164import Data.Aeson
165+import Data.Aeson.Types (parseMaybe)
149166import qualified Data.ByteString.Lazy.Char8 as L
150167import Data.List (nub)
151168import Data.List.NonEmpty (NonEmpty(..))
152169import Data.Monoid
153170import Data.Text (Text)
171+import qualified Data.Map.Strict as M
154172import qualified Data.Text as T
155173import Data.Time.Clock (UTCTime)
156174import GHC.Generics (Generic)
@@ -474,6 +492,7 @@ type Size = Int
474492data Search = Search { queryBody :: Maybe Query
475493 , filterBody :: Maybe Filter
476494 , sortBody :: Maybe Sort
495+ , aggBody :: Maybe Aggregations
477496 -- default False
478497 , trackSortScores :: TrackSortScores
479498 , from :: From
@@ -913,10 +932,11 @@ data DistanceRange =
913932 , distanceTo :: Distance } deriving (Eq, Show)
914933
915934data FromJSON a => SearchResult a =
916− SearchResult { took :: Int
917− , timedOut :: Bool
918− , shards :: ShardResult
919− , searchHits :: SearchHits a } deriving (Eq, Show)
935+ SearchResult { took :: Int
936+ , timedOut :: Bool
937+ , shards :: ShardResult
938+ , searchHits :: SearchHits a
939+ , aggregations :: Maybe AggregationResults } deriving (Eq, Show)
920940
921941type Score = Double
922942
@@ -940,6 +960,188 @@ data ShardResult =
940960showText :: Show a => a -> Text
941961showText = T.pack . show
942962
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"
9431145
9441146instance Monoid Filter where
9451147 mempty = IdentityFilter
@@ -1533,10 +1735,11 @@ instance (FromJSON a) => FromJSON (EsResult a) where
15331735
15341736
15351737instance ToJSON Search where
1536− toJSON (Search query sFilter sort sTrackSortScores sFrom sSize) =
1738+ toJSON (Search query sFilter sort aggs sTrackSortScores sFrom sSize) =
15371739 omitNulls [ "query" .= query
15381740 , "filter" .= sFilter
15391741 , "sort" .= sort
1742+ , "aggregations" .= aggs
15401743 , "from" .= sFrom
15411744 , "size" .= sSize
15421745 , "track_scores" .= sTrackSortScores ]
@@ -1674,10 +1877,11 @@ instance ToJSON BoolMatch where
16741877
16751878instance (FromJSON a) => FromJSON (SearchResult a) where
16761879 parseJSON (Object v) = SearchResult <$>
1677− v .: "took" <*>
1678− v .: "timed_out" <*>
1679− v .: "_shards" <*>
1680− v .: "hits"
1880+ v .: "took" <*>
1881+ v .: "timed_out" <*>
1882+ v .: "_shards" <*>
1883+ v .: "hits" <*>
1884+ v .:? "aggregations"
16811885 parseJSON _ = empty
16821886
16831887instance (FromJSON a) => FromJSON (SearchHits a) where