summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-04-26 16:24:39 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2020-04-26 20:13:48 -0400
commitd7d3f74ab36f691d6580ec40a2265de160fec0cd (patch)
tree57143d5c94fe2cd3db2cf7eb8fca7161b19a3df9
parent0ac29c885fba7ed69de83a597cdbd03696c9ed13 (diff)
downloadhaskell-wip/T18103.tar.gz
Define a Quote IO instancewip/T18103
Fixes #18103.
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs10
-rw-r--r--testsuite/tests/quotes/T18103.hs7
-rw-r--r--testsuite/tests/quotes/TH_localname.stderr6
-rw-r--r--testsuite/tests/quotes/all.T1
4 files changed, 20 insertions, 4 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index c14bec1f65..79f799aae0 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -122,8 +122,7 @@ class (MonadIO m, MonadFail m) => Quasi m where
-----------------------------------------------------
instance Quasi IO where
- qNewName s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
- ; pure (mkNameU s n) }
+ qNewName = newNameIO
qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
@@ -150,6 +149,13 @@ instance Quasi IO where
qIsExtEnabled _ = badIO "isExtEnabled"
qExtsEnabled = badIO "extsEnabled"
+instance Quote IO where
+ newName = newNameIO
+
+newNameIO :: String -> IO Name
+newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
+ ; pure (mkNameU s n) }
+
badIO :: String -> IO a
badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
; fail "Template Haskell failure" }
diff --git a/testsuite/tests/quotes/T18103.hs b/testsuite/tests/quotes/T18103.hs
new file mode 100644
index 0000000000..6965c2d2c3
--- /dev/null
+++ b/testsuite/tests/quotes/T18103.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module T18103 where
+
+import Language.Haskell.TH
+
+ex :: IO [Dec]
+ex = [d| foo x = x |]
diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr
index 6d0ccc91ec..db549a63e2 100644
--- a/testsuite/tests/quotes/TH_localname.stderr
+++ b/testsuite/tests/quotes/TH_localname.stderr
@@ -7,8 +7,10 @@ TH_localname.hs:3:11: error:
x :: t0 -> m0 Language.Haskell.TH.Syntax.Exp
(bound at TH_localname.hs:3:1)
Probable fix: use a type annotation to specify what ‘m0’ should be.
- These potential instance exist:
- one instance involving out-of-scope types
+ These potential instances exist:
+ instance Language.Haskell.TH.Syntax.Quote IO
+ -- Defined in ‘Language.Haskell.TH.Syntax’
+ ...plus one instance involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the expression:
[| y |]
diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T
index 1a5d5242b4..fe2a8e5e54 100644
--- a/testsuite/tests/quotes/all.T
+++ b/testsuite/tests/quotes/all.T
@@ -17,6 +17,7 @@ test('T9824', normal, compile, ['-v0'])
test('T10384', normal, compile_fail, [''])
test('T16384', req_th, compile, [''])
test('T17857', normal, compile, [''])
+test('T18103', normal, compile, [''])
test('TH_tf2', normal, compile, ['-v0'])
test('TH_ppr1', normal, compile_and_run, [''])