path-0.7.0: Support for well-typed paths

Safe HaskellNone
LanguageHaskell2010

Path.Windows

Contents

Description

This library provides a well-typed representation of paths in a filesystem directory tree.

Note: This module is for working with Windows style paths. Importing Path is usually better.

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
Instance details

Defined in Path.Internal

Methods

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

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

(Data b, Data t) => Data (Path b t) Source # 
Instance details

Defined in Path.Internal

Methods

gfoldl :: (forall d b0. Data d => c (d -> b0) -> d -> c b0) -> (forall g. g -> c g) -> Path b t -> c (Path b t) #

gunfold :: (forall b0 r. Data b0 => c (b0 -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Path b t) #

toConstr :: Path b t -> Constr #

dataTypeOf :: Path b t -> DataType #

dataCast1 :: Typeable t0 => (forall d. Data d => c (t0 d)) -> Maybe (c (Path b t)) #

dataCast2 :: Typeable t0 => (forall d e. (Data d, Data e) => c (t0 d e)) -> Maybe (c (Path b t)) #

gmapT :: (forall b0. Data b0 => b0 -> b0) -> Path b t -> Path b t #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path b t -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path b t -> r #

gmapQ :: (forall d. Data d => d -> u) -> Path b t -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Path b t -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Path b t -> m (Path b t) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Path b t -> m (Path b t) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Path b t -> m (Path b t) #

Ord (Path b t) Source #

String ordering.

The following property holds:

show x `compare` show y ≡ x `compare` y
Instance details

Defined in Path.Internal

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
Instance details

Defined in Path.Internal

Methods

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

show :: Path b t -> String #

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

Generic (Path b t) Source # 
Instance details

Defined in Path.Internal

Associated Types

type Rep (Path b t) :: Type -> Type #

Methods

from :: Path b t -> Rep (Path b t) x #

to :: Rep (Path b t) x -> Path b t #

Lift (Path a b) Source # 
Instance details

Defined in Path.Internal

Methods

lift :: Path a b -> Q Exp #

Hashable (Path b t) Source # 
Instance details

Defined in Path.Internal

Methods

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

hash :: Path b t -> Int #

ToJSON (Path b t) Source # 
Instance details

Defined in Path.Internal

Methods

toJSON :: Path b t -> Value #

toEncoding :: Path b t -> Encoding #

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

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

ToJSONKey (Path b t) Source # 
Instance details

Defined in Path.Internal

FromJSON (Path Rel Dir) Source # 
Instance details

Defined in Path.Posix

FromJSON (Path Rel File) Source # 
Instance details

Defined in Path.Posix

FromJSON (Path Abs Dir) Source # 
Instance details

Defined in Path.Posix

FromJSON (Path Abs File) Source # 
Instance details

Defined in Path.Posix

FromJSON (Path Rel Dir) Source # 
Instance details

Defined in Path.Windows

FromJSON (Path Rel File) Source # 
Instance details

Defined in Path.Windows

FromJSON (Path Abs Dir) Source # 
Instance details

Defined in Path.Windows

FromJSON (Path Abs File) Source # 
Instance details

Defined in Path.Windows

FromJSONKey (Path Rel Dir) Source # 
Instance details

Defined in Path.Posix

FromJSONKey (Path Rel File) Source # 
Instance details

Defined in Path.Posix

FromJSONKey (Path Abs Dir) Source # 
Instance details

Defined in Path.Posix

FromJSONKey (Path Abs File) Source # 
Instance details

Defined in Path.Posix

FromJSONKey (Path Rel Dir) Source # 
Instance details

Defined in Path.Windows

FromJSONKey (Path Rel File) Source # 
Instance details

Defined in Path.Windows

FromJSONKey (Path Abs Dir) Source # 
Instance details

Defined in Path.Windows

FromJSONKey (Path Abs File) Source # 
Instance details

Defined in Path.Windows

NFData (Path b t) Source # 
Instance details

Defined in Path.Internal

Methods

rnf :: Path b t -> () #

type Rep (Path b t) Source # 
Instance details

Defined in Path.Internal

type Rep (Path b t) = D1 (MetaData "Path" "Path.Internal" "path-0.7.0-91Np1WF1N8MDj1zOTTXnHX" True) (C1 (MetaCons "Path" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath)))

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

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

