summaryrefslogtreecommitdiff
path: root/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/template-haskell/Language/Haskell/TH/Syntax.hs')
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs10
1 files changed, 8 insertions, 2 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" }