cdc262f · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

tests, seminearring, cleanup, basic filter composition working

cdc262fChris Allen13 years ago

Database/Bloodhound/Client.hs+29−90

compare with master

unifiedsplit

@@ -21,6 +21,7 @@ import Data.Aeson.TH (deriveJSON)

21import qualified Data.ByteString.Lazy.Char8 as L

22import Data.List (intercalate)

23import Data.Maybe (fromMaybe)

24+import Data.Monoid

24import Data.Text (Text)

25import Data.Text (Text)

25import Data.Time.Clock (UTCTime)

26import Data.Time.Clock (UTCTime)

26import GHC.Generics (Generic)

27import GHC.Generics (Generic)

@@ -53,33 +54,8 @@ instance (FromJSON a, ToJSON a) => FromJSON (Status a) where

53 v .: "tagline"

54 v .: "tagline"

54 parseJSON _ = empty

55 parseJSON _ = empty

56−-- instance ToJSON (Status a)

57−-- instance FromJSON (Status a)

58−

59−-- bloo <- (liftM responseBody $ parseUrl "http://localhost:9200/" >>= \r -> withManager (httpLbs r))

60−

61−-- rootPath :: String

62−-- rootPath = rollUp $ ["/"]

63−

64−-- -- Kinda hate this.

65−-- pathFromType :: String -> String -> String

66−-- pathFromType index docType = "/" ++ index ++ docType

67−

68−-- -- Kinda hate this too.

69−-- rollUp :: [String] -> String

70−-- rollUp = Prelude.concat

71−

72main = simpleHttp "http://localhost:9200/events/event/_search?q=hostname:localhost&size=1" >>= L.putStrLn

57main = simpleHttp "http://localhost:9200/events/event/_search?q=hostname:localhost&size=1" >>= L.putStrLn

74−-- data Response = Response { blah :: Text } deriving (Show)

75−

76−-- indexDocument :: ToJSON a => a -> IO Response

77−-- indexDocument doc = ToJSON a

78−

79−-- nomenclature is because you're dropping the type baggage. All of this is compile-time erased.

80−-- newtype ShardCount = ShardCount { unShardCount :: Int } deriving (Show, Generic)

81−-- newtype ReplicaCount = ReplicaCount { unReplicaCount :: Int } deriving (Show, Generic)

82−

83newtype ShardCount = ShardCount Int deriving (Show, Generic)

59newtype ShardCount = ShardCount Int deriving (Show, Generic)

84newtype ReplicaCount = ReplicaCount Int deriving (Show, Generic)

60newtype ReplicaCount = ReplicaCount Int deriving (Show, Generic)

@@ -95,8 +71,6 @@ mkReplicaCount n

95 | n > 1000 = Nothing -- ...

71 | n > 1000 = Nothing -- ...

96 | otherwise = Just (ReplicaCount n)

72 | otherwise = Just (ReplicaCount n)

98−-- IndexSettings <$> mkShardCount 10 <*> mkReplicaCount 20

99−

100data IndexSettings =

74data IndexSettings =

101 IndexSettings { indexShards :: ShardCount

75 IndexSettings { indexShards :: ShardCount

102 , indexReplicas :: ReplicaCount } deriving (Show)

76 , indexReplicas :: ReplicaCount } deriving (Show)

@@ -113,20 +87,6 @@ data Strategy = RoundRobinStrat | RandomStrat | HeadStrat deriving (Show)

113

114newtype Server = Server String deriving (Show)

88newtype Server = Server String deriving (Show)

115

116−-- data Errors = IndexAlreadyExistsError | GenericError deriving (Show)

117−

118−-- data ElasticsearchError = ElasticsearchError

119−-- { status :: Int

120−-- , error :: Text } deriving (Show, Generic)

121−

122−-- instance FromJSON ElasticsearchError

123−

124−-- errorForResponse resp = do

125−-- let (sts, err) = decode (responseBody resp) :: ElasticsearchError

126−-- if T.isInfixOf "IndexAlreadyExistsException" error

127−-- then IndexAlreadyExistsError

128−-- else

129−

130type Reply = Network.HTTP.Conduit.Response L.ByteString

90type Reply = Network.HTTP.Conduit.Response L.ByteString

131type Method = NHTM.Method

