diff options
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/quotes/T18103.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/quotes/TH_localname.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/quotes/all.T | 1 |
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 8e559dd854..227d24290c 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -125,8 +125,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) @@ -153,6 +152,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, ['']) |