[commit: ghc] master: template-haskell: define `MonadFail Q` instance (1c76e16)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1c76e1686bd4291556ae9357151f256c805b4b5d/ghc

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

commit 1c76e1686bd4291556ae9357151f256c805b4b5d
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
    
    Reviewed By: bgamari, goldfire
    
    Differential Revision: https://phabricator.haskell.org/D1982


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

1c76e1686bd4291556ae9357151f256c805b4b5d
 libraries/ghci/GHCi/TH.hs                             |  4 ++++
 .../template-haskell/Language/Haskell/TH/Syntax.hs    | 19 +++++++++++++++++++
 libraries/template-haskell/changelog.md               |  2 ++
 testsuite/tests/stranal/should_compile/T9208.hs       |  8 ++++++++
 4 files changed, 33 insertions(+)

diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index 00601ba..1525221 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,6 +61,9 @@ instance Monad GHCiQ where
     do (m', s')  <- runGHCiQ m s
        (a,  s'') <- runGHCiQ (f m') s'
        return (a, s'')
+  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 f26f37e..ce3c908 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -4,6 +4,10 @@
 
 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
 
+#if MIN_VERSION_base(4,9,0)
+# define HAS_MONADFAIL 1
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Language.Haskell.Syntax
@@ -38,13 +42,21 @@ import GHC.Lexeme       ( startsVarSym, startsVarId )
 import Language.Haskell.TH.LanguageExtensions
 import Numeric.Natural
 
+#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 Monad m => Quasi m where
+#endif
   qNewName :: String -> m Name
         -- ^ Fresh names
 
@@ -162,7 +174,14 @@ runQ (Q m) = m
 instance Monad Q where
   Q m >>= k  = Q (m >>= \x -> unQ (k x))
   (>>) = (*>)
+#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