>>> addExtension ".foo"   $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo"    )
>>> addExtension ".foo."  $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo."   )
>>> addExtension ".foo.." $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo.."  )
>>> addExtension ".foo"   $(mkRelFile "name.bar" ) == Just $(mkRelFile "name.bar.foo")
>>> addExtension ".foo"   $(mkRelFile ".name"    ) == Just $(mkRelFile ".name.foo"   )
>>> addExtension ".foo"   $(mkRelFile "name."    ) == Just $(mkRelFile "name..foo"   )
>>> addExtension ".foo"   $(mkRelFile "..."      ) == Just $(mkRelFile "....foo"     )

Throws an InvalidExtension exception if the extension is not valid. A valid extension starts with a . followed by one or more characters not including . followed by zero or more . in trailing position. Moreover, an extension must be a valid filename, notably it cannot include path separators. Particularly, .foo.bar is an invalid extension, instead you have to first set .foo and then .bar individually. Some examples of invalid extensions are:

>>> addExtension "foo"      $(mkRelFile "name")
>>> addExtension "..foo"    $(mkRelFile "name")
>>> addExtension ".foo.bar" $(mkRelFile "name")
>>> addExtension ".foo/bar" $(mkRelFile "name")

Since: 0.7.0

splitExtension :: MonadThrow m => Path b File -> m (Path b File, String) Source #

splitExtension is the inverse of addExtension. It splits the given file path into a valid filename and a valid extension.

>>> splitExtension $(mkRelFile "name.foo"     ) == Just ($(mkRelFile "name"    ), ".foo"  )
>>> splitExtension $(mkRelFile "name.foo."    ) == Just ($(mkRelFile "name"    ), ".foo." )
>>> splitExtension $(mkRelFile "name.foo.."   ) == Just ($(mkRelFile "name"    ), ".foo..")
>>> splitExtension $(mkRelFile "name.bar.foo" ) == Just ($(mkRelFile "name.bar"), ".foo"  )
>>> splitExtension $(mkRelFile ".name.foo"    ) == Just ($(mkRelFile ".name"   ), ".foo"  )
>>> splitExtension $(mkRelFile "name..foo"    ) == Just ($(mkRelFile "name."   ), ".foo"  )
>>> splitExtension $(mkRelFile "....foo"      ) == Just ($(mkRelFile "..."     ), ".foo"  )

Throws HasNoExtension exception if the filename does not have an extension or in other words it cannot be split into a valid filename and a valid extension. The following cases throw an exception, please note that "." and ".." are not valid filenames:

>>> splitExtension $(mkRelFile "name"   )
>>> splitExtension $(mkRelFile "name."  )
>>> splitExtension $(mkRelFile "name.." )
>>> splitExtension $(mkRelFile ".name"  )
>>> splitExtension $(mkRelFile "..name" )
>>> splitExtension $(mkRelFile "...name")

splitExtension and addExtension are inverses of each other, the following laws hold:

uncurry addExtension . swap >=> splitExtension == return
splitExtension >=> uncurry addExtension . swap == return

Since: 0.7.0

fileExtension :: MonadThrow m => Path b File -> m String Source #

Get extension from given file path. Throws HasNoExtension exception if the file does not have an extension. The following laws hold:

flip addExtension file >=> fileExtension == return
fileExtension == (fmap snd) . splitExtension

Since: 0.5.11

replaceExtension 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

If the file has an extension replace it with the given extension otherwise add the new extension to it. Throws an InvalidExtension exception if the new extension is not a valid extension (see fileExtension for validity rules).

The following law holds:

(fileExtension >=> flip replaceExtension file) file == return file

Since: 0.7.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)
  • is all path separators

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.

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

Deprecated: Please use addExtension instead.

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

Deprecated: Please use addExtension instead.

A synonym for addFileExtension in the form of an infix 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

Deprecated: Please use replaceExtension instead.

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

Deprecated: Please use replaceExtension instead.

A synonym for setFileExtension in the form of an operator.

Since: 0.6.0