Copyright | (c) 2023 Composewell Technologies |
---|---|
License | BSD3 |
Maintainer | streamly@composewell.com |
Portability | GHC |
Safe Haskell | None |
Language | Haskell2010 |
Streamly.FileSystem.Path
Description
File system paths that are extensible, high-performance and preserve the OS and filesystem encoding.
The Path
type is built on top of Streamly's Array
type, leveraging all
its operations — including support for both pinned and unpinned
representations. The API integrates with streams, prioritizes safety,
flexibility, and performance. It supports configurable equality for
cross-platform compatibility and user-defined path matching. It is designed
for extensibility and fine-grained type safety as well. For type-safe
adaptations, see the "Streamly.Internal.FileSystem.Path.*" modules.
Path
is interconvertible with the OsPath
type from the filepath
package at zero runtime cost. While the API is mostly compatible with that
of the filepath
package, some differences exist due to a slightly
different design philosophy focused on better safety.
Rooted vs Unrooted Paths
To ensure the safety of the path append operation, we distinguish between
rooted paths and free path segments or unrooted paths. A path that starts
from an explicit or implicit file system root is called a rooted path or an
anchored path. For example, /usr/bin
is a rooted path with /
as an
explicit root directory. Similarly, ./bin
is a rooted path with the
current directoy "." as an implicit root. A path that is not rooted is
called an unrooted path or unanchored path; for example, local/bin
is an
unrooted path.
This distinction ensures the safety of the path append operation. You can append only an unrooted path to another path, it does not make sense to append a rooted path to another path. The default append operation in the Path module checks for this and fails if the operation is invalid.
Rooted vs unrooted distinction is a stricter form of relative vs absolute
path distinction. In this model, for better safety, paths relative to the
current directory are also treated in the same way as absolute paths, from
the perspective of a path append operation. This is because the meaning of
current directory is context dependent and dynamic, therefore, appending it
to another path is not allowed. Only unrooted path segments (e.g.
local/bin
) can be appended to any other path using safe operations.
File vs. Directory Paths
By default, a path with a trailing separator (e.g. local/
) is implicitly
considered a directory path. However, the absence of a trailing separator
does not indicate whether the path is a file or a directory — it could be
either. Therefore, when using the Path
type, the append operation allows
appending to paths even if they lack a trailing separator.
Compatibility with the filepath package
Any path type can be converted to the FilePath
type from the filepath
package by using the toString
operation. Operations to convert to and from
the OsPath
type at zero cost are provided in the streamly-filepath
package. Zero-cost interconversion is possible because the Path
type uses
an underlying representation which is compatible with the OsPath
type.
Path Creation Quasiquoter
The path
quasiquoter is useful in creating valid paths that are checked
during the compile time.
Synopsis
- type Path = PosixPath
- type OsWord = Word8
- validatePath :: MonadThrow m => Array OsWord -> m ()
- fromArray :: MonadThrow m => Array OsWord -> m Path
- fromString :: MonadThrow m => [Char] -> m Path
- fromString_ :: [Char] -> Path
- path :: QuasiQuoter
- pathE :: String -> Q Exp
- toArray :: Path -> Array OsWord
- toString :: Path -> [Char]
- isRooted :: Path -> Bool
- isUnrooted :: Path -> Bool
- unsafeJoin :: Path -> Path -> Path
- join :: Path -> Path -> Path
- joinStr :: Path -> [Char] -> Path
- splitRoot :: Path -> Maybe (Path, Maybe Path)
- splitPath :: forall (m :: Type -> Type). Monad m => Path -> Stream m Path
- splitExtension :: Path -> Maybe (Path, Path)
- takeExtension :: Path -> Maybe Path
- dropExtension :: Path -> Path
- splitFile :: Path -> Maybe (Maybe Path, Path)
- takeFileName :: Path -> Maybe Path
- takeDirectory :: Path -> Maybe Path
- takeFileBase :: Path -> Maybe Path
- data EqCfg
- ignoreCase :: Bool -> EqCfg -> EqCfg
- ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg
- allowRelativeEquality :: Bool -> EqCfg -> EqCfg
- eqPath :: (EqCfg -> EqCfg) -> Path -> Path -> Bool
Setup
To execute the code examples provided in this module in ghci, please run the following commands first.
>>>
:m
>>>
:set -XQuasiQuotes
>>>
import Control.Exception (SomeException, evaluate, try)
>>>
import Data.Either (Either, isLeft)
>>>
import Data.Maybe (fromJust, isJust, isNothing)
>>>
import Streamly.FileSystem.Path (Path, path)
>>>
import qualified Streamly.Data.Array as Array
>>>
import qualified Streamly.Data.Stream as Stream
>>>
import qualified Streamly.FileSystem.Path as Path
>>>
import qualified Streamly.Unicode.Stream as Unicode
For APIs that have not been released yet.
>>>
import qualified Streamly.Internal.FileSystem.Path as Path
Utilities:
>>>
fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))
Type
Construction
validatePath :: MonadThrow m => Array OsWord -> m () Source #
Checks whether the filepath is valid; i.e., whether the operating system permits such a path for listing or creating files. These validations are operating system specific and file system independent. Throws an exception with a detailed explanation if the path is invalid.
>>>
isValid = isJust . Path.validatePath . Path.encodeString
Validations:
>>>
isValid ""
False>>>
isValid "\0"
False
Other than these there may be maximum path component length and maximum path length restrictions enforced by the OS as well as the filesystem which we do not validate.
fromArray :: MonadThrow m => Array OsWord -> m Path Source #
Convert an encoded array of OsWord into a value of type
Path. The path is validated using validatePath
.
Each OsWord should be encoded such that:
- The input does not contain a NUL word.
- Values from 1-128 are assumed to be ASCII characters.
Apart from the above, there are no restrictions on the encoding.
To bypass path validation checks, use unsafeFromArray
.
Throws InvalidPath
if validatePath
fails on the resulting path.
fromString :: MonadThrow m => [Char] -> m Path Source #
Encode a Unicode character string to Path using strict UTF-8
encoding. The path is validated using validatePath
.
- Throws
InvalidPath
ifvalidatePath
fails on the path - Fails if the stream contains invalid unicode characters
fromString_ :: [Char] -> Path Source #
Like fromString but a pure and partial function that throws an
InvalidPath
exception.
Statically Verified String Literals
Quasiquoters.
path :: QuasiQuoter Source #
Generates a Path type from a quoted literal. Equivalent to using
fromString
on the static literal.
>>>
Path.toString ([path|/usr/bin|] :: Path)
"/usr/bin"
Statically Verified Strings
Template Haskell expression splices.
pathE :: String -> Q Exp Source #
Generates a Haskell expression of type Path from a String. Equivalent
to using fromString
on the string passed.
Elimination
Path Info
isRooted :: Path -> Bool Source #
A path that is attached to a root e.g. "/x" or "./x" are rooted paths. "/" is considered an absolute root and "." as a dynamic root. ".." is not considered a root, "../x" or "x/y" are not rooted paths.
>>>
isRooted = Path.isRooted . Path.fromString_
>>>
isRooted "/"
True>>>
isRooted "/x"
True>>>
isRooted "."
True>>>
isRooted "./x"
True
isUnrooted :: Path -> Bool Source #
A path that is not attached to a root e.g. a/b/c
or ../b/c
.
>>>
isUnrooted = not . Path.isRooted
>>>
isUnrooted = Path.isUnrooted . Path.fromString_
>>>
isUnrooted "x"
True>>>
isUnrooted "x/y"
True>>>
isUnrooted ".."
True>>>
isUnrooted "../x"
True
Joining
unsafeJoin :: Path -> Path -> Path Source #
Like join
but does not check if the second path is rooted.
>>>
f a b = Path.toString $ Path.unsafeJoin (Path.fromString_ a) (Path.fromString_ b)
>>>
f "x" "y"
"x/y">>>
f "x/" "y"
"x/y">>>
f "x" "/y"
"x/y">>>
f "x/" "/y"
"x/y"
join :: Path -> Path -> Path Source #
Append a separator followed by another path to a Path. Fails if
the second path is a rooted path. Use unsafeJoin
to avoid failure if you
know it is ok to append the rooted path.
>>>
f a b = Path.toString $ Path.join a b
>>>
f [path|/usr|] [path|bin|]
"/usr/bin">>>
f [path|/usr/|] [path|bin|]
"/usr/bin">>>
fails (f [path|/usr|] [path|/bin|])
True
joinStr :: Path -> [Char] -> Path Source #
Append a separator followed by the supplied string to a path.
Throws InvalidPath
if the resulting path is not a valid path as per
validatePath
.
Splitting root
splitRoot :: Path -> Maybe (Path, Maybe Path) Source #
If a path is rooted then separate the root and the remaining path,
otherwise return Nothing
. The non-root
part is guaranteed to NOT start with a separator.
Some filepath package equivalent idioms:
>>>
splitDrive = Path.splitRoot
>>>
joinDrive = Path.unsafeJoin
>>>
takeDrive = fmap fst . Path.splitRoot
>>>
dropDrive x = Path.splitRoot x >>= snd
>>>
hasDrive = isJust . Path.splitRoot
>>>
isDrive = isNothing . dropDrive
>>>
toList (a,b) = (Path.toString a, fmap Path.toString b)
>>>
split = fmap toList . Path.splitRoot . Path.fromString_
>>>
split "/"
Just ("/",Nothing)
>>>
split "."
Just (".",Nothing)
>>>
split "./"
Just ("./",Nothing)
>>>
split "/home"
Just ("/",Just "home")
>>>
split "//"
Just ("//",Nothing)
>>>
split "./home"
Just ("./",Just "home")
>>>
split "home"
Nothing
Splitting path components
splitPath :: forall (m :: Type -> Type). Monad m => Path -> Stream m Path Source #
Split the path components keeping separators between path components attached to the dir part. Redundant separators are removed, only the first one is kept. Separators are not added either e.g. "." and ".." may not have trailing separators if the original path does not.
>>>
split = Stream.toList . fmap Path.toString . Path.splitPath . Path.fromString_
>>>
split "."
["."]
>>>
split "././"
["./"]
>>>
split "./a/b/."
["./","a/","b/"]
>>>
split ".."
[".."]
>>>
split "../"
["../"]
>>>
split "a/.."
["a/",".."]
>>>
split "/"
["/"]
>>>
split "//"
["/"]
>>>
split "/x"
["/","x"]
>>>
split "/./x/"
["/","x/"]
>>>
split "/x/./y"
["/","x/","y"]
>>>
split "/x/../y"
["/","x/","../","y"]
>>>
split "/x///y"
["/","x/","y"]
>>>
split "/x/\\y"
["/","x/","\\y"]
Splitting file extension
splitExtension :: Path -> Maybe (Path, Path) Source #
Returns Just(filename, extension)
if an extension is present otherwise
returns Nothing
.
A file name is considered to have an extension if the file name can be split into a non-empty filename followed by the extension separator "." followed by a non-empty extension with at least one character in addition to the extension separator. The shortest suffix obtained by this rule, starting with the extension separator, is returned as the extension and the remaining prefix part as the filename.
A directory name does not have an extension.
If you want a splitExtensions
, you can use splitExtension until the
extension returned is Nothing. dropExtensions
, isExtensionOf
can be
implemented similarly.
>>>
toList (a,b) = (Path.toString a, Path.toString b)
>>>
split = fmap toList . Path.splitExtension . Path.fromString_
>>>
split "/"
Nothing
>>>
split "."
Nothing
>>>
split ".."
Nothing
>>>
split "x"
Nothing
>>>
split "/x"
Nothing
>>>
split "x/"
Nothing
>>>
split "./x"
Nothing
>>>
split "x/."
Nothing
>>>
split "x/y."
Nothing
>>>
split "/x.y"
Just ("/x",".y")
>>>
split "/x.y."
Nothing
>>>
split "/x.y.."
Nothing
>>>
split "x/.y"
Nothing
>>>
split ".x"
Nothing
>>>
split "x."
Nothing
>>>
split ".x.y"
Just (".x",".y")
>>>
split "x/y.z"
Just ("x/y",".z")
>>>
split "x.y.z"
Just ("x.y",".z")
>>>
split "x..y"
Just ("x.",".y")
>>>
split "..."
Nothing
>>>
split "..x"
Just (".",".x")
>>>
split "...x"
Just ("..",".x")
>>>
split "x/y.z/"
Nothing
>>>
split "x/y"
Nothing
takeExtension :: Path -> Maybe Path Source #
Take the extension of a file if it has one.
>>>
takeExtension = fmap snd . Path.splitExtension
>>>
hasExtension = isJust . Path.splitExtension
>>>
fmap Path.toString $ Path.takeExtension [path|/home/user/file.txt|]
Just ".txt"
See splitExtension
for more examples.
dropExtension :: Path -> Path Source #
Drop the extension of a file if it has one.
>>>
dropExtension p = maybe p fst $ Path.splitExtension p
>>>
Path.toString $ Path.dropExtension [path|/home/user/file.txt|]
"/home/user/file"
Splitting file and dir
splitFile :: Path -> Maybe (Maybe Path, Path) Source #
If the path does not look like a directory then return Just (Maybe dir,
file)
otherwise return Nothing
. The path is not a directory if:
- the path does not end with a separator
- the path does not end with a . or .. component
Splits a single component path into Just (Nothing, path)
if it does not
look like a dir.
>>>
toList (a,b) = (fmap Path.toString a, Path.toString b)
>>>
split = fmap toList . Path.splitFile . Path.fromString_
>>>
split "/"
Nothing
>>>
split "."
Nothing
>>>
split "/."
Nothing
>>>
split ".."
Nothing
> split "//" -- Posix
Nothing
>>>
split "/home"
Just (Just "/","home")
>>>
split "./home"
Just (Just "./","home")
>>>
split "home"
Just (Nothing,"home")
>>>
split "x/"
Nothing
>>>
split "x/y"
Just (Just "x/","y")
>>>
split "x//y"
Just (Just "x//","y")
>>>
split "x/./y"
Just (Just "x/./","y")
takeFileName :: Path -> Maybe Path Source #
Extracts the file name component (with extension) from a Path, if present.
>>>
takeFileName = fmap snd . Path.splitFile
>>>
replaceDirectory p x = fmap (flip Path.join x) (takeFileName p)
>>>
fmap Path.toString $ Path.takeFileName [path|/home/user/file.txt|]
Just "file.txt">>>
fmap Path.toString $ Path.takeFileName [path|/home/user/|]
Nothing
See splitFile
for more examples.
takeDirectory :: Path -> Maybe Path Source #
Returns the parent directory of the given Path, if any.
>>>
takeDirectory x = Path.splitFile x >>= fst
>>>
replaceFileName p x = fmap (flip Path.join x) (takeDirectory p)
To get an equivalent to takeDirectory from filepath use
dropTrailingSeparators
on the result.
>>>
fmap Path.toString $ Path.takeDirectory [path|/home/user/file.txt|]
Just "/home/user/">>>
fmap Path.toString $ Path.takeDirectory [path|file.txt|]
Nothing
takeFileBase :: Path -> Maybe Path Source #
Extracts the file name dropping the extension, if any, from a Path.
>>>
takeFileBase = fmap Path.dropExtension . Path.takeFileName
>>>
fmap Path.toString $ Path.takeFileBase [path|/home/user/file.txt|]
Just "file">>>
fmap Path.toString $ Path.takeFileBase [path|/home/user/file|]
Just "file">>>
fmap Path.toString $ Path.takeFileBase [path|/home/user/.txt|]
Just ".txt">>>
fmap Path.toString $ Path.takeFileBase [path|/home/user/|]
Nothing
See splitFile
for more examples.
Equality
Options for path comparison operation. By default path comparison uses a strict criteria for equality. The following options are provided to control the strictness.
The default configuration is as follows:
>>>
:{
defaultMod = ignoreTrailingSeparators False . ignoreCase False . allowRelativeEquality False :}
ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg Source #
When set to False
(default):
>>>
cfg = Path.ignoreTrailingSeparators False
>>>
eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)
>>>
eq "x/" "x"
False
When set to True
:
>>>
cfg = Path.ignoreTrailingSeparators True
>>>
eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)
>>>
eq "x/" "x"
True
Default: False
allowRelativeEquality :: Bool -> EqCfg -> EqCfg Source #
Allow relative paths to be treated as equal. When this is False
relative
paths will never match even if they are literally equal e.g. "./x" will not
match "./x" because the meaning of "." in both cases could be different
depending on what the user meant by current directory in each case.
When set to False
(default):
>>>
cfg = Path.allowRelativeEquality False
>>>
eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)
>>>
eq "." "."
False>>>
eq "./x" "./x"
False>>>
eq "./x" "x"
False
When set to False
(default):
>>>
cfg = Path.allowRelativeEquality True
>>>
eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)
>>>
eq "." "."
True>>>
eq "./x" "./x"
True>>>
eq "./x" "x"
True
>>>
eq "./x" "././x"
True
Default: False
eqPath :: (EqCfg -> EqCfg) -> Path -> Path -> Bool Source #
Checks whether two paths are logically equal. This function takes a
configuration modifier to customize the notion of equality. For using the
default configuration pass id
as the modifier. For details about the
defaults, see EqCfg
.
eqPath performs some normalizations on the paths before comparing them, specifically it drops redundant path separators between path segments and redundant "/./" components between segments.
Default config options use strict equality, for strict equality both the paths must be absolute or both must be path segments without a leading root component (e.g. x/y). Also, both must be files or both must be directories.
In addition to the default config options, the following equality semantics are used:
- An absolute path and a path relative to "." may be equal depending on the meaning of ".", however this routine treats them as unequal, it does not resolve the "." to a concrete path.
- Two paths having ".." components may be equal after processing the ".." components even if we determined them to be unequal. However, if we determined them to be equal then they must be equal.
Using default config with case sensitive comparision, if eqPath returns equal then the paths are definitely equal, if it returns unequal then the paths may still be equal under some relaxed equality criterion.
>>>
:{
eq a b = Path.eqPath id (Path.fromString_ a) (Path.fromString_ b) :}
>>>
eq "x" "x"
True>>>
eq ".." ".."
True
Non-trailing separators and non-leading "." segments are ignored:
>>>
eq "/x" "//x"
True>>>
eq "x//y" "x/y"
True>>>
eq "x/./y" "x/y"
True>>>
eq "x/y/." "x/y"
True
Leading dot, relative paths are not equal by default:
>>>
eq "." "."
False>>>
eq "./x" "./x"
False>>>
eq "./x" "x"
False
Trailing separators are significant by default:
>>>
eq "x/" "x"
False
Match is case sensitive by default:
>>>
eq "x" "X"
False