filepath-2.0.0.1: Library for manipulating FilePaths in a cross platform way.
Safe HaskellNone
LanguageHaskell2010

System.AbstractFilePath.Posix

Synopsis

Types

data PosixString Source #

Commonly used Posix string as uninterpreted char[] array.

Instances

Instances details
Eq PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

(==) :: PosixString -> PosixString -> Bool

(/=) :: PosixString -> PosixString -> Bool

Ord PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Read PosixString Source #

Encodes as UTF-8.

Instance details

Defined in System.OsString.Internal.Types

Methods

readsPrec :: Int -> ReadS PosixString

readList :: ReadS [PosixString]

readPrec :: ReadPrec PosixString

readListPrec :: ReadPrec [PosixString]

Show PosixString Source #

Decodes as UTF-8 and replaces invalid chars with unicode replacement char U+FFFD.

Instance details

Defined in System.OsString.Internal.Types

Methods

showsPrec :: Int -> PosixString -> ShowS

show :: PosixString -> String

showList :: [PosixString] -> ShowS

IsString PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

fromString :: String -> PosixString

Generic PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Associated Types

type Rep PosixString :: Type -> Type

Methods

from :: PosixString -> Rep PosixString x

to :: Rep PosixString x -> PosixString

Semigroup PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

(<>) :: PosixString -> PosixString -> PosixString

sconcat :: NonEmpty PosixString -> PosixString

stimes :: Integral b => b -> PosixString -> PosixString

Monoid PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

NFData PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

rnf :: PosixString -> ()

Lift PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

lift :: PosixString -> Q Exp

liftTyped :: PosixString -> Q (TExp PosixString)

type Rep PosixString Source # 
Instance details

Defined in System.OsString.Internal.Types

