Template haskell: This pattern-binding binds no variables

I'm trying to introduce a new local variable to some scope, in this example this scope is represented by print $( varE ohNoes) Everything works as expected, but I'm getting a warning message which I don't seem quite right to me. Am I doing anything wrong? ---- Blah.hs ---- {-# LANGUAGE TemplateHaskell #-} module Blah where import Language.Haskell.TH sample :: Q Exp sample = newName "ohNoes" >>= \ohNoes -> [| let $( varP ohNoes ) = "Teh warning!" in print $( varE ohNoes ) |] ---- Main.hs ---- {-# LANGUAGE TemplateHaskell #-} module Main where import Blah main :: IO () main = $( sample ) ---- output ---- Blah.hs:8:49: Warning: This pattern-binding binds no variables: $(varP ohNoes) = "Teh warning!" sample ======> let ohNoes_a2Al = "Teh warning!" in print ohNoes_a2Al

Hi Michael,
I think it's a bug. Maybe the fix is similar to the one done for
https://ghc.haskell.org/trac/ghc/ticket/9127.
Assuming you only need that unique name ('ohNoes :: Name) after you
bind it with the let, you can avoid the warning with:
sample :: Q Exp
sample = [| let ohNoes = "Teh warning!"
in print $( varE 'ohNoes ) |]
Or you could use letE instead of the brackets, as we had to with ghc <
7.8 when PatQ splices were added.
Regards,
Adam
On Sun, Dec 21, 2014 at 3:50 AM, Michael Baikov
I'm trying to introduce a new local variable to some scope, in this example this scope is represented by print $( varE ohNoes)
Everything works as expected, but I'm getting a warning message which I don't seem quite right to me. Am I doing anything wrong?
---- Blah.hs ---- {-# LANGUAGE TemplateHaskell #-}
module Blah where
import Language.Haskell.TH
sample :: Q Exp sample = newName "ohNoes" >>= \ohNoes -> [| let $( varP ohNoes ) = "Teh warning!" in print $( varE ohNoes ) |]
---- Main.hs ---- {-# LANGUAGE TemplateHaskell #-}
module Main where import Blah
main :: IO () main = $( sample )
---- output ----
Blah.hs:8:49: Warning: This pattern-binding binds no variables: $(varP ohNoes) = "Teh warning!"
sample ======> let ohNoes_a2Al = "Teh warning!" in print ohNoes_a2Al _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

I need this unique iname in other places as well. letE would work, right. I'll file a bugreport later then, Thanks!
I think it's a bug. Maybe the fix is similar to the one done for https://ghc.haskell.org/trac/ghc/ticket/9127.
Assuming you only need that unique name ('ohNoes :: Name) after you bind it with the let, you can avoid the warning with:
sample :: Q Exp sample = [| let ohNoes = "Teh warning!" in print $( varE 'ohNoes ) |]
Or you could use letE instead of the brackets, as we had to with ghc < 7.8 when PatQ splices were added.
Regards, Adam
On Sun, Dec 21, 2014 at 3:50 AM, Michael Baikov
wrote: I'm trying to introduce a new local variable to some scope, in this example this scope is represented by print $( varE ohNoes)
Everything works as expected, but I'm getting a warning message which I don't seem quite right to me. Am I doing anything wrong?
---- Blah.hs ---- {-# LANGUAGE TemplateHaskell #-}
module Blah where
import Language.Haskell.TH
sample :: Q Exp sample = newName "ohNoes" >>= \ohNoes -> [| let $( varP ohNoes ) = "Teh warning!" in print $( varE ohNoes ) |]
---- Main.hs ---- {-# LANGUAGE TemplateHaskell #-}
module Main where import Blah
main :: IO () main = $( sample )
---- output ----
Blah.hs:8:49: Warning: This pattern-binding binds no variables: $(varP ohNoes) = "Teh warning!"
sample ======> let ohNoes_a2Al = "Teh warning!" in print ohNoes_a2Al _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (2)
-
adam vogt
-
Michael Baikov