git.iko.soy/typeable/bloodhound
on master help sign in
cleanup, redundancy killed off
3e7dc54Chris Allen
Database/Bloodhound/Client.hs+16−21
compare with master
unifiedsplit
@@ -20,7 +20,7 @@ import Control.Monad (liftM)
20import Data.Aeson
20import Data.Aeson
21import Data.Aeson.TH (deriveJSON)
21import Data.Aeson.TH (deriveJSON)
22import qualified Data.ByteString.Lazy.Char8 as L
22import qualified Data.ByteString.Lazy.Char8 as L
23−import Data.List (intersperse)
23+import Data.List (intercalate)
24import Data.Maybe (fromMaybe)
24import Data.Maybe (fromMaybe)
25import Data.Text (Text)
25import Data.Text (Text)
26import Data.Time.Clock (UTCTime)
26import Data.Time.Clock (UTCTime)
@@ -131,9 +131,7 @@ type Reply = Network.HTTP.Conduit.Response L.ByteString
131type Method = NHTM.Method
131type Method = NHTM.Method
132
132
133responseIsError :: Reply -> Bool
133responseIsError :: Reply -> Bool
134−responseIsError resp = if (NHTS.statusCode (responseStatus resp)) > 299
134+responseIsError resp = NHTS.statusCode (responseStatus resp) > 299
135− then True
136− else False
137
135
138emptyBody = L.pack ""
136emptyBody = L.pack ""
139
137
@@ -145,19 +143,18 @@ dispatch url method body = do
145 let req = initReq { method = method
143 let req = initReq { method = method
146 , requestBody = reqBody
144 , requestBody = reqBody
147 , checkStatus = \_ _ _ -> Nothing}
145 , checkStatus = \_ _ _ -> Nothing}
148− response <- withManager $ httpLbs req
146+ withManager $ httpLbs req
149− return response
150
147
151type IndexName = String
148type IndexName = String
152
149
153joinPath :: [String] -> String
150joinPath :: [String] -> String
154−joinPath path = concat $ intersperse "/" path
151+joinPath path = intercalate "/" path
155
152
156getStatus :: Server -> IO (Maybe (Status Version))
153getStatus :: Server -> IO (Maybe (Status Version))
157getStatus (Server server) = do
154getStatus (Server server) = do
158 request <- parseUrl $ joinPath [server]
155 request <- parseUrl $ joinPath [server]
159 response <- withManager $ httpLbs request
156 response <- withManager $ httpLbs request
160− return $ (decode $ responseBody response)
157+ return $ decode (responseBody response)
161
158
162createIndex :: Server -> IndexSettings -> IndexName -> IO Reply
159createIndex :: Server -> IndexSettings -> IndexName -> IO Reply
163createIndex (Server server) indexSettings indexName =
160createIndex (Server server) indexSettings indexName =
@@ -174,16 +171,17 @@ deleteIndex (Server server) indexName =
174 body = Nothing
171 body = Nothing
175
172
176respIsTwoHunna :: Reply -> Bool
173respIsTwoHunna :: Reply -> Bool
177−respIsTwoHunna resp = (NHTS.statusCode $ responseStatus resp) == 200
174+respIsTwoHunna resp = NHTS.statusCode (responseStatus resp) == 200
175+
176+existentialQuery url = do
177+ reply <- dispatch url NHTM.methodHead Nothing
178+ return (reply, respIsTwoHunna reply)
178
179
179indexExists :: Server -> IndexName -> IO Bool
180indexExists :: Server -> IndexName -> IO Bool
180−indexExists (Server server) indexName =
181+indexExists (Server server) indexName = do
182+ (reply, exists) <- existentialQuery url
181− exists where
183+ return exists where
182 url = joinPath [server, indexName]
184 url = joinPath [server, indexName]
183− method = NHTM.methodHead
184− body = Nothing
185− reply = dispatch url method body
186− exists = fmap respIsTwoHunna reply
187
185
188data OpenCloseIndex = OpenIndex | CloseIndex deriving (Show)
186data OpenCloseIndex = OpenIndex | CloseIndex deriving (Show)
189
187
@@ -267,13 +265,10 @@ getDocument (Server server) indexName mappingName docId =
267
265
268documentExists :: Server -> IndexName -> MappingName
266documentExists :: Server -> IndexName -> MappingName
269 -> DocumentID -> IO Bool
267 -> DocumentID -> IO Bool
270−documentExists (Server server) indexName mappingName docId =
268+documentExists (Server server) indexName mappingName docId = do
269+ (reply, exists) <- existentialQuery url
271− exists where
270+ return exists where
272 url = joinPath [server, indexName, mappingName, docId]
271 url = joinPath [server, indexName, mappingName, docId]
273− method = NHTM.methodHead
274− body = Nothing
275− reply = dispatch url method body
276− exists = fmap respIsTwoHunna reply
277
272
278-- getStatus :: String -> IO (Maybe (Status Version))
273-- getStatus :: String -> IO (Maybe (Status Version))
279-- getStatus server = do
274-- getStatus server = do