This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap".
The branch, master has been updated
via 38b78d21761247c502f4859bd378067125476e72 (commit)
from f95b2b7565d39724fadd51a2481e7f5353678d33 (commit)
Summary of changes:
TODO | 2 --
snap.cabal | 2 ++
src/Snap/Error.hs | 35 +++++++++++++++++++++++++++++++++++
src/Snap/Heist.hs | 13 +++----------
src/Snap/Loader/Hint.hs | 12 +++---------
5 files changed, 43 insertions(+), 21 deletions(-)
create mode 100644 src/Snap/Error.hs
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 38b78d21761247c502f4859bd378067125476e72
Author: Carl Howells <[email protected]>
Date: Tue Jun 29 14:30:46 2010 -0700
Create Snap.Error to unify error handling
diff --git a/TODO b/TODO
index 20a1820..5010138 100644
--- a/TODO
+++ b/TODO
@@ -1,8 +1,6 @@
TODO
----
-Handle runtime exceptions better in Hint server.
-
document EVERYTHING.
-- low-level per-function documentation
-- mid-level per-module documentation
diff --git a/snap.cabal b/snap.cabal
index 68715d7..354185a 100644
--- a/snap.cabal
+++ b/snap.cabal
@@ -43,6 +43,7 @@ Library
hs-source-dirs: src
exposed-modules:
+ Snap.Error,
Snap.Heist,
Snap.Loader.Static,
Snap.Loader.Hint
@@ -52,6 +53,7 @@ Library
bytestring >= 0.9.1 && < 0.10,
directory >= 1.0.0.0 && < 1.1,
filepath >= 1.0 && < 1.2,
+ MonadCatchIO-transformers >= 0.2.1 && < 0.3,
monads-fd >= 0.1 && < 0.2,
snap-core == 0.3,
heist >= 0.2.1 && < 0.3,
diff --git a/src/Snap/Error.hs b/src/Snap/Error.hs
new file mode 100644
index 0000000..e3a9d27
--- /dev/null
+++ b/src/Snap/Error.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Snap.Error (
+ catch500
+ , internalError
+)
+where
+
+import Control.Exception (SomeException)
+import Control.Monad.CatchIO
+
+import Prelude hiding (catch)
+
+import qualified Data.ByteString.Char8 as S
+
+import Snap.Iteratee
+import Snap.Types
+
+internalError :: S.ByteString -> Snap a
+internalError msg =
+ let rsp = setContentType "text/plain; charset=utf-8"
+ . setContentLength (fromIntegral $ S.length msg)
+ . setResponseStatus 500 "Internal Server Error"
+ . modifyResponseBody (>. enumBS msg)
+ $ emptyResponse
+
+ in finishWith rsp
+
+catch500 :: Snap a -> Snap a
+catch500 action = action `catch` handler
+ where
+ handler :: SomeException -> Snap a'
+ handler = internalError
+ . S.append "Unhandled error:\r\n\r\n"
+ . S.pack
+ . show
diff --git a/src/Snap/Heist.hs b/src/Snap/Heist.hs
index c631d5e..d629742 100644
--- a/src/Snap/Heist.hs
+++ b/src/Snap/Heist.hs
@@ -3,7 +3,7 @@ module Snap.Heist where
import qualified Data.ByteString.Char8 as S
-import Snap.Iteratee
+import Snap.Error
import Snap.Types
import Text.Templating.Heist
@@ -21,12 +21,5 @@ render contentType ts template = do
. setContentLength (fromIntegral $ S.length x)
writeBS x
where
- missingTemplate = do
- let msg = S.append "Unable to load template: " template
- rsp = setContentType "text/plain; charset=utf-8"
- . setContentLength (fromIntegral $ S.length msg)
- . setResponseStatus 500 "Internal Server Error"
- . modifyResponseBody (>. enumBS msg)
- $ emptyResponse
-
- finishWith rsp
+ msg = S.append "Unable to load template: " template
+ missingTemplate = internalError msg
diff --git a/src/Snap/Loader/Hint.hs b/src/Snap/Loader/Hint.hs
index b204c47..83efa26 100644
--- a/src/Snap/Loader/Hint.hs
+++ b/src/Snap/Loader/Hint.hs
@@ -24,6 +24,7 @@ import Language.Haskell.TH.Syntax
import System.Environment (getArgs)
------------------------------------------------------------------------------
+import Snap.Error
import Snap.Types
import qualified Snap.Loader.Static as Static
@@ -102,15 +103,8 @@ hintSnap opts mNames initBase cleanBase actBase = do
return $ do
eSnap <- liftIO loadAction
case eSnap of
- Left err -> do
- let msg = format err
- len = fromIntegral $ S.length msg
- modifyResponse $ setContentType "text/plain; charset=utf-8"
- . setResponseStatus 500 "Internal Server Error"
- . setContentLength len
- writeBS msg
-
- Right handler -> handler
+ Left err -> internalError $ format err
+ Right handler -> catch500 handler
------------------------------------------------------------------------------
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
