From cee07ba63331e8b3dd39756a38fe4b913dfaffe0 Mon Sep 17 00:00:00 2001 From: Anders Kaseorg Date: Tue, 9 Mar 2010 00:52:03 -0500 Subject: [PATCH] Clean up open exception handling. Signed-off-by: Anders Kaseorg --- StaticCat.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/StaticCat.hs b/StaticCat.hs index 25be388..be7fbe0 100644 --- a/StaticCat.hs +++ b/StaticCat.hs @@ -131,13 +131,15 @@ serveFile file = (`catchExceptionCGI` outputMyError) $ do checkMethod $ do - h <- (`catchExceptionCGI` \e -> - if isDoesNotExistError e then throwExceptionCGI NotFound - else if isPermissionError e then throwExceptionCGI Forbidden - else throwExceptionCGI e) $ - liftIO $ openBinaryFile file ReadMode - (`catchCGI` \e -> - (liftIO $ hClose h) >> throwCGI e) $ do + let handleOpenError e = + if isDoesNotExistError e then throwExceptionCGI NotFound + else if isPermissionError e then throwExceptionCGI Forbidden + else throwExceptionCGI e + h <- liftIO (openBinaryFile file ReadMode) `catchExceptionCGI` handleOpenError + let handlePostOpenError e = do + liftIO $ hClose h + throwCGI e + (`catchCGI` handlePostOpenError) $ do status <- liftIO $ hGetStatus h let mTime = modificationTime status -- 2.44.0