From 6acb114e8ee4dcce7926c005a197ba02bba8bf37 Mon Sep 17 00:00:00 2001
From: Chris Allen <cma@bitemyapp.com>
Date: Sun, 27 Apr 2014 07:22:12 -0500
Subject: [PATCH] Boosting Query

---
 Database/Bloodhound/Types.hs           |  7 +++----
 Database/Bloodhound/Types/Instances.hs | 13 +++++++++++--
 tests/tests.hs                         |  9 +++++++++
 3 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/Database/Bloodhound/Types.hs b/Database/Bloodhound/Types.hs
index 4590836..ccbc060 100644
--- a/Database/Bloodhound/Types.hs
+++ b/Database/Bloodhound/Types.hs
@@ -518,10 +518,9 @@ data BoolQuery = BoolQuery { boolQueryMustMatch          :: Maybe Query
 mkBoolQuery :: Maybe Query -> Maybe Query -> Maybe [Query] -> BoolQuery
 mkBoolQuery must mustNot should = BoolQuery must mustNot should Nothing Nothing Nothing
 
-data BoostingQuery = BoostingQuery { positiveQuery :: Maybe Query
-                                   , negativeQuery :: Maybe Query
-                                   , positiveBoost :: Maybe Boost
-                                   , negativeBoost :: Maybe Boost } deriving (Eq, Show)
+data BoostingQuery = BoostingQuery { positiveQuery :: Query
+                                   , negativeQuery :: Query
+                                   , negativeBoost :: Boost } deriving (Eq, Show)
 
 data CommonTermsQuery =
   CommonTermsQuery { commonQuery              :: QueryString
diff --git a/Database/Bloodhound/Types/Instances.hs b/Database/Bloodhound/Types/Instances.hs
index a69208b..a60c5a2 100644
--- a/Database/Bloodhound/Types/Instances.hs
+++ b/Database/Bloodhound/Types/Instances.hs
@@ -143,16 +143,25 @@ instance ToJSON Query where
   toJSON (QueryBoolQuery boolQuery) =
     object [ "bool" .= toJSON boolQuery ]
 
+  toJSON (QueryBoostingQuery boostingQuery) =
+    object ["boosting" .= toJSON boostingQuery]
+
 
 mField :: (ToJSON a, Functor f) => T.Text -> f a -> f (T.Text, Value)
 mField field = fmap ((field .=) . toJSON)
 
 
+instance ToJSON BoostingQuery where
+  toJSON (BoostingQuery positiveQuery negativeQuery negativeBoost) =
+    object [ "positive" .= toJSON positiveQuery
+           , "negative" .= toJSON negativeQuery
+           , "negative_boost" .= toJSON negativeBoost ]
+
+
 instance ToJSON BoolQuery where
   toJSON (BoolQuery mustM notM shouldM min boost disableCoord) =
     object filtered
-    where f field = fmap ((field .=) . toJSON)
-          filtered = catMaybes
+    where filtered = catMaybes
                       [ mField "must" mustM
                       , mField "must_not" notM
                       , mField "should" shouldM
diff --git a/tests/tests.hs b/tests/tests.hs
index 0ca87df..7cab33f 100644
--- a/tests/tests.hs
+++ b/tests/tests.hs
@@ -182,6 +182,15 @@ main = hspec $ do
       myTweet <- searchTweet search
       myTweet `shouldBe` Right exampleTweet
 
+    it "returns document for boosting query" $ do
+      _ <- insertData
+      let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
+      let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
+      let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
+      let search = mkSearch (Just query) Nothing
+      myTweet <- searchTweet search
+      myTweet `shouldBe` Right exampleTweet
+
   describe "sorting" $ do
     it "returns documents in the right order" $ do
       _ <- insertData