[commit: ghc] ghc-8.0: template-haskell: define `MonadFail Q` instance (35b747f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/35b747fcde36bdc96e533bd1c3f02d81845453c2/ghc

>---------------------------------------------------------------

commit 35b747fcde36bdc96e533bd1c3f02d81845453c2
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Tue Mar 8 17:26:00 2016 +0100

    template-haskell: define `MonadFail Q` instance
    
    When `MonadFail`is available, this patch makes `MonadFail` a superclass
    of `Quasi`, and `Q` an instance of `MonadFail`.
    
    NB: Since f16ddcee0c64a92ab911a7841a8cf64e3ac671fd, we need to be able
        to compile `template-haskell` with stage0 compilers that don't provide
        a `MonadFail` class yet. Once we reach GHC 8.3 development we can drop
        the CPP conditionals again.
    
    Addresses #11661
    
    (cherry picked from commit 1c76e1686bd4291556ae9357151f256c805b4b5d)


>---------------------------------------------------------------

35b747fcde36bdc96e533bd1c3f02d81845453c2
 libraries/ghci/GHCi/TH.hs                           |  6 +++++-
 .../template-haskell/Language/Haskell/TH/Syntax.hs  | 21 +++++++++++++++++++++
 libraries/template-haskell/changelog.md             |  2 ++
 testsuite/tests/stranal/should_compile/T9208.hs     |  8 ++++++++
 4 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index 34d6fad6..f4f4725 100644
--- a/libraries/ghci/GHCi/TH.hs
+++ b/libraries/ghci/GHCi/TH.hs
@@ -12,6 +12,7 @@ import GHCi.RemoteTypes
 import GHC.Serialized
 
 import Control.Exception
+import qualified Control.Monad.Fail as Fail
 import Data.Binary
 import Data.Binary.Put
 import Data.ByteString (ByteString)
@@ -60,7 +61,10 @@ instance Monad GHCiQ where
     do (m', s')  <- runGHCiQ m s
        (a,  s'') <- runGHCiQ (f m') s'
        return (a, s'')
-  return    = pure
+
+  fail = Fail.fail
+
+instance Fail.MonadFail GHCiQ where
   fail err  = GHCiQ $ \s -> throwIO (GHCiQException s err)
 
 getState :: GHCiQ QState
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index d2ed425..e363adc 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -8,6 +8,10 @@
 #define HAS_NATURAL
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+# define HAS_MONADFAIL 1
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Language.Haskell.Syntax
@@ -48,13 +52,21 @@ import Language.Haskell.TH.LanguageExtensions
 import Numeric.Natural
 #endif
 
+#if HAS_MONADFAIL
+import qualified Control.Monad.Fail as Fail
+#endif
+
 -----------------------------------------------------
 --
 --              The Quasi class
 --
 -----------------------------------------------------
 
+#if HAS_MONADFAIL
+class Fail.MonadFail m => Quasi m where
+#else
 class (Applicative m, Monad m) => Quasi m where
+#endif
   qNewName :: String -> m Name
         -- ^ Fresh names
 
@@ -172,8 +184,17 @@ runQ (Q m) = m
 instance Monad Q where
   Q m >>= k  = Q (m >>= \x -> unQ (k x))
   (>>) = (*>)
+
   return     = pure
+
+#if !HAS_MONADFAIL
   fail s     = report True s >> Q (fail "Q monad failure")
+#else
+  fail       = Fail.fail
+
+instance Fail.MonadFail Q where
+  fail s     = report True s >> Q (Fail.fail "Q monad failure")
+#endif
 
 instance Functor Q where
   fmap f (Q x) = Q (fmap f x)
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 1c0919a..c313c62 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -43,6 +43,8 @@
     fixity if there is an explicit fixity declaration for that `Name`, and
     `Nothing` otherwise (#10704 and #11345)
 
+  * Add `MonadFail Q` instance for GHC 8.0 and later (#11661)
+
   * TODO: document API changes and important bugfixes
 
 
diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs
index f587da7..bf98fba 100644
--- a/testsuite/tests/stranal/should_compile/T9208.hs
+++ b/testsuite/tests/stranal/should_compile/T9208.hs
@@ -22,6 +22,9 @@ module Eval (
 
 import           Control.Applicative
 import           Control.Monad
+#if __GLASGOW_HASKELL__ >= 800
+import           Control.Monad.Fail (MonadFail(fail))
+#endif
 
 import           Data.Binary
 import           Data.Binary.Get
@@ -73,6 +76,11 @@ instance Monad GHCJSQ where
        return (a, s'')
   return    = pure
 
+#if __GLASGOW_HASKELL__ >= 800
+instance MonadFail GHCJSQ where
+  fail = undefined
+#endif
+
 instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m
 
 -- | the Template Haskell server