git.iko.soy/typeable/ether
on master help sign in
Guard compatibility hack behind CPP
e7ad6e0Ryan Scott
src/Ether/TaggedTrans.hs+12−4
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1module Ether.TaggedTrans
2module Ether.TaggedTrans
2 ( TaggedTrans(..)
3 ( TaggedTrans(..)
3 ) where
4 ) where
@@ -29,11 +30,17 @@ import qualified Control.Monad.Error.Class as Mtl
29import GHC.Generics (Generic)
30import GHC.Generics (Generic)
30import Data.Coerce (coerce)
31import Data.Coerce (coerce)
31
32
33+#define TRAC_11837_PRESENT \
34+ __GLASGOW_HASKELL__ == 800 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1
35+
32newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
36newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
33 deriving
37 deriving
34 ( Generic
38 ( Generic
35 , Functor, Applicative, Alternative, Monad, MonadPlus
39 , Functor, Applicative, Alternative, Monad, MonadPlus
36 , MonadFix, MonadTrans, MonadIO
40 , MonadFix, MonadTrans, MonadIO
41+#if !(TRAC_11837_PRESENT)
42+ , MFunctor, MMonad
43+#endif
37 , MonadThrow, MonadCatch, MonadMask )
44 , MonadThrow, MonadCatch, MonadMask )
38
45
39type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
46type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
@@ -175,14 +182,15 @@ instance
175 throwError = lift . Mtl.throwError
182 throwError = lift . Mtl.throwError
176 catchError = Lift.liftCatch Mtl.catchError
183 catchError = Lift.liftCatch Mtl.catchError
177
184
185+#if TRAC_11837_PRESENT
178−-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will
186+-- NB: Don't use GeneralizedNewtypeDeriving to create these instances on
179−-- trigger GHC Trac #11837 on GHC 8.0.1 and older.
187+-- GHC 8.0.1, as they will trigger GHC Trac #11837
188+
180instance MFunctor trans => MFunctor (TaggedTrans tag trans) where
189instance MFunctor trans => MFunctor (TaggedTrans tag trans) where
181 hoist f (TaggedTrans t) = TaggedTrans (hoist f t)
190 hoist f (TaggedTrans t) = TaggedTrans (hoist f t)
182
191
183−-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will
184−-- trigger GHC Trac #11837 on GHC 8.0.1 and older.
185instance MMonad trans => MMonad (TaggedTrans tag trans) where
192instance MMonad trans => MMonad (TaggedTrans tag trans) where
186 embed f (TaggedTrans t) = TaggedTrans (embed (runTaggedTrans . f) t)
193 embed f (TaggedTrans t) = TaggedTrans (embed (runTaggedTrans . f) t)
187 where
194 where
188 runTaggedTrans (TaggedTrans x) = x
195 runTaggedTrans (TaggedTrans x) = x
196+#endif