Move MonadSnap instances out into a new module

snapframework · Jul 6, 2010 · 9cf1a67 · 9cf1a67
1 parent 3ac7c14
commit 9cf1a67
Show file tree

Hide file tree

Showing 5 changed files with 121 additions and 94 deletions.
diff --git a/snap-core.cabal b/snap-core.cabal
@@ -132,6 +132,7 @@ Library
     Snap.Util.GZip
 
   other-modules:
+    Snap.Internal.Instances,
     Snap.Internal.Routing,
     Snap.Internal.Types
 

diff --git a/src/Snap/Internal/Instances.hs b/src/Snap/Internal/Instances.hs
@@ -0,0 +1,82 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE PackageImports #-}
+
+module Snap.Internal.Instances where
+
+import                       Control.Applicative
+import           "monads-fd" Control.Monad.Cont
+import           "monads-fd" Control.Monad.Error
+import           "monads-fd" Control.Monad.List
+import           "monads-fd" Control.Monad.RWS.Strict hiding (pass)
+import qualified "monads-fd" Control.Monad.RWS.Lazy as LRWS
+import           "monads-fd" Control.Monad.Reader
+import           "monads-fd" Control.Monad.State.Strict
+import qualified "monads-fd" Control.Monad.State.Lazy as LState
+import           "monads-fd" Control.Monad.Writer.Strict hiding (pass)
+import qualified "monads-fd" Control.Monad.Writer.Lazy as LWriter
+import                       Prelude hiding (catch)
+
+------------------------------------------------------------------------------
+import                       Snap.Internal.Types
+
+
+------------------------------------------------------------------------------
+instance MonadPlus m => MonadPlus (ContT c m) where
+    mzero = lift mzero
+    m `mplus` n = ContT $ \ f -> runContT m f `mplus` runContT n f
+
+
+------------------------------------------------------------------------------
+instance MonadPlus m => Alternative (ContT c m) where
+    empty = mzero
+    (<|>) = mplus
+
+
+------------------------------------------------------------------------------
+instance MonadSnap m => MonadSnap (ContT c m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance (MonadSnap m, Error e) => MonadSnap (ErrorT e m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance MonadSnap m => MonadSnap (ListT m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance (MonadSnap m, Monoid w) => MonadSnap (RWST r w s m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance (MonadSnap m, Monoid w) => MonadSnap (LRWS.RWST r w s m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance MonadSnap m => MonadSnap (ReaderT r m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance MonadSnap m => MonadSnap (StateT s m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance MonadSnap m => MonadSnap (LState.StateT s m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance (MonadSnap m, Monoid w) => MonadSnap (WriterT w m) where
+    liftSnap = lift . liftSnap
+
+
+------------------------------------------------------------------------------
+instance (MonadSnap m, Monoid w) => MonadSnap (LWriter.WriterT w m) where
+    liftSnap = lift . liftSnap
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
@@ -1,43 +1,45 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module Snap.Internal.Types where
 
 ------------------------------------------------------------------------------
-import           Control.Applicative
-import           Control.Exception (throwIO, ErrorCall(..))
-import           Control.Monad.CatchIO
-import           Control.Monad.Cont
-import           Control.Monad.Error
-import           Control.Monad.List
-import           Control.Monad.RWS.Strict hiding (pass)
-import qualified Control.Monad.RWS.Lazy as LRWS
-import           Control.Monad.Reader
-import           Control.Monad.State.Strict
-import qualified Control.Monad.State.Lazy as LState
-import           Control.Monad.Writer.Strict hiding (pass)
-import qualified Control.Monad.Writer.Lazy as LWriter
-import           Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as S
-import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.CIByteString as CIB
-import           Data.IORef
-import qualified Data.Iteratee as Iter
-import           Data.Maybe
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Lazy as LT
-import qualified Data.Text.Lazy.Encoding as LT
-import           Prelude hiding (catch)
-
-import           Data.Typeable
-
-------------------------------------------------------------------------------
-import           Snap.Iteratee hiding (Enumerator)
-import           Snap.Internal.Http.Types
+import "MonadCatchIO-transformers" Control.Monad.CatchIO
+
+import                       Control.Applicative
+import                       Control.Exception (throwIO, ErrorCall(..))
+import           "monads-fd" Control.Monad.Cont
+import           "monads-fd" Control.Monad.Error
+import           "monads-fd" Control.Monad.List
+import           "monads-fd" Control.Monad.RWS.Strict hiding (pass)
+import qualified "monads-fd" Control.Monad.RWS.Lazy as LRWS
+import           "monads-fd" Control.Monad.Reader
+import           "monads-fd" Control.Monad.State.Strict
+import qualified "monads-fd" Control.Monad.State.Lazy as LState
+import           "monads-fd" Control.Monad.Writer.Strict hiding (pass)
+import qualified "monads-fd" Control.Monad.Writer.Lazy as LWriter
+import                       Data.ByteString.Char8 (ByteString)
+import qualified             Data.ByteString.Char8 as S
+import qualified             Data.ByteString.Lazy.Char8 as L
+import qualified             Data.CIByteString as CIB
+import                       Data.IORef
+import qualified             Data.Iteratee as Iter
+import                       Data.Maybe
+import qualified             Data.Text as T
+import qualified             Data.Text.Encoding as T
+import qualified             Data.Text.Lazy as LT
+import qualified             Data.Text.Lazy.Encoding as LT
+import                       Data.Typeable
+import                       Prelude hiding (catch)
+
+
+------------------------------------------------------------------------------
+import                       Snap.Internal.Http.Types
+import                       Snap.Iteratee hiding (Enumerator)
 
 
 ------------------------------------------------------------------------------
@@ -175,67 +177,6 @@ instance MonadSnap Snap where
     liftSnap = id
 
 
-------------------------------------------------------------------------------
-instance MonadPlus m => MonadPlus (ContT c m) where
-    mzero = lift mzero
-    m `mplus` n = ContT $ \ f -> runContT m f `mplus` runContT n f
-
-
-------------------------------------------------------------------------------
-instance MonadPlus m => Alternative (ContT c m) where
-    empty = mzero
-    (<|>) = mplus
-
-
-------------------------------------------------------------------------------
-instance MonadSnap m => MonadSnap (ContT c m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance (MonadSnap m, Error e) => MonadSnap (ErrorT e m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance MonadSnap m => MonadSnap (ListT m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance (MonadSnap m, Monoid w) => MonadSnap (RWST r w s m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance (MonadSnap m, Monoid w) => MonadSnap (LRWS.RWST r w s m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance MonadSnap m => MonadSnap (ReaderT r m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance MonadSnap m => MonadSnap (StateT s m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance MonadSnap m => MonadSnap (LState.StateT s m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance (MonadSnap m, Monoid w) => MonadSnap (WriterT w m) where
-    liftSnap = lift . liftSnap
-
-
-------------------------------------------------------------------------------
-instance (MonadSnap m, Monoid w) => MonadSnap (LWriter.WriterT w m) where
-    liftSnap = lift . liftSnap
-
 
 ------------------------------------------------------------------------------
 -- | The Typeable instance is here so Snap can be dynamically executed with

diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
@@ -1,6 +1,8 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Snap Framework type aliases and utilities for iteratees. Note that as a
@@ -45,7 +47,7 @@ module Snap.Iteratee
 
 ------------------------------------------------------------------------------
 import           Control.Monad
-import           Control.Monad.CatchIO
+import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Unsafe as S

diff --git a/src/Snap/Types.hs b/src/Snap/Types.hs
@@ -116,6 +116,7 @@ module Snap.Types
 
 ------------------------------------------------------------------------------
 import           Snap.Internal.Http.Types
+import           Snap.Internal.Instances ()
 import           Snap.Internal.Routing
 import           Snap.Internal.Types
 ------------------------------------------------------------------------------