git.iko.soy/typeable/bloodhound
on master help sign in
mapping, bounding box positive validation, shuffling cache around
commit8a946b1ea377e200231a23032e4e83aca4ed00bd authorChris Allen <cma@bitemyapp.com> dateThu 10 Apr 2014, 16:39 (13 years ago) parentef50fc2
3 files changed+116−25
compare with master
unifiedsplit
Database/Bloodhound/Client.hs+58−9 README.org+11−1 tests/tests.hs+47−15
Database/Bloodhound/Client.hs+58−9
@@ -4,6 +4,8 @@ module Database.Bloodhound.Client
44 ( createIndex
55 , deleteIndex
66 , defaultIndexSettings
7+ , createMapping
8+ , deleteMapping
79 , indexDocument
810 , getDocument
911 , documentExists
@@ -26,6 +28,11 @@ module Database.Bloodhound.Client
2628 , Seminearring(..)
2729 , BoolMatch(..)
2830 , Term(..)
31+ , GeoConstraint(..)
32+ , GeoBoundingBoxConstraint(..)
33+ , GeoBoundingBox(..)
34+ , GeoFilterType(..)
35+ , LatLon(..)
2936 )
3037 where
3138
@@ -158,6 +165,12 @@ indexExists (Server server) indexName = do
158165 return exists where
159166 url = joinPath [server, indexName]
160167
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+
161174data OpenCloseIndex = OpenIndex | CloseIndex deriving (Show)
162175
163176stringifyOCIndex oci = case oci of
@@ -180,6 +193,24 @@ closeIndex = openOrCloseIndexes CloseIndex
180193
181194type MappingName = String
182195
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+
183214createMapping :: ToJSON a => Server -> IndexName
184215 -> MappingName -> a -> IO Reply
185216createMapping (Server server) indexName mappingName mapping =
@@ -261,12 +292,6 @@ searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
261292searchByType (Server server) indexName mappingName search = dispatchSearch url search where
262293 url = joinPath [server, indexName, mappingName, "_search"]
263294
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−
270295data Search = Search { queryBody :: Maybe Query
271296 , filterBody :: Maybe Filter } deriving (Show)
272297
@@ -340,8 +365,8 @@ data Filter = AndFilter [Filter] Cache
340365 | IdentityFilter
341366 | BoolFilter BoolMatch
342367 | ExistsFilter FieldName -- always cached
343− | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache
344− | GeoDistanceFilter GeoConstraint Distance Cache
368+ | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType
369+ | GeoDistanceFilter GeoConstraint Distance
345370 deriving (Show)
346371
347372class Monoid a => Seminearring a where
@@ -374,6 +399,28 @@ instance ToJSON Filter where
374399 ["field" .= fieldName]]
375400 toJSON (BoolFilter boolMatch) =
376401 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]
377424
378425data Term = Term { termField :: Text
379426 , termValue :: Text } deriving (Show)
@@ -397,6 +444,7 @@ instance ToJSON BoolMatch where
397444-- "memory" or "indexed"
398445data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Show)
399446
447+
400448data LatLon = LatLon { lat :: Double
401449 , lon :: Double } deriving (Show)
402450
@@ -407,6 +455,7 @@ data GeoBoundingBox =
407455data GeoBoundingBoxConstraint =
408456 GeoBoundingBoxConstraint { geoBBField :: FieldName
409457 , constraintBox :: GeoBoundingBox
458+ , cache :: Cache
410459 } deriving (Show)
411460
412461data GeoConstraint =
@@ -426,7 +475,7 @@ data DistanceUnits = Miles
426475data DistanceType = Arc | SloppyArc | Plane deriving (Show)
427476
428477-- geo_point?
429−data OptimizeBbox = GeoFilterType | NoOptimizeBbox deriving (Show)
478+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType | NoOptimizeBbox deriving (Show)
430479
431480data Distance =
432481 Distance { coefficient :: Double
README.org+11−1
@@ -1,5 +1,15 @@
1+* PRE-ALPHA, THERE IS NOTHING FOR YOU HERE
2+
13* Bloodhound
24
35Elasticsearch client and query DSL for Haskell
46
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
1616import Test.Hspec
1717
1818
19−testServer = Server "http://localhost:9200"
20−testIndex = "twitter"
19+testServer = Server "http://localhost:9200"
20+testIndex = "twitter"
21+testMapping = "tweet"
2122validateStatus resp expected = (NHTS.statusCode $ responseStatus resp) `shouldBe` (expected :: Int)
2223createExampleIndex = createIndex testServer defaultIndexSettings testIndex
2324deleteExampleIndex = deleteIndex testServer testIndex
2425
26+data Location = Location { lat :: Double
27+ , lon :: Double } deriving (Eq, Generic, Show)
28+
2529data Tweet = Tweet { user :: Text
2630 , postDate :: UTCTime
27− , message :: Text }
31+ , message :: Text
32+ , location :: Location }
2833 deriving (Eq, Generic, Show)
2934
30−instance ToJSON Tweet
35+instance ToJSON Tweet
3136instance 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)]]]]
3247
3348exampleTweet = Tweet { user = "bitemyapp"
3449 , postDate = UTCTime
3550 (ModifiedJulianDay 55000)
3651 (secondsToDiffTime 10)
37− , message = "Use haskell!" }
52+ , message = "Use haskell!"
53+ , location = Location 40.12 (-71.34) }
3854
3955insertData :: IO ()
4056insertData = do
4157 let encoded = encode exampleTweet
4258 _ <- deleteExampleIndex
4359 created <- createExampleIndex
44− docCreated <- indexDocument (Server "http://localhost:9200") "twitter" "tweet" exampleTweet "1"
45− _ <- refreshIndex testServer "twitter"
60+ mappingCreated <- createMapping testServer testIndex testMapping TweetMapping
61+ docCreated <- indexDocument testServer testIndex testMapping exampleTweet "1"
62+ _ <- refreshIndex testServer testIndex
4663 return ()
4764
48−queryTweet :: IO (Either String Tweet)
49−queryTweet = do
50− let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
51− <&&> IdentityFilter
52− let search = Search Nothing (Just queryFilter)
65+searchTweet :: Search -> IO (Either String Tweet)
66+searchTweet search = do
5367 reply <- searchByIndex testServer "twitter" search
5468 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
5569 let myTweet = fmap (hitSource . head . hits . searchHits) result
@@ -73,8 +87,26 @@ main = hspec $ do
7387 let newTweet = eitherDecode (responseBody docInserted) :: Either String (EsResult Tweet)
7488 fmap _source newTweet `shouldBe` Right exampleTweet
7589
76− describe "document filtering" $ do
77− it "returns documents expected from composed filters" $ do
90+ describe "filtering API" $ 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
78106 _ <- 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
80112 myTweet `shouldBe` Right exampleTweet