streamly-core
Copyright(c) 2023 Composewell Technologies
LicenseBSD3
Maintainerstreamly@composewell.com
PortabilityGHC
Safe HaskellNone
LanguageHaskell2010

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

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.

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

toArray :: Path -> Array OsWord Source #

Convert the path to an array.

toString :: Path -> [Char] Source #

Decode the path to a Unicode string using strict UTF-8 decoding.

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

data EqCfg Source #

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
:}

ignoreCase :: Bool -> EqCfg -> EqCfg Source #

When set to False, comparison is case sensitive.

Posix Default: False

Windows Default: True

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