git.iko.soy/typeable/bloodhound
on master help sign in
Add Monoid instance for Search Hits
7f237c4Michael Xavier
bloodhound.cabal+2−1
compare with master
unifiedsplit
@@ -62,7 +62,8 @@ test-suite tests
62 QuickCheck,
62 QuickCheck,
63 vector,
63 vector,
64 unordered-containers >= 0.2.5.0 && <0.3,
64 unordered-containers >= 0.2.5.0 && <0.3,
65− mtl
65+ mtl,
66+ quickcheck-properties
66 default-language: Haskell2010
67 default-language: Haskell2010
67
68
68test-suite doctests
69test-suite doctests
src/Database/Bloodhound/Types.hs+7
@@ -1125,6 +1125,13 @@ data SearchHits a =
1125 , maxScore :: Score
1125 , maxScore :: Score
1126 , hits :: [Hit a] } deriving (Eq, Show)
1126 , hits :: [Hit a] } deriving (Eq, Show)
1127
1127
1128+
1129+instance Monoid (SearchHits a) where
1130+ mempty = SearchHits 0 Nothing mempty
1131+ mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1132+ SearchHits (ta + tb) (max ma mb) (ha <> hb)
1133+
1134+
1128data Hit a =
1135data Hit a =
1129 Hit { hitIndex :: IndexName
1136 Hit { hitIndex :: IndexName
1130 , hitType :: MappingName
1137 , hitType :: MappingName
tests/tests.hs+55−16
@@ -1,31 +1,33 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4−
4+{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Main where
5module Main where
6
6
7import Control.Applicative
7import Control.Applicative
8import Control.Monad
8import Control.Monad
9import Control.Monad.Reader
9import Control.Monad.Reader
10import Data.Aeson
10import Data.Aeson
11−import qualified Data.HashMap.Strict as HM
11+import qualified Data.HashMap.Strict as HM
12−import Data.List (nub)
12+import Data.List (nub)
13−import Data.List.NonEmpty (NonEmpty (..))
13+import Data.List.NonEmpty (NonEmpty (..))
14−import qualified Data.List.NonEmpty as NE
14+import qualified Data.List.NonEmpty as NE
15−import qualified Data.Map.Strict as M
15+import qualified Data.Map.Strict as M
16−import Data.Text (Text)
16+import Data.Text (Text)
17−import qualified Data.Text as T
17+import qualified Data.Text as T
18−import Data.Time.Calendar (Day (..))
18+import Data.Time.Calendar (Day (..))
19−import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
19+import Data.Time.Clock (UTCTime (..),
20+ secondsToDiffTime)
20−import qualified Data.Vector as V
21+import qualified Data.Vector as V
21import Database.Bloodhound
22import Database.Bloodhound
22−import GHC.Generics (Generic)
23+import GHC.Generics (Generic)
23import Network.HTTP.Client
24import Network.HTTP.Client
24−import qualified Network.HTTP.Types.Status as NHTS
25+import qualified Network.HTTP.Types.Status as NHTS
25−import Prelude hiding (filter, putStrLn)
26+import Prelude hiding (filter, putStrLn)
26import Test.Hspec
27import Test.Hspec
28+import Test.QuickCheck.Property.Monoid
27
29
28−import Test.Hspec.QuickCheck (prop)
30+import Test.Hspec.QuickCheck (prop)
29import Test.QuickCheck
31import Test.QuickCheck
30
32
31testServer :: Server
33testServer :: Server
@@ -224,6 +226,40 @@ instance Arbitrary RegexpFlag where
224 , pure Interval
226 , pure Interval
225 ]
227 ]
226
228
229+arbitraryScore :: Gen Score
230+arbitraryScore = fmap getPositive <$> arbitrary
231+
232+instance Arbitrary Text where
233+ arbitrary = T.pack <$> arbitrary
234+
235+instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
236+ arbitrary = M.fromList <$> arbitrary
237+
238+instance Arbitrary IndexName where
239+ arbitrary = IndexName <$> arbitrary
240+
241+instance Arbitrary MappingName where
242+ arbitrary = MappingName <$> arbitrary
243+
244+instance Arbitrary DocId where
245+ arbitrary = DocId <$> arbitrary
246+
247+instance Arbitrary a => Arbitrary (Hit a) where
248+ arbitrary = Hit <$> arbitrary
249+ <*> arbitrary
250+ <*> arbitrary
251+ <*> arbitraryScore
252+ <*> arbitrary
253+ <*> arbitrary
254+
255+
256+instance Arbitrary a => Arbitrary (SearchHits a) where
257+ arbitrary = do
258+ tot <- getPositive <$> arbitrary
259+ score <- arbitraryScore
260+ hs <- arbitrary
261+ return $ SearchHits tot score hs
262+
227main :: IO ()
263main :: IO ()
228main = hspec $ do
264main = hspec $ do
229
265
@@ -610,4 +646,7 @@ main = hspec $ do
610 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
646 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
611 , "test2" .= (toJSON ("some value" :: Text))]
647 , "test2" .= (toJSON ("some value" :: Text))]
612 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
648 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
613− , ("test2", String "some value")])
649+ , ("test2", String "some value")])
650+ describe "Monoid (SearchHits a)" $ do
651+ prop "abides the monoid laws" $ eq $
652+ prop_Monoid (T :: T (SearchHits ()))