Make Typeable instance for Snap play nicely with hint

duairc · Jun 16, 2010 · 8ee59a2 · 8ee59a2
1 parent e97491e
commit 8ee59a2
Showing 1 changed file with 11 additions and 1 deletion.
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
@@ -84,7 +84,7 @@ import           Snap.Internal.Http.Types
 ------------------------------------------------------------------------------
 newtype Snap a = Snap {
       unSnap :: StateT SnapState (Iteratee IO) (Maybe (Either Response a))
-} deriving Typeable
+}
 
 
 ------------------------------------------------------------------------------
@@ -151,6 +151,16 @@ instance Alternative Snap where
     empty = mzero
     (<|>) = mplus
 
+------------------------------------------------------------------------------
+-- | The Typeable instance is here so Snap can be dynamically executed with
+-- Hint.
+snapTyCon :: TyCon
+snapTyCon = mkTyCon "Snap.Types.Snap"
+{-# NOINLINE snapTyCon #-}
+
+instance Typeable1 Snap where
+    typeOf1 _ = mkTyConApp snapTyCon []
+
 
 ------------------------------------------------------------------------------
 liftIter :: Iteratee IO a -> Snap a