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

Streamly.Internal.FileSystem.Path

Description

References

Windows and Posix Paths

We should be able to manipulate windows paths on posix and posix paths on windows as well. Therefore, we have WindowsPath and PosixPath types which are supported on both platforms. However, the Path module aliases Path to WindowsPath on Windows and PosixPath on Posix.

File System as Tree vs Graph

A file system is a tree when there are no hard links or symbolic links. But in the presence of symlinks it could be a DAG or a graph, because directory symlinks can create cycles.

Rooted and Branch paths

We make two distinctions for paths, a path may a specific filesystem root attached to it or it may be a free branch without a root attached.

A path that has a root attached to it is called a rooted path e.g. /usr is a rooted path, . is a rooted path, ./bin is a rooted path. A rooted path could be absolute e.g. usr or it could be relative e.g. .bin . A rooted path always has two components, a specific "root" which could be explicit or implicit, and a path segment relative to the root. A rooted path with a fixed root is known as an absolute path whereas a rooted path with an implicit root e.g. "./bin" is known as a relative path.

A path that does not have a root attached but defines steps to go from some place to another is a path branch. For example, "local/bin" is a path branch whereas ".localbin" is a rooted path.

Rooted paths can never be appended to any other path whereas a branch can be appended.

Comparing Paths

We can compare two absolute rooted paths or path branches but we cannot compare two relative rooted paths. If each component of the path is the same then the paths are considered to be equal.

Implicit Roots (.)

On Posix and Windows "." implicitly refers to the current directory. On Windows a path like Users has the drive reference implicit. Such references are contextual and may have different meanings at different times.

./bin may refer to a different location depending on what "." is referring to. Thus we should not allow ./bin to be appended to another path, bin can be appended though. Similarly, we cannot compare ./bin with ./bin and say that they are equal because they may be referring to different locations depending on in what context the paths were created.

The same arguments apply to paths with implicit drive on Windows.

We can treat ./bin/ls as an absolute path with "." as an implicit root. The relative path is "bin/ls" which represents steps from somewhere to somewhere else rather than a particular location. We can also call ./bin as a "rooted path" as it starts from particular location rather than defining "steps" to go from one place to another. If we want to append such paths we need to first make them explicitly relative by dropping the implicit root. Or we can use unsafeAppend to force it anyway or unsafeCast to convert absolute to relative.

On these absolute (Rooted) paths if we use takeRoot, it should return RootCurDir, RootCurDrive and Root Path to distinguish ./, /, C:/. We could represent them by different types but that would make the types even more complicated. So runtime checks are are a good balance.

Path comparison should return EqTrue, EqFalse or EqUnknown. If we compare these absolute/located paths having implicit roots then result should be EqUnknown or maybe we can just return False?. ./bin and ./bin should be treated as paths with different roots/drives but same relative path. The programmer can explicitly drop the root and compare the relative paths if they want to check literal equality.

Note that a trailing . or a . in the middle of a path is different as it refers to a known name.

Ambiguous References (..)

".." in a path refers to the parent directory relative to the current path. For an absolute root directory ".." refers to the root itself because you cannot go further up.

When resolving ".." it always resolves to the parent of a directory as stored in the directory entry. So if we landed in a directory via a symlink, ".." can take us back to a different directory and not to the symlink itself. Thus a/b/.. may not be the same as a/. Shells like bash keep track of the old paths explicitly, so you may not see this behavior when using a shell.

For this reason we cannot process ".." in the path statically. However, if the components of two paths are exactly the same then they will always resolve to the same target. But two paths with different components could also point to the same target. So if there are ".." in the path we cannot definitively say if they are the same without resolving them.

Exception Handling

Path creation routines use MonadThrow which can be interpreted as an Either type. It is rare to actually handle exceptions in path creation functions, we would rather fix the issue, so partial functions should also be fine. But there may be some cases where we are parsing paths from external inputs, reading from a file etc where we may want to handle exceptions. We can always create partial wrappers from these if that is convenient to use.

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

Conversions

class IsPath a b where Source #

If the type a b is a member of IsPath it means we know how to convert the type b to and from the base type a.

Methods

unsafeFromPath :: a -> b Source #

Like fromPath but does not check the properties of Path. The user is responsible to maintain the invariants enforced by the type b otherwise surprising behavior may result.

This operation provides performance and simplicity when we know that the properties of the path are already verified, for example, when we get the path from the file system or from the OS APIs.

fromPath :: MonadThrow m => a -> m b Source #

Convert a base path type to other forms of well-typed paths. It may fail if the path does not satisfy the properties of the target type.

toPath :: b -> a Source #

Convert a well-typed path to the base path type. Never fails.

Instances

Instances details
IsPath PosixPath PosixPath Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath

