diff options
author | Oleg Grenrus <oleg.grenrus@iki.fi> | 2017-08-05 12:02:16 -0400 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-05 12:02:16 -0400 |
commit | 394c391a41539914dc445368854638f396c824f9 (patch) | |
tree | 0544f81991868b3abecba7a87e532930adf385c9 | |
parent | 884bd21a917f607b5a44e038e06f78d0b765ea63 (diff) | |
download | haskell-394c391a41539914dc445368854638f396c824f9.tar.gz |
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
-rw-r--r-- | compiler/typecheck/TcSplice.hs | 1 | ||||
-rw-r--r-- | libraries/ghci/GHCi/TH.hs | 5 | ||||
-rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 10 | ||||
-rw-r--r-- | libraries/template-haskell/changelog.md | 5 | ||||
-rw-r--r-- | 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 266a4dfe3a..77c97f70df 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 1b08501580..09fbca7e32 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 90c728296b..b8e1601456 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 0e3429caa9..e003f1b47e 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 b8ec6df6d1..5243445c96 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 () |