Skip to content

use templateHaskell type checker panic

I'm use acid-state, whci use TemplateHaskell to deriveSafeCopy, the following code will produce a panic

{-# 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

/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
Trac metadata
Trac field Value
Version 8.0.2
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler (Type checker)
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information