git.iko.soy/typeable/bloodhound
on master help sign in
more type-safety and paranoid. Bulk operations...maybe?
c080849Chris Allen
Database/Bloodhound/Client.hs+62−33
compare with master
unifiedsplit
@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveGeneric #-}
1+{-# LANGUAGE DeriveGeneric, ExistentialQuantification #-}
2
2
3module Database.Bloodhound.Client
3module Database.Bloodhound.Client
4 ( createIndex
4 ( createIndex
@@ -49,6 +49,9 @@ module Database.Bloodhound.Client
49 , Regexp(..)
49 , Regexp(..)
50 , RegexpFlags(..)
50 , RegexpFlags(..)
51 , FieldName(..)
51 , FieldName(..)
52+ , IndexName(..)
53+ , MappingName(..)
54+ , DocId(..)
52 , CacheName(..)
55 , CacheName(..)
53 , CacheKey(..)
56 , CacheKey(..)
54 )
57 )
@@ -146,8 +149,6 @@ dispatch url method body = do
146 , checkStatus = \_ _ _ -> Nothing}
149 , checkStatus = \_ _ _ -> Nothing}
147 withManager $ httpLbs req
150 withManager $ httpLbs req
148
151
149−type IndexName = String
150−
151joinPath :: [String] -> String
152joinPath :: [String] -> String
152joinPath = intercalate "/"
153joinPath = intercalate "/"
153
154
@@ -158,14 +159,14 @@ getStatus (Server server) = do
158 return $ decode (responseBody response)
159 return $ decode (responseBody response)
159
160
160createIndex :: Server -> IndexSettings -> IndexName -> IO Reply
161createIndex :: Server -> IndexSettings -> IndexName -> IO Reply
161−createIndex (Server server) indexSettings indexName =
162+createIndex (Server server) indexSettings (IndexName indexName) =
162 dispatch url method body where
163 dispatch url method body where
163 url = joinPath [server, indexName]
164 url = joinPath [server, indexName]
164 method = NHTM.methodPut
165 method = NHTM.methodPut
165 body = Just $ encode indexSettings
166 body = Just $ encode indexSettings
166
167
167deleteIndex :: Server -> IndexName -> IO Reply
168deleteIndex :: Server -> IndexName -> IO Reply
168−deleteIndex (Server server) indexName =
169+deleteIndex (Server server) (IndexName indexName) =
169 dispatch url method body where
170 dispatch url method body where
170 url = joinPath [server, indexName]
171 url = joinPath [server, indexName]
171 method = NHTM.methodDelete
172 method = NHTM.methodDelete
@@ -179,13 +180,13 @@ existentialQuery url = do
179 return (reply, respIsTwoHunna reply)
180 return (reply, respIsTwoHunna reply)
180
181
181indexExists :: Server -> IndexName -> IO Bool
182indexExists :: Server -> IndexName -> IO Bool
182−indexExists (Server server) indexName = do
183+indexExists (Server server) (IndexName indexName) = do
183 (reply, exists) <- existentialQuery url
184 (reply, exists) <- existentialQuery url
184 return exists where
185 return exists where
185 url = joinPath [server, indexName]
186 url = joinPath [server, indexName]
186
187
187refreshIndex :: Server -> IndexName -> IO Reply
188refreshIndex :: Server -> IndexName -> IO Reply
188−refreshIndex (Server server) indexName = dispatch url method body where
189+refreshIndex (Server server) (IndexName indexName) = dispatch url method body where
189 url = joinPath [server, indexName, "_refresh"]
190 url = joinPath [server, indexName, "_refresh"]
190 method = NHTM.methodPost
191 method = NHTM.methodPost
191 body = Nothing
192 body = Nothing
@@ -197,7 +198,7 @@ stringifyOCIndex oci = case oci of
197 CloseIndex -> "_close"
198 CloseIndex -> "_close"
198
199
199openOrCloseIndexes :: OpenCloseIndex -> Server -> IndexName -> IO Reply
200openOrCloseIndexes :: OpenCloseIndex -> Server -> IndexName -> IO Reply
200−openOrCloseIndexes oci (Server server) indexName =
201+openOrCloseIndexes oci (Server server) (IndexName indexName) =
201 dispatch url method body where
202 dispatch url method body where
202 ociString = stringifyOCIndex oci
203 ociString = stringifyOCIndex oci
203 url = joinPath [server, indexName, ociString]
204 url = joinPath [server, indexName, ociString]
@@ -210,8 +211,6 @@ openIndex = openOrCloseIndexes OpenIndex
210closeIndex :: Server -> IndexName -> IO Reply
211closeIndex :: Server -> IndexName -> IO Reply
211closeIndex = openOrCloseIndexes CloseIndex
212closeIndex = openOrCloseIndexes CloseIndex
212
213
213−type MappingName = String
214−
215data FieldType = GeoPointType
214data FieldType = GeoPointType
216 | GeoShapeType
215 | GeoShapeType
217 | FloatType
216 | FloatType
@@ -232,37 +231,56 @@ data Mapping = Mapping { typeName :: Text
232
231
233createMapping :: ToJSON a => Server -> IndexName
232createMapping :: ToJSON a => Server -> IndexName
234 -> MappingName -> a -> IO Reply
233 -> MappingName -> a -> IO Reply
235−createMapping (Server server) indexName mappingName mapping =
234+createMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
236 dispatch url method body where
235 dispatch url method body where
237 url = joinPath [server, indexName, mappingName, "_mapping"]
236 url = joinPath [server, indexName, mappingName, "_mapping"]
238 method = NHTM.methodPut
237 method = NHTM.methodPut
239 body = Just $ encode mapping
238 body = Just $ encode mapping
240
239
241deleteMapping :: Server -> IndexName -> MappingName -> IO Reply
240deleteMapping :: Server -> IndexName -> MappingName -> IO Reply
242−deleteMapping (Server server) indexName mappingName =
241+deleteMapping (Server server) (IndexName indexName) (MappingName mappingName) =
243 dispatch url method body where
242 dispatch url method body where
244 url = joinPath [server, indexName, mappingName, "_mapping"]
243 url = joinPath [server, indexName, mappingName, "_mapping"]
245 method = NHTM.methodDelete
244 method = NHTM.methodDelete
246 body = Nothing
245 body = Nothing
247
246
248−type DocumentID = String
249−
250indexDocument :: ToJSON doc => Server -> IndexName -> MappingName
247indexDocument :: ToJSON doc => Server -> IndexName -> MappingName
251− -> doc -> DocumentID -> IO Reply
248+ -> doc -> DocId -> IO Reply
252−indexDocument (Server server) indexName mappingName document docId =
249+indexDocument (Server server) (IndexName indexName)
250+ (MappingName mappingName) document (DocId docId) =
253 dispatch url method body where
251 dispatch url method body where
254 url = joinPath [server, indexName, mappingName, docId]
252 url = joinPath [server, indexName, mappingName, docId]
255 method = NHTM.methodPut
253 method = NHTM.methodPut
256 body = Just (encode document)
254 body = Just (encode document)
257
255
258deleteDocument :: Server -> IndexName -> MappingName
256deleteDocument :: Server -> IndexName -> MappingName
259− -> DocumentID -> IO Reply
257+ -> DocId -> IO Reply
260−deleteDocument (Server server) indexName mappingName docId =
258+deleteDocument (Server server) (IndexName indexName)
259+ (MappingName mappingName) (DocId docId) =
261 dispatch url method body where
260 dispatch url method body where
262 url = joinPath [server, indexName, mappingName, docId]
261 url = joinPath [server, indexName, mappingName, docId]
263 method = NHTM.methodDelete
262 method = NHTM.methodDelete
264 body = Nothing
263 body = Nothing
265
264
265+-- bulk :: Server -> [BulkOperation a] -> IO Reply
266+-- bulk (Server server) bulkOps = dispatch url method body where
267+-- url = joinPath [server, "_bulk"]
268+-- method = NHTM.methodPost
269+-- body = Just (L.intercalate "\n" . fmap encode $ bulkOps)
270+
271+data BulkOperation a =
272+ forall a. ToJSON a =>
273+ BulkIndex (AssociatedDocument a)
274+ | BulkCreate (AssociatedDocument a)
275+ | BulkDelete Association
276+ | BulkUpdate (AssociatedDocument a)
277+
278+data Placement = Placement IndexName MappingName deriving (Eq, Show)
279+data Association = Association Placement DocId deriving (Eq, Show)
280+
281+data AssociatedDocument a =
282+ forall a. ToJSON a => Associate Association a
283+
266data EsResult a = EsResult { _index :: Text
284data EsResult a = EsResult { _index :: Text
267 , _type :: Text
285 , _type :: Text
268 , _id :: Text
286 , _id :: Text
@@ -281,16 +299,16 @@ instance (FromJSON a, ToJSON a) => FromJSON (EsResult a) where
281 parseJSON _ = empty
299 parseJSON _ = empty
282
300
283getDocument :: Server -> IndexName -> MappingName
301getDocument :: Server -> IndexName -> MappingName
284− -> DocumentID -> IO Reply
302+ -> DocId -> IO Reply
285−getDocument (Server server) indexName mappingName docId =
303+getDocument (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) =
286 dispatch url method body where
304 dispatch url method body where
287 url = joinPath [server, indexName, mappingName, docId]
305 url = joinPath [server, indexName, mappingName, docId]
288 method = NHTM.methodGet
306 method = NHTM.methodGet
289 body = Nothing
307 body = Nothing
290
308
291documentExists :: Server -> IndexName -> MappingName
309documentExists :: Server -> IndexName -> MappingName
292− -> DocumentID -> IO Bool
310+ -> DocId -> IO Bool
293−documentExists (Server server) indexName mappingName docId = do
311+documentExists (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) = do
294 (reply, exists) <- existentialQuery url
312 (reply, exists) <- existentialQuery url
295 return exists where
313 return exists where
296 url = joinPath [server, indexName, mappingName, docId]
314 url = joinPath [server, indexName, mappingName, docId]
@@ -304,11 +322,12 @@ searchAll (Server server) search = dispatchSearch url search where
304 url = joinPath [server, "_search"]
322 url = joinPath [server, "_search"]
305
323
306searchByIndex :: Server -> IndexName -> Search -> IO Reply
324searchByIndex :: Server -> IndexName -> Search -> IO Reply
307−searchByIndex (Server server) indexName search = dispatchSearch url search where
325+searchByIndex (Server server) (IndexName indexName) search = dispatchSearch url search where
308 url = joinPath [server, indexName, "_search"]
326 url = joinPath [server, indexName, "_search"]
309
327
310searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
328searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
329+searchByType (Server server) (IndexName indexName)
311−searchByType (Server server) indexName mappingName search = dispatchSearch url search where
330+ (MappingName mappingName) search = dispatchSearch url search where
312 url = joinPath [server, indexName, mappingName, "_search"]
331 url = joinPath [server, indexName, mappingName, "_search"]
313
332
314data Search = Search { queryBody :: Maybe Query
333data Search = Search { queryBody :: Maybe Query
@@ -457,12 +476,22 @@ type PrefixValue = Text
457
476
458data BooleanOperator = And | Or deriving (Eq, Show)
477data BooleanOperator = And | Or deriving (Eq, Show)
459
478
479+newtype IndexName = IndexName String deriving (Eq, Generic, Show)
480+newtype MappingName = MappingName String deriving (Eq, Generic, Show)
481+newtype DocId = DocId String deriving (Eq, Generic, Show)
460newtype QueryString = QueryString Text deriving (Eq, Show)
482newtype QueryString = QueryString Text deriving (Eq, Show)
461−newtype FieldName = FieldName Text deriving (Eq, Show)
483+newtype FieldName = FieldName Text deriving (Eq, Show)
462−newtype CacheName = CacheName Text deriving (Eq, Show)
484+newtype CacheName = CacheName Text deriving (Eq, Show)
463−newtype CacheKey = CacheKey Text deriving (Eq, Show)
485+newtype CacheKey = CacheKey Text deriving (Eq, Show)
464−newtype Existence = Existence Bool deriving (Eq, Show)
486+newtype Existence = Existence Bool deriving (Eq, Show)
465−newtype NullValue = NullValue Bool deriving (Eq, Show)
487+newtype NullValue = NullValue Bool deriving (Eq, Show)
488+
489+unpackId :: DocId -> String
490+unpackId (DocId docId) = docId
491+
492+instance FromJSON IndexName
493+instance FromJSON MappingName
494+instance FromJSON DocId
466
495
467-- data QueryType = BooleanQueryType
496-- data QueryType = BooleanQueryType
468-- | PhraseQueryType
497-- | PhraseQueryType
@@ -495,7 +524,7 @@ data Filter = AndFilter [Filter] Cache
495 | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
524 | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
496 | GeoDistanceRangeFilter GeoPoint DistanceRange
525 | GeoDistanceRangeFilter GeoPoint DistanceRange
497 | GeoPolygonFilter FieldName [LatLon]
526 | GeoPolygonFilter FieldName [LatLon]
498− | IdsFilter MappingName [DocumentID]
527+ | IdsFilter MappingName [DocId]
499 | LimitFilter Int
528 | LimitFilter Int
500 | MissingFilter FieldName Existence NullValue
529 | MissingFilter FieldName Existence NullValue
501 | PrefixFilter FieldName PrefixValue Cache
530 | PrefixFilter FieldName PrefixValue Cache
@@ -568,10 +597,10 @@ instance ToJSON Filter where
568 object [geoField .=
597 object [geoField .=
569 object ["points" .= fmap toJSON latLons]]]
598 object ["points" .= fmap toJSON latLons]]]
570
599
571− toJSON (IdsFilter mappingName values) =
600+ toJSON (IdsFilter (MappingName mappingName) values) =
572 object ["ids" .=
601 object ["ids" .=
573 object ["type" .= mappingName
602 object ["type" .= mappingName
574− , "values" .= fmap T.pack values]]
603+ , "values" .= fmap (T.pack . unpackId) values]]
575
604
576 toJSON (LimitFilter limit) =
605 toJSON (LimitFilter limit) =
577 object ["limit" .= object ["value" .= limit]]
606 object ["limit" .= object ["value" .= limit]]
@@ -815,7 +844,7 @@ data FromJSON a => SearchHits a =
815data FromJSON a => Hit a =
844data FromJSON a => Hit a =
816 Hit { hitIndex :: IndexName
845 Hit { hitIndex :: IndexName
817 , hitType :: MappingName
846 , hitType :: MappingName
818− , hitDocumentID :: DocumentID
847+ , hitDocId :: DocId
819 , hitScore :: Score
848 , hitScore :: Score
820 , hitSource :: a } deriving (Eq, Show)
849 , hitSource :: a } deriving (Eq, Show)
821
850
tests/tests.hs+5−5
@@ -16,8 +16,8 @@ import qualified Network.HTTP.Types.Status as NHTS
16import Test.Hspec
16import Test.Hspec
17
17
18testServer = Server "http://localhost:9200"
18testServer = Server "http://localhost:9200"
19−testIndex = "twitter"
19+testIndex = IndexName "twitter"
20−testMapping = "tweet"
20+testMapping = MappingName "tweet"
21
21
22validateStatus resp expected =
22validateStatus resp expected =
23 (NHTS.statusCode $ responseStatus resp)
23 (NHTS.statusCode $ responseStatus resp)
@@ -63,7 +63,7 @@ insertData = do
63 _ <- deleteExampleIndex
63 _ <- deleteExampleIndex
64 created <- createExampleIndex
64 created <- createExampleIndex
65 mappingCreated <- createMapping testServer testIndex testMapping TweetMapping
65 mappingCreated <- createMapping testServer testIndex testMapping TweetMapping
66− docCreated <- indexDocument testServer testIndex testMapping exampleTweet "1"
66+ docCreated <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
67 _ <- refreshIndex testServer testIndex
67 _ <- refreshIndex testServer testIndex
68 return ()
68 return ()
69
69
@@ -96,7 +96,7 @@ main = hspec $ do
96 describe "document API" $ do
96 describe "document API" $ do
97 it "indexes, gets, and then deletes the generated document" $ do
97 it "indexes, gets, and then deletes the generated document" $ do
98 _ <- insertData
98 _ <- insertData
99− docInserted <- getDocument testServer testIndex testMapping "1"
99+ docInserted <- getDocument testServer testIndex testMapping (DocId "1")
100 let newTweet = eitherDecode
100 let newTweet = eitherDecode
101 (responseBody docInserted) :: Either String (EsResult Tweet)
101 (responseBody docInserted) :: Either String (EsResult Tweet)
102 fmap _source newTweet `shouldBe` Right exampleTweet
102 fmap _source newTweet `shouldBe` Right exampleTweet
@@ -192,7 +192,7 @@ main = hspec $ do
192
192
193 it "returns document for ids filter" $ do
193 it "returns document for ids filter" $ do
194 _ <- insertData
194 _ <- insertData
195− let filter = IdsFilter "tweet" ["1"]
195+ let filter = IdsFilter (MappingName "tweet") [DocId "1"]
196 let search = mkSearch Nothing (Just filter)
196 let search = mkSearch Nothing (Just filter)
197 myTweet <- searchTweet search
197 myTweet <- searchTweet search
198 myTweet `shouldBe` Right exampleTweet
198 myTweet `shouldBe` Right exampleTweet