haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

safeEh logs properly

Browse Source
This commit is contained in:
Michael Snoyman 2013-03-10 14:14:44 +02:00
parent 1b8a1b9d42
commit 0c4643422c
3 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
yesod-core/Yesod/Core/Run.hs
View File

@ -2,6 +2,7 @@
{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Yesod.Core.Run where module Yesod.Core.Run where
import Blaze.ByteString.Builder (fromLazyByteString, toByteString, import Blaze.ByteString.Builder (fromLazyByteString, toByteString,
@ -32,7 +33,6 @@ import Data.Text.Encoding.Error (lenientDecode)
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
import Network.Wai import Network.Wai
import Prelude hiding (catch) import Prelude hiding (catch)
import System.IO (hPutStrLn, stderr)
import System.Log.FastLogger (Logger) import System.Log.FastLogger (Logger)
import System.Random (newStdGen) import System.Random (newStdGen)
import Web.Cookie (renderSetCookie) import Web.Cookie (renderSetCookie)
@ -43,6 +43,9 @@ import Yesod.Internal (tokenKey)
import Yesod.Internal.Request (parseWaiRequest, import Yesod.Internal.Request (parseWaiRequest,
tooLargeResponse) tooLargeResponse)
import Yesod.Routes.Class (Route, renderRoute) import Yesod.Routes.Class (Route, renderRoute)
import Language.Haskell.TH.Syntax (Loc, qLocation)
import Control.Monad.Logger (LogSource, LogLevel (LevelError), liftLoc)
import System.Log.FastLogger (LogStr, toLogStr)
yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> Response yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> Response
yarToResponse (YRWai a) _ = a yarToResponse (YRWai a) _ = a
@ -161,9 +164,12 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = do
cts = reqAccept yreq cts = reqAccept yreq
initSession = reqSession yreq initSession = reqSession yreq
safeEh :: ErrorResponse -> YesodApp safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
safeEh er req = do -> ErrorResponse
liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er -> YesodApp
safeEh log' er req = do
liftIO $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError
$ toLogStr $ "Error handler errored out: " ++ show er
return $ YRPlain return $ YRPlain
H.status500 H.status500
[] []
@ -293,7 +299,7 @@ defaultYesodRunner YesodRunnerEnv {..} handler' req
, rheSub = yreSub , rheSub = yreSub
, rheUpload = fileUpload yreMaster , rheUpload = fileUpload yreMaster
, rheLog = log' , rheLog = log'
, rheOnError = safeEh , rheOnError = safeEh log'
} }
rhe = rheSafe rhe = rheSafe
{ rheOnError = runHandler rheSafe . localNoCurrent . errorHandler { rheOnError = runHandler rheSafe . localNoCurrent . errorHandler

3
yesod-core/Yesod/Widget.hs
View File

@ -225,6 +225,7 @@ ihamletToRepHtml ih = do
tell :: GWData (Route master) -> GWidget sub master () tell :: GWData (Route master) -> GWidget sub master ()
tell w = GWidget $ return ((), w) tell w = GWidget $ return ((), w)
-- | Type-restricted version of @lift@ -- | Type-restricted version of @lift@. Used internally to create better error
-- messages.
liftW :: GHandler sub master a -> GWidget sub master a liftW :: GHandler sub master a -> GWidget sub master a
liftW = lift liftW = lift

2
yesod-core/yesod-core.cabal
View File

@ -81,7 +81,7 @@ library
, vector >= 0.9 && < 0.11 , vector >= 0.9 && < 0.11
, aeson >= 0.5 , aeson >= 0.5
, fast-logger >= 0.2 , fast-logger >= 0.2
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3.1 && < 0.4
, conduit >= 0.5 , conduit >= 0.5
, resourcet >= 0.4 && < 0.5 , resourcet >= 0.4 && < 0.5
, lifted-base >= 0.1 , lifted-base >= 0.1