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

Eliminate partiality in EsResult

README.md

@@ -276,23 +276,22 @@ let eitherResult = eitherDecode body :: Either String (EsResult Tweet)
 Right (EsResult {_index = "twitter"
                , _type = "tweet"
                , _id = "1"
-               , _version = 2
-               , found = Just True
-               , _source = Tweet {user = "bitemyapp"
-               , postDate = 2009-06-18 00:00:10 UTC
-               , message = "Use haskell!"
-               , age = 10000
-               , location = Location {lat = 40.12, lon = -71.34}}})
+               , foundResult = Just (EsResultFound { _version = 2
+                                                   , _source = Tweet {user = "bitemyapp"
+                                                                     , postDate = 2009-06-18 00:00:10 UTC
+                                                                     , message = "Use haskell!"
+                                                                     , age = 10000
+                                                                     , location = Location {lat = 40.12, lon = -71.34}}})})
 
--- _source in EsResult is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.
+-- _source in EsResultFound is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.
 
 -- use the _source record accessor to get at your document
-fmap _source eitherResult
-Right (Tweet {user = "bitemyapp"
-            , postDate = 2009-06-18 00:00:10 UTC
-            , message = "Use haskell!"
-            , age = 10000
-            , location = Location {lat = 40.12, lon = -71.34}})
+fmap (fmap _source . foundResult) eitherResult
+Right (Just (Tweet {user = "bitemyapp"
+                   , postDate = 2009-06-18 00:00:10 UTC
+                   , message = "Use haskell!"
+                   , age = 10000
+                   , location = Location {lat = 40.12, lon = -71.34}}))
 
 ```
 

src/Database/Bloodhound/Types.hs

@@ -60,6 +60,7 @@ module Database.Bloodhound.Types
        , Server(..)
        , Reply
        , EsResult(..)
+       , EsResultFound(..)
        , DocVersion
        , ExternalDocVersion(..)
        , VersionControl(..)
@@ -394,14 +395,21 @@ data BulkOperation =
   | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)
 
 {-| 'EsResult' describes the standard wrapper JSON document that you see in
-    successful Elasticsearch responses.
+    successful Elasticsearch lookups or lookups that couldn't find the document.
 -}
 data EsResult a = EsResult { _index   :: Text
                            , _type    :: Text
                            , _id      :: Text
-                           , _version :: DocVersion
-                           , found    :: Maybe Bool
-                           , _source  :: a } deriving (Eq, Show)
+                           , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)
+
+
+{-| 'EsResultFound' contains the document and its metadata inside of an
+    'EsResult' when the document was successfully found.
+-}
+data EsResultFound a = EsResultFound {  _version :: DocVersion
+                                     , _source  :: a } deriving (Eq, Show)
+
+
 
 {-| 'DocVersion' is an integer version number for a document between 1
 and 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
      merge _           _           = undefined
 
 instance (FromJSON a) => FromJSON (EsResult a) where
-  parseJSON (Object v) = EsResult <$>
-                         v .:  "_index"   <*>
-                         v .:  "_type"    <*>
-                         v .:  "_id"      <*>
-                         v .:  "_version" <*>
-                         v .:? "found"    <*>
-                         v .:  "_source"
+  parseJSON jsonVal@(Object v) = do
+    found <- v .:? "found" .!= False
+    fr <- if found
+             then parseJSON jsonVal
+             else return Nothing
+    EsResult <$> v .:  "_index"   <*>
+                 v .:  "_type"    <*>
+                 v .:  "_id"      <*>
+                 pure fr
   parseJSON _          = empty
 
+instance (FromJSON a) => FromJSON (EsResultFound a) where
+  parseJSON (Object v) = EsResultFound <$>
+                         v .: "_version" <*>
+                         v .: "_source"
+  parseJSON _          = empty
 
 instance ToJSON Search where
   toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize sFields) =

tests/tests.hs

@@ -278,6 +278,9 @@ instance Arbitrary a => Arbitrary (SearchHits a) where
     hs <- arbitrary
     return $ SearchHits tot score hs
 
+getSource :: EsResult a -> Maybe a
+getSource = fmap _source . foundResult
+
 main :: IO ()
 main = hspec $ do
 
@@ -298,7 +301,13 @@ main = hspec $ do
       docInserted <- getDocument testIndex testMapping (DocId "1")
       let newTweet = eitherDecode
                      (responseBody docInserted) :: Either String (EsResult Tweet)
-      liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
+      liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
+
+    it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
+      doc <- getDocument testIndex testMapping  (DocId "bogus")
+      let noTweet = eitherDecode
+                    (responseBody doc) :: Either String (EsResult Tweet)
+      liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
 
     it "can use optimistic concurrency control" $ withTestEnv $ do
       let ev = ExternalDocVersion minBound
@@ -344,8 +353,8 @@ main = hspec $ do
       let maybeFirst  = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
       let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
       liftIO $ do
-        fmap _source maybeFirst `shouldBe` Right firstTest
-        fmap _source maybeSecond `shouldBe` Right secondTest
+        fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
+        fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
 
 
   describe "query API" $ do
@@ -377,8 +386,8 @@ main = hspec $ do
 
     it "returns document for multi-match query" $ withTestEnv $ do
       _ <- insertData
-      let fields = [FieldName "user", FieldName "message"]
-      let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
+      let flds = [FieldName "user", FieldName "message"]
+      let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
       let search = mkSearch (Just query) Nothing
       myTweet <- searchTweet search
       liftIO $