IsPath WindowsPath WindowsPath Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath

IsPath PosixPath (Dir PosixPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.Node

IsPath PosixPath (File PosixPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.Node

IsPath PosixPath (Rooted PosixPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.Seg

IsPath PosixPath (Rooted (Dir PosixPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.SegNode

IsPath PosixPath (Rooted (File PosixPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.SegNode

IsPath PosixPath (Unrooted PosixPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.Seg

IsPath PosixPath (Unrooted (Dir PosixPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.SegNode

IsPath PosixPath (Unrooted (File PosixPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.PosixPath.SegNode

IsPath WindowsPath (Dir WindowsPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.Node

IsPath WindowsPath (File WindowsPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.Node

IsPath WindowsPath (Rooted WindowsPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.Seg

IsPath WindowsPath (Rooted (Dir WindowsPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.SegNode

IsPath WindowsPath (Rooted (File WindowsPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.SegNode

IsPath WindowsPath (Unrooted WindowsPath) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.Seg

IsPath WindowsPath (Unrooted (Dir WindowsPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.SegNode

IsPath WindowsPath (Unrooted (File WindowsPath)) Source # 
Instance details

Defined in Streamly.Internal.FileSystem.WindowsPath.SegNode

adapt :: (MonadThrow m, IsPath Path a, IsPath Path b) => a -> m b Source #

Convert a path type to another path type. This operation may fail with a PathException when converting a less restrictive path type to a more restrictive one. This can be used to upgrade or downgrade type safety.

Conversion to OsWord

charToWord :: Char -> OsWord Source #

Unsafe, truncates the Char to Word8 on Posix and Word16 on Windows.

wordToChar :: OsWord -> Char Source #

Unsafe, should be a valid character.

Validation

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.

isValidPath :: Array OsWord -> Bool Source #

Returns True if the filepath is valid:

>>> isValidPath = isJust . Path.validatePath

Construction

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.

unsafeFromArray :: Array OsWord -> Path Source #

Unsafe: The user is responsible to make sure that the path is valid as per validatePath.

fromChars :: MonadThrow m => Stream Identity Char -> m Path Source #

Like fromString but a streaming operation.

>>> fromString = Path.fromChars . Stream.fromList

We do not sanitize the path i.e. we do not remove duplicate separators, redundant . segments, trailing separators etc because that would require unnecessary checks and modifications to the path which may not be used ever for any useful purpose, it is only needed for path equality and can be done during the equality check.

Unicode normalization is not done. If normalization is needed the user can normalize it and then use the fromArray API.

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.

encodeString :: [Char] -> Array OsWord Source #

Create an array from a path string using strict UTF-8 encoding. The path is not validated, therefore, it may not be valid according to validatePath.

Same as toArray . unsafeFromString.

unsafeFromString :: [Char] -> Path Source #

Like fromString but does not perform any validations mentioned under validatePath. Fails only if unicode encoding fails.

readArray :: [Char] -> Path Source #

Parse a raw array of bytes as a path type.

>>> readArray = fromJust . Path.fromArray . read
>>> arr = Path.encodeString "hello"
>>> Path.showArray $ (Path.readArray $ show arr :: Path.Path)
"fromList [104,101,108,108,111]"

See also: showArray.

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.

toChars :: forall (m :: Type -> Type). Monad m => Path -> Stream m Char Source #

Decode the path to a stream of Unicode chars using strict UTF-8 decoding.

toChars_ :: forall (m :: Type -> Type). Monad m => Path -> Stream m Char Source #

Decode the path to a stream of Unicode chars using lax UTF-8 decoding.

toString :: Path -> [Char] Source #

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

asOsCString :: Path -> (OsCString -> IO a) -> IO a Source #

Use the path as a pinned CString. Useful for using a PosixPath in system calls on Posix.

toString_ :: Path -> [Char] Source #

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

showArray :: Path -> [Char] Source #

Show the path as raw characters without any specific decoding.

See also: readArray.

Separators

separator :: OsWord Source #

The primary path separator word: / on POSIX and \ on Windows. Windows also supports / as a valid separator. Use isSeparator to check for any valid path separator.

isSeparator :: OsWord -> Bool Source #

On POSIX, only / is a path separator, whereas on Windows both / and \ are valid separators.

extSeparator :: OsWord Source #

File extension separator word.

Dir or non-dir paths

dropTrailingSeparators :: Path -> Path Source #

Remove all trailing path separators from the given Path.

Instead of this operation you may want to use eqPath with ignoreTrailingSeparators option.

This operation is careful not to alter the semantic meaning of the path. For example, on Windows:

  • Dropping the separator from "C:/" would change the meaning of the path from referring to the root of the C: drive to the current directory on C:.
  • If a path ends with a separator immediately after a colon (e.g., "C:/"), the separator will not be removed.

If the input path is invalid, the behavior is not fully guaranteed:

  • The separator may still be dropped.
  • In some cases, dropping the separator may make an invalid path valid (e.g., "C:\\" or "C:\/").

This operation may convert a path that implicitly refers to a directory into one that does not.

Typically, if the path is dir//, the result is dir. Special cases include:

  • On POSIX: dropping from "//" yields "/".
  • On Windows: dropping from "C://" results in "C:/".

Examples:

>>> f = Path.toString . Path.dropTrailingSeparators . Path.fromString_
>>> f "./"
"."
> f "//"  -- On POSIX

"/"

hasTrailingSeparator :: Path -> Bool Source #

Returns True if the path ends with a trailing separator.

This typically indicates that the path is a directory, though this is not guaranteed in all cases.

Example:

>>> Path.hasTrailingSeparator (Path.fromString_ "foo/")
True
>>> Path.hasTrailingSeparator (Path.fromString_ "foo")
False

addTrailingSeparator :: Path -> Path Source #

Add a trailing path separator to a path if it doesn't already have one.

Instead of this operation you may want to use eqPath with ignoreTrailingSeparators option.

This function avoids modifying the path if doing so would change its meaning or make it invalid. For example, on Windows:

  • Adding a separator to "C:" would change it from referring to the current directory on the C: drive to the root directory.
  • Adding a separator to "\" could turn it into a UNC share path, which may not be intended.
  • If the path ends with a colon (e.g., "C:"), a separator is not added.

This operation typically makes the path behave like an implicit directory path.

Path Segment Types

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

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.

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"

joinCStr :: Path -> CString -> IO Path Source #

Append a separator and a CString to the Array. This is like unsafeJoin but always inserts a separator between the two paths even if the first path has a trailing separator or second path has a leading separator.

joinCStr' :: Path -> CString -> IO Path Source #

Like joinCStr but creates a pinned path.

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

joinDir :: Path -> Path -> Path Source #

A stricter version of join which requires the first path to be a directory like path i.e. having a trailing separator.

>>> f a b = Path.toString $ Path.joinDir a b
>>> fails $ f [path|/usr|] [path|bin|]
True

unsafeJoinPaths :: [Path] -> Path Source #

Join paths by path separator. Does not check if the paths being appended are rooted or branches. Note that splitting and joining may not give exactly the original path but an equivalent path.

Unimplemented

Splitting

Note: you can use unsafeJoin as a replacement for the joinDrive function in the filepath package.

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

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"]

splitPath_ :: forall (m :: Type -> Type). Monad m => Path -> Stream m Path Source #

Split a path into components separated by the path separator. "." components in the path are ignored except when in the leading position. Trailing separators in non-root components are dropped.

>>> split = Stream.toList . fmap Path.toString . Path.splitPath_ . Path.fromString_
>>> split "."
["."]
>>> split "././"
["."]
>>> split ".//"
["."]
>>> split "//"
["/"]
>>> split "//x/y/"
["/","x","y"]
>>> split "./a"
[".","a"]
>>> split "a/."
["a"]
>>> 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"]

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")

splitFirst :: Path -> (Path, Maybe Path) Source #

Split the path into the first component and rest of the path. Treats the entire root or share name, if present, as the first component.

Unimplemented

splitLast :: Path -> (Maybe Path, Path) Source #

Split the path into the last component and rest of the path. Treats the entire root or share name, if present, as the first component.

>>> basename = snd . Path.splitLast -- Posix basename
>>> dirname = fst . Path.splitLast -- Posix dirname

Unimplemented

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

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"

addExtension :: Path -> Path -> Path Source #

Add an extension to a file path. If a non-empty extension does not start with a leading dot then a dot is inserted, otherwise the extension is concatenated with the path.

It is an error to add an extension to a path with a trailing separator.

Unimplemented

Path View

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

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.

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

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

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

When set to False, comparison is case sensitive.

Posix Default: False

Windows Default: True

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

eqPathBytes :: Path -> Path -> Bool Source #

Check two paths for byte level equality. This is the most strict path equality check.

>>> eqPath a b = Path.eqPathBytes (Path.fromString_ a) (Path.fromString_ b)
>>> eqPath "x//y"  "x//y"
True
>>> eqPath "x//y"  "x/y"
False
>>> eqPath "x/./y"  "x/y"
False
>>> eqPath "x\\y" "x/y"
False
>>> eqPath "./file"  "file"
False
>>> eqPath "file/"  "file"
False

normalize :: EqCfg -> Path -> Path Source #

Convert the path to an equivalent but standard format for reliable comparison. This can be implemented if required. Usually, the equality operations should be enough and this may not be needed.

Unimplemented