diff --git a/Database/Bloodhound/Client.hs b/Database/Bloodhound/Client.hs --- a/Database/Bloodhound/Client.hs +++ b/Database/Bloodhound/Client.hs @@ -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) diff --git a/Database/Bloodhound/Types.hs b/Database/Bloodhound/Types.hs --- a/Database/Bloodhound/Types.hs +++ b/Database/Bloodhound/Types.hs @@ -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) diff --git a/Database/Bloodhound/Types/Instances.hs b/Database/Bloodhound/Types/Instances.hs --- a/Database/Bloodhound/Types/Instances.hs +++ b/Database/Bloodhound/Types/Instances.hs @@ -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 diff --git a/bloodhound.cabal b/bloodhound.cabal --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -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 diff --git a/tests/tests.hs b/tests/tests.hs --- a/tests/tests.hs +++ b/tests/tests.hs @@ -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