85bbc62 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

Merge pull request #58 from Soostone/57-esresult-partiality

Eliminate partiality in EsResult

commit85bbc620f43a07dc0de6e0f4b873d1abba206d30 authorChris Allen <cma@bitemyapp.com> dateMon 27 Jul 2015, 21:16 (11 years ago) parent6844fd4 d9e8da1

3 files changed+53−30

compare with master

unifiedsplit

README.md+13−14 src/Database/Bloodhound/Types.hs+26−11 tests/tests.hs+14−5

README.md+13−14

@@ -276,23 +276,22 @@ let eitherResult = eitherDecode body :: Either String (EsResult Tweet)

276276Right (EsResult {_index = "twitter"

277277 , _type = "tweet"

278278 , _id = "1"

279− , _version = 2

280− , found = Just True

281− , _source = Tweet {user = "bitemyapp"

282− , postDate = 2009-06-18 00:00:10 UTC

283− , message = "Use haskell!"

284− , age = 10000

285− , location = Location {lat = 40.12, lon = -71.34}}})

279+ , foundResult = Just (EsResultFound { _version = 2

280+ , _source = Tweet {user = "bitemyapp"

281+ , postDate = 2009-06-18 00:00:10 UTC

282+ , message = "Use haskell!"

283+ , age = 10000

284+ , location = Location {lat = 40.12, lon = -71.34}}})})

286285

287−-- _source in EsResult is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.

286+-- _source in EsResultFound is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.

288287

289288-- use the _source record accessor to get at your document

290−fmap _source eitherResult

291−Right (Tweet {user = "bitemyapp"

292− , postDate = 2009-06-18 00:00:10 UTC

293− , message = "Use haskell!"

294− , age = 10000

295− , location = Location {lat = 40.12, lon = -71.34}})

289+fmap (fmap _source . foundResult) eitherResult

290+Right (Just (Tweet {user = "bitemyapp"

291+ , postDate = 2009-06-18 00:00:10 UTC

292+ , message = "Use haskell!"

293+ , age = 10000

294+ , location = Location {lat = 40.12, lon = -71.34}}))

296295

297296```

298297

src/Database/Bloodhound/Types.hs+26−11

@@ -60,6 +60,7 @@ module Database.Bloodhound.Types

6060 , Server(..)

6161 , Reply

6262 , EsResult(..)

63+ , EsResultFound(..)

6364 , DocVersion

6465 , ExternalDocVersion(..)

6566 , VersionControl(..)

@@ -394,14 +395,21 @@ data BulkOperation =

394395 | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)

395396

396397{-| 'EsResult' describes the standard wrapper JSON document that you see in

397− successful Elasticsearch responses.

398+ successful Elasticsearch lookups or lookups that couldn't find the document.

398399-}

399400data EsResult a = EsResult { _index :: Text

400401 , _type :: Text

401402 , _id :: Text

402− , _version :: DocVersion

403− , found :: Maybe Bool

404− , _source :: a } deriving (Eq, Show)

403+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)

404+

405+

406+{-| 'EsResultFound' contains the document and its metadata inside of an

407+ 'EsResult' when the document was successfully found.

408+-}

409+data EsResultFound a = EsResultFound { _version :: DocVersion

410+ , _source :: a } deriving (Eq, Show)

411+

412+

405413

406414{-| 'DocVersion' is an integer version number for a document between 1

407415and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.

@@ -2039,15 +2047,22 @@ instance ToJSON IndexTemplate where

20392047 merge _ _ = undefined

20402048

20412049instance (FromJSON a) => FromJSON (EsResult a) where

2042− parseJSON (Object v) = EsResult <$>

2043− v .: "_index" <*>

2044− v .: "_type" <*>

2045− v .: "_id" <*>

2046− v .: "_version" <*>

2047− v .:? "found" <*>

2048− v .: "_source"

2050+ parseJSON jsonVal@(Object v) = do

2051+ found <- v .:? "found" .!= False

2052+ fr <- if found

2053+ then parseJSON jsonVal

2054+ else return Nothing

2055+ EsResult <$> v .: "_index" <*>

2056+ v .: "_type" <*>

2057+ v .: "_id" <*>

2058+ pure fr

20492059 parseJSON _ = empty

20502060

2061+instance (FromJSON a) => FromJSON (EsResultFound a) where

2062+ parseJSON (Object v) = EsResultFound <$>

2063+ v .: "_version" <*>

2064+ v .: "_source"

2065+ parseJSON _ = empty

20512066

20522067instance ToJSON Search where

20532068 toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize sFields) =

tests/tests.hs+14−5

@@ -278,6 +278,9 @@ instance Arbitrary a => Arbitrary (SearchHits a) where

278278 hs <- arbitrary

279279 return $ SearchHits tot score hs

280280

281+getSource :: EsResult a -> Maybe a

282+getSource = fmap _source . foundResult

283+

281284main :: IO ()

282285main = hspec $ do

283286

@@ -298,7 +301,13 @@ main = hspec $ do

298301 docInserted <- getDocument testIndex testMapping (DocId "1")

299302 let newTweet = eitherDecode

300303 (responseBody docInserted) :: Either String (EsResult Tweet)

301− liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)

304+ liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))

305+

306+ it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do

307+ doc <- getDocument testIndex testMapping (DocId "bogus")

308+ let noTweet = eitherDecode

309+ (responseBody doc) :: Either String (EsResult Tweet)

310+ liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing

302311

303312 it "can use optimistic concurrency control" $ withTestEnv $ do

304313 let ev = ExternalDocVersion minBound

@@ -344,8 +353,8 @@ main = hspec $ do

344353 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)

345354 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)

346355 liftIO $ do

347− fmap _source maybeFirst `shouldBe` Right firstTest

348− fmap _source maybeSecond `shouldBe` Right secondTest

356+ fmap getSource maybeFirst `shouldBe` Right (Just firstTest)

357+ fmap getSource maybeSecond `shouldBe` Right (Just secondTest)

349358

350359

351360 describe "query API" $ do

@@ -377,8 +386,8 @@ main = hspec $ do

377386

378387 it "returns document for multi-match query" $ withTestEnv $ do

379388 _ <- insertData

380− let fields = [FieldName "user", FieldName "message"]

381− let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")

389+ let flds = [FieldName "user", FieldName "message"]

390+ let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")

382391 let search = mkSearch (Just query) Nothing

383392 myTweet <- searchTweet search

384393 liftIO $