packages feed

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 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