Safe Haskell | Safe |
---|---|
Language | Haskell98 |
This module provides type-safe access to filepath manipulations independent from the operating system.
Normally you would import Path
since this contains types fixed to your host system
and otherwise generic functions.
However, importing this explicitly
allows for manipulation of non-native paths.
Synopsis
- type FileDirPath os ar = Path os ar FileDir
- type AbsRelPath os fd = Path os AbsRel fd
- type DirPath os ar = Path os ar Dir
- type FilePath os ar = Path os ar File
- type RelPath os fd = Path os Rel fd
- type AbsPath os fd = Path os Abs fd
- type FileDir os ar = Path os ar FileDir
- type AbsRel os fd = Path os AbsRel fd
- type Dir os ar = Path os ar Dir
- type File os ar = Path os ar File
- type Rel os fd = Path os Rel fd
- type Abs os fd = Path os Abs fd
- type AbsRelFileDir os = Path os AbsRel FileDir
- type RelFileDir os = Path os Rel FileDir
- type AbsFileDir os = Path os Abs FileDir
- type AbsRelDir os = Path os AbsRel Dir
- type AbsRelFile os = Path os AbsRel File
- type RelDir os = Path os Rel Dir
- type AbsDir os = Path os Abs Dir
- type RelFile os = Path os Rel File
- type AbsFile os = Path os Abs File
- data Path os ar fd
- pathMap :: FileDir fd => (String -> String) -> Path os ar fd -> Path os ar fd
- withAbsRel :: AbsRel ar => (AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a
- withFileDir :: FileOrDir fd => (FilePath os ar -> a) -> (DirPath os ar -> a) -> Path os ar fd -> a
- toString :: (System os, AbsRel ar, FileDir fd) => Path os ar fd -> String
- getPathString :: (System os, AbsRel ar, FileDir fd) => Path os ar fd -> String
- rootDir :: System os => AbsDir os
- currentDir :: System os => RelDir os
- emptyFile :: System os => RelFile os
- maybe :: (System os, AbsRel ar, FileDir fd) => String -> Maybe (Path os ar fd)
- maybePath :: (System os, AbsRel ar, FileDir fd) => String -> Maybe (Path os ar fd)
- parse :: (System os, AbsRel ar, FileDir fd) => String -> Either String (Path os ar fd)
- parsePath :: (System os, AbsRel ar, FileDir fd) => String -> Either String (Path os ar fd)
- path :: (System os, AbsRel ar, FileDir fd) => String -> Path os ar fd
- relFile :: System os => String -> RelFile os
- relDir :: System os => String -> RelDir os
- absFile :: System os => String -> AbsFile os
- absDir :: System os => String -> AbsDir os
- rel :: (System os, FileDir fd) => String -> Rel os fd
- abs :: (System os, FileDir fd) => String -> Abs os fd
- absRel :: (System os, FileDir fd) => String -> AbsRel os fd
- file :: (System os, AbsRel ar) => String -> File os ar
- dir :: (System os, AbsRel ar) => String -> Dir os ar
- fileDir :: (System os, AbsRel ar) => String -> FileDir os ar
- relPath :: (System os, FileDir fd) => String -> RelPath os fd
- absPath :: (System os, FileDir fd) => String -> AbsPath os fd
- filePath :: (System os, AbsRel ar) => String -> FilePath os ar
- dirPath :: (System os, AbsRel ar) => String -> DirPath os ar
- idAbsRel :: AbsRelPath os fd -> AbsRelPath os fd
- idAbs :: AbsPath os fd -> AbsPath os fd
- idRel :: RelPath os fd -> RelPath os fd
- idFileDir :: FileDirPath os fd -> FileDirPath os fd
- idFile :: FilePath os fd -> FilePath os fd
- idDir :: DirPath os fd -> DirPath os fd
- asPath :: (System os, AbsRel ar, FileDir fd) => String -> Path os ar fd
- asRelFile :: System os => String -> RelFile os
- asRelDir :: System os => String -> RelDir os
- asAbsFile :: System os => String -> AbsFile os
- asAbsDir :: System os => String -> AbsDir os
- asRelPath :: (System os, FileDir fd) => String -> RelPath os fd
- asAbsPath :: (System os, FileDir fd) => String -> AbsPath os fd
- asFilePath :: (System os, AbsRel ar) => String -> FilePath os ar
- asDirPath :: (System os, AbsRel ar) => String -> DirPath os ar
- mkPathAbsOrRel :: (System os, FileDir fd) => String -> Either (AbsPath os fd) (RelPath os fd)
- mkPathFileOrDir :: (System os, AbsRel ar) => String -> IO (Maybe (Either (FilePath os ar) (DirPath os ar)))
- mkAbsPath :: (System os, FileDir fd) => AbsDir os -> String -> AbsPath os fd
- mkAbsPathFromCwd :: (System os, FileDir fd) => String -> IO (AbsPath os fd)
- (</>) :: DirPath os ar -> RelPath os fd -> Path os ar fd
- (<.>) :: FilePath os ar -> String -> FilePath os ar
- (<++>) :: FilePath os ar -> String -> FilePath os ar
- addExtension :: FilePath os ar -> String -> FilePath os ar
- combine :: DirPath os ar -> RelPath os fd -> Path os ar fd
- dropExtension :: FilePath os ar -> FilePath os ar
- dropExtensions :: FilePath os ar -> FilePath os ar
- dropFileName :: FilePath os ar -> DirPath os ar
- replaceExtension :: FilePath os ar -> String -> FilePath os ar
- replaceBaseName :: FilePath os ar -> String -> FilePath os ar
- replaceDirectory :: FilePath os ar1 -> DirPath os ar2 -> FilePath os ar2
- replaceFileName :: FilePath os ar -> String -> FilePath os ar
- splitExtension :: FilePath os ar -> (FilePath os ar, String)
- splitExtensions :: FilePath os ar -> (FilePath os ar, String)
- splitFileName :: FilePath os ar -> (DirPath os ar, RelFile os)
- splitDirName :: DirPath os ar -> Maybe (DirPath os ar, RelDir os)
- takeBaseName :: FilePath os ar -> RelFile os
- takeDirectory :: FilePath os ar -> DirPath os ar
- takeSuperDirectory :: DirPath os ar -> Maybe (DirPath os ar)
- takeExtension :: FilePath os ar -> String
- takeExtensions :: FilePath os ar -> String
- takeFileName :: FilePath os ar -> RelFile os
- takeDirName :: DirPath os ar -> Maybe (RelDir os)
- mapFileName :: (String -> String) -> FilePath os ar -> FilePath os ar
- mapFileNameF :: Functor f => (String -> f String) -> FilePath os ar -> f (FilePath os ar)
- equalFilePath :: System os => Tagged os (String -> String -> Bool)
- joinPath :: FileDir fd => [String] -> RelPath os fd
- normalise :: System os => Path os ar fd -> Path os ar fd
- splitPath :: (AbsRel ar, FileOrDir fd) => Path os ar fd -> (Bool, [RelDir os], Maybe (RelFile os))
- makeRelative :: (System os, FileDir fd) => AbsDir os -> AbsPath os fd -> RelPath os fd
- makeRelativeMaybe :: (System os, FileDir fd) => AbsDir os -> AbsPath os fd -> Maybe (RelPath os fd)
- makeAbsolute :: System os => AbsDir os -> RelPath os fd -> AbsPath os fd
- makeAbsoluteFromCwd :: System os => RelPath os fd -> IO (AbsPath os fd)
- dynamicMakeAbsolute :: System os => AbsDir os -> AbsRelPath os fd -> AbsPath os fd
- dynamicMakeAbsoluteFromCwd :: System os => AbsRelPath os fd -> IO (AbsPath os fd)
- genericMakeAbsolute :: (System os, AbsRel ar) => AbsDir os -> Path os ar fd -> AbsPath os fd
- genericMakeAbsoluteFromCwd :: (System os, AbsRel ar) => Path os ar fd -> IO (AbsPath os fd)
- dirFromFile :: FilePath os ar -> DirPath os ar
- fileFromDir :: DirPath os ar -> Maybe (FilePath os ar)
- toFileDir :: FileDir fd => Path os ar fd -> FileDirPath os ar
- fromFileDir :: FileDir fd => FileDirPath os ar -> Maybe (Path os ar fd)
- fileFromFileDir :: FileDirPath os ar -> Maybe (FilePath os ar)
- dirFromFileDir :: FileDirPath os ar -> DirPath os ar
- toAbsRel :: AbsRel ar => Path os ar fd -> AbsRelPath os fd
- fromAbsRel :: AbsRel ar => AbsRelPath os fd -> Maybe (Path os ar fd)
- isAbsolute :: AbsRel ar => Path os ar fd -> Bool
- isRelative :: AbsRel ar => Path os ar fd -> Bool
- isAbsoluteString :: System os => Tagged os (String -> Bool)
- isRelativeString :: System os => Tagged os (String -> Bool)
- hasAnExtension :: FilePath os ar -> Bool
- hasExtension :: String -> FilePath os ar -> Bool
- genericAddExtension :: FileDir fd => Path os ar fd -> String -> Path os ar fd
- genericDropExtension :: FileDir fd => Path os ar fd -> Path os ar fd
- genericDropExtensions :: FileDir fd => Path os ar fd -> Path os ar fd
- genericSplitExtension :: FileDir fd => Path os ar fd -> (Path os ar fd, String)
- genericSplitExtensions :: FileDir fd => Path os ar fd -> (Path os ar fd, String)
- genericTakeExtension :: FileDir fd => Path os ar fd -> String
- genericTakeExtensions :: FileDir fd => Path os ar fd -> String
- isValid :: (System os, AbsRel ar, FileDir fd) => Path os ar fd -> Bool
- class System os
Documentation
type FileDirPath os ar = Path os ar FileDir Source #
Deprecated: Use Path.FileDir instead.
type AbsRelPath os fd = Path os AbsRel fd Source #
Deprecated: Use Path.AbsRel instead.
This is the main filepath abstract datatype
Instances
(System os, AbsRel ar, FileDir fd) => Eq (Path os ar fd) Source # | |
(System os, AbsRel ar, FileDir fd) => Ord (Path os ar fd) Source # | |
Defined in System.Path.Internal compare :: Path os ar fd -> Path os ar fd -> Ordering # (<) :: Path os ar fd -> Path os ar fd -> Bool # (<=) :: Path os ar fd -> Path os ar fd -> Bool # (>) :: Path os ar fd -> Path os ar fd -> Bool # (>=) :: Path os ar fd -> Path os ar fd -> Bool # | |
(System os, AbsRel ar, FileDir fd) => Read (Path os ar fd) Source # | Currently it also parses Part.AbsRel and Part.FileDir paths, although these cannot be composed with the accepted combinators. |
(System os, AbsRel ar, FileDir fd) => Show (Path os ar fd) Source # | We show and parse file path components
using the rather generic |
(ForbiddenSystem os, ForbiddenAbsRel ar, ForbiddenFileDir fd) => IsString (Path os ar fd) Source # | Forbid use of OverloadedStrings and prevent custom orphan instances |
Defined in System.Path.Internal fromString :: String -> Path os ar fd # | |
(Rel ar, Dir fd) => Semigroup (Path os ar fd) Source # | |
(Rel ar, Dir fd) => Monoid (Path os ar fd) Source # | |
(System os, AbsRel ar, FileDir fd) => Arbitrary (Path os ar fd) Source # | |
(AbsRel ar, FileDir fd) => NFData (Path os ar fd) Source # | |
Defined in System.Path.Internal |
pathMap :: FileDir fd => (String -> String) -> Path os ar fd -> Path os ar fd Source #
Map over the components of the path.
> Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets"
withAbsRel :: AbsRel ar => (AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a Source #
withFileDir :: FileOrDir fd => (FilePath os ar -> a) -> (DirPath os ar -> a) -> Path os ar fd -> a Source #
getPathString :: (System os, AbsRel ar, FileDir fd) => Path os ar fd -> String Source #
Deprecated: Use Path.toString instead.
Synonym of toString
intended for unqualified use.
currentDir :: System os => RelDir os Source #
emptyFile :: System os => RelFile os Source #
This is a file with path ""
.
You will not be able to create a file with this name.
We also forbid parsing ""
by relFile
.
You might only need this file path as intermediate step
when manipulating extensions of files like ".bashrc"
.
maybe :: (System os, AbsRel ar, FileDir fd) => String -> Maybe (Path os ar fd) Source #
This function is intended for checking and parsing paths provided as user input.
> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" > fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing > fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing > fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" > fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing > fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" > fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" > fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" > fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" > fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" > fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" > fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing > fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing > fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing > fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing
maybePath :: (System os, AbsRel ar, FileDir fd) => String -> Maybe (Path os ar fd) Source #
Deprecated: Use Path.maybe instead.
This function is intended for checking and parsing paths provided as user input.
> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" > fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing > fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing > fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing > fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" > fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" > fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing > fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" > fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" > fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" > fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" > fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" > fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" > fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing > fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing > fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing > fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing
parsePath :: (System os, AbsRel ar, FileDir fd) => String -> Either String (Path os ar fd) Source #
Deprecated: Use Path.parse instead.
path :: (System os, AbsRel ar, FileDir fd) => String -> Path os ar fd Source #
This function is intended for converting path strings
with known content, e.g. string literals, to the Path
type.
absRel :: (System os, FileDir fd) => String -> AbsRel os fd Source #
Construct an 'AbsRel fd' from a String
.
fileDir :: (System os, AbsRel ar) => String -> FileDir os ar Source #
Construct a 'FileDir ar' from a String
.
relPath :: (System os, FileDir fd) => String -> RelPath os fd Source #
Deprecated: Use Path.rel instead.
Construct a 'RelPath fd' from a String
.
absPath :: (System os, FileDir fd) => String -> AbsPath os fd Source #
Deprecated: Use Path.abs instead.
Construct an 'AbsPath fd' from a String
.
filePath :: (System os, AbsRel ar) => String -> FilePath os ar Source #
Deprecated: Use Path.file instead.
Construct a 'FilePath ar' from a String
.
dirPath :: (System os, AbsRel ar) => String -> DirPath os ar Source #
Deprecated: Use Path.dir instead.
Construct a 'DirPath ar' from a String
.
idAbsRel :: AbsRelPath os fd -> AbsRelPath os fd Source #
idFileDir :: FileDirPath os fd -> FileDirPath os fd Source #
asPath :: (System os, AbsRel ar, FileDir fd) => String -> Path os ar fd Source #
Use a String
as a Path
whose type is determined by its context.
You should not use this and other as*
functions,
since they may silently turn a relative path to an absolute one,
or vice versa, or they may accept a path as file path
although it ends on a slash.
If you are certain about the string content
then you should use path
.
If you got the string as user input then use maybePath
or parsePath
.
> Posix.asPath "/tmp" == Posix.absDir "/tmp" > Posix.asPath "file.txt" == Posix.relFile "file.txt" > Path.isAbsolute (Posix.asAbsDir "/tmp") > Path.isRelative (Posix.asRelDir "/tmp") > Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" > Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" > Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" > Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" > Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp" > Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp"
asRelFile :: System os => String -> RelFile os Source #
Deprecated: Use relFile
instead.
Use a String
as a RelFile
. No checking is done.
> Posix.toString (Posix.asRelFile "file.txt") == "file.txt" > Posix.toString (Posix.asRelFile "/file.txt") == "file.txt" > Posix.toString (Posix.asRelFile "tmp") == "tmp" > Posix.toString (Posix.asRelFile "/tmp") == "tmp"
asRelDir :: System os => String -> RelDir os Source #
Deprecated: Use relDir
instead.
Use a String
as a RelDir
. No checking is done.
> Posix.toString (Posix.asRelDir ".") == "." > Posix.toString (Posix.asRelDir "file.txt") == "file.txt" > Posix.toString (Posix.asRelDir "/file.txt") == "file.txt" > Posix.toString (Posix.asRelDir "tmp") == "tmp" > Posix.toString (Posix.asRelDir "/tmp") == "tmp"
mkPathAbsOrRel :: (System os, FileDir fd) => String -> Either (AbsPath os fd) (RelPath os fd) Source #
Deprecated: Use Path.absRel instead.
Examines the supplied string and constructs an absolute or relative path as appropriate.
> Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp") > Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp") > Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp") > Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp") > Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp") > Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp")
mkPathFileOrDir :: (System os, AbsRel ar) => String -> IO (Maybe (Either (FilePath os ar) (DirPath os ar))) Source #
Deprecated: Don't let the path type depend on current file system content. Instead choose the path type according to the needed disk object type.
Searches for a file or directory with the supplied path string
and returns a File
or Dir
path as appropriate. If neither exists
at the supplied path, Nothing
is returned.
mkAbsPath :: (System os, FileDir fd) => AbsDir os -> String -> AbsPath os fd Source #
Deprecated: Use Path.dynamicMakeAbsolute instead.
Convert a String
into an AbsPath
by interpreting it as
relative to the supplied directory if necessary.
> Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt" > Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt"
(</>) :: DirPath os ar -> RelPath os fd -> Path os ar fd infixr 5 Source #
Infix variant of combine
.
> Posix.toString (Posix.absDir "/tmp" </> Posix.relFile "file.txt") == "/tmp/file.txt" > Posix.toString (Posix.absDir "/tmp" </> Posix.relDir "dir" </> Posix.relFile "file.txt") == "/tmp/dir/file.txt" > Posix.toString (Posix.relDir "dir" </> Posix.relFile "file.txt") == "dir/file.txt" > Windows.toString (Windows.absDir "\\tmp" </> Windows.relFile "file.txt") == "\\tmp\\file.txt" > Windows.toString (Windows.absDir "c:\\tmp" </> Windows.relFile "file.txt") == "c:\\tmp\\file.txt" > Windows.toString (Windows.absDir "c:tmp" </> Windows.relFile "file.txt") == "c:tmp\\file.txt" > Windows.toString (Windows.absDir "c:\\" </> Windows.relDir "tmp" </> Windows.relFile "file.txt") == "c:\\tmp\\file.txt" > Windows.toString (Windows.absDir "c:" </> Windows.relDir "tmp" </> Windows.relFile "file.txt") == "c:tmp\\file.txt" > Windows.toString (Windows.relDir "dir" </> Windows.relFile "file.txt") == "dir\\file.txt"
(<.>) :: FilePath os ar -> String -> FilePath os ar infixl 7 Source #
Infix variant of addExtension
.
We only allow files (and not directories) to have extensions added
by this function. This is because it's the vastly common case and
an attempt to add one to a directory will - more often than not -
represent an error.
We don't however want to prevent the corresponding operation on
directories, and so we provide a function that is more flexible:
genericAddExtension
.
addExtension :: FilePath os ar -> String -> FilePath os ar Source #
Add an extension, even if there is already one there.
E.g. addExtension "foo.txt" "bat" -> "foo.txt.bat"
.
> Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib" > Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib" > Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib" > Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib" > Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib" > Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext"
combine :: DirPath os ar -> RelPath os fd -> Path os ar fd Source #
Join an (absolute or relative) directory path with a relative (file or directory) path to form a new path.
dropExtension :: FilePath os ar -> FilePath os ar Source #
Remove last extension, and the "." preceding it.
> Path.dropExtension x == fst (Path.splitExtension x)
dropExtensions :: FilePath os ar -> FilePath os ar Source #
Drop all extensions
> not $ Path.hasAnExtension (Path.dropExtensions x)
dropFileName :: FilePath os ar -> DirPath os ar Source #
Synonym for takeDirectory
replaceExtension :: FilePath os ar -> String -> FilePath os ar Source #
Set the extension of a file, overwriting one if already present.
> Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob" > Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob" > Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob" > Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file" > Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt"
splitExtension :: FilePath os ar -> (FilePath os ar, String) Source #
Split on the extension. addExtension
is the inverse.
> uncurry (<.>) (Path.splitExtension x) == x > uncurry Path.addExtension (Path.splitExtension x) == x > Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt") > Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc") > Path.splitExtension (relFile "file") == (Posix.relFile "file","") > Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt") > Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","") > Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext") > Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred")
splitExtensions :: FilePath os ar -> (FilePath os ar, String) Source #
Split on all extensions
> Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz")
takeBaseName :: FilePath os ar -> RelFile os Source #
Get the basename of a file
> Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile" > Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile" > Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile"
takeDirectory :: FilePath os ar -> DirPath os ar Source #
takeExtension :: FilePath os ar -> String Source #
Get the extension of a file, returns ""
for no extension, .ext
otherwise.
> Path.takeExtension x == snd (Path.splitExtension x) > Path.takeExtension (Path.addExtension x "ext") == ".ext" > Path.takeExtension (Path.replaceExtension x "ext") == ".ext"
takeExtensions :: FilePath os ar -> String Source #
Get all extensions
> Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz"
takeFileName :: FilePath os ar -> RelFile os Source #
Get the filename component of a file path (ie stripping all parent dirs)
> Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt" > Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt" > Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt"
equalFilePath :: System os => Tagged os (String -> String -> Bool) Source #
Check whether two strings are equal as file paths.
> Posix.equalFilePath "abc/def" "abc/def" > Posix.equalFilePath "abc/def" "abc//def" > Posix.equalFilePath "/tmp/" "/tmp" > Posix.equalFilePath "/tmp" "//tmp" > Posix.equalFilePath "/tmp" "///tmp" > not $ Posix.equalFilePath "abc" "def" > not $ Posix.equalFilePath "/tmp" "tmp" > Windows.equalFilePath "abc\\def" "abc\\def" > Windows.equalFilePath "abc\\def" "abc\\\\def" > Windows.equalFilePath "file" "File" > Windows.equalFilePath "\\file" "\\\\file" > Windows.equalFilePath "\\file" "\\\\\\file" > not $ Windows.equalFilePath "abc" "def" > not $ Windows.equalFilePath "file" "dir"
joinPath :: FileDir fd => [String] -> RelPath os fd Source #
Constructs a RelPath
from a list of components.
It is an unchecked error if the path components contain path separators.
It is an unchecked error if a RelFile
path is empty.
> Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir" > Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt"
normalise :: System os => Path os ar fd -> Path os ar fd Source #
Currently just transforms:
> Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file"
splitPath :: (AbsRel ar, FileOrDir fd) => Path os ar fd -> (Bool, [RelDir os], Maybe (RelFile os)) Source #
Deconstructs a path into its components.
> Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing) > Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt")
makeRelative :: (System os, FileDir fd) => AbsDir os -> AbsPath os fd -> RelPath os fd Source #
This function can be used to construct a relative path by removing
the supplied AbsDir
from the front. It is a runtime error
if the
supplied AbsPath
doesn't start with the AbsDir
.
> Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt" > Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir" > Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt" > Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" > Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir"
makeRelativeMaybe :: (System os, FileDir fd) => AbsDir os -> AbsPath os fd -> Maybe (RelPath os fd) Source #
makeAbsolute :: System os => AbsDir os -> RelPath os fd -> AbsPath os fd Source #
Joins an absolute directory with a relative path to construct a new absolute path.
> Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" > Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" > Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir"
makeAbsoluteFromCwd :: System os => RelPath os fd -> IO (AbsPath os fd) Source #
Converts a relative path into an absolute one by prepending the current working directory.
dynamicMakeAbsolute :: System os => AbsDir os -> AbsRelPath os fd -> AbsPath os fd Source #
dynamicMakeAbsoluteFromCwd :: System os => AbsRelPath os fd -> IO (AbsPath os fd) Source #
genericMakeAbsolute :: (System os, AbsRel ar) => AbsDir os -> Path os ar fd -> AbsPath os fd Source #
As for makeAbsolute
, but for use when the path may already be
absolute (in which case it is left unchanged).
You should avoid the use of genericMakeAbsolute
-type functions,
because then you avoid to absolutize a path that was already absolutized.
> Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" > Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" > Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt"
genericMakeAbsoluteFromCwd :: (System os, AbsRel ar) => Path os ar fd -> IO (AbsPath os fd) Source #
As for makeAbsoluteFromCwd
, but for use when the path may already be
absolute (in which case it is left unchanged).
dirFromFile :: FilePath os ar -> DirPath os ar Source #
Convert a file to a directory path. Obviously, the corresponding disk object won't change accordingly. The purpose of this function is to be an intermediate step when deriving a directory name from a file name.
fileFromDir :: DirPath os ar -> Maybe (FilePath os ar) Source #
Convert a directory to a file path.
The function returns Nothing
if the directory path is empty.
The purpose of this function is to be an intermediate step
when deriving a file name from a directory name.
fromFileDir :: FileDir fd => FileDirPath os ar -> Maybe (Path os ar fd) Source #
fileFromFileDir :: FileDirPath os ar -> Maybe (FilePath os ar) Source #
dirFromFileDir :: FileDirPath os ar -> DirPath os ar Source #
fromAbsRel :: AbsRel ar => AbsRelPath os fd -> Maybe (Path os ar fd) Source #
isAbsolute :: AbsRel ar => Path os ar fd -> Bool Source #
Test whether a
is absolute.Path
ar fd
> Path.isAbsolute (Posix.absFile "/fred") > Path.isAbsolute (Windows.absFile "\\fred") > Path.isAbsolute (Windows.absFile "c:\\fred") > Path.isAbsolute (Windows.absFile "c:fred")
isRelative :: AbsRel ar => Path os ar fd -> Bool Source #
Invariant - this should return True iff arg is of type Path
Part.Rel _
isRelative = not . isAbsolute > Path.isRelative (Posix.relFile "fred") > Path.isRelative (Windows.relFile "fred")
hasAnExtension :: FilePath os ar -> Bool Source #
Does the given filename have an extension?
> null (Path.takeExtension x) == not (Path.hasAnExtension x)
hasExtension :: String -> FilePath os ar -> Bool Source #
Does the given filename have the given extension?
> Path.hasExtension ".hs" (Posix.relFile "MyCode.hs") > Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs") > not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak")
genericAddExtension :: FileDir fd => Path os ar fd -> String -> Path os ar fd Source #
This is a more flexible variant of addExtension
/ <.>
which can
work with files or directories
> Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x" > Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x" > Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x" > Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile