path-0.6.1: Support for well-typed paths

Safe HaskellNone
LanguageHaskell2010

Path

Contents

Description

This library provides a well-typed representation of paths in a filesystem directory tree. A path is represented by a number of path components separated by a path separator which is a / on POSIX systems and can be a / or \ on Windows.

The root of the tree is represented by a / on POSIX and a drive letter followed by a / or \ on Windows (e.g. C:\). Paths can be absolute or relative. An absolute path always starts from the root of the tree (e.g. /x/y) whereas a relative path never starts with the root (e.g. x/y). Just like we represent the notion of an absolute root by "/", the same way we represent the notion of a relative root by ".". The relative root denotes the directory which contains the first component of a relative path.

Synopsis

Types

data Path b t Source #

Path of some base and type.

The type variables are:

  • b — base, the base location of the path; absolute or relative.
  • t — type, whether file or directory.

Internally is a string. The string can be of two formats only:

  1. File format: file.txt, foo/bar.txt, /foo/bar.txt
  2. Directory format: foo/, /foo/bar/

All directories end in a trailing separator. There are no duplicate path separators //, no .., no ./, no ~/, etc.

Instances

Eq (Path b t) Source #

String equality.

The following property holds:

show x == show y ≡ x == y

Methods

(==) :: Path b t -> Path b t -> Bool #

(/=) :: Path b t -> Path b t -> Bool #

Ord (Path b t) Source #

String ordering.

The following property holds:

show x `compare` show y ≡ x `compare` y

Methods

compare :: Path b t -> Path b t -> Ordering #

(<) :: Path b t -> Path b t -> Bool #

(<=) :: Path b t -> Path b t -> Bool #

(>) :: Path b t -> Path b t -> Bool #

(>=) :: Path b t -> Path b t -> Bool #

max :: Path b t -> Path b t -> Path b t #

min :: Path b t -> Path b t -> Path b t #

Show (Path b t) Source #

Same as 'show . Path.toFilePath'.

The following property holds:

x == y ≡ show x == show y

Methods

showsPrec :: Int -> Path b t -> ShowS #

show :: Path b t -> String #

showList :: [Path b t] -> ShowS #

Hashable (Path b t) Source # 

Methods

hashWithSalt :: Int -> Path b t -> Int #

hash :: Path b t -> Int #

ToJSON (Path b t) Source # 

Methods

toJSON :: Path b t -> Value #

toEncoding :: Path b t -> Encoding #

toJSONList :: [Path b t] -> Value #

toEncodingList :: [Path b t] -> Encoding #

FromJSON (Path Rel Dir) # 
FromJSON (Path Rel File) # 
FromJSON (Path Abs Dir) # 
FromJSON (Path Abs File) # 
NFData (Path b t) Source # 

Methods

rnf :: Path b t -> () #

data Rel Source #

A relative path; one without a root. Note that a .. path component to represent the parent directory is not allowed by this library.

Exceptions

QuasiQuoters

Using the following requires the QuasiQuotes language extension.

For Windows users, the QuasiQuoters are especially beneficial because they prevent Haskell from treating \ as an escape character. This makes Windows paths easier to write.

[absfile|C:\chris\foo.txt|]

absdir :: QuasiQuoter Source #

Construct a Path Abs Dir using QuasiQuotes.

[absdir|/|]

[absdir|/home/chris|]

Remember: due to the nature of absolute paths a path like [absdir|/home/chris|] may compile on your platform, but it may not compile on another platform (Windows).

Since: 0.5.13

reldir :: QuasiQuoter Source #

Construct a Path Rel Dir using QuasiQuotes.

[absdir|/home|]</>[reldir|chris|]

Since: 0.5.13

absfile :: QuasiQuoter Source #

Construct a Path Abs File using QuasiQuotes.

[absfile|/home/chris/foo.txt|]

Remember: due to the nature of absolute paths a path like [absdir|/home/chris/foo.txt|] may compile on your platform, but it may not compile on another platform (Windows).

Since: 0.5.13

relfile :: QuasiQuoter Source #

Construct a Path Rel File using QuasiQuotes.

[absdir|/home/chris|]</>[relfile|foo.txt|]

Since: 0.5.13

Operations

(</>) :: Path b Dir -> Path Rel t -> Path b t infixr 5 Source #

Append two paths.

The following cases are valid and the equalities hold:

$(mkAbsDir x) </> $(mkRelDir y) = $(mkAbsDir (x ++ "/" ++ y))
$(mkAbsDir x) </> $(mkRelFile y) = $(mkAbsFile (x ++ "/" ++ y))
$(mkRelDir x) </> $(mkRelDir y) = $(mkRelDir (x ++ "/" ++ y))
$(mkRelDir x) </> $(mkRelFile y) = $(mkRelFile (x ++ "/" ++ y))

The following are proven not possible to express:

$(mkAbsFile …) </> x
$(mkRelFile …) </> x
x </> $(mkAbsFile …)
x </> $(mkAbsDir …)

stripProperPrefix :: MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) Source #

If the directory in the first argument is a proper prefix of the path in the second argument strip it from the second argument, generating a path relative to the directory. Throws NotAProperPrefix if the directory is not a proper prefix of the path.

The following properties hold:

stripProperPrefix x (x </> y) = y

Cases which are proven not possible:

stripProperPrefix (a :: Path Abs …) (b :: Path Rel …)
stripProperPrefix (a :: Path Rel …) (b :: Path Abs …)

In other words the bases must match.

Since: 0.6.0

isProperPrefixOf :: Path b Dir -> Path b t -> Bool Source #

Determines if the path in the first parameter is a proper prefix of the path in the second parameter.

The following properties hold:

