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 |