From a7333838d4bb7d71e00f0bf88f6dcc5b788c1351 Mon Sep 17 00:00:00 2001 From: Fumiaki Kinoshita Date: Sat, 14 Oct 2023 03:49:55 +0900 Subject: [PATCH 1/2] Remove unnecessary CPP conditionals (#333) --- Web/Scotty/Internal/Types.hs | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index 98ec69aa..b462d198 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} @@ -242,40 +241,19 @@ instance (Semigroup a) => Semigroup (ScottyT m a) where instance ( Monoid a -#if !(MIN_VERSION_base(4,11,0)) - , Semigroup a -#endif -#if !(MIN_VERSION_base(4,8,0)) - , Functor m -#endif ) => Monoid (ScottyT m a) where mempty = return mempty -#if !(MIN_VERSION_base(4,11,0)) - mappend = (<>) -#endif instance ( Monad m -#if !(MIN_VERSION_base(4,8,0)) - , Functor m -#endif , Semigroup a ) => Semigroup (ActionT m a) where x <> y = (<>) <$> x <*> y instance ( Monad m, Monoid a -#if !(MIN_VERSION_base(4,11,0)) - , Semigroup a -#endif -#if !(MIN_VERSION_base(4,8,0)) - , Functor m -#endif ) => Monoid (ActionT m a) where mempty = return mempty -#if !(MIN_VERSION_base(4,11,0)) - mappend = (<>) -#endif ------------------ Scotty Routes -------------------- data RoutePattern = Capture Text From 123ff5f3592e902f96fa7f4347e62e945bef3caf Mon Sep 17 00:00:00 2001 From: Fumiaki Kinoshita Date: Sat, 14 Oct 2023 04:07:07 +0900 Subject: [PATCH 2/2] handle ActionError prior to a user-defined handler (fixes #330) (#331) Catching SomeException in a user-defined handler should not bypass actionErrorHandler. --- Web/Scotty.hs | 2 +- Web/Scotty/Action.hs | 15 +++++++-------- Web/Scotty/Exceptions.hs | 25 ------------------------- Web/Scotty/Internal/Types.hs | 2 +- Web/Scotty/Trans.hs | 2 +- scotty.cabal | 1 - 6 files changed, 10 insertions(+), 37 deletions(-) delete mode 100644 Web/Scotty/Exceptions.hs diff --git a/Web/Scotty.hs b/Web/Scotty.hs index 0d6f9df1..c02d7b31 100644 --- a/Web/Scotty.hs +++ b/Web/Scotty.hs @@ -56,7 +56,7 @@ import Network.Wai (Application, Middleware, Request, StreamingBody) import Network.Wai.Handler.Warp (Port) import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, StatusError(..), Content(..)) -import Web.Scotty.Exceptions (Handler(..)) +import UnliftIO.Exception (Handler(..)) type ScottyM = ScottyT IO type ActionM = ActionT IO diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index 7dd15dd4..b64715fe 100644 --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -69,6 +69,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Int +import Data.Maybe (maybeToList) import qualified Data.Text as ST import qualified Data.Text.Encoding as STE import qualified Data.Text.Lazy as T @@ -86,7 +87,7 @@ import Numeric.Natural import Web.Scotty.Internal.Types import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, strictByteStringToLazyText) -import Web.Scotty.Exceptions (Handler(..), catch, catchesOptionally, tryAny) +import UnliftIO.Exception (Handler(..), catch, catches, tryAny) import Network.Wai.Internal (ResponseReceived(..)) @@ -101,13 +102,11 @@ runAction :: MonadUnliftIO m => -> ActionT m () -- ^ Route action to be evaluated -> m (Maybe Response) runAction mh env action = do - let - handlers = [ - statusErrorHandler, -- StatusError - actionErrorHandler, -- ActionError i.e. Next, Finish, Redirect - someExceptionHandler -- all remaining exceptions - ] - ok <- flip runReaderT env $ runAM $ tryNext (catchesOptionally action mh handlers ) + ok <- flip runReaderT env $ runAM $ tryNext $ action `catches` concat + [ [actionErrorHandler] + , maybeToList mh + , [statusErrorHandler, someExceptionHandler] + ] res <- getResponse env return $ bool Nothing (Just $ mkResponse res) ok diff --git a/Web/Scotty/Exceptions.hs b/Web/Scotty/Exceptions.hs deleted file mode 100644 index 53f7d36f..00000000 --- a/Web/Scotty/Exceptions.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -module Web.Scotty.Exceptions ( - Handler(..) - -- * catching - , catch - , catchAny - , catches - , catchesOptionally - -- * trying - , try - , tryAny - ) where - -import Data.Maybe (maybeToList) - -import UnliftIO (MonadUnliftIO(..), catch, catchAny, catches, try, tryAny, Handler(..)) - - --- | Handlers are tried sequentially -catchesOptionally :: MonadUnliftIO m => - m a - -> Maybe (Handler m a) -- ^ if present, this 'Handler' is tried first - -> [Handler m a] -- ^ these are tried in order - -> m a -catchesOptionally io mh handlers = io `catches` (maybeToList mh <> handlers) diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index b462d198..5533eb2b 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -40,7 +40,7 @@ import qualified Network.Wai as Wai import Network.Wai.Handler.Warp (Settings, defaultSettings) import Network.Wai.Parse (FileInfo) -import Web.Scotty.Exceptions (Handler(..), catch, catches) +import UnliftIO.Exception (Handler(..), catch, catches) --------------------- Options ----------------------- diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs index b42e28f5..8beee939 100644 --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -66,7 +66,7 @@ import Web.Scotty.Route import Web.Scotty.Internal.Types (ActionT(..), ScottyT(..), defaultScottyState, Application, RoutePattern, Options(..), defaultOptions, RouteOptions(..), defaultRouteOptions, ErrorHandler, Kilobytes, File, addMiddleware, setHandler, updateMaxRequestBodySize, routes, middlewares, ScottyException(..), ScottyState, defaultScottyState, StatusError(..), Content(..)) import Web.Scotty.Util (socketDescription) import Web.Scotty.Body (newBodyInfo) -import Web.Scotty.Exceptions (Handler(..), catches) +import UnliftIO.Exception (Handler(..), catches) -- | Run a scotty application using the warp server. -- NB: scotty p === scottyT p id diff --git a/scotty.cabal b/scotty.cabal index e06ffb96..83464d43 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -64,7 +64,6 @@ Library Web.Scotty.Cookie other-modules: Web.Scotty.Action Web.Scotty.Body - Web.Scotty.Exceptions Web.Scotty.Route Web.Scotty.Util default-language: Haskell2010