@@ -225,6 +225,12 @@ module Database.Bloodhound.Types
225225 , ValueCountAggregation(..)
226226 , FilterAggregation(..)
227227 , DateHistogramAggregation(..)
228+ , DateRangeAggregation(..)
229+ , DateRangeAggRange(..)
230+ , DateMathExpr(..)
231+ , DateMathAnchor(..)
232+ , DateMathModifier(..)
233+ , DateMathUnit(..)
228234
229235 , Highlights(..)
230236 , FieldHighlight(..)
@@ -240,6 +246,7 @@ module Database.Bloodhound.Types
240246
241247 , TermsResult(..)
242248 , DateHistogramResult(..)
249+ , DateRangeResult(..)
243250 ) where
244251
245252import Control.Applicative
@@ -261,7 +268,9 @@ import qualified Data.Map.Strict as M
261268import Data.Maybe
262269import Data.Text (Text)
263270import qualified Data.Text as T
271+import Data.Time.Calendar
264272import Data.Time.Clock (UTCTime)
273+import Data.Time.Clock.POSIX
265274import qualified Data.Traversable as DT
266275import Data.Typeable (Typeable)
267276import qualified Data.Vector as V
@@ -773,6 +782,9 @@ newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, Generic, ToJSO
773782newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
774783newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)
775784
785+-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
786+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
787+
776788{-| 'unpackId' is a silly convenience function that gets used once.
777789-}
778790unpackId :: DocId -> Text
@@ -1408,7 +1420,8 @@ data Interval = Year
14081420data Aggregation = TermsAgg TermsAggregation
14091421 | DateHistogramAgg DateHistogramAggregation
14101422 | ValueCountAgg ValueCountAggregation
1411− | FilterAgg FilterAggregation deriving (Eq, Show)
1423+ | FilterAgg FilterAggregation
1424+ | DateRangeAgg DateRangeAggregation deriving (Eq, Show)
14121425
14131426
14141427data TermsAggregation = TermsAggregation { term :: Either Text Text
@@ -1434,6 +1447,36 @@ data DateHistogramAggregation = DateHistogramAggregation { dateField :: Fie
14341447 , dateAggs :: Maybe Aggregations
14351448 } deriving (Eq, Show)
14361449
1450+
1451+data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1452+ , draFormat :: Maybe Text
1453+ , draRanges :: NonEmpty DateRangeAggRange
1454+ } deriving (Eq, Show)
1455+
1456+data DateRangeAggRange = DateRangeFrom DateMathExpr
1457+ | DateRangeTo DateMathExpr
1458+ | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Show)
1459+
1460+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1461+data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Show)
1462+
1463+
1464+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1465+data DateMathAnchor = DMNow
1466+ | DMDate Day deriving (Eq, Show)
1467+
1468+data DateMathModifier = AddTime Int DateMathUnit
1469+ | SubtractTime Int DateMathUnit
1470+ | RoundDownTo DateMathUnit deriving (Eq, Show)
1471+
1472+data DateMathUnit = DMYear
1473+ | DMMonth
1474+ | DMWeek
1475+ | DMDay
1476+ | DMHour
1477+ | DMMinute
1478+ | DMSecond deriving (Eq, Show)
1479+
14371480-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
14381481data ValueCountAggregation = FieldValueCount FieldName
14391482 | ScriptValueCount Script deriving (Eq, Show)
@@ -1537,6 +1580,39 @@ instance ToJSON Aggregation where
15371580 toJSON (FilterAgg (FilterAggregation filt ags)) =
15381581 omitNulls [ "filter" .= filt
15391582 , "aggs" .= ags]
1583+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
1584+ ]
1585+
1586+instance ToJSON DateRangeAggregation where
1587+ toJSON DateRangeAggregation {..} =
1588+ omitNulls [ "field" .= draField
1589+ , "format" .= draFormat
1590+ , "ranges" .= toList draRanges
1591+ ]
1592+
1593+instance ToJSON DateRangeAggRange where
1594+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
1595+ toJSON (DateRangeTo e) = object [ "to" .= e ]
1596+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1597+
1598+instance ToJSON DateMathExpr where
1599+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1600+ where fmtA DMNow = "now"
1601+ fmtA (DMDate date) = case toGregorian date of
1602+ (y,m,d) -> showText y <> "-" <>
1603+ showText m <> "-" <>
1604+ showText d <> "||"
1605+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1606+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1607+ fmtMod (RoundDownTo u) = "/" <> fmtU u
1608+ fmtU DMYear = "y"
1609+ fmtU DMMonth = "M"
1610+ fmtU DMWeek = "w"
1611+ fmtU DMDay = "d"
1612+ fmtU DMHour = "h"
1613+ fmtU DMMinute = "m"
1614+ fmtU DMSecond = "s"
1615+
15401616
15411617type AggregationResults = M.Map Text Value
15421618
@@ -1557,6 +1633,14 @@ data DateHistogramResult = DateHistogramResult { dateKey :: Int
15571633 , dateDocCount :: Int
15581634 , dateHistogramAggs :: Maybe AggregationResults } deriving (Show)
15591635
1636+data DateRangeResult = DateRangeResult { dateRangeKey :: Text
1637+ , dateRangeFrom :: Maybe UTCTime
1638+ , dateRangeFromAsString :: Maybe Text
1639+ , dateRangeTo :: Maybe UTCTime
1640+ , dateRangeToAsString :: Maybe Text
1641+ , dateRangeDocCount :: Int
1642+ , dateRangeAggs :: Maybe AggregationResults } deriving (Show, Eq)
1643+
15601644toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
15611645toTerms t a = M.lookup t a >>= deserialize
15621646 where deserialize = parseMaybe parseJSON
@@ -1575,6 +1659,11 @@ instance BucketAggregation DateHistogramResult where
15751659 docCount = dateDocCount
15761660 aggs = dateHistogramAggs
15771661
1662+instance BucketAggregation DateRangeResult where
1663+ key = dateRangeKey
1664+ docCount = dateRangeDocCount
1665+ aggs = dateRangeAggs
1666+
15781667instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
15791668 parseJSON (Object v) = Bucket <$>
15801669 v .: "buckets"
@@ -1595,6 +1684,22 @@ instance FromJSON DateHistogramResult where
15951684 v .:? "aggregations"
15961685 parseJSON _ = mempty
15971686
1687+instance FromJSON DateRangeResult where
1688+ parseJSON = withObject "DateRangeResult" parse
1689+ where parse v = DateRangeResult <$>
1690+ v .: "key" <*>
1691+ (fmap posixMS <$> v .:? "from") <*>
1692+ v .:? "from_as_string" <*>
1693+ (fmap posixMS <$> v .:? "to") <*>
1694+ v .:? "to_as_string" <*>
1695+ v .: "doc_count" <*>
1696+ v .:? "aggregations"
1697+
1698+instance FromJSON POSIXMS where
1699+ parseJSON = withScientific "POSIXMS" (return . parse)
1700+ where parse n = let n' = truncate n :: Integer
1701+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
1702+
15981703instance Monoid Filter where
15991704 mempty = IdentityFilter
16001705 mappend a b = AndFilter [a, b] defaultCache
@@ -1890,7 +1995,7 @@ instance FromJSON Query where
18901995 <|> idsQuery `taggedWith` "ids"
18911996 <|> queryQueryStringQuery `taggedWith` "query_string"
18921997 <|> queryMatchQuery `taggedWith` "match"
1893− <|> queryMultiMatchQuery --TODO: is this a precedence issue?
1998+ <|> queryMultiMatchQuery
18941999 <|> queryBoolQuery `taggedWith` "bool"
18952000 <|> queryBoostingQuery `taggedWith` "boosting"
18962001 <|> queryCommonTermsQuery `taggedWith` "common"