diff --git a/bloodhound.cabal b/bloodhound.cabal index bc0a0b5..8c85fa2 100644 --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -62,7 +62,8 @@ test-suite tests QuickCheck, vector, unordered-containers >= 0.2.5.0 && <0.3, - mtl + mtl, + quickcheck-properties default-language: Haskell2010 test-suite doctests diff --git a/src/Database/Bloodhound/Types.hs b/src/Database/Bloodhound/Types.hs index c208cb8..f6cf1ce 100644 --- a/src/Database/Bloodhound/Types.hs +++ b/src/Database/Bloodhound/Types.hs @@ -1125,6 +1125,13 @@ data SearchHits a = , maxScore :: Score , hits :: [Hit a] } deriving (Eq, Show) + +instance Monoid (SearchHits a) where + mempty = SearchHits 0 Nothing mempty + mappend (SearchHits ta ma ha) (SearchHits tb mb hb) = + SearchHits (ta + tb) (max ma mb) (ha <> hb) + + data Hit a = Hit { hitIndex :: IndexName , hitType :: MappingName diff --git a/tests/tests.hs b/tests/tests.hs index e08efdf..65b8862 100644 --- a/tests/tests.hs +++ b/tests/tests.hs @@ -1,31 +1,33 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} - +{-# OPTIONS_GHC -fno-warn-orphans #-} module Main where import Control.Applicative import Control.Monad import Control.Monad.Reader import Data.Aeson -import qualified Data.HashMap.Strict as HM -import Data.List (nub) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as M -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time.Calendar (Day (..)) -import Data.Time.Clock (UTCTime (..), secondsToDiffTime) -import qualified Data.Vector as V +import qualified Data.HashMap.Strict as HM +import Data.List (nub) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as M +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day (..)) +import Data.Time.Clock (UTCTime (..), + secondsToDiffTime) +import qualified Data.Vector as V import Database.Bloodhound -import GHC.Generics (Generic) +import GHC.Generics (Generic) import Network.HTTP.Client -import qualified Network.HTTP.Types.Status as NHTS -import Prelude hiding (filter, putStrLn) +import qualified Network.HTTP.Types.Status as NHTS +import Prelude hiding (filter, putStrLn) import Test.Hspec +import Test.QuickCheck.Property.Monoid -import Test.Hspec.QuickCheck (prop) +import Test.Hspec.QuickCheck (prop) import Test.QuickCheck testServer :: Server @@ -224,6 +226,40 @@ instance Arbitrary RegexpFlag where , pure Interval ] +arbitraryScore :: Gen Score +arbitraryScore = fmap getPositive <$> arbitrary + +instance Arbitrary Text where + arbitrary = T.pack <$> arbitrary + +instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where + arbitrary = M.fromList <$> arbitrary + +instance Arbitrary IndexName where + arbitrary = IndexName <$> arbitrary + +instance Arbitrary MappingName where + arbitrary = MappingName <$> arbitrary + +instance Arbitrary DocId where + arbitrary = DocId <$> arbitrary + +instance Arbitrary a => Arbitrary (Hit a) where + arbitrary = Hit <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitraryScore + <*> arbitrary + <*> arbitrary + + +instance Arbitrary a => Arbitrary (SearchHits a) where + arbitrary = do + tot <- getPositive <$> arbitrary + score <- arbitraryScore + hs <- arbitrary + return $ SearchHits tot score hs + main :: IO () main = hspec $ do @@ -610,4 +646,7 @@ main = hspec $ do let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int)) , "test2" .= (toJSON ("some value" :: Text))] in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0) - , ("test2", String "some value")]) + , ("test2", String "some value")]) + describe "Monoid (SearchHits a)" $ do + prop "abides the monoid laws" $ eq $ + prop_Monoid (T :: T (SearchHits ()))