template-haskell: define `MonadFail Q` instance
authorHerbert Valerio Riedel <hvr@gnu.org>
Tue, 8 Mar 2016 16:26:00 +0000 (17:26 +0100)
committerHerbert Valerio Riedel <hvr@gnu.org>
Tue, 8 Mar 2016 16:26:26 +0000 (17:26 +0100)
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

libraries/ghci/GHCi/TH.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
libraries/template-haskell/changelog.md
testsuite/tests/stranal/should_compile/T9208.hs

index 00601ba..1525221 100644 (file)
@@ -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
index f26f37e..ce3c908 100644 (file)
@@ -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)
index 1c0919a..c313c62 100644 (file)
@@ -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
 
 
index f587da7..bf98fba 100644 (file)
@@ -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