91type Method = NHTM.Method

132

@@ -242,17 +202,17 @@ data EsResult a = EsResult { _index :: Text

242 , _type :: Text

202 , _type :: Text

243 , _id :: Text

203 , _id :: Text

244 , _version :: Int

204 , _version :: Int

245− , found :: Bool

205+ , found :: Maybe Bool

246 , _source :: a } deriving (Eq, Show)

206 , _source :: a } deriving (Eq, Show)

247

207

248instance (FromJSON a, ToJSON a) => FromJSON (EsResult a) where

208instance (FromJSON a, ToJSON a) => FromJSON (EsResult a) where

249 parseJSON (Object v) = EsResult <$>

209 parseJSON (Object v) = EsResult <$>

250− v .: "_index" <*>

210+ v .: "_index" <*>

251− v .: "_type" <*>

211+ v .: "_type" <*>

252− v .: "_id" <*>

212+ v .: "_id" <*>

253− v .: "_version" <*>

213+ v .: "_version" <*>

254− v .: "found" <*>

214+ v .:? "found" <*>

255− v .: "_source"

215+ v .: "_source"

256 parseJSON _ = empty

216 parseJSON _ = empty

257

217

258getDocument :: Server -> IndexName -> MappingName

218getDocument :: Server -> IndexName -> MappingName

@@ -270,25 +230,6 @@ documentExists (Server server) indexName mappingName docId = do

270 return exists where

230 return exists where

271 url = joinPath [server, indexName, mappingName, docId]

231 url = joinPath [server, indexName, mappingName, docId]

272

232

273−-- data Analyzer = AStandardAnalyzer StandardAnalyzer

274−-- | SimpleAnalyzer -- just "simple"

275−-- | WhitespaceAnalyzer

276−-- | StopAnalyzer

277−-- | KeywordAnalyzer

278−-- | PatternAnalyzer

279−-- | LanguageAnalyzer

280−-- | SnowballAnalyzer

281−-- | CustomAnalyzer

282−

283−-- data StandardAnalyzer =

284−-- StandardAnalyzer

285−-- { stopwords :: Maybe [Text] -- default []

286−-- , max_token_length :: Maybe Int -- default 255

287−-- }

288−

289−-- DefaultField -> "default_field": ""

290−-- Fields -> "fields": []

291−

292type QueryString = Text

233type QueryString = Text

293-- status:active

234-- status:active

294-- author:"John Smith"

235-- author:"John Smith"

@@ -345,14 +286,33 @@ queryStringQuery query = emptyQueryStringQuery { query = query }

345type FieldName = Text

286type FieldName = Text

346

287

347type Cache = Bool -- caching on/off

288type Cache = Bool -- caching on/off

289+defaultCache = False

290+

348data Filter = AndFilter [Filter] Cache

291data Filter = AndFilter [Filter] Cache

349 | OrFilter [Filter] Cache

292 | OrFilter [Filter] Cache

293+ | IdentityFilter

350 | BoolFilter BoolMatch Cache

294 | BoolFilter BoolMatch Cache

351 | ExistsFilter FieldName -- always cached

295 | ExistsFilter FieldName -- always cached

352 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache

296 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache

353 | GeoDistanceFilter GeoConstraint Distance Cache

297 | GeoDistanceFilter GeoConstraint Distance Cache

354 deriving (Show)

298 deriving (Show)

355

299

300+class Monoid a => Seminearring a where

301+ -- 0, +, *

302+ (<||>) :: a -> a -> a

303+ (<&&>) :: a -> a -> a

304+ (<&&>) = mappend

305+

306+infixr 5 <||>

307+infixr 5 <&&>

308+

309+instance Monoid Filter where

310+ mempty = IdentityFilter

311+ mappend a b = AndFilter [a, b] defaultCache

312+

313+instance Seminearring Filter where

314+ a <||> b = OrFilter [a, b] defaultCache

315+

356instance ToJSON Filter where

316instance ToJSON Filter where

357 toJSON (AndFilter filters cache) =

317 toJSON (AndFilter filters cache) =

