Copyright | © 2015–2016 FP Complete 2016 Julian Ospald |
---|---|
License | BSD 3 clause |
Maintainer | Julian Ospald <[email protected]> |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
HPath
Description
Support for well-typed paths.
Synopsis
- data Path b
- data Abs
- data Rel
- data PathParseException
- data PathException
- pattern Path :: ByteString -> Path a
- parseAbs :: MonadThrow m => ByteString -> m (Path Abs)
- parseRel :: MonadThrow m => ByteString -> m (Path Rel)
- parseAny :: MonadThrow m => ByteString -> m (Either (Path Abs) (Path Rel))
- rootPath :: Path Abs
- pwdPath :: Path Rel
- fromAbs :: Path Abs -> ByteString
- fromRel :: Path Rel -> ByteString
- toFilePath :: Path b -> ByteString
- fromAny :: Either (Path Abs) (Path Rel) -> ByteString
- (</>) :: Path b -> Path Rel -> Path b
- basename :: MonadThrow m => Path b -> m (Path Rel)
- basename' :: Path Rel -> Path Rel
- dirname :: Path Abs -> Path Abs
- getAllParents :: Path Abs -> [Path Abs]
- getAllComponents :: Path Rel -> [Path Rel]
- getAllComponentsAfterRoot :: Path Abs -> [Path Rel]
- stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel)
- isParentOf :: Path b -> Path b -> Bool
- isRootPath :: Path Abs -> Bool
- isPwdPath :: Path Rel -> Bool
- withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a
- withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a
- abs :: QuasiQuoter
- rel :: QuasiQuoter
Types
The main Path type.
The type variable b
is either:
Internally it is a ByteString. The path is guaranteed to
be normalised and contain no trailing Path separators,
except for the "/"
root path.
There are no duplicate path separators
"//"
, no ".."
, no "./"
, etc.
Two special paths exist:
The constructor is not exposed. Instead, use the smart constructors
parseAbs
, parseRel
and parseAny
.
Instances
Typeable a => Lift (Path a :: Type) Source # | |
Eq (Path b) Source # | ByteString equality. The following property holds: show x == show y ≡ x == y |
Ord (Path b) Source # | ByteString ordering. The following property holds: show x `compare` show y ≡ x `compare` y |
Show (Path b) Source # | Same as The following property holds: x == y ≡ show x == show y |
NFData (Path b) Source # | |
Defined in HPath.Internal |
data PathParseException Source #
Exception when parsing a location.
Instances
Show PathParseException Source # | |
Defined in HPath Methods showsPrec :: Int -> PathParseException -> ShowS # show :: PathParseException -> String # showList :: [PathParseException] -> ShowS # | |
Exception PathParseException Source # | |
Defined in HPath Methods toException :: PathParseException -> SomeException # fromException :: SomeException -> Maybe PathParseException # |
data PathException Source #
Instances
Show PathException Source # | |
Defined in HPath Methods showsPrec :: Int -> PathException -> ShowS # show :: PathException -> String # showList :: [PathException] -> ShowS # | |
Exception PathException Source # | |
Defined in HPath Methods toException :: PathException -> SomeException # fromException :: SomeException -> Maybe PathException # displayException :: PathException -> String # |
PatternSynonyms/ViewPatterns
pattern Path :: ByteString -> Path a Source #
Path Construction
parseAbs :: MonadThrow m => ByteString -> m (Path Abs) Source #
Get a location for an absolute path. Produces a normalised path.
Throws: PathParseException
>>>
parseAbs "/abc"
"/abc">>>
parseAbs "/"
"/">>>
parseAbs "/abc/def"
"/abc/def">>>
parseAbs "/abc/def/.///"
"/abc/def">>>
parseAbs "abc"
*** Exception: InvalidAbs "abc">>>
parseAbs ""
*** Exception: InvalidAbs "">>>
parseAbs "/abc/../foo"
*** Exception: InvalidAbs "/abc/../foo"
parseRel :: MonadThrow m => ByteString -> m (Path Rel) Source #
Get a location for a relative path. Produces a normalised path.
Note that filepath
may contain any number of ./
,
but not a single ..
anywhere.
Throws: PathParseException
>>>
parseRel "abc"
"abc">>>
parseRel "def/"
"def">>>
parseRel "abc/def"
"abc/def">>>
parseRel "abc/def/."
"abc/def">>>
parseRel "/abc"
*** Exception: InvalidRel "/abc">>>
parseRel ""
*** Exception: InvalidRel "">>>
parseRel "abc/../foo"
*** Exception: InvalidRel "abc/../foo">>>
parseRel "."
".">>>
parseRel "././././."
".">>>
parseRel "./..."
"...">>>
parseRel ".."
*** Exception: InvalidRel ".."
parseAny :: MonadThrow m => ByteString -> m (Either (Path Abs) (Path Rel)) Source #
Parses a path, whether it's relative or absolute.
Throws: PathParseException
>>>
parseAny "/abc"
Left "/abc">>>
parseAny "..."
Right "...">>>
parseAny "abc/def"
Right "abc/def">>>
parseAny "abc/def/."
Right "abc/def">>>
parseAny "/abc"
Left "/abc">>>
parseAny ""
*** Exception: InvalidRel "">>>
parseAny "abc/../foo"
*** Exception: InvalidRel "abc/../foo">>>
parseAny "."
Right ".">>>
parseAny ".."
*** Exception: InvalidRel ".."
Path Conversion
toFilePath :: Path b -> ByteString Source #
Convert any Path to a ByteString type.
Path Operations
(</>) :: Path b -> Path Rel -> Path b Source #
Append two paths.
The second argument must always be a relative path, which ensures that undefinable things like `"abc" <> "/def"` cannot happen.
Technically, the first argument can be a path that points to a non-directory, because this library is IO-agnostic and makes no assumptions about file types.
>>>
[abs|/|] </> [rel|file|]
"/file">>>
[abs|/path/to|] </> [rel|file|]
"/path/to/file">>>
[abs|/|] </> [rel|file/lal|]
"/file/lal">>>
[abs|/|] </> [rel|.|]
"/">>>
[rel|.|] </> [rel|.|]
"."
basename :: MonadThrow m => Path b -> m (Path Rel) Source #
Extract the file part of a path.
The following properties hold:
basename (p </> a) == basename a
Throws: PathException
if given the root path "/"
>>>
basename [abs|/abc/def/dod|]
"dod">>>
basename [rel|abc/def/dod|]
"dod">>>
basename [rel|dod|]
"dod">>>
basename [rel|.|]
".">>>
basename [abs|/|]
*** Exception: RootDirHasNoBasename
basename' :: Path Rel -> Path Rel Source #
Extract the file part of a relative path.
The following properties hold:
basename' (p </> a) == basename' a
>>>
basename' [rel|abc/def/dod|]
"dod">>>
basename' [rel|dod|]
"dod">>>
basename' [rel|.|]
"."
dirname :: Path Abs -> Path Abs Source #
Extract the directory name of a path.
>>>
dirname [abs|/abc/def/dod|]
"/abc/def">>>
dirname [abs|/|]
"/"
getAllParents :: Path Abs -> [Path Abs] Source #
Get all parents of a path.
>>>
getAllParents [abs|/abs/def/dod|]
["/abs/def","/abs","/"]>>>
getAllParents [abs|/foo|]
["/"]>>>
getAllParents [abs|/|]
[]
getAllComponents :: Path Rel -> [Path Rel] Source #
Gets all path components.
>>>
getAllComponents [rel|abs/def/dod|]
["abs","def","dod"]>>>
getAllComponents [rel|abs|]
["abs"]>>>
getAllComponents [rel|.|]
["."]
getAllComponentsAfterRoot :: Path Abs -> [Path Rel] Source #
Gets all path components after the "/" root directory.
>>>
getAllComponentsAfterRoot [abs|/abs/def/dod|]
["abs","def","dod"]>>>
getAllComponentsAfterRoot [abs|/abs|]
["abs"]
stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel) Source #
Strip directory from path, making it relative to that directory.
Throws Couldn'tStripPrefixDir
if directory is not a parent of the path.
The bases must match.
>>>
[abs|/lal/lad|] `stripDir` [abs|/lal/lad/fad|]
"fad">>>
[rel|lal/lad|] `stripDir` [rel|lal/lad/fad|]
"fad">>>
[abs|/|] `stripDir` [abs|/|]
".">>>
[abs|/lal/lad/fad|] `stripDir` [abs|/lal/lad|]
*** Exception: Couldn'tStripPrefixTPS "/lal/lad/fad" "/lal/lad">>>
[abs|/abs|] `stripDir` [abs|/lal/lad|]
*** Exception: Couldn'tStripPrefixTPS "/abs" "/lal/lad">>>
[rel|fad|] `stripDir` [rel|fad|]
".">>>
[rel|.|] `stripDir` [rel|.|]
".">>>
[rel|.|] `stripDir` [rel|.foo|]
*** Exception: Couldn'tStripPrefixTPS "." ".foo"
Path Examination
isParentOf :: Path b -> Path b -> Bool Source #
Is p a parent of the given location? Implemented in terms of
stripDir
. The bases must match.
>>>
[abs|/lal/lad|] `isParentOf` [abs|/lal/lad/fad|]
True>>>
[rel|lal/lad|] `isParentOf` [rel|lal/lad/fad|]
True>>>
[abs|/|] `isParentOf` [abs|/|]
False>>>
[abs|/lal/lad/fad|] `isParentOf` [abs|/lal/lad|]
False>>>
[rel|fad|] `isParentOf` [rel|fad|]
False>>>
[rel|.|] `isParentOf` [rel|.foo|]
False
isRootPath :: Path Abs -> Bool Source #
Check whether the given Path is the root "/" path.
>>>
isRootPath [abs|/lal/lad|]
False>>>
isRootPath [abs|/|]
True
isPwdPath :: Path Rel -> Bool Source #
Check whether the given Path is the pwd "." path.
>>>
isPwdPath [rel|lal/lad|]
False>>>
isPwdPath [rel|.|]
True
Path IO helpers
withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a Source #
withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a Source #
Quasiquoters
abs :: QuasiQuoter Source #
Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8.
>>>
[abs|/etc/profile|] :: Path Abs
"/etc/profile">>>
[abs|/|] :: Path Abs
"/">>>
[abs|/|] :: Path Abs
"/\239\131\144"
rel :: QuasiQuoter Source #
Quasiquote a relative Path. This accepts Unicode Chars and will encode as UTF-8.
>>>
[rel|etc|] :: Path Rel
"etc">>>
[rel|bar/baz|] :: Path Rel
"bar/baz">>>
[rel||] :: Path Rel
"\239\131\144"