1 files changed, 32 insertions, 30 deletions
diff --git a/src/Mmap.hs b/src/Mmap.hs
index 94f5c49..d62dcab 100644
--- a/src/Mmap.hs
+++ b/src/Mmap.hs
@@ -9,6 +9,9 @@ import Foreign.C.Types
 import System.Posix.IO
 import System.Posix.Types
 
+import AtomicPrint
+
+
 foreign import ccall "ircbrowse_mmap"
   c_mmap :: CInt -> Ptr CSize -> IO (Ptr Word8)
   --        fd      out length
@@ -17,36 +20,35 @@ foreign import ccall "ircbrowse_munmap"
   c_munmap :: Ptr Word8 -> CSize -> IO ()
   --          addr         length
 
-mapFile :: FilePath -> IO ByteString
+-- | Returns Nothing if the open(2) fails.
+mapFile :: FilePath -> IO (Maybe ByteString)
 mapFile path = mask_ $ do
-  -- open can fail without repercussions
-  Fd fd <- openFd path ReadOnly defaultFileFlags
-
-  -- do the mmap; if it fails, close the file, ignoring exceptions there
-  (addr, filelen) <-
-    catchNoPropagate @SomeException
-      (alloca $ \lengthp -> do
-        addr <- c_mmap fd lengthp
-        lengthval <- peek lengthp
-        return (addr, lengthval))
-      (\e -> do
-          catch @SomeException (closeFd (Fd fd))
-            (\_ -> return ())
-          rethrowIO e)
+  -- if open fails, we simply return Nothing, and nothing has happened yet so that's fine
+  try @IOException (openFd path ReadOnly defaultFileFlags) >>= \case
+    Left _ -> return Nothing
+    Right (Fd fd) -> do
+      -- do the mmap; if it fails, close the file, ignoring exceptions there
+      (addr, filelen) <-
+        onException
+          (alloca $ \lengthp -> do
+            addr <- c_mmap fd lengthp
+            lengthval <- peek lengthp
+            return (addr, lengthval))
+          (catch @SomeException (closeFd (Fd fd))
+             (\_ -> return ()))
 
-  -- mmap succeeded, close the file
-  catchNoPropagate @SomeException (closeFd (Fd fd))
-    (\e -> do
-      -- putStrLn ("[munmap " ++ show addr ++ " as close(2) handler]")
-      c_munmap addr filelen
-      rethrowIO e)
+      -- mmap succeeded, close the file; if closing fails, something is badly wrong, so unmap, and if that throws an exception propagate that
+      onException
+        (closeFd (Fd fd))
+        (do atomicPrintNoWaitS ("[munmap " ++ show addr ++ " as close(2) exception handler]")
+            c_munmap addr filelen)
 
-  -- close succeeded, we're safe now since bytestring construction will not
-  -- fail (and no exceptions are coming from outside as we're masked)
-  if addr == nullPtr
-    then fail "mapFile: could not mmap"
-    else do bs <- BS.unsafePackCStringFinalizer addr (fromIntegral @CSize @Int filelen)
-                    (do -- putStrLn ("[munmap " ++ show addr ++ "]")
-                        c_munmap addr filelen)
-            -- putStrLn ("[mmap " ++ show addr ++ "]")
-            return bs
+      -- close succeeded, we're safe now since bytestring construction will not
+      -- fail (and no exceptions are coming from outside as we're masked)
+      if addr == nullPtr
+        then fail "mapFile: could not mmap"
+        else do bs <- BS.unsafePackCStringFinalizer addr (fromIntegral @CSize @Int filelen)
+                        (do atomicPrintNoWaitS ("[munmap " ++ show addr ++ "]")
+                            c_munmap addr filelen)
+                atomicPrintNoWaitS ("[mmap " ++ show addr ++ "]")
+                return (Just bs)