Clean up open exception handling.

[scripts-static-cat.git] / StaticCat.hs

diff --git a/StaticCat.hs b/StaticCat.hs
index f7e4ad80228580deac09e575f0ce945de3cfc12a..be7fbe0ceccb1d4fd4b79221808c58e3992246ea 100644 (file)
--- a/StaticCat.hs
+++ b/StaticCat.hs
@@ -108,38 +108,46 @@ checkRange mTime size = do
       Just (a, b) | a <= b -> return $ Just (a, b)
       _ -> throwExceptionCGI BadRange
 
+outputAll :: Handle -> FileOffset -> CGI CGIResult
+outputAll h size = do
+  setHeader "Content-Length" $ show size
+  outputFPS =<< liftIO (B.hGetContents h)
+
+outputRange :: Handle -> FileOffset -> Maybe (FileOffset, FileOffset) -> CGI CGIResult
+outputRange h size Nothing = outputAll h size
+outputRange h size (Just (a, b)) = do
+  let len = b - a + 1
+
+  setStatus 206 "Partial Content"
+  setHeader "Content-Range" $
+   "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size
+  setHeader "Content-Length" $ show len
+  liftIO $ hSeek h AbsoluteSeek (fromIntegral a)
+  outputFPS =<< liftIO (B.hGet h (fromIntegral len))
+
 serveFile :: FilePath -> CGI CGIResult
 serveFile file = (`catchExceptionCGI` outputMyError) $ do
   checkExtension file
 
   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
       size = fileSize status
   checkModified mTime
 
-  checkRange mTime size >>= maybe
-    (do
-       setHeader "Content-Length" $ show size
-       outputFPS =<< (liftIO $ B.hGetContents h))
-    (\(a, b) -> do
-       let len = b - a + 1
-
-       setStatus 206 "Partial Content"
-       setHeader "Content-Range" $
-        "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size
-       setHeader "Content-Length" $ show len
-       liftIO $ hSeek h AbsoluteSeek (fromIntegral a)
-       outputFPS =<< (liftIO $ B.hGet h (fromIntegral len)))
+  range <- checkRange mTime size
+  outputRange h size range
 
 main :: IO ()
 main = runCGI $ handleErrors $ serveFile =<< pathTranslated