[GHC] #13989: use templateHaskell type checker panic

[GHC]

#13989: use templateHaskell type checker panic
-------------------------------------+-------------------------------------
           Reporter:  chinaxing      |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Compiler       |           Version:  8.0.2
  (Type checker)                     |
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:  x86_64         |   Type of failure:  Compile-time
  (amd64)                            |  crash or panic
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 I'm use acid-state, whci use TemplateHaskell to deriveSafeCopy, the
 following code will produce
 a panic

 {{{#!hs
 {-# LANGUAGE TemplateHaskell #-}

 module Service.HAEventBroker where

 -- this module dispatch HAEvent to remote RDS-Console,
 -- if failed, persistent to locle storage and deliver later
 -- Event must keep ordered, aka FIFO

 -- import Model
 import Data.Acid
 import qualified Data.List as DL
 import Data.SafeCopy
 import Data.Typeable
 import Control.Concurrent
 import Control.Monad

 data HAEvent = HAEvent Int

 data EventQueue = EvQ [HAEvent]

 $(deriveSafeCopy 0 'base ''EventQueue)

 putEvent :: HAEvent -> Update EventQueue ()
 putEvent e = do
   EvQ el <- get
   put $ EvQ (e:el)

 pollEvent :: Int -> Update EventQueue [HAEvent]
 pollEvent n = do
   EvQ el <- get
   let rl = DL.reverse el
   let t = DL.take n $ rl
   let r = DL.reverse $ DL.splitAt (length t) rl
   put $ EvQ r

 $(makeAcidic 'EventQueue ['putEvent, 'pollEvent])

 publish :: Broker -> HAEvent  -> IO ()
 publish broker e = update broker (PutEvent e)

 consume :: HAEvent -> IO ()
 consume e = return ()

 newtype Broker = Broker { acidState ::  AcidState (EventQueue [HAEvent]) }

 runBroker :: IO Broker
 runBroker = do
   broker <- openLocalStateFrom "haBroker/" (EventQueue [])
   putStrLn "I'm consuming the message queue ..."
   forkIO $ forever $ doConsume broker
   return broker
   where
     doConsume :: Broker -> IO ()
     doConsume b = do
       ev <- update (acidState b) (PollEvent n)
       consume ev
 }}}

 stack ghci --ghc-options=-ddump-splices

 {{{#!hs
 /Users/LambdaCat/code/haskell/ha-
 admin/src/Service/HAEventBroker.hs:21:3-37: Splicing declarations
     deriveSafeCopy 0 'base ''EventQueue
   ======>
     instance SafeCopy EventQueue where
       putCopy (EvQ a1_awJ6)
         = contain
             (do { safePut_ListHAEvent_awJ7 <- getSafePut;
                   safePut_ListHAEvent_awJ7 a1_awJ6;
                   return () })
       getCopy
         = contain
             (cereal-0.5.4.0:Data.Serialize.Get.label
                "Service.HAEventBroker.EventQueue:"
                (do { safeGet_ListHAEvent_awJ8 <- getSafeGet;
                      ((return EvQ) <*> safeGet_ListHAEvent_awJ8) }))
       version = 0
       kind = base
       errorTypeName _ = "Service.HAEventBroker.EventQueue"
 ghc: panic! (the 'impossible' happened)
   (GHC version 8.0.2 for x86_64-apple-darwin):
         initTc: unsolved constraints
   WC {wc_insol =
         [W] get_awNI :: t_awNH[tau:1] (CHoleCan: get)
         [W] put_awOs :: t_awOr[tau:1] (CHoleCan: put)
         [W] get_awOF :: t_awOE[tau:1] (CHoleCan: get)
         [W] put_awOK :: t_awOJ[tau:1] (CHoleCan: put)}

 Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
 }}}

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