type Rep PosixString = D1 ('MetaData "PosixString" "System.OsString.Internal.Types" "filepath-2.0.0.1-inplace" 'True) (C1 ('MetaCons "PS" 'PrefixI 'True) (S1 ('MetaSel ('Just "unPFP") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ShortByteString)))

data PosixChar Source #

Instances

Instances details
Eq PosixChar Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

(==) :: PosixChar -> PosixChar -> Bool

(/=) :: PosixChar -> PosixChar -> Bool

Ord PosixChar Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

compare :: PosixChar -> PosixChar -> Ordering

(<) :: PosixChar -> PosixChar -> Bool

(<=) :: PosixChar -> PosixChar -> Bool

(>) :: PosixChar -> PosixChar -> Bool

(>=) :: PosixChar -> PosixChar -> Bool

max :: PosixChar -> PosixChar -> PosixChar

min :: PosixChar -> PosixChar -> PosixChar

Show PosixChar Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

showsPrec :: Int -> PosixChar -> ShowS

show :: PosixChar -> String

showList :: [PosixChar] -> ShowS

Generic PosixChar Source # 
Instance details

Defined in System.OsString.Internal.Types

Associated Types

type Rep PosixChar :: Type -> Type

Methods

from :: PosixChar -> Rep PosixChar x

to :: Rep PosixChar x -> PosixChar

NFData PosixChar Source # 
Instance details

Defined in System.OsString.Internal.Types

Methods

rnf :: PosixChar -> ()

type Rep PosixChar Source # 
Instance details

Defined in System.OsString.Internal.Types

type Rep PosixChar = D1 ('MetaData "PosixChar" "System.OsString.Internal.Types" "filepath-2.0.0.1-inplace" 'True) (C1 ('MetaCons "PW" 'PrefixI 'True) (S1 ('MetaSel ('Just "unPW") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word8)))

type PosixFilePath = PosixString Source #

Filepaths are char[] data on unix as passed to syscalls.

Filepath construction

toPlatformStringUtf :: MonadThrow m => String -> m PosixString Source #

Convert a String.

On windows this encodes as UTF16, which is a pretty good guess. On unix this encodes as UTF8, which is a good guess.

Throws a EncodingException if encoding fails.

toPlatformStringEnc :: String -> TextEncoding -> Either EncodingException PosixString Source #

Like toPlatformStringUtf, except allows to provide an encoding.

toPlatformStringFS :: String -> IO PosixString Source #

Like toPlatformStringUtf, except on unix this uses the current filesystem locale for encoding instead of always UTF8.

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

Throws a EncodingException if encoding fails.

pstr :: QuasiQuoter Source #

QuasiQuote a PosixString. This accepts Unicode characters and encodes as UTF-8 on unix.

packPlatformString :: [PosixChar] -> PosixString Source #

Pack a list of platform words to a platform string.

Note that using this in conjunction with unsafeFromChar to convert from [Char] to platform string is probably not what you want, because it will truncate unicode code points.

Filepath deconstruction

fromPlatformStringUtf :: MonadThrow m => PosixString -> m String Source #

Partial unicode friendly decoding.

On windows this decodes as UTF16-LE (which is the expected filename encoding). On unix this decodes as UTF8 (which is a good guess). Note that filenames on unix are encoding agnostic char arrays.

Throws a EncodingException if decoding fails.

fromPlatformStringEnc :: PosixString -> TextEncoding -> Either EncodingException String Source #

Like fromPlatformStringUtf, except allows to provide a text encoding.

The String is forced into memory to catch all exceptions.

fromPlatformStringFS :: PosixString -> IO String Source #

Like fromPlatformStringUt, except on unix this uses the current filesystem locale for decoding instead of always UTF8. On windows, uses UTF-16LE.

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

Throws EncodingException if decoding fails.

unpackPlatformString :: PosixString -> [PosixChar] Source #

Unpack a platform string to a list of platform words.

Word construction

unsafeFromChar :: Char -> PosixChar Source #

Truncates to 1 octet.

Word deconstruction

toChar :: PosixChar -> Char Source #

Converts back to a unicode codepoint (total).

Separator predicates

pathSeparator :: PosixChar Source #

The character that separates directories. In the case where more than one character is possible, pathSeparator is the 'ideal' one.

Windows: pathSeparator == '\\'
Posix:   pathSeparator ==  '/'
isPathSeparator pathSeparator

pathSeparators :: [PosixChar] Source #

The list of all possible separators.

Windows: pathSeparators == ['\\', '/']
Posix:   pathSeparators == ['/']
pathSeparator `elem` pathSeparators

isPathSeparator :: PosixChar -> Bool Source #

Rather than using (== pathSeparator), use this. Test if something is a path separator.

isPathSeparator a == (a `elem` pathSeparators)

searchPathSeparator :: PosixChar Source #

Is the character a file separator?

isSearchPathSeparator a == (a == searchPathSeparator)

isSearchPathSeparator :: PosixChar -> Bool Source #

Is the character a file separator?

isSearchPathSeparator a == (a == searchPathSeparator)

extSeparator :: PosixChar Source #

File extension character

extSeparator == '.'

isExtSeparator :: PosixChar -> Bool Source #

Is the character an extension character?

isExtSeparator a == (a == extSeparator)

$PATH methods

splitSearchPath :: PosixString -> [PosixFilePath] Source #

Take a string, split it on the searchPathSeparator character. Blank items are ignored on Windows, and converted to . on Posix. On Windows path elements are stripped of quotes.

Follows the recommendations in http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html

Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]
Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]
Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]

Extension functions

splitExtension :: PosixFilePath -> (PosixFilePath, PosixString) 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 :: PosixFilePath -> PosixString 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 :: PosixFilePath -> PosixString -> PosixFilePath 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

(-<.>) :: PosixFilePath -> PosixString -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath Source #

Remove last extension, and the "." preceding it.

dropExtension "/directory/path.ext" == "/directory/path"
dropExtension x == fst (splitExtension x)

addExtension :: PosixFilePath -> PosixString -> PosixFilePath 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"

hasExtension :: PosixFilePath -> Bool Source #

Does the given filename have an extension?

hasExtension "/directory/path.ext" == True
hasExtension "/directory/path" == False
null (takeExtension x) == not (hasExtension x)

(<.>) :: PosixFilePath -> PosixString -> PosixFilePath 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 :: PosixFilePath -> (PosixFilePath, PosixString) 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 :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixString Source #

Get all extensions.

takeExtensions "/directory/path.ext" == ".ext"
takeExtensions "file.tar.gz" == ".tar.gz"

replaceExtensions :: PosixFilePath -> PosixString -> PosixFilePath 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 :: PosixString -> PosixFilePath -> 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 :: PosixString -> PosixFilePath -> Maybe PosixFilePath 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 :: PosixFilePath -> (PosixFilePath, PosixFilePath) 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 :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixString -> PosixFilePath Source #

Set the filename.

replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"
Valid x => replaceFileName x (takeFileName x) == x

dropFileName :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixString -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath -> PosixFilePath 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

(</>) :: PosixFilePath -> PosixFilePath -> PosixFilePath 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 </> file) will access the same file as 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 :: PosixFilePath -> [PosixFilePath] 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 :: [PosixFilePath] -> PosixFilePath 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 :: PosixFilePath -> [PosixFilePath] 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 :: PosixFilePath -> (PosixFilePath, PosixFilePath) 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 :: PosixFilePath -> PosixFilePath -> PosixFilePath 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"

takeDrive :: PosixFilePath -> PosixFilePath Source #

Get the drive from a filepath.

takeDrive x == fst (splitDrive x)

hasDrive :: PosixFilePath -> 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 :: PosixFilePath -> PosixFilePath Source #

Delete the drive, if it exists.

dropDrive x == snd (splitDrive x)

isDrive :: PosixFilePath -> 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 :: PosixFilePath -> Bool Source #

Is an item either a directory or the last character a path separator?

hasTrailingPathSeparator "test" == False
hasTrailingPathSeparator "test/" == True

addTrailingPathSeparator :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> PosixFilePath -> 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 :: PosixFilePath -> PosixFilePath -> PosixFilePath 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 :: PosixFilePath -> 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 :: PosixFilePath -> Bool Source #

not . isRelative
isAbsolute x == not (isRelative x)

isValid :: PosixFilePath -> 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 :: PosixFilePath -> PosixFilePath 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"