Updating the documentation and semantics testing for MustExist.

Author: recursion-ninja

fs-api/src-win32/System/FS/IO/Windows.hs

@@ -60,7 +60,7 @@ open filename openMode = do
       ReadWriteMode ex -> (gENERIC_READ .|. gENERIC_WRITE, createNew ex)
     createNew AllowExisting = oPEN_ALWAYS
     createNew MustBeNew     = cREATE_NEW
-    createNew MustExist     = oPEN_ALWAYS
+    createNew MustExist     = oPEN_EXISTING
 
 write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32
 write fh data' bytes = withOpenHandle "write" fh $ \h ->

fs-api/src/System/FS/API/Types.hs

@@ -70,6 +70,15 @@ import           System.FS.Condense
 -------------------------------------------------------------------------------}
 
 -- | How to 'System.FS.API.hOpen' a new file.
+--
+-- Each mode of file operation has an associated 'AllowExisting' parameter which
+-- specifies the semantics of how to handle the existence or non-existence of
+-- the file.
+--
+-- /Notably however/, opening a file in read mode with the @ReadMode@ value
+-- /implicitly/ has the associated 'AllowExisting' value of 'MustExist'.
+-- This is beacause opening a non-existing file in 'ReadMode' provides access to
+-- exactly 0 bytes of data and is hence a useless operation.
 data OpenMode
   = ReadMode
   | WriteMode     AllowExisting
@@ -88,11 +97,14 @@ data AllowExisting
   | MustExist
     -- ^ The file must already exist. If it does not, an error
     -- ('FsResourceDoesNotExist') is thrown.
+    --
+    -- /Note:/ If opening a file in 'ReadMode', then the file must exist
+    -- or an exception is thrown.
   deriving (Eq, Show)
 
 allowExisting :: OpenMode -> AllowExisting
 allowExisting openMode = case openMode of
-  ReadMode         -> AllowExisting
+  ReadMode         -> MustExist
   WriteMode     ex -> ex
   AppendMode    ex -> ex
   ReadWriteMode ex -> ex

fs-sim/src/System/FS/Sim/FsTree.hs

@@ -231,18 +231,23 @@ getDir fp =
   Specific file system functions
 -------------------------------------------------------------------------------}
 
--- | Open a file based on an 'AllowExisting'.
+-- | Open a file: create it if necessary or throw an error if either:
+--    1. It existed already while we were supposed to create it from scratch
+--        (when passed 'MustBeNew').
+--    2. It did not already exists when we expected to (when passed 'MustExist').
 openFile :: Monoid a
          => FsPath -> AllowExisting -> FsTree a -> Either FsTreeError (FsTree a)
 openFile fp ex = alterFile fp Left caseDoesNotExist caseAlreadyExist
   where
     caseAlreadyExist a = case ex of
+      AllowExisting -> Right a
       MustBeNew -> Left (FsExists fp)
-      _         -> Right a
+      MustExist -> Right a
 
     caseDoesNotExist = case ex of
+      AllowExisting -> Right mempty
+      MustBeNew -> Right mempty
       MustExist -> Left (FsMissing fp (pathLast fp :| []))
-      _         -> Right mempty
 
 -- | Replace the contents of the specified file (which must exist)
 replace :: FsPath -> a -> FsTree a -> Either FsTreeError (FsTree a)

fs-sim/src/System/FS/Sim/MockFS.hs

@@ -65,7 +65,7 @@ module System.FS.Sim.MockFS (
   , hPutBufSomeAt
   ) where
 
-import           Control.Monad (forM, forM_, unless, void, when)
+import           Control.Monad (forM, forM_, unless, when)
 import           Control.Monad.Except (MonadError, throwError)
 import           Control.Monad.Primitive (PrimMonad (..))
 import           Control.Monad.State.Strict (MonadState, get, gets, put)
@@ -479,11 +479,7 @@ hOpen fp openMode = do
       , fsLimitation  = True
       }
     modifyMockFS $ \fs -> do
-      let assumedExistance (WriteMode MustExist) = True
-          assumedExistance (AppendMode MustExist) = True
-          assumedExistance (ReadWriteMode MustExist) = True
-          assumedExistance _ = False
-          alreadyHasWriter =
+      let alreadyHasWriter =
             any (\hs -> openFilePath hs == fp && isWriteHandle hs) $
             openHandles fs
       when (openMode /= ReadMode && alreadyHasWriter) $
@@ -495,8 +491,6 @@ hOpen fp openMode = do
           , fsErrorStack  = prettyCallStack
           , fsLimitation  = True
           }
