Copyright | © 2021 Julian Ospald |
---|---|
License | MIT |
Maintainer | Julian Ospald <hasufell@posteo.de> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
An implementation of the Abstract FilePath Proposal,
which aims to supersede type FilePath = String
for various reasons:
- it is more efficient and avoids memory fragmentation (uses unpinned
ShortByteString
under the hood) - it is more type-safe (newtype over
ShortByteString
) - avoids round-tripping issues by not converting to String (which is not total and loses the encoding)
- abstracts over unix and windows while keeping the original bytes
It is important to know that filenames/filepaths have different representations across platforms:
- On Windows, filepaths are expected to be encoded as UTF16-LE as per the documentation, but
may also include invalid surrogate pairs, in which case UCS-2 can be used. They are passed as
wchar_t*
to syscalls.OsPath
only maintains the wide character invariant. - On Unix, filepaths don't have a predefined encoding (although they
are often interpreted as UTF8) as per the
POSIX specification
and are passed as
char[]
to syscalls.OsPath
maintains no invariant here.
Apart from encoding, filepaths have additional restrictions per platform:
- On Windows the naming convention may apply
- On Unix, only
NUL
bytes are disallowed as per the POSIX specification
Use isValid
to check for these restrictions (OsPath
doesn't
maintain this invariant).
Also note that these restrictions are not exhaustive and further filesystem specific restrictions may apply on all platforms. This library makes no attempt at satisfying these. Library users may need to account for that, depending on what filesystems they want to support.
It is advised to follow these principles when dealing with filepaths/filenames:
- Avoid interpreting filenames that the OS returns, unless absolutely necessary.
For example, the filepath separator is usually a predefined
Word8
/Word16
, regardless of encoding. So even if we need to split filepaths, it might still not be necessary to understand the encoding of the filename. - When interpreting OS returned filenames consider that these might not be UTF8 on unix
or at worst don't have an ASCII compatible encoding. The are 3 available strategies fer decoding/encoding:
a) pick the best UTF (UTF-8 on unix, UTF-16LE on windows), b) decode with an explicitly defined
TextEncoding
, c) mimic the behavior of thebase
library (permissive UTF16 on windows, current filesystem encoding on unix). - Avoid comparing
String
based filepaths, because filenames of different encodings may have the sameString
representation, although they're not the same byte-wise.
Synopsis
- type OsPath = OsString
- data OsString
- data OsChar
- encodeUtf :: MonadThrow m => FilePath -> m OsPath
- encodeWith :: TextEncoding -> TextEncoding -> FilePath -> Either EncodingException OsPath
- encodeFS :: FilePath -> IO OsPath
- osp :: QuasiQuoter
- pack :: [OsChar] -> OsPath
- decodeUtf :: MonadThrow m => OsPath -> m FilePath
- decodeWith :: TextEncoding -> TextEncoding -> OsPath -> Either EncodingException FilePath
- decodeFS :: OsPath -> IO FilePath
- unpack :: OsPath -> [OsChar]
- unsafeFromChar :: Char -> OsChar
- toChar :: OsChar -> Char
- pathSeparator :: OsChar
- pathSeparators :: [OsChar]
- isPathSeparator :: OsChar -> Bool
- searchPathSeparator :: OsChar
- isSearchPathSeparator :: OsChar -> Bool
- extSeparator :: OsChar
- isExtSeparator :: OsChar -> Bool
- splitSearchPath :: OsString -> [OsPath]
- splitExtension :: OsPath -> (OsPath, OsString)
- takeExtension :: OsPath -> OsString
- replaceExtension :: OsPath -> OsString -> OsPath
- (-<.>) :: OsPath -> OsString -> OsPath
- dropExtension :: OsPath -> OsPath
- addExtension :: OsPath -> OsString -> OsPath
- hasExtension :: OsPath -> Bool
- (<.>) :: OsPath -> OsString -> OsPath
- splitExtensions :: OsPath -> (OsPath, OsString)
- dropExtensions :: OsPath -> OsPath
- takeExtensions :: OsPath -> OsString
- replaceExtensions :: OsPath -> OsString -> OsPath
- isExtensionOf :: OsString -> OsPath -> Bool
- stripExtension :: OsString -> OsPath -> Maybe OsPath
- splitFileName :: OsPath -> (OsPath, OsPath)
- takeFileName :: OsPath -> OsPath
- replaceFileName :: OsPath -> OsString -> OsPath
- dropFileName :: OsPath -> OsPath
- takeBaseName :: OsPath -> OsPath
- replaceBaseName :: OsPath -> OsString -> OsPath
- takeDirectory :: OsPath -> OsPath
- replaceDirectory :: OsPath -> OsPath -> OsPath
- combine :: OsPath -> OsPath -> OsPath
- (</>) :: OsPath -> OsPath -> OsPath
- splitPath :: OsPath -> [OsPath]
- joinPath :: [OsPath] -> OsPath
- splitDirectories :: OsPath -> [OsPath]
- splitDrive :: OsPath -> (OsPath, OsPath)
- joinDrive :: OsPath -> OsPath -> OsPath
- takeDrive :: OsPath -> OsPath
- hasDrive :: OsPath -> Bool
- dropDrive :: OsPath -> OsPath
- isDrive :: OsPath -> Bool
- hasTrailingPathSeparator :: OsPath -> Bool
- addTrailingPathSeparator :: OsPath -> OsPath
- dropTrailingPathSeparator :: OsPath -> OsPath
- normalise :: OsPath -> OsPath
- equalFilePath :: OsPath -> OsPath -> Bool
- makeRelative :: OsPath -> OsPath -> OsPath
- isRelative :: OsPath -> Bool
- isAbsolute :: OsPath -> Bool
- isValid :: OsPath -> Bool
- makeValid :: OsPath -> OsPath
Types
type OsPath = OsString Source #
Type representing filenames/pathnames.
This type doesn't add any guarantees over OsString
.
Newtype representing short operating system specific strings.
Internally this is either WindowsString
or PosixString
,
depending on the platform. Both use unpinned
ShortByteString
for efficiency.
The constructor is only exported via System.OsString.Internal.Types, since dealing with the internals isn't generally recommended, but supported in case you need to write platform specific code.
Instances
Monoid OsString Source # | "String-Concatenation" for |
Semigroup OsString Source # | |
Generic OsString Source # | |
Show OsString Source # | On windows, decodes as UCS-2. On unix prints the raw bytes without decoding. |
NFData OsString Source # | |
Defined in System.OsString.Internal.Types | |
Eq OsString Source # | Byte equality of the internal representation. |
Ord OsString Source # | Byte ordering of the internal representation. |
Defined in System.OsString.Internal.Types | |
Lift OsString Source # | |
type Rep OsString Source # | |
Defined in System.OsString.Internal.Types type Rep OsString = D1 ('MetaData "OsString" "System.OsString.Internal.Types" "filepath-1.4.100.4-2ou6v9Oza7x86l4jie19Fo" 'True) (C1 ('MetaCons "OsString" 'PrefixI 'True) (S1 ('MetaSel ('Just "getOsString") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PlatformString))) |
Newtype representing a code unit.
On Windows, this is restricted to two-octet codepoints Word16
,
on POSIX one-octet (Word8
).
Instances
Generic OsChar Source # | |
Show OsChar Source # | |
NFData OsChar Source # | |
Defined in System.OsString.Internal.Types | |
Eq OsChar Source # | Byte equality of the internal representation. |
Ord OsChar Source # | Byte ordering of the internal representation. |
type Rep OsChar Source # | |
Defined in System.OsString.Internal.Types type Rep OsChar = D1 ('MetaData "OsChar" "System.OsString.Internal.Types" "filepath-1.4.100.4-2ou6v9Oza7x86l4jie19Fo" 'True) (C1 ('MetaCons "OsChar" 'PrefixI 'True) (S1 ('MetaSel ('Just "getOsChar") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PlatformChar))) |
Filepath construction
encodeUtf :: MonadThrow m => FilePath -> m OsPath Source #
Partial unicode friendly encoding.
On windows this encodes as UTF16-LE (strictly), which is a pretty good guess. On unix this encodes as UTF8 (strictly), which is a good guess.
Throws a EncodingException
if encoding fails.
:: TextEncoding | unix text encoding |
-> TextEncoding | windows text encoding |
-> FilePath | |
-> Either EncodingException OsPath |
Encode a FilePath
with the specified encoding.
encodeFS :: FilePath -> IO OsPath Source #
Like encodeUtf
, except this mimics the behavior of the base library when doing filesystem
operations, which is:
- on unix, uses shady PEP 383 style encoding (based on the current locale, but PEP 383 only works properly on UTF-8 encodings, so good luck)
- on windows does permissive UTF-16 encoding, where coding errors generate Chars in the surrogate range
Looking up the locale requires IO. If you're not worried about calls
to setFileSystemEncoding
, then unsafePerformIO
may be feasible (make sure
to deeply evaluate the result to catch exceptions).
osp :: QuasiQuoter Source #
Filepath deconstruction
decodeUtf :: MonadThrow m => OsPath -> m FilePath Source #
Partial unicode friendly decoding.
On windows this decodes as UTF16-LE (strictly), which is a pretty good guess. On unix this decodes as UTF8 (strictly), which is a good guess.
Throws a EncodingException
if decoding fails.
:: TextEncoding | unix text encoding |
-> TextEncoding | windows text encoding |
-> OsPath | |
-> Either EncodingException FilePath |
Decode an OsPath
with the specified encoding.
decodeFS :: OsPath -> IO FilePath Source #
Like decodeUtf
, except this mimics the behavior of the base library when doing filesystem
operations, which is:
- on unix, uses shady PEP 383 style encoding (based on the current locale, but PEP 383 only works properly on UTF-8 encodings, so good luck)
- on windows does permissive UTF-16 encoding, where coding errors generate Chars in the surrogate range
Looking up the locale requires IO. If you're not worried about calls
to setFileSystemEncoding
, then unsafePerformIO
may be feasible (make sure
to deeply evaluate the result to catch exceptions).
Word construction
unsafeFromChar :: Char -> OsChar Source #
Truncates on unix to 1 and on Windows to 2 octets.
Word deconstruction
Separator predicates
pathSeparator :: OsChar Source #
The character that separates directories. In the case where more than
one character is possible, pathSeparator
is the 'ideal' one.
Windows: pathSeparator == '\\'S Posix: pathSeparator == '/'
pathSeparators :: [OsChar] Source #
The list of all possible separators.
Windows: pathSeparators == ['\\', '/'] Posix: pathSeparators == ['/'] pathSeparator `elem` pathSeparators
isPathSeparator :: OsChar -> Bool Source #
Rather than using (==
, use this. Test if something
is a path separator.pathSeparator
)
isPathSeparator a == (a `elem` pathSeparators)
searchPathSeparator :: OsChar Source #
The character that is used to separate the entries in the $PATH environment variable.
Posix: searchPathSeparator == ':' Windows: searchPathSeparator == ';'
isSearchPathSeparator :: OsChar -> Bool Source #
Is the character a file separator?
isSearchPathSeparator a == (a == searchPathSeparator)
extSeparator :: OsChar Source #
File extension character
extSeparator == '.'
isExtSeparator :: OsChar -> Bool Source #
Is the character an extension character?
isExtSeparator a == (a == extSeparator)
$PATH methods
splitSearchPath :: OsString -> [OsPath] Source #
Take a string, split it on the searchPathSeparator
character.
On Windows, blank items are ignored on Windows, and path elements are stripped of quotes.
On Posix, blank items are converted to .
on Posix, and quotes are not
treated specially.
Follows the recommendations in http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html
Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"] Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"] Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"] Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"] Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
Extension functions
splitExtension :: OsPath -> (OsPath, OsString) Source #
Split on the extension. addExtension
is the inverse.
splitExtension "/directory/path.ext" == ("/directory/path",".ext") uncurry (<>) (splitExtension x) == x Valid x => uncurry addExtension (splitExtension x) == x splitExtension "file.txt" == ("file",".txt") splitExtension "file" == ("file","") splitExtension "file/file.txt" == ("file/file",".txt") splitExtension "file.txt/boris" == ("file.txt/boris","") splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext") splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") splitExtension "file/path.txt/" == ("file/path.txt/","")
takeExtension :: OsPath -> OsString Source #
Get the extension of a file, returns ""
for no extension, .ext
otherwise.
takeExtension "/directory/path.ext" == ".ext" takeExtension x == snd (splitExtension x) Valid x => takeExtension (addExtension x "ext") == ".ext" Valid x => takeExtension (replaceExtension x "ext") == ".ext"
replaceExtension :: OsPath -> OsString -> OsPath Source #
Set the extension of a file, overwriting one if already present, equivalent to -<.>
.
replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext" replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext" replaceExtension "file.txt" ".bob" == "file.bob" replaceExtension "file.txt" "bob" == "file.bob" replaceExtension "file" ".bob" == "file.bob" replaceExtension "file.txt" "" == "file" replaceExtension "file.fred.bob" "txt" == "file.fred.txt" replaceExtension x y == addExtension (dropExtension x) y
(-<.>) :: OsPath -> OsString -> OsPath Source #
Remove the current extension and add another, equivalent to replaceExtension
.
"/directory/path.txt" -<.> "ext" == "/directory/path.ext" "/directory/path.txt" -<.> ".ext" == "/directory/path.ext" "foo.o" -<.> "c" == "foo.c"
dropExtension :: OsPath -> OsPath Source #
Remove last extension, and the "." preceding it.
dropExtension "/directory/path.ext" == "/directory/path" dropExtension x == fst (splitExtension x)
addExtension :: OsPath -> OsString -> OsPath Source #
Add an extension, even if there is already one there, equivalent to <.>
.
addExtension "/directory/path" "ext" == "/directory/path.ext" addExtension "file.txt" "bib" == "file.txt.bib" addExtension "file." ".bib" == "file..bib" addExtension "file" ".bib" == "file.bib" addExtension "/" "x" == "/.x" addExtension x "" == x Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext" Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
Add an extension, even if there is already one there, equivalent to <.>
.
addExtension "/directory/path" "ext" == "/directory/path.ext" addExtension "file.txt" "bib" == "file.txt.bib" addExtension "file." ".bib" == "file..bib" addExtension "file" ".bib" == "file.bib" addExtension "/" "x" == "/.x" addExtension x "" == x Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext" Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
hasExtension :: OsPath -> Bool Source #
Does the given filename have an extension?
hasExtension "/directory/path.ext" == True hasExtension "/directory/path" == False null (takeExtension x) == not (hasExtension x)
(<.>) :: OsPath -> OsString -> OsPath Source #
Add an extension, even if there is already one there, equivalent to addExtension
.
"/directory/path" <.> "ext" == "/directory/path.ext" "/directory/path" <.> ".ext" == "/directory/path.ext"
splitExtensions :: OsPath -> (OsPath, OsString) Source #
Split on all extensions.
splitExtensions "/directory/path.ext" == ("/directory/path",".ext") splitExtensions "file.tar.gz" == ("file",".tar.gz") uncurry (<>) (splitExtensions x) == x Valid x => uncurry addExtension (splitExtensions x) == x splitExtensions "file.tar.gz" == ("file",".tar.gz")
dropExtensions :: OsPath -> OsPath Source #
Drop all extensions.
dropExtensions "/directory/path.ext" == "/directory/path" dropExtensions "file.tar.gz" == "file" not $ hasExtension $ dropExtensions x not $ any isExtSeparator $ takeFileName $ dropExtensions x
takeExtensions :: OsPath -> OsString Source #
Get all extensions.
takeExtensions "/directory/path.ext" == ".ext" takeExtensions "file.tar.gz" == ".tar.gz"
replaceExtensions :: OsPath -> OsString -> OsPath Source #
Replace all extensions of a file with a new extension. Note
that replaceExtension
and addExtension
both work for adding
multiple extensions, so only required when you need to drop
all extensions first.
replaceExtensions "file.fred.bob" "txt" == "file.txt" replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"
isExtensionOf :: OsString -> OsPath -> Bool Source #
Does the given filename have the specified extension?
"png" `isExtensionOf` "/directory/file.png" == True ".png" `isExtensionOf` "/directory/file.png" == True ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False "png" `isExtensionOf` "/directory/file.png.jpg" == False "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
stripExtension :: OsString -> OsPath -> Maybe OsPath Source #
Drop the given extension from a filepath, and the "."
preceding it.
Returns Nothing
if the filepath does not have the given extension, or
Just
and the part before the extension if it does.
This function can be more predictable than dropExtensions
, especially if the filename
might itself contain .
characters.
stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x" stripExtension "hi.o" "foo.x.hs.o" == Nothing dropExtension x == fromJust (stripExtension (takeExtension x) x) dropExtensions x == fromJust (stripExtension (takeExtensions x) x) stripExtension ".c.d" "a.b.c.d" == Just "a.b" stripExtension ".c.d" "a.b..c.d" == Just "a.b." stripExtension "baz" "foo.bar" == Nothing stripExtension "bar" "foobar" == Nothing stripExtension "" x == Just x
Filename/directory functions
splitFileName :: OsPath -> (OsPath, OsPath) Source #
Split a filename into directory and file. </>
is the inverse.
The first component will often end with a trailing slash.
splitFileName "/directory/file.ext" == ("/directory/","file.ext") Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./" Valid x => isValid (fst (splitFileName x)) splitFileName "file/bob.txt" == ("file/", "bob.txt") splitFileName "file/" == ("file/", "") splitFileName "bob" == ("./", "bob") Posix: splitFileName "/" == ("/","") Windows: splitFileName "c:" == ("c:","")
takeFileName :: OsPath -> OsPath Source #
Get the file name.
takeFileName "/directory/file.ext" == "file.ext" takeFileName "test/" == "" takeFileName x `isSuffixOf` x takeFileName x == snd (splitFileName x) Valid x => takeFileName (replaceFileName x "fred") == "fred" Valid x => takeFileName (x </> "fred") == "fred" Valid x => isRelative (takeFileName x)
replaceFileName :: OsPath -> OsString -> OsPath Source #
Set the filename.
replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext" Valid x => replaceFileName x (takeFileName x) == x
dropFileName :: OsPath -> OsPath Source #
Drop the filename. Unlike takeDirectory
, this function will leave
a trailing path separator on the directory.
dropFileName "/directory/file.ext" == "/directory/" dropFileName x == fst (splitFileName x)
takeBaseName :: OsPath -> OsPath Source #
Get the base name, without an extension or path.
takeBaseName "/directory/file.ext" == "file" takeBaseName "file/test.txt" == "test" takeBaseName "dave.ext" == "dave" takeBaseName "" == "" takeBaseName "test" == "test" takeBaseName (addTrailingPathSeparator x) == "" takeBaseName "file/file.tar.gz" == "file.tar"
replaceBaseName :: OsPath -> OsString -> OsPath Source #
Set the base name.
replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext" replaceBaseName "file/test.txt" "bob" == "file/bob.txt" replaceBaseName "fred" "bill" == "bill" replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar" Valid x => replaceBaseName x (takeBaseName x) == x
takeDirectory :: OsPath -> OsPath Source #
Get the directory name, move up one level.
takeDirectory "/directory/other.ext" == "/directory" takeDirectory x `isPrefixOf` x || takeDirectory x == "." takeDirectory "foo" == "." takeDirectory "/" == "/" takeDirectory "/foo" == "/" takeDirectory "/foo/bar/baz" == "/foo/bar" takeDirectory "/foo/bar/baz/" == "/foo/bar/baz" takeDirectory "foo/bar/baz" == "foo/bar" Windows: takeDirectory "foo\\bar" == "foo" Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar" Windows: takeDirectory "C:\\" == "C:\\"
replaceDirectory :: OsPath -> OsPath -> OsPath Source #
Set the directory, keeping the filename the same.
replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext" Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
(</>) :: OsPath -> OsPath -> OsPath Source #
Combine two paths with a path separator.
If the second path starts with a path separator or a drive letter, then it returns the second.
The intention is that readFile (dir
will access the same file as
</>
file)setCurrentDirectory dir; readFile file
.
Posix: "/directory" </> "file.ext" == "/directory/file.ext" Windows: "/directory" </> "file.ext" == "/directory\\file.ext" "directory" </> "/file.ext" == "/file.ext" Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x
Combined:
Posix: "/" </> "test" == "/test" Posix: "home" </> "bob" == "home/bob" Posix: "x:" </> "foo" == "x:/foo" Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar" Windows: "home" </> "bob" == "home\\bob"
Not combined:
Posix: "home" </> "/bob" == "/bob" Windows: "home" </> "C:\\bob" == "C:\\bob"
Not combined (tricky):
On Windows, if a filepath starts with a single slash, it is relative to the
root of the current drive. In [1], this is (confusingly) referred to as an
absolute path.
The current behavior of </>
is to never combine these forms.
Windows: "home" </> "/bob" == "/bob" Windows: "home" </> "\\bob" == "\\bob" Windows: "C:\\home" </> "\\bob" == "\\bob"
On Windows, from [1]: "If a file name begins with only a disk designator
but not the backslash after the colon, it is interpreted as a relative path
to the current directory on the drive with the specified letter."
The current behavior of </>
is to never combine these forms.
Windows: "D:\\foo" </> "C:bar" == "C:bar" Windows: "C:\\foo" </> "C:bar" == "C:bar"
splitPath :: OsPath -> [OsPath] Source #
Split a path by the directory separator.
splitPath "/directory/file.ext" == ["/","directory/","file.ext"] concat (splitPath x) == x splitPath "test//item/" == ["test//","item/"] splitPath "test/item/file" == ["test/","item/","file"] splitPath "" == [] Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"] Posix: splitPath "/file/test" == ["/","file/","test"]
joinPath :: [OsPath] -> OsPath Source #
Join path elements back together.
joinPath z == foldr (</>) "" z joinPath ["/","directory/","file.ext"] == "/directory/file.ext" Valid x => joinPath (splitPath x) == x joinPath [] == "" Posix: joinPath ["test","file","path"] == "test/file/path"
splitDirectories :: OsPath -> [OsPath] Source #
Just as splitPath
, but don't add the trailing slashes to each element.
splitDirectories "/directory/file.ext" == ["/","directory","file.ext"] splitDirectories "test/file" == ["test","file"] splitDirectories "/test/file" == ["/","test","file"] Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"] Valid x => joinPath (splitDirectories x) `equalFilePath` x splitDirectories "" == [] Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"] splitDirectories "/test///file" == ["/","test","file"]
Drive functions
splitDrive :: OsPath -> (OsPath, OsPath) Source #
Split a path into a drive and a path. On Posix, / is a Drive.
uncurry (<>) (splitDrive x) == x Windows: splitDrive "file" == ("","file") Windows: splitDrive "c:/file" == ("c:/","file") Windows: splitDrive "c:\\file" == ("c:\\","file") Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test") Windows: splitDrive "\\\\shared" == ("\\\\shared","") Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file") Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file") Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file") Windows: splitDrive "/d" == ("","/d") Posix: splitDrive "/test" == ("/","test") Posix: splitDrive "//test" == ("//","test") Posix: splitDrive "test/file" == ("","test/file") Posix: splitDrive "file" == ("","file")
joinDrive :: OsPath -> OsPath -> OsPath Source #
Join a drive and the rest of the path.
Valid x => uncurry joinDrive (splitDrive x) == x Windows: joinDrive "C:" "foo" == "C:foo" Windows: joinDrive "C:\\" "bar" == "C:\\bar" Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo" Windows: joinDrive "/:" "foo" == "/:\\foo"
Join a drive and the rest of the path.
Valid x => uncurry joinDrive (splitDrive x) == x Windows: joinDrive "C:" "foo" == "C:foo" Windows: joinDrive "C:\\" "bar" == "C:\\bar" Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo" Windows: joinDrive "/:" "foo" == "/:\\foo"
takeDrive :: OsPath -> OsPath Source #
Get the drive from a filepath.
takeDrive x == fst (splitDrive x)
hasDrive :: OsPath -> Bool Source #
Does a path have a drive.
not (hasDrive x) == null (takeDrive x) Posix: hasDrive "/foo" == True Windows: hasDrive "C:\\foo" == True Windows: hasDrive "C:foo" == True hasDrive "foo" == False hasDrive "" == False
dropDrive :: OsPath -> OsPath Source #
Delete the drive, if it exists.
dropDrive x == snd (splitDrive x)
isDrive :: OsPath -> Bool Source #
Is an element a drive
Posix: isDrive "/" == True Posix: isDrive "/foo" == False Windows: isDrive "C:\\" == True Windows: isDrive "C:\\foo" == False isDrive "" == False
Trailing slash functions
hasTrailingPathSeparator :: OsPath -> Bool Source #
Is an item either a directory or the last character a path separator?
hasTrailingPathSeparator "test" == False hasTrailingPathSeparator "test/" == True
addTrailingPathSeparator :: OsPath -> OsPath Source #
Add a trailing file path separator if one is not already present.
hasTrailingPathSeparator (addTrailingPathSeparator x) hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x Posix: addTrailingPathSeparator "test/rest" == "test/rest/"
dropTrailingPathSeparator :: OsPath -> OsPath Source #
Remove any trailing path separators
dropTrailingPathSeparator "file/test/" == "file/test" dropTrailingPathSeparator "/" == "/" Windows: dropTrailingPathSeparator "\\" == "\\" Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
File name manipulations
normalise :: OsPath -> OsPath Source #
Normalise a file
- // outside of the drive can be made blank
- / ->
pathSeparator
- ./ -> ""
Does not remove ".."
, because of symlinks.
Posix: normalise "/file/\\test////" == "/file/\\test/" Posix: normalise "/file/./test" == "/file/test" Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" Posix: normalise "../bob/fred/" == "../bob/fred/" Posix: normalise "/a/../c" == "/a/../c" Posix: normalise "./bob/fred/" == "bob/fred/" Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" Windows: normalise "c:\\" == "C:\\" Windows: normalise "C:.\\" == "C:" Windows: normalise "\\\\server\\test" == "\\\\server\\test" Windows: normalise "//server/test" == "\\\\server\\test" Windows: normalise "c:/file" == "C:\\file" Windows: normalise "/file" == "\\file" Windows: normalise "\\" == "\\" Windows: normalise "/./" == "\\" normalise "." == "." Posix: normalise "./" == "./" Posix: normalise "./." == "./" Posix: normalise "/./" == "/" Posix: normalise "/" == "/" Posix: normalise "bob/fred/." == "bob/fred/" Posix: normalise "//home" == "/home"
equalFilePath :: OsPath -> OsPath -> Bool Source #
Equality of two filepaths.
If you call System.Directory.canonicalizePath
first this has a much better chance of working.
Note that this doesn't follow symlinks or DOSNAM~1s.
Similar to normalise
, this does not expand ".."
, because of symlinks.
x == y ==> equalFilePath x y normalise x == normalise y ==> equalFilePath x y equalFilePath "foo" "foo/" not (equalFilePath "/a/../c" "/c") not (equalFilePath "foo" "/foo") Posix: not (equalFilePath "foo" "FOO") Windows: equalFilePath "foo" "FOO" Windows: not (equalFilePath "C:" "C:/")
makeRelative :: OsPath -> OsPath -> OsPath Source #
Contract a filename, based on a relative path. Note that the resulting path
will never introduce ..
paths, as the presence of symlinks means ../b
may not reach a/b
if it starts from a/c
. For a worked example see
this blog post.
The corresponding makeAbsolute
function can be found in
System.Directory
.
makeRelative "/directory" "/directory/file.ext" == "file.ext" Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x makeRelative x x == "." Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob" Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob" Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" Windows: makeRelative "/Home" "/home/bob" == "bob" Windows: makeRelative "/" "//" == "//" Posix: makeRelative "/Home" "/home/bob" == "/home/bob" Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" Posix: makeRelative "/fred" "bob" == "bob" Posix: makeRelative "/file/test" "/file/test/fred" == "fred" Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
isRelative :: OsPath -> Bool Source #
Is a path relative, or is it fixed to the root?
Windows: isRelative "path\\test" == True Windows: isRelative "c:\\test" == False Windows: isRelative "c:test" == True Windows: isRelative "c:\\" == False Windows: isRelative "c:/" == False Windows: isRelative "c:" == True Windows: isRelative "\\\\foo" == False Windows: isRelative "\\\\?\\foo" == False Windows: isRelative "\\\\?\\UNC\\foo" == False Windows: isRelative "/foo" == True Windows: isRelative "\\foo" == True Posix: isRelative "test/path" == True Posix: isRelative "/test" == False Posix: isRelative "/" == False
According to [1]:
- "A UNC name of any format [is never relative]."
- "You cannot use the "\?" prefix with a relative path."
isAbsolute :: OsPath -> Bool Source #
not . isRelative
isAbsolute x == not (isRelative x)
isValid :: OsPath -> Bool Source #
Is a filepath valid, i.e. could you create a file like it? This function checks for invalid names, and invalid characters, but does not check if length limits are exceeded, as these are typically filesystem dependent.
isValid "" == False isValid "\0" == False Posix: isValid "/random_ path:*" == True Posix: isValid x == not (null x) Windows: isValid "c:\\test" == True Windows: isValid "c:\\test:of_test" == False Windows: isValid "test*" == False Windows: isValid "c:\\test\\nul" == False Windows: isValid "c:\\test\\prn.txt" == False Windows: isValid "c:\\nul\\file" == False Windows: isValid "\\\\" == False Windows: isValid "\\\\\\foo" == False Windows: isValid "\\\\?\\D:file" == False Windows: isValid "foo\tbar" == False Windows: isValid "nul .txt" == False Windows: isValid " nul.txt" == True
makeValid :: OsPath -> OsPath Source #
Take a filepath and make it valid; does not change already valid filepaths.
isValid (makeValid x) isValid x ==> makeValid x == x makeValid "" == "_" makeValid "file\0name" == "file_name" Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid" Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" Windows: makeValid "test*" == "test_" Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file" Windows: makeValid "\\\\\\foo" == "\\\\drive" Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" Windows: makeValid "nul .txt" == "nul _.txt"