[commit: ghc] master: Add MonadIO Q - by requiring MonadIO => Quasi (394c391)
git at git.haskell.org
git at git.haskell.org
Sat Aug 5 16:12:51 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/394c391a41539914dc445368854638f396c824f9/ghc
>---------------------------------------------------------------
commit 394c391a41539914dc445368854638f396c824f9
Author: Oleg Grenrus <oleg.grenrus at iki.fi>
Date: Sat Aug 5 12:02:16 2017 -0400
Add MonadIO Q - by requiring MonadIO => Quasi
Summary: This is follow-up to https://ghc.haskell.org/trac/ghc/ticket/10773
Reviewers: austin, goldfire, bgamari, RyanGlScott
Reviewed By: RyanGlScott
Subscribers: RyanGlScott, rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3816
>---------------------------------------------------------------
394c391a41539914dc445368854638f396c824f9
compiler/typecheck/TcSplice.hs | 1 -
libraries/ghci/GHCi/TH.hs | 5 ++++-
libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 10 ++++++----
libraries/template-haskell/changelog.md | 5 +++++
testsuite/tests/stranal/should_compile/T9208.hs | 4 +++-
5 files changed, 18 insertions(+), 7 deletions(-)
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 266a4df..77c97f7 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -869,7 +869,6 @@ instance TH.Quasi TcM where
-- the recovery action is chosen. Otherwise
-- we'll only fail higher up.
qRecover recover main = tryTcDiscardingErrs recover main
- qRunIO io = liftIO io
qAddDependentFile fp = do
ref <- fmap tcg_dependent_files getGblEnv
diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index 1b08501..09fbca7 100644
--- a/libraries/ghci/GHCi/TH.hs
+++ b/libraries/ghci/GHCi/TH.hs
@@ -97,6 +97,7 @@ import GHC.Serialized
import Control.Exception
import qualified Control.Monad.Fail as Fail
+import Control.Monad.IO.Class (MonadIO (..))
import Data.Binary
import Data.Binary.Put
import Data.ByteString (ByteString)
@@ -160,6 +161,9 @@ ghcCmd m = GHCiQ $ \s -> do
THException str -> throwIO (GHCiQException s str)
THComplete res -> return (res, s)
+instance MonadIO GHCiQ where
+ liftIO m = GHCiQ $ \s -> fmap (,s) m
+
instance TH.Quasi GHCiQ where
qNewName str = ghcCmd (NewName str)
qReport isError msg = ghcCmd (Report isError msg)
@@ -190,7 +194,6 @@ instance TH.Quasi GHCiQ where
qReifyModule m = ghcCmd (ReifyModule m)
qReifyConStrictness name = ghcCmd (ReifyConStrictness name)
qLocation = fromMaybe noLoc . qsLocation <$> getState
- qRunIO m = GHCiQ $ \s -> fmap (,s) m
qAddDependentFile file = ghcCmd (AddDependentFile file)
qAddTopDecls decls = ghcCmd (AddTopDecls decls)
qAddForeignFile str lang = ghcCmd (AddForeignFile str lang)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 90c7282..b8e1601 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -30,6 +30,7 @@ import Data.Data hiding (Fixity(..))
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad (liftM)
+import Control.Monad.IO.Class (MonadIO (..))
import System.IO ( hPutStrLn, stderr )
import Data.Char ( isAlpha, isAlphaNum, isUpper )
import Data.Int
@@ -49,7 +50,7 @@ import qualified Control.Monad.Fail as Fail
--
-----------------------------------------------------
-class Fail.MonadFail m => Quasi m where
+class (MonadIO m, Fail.MonadFail m) => Quasi m where
qNewName :: String -> m Name
-- ^ Fresh names
@@ -78,6 +79,7 @@ class Fail.MonadFail m => Quasi m where
qLocation :: m Loc
qRunIO :: IO a -> m a
+ qRunIO = liftIO
-- ^ Input/output (dangerous)
qAddDependentFile :: FilePath -> m ()
@@ -132,8 +134,6 @@ instance Quasi IO where
qIsExtEnabled _ = badIO "isExtEnabled"
qExtsEnabled = badIO "extsEnabled"
- qRunIO m = m
-
badIO :: String -> IO a
badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
; fail "Template Haskell failure" }
@@ -494,6 +494,9 @@ isExtEnabled ext = Q (qIsExtEnabled ext)
extsEnabled :: Q [Extension]
extsEnabled = Q qExtsEnabled
+instance MonadIO Q where
+ liftIO = runIO
+
instance Quasi Q where
qNewName = newName
qReport = report
@@ -507,7 +510,6 @@ instance Quasi Q where
qReifyConStrictness = reifyConStrictness
qLookupName = lookupName
qLocation = location
- qRunIO = runIO
qAddDependentFile = addDependentFile
qAddTopDecls = addTopDecls
qAddForeignFile = addForeignFile
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 0e3429c..e003f1b 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -14,6 +14,11 @@
with Template Haskell. This is not a part of the public API, and as
such, there are no API guarantees for this module from version to version.
+ * `MonadIO` is now a superclass of `Quasi`, `qRunIO` has a default
+ implementation `qRunIO = liftIO`
+
+ * Add `MonadIO Q` instance
+
## 2.12.0.0 *TBA*
* Bundled with GHC *TBA*
diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs
index b8ec6df..5243445 100644
--- a/testsuite/tests/stranal/should_compile/T9208.hs
+++ b/testsuite/tests/stranal/should_compile/T9208.hs
@@ -25,6 +25,7 @@ import Control.Monad
#if __GLASGOW_HASKELL__ >= 800
import Control.Monad.Fail (MonadFail(fail))
#endif
+import Control.Monad.IO.Class (MonadIO (..))
import Data.Binary
import Data.Binary.Get
@@ -81,7 +82,8 @@ instance MonadFail GHCJSQ where
fail = undefined
#endif
-instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m
+instance MonadIO GHCJSQ where liftIO m = GHCJSQ $ \s -> fmap (,s) m
+instance TH.Quasi GHCJSQ
-- | the Template Haskell server
runTHServer :: IO ()
More information about the ghc-commits
mailing list