bloodhound 0.25.0.0 → 0.26.0.0

raw patch · 8 files changed

+103/−64 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bloodhound.cabal +1/−1
• changelog.md +11/−0
• src/Database/Bloodhound/Client/Cluster.hs +16/−16
• src/Database/Bloodhound/Internal/Versions/Common/Types/Aggregation.hs +35/−12
• src/Database/Bloodhound/Internal/Versions/Common/Types/Script.hs +2/−2
• src/Database/Bloodhound/Internal/Versions/Common/Types/Units.hs +12/−8
• tests/Test/AggregationSpec.hs +25/−24
• tests/TestsUtils/Common.hs +1/−1

@@ -1,7 +1,7 @@ cabal-version:  3.4  name:           bloodhound-version:        0.25.0.0+version:        0.26.0.0 synopsis:       Elasticsearch client library for Haskell description:    Elasticsearch made awesome for Haskell hackers category:       Database, Search

@@ -1,3 +1,14 @@+0.26.0.0+========+- @blackheaven+  - breaking: change `DateHistogramAggregation.dateInterval` from `Interval` to `Maybe Interval`+  - breaking: change `mkDateHistogram` signature from `FieldName -> Interval -> DateHistogramAggregation` to `FieldName -> DateHistogramAggregation`+  - breaking: replace `TermsAggregation.term` from `Either Text Text` to `TermsAggregationTarget`+  - breaking: change `mkTermsAggregation` signature from `Text -> TermsAggregation` to `FieldName -> TermsAggregation`+  - feat: add `IntervalFixed` constructor to `Interval` sum type+  - feat: add `bhResponseHook` to `BHEnv` for post-response debugging/processing+  - feat: add `TermsAggregationTarget` sum type with `TermsAggregationTargetField` and `TermsAggregationTargetScript` constructors+ 0.25.0.0 ======== - @blackheaven

@@ -50,7 +50,9 @@   { bhServer :: Server,     bhManager :: HTTP.Manager,     -- | Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.-    bhRequestHook :: HTTP.Request -> IO HTTP.Request+    bhRequestHook :: HTTP.Request -> IO HTTP.Request,+    -- | Low-level hook that is run after every response is received. Used to debug. Defaults to 'return' with 'mkBHEnv'.+    bhResponseHook :: HTTP.Response L.ByteString -> IO (HTTP.Response L.ByteString)   }  -- | All API calls to Elasticsearch operate within@@ -86,7 +88,7 @@ -- -- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook } mkBHEnv :: Server -> HTTP.Manager -> BHEnv-mkBHEnv s m = BHEnv s m return+mkBHEnv s m = BHEnv s m return return  -- | Basic BH implementation newtype BH m a = BH@@ -121,28 +123,26 @@   type Backend (BH m) = 'Dynamic   dispatch request = BH $ do     env <- ask @BHEnv-    let url = getEndpoint (bhServer env) (bhRequestEndpoint request)-    initReq <- liftIO $ parseUrl' url-    let reqHook = bhRequestHook env-    let reqBody = HTTP.RequestBodyLBS $ fromMaybe emptyBody $ bhRequestBody request-    let setQueryStrings =-          case bhRequestQueryStrings request of-            [] -> id-            xs -> HTTP.setQueryString xs-    req <--      liftIO $-        reqHook $+    liftIO $ do+      initReq <- parseUrl' $ getEndpoint (bhServer env) (bhRequestEndpoint request)+      let setQueryStrings =+            case bhRequestQueryStrings request of+              [] -> id+              xs -> HTTP.setQueryString xs+      req <-+        bhRequestHook env $           HTTP.setRequestIgnoreStatus $             setQueryStrings $               initReq                 { HTTP.method = bhRequestMethod request,                   HTTP.requestHeaders =                     ("Content-Type", "application/json") : HTTP.requestHeaders initReq,-                  HTTP.requestBody = reqBody+                  HTTP.requestBody = HTTP.RequestBodyLBS $ fromMaybe emptyBody $ bhRequestBody request                 } -    let mgr = bhManager env-    BHResponse <$> liftIO (HTTP.httpLbs req mgr)+      let mgr = bhManager env+      rawResp <- HTTP.httpLbs req mgr+      BHResponse <$> bhResponseHook env rawResp   tryEsError = try   throwEsError = throwM 