-      when (openMode == ReadMode || assumedExistance openMode) $ void $
-        checkFsTree $ FS.getFile fp (mockFiles fs)
       files' <- checkFsTree $ FS.openFile fp ex (mockFiles fs)
       return $ newHandle (fs { mockFiles = files' })
                          (OpenHandle fp (filePtr openMode))

fs-sim/test/Test/System/FS/StateMachine.hs

@@ -1004,92 +1004,94 @@ data Tag =
   -- > Get ..
   | TagPutTruncateGet
 
-  -- Close a handle 2 times
+  -- | Close a handle 2 times
   --
   -- > h <- Open ..
   -- > close h
   -- > close h
   | TagClosedTwice
 
-  -- Open an existing file with ReadMode and then with WriteMode
+  -- | Open an existing file with ReadMode and then with WriteMode
   --
   -- > open fp ReadMode
   -- > open fp Write
   | TagOpenReadThenWrite
 
-  -- Open 2 Readers of a file.
+  -- | Open 2 Readers of a file.
   --
   -- > open fp ReadMode
   -- > open fp ReadMode
   | TagOpenReadThenRead
 
-  -- ListDir on a non empty dirextory.
+  -- | ListDir on a non empty dirextory.
   --
   -- > CreateDirIfMissing True a/b
   -- > ListDirectory a
   | TagCreateDirWithParentsThenListDirNotNull
 
-  -- Read from an AppendMode file
+  -- | Read from an AppendMode file
   --
   -- > h <- Open fp AppendMode
   -- > Read h ..
   | TagReadInvalid
 
-  -- Write to a read only file
+  -- | Write to a read only file
   --
   -- > h <- Open fp ReadMode
   -- > Put h ..
   | TagWriteInvalid
 
-  -- Put Seek and Get
+  -- | Put Seek and Get
   --
   -- > Put ..
   -- > Seek ..
   -- > Get ..
   | TagPutSeekGet
 
-  -- Put Seek (negative) and Get
+  -- | Put Seek (negative) and Get
   --
   -- > Put ..
   -- > Seek .. (negative)
   -- > Get ..
   | TagPutSeekNegGet
 
-
-  -- Open with MustBeNew (O_EXCL flag), but the file already existed.
+  -- | Open with MustBeNew (O_EXCL flag), but the file already existed.
   --
   -- > h <- Open fp (AppendMode _)
   -- > Close h
   -- > Open fp (AppendMode MustBeNew)
   | TagExclusiveFail
 
-
-  -- Open with MustExist, but the file does not exist.
+  -- | Open with MustExist, but the file does not exist.
   --
   -- > DoesFileExist fp
   -- > h <- Open fp (AppendMode _)
   | TagAssumeExists
 
+  -- | Open in ReadMode, but the file does not exist.
+  --
+  -- > DoesFileExist fp
+  -- > h <- Open fp ReadMode
+  | TagReadMustExist
 
-  -- Reading returns an empty bytestring when EOF
+  -- | Reading returns an empty bytestring when EOF
   --
   -- > h <- open fp ReadMode
   -- > Get h 1 == ""
   | TagReadEOF
 
-
-  -- GetAt
+  -- | GetAt
   --
   -- > GetAt ...
   | TagPread
 
-  -- Roundtrip for I/O with user-supplied buffers
+  -- | Roundtrip for I/O with user-supplied buffers
   --
   -- > PutBuf h bs c
   -- > GetBuf h c          (==bs)
   | TagPutGetBuf
 
-  -- Roundtrip for I/O with user-supplied buffers
+  -- | Roundtrip for I/O with user-supplied buffers
   --
   -- > PutBufAt h bs c o
   -- > GetBufAt h c o      (==bs)
@@ -1144,7 +1146,8 @@ tag = C.classify [
     , tagPutSeekGet Set.empty Set.empty
     , tagPutSeekNegGet Set.empty Set.empty
     , tagExclusiveFail
---    , tagAssumeExistsFail -- Set.empty
+    , tagAssumeExistsFail
+    , tagReadMustExistFail
     , tagReadEOF
     , tagPread
     , tagPutGetBuf Set.empty
@@ -1492,21 +1495,21 @@ tag = C.classify [
 
     tagAssumeExistsFail :: EventPred
     tagAssumeExistsFail = C.predicate $ \ev ->
-{-      
-    tagClosedTwice closed = successful $ \ev _suc ->
-      case eventMockCmd ev of
-        Close (Handle h _) | Set.member h closed -> Left TagClosedTwice
-        Close (Handle h _) -> Right $ tagClosedTwice $ Set.insert h closed
-        _otherwise -> Right $ tagClosedTwice closed
-        (DoesFileExist _, Bool False) -> Left TagDoesFileExistKO
--}
       case (eventMockCmd ev, eventMockResp ev) of
         (Open _ mode, Resp (Left fsError))
           | MustExist <- allowExisting mode
           , fsErrorType fsError == FsResourceDoesNotExist ->
             Left TagAssumeExists
         _otherwise -> Right tagAssumeExistsFail
 
+    tagReadMustExistFail :: EventPred
+    tagReadMustExistFail = C.predicate $ \ev ->
+      case (eventMockCmd ev, eventMockResp ev) of
+        (Open _ ReadMode, Resp (Left fsError))
+          | fsErrorType fsError == FsResourceDoesNotExist ->
+            Left TagReadMustExist
+        _otherwise -> Right tagReadMustExistFail
+
     tagReadEOF :: EventPred
     tagReadEOF = successful $ \ev suc ->
       case (eventMockCmd ev, suc) of