not (x `isProperPrefixOf` x)
x `isProperPrefixOf` (x </> y)

Since: 0.6.0

parent :: Path b t -> Path b Dir Source #

Take the parent path component from a path.

The following properties hold:

parent (x </> y) == x
parent "/x" == "/"
parent "x" == "."

On the root (absolute or relative), getting the parent is idempotent:

parent "/" = "/"
parent "." = "."

filename :: Path b File -> Path Rel File Source #

Extract the file part of a path.

The following properties hold:

filename (p </> a) == filename a

dirname :: Path b Dir -> Path Rel Dir Source #

Extract the last directory name of a path.

The following properties hold:

dirname $(mkRelDir ".") == $(mkRelDir ".")
dirname (p </> a) == dirname a

fileExtension :: Path b File -> String Source #

Get extension from given file path.

Since: 0.5.11

addFileExtension Source #

Arguments

:: MonadThrow m 
=> String

Extension to add

-> Path b File

Old file name

-> m (Path b File)

New file name with the desired extension added at the end

Add extension to given file path. Throws if the resulting filename does not parse.

>>> addFileExtension "txt $(mkRelFile "foo")
"foo.txt"
>>> addFileExtension "symbols" $(mkRelFile "Data.List")
"Data.List.symbols"
>>> addFileExtension ".symbols" $(mkRelFile "Data.List")
"Data.List.symbols"
>>> addFileExtension "symbols" $(mkRelFile "Data.List.")
"Data.List..symbols"
>>> addFileExtension ".symbols" $(mkRelFile "Data.List.")
"Data.List..symbols"
>>> addFileExtension "evil/" $(mkRelFile "Data.List")
*** Exception: InvalidRelFile "Data.List.evil/"

Since: 0.6.1

(<.>) infixr 7 Source #

Arguments

:: MonadThrow m 
=> Path b File

Old file name

-> String

Extension to add

-> m (Path b File)

New file name with the desired extension added at the end

A synonym for addFileExtension in the form of an operator. See more examples there.

>>> $(mkRelFile "Data.List") <.> "symbols"
"Data.List.symbols"
>>> $(mkRelFile "Data.List") <.> "evil/"
*** Exception: InvalidRelFile "Data.List.evil/"

Since: 0.6.1

setFileExtension Source #

Arguments

:: MonadThrow m 
=> String

Extension to set

-> Path b File

Old file name

-> m (Path b File)

New file name with the desired extension

Replace/add extension to given file path. Throws if the resulting filename does not parse.

Since: 0.5.11

(-<.>) infixr 7 Source #

Arguments

:: MonadThrow m 
=> Path b File

Old file name

-> String

Extension to set

-> m (Path b File)

New file name with the desired extension

A synonym for setFileExtension in the form of an operator.

Since: 0.6.0

Parsing

parseAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir) Source #

Convert an absolute FilePath to a normalized absolute dir Path.

Throws: InvalidAbsDir when the supplied path:

  • is not an absolute path
  • contains a .. path component representing the parent directory
  • is not a valid path (See isValid)

parseRelDir :: MonadThrow m => FilePath -> m (Path Rel Dir) Source #

Convert a relative FilePath to a normalized relative dir Path.

Throws: InvalidRelDir when the supplied path:

  • is not a relative path
  • is ""
  • contains a .. path component representing the parent directory
  • is not a valid path (See isValid)

parseAbsFile :: MonadThrow m => FilePath -> m (Path Abs File) Source #

Convert an absolute FilePath to a normalized absolute file Path.

Throws: InvalidAbsFile when the supplied path:

  • is not an absolute path
  • is a directory path i.e.

    • has a trailing path separator
    • is . or ends in /.
  • contains a .. path component representing the parent directory
  • is not a valid path (See isValid)

parseRelFile :: MonadThrow m => FilePath -> m (Path Rel File) Source #

Convert a relative FilePath to a normalized relative file Path.

Throws: InvalidRelFile when the supplied path:

  • is not a relative path
  • is ""
  • is a directory path i.e.

    • has a trailing path separator
    • is . or ends in /.
  • contains a .. path component representing the parent directory
  • is not a valid path (See isValid)

Conversion

toFilePath :: Path b t -> FilePath Source #

Convert to a FilePath type.

All directories have a trailing slash, so if you want no trailing slash, you can use dropTrailingPathSeparator from the filepath package.

fromAbsDir :: Path Abs Dir -> FilePath Source #

Convert absolute path to directory to FilePath type.

fromRelDir :: Path Rel Dir -> FilePath Source #

Convert relative path to directory to FilePath type.

fromAbsFile :: Path Abs File -> FilePath Source #

Convert absolute path to file to FilePath type.

fromRelFile :: Path Rel File -> FilePath Source #

Convert relative path to file to FilePath type.

TemplateHaskell constructors

These require the TemplateHaskell language extension.

mkAbsDir :: FilePath -> Q Exp Source #

Make a Path Abs Dir'.

Remember: due to the nature of absolute paths this (e.g. /home/foo) may compile on your platform, but it may not compile on another platform (Windows).

mkAbsFile :: FilePath -> Q Exp Source #

Make a Path Abs File.

Remember: due to the nature of absolute paths this (e.g. /home/foo) may compile on your platform, but it may not compile on another platform (Windows).

Deprecated

type PathParseException = PathException Source #

Deprecated: Please use PathException instead.

Same as PathException.

stripDir :: MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) Source #

Deprecated: Please use stripProperPrefix instead.

Same as stripProperPrefix.

isParentOf :: Path b Dir -> Path b t -> Bool Source #

Deprecated: Please use isProperPrefixOf instead.

Same as isProperPrefixOf.