From 4608821ff62cf96347ed77731158e2779d958819 Mon Sep 17 00:00:00 2001
From: tom-audm <tom@audm.com>
Date: Tue, 11 Feb 2020 12:12:36 -0500
Subject: [PATCH 1/3] Fix MonadFail usage

---
 Data/Bson.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Data/Bson.hs b/Data/Bson.hs
index f6b75c0..d12b600 100644
--- a/Data/Bson.hs
+++ b/Data/Bson.hs
@@ -25,12 +25,12 @@ module Data.Bson (
   ObjectId(..), timestamp, genObjectId, showHexLen
 ) where
 
-import Prelude hiding (lookup)
+import Prelude hiding (fail, lookup)
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>))
 #endif
 #if !MIN_VERSION_base(4,13,0)
-import Control.Monad.Fail (MonadFail)
+import Control.Monad.Fail (MonadFail(fail))
 #endif
 import Control.Monad (foldM)
 import Data.Bits (shift, (.|.))

From e7f095765904f1cde3eeaedfc7b277f3f778ac32 Mon Sep 17 00:00:00 2001
From: tom-audm <tom@audm.com>
Date: Wed, 18 Mar 2020 11:28:34 -0400
Subject: [PATCH 2/3] Update MonadFail version bounds

---
 Data/Bson.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Data/Bson.hs b/Data/Bson.hs
index d12b600..7f59b10 100644
--- a/Data/Bson.hs
+++ b/Data/Bson.hs
@@ -29,7 +29,7 @@ import Prelude hiding (fail, lookup)
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>))
 #endif
-#if !MIN_VERSION_base(4,13,0)
+#if MIN_VERSION_base(4, 9, 0)
 import Control.Monad.Fail (MonadFail(fail))
 #endif
 import Control.Monad (foldM)

From 664210b4cf9c00a71bf781d7078eaa570df914a6 Mon Sep 17 00:00:00 2001
From: tom-audm <tom@audm.com>
Date: Wed, 18 Mar 2020 12:06:37 -0400
Subject: [PATCH 3/3] Add test to make sure Bson.look uses MonadFail correctly

---
 tests/Data/Bson/Tests.hs | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/tests/Data/Bson/Tests.hs b/tests/Data/Bson/Tests.hs
index dc93a34..b52154b 100644
--- a/tests/Data/Bson/Tests.hs
+++ b/tests/Data/Bson/Tests.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}
 
 module Data.Bson.Tests
     ( tests
@@ -7,6 +7,9 @@ module Data.Bson.Tests
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>), (<*>))
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Control.Monad.Fail(MonadFail(..))
+#endif
 import Data.Int (Int32, Int64)
 import Data.Time.Calendar (Day(ModifiedJulianDay))
 import Data.Time.Clock.POSIX (POSIXTime)
@@ -16,7 +19,7 @@ import qualified Data.ByteString as S
 import Data.Text (Text)
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck (Arbitrary(..), elements, oneof)
+import Test.QuickCheck (Arbitrary(..), elements, oneof, Property, (===))
 import qualified Data.Text as T
 
 import Data.Bson (Val(cast', val), ObjectId(..), MinMaxKey(..), MongoStamp(..),
@@ -106,6 +109,17 @@ testVal a = case cast' . val $ a of
     Nothing -> False
     Just a' -> a == a'
 
+#if MIN_VERSION_base(4,9,0)
+instance MonadFail (Either String) where
+   fail = Left
+
+testLookMonadFail :: Property
+testLookMonadFail =
+   (Bson.look "key" [] :: Either String Value)
+      -- This is as opposed to an exception thrown from Prelude.fail:
+      === Left "expected \"key\" in []"
+#endif
+
 tests :: Test
 tests = testGroup "Data.Bson.Tests"
     [ testProperty "Val Bool"        (testVal :: Bool -> Bool)
@@ -131,4 +145,8 @@ tests = testGroup "Data.Bson.Tests"
     , testProperty "Val Binary"      (testVal :: Binary -> Bool)
     -- , testProperty "Val Document"    (testVal :: Document -> Bool)
     , testProperty "Val Text"        (testVal :: Text -> Bool)
+
+#if MIN_VERSION_base(4,9,0)
+    , testProperty "'look' uses MonadFail.fail" testLookMonadFail
+#endif
     ]