diff --git a/fs-api/CHANGELOG.md b/fs-api/CHANGELOG.md index 0dde19c..c530bd8 100644 --- a/fs-api/CHANGELOG.md +++ b/fs-api/CHANGELOG.md @@ -29,9 +29,8 @@ ### Patch -* Add a clarification in the documentation of `fsPathFromList` that each path - component should be non-empty, because directories/files with empty names are - not valid! Also, add an `assert`ion to `fsPathFromList` for this precondition. +* Add a clarification in the documentation of `FsPath` that the user is + responsible for picking sensible directory/file names. ## 0.2.0.1 -- 2023-10-30 diff --git a/fs-api/src/System/FS/API/Types.hs b/fs-api/src/System/FS/API/Types.hs index 0863271..0ee9244 100644 --- a/fs-api/src/System/FS/API/Types.hs +++ b/fs-api/src/System/FS/API/Types.hs @@ -101,6 +101,26 @@ allowExisting openMode = case openMode of -------------------------------------------------------------------------------} -- | A relative path. +-- +-- === Invariant +-- +-- The user of this library is tasked with picking sensible names of +-- directories/files on a path. Amongst others, the following should hold: +-- +-- * Names are non-empty +-- +-- * Names are monotonic, i.e., they are not equal to @..@ +-- +-- * Names should not contain path separators or drive letters +-- +-- In particular, names that satisfy these invariants should result in an +-- 'FsPath' that remains relative to the HasFS instance root. For example, an +-- @'FsPath' ["/"]@ would try to access the root folder, which is most likely +-- outside of the scope of the HasFS instance. +-- +-- \"@..@\" should not be used because @fs-sim@ will not be able to follow these +-- types of back-links. @fs-sim@ will interpret \"@..@\" as a directory name +-- instead. newtype FsPath = UnsafeFsPath { fsPathToList :: [Strict.Text] } deriving (Eq, Ord, Generic) deriving newtype NFData @@ -108,7 +128,7 @@ newtype FsPath = UnsafeFsPath { fsPathToList :: [Strict.Text] } -- | Create a path from a list of directory/file names. All of the names should -- be non-empty. fsPathFromList :: [Strict.Text] -> FsPath -fsPathFromList xs = assert (not (any Strict.null xs)) $ UnsafeFsPath (force xs) +fsPathFromList xs = UnsafeFsPath (force xs) instance Show FsPath where show = intercalate "/" . map Strict.unpack . fsPathToList diff --git a/fs-api/test/Test/System/FS/API/FsPath.hs b/fs-api/test/Test/System/FS/API/FsPath.hs index 6e02244..b1e3eb3 100644 --- a/fs-api/test/Test/System/FS/API/FsPath.hs +++ b/fs-api/test/Test/System/FS/API/FsPath.hs @@ -19,8 +19,16 @@ tests = testGroup "Test.System.FS.API.FsPath" [ -- | Orphan instance that generates a __non-empty__ text! instance Arbitrary Text where - arbitrary = Text.pack <$> (arbitrary `suchThat` (not . null)) - shrink x = [Text.pack x'' | let x' = Text.unpack x, x'' <- shrink x'] + arbitrary = Text.pack <$> QC.listOf (QC.elements validChars) `suchThat` (not . null) + shrink x = [ x''' | let x' = Text.unpack x + , x'' <- shrink x' + , not (null x'') + , let x''' = Text.pack x'' ] + +-- | We pick a small subset of characters to use in directory/file names, so +-- that we don't break the invariant of 'FsPath'. +validChars :: [Char] +validChars = concat [['a'..'z'], ['A'..'Z'], ['0'..'9']] -- | Commutativity property for 'FS.' and 'FilePath.'. -- @@ -65,7 +73,7 @@ prop_addExtensionCommutes mnt path ext = .&&. FilePath.makeValid lhs === FilePath.makeValid rhs where mnt' = filePathFromList mnt - mnt'' = FS.MountPoint (filePathFromList mnt) + mnt'' = FS.MountPoint mnt' fsp = FS.fsPathFromList path FS.<.> ext lhs = FS.fsToFilePath mnt'' fsp rhs = mnt' FilePath. filePathFromList path FilePath.<.> ext