Merge 50371e9 into 0499927

scotty-web · Jul 16, 2014 · 3de0044 · 3de0044
2 parents 0499927 + 50371e9
commit 3de0044
Show file tree

Hide file tree

Showing 3 changed files with 47 additions and 21 deletions.
diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE CPP, OverloadedStrings, RankNTypes #-}
 module Web.Scotty.Action
     ( addHeader
     , body
@@ -29,10 +29,14 @@ module Web.Scotty.Action
     , runAction
     ) where
 
-import Blaze.ByteString.Builder (Builder, fromLazyByteString)
+import           Blaze.ByteString.Builder (Builder, fromLazyByteString)
 
-import Control.Monad.Error
-import Control.Monad.Reader
+#if MIN_VERSION_mtl(2,2,1)
+import           Control.Monad.Except
+#else
+import           Control.Monad.Error
+#endif
+import           Control.Monad.Reader
 import qualified Control.Monad.State as MS
 
 import qualified Data.Aeson as A
@@ -47,19 +51,23 @@ import qualified Data.Text as ST
 import qualified Data.Text.Lazy as T
 import           Data.Text.Lazy.Encoding (encodeUtf8)
 
-import Network.HTTP.Types
-import Network.Wai
+import           Network.HTTP.Types
+import           Network.Wai
 
-import Web.Scotty.Internal.Types
-import Web.Scotty.Util
+import           Web.Scotty.Internal.Types
+import           Web.Scotty.Util
 
 -- Nothing indicates route failed (due to Next) and pattern matching should continue.
 -- Just indicates a successful response.
 runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response)
 runAction h env action = do
     (e,r) <- flip MS.runStateT def
            $ flip runReaderT env
+#if MIN_VERSION_mtl(2,2,1)
+           $ runExceptT
+#else
            $ runErrorT
+#endif
            $ runAM
            $ action `catchError` (defH h)
     return $ either (const Nothing) (const $ Just $ mkResponse r) e

diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs
@@ -1,12 +1,16 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}
 module Web.Scotty.Internal.Types where
 
 import           Blaze.ByteString.Builder (Builder)
 
 import           Control.Applicative
 import qualified Control.Exception as E
 import           Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)
+#if MIN_VERSION_mtl(2,2,1)
+import           Control.Monad.Except
+#else
 import           Control.Monad.Error
+#endif
 import           Control.Monad.Reader
 import           Control.Monad.State
 import           Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM, ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl, StT, liftWith, restoreT)
@@ -89,8 +93,10 @@ instance ScottyError e => ScottyError (ActionError e) where
     showError Next            = pack "Next"
     showError (ActionError e) = showError e
 
+#if !MIN_VERSION_mtl(2,2,1)
 instance ScottyError e => Error (ActionError e) where
     strMsg = stringError
+#endif
 
 type ErrorHandler e m = Maybe (e -> ActionT e m ())
 
@@ -117,7 +123,11 @@ data ScottyResponse = SR { srStatus  :: Status
 instance Default ScottyResponse where
     def = SR status200 [] (ContentBuilder mempty)
 
+#if MIN_VERSION_mtl(2,2,1)
+newtype ActionT e m a = ActionT { runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }
+#else
 newtype ActionT e m a = ActionT { runAM :: ErrorT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }
+#endif
     deriving ( Functor, Applicative, Monad )
 
 instance (MonadIO m, ScottyError e) => MonadIO (ActionT e m) where
@@ -139,7 +149,11 @@ instance (MonadBase b m, ScottyError e) => MonadBase b (ActionT e m) where
 
 
 instance (ScottyError e) => MonadTransControl (ActionT e) where
+#if MIN_VERSION_mtl(2,2,1)
+     newtype StT (ActionT e) a = StAction {unStAction :: StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ExceptT (ActionError e)) a))}
+#else
      newtype StT (ActionT e) a = StAction {unStAction :: StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ErrorT (ActionError e)) a))}
+#endif
      liftWith = \f ->
         ActionT $  liftWith $ \run  ->
                    liftWith $ \run' ->

diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs
@@ -1,32 +1,36 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase,
+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, LambdaCase,
              OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
 module Web.Scotty.Route
     ( get, post, put, delete, patch, addroute, matchAny, notFound,
       capture, regex, function, literal
     ) where
 
-import Control.Arrow ((***))
-import Control.Concurrent.MVar
-import Control.Monad.Error
+import           Control.Arrow ((***))
+import           Control.Concurrent.MVar
+#if MIN_VERSION_mtl(2,2,1)
+import           Control.Monad.Except
+#else
+import           Control.Monad.Error
+#endif
 import qualified Control.Monad.State as MS
 
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as BL
-import Data.Maybe (fromMaybe)
-import Data.Monoid (mconcat)
-import Data.String (fromString)
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid (mconcat)
+import           Data.String (fromString)
 import qualified Data.Text.Lazy as T
 import qualified Data.Text as TS
 
-import Network.HTTP.Types
-import Network.Wai (Request(..))
+import           Network.HTTP.Types
+import           Network.Wai (Request(..))
 import qualified Network.Wai.Parse as Parse hiding (parseRequestBody)
 
 import qualified Text.Regex as Regex
 
-import Web.Scotty.Action
-import Web.Scotty.Internal.Types
-import Web.Scotty.Util
+import           Web.Scotty.Action
+import           Web.Scotty.Internal.Types
+import           Web.Scotty.Util
 
 -- | get = 'addroute' 'GET'
 get :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()