missingh
missingh copied to clipboard
/etc/mime.types: hIsEOF: illegal operation (handle is closed)
I'm wrapping the initialization of the Data.MIME.Types.guessType call with the following function
import Data.MIME.Types
makeMimeTypeGuesser :: IO (FilePath -> Maybe String)
makeMimeTypeGuesser = do
system_mimetype <- readSystemMIMETypes defaultmtd
pure $ \filepath ->
case guessType system_mimetype True filepath of
(Nothing, _) -> Nothing
(r@(Just _), _) -> r
And I'm calling the function in a wai + warp context, where I get the exception in the issue title.
data Env = Env { guessMimeType :: FilePath -> Maybe String } -- a couple more lines to build the Env that are omitted
app :: Env -> Application
app env request respond = do
cwd <- FS.getCurrentDirectory
let path = (cwd <>) $ unpack $ rawPathInfo request
exists <- FS.doesFileExist path
respond $ if exists
then case guessMimeType env path of
Nothing -> responseLBS status415 [] "Unsupported media type"
Just mimetype -> responseFile status200 [("Content-Type", pack mimetype)] path Nothing
else responseLBS status404 [] "Not found"
I'm no expert in laziness, or Lazy IO for that matter, but if I where to guess it's because the underlying functions use foldls without any strictness in the accumulator.
I've played around with switching foldl to foldr, changing to strict Maps and such, but in the end what worked was to make the result itself strict before the handle is closed
diff --git a/hackage/MissingH-1.6.0.1/src/Data/MIME/Types.hs b/hackage/MissingH-1.6.0.1/src/Data/MIME/Types.hs
index ecdfd03..cc16134 100644
--- a/hackage/MissingH-1.6.0.1/src/Data/MIME/Types.hs
+++ b/hackage/MissingH-1.6.0.1/src/Data/MIME/Types.hs
@@ -18,6 +18,7 @@ Utilities for guessing MIME types of files.
Written by John Goerzen, jgoerzen\@complete.org
-}
+{-# LANGUAGE BangPatterns #-}
module Data.MIME.Types (-- * Creating Lookup Objects
defaultmtd,
readMIMETypes,
@@ -190,7 +191,7 @@ readSystemMIMETypes mtd =
case fn of
Left (_ :: Control.Exception.IOException) -> return inputobj
Right h -> do
- x <- hReadMIMETypes inputobj True h
+ !x <- hReadMIMETypes inputobj True h
hClose h
return x
in