[GHC] #10596: Template Haskell : getQ and putQ doesn't work

[GHC]

#10596: Template Haskell : getQ and putQ doesn't work
-------------------------------------+-------------------------------------
        Reporter:  kiripon           |                   Owner:
            Type:  bug               |                  Status:  new
        Priority:  normal            |               Milestone:
       Component:  Template Haskell  |                 Version:  7.10.1
      Resolution:                    |                Keywords:  getQ putQ
Operating System:  Unknown/Multiple  |            Architecture:
 Type of failure:  None/Unknown      |  Unknown/Multiple
      Blocked By:                    |               Test Case:
 Related Tickets:                    |                Blocking:
                                     |  Differential Revisions:
-------------------------------------+-------------------------------------

Comment (by kiripon):

 I fixed this bug and checked work correctly.

 {{{
 diff --git a/compiler/typecheck/TcSplice.hs
 b/compiler/typecheck/TcSplice.hs
 index a7363d8..2bcb78c 100644
 --- a/compiler/typecheck/TcSplice.hs
 +++ b/compiler/typecheck/TcSplice.hs
 @@ -836,7 +836,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv))
 where
    qGetQ = do
        th_state_var <- fmap tcg_th_state getGblEnv
        th_state <- readTcRef th_state_var
 -      let x = Map.lookup (typeOf x) th_state >>= fromDynamic
 +      let x = Map.lookup (typeOf $ fromJust x) th_state >>= fromDynamic
        return x

    qPutQ x = do

 diff --git a/compiler/typecheck/TcSplice.hs
 b/compiler/typecheck/TcSplice.hs
 }}}

 {{{
 kiripon% ghc -fforce-recomp Y.hs
 [1 of 1] Compiling Y                ( Y.hs, Y.o )
 Nothing
 Nothing
 kiripon% $HOME/opt/local/ghc-head/bin/ghc -fforce-recomp Y.hs
 [1 of 1] Compiling Y                ( Y.hs, Y.o )
 Just 100
 Just 100
 kiripon% cat Y.hs
 {-# LANGUAGE TemplateHaskell #-}
 module Y where
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
 -- splice for testing getQ and putQ
 do
   putQ (100 :: Int) :: Q ()
   x <- getQ :: Q (Maybe Int)
   runIO $ print x -- prints Nothing
   return []
 do
   x <- getQ :: Q (Maybe Int)
   runIO $ print x -- prints Nothing
   return []
 kiripon%
 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10596#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler