add scottyMiddleware method to Trans, and example in globastate.hs

Web/Scotty/Trans.hs

@@ -13,7 +13,8 @@ module Web.Scotty.Trans
       -- | 'Middleware' and routes are run in the order in which they
       -- are defined. All middleware is run first, followed by the first
       -- route that matches. If no route matches, a 404 response is given.
-    , middleware, get, post, put, delete, patch, addroute, matchAny, notFound
+    , middleware, scottyMiddleware, get, post, put, delete, patch, addroute
+    , matchAny, notFound
       -- ** Route Patterns
     , capture, regex, function, literal
       -- ** Accessing the Request, Captures, and Query Parameters
@@ -32,7 +33,7 @@ module Web.Scotty.Trans
       -- * Types
     , RoutePattern, File
       -- * Monad Transformers
-    , ScottyT, ActionT
+    , ScottyT, ActionT, Scotty.Middleware, Scotty.Application
     ) where
 
 import Blaze.ByteString.Builder (fromByteString)
@@ -85,8 +86,10 @@ scottyAppT :: (Monad m, Monad n)
            -> n Application
 scottyAppT runM runActionToIO defs = do
     s <- runM $ execStateT (runS defs) def
-    let rapp = runActionToIO . foldl (flip ($)) notFoundApp (routes s)
-    return $ foldl (flip ($)) rapp (middlewares s)
+    let chain = foldl $ flip ($)
+        rapp' = chain notFoundApp (routes s)
+        rapp  = runActionToIO . chain rapp' (scottyMiddlewares s)
+    return $ chain rapp (middlewares s)
 
 notFoundApp :: Monad m => Scotty.Application m
 notFoundApp _ = return $ responseBuilder status404 [("Content-Type","text/html")]
@@ -104,3 +107,12 @@ defaultHandler f = ScottyT $ modify $ addHandler $ Just f
 -- on the response). Every middleware is run on each request.
 middleware :: Monad m => Middleware -> ScottyT e m ()
 middleware = ScottyT . modify . addMiddleware
+
+-- | Use given Scotty middleware. Middleware is nested such that the first
+-- declared is the outermost middleware (it has first dibs on the request and
+-- last action on the response). Every middleware is run on each request.
+--
+-- Scotty middlewares are different from WAI middlewares, as they can access the
+-- state in the monad wrapped by 'ScottyT'.
+scottyMiddleware :: Monad m => Scotty.Middleware m -> ScottyT e m ()
+scottyMiddleware = ScottyT . modify . addScottyMiddleware

Web/Scotty/Types.hs

@@ -38,18 +38,22 @@ type Application m = Request -> m Response
 data ScottyState e m = 
     ScottyState { middlewares :: [Wai.Middleware]
                 , routes :: [Middleware m]
+                , scottyMiddlewares :: [Middleware m]
                 , handler :: ErrorHandler e m
                 }
 
 instance Monad m => Default (ScottyState e m) where
-    def = ScottyState [] [] Nothing
+    def = ScottyState [] [] [] Nothing
 
 addMiddleware :: Wai.Middleware -> ScottyState e m -> ScottyState e m
 addMiddleware m s@(ScottyState {middlewares = ms}) = s { middlewares = m:ms }
 
 addRoute :: Monad m => Middleware m -> ScottyState e m -> ScottyState e m
 addRoute r s@(ScottyState {routes = rs}) = s { routes = r:rs }
 
+addScottyMiddleware :: Monad m => Middleware m -> ScottyState e m -> ScottyState e m
+addScottyMiddleware m s@(ScottyState {scottyMiddlewares = ms}) = s { scottyMiddlewares = m:ms }
+
 addHandler :: ErrorHandler e m -> ScottyState e m -> ScottyState e m
 addHandler h s = s { handler = h }
 

examples/globalstate.hs

@@ -68,6 +68,7 @@ main = do
 app :: ScottyT Text WebM ()
 app = do
     middleware logStdoutDev
+    scottyMiddleware logTickCount
     get "/" $ do
         c <- webM $ gets tickCount
         text $ fromString $ show c
@@ -79,3 +80,13 @@ app = do
     get "/plustwo" $ do
         webM $ modify $ \ st -> st { tickCount = tickCount st + 2 }
         redirect "/"
+
+-- Log tick count after every request, but before the 'logStdoutDev'
+-- logs the status. As you can see, it can access AppState.
+-- However, unlike in actions, you do not need 'WebM' to lift state accessing.
+logTickCount :: Application WebM -> Application WebM
+logTickCount a req = do
+  r <- a req
+  c <- gets tickCount
+  liftIO $ putStrLn $ "* tick count after request handled: " ++ show c
+  return r