git.iko.soy/typeable/bloodhound
on master help sign in
mapping, bounding box positive validation, shuffling cache around
8a946b1Chris Allen
Database/Bloodhound/Client.hs+58−9
compare with master
unifiedsplit
@@ -4,6 +4,8 @@ module Database.Bloodhound.Client
4 ( createIndex
4 ( createIndex
5 , deleteIndex
5 , deleteIndex
6 , defaultIndexSettings
6 , defaultIndexSettings
7+ , createMapping
8+ , deleteMapping
7 , indexDocument
9 , indexDocument
8 , getDocument
10 , getDocument
9 , documentExists
11 , documentExists
@@ -26,6 +28,11 @@ module Database.Bloodhound.Client
26 , Seminearring(..)
28 , Seminearring(..)
27 , BoolMatch(..)
29 , BoolMatch(..)
28 , Term(..)
30 , Term(..)
31+ , GeoConstraint(..)
32+ , GeoBoundingBoxConstraint(..)
33+ , GeoBoundingBox(..)
34+ , GeoFilterType(..)
35+ , LatLon(..)
29 )
36 )
30 where
37 where
31
38
@@ -158,6 +165,12 @@ indexExists (Server server) indexName = do
158 return exists where
165 return exists where
159 url = joinPath [server, indexName]
166 url = joinPath [server, indexName]
160
167
168+refreshIndex :: Server -> IndexName -> IO Reply
169+refreshIndex (Server server) indexName = dispatch url method body where
170+ url = joinPath [server, indexName, "_refresh"]
171+ method = NHTM.methodPost
172+ body = Nothing
173+
161data OpenCloseIndex = OpenIndex | CloseIndex deriving (Show)
174data OpenCloseIndex = OpenIndex | CloseIndex deriving (Show)
162
175
163stringifyOCIndex oci = case oci of
176stringifyOCIndex oci = case oci of
@@ -180,6 +193,24 @@ closeIndex = openOrCloseIndexes CloseIndex
180
193
181type MappingName = String
194type MappingName = String
182
195
196+data FieldType = GeoPointType
197+ | GeoShapeType
198+ | FloatType
199+ | IntegerType
200+ | LongType
201+ | ShortType
202+ | ByteType deriving (Eq, Show)
203+
204+data FieldDefinition =
205+ FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)
206+
207+data MappingField =
208+ MappingField { fieldName :: Text
209+ , fieldDefinition :: FieldDefinition } deriving (Eq, Show)
210+
211+data Mapping = Mapping { typeName :: Text
212+ , fields :: [MappingField] } deriving (Eq, Show)
213+
183createMapping :: ToJSON a => Server -> IndexName
214createMapping :: ToJSON a => Server -> IndexName
184 -> MappingName -> a -> IO Reply
215 -> MappingName -> a -> IO Reply
185createMapping (Server server) indexName mappingName mapping =
216createMapping (Server server) indexName mappingName mapping =
@@ -261,12 +292,6 @@ searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
261searchByType (Server server) indexName mappingName search = dispatchSearch url search where
292searchByType (Server server) indexName mappingName search = dispatchSearch url search where
262 url = joinPath [server, indexName, mappingName, "_search"]
293 url = joinPath [server, indexName, mappingName, "_search"]
263
294
264−refreshIndex :: Server -> IndexName -> IO Reply
265−refreshIndex (Server server) indexName = dispatch url method body where
266− url = joinPath [server, indexName, "_refresh"]
267− method = NHTM.methodPost
268− body = Nothing
269−
270data Search = Search { queryBody :: Maybe Query
295data Search = Search { queryBody :: Maybe Query
271 , filterBody :: Maybe Filter } deriving (Show)
296 , filterBody :: Maybe Filter } deriving (Show)
272
297
@@ -340,8 +365,8 @@ data Filter = AndFilter [Filter] Cache
340 | IdentityFilter
365 | IdentityFilter
341 | BoolFilter BoolMatch
366 | BoolFilter BoolMatch
342 | ExistsFilter FieldName -- always cached
367 | ExistsFilter FieldName -- always cached
343− | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache
368+ | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
344− | GeoDistanceFilter GeoConstraint Distance Cache
369+ | GeoDistanceFilter GeoConstraint Distance
345 deriving (Show)
370 deriving (Show)
346
371
347class Monoid a => Seminearring a where
372class Monoid a => Seminearring a where
@@ -374,6 +399,28 @@ instance ToJSON Filter where
374 ["field" .= fieldName]]
399 ["field" .= fieldName]]
375 toJSON (BoolFilter boolMatch) =
400 toJSON (BoolFilter boolMatch) =
376 object ["bool" .= toJSON boolMatch]
401 object ["bool" .= toJSON boolMatch]
402+ toJSON (GeoBoundingBoxFilter bbConstraint filterType) =
403+ object ["geo_bounding_box" .= toJSON bbConstraint
404+ , "type" .= toJSON filterType]
405+
406+instance ToJSON GeoBoundingBoxConstraint where
407+ toJSON (GeoBoundingBoxConstraint geoBBField constraintBox cache) =
408+ object [geoBBField .= toJSON constraintBox
409+ , "_cache" .= cache]
410+
411+instance ToJSON GeoFilterType where
412+ toJSON GeoFilterMemory = "memory"
413+ toJSON GeoFilterIndexed = "indexed"
414+
415+instance ToJSON GeoBoundingBox where
416+ toJSON (GeoBoundingBox topLeft bottomRight) =
417+ object ["top_left" .= toJSON topLeft
418+ , "bottom_right" .= toJSON bottomRight]
419+
420+instance ToJSON LatLon where
421+ toJSON (LatLon lat lon) =
422+ object ["lat" .= lat
423+ , "lon" .= lon]
377
424
378data Term = Term { termField :: Text
425data Term = Term { termField :: Text
379 , termValue :: Text } deriving (Show)
426 , termValue :: Text } deriving (Show)
@@ -397,6 +444,7 @@ instance ToJSON BoolMatch where
397-- "memory" or "indexed"
444-- "memory" or "indexed"
398data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Show)
445data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Show)
399
446
447+
400data LatLon = LatLon { lat :: Double
448data LatLon = LatLon { lat :: Double
401 , lon :: Double } deriving (Show)
449 , lon :: Double } deriving (Show)
402
450
@@ -407,6 +455,7 @@ data GeoBoundingBox =
407data GeoBoundingBoxConstraint =
455data GeoBoundingBoxConstraint =
408 GeoBoundingBoxConstraint { geoBBField :: FieldName
456 GeoBoundingBoxConstraint { geoBBField :: FieldName
409 , constraintBox :: GeoBoundingBox
457 , constraintBox :: GeoBoundingBox
458+ , cache :: Cache
410 } deriving (Show)
459 } deriving (Show)
411
460
412data GeoConstraint =
461data GeoConstraint =
@@ -426,7 +475,7 @@ data DistanceUnits = Miles
426data DistanceType = Arc | SloppyArc | Plane deriving (Show)
475data DistanceType = Arc | SloppyArc | Plane deriving (Show)
427
476
428-- geo_point?
477-- geo_point?
429−data OptimizeBbox = GeoFilterType | NoOptimizeBbox deriving (Show)
478+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType | NoOptimizeBbox deriving (Show)
430
479
431data Distance =
480data Distance =
432 Distance { coefficient :: Double
481 Distance { coefficient :: Double
README.org+11−1
@@ -1,5 +1,15 @@
1+* PRE-ALPHA, THERE IS NOTHING FOR YOU HERE
2+
1* Bloodhound
3* Bloodhound
2
4
3Elasticsearch client and query DSL for Haskell
5Elasticsearch client and query DSL for Haskell
4
6
5−** PRE-ALPHA, THERE IS NOTHING FOR YOU HERE
7+** Possible future functionality
8+
9+Runtime checking for cycles in data structures:
10+
11+check for n > 1 occurrences in DFS:
12+
13+http://hackage.haskell.org/package/stable-maps-0.0.5/docs/System-Mem-StableName-Dynamic.html
14+
15+http://hackage.haskell.org/package/stable-maps-0.0.5/docs/System-Mem-StableName-Dynamic-Map.html
tests/tests.hs+47−15
@@ -16,40 +16,54 @@ import qualified Network.HTTP.Types.Status as NHTS
16import Test.Hspec
16import Test.Hspec
17
17
18
18
19−testServer = Server "http://localhost:9200"
19+testServer = Server "http://localhost:9200"
20−testIndex = "twitter"
20+testIndex = "twitter"
21+testMapping = "tweet"
21validateStatus resp expected = (NHTS.statusCode $ responseStatus resp) `shouldBe` (expected :: Int)
22validateStatus resp expected = (NHTS.statusCode $ responseStatus resp) `shouldBe` (expected :: Int)
22createExampleIndex = createIndex testServer defaultIndexSettings testIndex
23createExampleIndex = createIndex testServer defaultIndexSettings testIndex
23deleteExampleIndex = deleteIndex testServer testIndex
24deleteExampleIndex = deleteIndex testServer testIndex
24
25
26+data Location = Location { lat :: Double
27+ , lon :: Double } deriving (Eq, Generic, Show)
28+
25data Tweet = Tweet { user :: Text
29data Tweet = Tweet { user :: Text
26 , postDate :: UTCTime
30 , postDate :: UTCTime
27− , message :: Text }
31+ , message :: Text
32+ , location :: Location }
28 deriving (Eq, Generic, Show)
33 deriving (Eq, Generic, Show)
29
34
30−instance ToJSON Tweet
35+instance ToJSON Tweet
31instance FromJSON Tweet
36instance FromJSON Tweet
37+instance ToJSON Location
38+instance FromJSON Location
39+
40+data TweetMapping = TweetMapping deriving (Eq, Show)
41+
42+instance ToJSON TweetMapping where
43+ toJSON TweetMapping =
44+ object ["tweet" .=
45+ object ["properties" .=
46+ object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
32
47
33exampleTweet = Tweet { user = "bitemyapp"
48exampleTweet = Tweet { user = "bitemyapp"
34 , postDate = UTCTime
49 , postDate = UTCTime
35 (ModifiedJulianDay 55000)
50 (ModifiedJulianDay 55000)
36 (secondsToDiffTime 10)
51 (secondsToDiffTime 10)
37− , message = "Use haskell!" }
52+ , message = "Use haskell!"
53+ , location = Location 40.12 (-71.34) }
38
54
39insertData :: IO ()
55insertData :: IO ()
40insertData = do
56insertData = do
41 let encoded = encode exampleTweet
57 let encoded = encode exampleTweet
42 _ <- deleteExampleIndex
58 _ <- deleteExampleIndex
43 created <- createExampleIndex
59 created <- createExampleIndex
60+ mappingCreated <- createMapping testServer testIndex testMapping TweetMapping
44− docCreated <- indexDocument (Server "http://localhost:9200") "twitter" "tweet" exampleTweet "1"
61+ docCreated <- indexDocument testServer testIndex testMapping exampleTweet "1"
45− _ <- refreshIndex testServer "twitter"
62+ _ <- refreshIndex testServer testIndex
46 return ()
63 return ()
47
64
48−queryTweet :: IO (Either String Tweet)
65+searchTweet :: Search -> IO (Either String Tweet)
49−queryTweet = do
66+searchTweet search = do
50− let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
51− <&&> IdentityFilter
52− let search = Search Nothing (Just queryFilter)
53 reply <- searchByIndex testServer "twitter" search
67 reply <- searchByIndex testServer "twitter" search
54 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
68 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
55 let myTweet = fmap (hitSource . head . hits . searchHits) result
69 let myTweet = fmap (hitSource . head . hits . searchHits) result
@@ -73,8 +87,26 @@ main = hspec $ do
73 let newTweet = eitherDecode (responseBody docInserted) :: Either String (EsResult Tweet)
87 let newTweet = eitherDecode (responseBody docInserted) :: Either String (EsResult Tweet)
74 fmap _source newTweet `shouldBe` Right exampleTweet
88 fmap _source newTweet `shouldBe` Right exampleTweet
75
89
76− describe "document filtering" $ do
90+ describe "filtering API" $ do
77− it "returns documents expected from composed filters" $ do
91+ it "returns document for composed boolmatch and identity" $ do
92+ _ <- insertData
93+ let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
94+ <&&> IdentityFilter
95+ let search = Search Nothing (Just queryFilter)
96+ myTweet <- searchTweet search
97+ myTweet `shouldBe` Right exampleTweet
98+
99+ it "returns document for existential query" $ do
100+ _ <- insertData
101+ let search = Search Nothing (Just (ExistsFilter "user"))
102+ myTweet <- searchTweet search
103+ myTweet `shouldBe` Right exampleTweet
104+
105+ it "returns document for geo boundingbox query" $ do
78 _ <- insertData
106 _ <- insertData
79− myTweet <- queryTweet
107+ let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
108+ let bbConstraint = GeoBoundingBoxConstraint "tweet.location" box False
109+ let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
110+ let search = Search Nothing (Just geoFilter)
111+ myTweet <- searchTweet search
80 myTweet `shouldBe` Right exampleTweet
112 myTweet `shouldBe` Right exampleTweet