/etc/mime.types: hIsEOF: illegal operation (handle is closed)

[mhitza]

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.

[mhitza]

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