diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index c9fa9952..e9575712 100644 --- 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,11 +51,11 @@ 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. @@ -59,7 +63,11 @@ runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> Action 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 index a3ee61d3..b723cff7 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-} module Web.Scotty.Internal.Types where import Blaze.ByteString.Builder (Builder) @@ -6,7 +6,11 @@ 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 index 6ed05c46..95daea2b 100644 --- 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 ()