358 object ["and" .= fmap toJSON filters

318 object ["and" .= fmap toJSON filters

@@ -360,6 +320,8 @@ instance ToJSON Filter where

360 toJSON (OrFilter filters cache) =

320 toJSON (OrFilter filters cache) =

361 object ["or" .= fmap toJSON filters

321 object ["or" .= fmap toJSON filters

362 , "_cache" .= cache]

322 , "_cache" .= cache]

323+ toJSON (IdentityFilter) =

324+ object ["match_all" .= object []]

363 toJSON (ExistsFilter fieldName) =

325 toJSON (ExistsFilter fieldName) =

364 object ["exists" .= object

326 object ["exists" .= object

365 ["field" .= fieldName]]

327 ["field" .= fieldName]]

@@ -367,7 +329,6 @@ instance ToJSON Filter where

367 object ["bool" .= toJSON boolMatch

329 object ["bool" .= toJSON boolMatch

368 , "_cache" .= cache]

330 , "_cache" .= cache]

369

331

370−-- I dunno.

371data Term = Term { termField :: Text

332data Term = Term { termField :: Text

372 , termValue :: Text } deriving (Show)

333 , termValue :: Text } deriving (Show)

373

334

@@ -446,25 +407,3 @@ data ShardResults =

446 ShardResults { shardTotal :: Int

407 ShardResults { shardTotal :: Int

447 , shardsSuccessful :: Int

408 , shardsSuccessful :: Int

448 , shardsFailed :: Int } deriving (Show)

409 , shardsFailed :: Int } deriving (Show)

449−

450−-- This is turning into a fractal of horror

451−-- data Fuzziness = FDateFuzziness DateFuzziness |

452−

453−-- data Query = Query { query :: () } deriving (Show)

454−-- search :: Server -> IndexName -> Maybe MappingName

455−-- -> Query -> IO Reply

456−-- search = fuck

457−

458−-- getStatus :: String -> IO (Maybe (Status Version))

459−-- getStatus server = do

460−-- request <- parseUrl $ server ++ rootPath

461−-- response <- withManager $ httpLbs request

462−-- return $ (decode $ responseBody response)

463−

464−-- mkServer -- (Maybe Server) for URL parsing?

465−

466−-- data Cluster = Cluster { targets :: [Server]

467−-- , strategy :: Strategy } deriving (Show)

468−

469−-- target :: Cluster -> Server

470−-- target (Cluster targets HeadStrat) = head targets

bloodhound.cabal+1−1

@@ -46,7 +46,7 @@ test-suite tests

46 bloodhound,

47 http-conduit,

48 http-types,

49− hspec >= 1.9,

49+ hspec >= 1.8,

50 QuickCheck >= 2.5,

51 derive >= 2.5,

52 text >= 0.11,

tests/tests.hs+5−7

@@ -5,6 +5,7 @@ module Main where

5import Database.Bloodhound.Client

6import Data.Aeson

7import Data.DeriveTH

8+import Data.Either (Either(..))

8import Data.Maybe (fromJust)

9import Data.Maybe (fromJust)

9import Data.Time.Calendar (Day(..))

10import Data.Time.Calendar (Day(..))

10import Data.Time.Clock (secondsToDiffTime, UTCTime(..))

11import Data.Time.Clock (secondsToDiffTime, UTCTime(..))

@@ -51,11 +52,8 @@ main = hspec $ do

51 let encoded = encode tweet

52 let encoded = encode tweet

52 _ <- deleteExampleIndex

53 _ <- deleteExampleIndex

53 created <- createExampleIndex

54 created <- createExampleIndex

54− docCreated <- indexDocument (Server "http://localhost:9200")

55+ docCreated <- indexDocument (Server "http://localhost:9200") "twitter" "tweet" tweet "1"

55− "twitter" "tweet" tweet "1"

56− docInserted <- getDocument (Server "http://localhost:9200")

56+ docInserted <- getDocument (Server "http://localhost:9200") "twitter" "tweet" "1"

57− "twitter" "tweet" "1"

58− let newTweet = decode

59− (responseBody docInserted) :: Maybe (EsResult Tweet)

57+ let newTweet = eitherDecode (responseBody docInserted) :: Either String (EsResult Tweet)

60 deleted <- deleteExampleIndex

58 deleted <- deleteExampleIndex

61− Just tweet `shouldBe` fmap _source newTweet

59+ Right tweet `shouldBe` fmap _source newTweet