@@ -147,7 +147,7 @@     omitNulls       [ "terms"           .= omitNulls-            [ toJSON' term,+            [ mkTarget term,               "include" .= include,               "exclude" .= exclude,               "order" .= order,@@ -160,7 +160,9 @@         "aggs" .= termAggs       ]     where-      toJSON' x = case x of Left y -> "field" .= y; Right y -> "script" .= y+      mkTarget x = case x of+        TermsAggregationTargetField fn -> "field" .= fn+        TermsAggregationTargetScript scr -> "script" .= scr   toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold missing)) =     object       [ "cardinality"@@ -270,7 +272,7 @@ topHitsAggregationSortLens :: Lens' TopHitsAggregation (Maybe Sort) topHitsAggregationSortLens = lens taSort (\x y -> x {taSort = y}) -data MissingAggregation = MissingAggregation+newtype MissingAggregation = MissingAggregation   { maField :: Text   }   deriving stock (Eq, Show)@@ -279,7 +281,7 @@ missingAggregationFieldLens = lens maField (\x y -> x {maField = y})  data TermsAggregation = TermsAggregation-  { term :: Either Text Text,+  { term :: TermsAggregationTarget,     termInclude :: Maybe TermInclusion,     termExclude :: Maybe TermInclusion,     termOrder :: Maybe TermOrder,@@ -292,7 +294,7 @@   }   deriving stock (Eq, Show) -termAggregationTermLens :: Lens' TermsAggregation (Either Text Text)+termAggregationTermLens :: Lens' TermsAggregation TermsAggregationTarget termAggregationTermLens = lens term (\x y -> x {term = y})  termAggregationIncludeLens :: Lens' TermsAggregation (Maybe TermInclusion)@@ -322,6 +324,27 @@ termAggregationAggsLens :: Lens' TermsAggregation (Maybe Aggregations) termAggregationAggsLens = lens termAggs (\x y -> x {termAggs = y}) +data TermsAggregationTarget+  = TermsAggregationTargetField FieldName+  | TermsAggregationTargetScript Text+  deriving stock (Eq, Show)++termsAggregationTargetTermsAggregationTargetFieldPrism :: Prism' TermsAggregationTarget FieldName+termsAggregationTargetTermsAggregationTargetFieldPrism = prism TermsAggregationTargetField extract+  where+    extract s =+      case s of+        TermsAggregationTargetField x -> Right x+        _ -> Left s++termsAggregationTargetTermsAggregationTargetScriptPrism :: Prism' TermsAggregationTarget Text+termsAggregationTargetTermsAggregationTargetScriptPrism = prism TermsAggregationTargetScript extract+  where+    extract s =+      case s of+        TermsAggregationTargetScript x -> Right x+        _ -> Left s+ data CardinalityAggregation = CardinalityAggregation   { cardinalityField :: FieldName,     cardinalityPrecisionThreshold :: Maybe PrecisionThreshold,@@ -340,7 +363,7 @@  data DateHistogramAggregation = DateHistogramAggregation   { dateField :: FieldName,-    dateInterval :: Interval,+    dateInterval :: Maybe Interval,     dateFormat :: Maybe Text,     -- pre and post deprecated in 1.5     datePreZone :: Maybe Text,@@ -362,7 +385,7 @@ dateHistogramAggregationFieldLens :: Lens' DateHistogramAggregation FieldName dateHistogramAggregationFieldLens = lens dateField (\x y -> x {dateField = y}) -dateHistogramAggregationIntervalLens :: Lens' DateHistogramAggregation Interval+dateHistogramAggregationIntervalLens :: Lens' DateHistogramAggregation (Maybe Interval) dateHistogramAggregationIntervalLens = lens dateInterval (\x y -> x {dateInterval = y})  dateHistogramAggregationFormatLens :: Lens' DateHistogramAggregation (Maybe Text)@@ -529,10 +552,10 @@ medianAbsoluteDeviationAggregationMissingLens :: Lens' MedianAbsoluteDeviationAggregation (Maybe Missing) medianAbsoluteDeviationAggregationMissingLens = lens medianAbsoluteDeviationAggregationMissing (\x y -> x {medianAbsoluteDeviationAggregationMissing = y}) -mkTermsAggregation :: Text -> TermsAggregation+mkTermsAggregation :: FieldName -> TermsAggregation mkTermsAggregation t =   TermsAggregation-    (Left t)+    (TermsAggregationTargetField t)     Nothing     Nothing     Nothing@@ -544,10 +567,10 @@     Nothing  mkTermsScriptAggregation :: Text -> TermsAggregation-mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+mkTermsScriptAggregation t = TermsAggregation (TermsAggregationTargetScript t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation-mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+mkDateHistogram :: FieldName -> DateHistogramAggregation+mkDateHistogram t = DateHistogramAggregation t Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing  mkCardinalityAggregation :: FieldName -> CardinalityAggregation mkCardinalityAggregation t = CardinalityAggregation t Nothing Nothing

@@ -156,9 +156,9 @@   singleScript     `taggedWith` "script_score"     <|> singleRandom-      `taggedWith` "random_score"+    `taggedWith` "random_score"     <|> singleFieldValueFactor-      `taggedWith` "field_value_factor"+    `taggedWith` "field_value_factor"   where     taggedWith parser k = parser =<< o .: k     singleScript = pure . FunctionScoreFunctionScript

@@ -87,17 +87,21 @@   | Hour   | Minute   | Second+  | IntervalFixed FixedInterval   deriving stock (Eq, Show)  instance ToJSON Interval where-  toJSON Year = "year"-  toJSON Quarter = "quarter"-  toJSON Month = "month"-  toJSON Week = "week"-  toJSON Day = "day"-  toJSON Hour = "hour"-  toJSON Minute = "minute"-  toJSON Second = "second"+  toJSON x =+    case x of+      Year -> "year"+      Quarter -> "quarter"+      Month -> "month"+      Week -> "week"+      Day -> "day"+      Hour -> "hour"+      Minute -> "minute"+      Second -> "second"+      IntervalFixed i -> toJSON i  parseStringInterval :: (Monad m, MonadFail m) => String -> m NominalDiffTime parseStringInterval s = case span isNumber s of

@@ -14,7 +14,7 @@     it "returns term aggregation results" $       withTestEnv $ do         _ <- insertData-        let terms = TermsAgg $ mkTermsAggregation "user"+        let terms = TermsAgg $ mkTermsAggregation $ FieldName "user"         let search = mkAggregateSearch Nothing $ mkAggregations "users" terms         searchExpectAggs search         searchValidBucketAgg search "users" toTerms@@ -22,8 +22,8 @@     it "return sub-aggregation results" $       withTestEnv $ do         _ <- insertData-        let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"-            agg = TermsAgg $ (mkTermsAggregation "user") {termAggs = Just subaggs}+        let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation $ FieldName "age"+            agg = TermsAgg $ (mkTermsAggregation $ FieldName "user") {termAggs = Just subaggs}             search = mkAggregateSearch Nothing $ mkAggregations "users" agg         result <- performBHRequest $ searchByIndex @Tweet testIndex search         let usersAggResults = aggregations result >>= toTerms "users"@@ -67,7 +67,7 @@     it "can give collection hint parameters to term aggregations" $       withTestEnv $ do         _ <- insertData-        let terms = TermsAgg $ (mkTermsAggregation "user") {termCollectMode = Just BreadthFirst}+        let terms = TermsAgg $ (mkTermsAggregation $ FieldName "user") {termCollectMode = Just BreadthFirst}         let search = mkAggregateSearch Nothing $ mkAggregations "users" terms         searchExpectAggs search         searchValidBucketAgg search "users" toTerms@@ -124,30 +124,31 @@         let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0         let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0         liftIO $-          buckets <$> bucks-            `shouldBe` Right-              [ DateRangeResult-                  "2015-02-14T00:00:00.000Z-*"-                  (Just fromMonthT)-                  (Just "2015-02-14T00:00:00.000Z")-                  Nothing-                  Nothing-                  2-                  Nothing,-                DateRangeResult-                  "2015-03-07T00:00:00.000Z-*"-                  (Just fromWeekT)-                  (Just "2015-03-07T00:00:00.000Z")-                  Nothing-                  Nothing-                  1-                  Nothing-              ]+          buckets+            <$> bucks+              `shouldBe` Right+                [ DateRangeResult+                    "2015-02-14T00:00:00.000Z-*"+                    (Just fromMonthT)+                    (Just "2015-02-14T00:00:00.000Z")+                    Nothing+                    Nothing+                    2+                    Nothing,+                  DateRangeResult+                    "2015-03-07T00:00:00.000Z-*"+                    (Just fromWeekT)+                    (Just "2015-03-07T00:00:00.000Z")+                    Nothing+                    Nothing+                    1+                    Nothing+                ]      it "returns date histogram aggregation results" $       withTestEnv $ do         _ <- insertData-        let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute+        let histogram = DateHistogramAgg (mkDateHistogram (FieldName "postDate")) {dateInterval = Just Minute}         let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)         searchExpectAggs search         searchValidBucketAgg search "byDate" toDateHistogram

@@ -278,7 +278,7 @@  searchTermsAggHint :: [ExecutionHint] -> BH IO () searchTermsAggHint hints = do-  let terms hint = TermsAgg $ (mkTermsAggregation "user.keyword") {termExecutionHint = Just hint}+  let terms hint = TermsAgg $ (mkTermsAggregation $ FieldName "user.keyword") {termExecutionHint = Just hint}   let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint   forM_ hints $ searchExpectAggs . search