bloodhound 0.1.0.2 → 0.2.0.0
raw patch · 5 files changed
+108/−15 lines, 5 filesdep +QuickCheckdep +semigroupsPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, semigroups
API changes (from Hackage documentation)
- Database.Bloodhound.Client: createMapping :: ToJSON a => Server -> IndexName -> MappingName -> a -> IO Reply
- Database.Bloodhound.Types: RegexpFlags :: Text -> RegexpFlags
- Database.Bloodhound.Types: newtype RegexpFlags
+ Database.Bloodhound.Client: putMapping :: ToJSON a => Server -> IndexName -> MappingName -> a -> IO Reply
+ Database.Bloodhound.Types: AllRegexpFlags :: RegexpFlags
+ Database.Bloodhound.Types: AnyString :: RegexpFlag
+ Database.Bloodhound.Types: Automaton :: RegexpFlag
+ Database.Bloodhound.Types: Complement :: RegexpFlag
+ Database.Bloodhound.Types: Empty :: RegexpFlag
+ Database.Bloodhound.Types: Intersection :: RegexpFlag
+ Database.Bloodhound.Types: Interval :: RegexpFlag
+ Database.Bloodhound.Types: NoRegexpFlags :: RegexpFlags
+ Database.Bloodhound.Types: SomeRegexpFlags :: (NonEmpty RegexpFlag) -> RegexpFlags
+ Database.Bloodhound.Types: TermFilter :: Term -> Cache -> Filter
+ Database.Bloodhound.Types: data RegexpFlag
+ Database.Bloodhound.Types: data RegexpFlags
+ Database.Bloodhound.Types: instance Eq RegexpFlag
+ Database.Bloodhound.Types: instance Show RegexpFlag
- Database.Bloodhound.Types: class Monoid a => Seminearring a where (<&&>) = mappend
+ Database.Bloodhound.Types: class Monoid a => Seminearring a where <&&> = mappend
- Database.Bloodhound.Types.Class: class Monoid a => Seminearring a where (<&&>) = mappend
+ Database.Bloodhound.Types.Class: class Monoid a => Seminearring a where <&&> = mappend
- Database.Bloodhound.Types.Instances: class Monoid a => Seminearring a where (<&&>) = mappend
+ Database.Bloodhound.Types.Instances: class Monoid a => Seminearring a where <&&> = mappend
Files
- Database/Bloodhound/Client.hs +7/−3
- Database/Bloodhound/Types.hs +19/−2
- Database/Bloodhound/Types/Instances.hs +20/−5
- bloodhound.cabal +5/−2
- tests/tests.hs +57/−3
Database/Bloodhound/Client.hs view
@@ -4,7 +4,7 @@ , indexExists , openIndex , closeIndex- , createMapping+ , putMapping , deleteMapping , indexDocument , getDocument@@ -138,9 +138,12 @@ closeIndex :: Server -> IndexName -> IO Reply closeIndex = openOrCloseIndexes CloseIndex -createMapping :: ToJSON a => Server -> IndexName+{-| putMapping is an HTTP PUT and has upsert semantics. Mappings are schemas+ for documents in indexes.+-}+putMapping :: ToJSON a => Server -> IndexName -> MappingName -> a -> IO Reply-createMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =+putMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping = put url body where url = joinPath [server, indexName, mappingName, "_mapping"] body = Just $ encode mapping@@ -149,6 +152,7 @@ deleteMapping (Server server) (IndexName indexName) (MappingName mappingName) = delete $ joinPath [server, indexName, mappingName, "_mapping"]+ indexDocument :: ToJSON doc => Server -> IndexName -> MappingName -> doc -> DocId -> IO Reply indexDocument (Server server) (IndexName indexName)
Database/Bloodhound/Types.hs view
@@ -60,6 +60,7 @@ , GreaterThanEq(..) , Regexp(..) , RegexpFlags(..)+ , RegexpFlag(..) , FieldName(..) , IndexName(..) , MappingName(..)@@ -144,6 +145,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as L+import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime)@@ -186,7 +188,7 @@ defaultIndexSettings :: IndexSettings defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2) -{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method' -}+{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -} type Reply = Network.HTTP.Client.Response L.ByteString type Method = NHTM.Method @@ -213,6 +215,10 @@ {-| Support for type reification of 'Mapping's is currently incomplete, for now the mapping API verbiage expects a 'ToJSON'able blob.++ Indexes have mappings, mappings are schemas for the documents contained in the+ index. I'd recommend having only one mapping per index, always having a mapping,+ and keeping different kinds of documents separated if possible. -} data Mapping = Mapping { typeName :: TypeName , mappingFields :: [MappingField] } deriving (Eq, Show)@@ -795,6 +801,7 @@ | PrefixFilter FieldName PrefixValue Cache | RangeFilter FieldName (Either HalfRange Range) RangeExecution Cache | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey+ | TermFilter Term Cache deriving (Eq, Show) data ZeroTermsQuery = ZeroTermsNone@@ -820,7 +827,17 @@ | RangeExecutionFielddata deriving (Eq, Show) newtype Regexp = Regexp Text deriving (Eq, Show)-newtype RegexpFlags = RegexpFlags Text deriving (Eq, Show)++data RegexpFlags = AllRegexpFlags+ | NoRegexpFlags+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)++data RegexpFlag = AnyString+ | Automaton+ | Complement+ | Empty+ | Intersection+ | Interval deriving (Eq, Show) halfRangeToKV :: HalfRange -> (Text, Double) halfRangeToKV (HalfRangeLt (LessThan n)) = ("lt", n)
Database/Bloodhound/Types/Instances.hs view
@@ -8,6 +8,8 @@ import Control.Applicative import Data.Aeson+import Data.List (nub)+import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (catMaybes) import Data.Monoid import qualified Data.Text as T@@ -39,6 +41,11 @@ toJSON (IdentityFilter) = object ["match_all" .= object []] + toJSON (TermFilter (Term termFilterField termFilterValue) cache) =+ object ["term" .= object base]+ where base = [termFilterField .= termFilterValue,+ "_cache" .= cache]+ toJSON (ExistsFilter (FieldName fieldName)) = object ["exists" .= object ["field" .= fieldName]]@@ -57,7 +64,7 @@ , "distance_type" .= toJSON distanceType , "optimize_bbox" .= optimizeBbox , distanceGeoField .= toJSON geoDistLatLon- , "_cache" .= cache]] + , "_cache" .= cache]] toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon) (DistanceRange geoDistRangeDistFrom drDistanceTo)) =@@ -213,7 +220,7 @@ toJSON (QueryRangeQuery query) = object [ "range" .= toJSON query ] - toJSON (QueryRegexpQuery query) = + toJSON (QueryRegexpQuery query) = object [ "regexp" .= toJSON query ] toJSON (QuerySimpleQueryStringQuery query) =@@ -645,7 +652,7 @@ instance ToJSON SortOrder where- toJSON Ascending = String "asc" + toJSON Ascending = String "asc" toJSON Descending = String "desc" @@ -731,8 +738,16 @@ instance ToJSON RegexpFlags where- toJSON (RegexpFlags txt) = String txt-+ toJSON AllRegexpFlags = String "ALL"+ toJSON NoRegexpFlags = String "NONE"+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs+ where flagStrs = map flagStr . nub $ h:fs+ flagStr AnyString = "ANYSTRING"+ flagStr Automaton = "AUTOMATON"+ flagStr Complement = "COMPLEMENT"+ flagStr Empty = "EMPTY"+ flagStr Intersection = "INTERSECTION"+ flagStr Interval = "INTERVAL" instance ToJSON Term where toJSON (Term field value) = object ["term" .= object
bloodhound.cabal view
@@ -1,5 +1,5 @@ name: bloodhound-version: 0.1.0.2+version: 0.2.0.0 synopsis: ElasticSearch client library for Haskell description: ElasticSearch made awesome for Haskell hackers homepage: https://github.com/bitemyapp/bloodhound@@ -29,6 +29,7 @@ aeson >= 0.7, conduit >= 1.0, http-client >= 0.3,+ semigroups >= 0.15, time >= 1.4, text >= 0.11, http-types >= 0.8@@ -47,5 +48,7 @@ hspec >= 1.8, text >= 0.11, time >= 1.4,- aeson >= 0.7+ aeson >= 0.7,+ semigroups >= 0.15,+ QuickCheck default-language: Haskell2010
tests/tests.hs view
@@ -1,17 +1,24 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-} module Main where +import Control.Applicative import Database.Bloodhound import Data.Aeson+import Data.List (nub)+import Data.List.NonEmpty (NonEmpty(..)) import Data.Time.Calendar (Day(..)) import Data.Time.Clock (secondsToDiffTime, UTCTime(..)) import Data.Text (Text)+import qualified Data.Text as T import GHC.Generics (Generic) import Network.HTTP.Client import qualified Network.HTTP.Types.Status as NHTS import Prelude hiding (filter, putStrLn) import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck testServer :: Server testServer = Server "http://localhost:9200"@@ -75,7 +82,7 @@ insertData = do _ <- deleteExampleIndex _ <- createExampleIndex- _ <- createMapping testServer testIndex testMapping TweetMapping+ _ <- putMapping testServer testIndex testMapping TweetMapping _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1") _ <- refreshIndex testServer testIndex return ()@@ -104,6 +111,27 @@ instance FromJSON BulkTest instance ToJSON BulkTest +noDuplicates :: Eq a => [a] -> Bool+noDuplicates xs = nub xs == xs++instance Arbitrary RegexpFlags where+ arbitrary = oneof [ pure AllRegexpFlags+ , pure NoRegexpFlags+ , SomeRegexpFlags <$> arbitrary+ ]++instance Arbitrary a => Arbitrary (NonEmpty a) where+ arbitrary = liftA2 (:|) arbitrary arbitrary++instance Arbitrary RegexpFlag where+ arbitrary = oneof [ pure AnyString+ , pure Automaton+ , pure Complement+ , pure Empty+ , pure Intersection+ , pure Interval+ ]+ main :: IO () main = hspec $ do @@ -224,6 +252,13 @@ myTweet <- searchTweet search myTweet `shouldBe` Right exampleTweet + it "returns document for term filter" $ do+ _ <- insertData+ let termFilter = TermFilter (Term "user" "bitemyapp") False+ let search = mkSearch Nothing (Just termFilter)+ myTweet <- searchTweet search+ myTweet `shouldBe` Right exampleTweet+ it "returns document for existential filter" $ do _ <- insertData let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))@@ -314,7 +349,7 @@ it "returns document for regexp filter" $ do _ <- insertData let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")- (RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")+ AllRegexpFlags (CacheName "test") False (CacheKey "key") let search = mkSearch Nothing (Just filter) myTweet <- searchTweet search myTweet `shouldBe` Right exampleTweet@@ -322,7 +357,26 @@ it "doesn't return document for non-matching regexp filter" $ do _ <- insertData let filter = RegexpFilter (FieldName "user")- (Regexp "boy") (RegexpFlags "ALL")+ (Regexp "boy") AllRegexpFlags (CacheName "test") False (CacheKey "key") let search = mkSearch Nothing (Just filter) searchExpectNoResults search+ describe "ToJSON RegexpFlags" $ do+ it "generates the correct JSON for AllRegexpFlags" $+ toJSON AllRegexpFlags `shouldBe` String "ALL"++ it "generates the correct JSON for NoRegexpFlags" $+ toJSON NoRegexpFlags `shouldBe` String "NONE"++ it "generates the correct JSON for SomeRegexpFlags" $+ let flags = AnyString :| [ Automaton+ , Complement+ , Empty+ , Intersection+ , Interval ]+ in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"++ prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->+ let String str = toJSON flags+ flagStrs = T.splitOn "|" str+ in noDuplicates flagStrs