safepath-0.1.0.0: Safe Paths in Haskell

Safe HaskellSafe
LanguageHaskell2010

Data.Path.Internal

Synopsis

Documentation

data Path rel Source #

Instances

Eq (Path rel) Source # 

Methods

(==) :: Path rel -> Path rel -> Bool #

(/=) :: Path rel -> Path rel -> Bool #

Data rel => Data (Path rel) Source # 

Methods

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

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

toConstr :: Path rel -> Constr #

dataTypeOf :: Path rel -> DataType #

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

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

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

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

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

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

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

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

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

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

Show (Path rel) Source # 

Methods

showsPrec :: Int -> Path rel -> ShowS #

show :: Path rel -> String #

showList :: [Path rel] -> ShowS #

Show (Path Relative) Source # 
Show (Path Absolute) Source # 
IsString (Path Relative) Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

IsString (Path Absolute) Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

Generic (Path rel) Source # 

Associated Types

type Rep (Path rel) :: * -> * #

Methods

from :: Path rel -> Rep (Path rel) x #

to :: Rep (Path rel) x -> Path rel #

Validity (Path rel) Source # 

Methods

isValid :: Path rel -> Bool #

type Rep (Path rel) Source # 
type Rep (Path rel) = D1 (MetaData "Path" "Data.Path.Internal" "safepath-0.1.0.0-4DMxAAzjInk6pEzgV90XGT" False) (C1 (MetaCons "Path" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "pathPieces") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [PathPiece])) ((:*:) (S1 (MetaSel (Just Symbol "pathLastPiece") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 LastPathPiece)) (S1 (MetaSel (Just Symbol "pathExtensions") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Extension])))))

data Absolute Source #

Constructors

Absolute 

Instances

Data Absolute Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Absolute -> c Absolute #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Absolute #

toConstr :: Absolute -> Constr #

dataTypeOf :: Absolute -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Absolute) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Absolute) #

gmapT :: (forall b. Data b => b -> b) -> Absolute -> Absolute #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Absolute -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Absolute -> r #

gmapQ :: (forall d. Data d => d -> u) -> Absolute -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Absolute -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Absolute -> m Absolute #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Absolute -> m Absolute #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Absolute -> m Absolute #

Generic Absolute Source # 

Associated Types

type Rep Absolute :: * -> * #

Methods

from :: Absolute -> Rep Absolute x #

to :: Rep Absolute x -> Absolute #

Show (Path Absolute) Source # 
IsString (Path Absolute) Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

type Rep Absolute Source # 
type Rep Absolute = D1 (MetaData "Absolute" "Data.Path.Internal" "safepath-0.1.0.0-4DMxAAzjInk6pEzgV90XGT" False) (C1 (MetaCons "Absolute" PrefixI False) U1)

data Relative Source #

Constructors

Relative 

Instances

Data Relative Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Relative -> c Relative #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Relative #

toConstr :: Relative -> Constr #

dataTypeOf :: Relative -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Relative) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relative) #

gmapT :: (forall b. Data b => b -> b) -> Relative -> Relative #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Relative -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Relative -> r #

gmapQ :: (forall d. Data d => d -> u) -> Relative -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Relative -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Relative -> m Relative #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Relative -> m Relative #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Relative -> m Relative #

Generic Relative Source # 

Associated Types

type Rep Relative :: * -> * #

Methods

from :: Relative -> Rep Relative x #

to :: Rep Relative x -> Relative #

Show (Path Relative) Source # 
IsString (Path Relative) Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

type Rep Relative Source # 
type Rep Relative = D1 (MetaData "Relative" "Data.Path.Internal" "safepath-0.1.0.0-4DMxAAzjInk6pEzgV90XGT" False) (C1 (MetaCons "Relative" PrefixI False) U1)

newtype PathPiece Source #

Constructors

PathPiece Text 

Instances

Eq PathPiece Source # 
Data PathPiece Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PathPiece -> c PathPiece #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PathPiece #

toConstr :: PathPiece -> Constr #

dataTypeOf :: PathPiece -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c PathPiece) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PathPiece) #

gmapT :: (forall b. Data b => b -> b) -> PathPiece -> PathPiece #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PathPiece -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PathPiece -> r #

gmapQ :: (forall d. Data d => d -> u) -> PathPiece -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PathPiece -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PathPiece -> m PathPiece #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PathPiece -> m PathPiece #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PathPiece -> m PathPiece #

Show PathPiece Source # 
IsString PathPiece Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

Generic PathPiece Source # 

Associated Types

type Rep PathPiece :: * -> * #

Validity PathPiece Source # 

Methods

isValid :: PathPiece -> Bool #

type Rep PathPiece Source # 
type Rep PathPiece = D1 (MetaData "PathPiece" "Data.Path.Internal" "safepath-0.1.0.0-4DMxAAzjInk6pEzgV90XGT" True) (C1 (MetaCons "PathPiece" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))

newtype LastPathPiece Source #

Constructors

LastPathPiece Text 

Instances

Eq LastPathPiece Source # 
Data LastPathPiece Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> LastPathPiece -> c LastPathPiece #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c LastPathPiece #

toConstr :: LastPathPiece -> Constr #

dataTypeOf :: LastPathPiece -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c LastPathPiece) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LastPathPiece) #

gmapT :: (forall b. Data b => b -> b) -> LastPathPiece -> LastPathPiece #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LastPathPiece -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LastPathPiece -> r #

gmapQ :: (forall d. Data d => d -> u) -> LastPathPiece -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> LastPathPiece -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> LastPathPiece -> m LastPathPiece #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> LastPathPiece -> m LastPathPiece #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> LastPathPiece -> m LastPathPiece #

Show LastPathPiece Source # 
IsString LastPathPiece Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

Generic LastPathPiece Source # 

Associated Types

type Rep LastPathPiece :: * -> * #

Validity LastPathPiece Source # 
type Rep LastPathPiece Source # 
type Rep LastPathPiece = D1 (MetaData "LastPathPiece" "Data.Path.Internal" "safepath-0.1.0.0-4DMxAAzjInk6pEzgV90XGT" True) (C1 (MetaCons "LastPathPiece" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))

newtype Extension Source #

Constructors

Extension Text 

Instances

Eq Extension Source # 
Data Extension Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Extension -> c Extension #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Extension #

toConstr :: Extension -> Constr #

dataTypeOf :: Extension -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Extension) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extension) #

gmapT :: (forall b. Data b => b -> b) -> Extension -> Extension #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Extension -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Extension -> r #

gmapQ :: (forall d. Data d => d -> u) -> Extension -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Extension -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Extension -> m Extension #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Extension -> m Extension #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Extension -> m Extension #

Show Extension Source # 
IsString Extension Source #

ONLY for OverloadedStrings This instance instance is unsafe and should only be used at own risk, for literals

Generic Extension Source # 

Associated Types

type Rep Extension :: * -> * #

Validity Extension Source # 

Methods

isValid :: Extension -> Bool #

type Rep Extension Source # 
type Rep Extension = D1 (MetaData "Extension" "Data.Path.Internal" "safepath-0.1.0.0-4DMxAAzjInk6pEzgV90XGT" True) (C1 (MetaCons "Extension" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))

isPathSeparator :: Char -> Bool Source #

Check if a given character is a valid path separator

>>> isPathSeparator pathSeparator
True
>>> all isPathSeparator pathSeparators
True

isExtensionSeparator :: Char -> Bool Source #

Check if a given character is a valid extension separator

>>> isExtensionSeparator extensionSeparator
True
>>> all isExtensionSeparator extensionSeparators
True

relpath :: FilePath -> Maybe RelPath Source #

Construct a relative path from a FilePath, failing if the given FilePath does not represent a valid relative path.

>>> relpath "file"
Just file
>>> relpath "/file"
Nothing
>>> relpath "."
Just .
>>> relpath "/"
Nothing
>>> relpath ""
Nothing

abspath :: FilePath -> Maybe AbsPath Source #

Construct an absolute path from a FilePath, failing if the given FilePath does not represent a valid absolute path.

>>> abspath "/file"
Just /file
>>> abspath "file"
Nothing
>>> abspath "/"
Just /
>>> abspath "."
Nothing
>>> abspath ""
Nothing

pathpiece :: String -> Maybe PathPiece Source #

Construct a path piece safely

>>> pathpiece "file"
Just file
>>> pathpiece "with.dot"
Just with.dot
>>> pathpiece "with/slash"
Nothing

lastpiece :: String -> Maybe LastPathPiece Source #

Construct a last path piece safely

>>> lastpiece "file"
Just file
>>> lastpiece "with.dot"
Nothing

ext :: String -> Maybe Extension Source #

Construct an extension safely

>>> ext "extension"
Just extension
>>> ext ".ext"
Nothing
>>> ext ""
Nothing

ground :: AbsPath -> FilePath -> Maybe AbsPath Source #

Ground a filepath on an absolute path. This will try to parse the given FilePath as an absolute path and take it if that works. Otherwise it will try to parse it an a relative path and append it to the given AbsPath

>>> ground "/home/user" "relative/path"
Just /home/user/relative/path
>>> ground "/home/user" "/absolute/path"
Just /absolute/path
>>> ground "/home/user" "."
Just /home/user
>>> ground "/home/user" "/"
Just /
>>> ground "/" "."
Just /
>>> ground "/anything" ""
Nothing

unsafeRelPathError :: FilePath -> RelPath Source #

Construct a relative path, throwing an error if relpath would fail.

unsafeAbsPathError :: FilePath -> AbsPath Source #

Construct an absolute path, throwing an error if abspath would fail.

unsafePathPieceError :: String -> PathPiece Source #

Construct an extension, throwing an error if pathpiece would fail.

unsafeLastPieceError :: String -> LastPathPiece Source #

Construct an extension, throwing an error if lastpiece would fail.

unsafeExtError :: String -> Extension Source #

Construct an extension, throwing an error if ext would fail.

toRelFilePath :: RelPath -> FilePath Source #

Render a relative filepath to a FilePath

toAbsFilePath :: AbsPath -> FilePath Source #

Render an absolute filepath to a FilePath

takeExtension :: Path rel -> Maybe Extension Source #

Take the last extension of a filepath

>>> takeExtension ("/directory/path.ext" :: AbsPath)
Just ext
>>> takeExtension ("file.tar.gz" :: RelPath)
Just gz
>>> takeExtension ("file" :: RelPath)
Nothing

Replaces System.FilePath.takeExtension

takeExtensions :: Path rel -> [Extension] Source #

Take all extensions of a given path in the form of a list

>>> takeExtensions ("/directory/path.ext" :: AbsPath)
[ext]
>>> takeExtensions ("file.tar.gz" :: RelPath)
[tar,gz]

Replaces System.FilePath.takeExtensions

replaceExtensionExact :: Path rel -> Extension -> Maybe (Path rel) Source #

Replace the last extension of a path, exactly

This will fail if the given path has no extension

>>> replaceExtensionExact "dir/file.ext1.ext2"  "ext3" :: Maybe RelPath
Just dir/file.ext1.ext3
>>> replaceExtensionExact "dir/file.ext1"       "ext2" :: Maybe RelPath
Just dir/file.ext2
>>> replaceExtensionExact "dir/file"            "ext"  :: Maybe RelPath
Nothing
>>> replaceExtensionExact "/dir/file.ext1.ext2" "ext3" :: Maybe AbsPath
Just /dir/file.ext1.ext3
>>> replaceExtensionExact "/dir/file.ext1"      "ext2" :: Maybe AbsPath
Just /dir/file.ext2
>>> replaceExtensionExact "/dir/file"           "ext"  :: Maybe AbsPath
Nothing
>>> replaceExtensionExact "." "ext" :: Maybe RelPath
Nothing
>>> replaceExtensionExact "/" "ext" :: Maybe AbsPath
Nothing

replaceExtension :: Path rel -> Extension -> Path rel Source #

Replace the last extension of a path

This will first remove one extension and then add the given extension.

replaceExtension path extension = dropExtension path <.> extension
>>> replaceExtension "dir/file.ext1.ext2"  "ext3" :: RelPath
dir/file.ext1.ext3
>>> replaceExtension "dir/file.ext1"       "ext2" :: RelPath
dir/file.ext2
>>> replaceExtension "dir/file"            "ext"  :: RelPath
dir/file.ext
>>> replaceExtension "/dir/file.ext1.ext2" "ext3" :: AbsPath
/dir/file.ext1.ext3
>>> replaceExtension "/dir/file.ext1"      "ext2" :: AbsPath
/dir/file.ext2
>>> replaceExtension "/dir/file"           "ext"  :: AbsPath
/dir/file.ext
>>> replaceExtension "." "ext" :: RelPath
.
>>> replaceExtension "/" "ext" :: AbsPath
/

Replaces System.FilePath.replaceExtension

(-<.>) :: Path rel -> Extension -> Path rel Source #

Replace the last extension of a path (equivalent to replaceExtension)

>>> "dir/file.ext1.ext2" -<.> "ext3"   :: RelPath
dir/file.ext1.ext3
>>> "dir/file.ext1" -<.> "ext2"        :: RelPath
dir/file.ext2
>>> "dir/file" -<.> "ext"              :: RelPath
dir/file.ext
>>> "/dir/file.ext1.ext2" -<.> "ext3"  :: AbsPath
/dir/file.ext1.ext3
>>> "/dir/file.ext1" -<.> "ext2"       :: AbsPath
/dir/file.ext2
>>> "/dir/file" -<.> "ext"             :: AbsPath
/dir/file.ext
>>> "." -<.> "ext" :: RelPath
.
>>> "/" -<.> "ext" :: AbsPath
/

Replaces System.FilePath.(-.)

replaceExtensions :: Path rel -> Extension -> Path rel Source #

Replace all the extensions of a path with the given extension

>>> replaceExtensions "dir/file.ext1.ext2"  "ext3" :: RelPath
dir/file.ext3
>>> replaceExtensions "dir/file.ext1"       "ext3" :: RelPath
dir/file.ext3
>>> replaceExtensions "dir/file"            "ext3" :: RelPath
dir/file.ext3
>>> replaceExtensions "/dir/file.ext1.ext2" "ext3" :: AbsPath
/dir/file.ext3
>>> replaceExtensions "/dir/file.ext1"      "ext3" :: AbsPath
/dir/file.ext3
>>> replaceExtensions "/dir/file"           "ext3" :: AbsPath
/dir/file.ext3
>>> replaceExtensions "." "ext" :: RelPath
.
>>> replaceExtensions "/" "ext" :: AbsPath
/

replaceExtensionss :: Path rel -> [Extension] -> Path rel Source #

Replace all the extensions of a path with the given list of extensions

>>> replaceExtensionss "dir/file.ext1.ext2"  ["ext3", "ext4"] :: RelPath
dir/file.ext3.ext4
>>> replaceExtensionss "dir/file.ext1"       ["ext3", "ext4"] :: RelPath
dir/file.ext3.ext4
>>> replaceExtensionss "dir/file"            ["ext3", "ext4"] :: RelPath
dir/file.ext3.ext4
>>> replaceExtensionss "/dir/file.ext1.ext2" ["ext3", "ext4"] :: AbsPath
/dir/file.ext3.ext4
>>> replaceExtensionss "/dir/file.ext1"      ["ext3", "ext4"] :: AbsPath
/dir/file.ext3.ext4
>>> replaceExtensionss "/dir/file"           ["ext3", "ext4"] :: AbsPath
/dir/file.ext3.ext4
>>> replaceExtensionss "." ["ext1", "ext2"] :: RelPath
.
>>> replaceExtensionss "/" ["ext1", "ext2"] :: AbsPath
/

dropExtensionExact :: Path rel -> Maybe (Path rel) Source #

Drop the last extension of a path, exactly

This will fail if the given path has no extensions

>>> dropExtensionExact "dir/file.ext1.ext2" :: Maybe RelPath
Just dir/file.ext1
>>> dropExtensionExact "dir/file.ext" :: Maybe RelPath
Just dir/file
>>> dropExtensionExact "dir/file" :: Maybe RelPath
Nothing
>>> dropExtensionExact "/dir/file.ext1.ext2" :: Maybe AbsPath
Just /dir/file.ext1
>>> dropExtensionExact "/dir/file.ext" :: Maybe AbsPath
Just /dir/file
>>> dropExtensionExact "/dir/file" :: Maybe AbsPath
Nothing
>>> dropExtensionExact "." :: Maybe RelPath
Nothing
>>> dropExtensionExact "/" :: Maybe AbsPath
Nothing

dropExtension :: Path rel -> Path rel Source #

Drop the last extension of a path

>>> dropExtension "dir/file.ext1.ext2" :: RelPath
dir/file.ext1
>>> dropExtension "dir/file.ext" :: RelPath
dir/file
>>> dropExtension "dir/file" :: RelPath
dir/file
>>> dropExtension "/dir/file.ext1.ext2" :: AbsPath
/dir/file.ext1
>>> dropExtension "/dir/file.ext" :: AbsPath
/dir/file
>>> dropExtension "/dir/file" :: AbsPath
/dir/file
>>> dropExtension "." :: RelPath
.
>>> dropExtension "/" :: AbsPath
/

Replaces System.FilePath.dropExtension

dropExtensions :: Path rel -> Path rel Source #

Drop all extensions of a path

>>> dropExtensions "dir/file.ext1.ext2" :: RelPath
dir/file
>>> dropExtensions "dir/file.ext" :: RelPath
dir/file
>>> dropExtensions "dir/file" :: RelPath
dir/file
>>> dropExtensions "/dir/file.ext1.ext2" :: AbsPath
/dir/file
>>> dropExtensions "/dir/file.ext" :: AbsPath
/dir/file
>>> dropExtensions "/dir/file" :: AbsPath
/dir/file
>>> dropExtensions "." :: RelPath
.
>>> dropExtensions "/" :: AbsPath
/

Replaces System.FilePath.dropExtensions

addExtension :: Path rel -> Extension -> Path rel Source #

Add an extension to a path

>>> addExtension "/directory/path" "ext" :: AbsPath
/directory/path.ext
>>> addExtension "directory/path"  "ext" :: RelPath
directory/path.ext

This will not override the extension if there already is an extension. It will only add the given extension on top of it

>>> addExtension "/directory/path.ext1" "ext2" :: AbsPath
/directory/path.ext1.ext2
>>> addExtension "directory/path.ext1"  "ext2" :: RelPath
directory/path.ext1.ext2

This will not add an extension if the path is empty.

>>> addExtension "." "ext" :: RelPath
.
>>> addExtension "/" "ext" :: AbsPath
/

Replaces System.FilePath.addExtension

(<.>) :: Path rel -> Extension -> Path rel Source #

Add an extension to a path (equivalent to addExtension)

>>> "/directory/path" <.> "ext" :: AbsPath
/directory/path.ext
>>> "directory/path"  <.> "ext" :: RelPath
directory/path.ext
>>> "/directory/path.ext1" <.> "ext2" :: AbsPath
/directory/path.ext1.ext2
>>> "directory/path.ext1"  <.> "ext2" :: RelPath
directory/path.ext1.ext2
>>> "." <.> "ext" :: RelPath
.
>>> "/" <.> "ext" :: AbsPath
/

Replaces System.FilePath.(.)

addExtensions :: Path rel -> [Extension] -> Path rel Source #

Add a list of extensions to a path

>>> addExtensions "/directory/path" ["ext1", "ext2"] :: AbsPath
/directory/path.ext1.ext2
>>> addExtensions "directory/path"  ["ext1", "ext2"] :: RelPath
directory/path.ext1.ext2
>>> addExtensions "/directory/path.ext1" ["ext2", "ext3"] :: AbsPath
/directory/path.ext1.ext2.ext3
>>> addExtensions "directory/path.ext1"  ["ext2", "ext3"] :: RelPath
directory/path.ext1.ext2.ext3
>>> addExtensions "." ["ext1", "ext2"] :: RelPath
.
>>> addExtensions "/" ["ext1", "ext2"] :: AbsPath
/

This operation is an identity function if the given list of extensions is empty.

stripExtension :: Path rel -> Extension -> Maybe (Path rel) Source #

Drop the given extension from a FilePath. Fails if the FilePath does not have the given extension.

>>> stripExtension "foo.x.hs.o" "o"    :: Maybe RelPath
Just foo.x.hs
>>> stripExtension "foo.x.hs.o" "hs"   :: Maybe RelPath
Nothing
>>> stripExtension "a.b.c.d"    "d"    :: Maybe RelPath
Just a.b.c
>>> stripExtension "foo.bar"    "baz"  :: Maybe RelPath
Nothing
>>> stripExtension "foobar"     "bar"  :: Maybe RelPath
Nothing

Replaces System.FilePath.stripExtension

stripExtensions :: Path rel -> [Extension] -> Maybe (Path rel) Source #

Drop the given extensions from a FilePath. Fails if the FilePath does not have all of the given extensions.

>>> stripExtensions "foo.x.hs.o" ["hs", "o"]      :: Maybe RelPath
Just foo.x
>>> stripExtensions "foo.x.hs.o" ["o", "hs"]      :: Maybe RelPath
Nothing
>>> stripExtensions "a.b.c.d"    ["c", "d"]       :: Maybe RelPath
Just a.b
>>> stripExtensions "foo.bar"    ["baz", "quux"]  :: Maybe RelPath
Nothing
>>> stripExtensions "foobar"     ["bar"]          :: Maybe RelPath
Nothing

splitExtension :: Path rel -> Maybe (Path rel, Extension) Source #

Split off the extensions from a path

>>> splitExtension ("dir/file.ext1.ext2" :: RelPath)
Just (dir/file.ext1,ext2)
>>> splitExtension ("dir/file.ext" :: RelPath)
Just (dir/file,ext)
>>> splitExtension ("dir/file" :: RelPath)
Nothing
>>> splitExtension ("/dir/file.ext1.ext2" :: AbsPath)
Just (/dir/file.ext1,ext2)
>>> splitExtension ("/dir/file.ext" :: AbsPath)
Just (/dir/file,ext)
>>> splitExtension ("/dir/file" :: AbsPath)
Nothing
>>> splitExtension ("." :: RelPath)
Nothing
>>> splitExtension ("/" :: AbsPath)
Nothing

Replaces System.FilePath.splitExtension

splitExtensions :: Path rel -> (Path rel, [Extension]) Source #

Split off the extensions from a path

>>> splitExtensions ("dir/file.ext1.ext2" :: RelPath)
(dir/file,[ext1,ext2])
>>> splitExtensions ("dir/file.ext" :: RelPath)
(dir/file,[ext])
>>> splitExtensions ("dir/file" :: RelPath)
(dir/file,[])
>>> splitExtensions ("/dir/file.ext1.ext2" :: AbsPath)
(/dir/file,[ext1,ext2])
>>> splitExtensions ("/dir/file.ext" :: AbsPath)
(/dir/file,[ext])
>>> splitExtensions ("/dir/file" :: AbsPath)
(/dir/file,[])
>>> splitExtensions ("." :: RelPath)
(.,[])
>>> splitExtensions ("/" :: AbsPath)
(/,[])

hasExtension :: Path rel -> Bool Source #

Check whether the given filepath has any extensions

>>> hasExtension ("/directory/path.ext" :: AbsPath)
True
>>> hasExtension ("/directory/path"     :: AbsPath)
False

Replaces System.FilePath.hasExtension

splitFileName :: Path rel -> (Path rel, RelPath) Source #

Split a path into all but the last piece and the last piece and the extensions

>>> splitFileName ("/directory/file.ext" :: AbsPath)
(/directory,file.ext)
>>> splitFileName ("file/bob.txt" :: RelPath)
(file,bob.txt)
>>> splitFileName ("file" :: RelPath)
(.,file)
>>> splitFileName ("dir.ext/file.ext" :: RelPath)
(dir.ext,file.ext)

takeFileNameExact :: Path rel -> Maybe RelPath Source #

Take the last piece and the extensions, exactly.

This will evaluate to Nothing if the given path is empty

>>> takeFileNameExact ("/directory/file.ext" :: AbsPath)
Just file.ext
>>> takeFileNameExact ("file/bob.txt" :: RelPath)
Just bob.txt
>>> takeFileNameExact ("file" :: RelPath)
Just file
>>> takeFileNameExact ("dir.ext/file.ext" :: RelPath)
Just file.ext
>>> takeFileNameExact ("." :: RelPath)
Nothing
>>> takeFileNameExact ("/" :: AbsPath)
Nothing

Replaces System.FilePath.takeFileName

takeFileName :: Path rel -> RelPath Source #

Take the last piece and the extensions.

This will evaluate to the empty (relative) path if the given path is empty.

>>> takeFileName ("/directory/file.ext" :: AbsPath)
file.ext
>>> takeFileName ("file/bob.txt" :: RelPath)
bob.txt
>>> takeFileName ("file" :: RelPath)
file
>>> takeFileName ("dir.ext/file.ext" :: RelPath)
file.ext
>>> takeFileName ("." :: RelPath)
.
>>> takeFileName ("/" :: AbsPath)
.

Replaces System.FilePath.takeFileName

replaceFileNameExact :: Path rel -> PathPiece -> Maybe (Path rel) Source #

Replace the last piece of a path with the given last piece.

>>> replaceFileNameExact "/directory/other.txt" "file.ext" :: Maybe AbsPath
Just /directory/file.ext
>>> replaceFileNameExact "." "file.ext" :: Maybe RelPath
Just file.ext
>>> replaceFileNameExact "/" "file.ext" :: Maybe AbsPath
Just /file.ext

If the given path piece is degenerate, this is what happens:

>>> replaceFileNameExact "/directory/other.txt" "..." :: Maybe AbsPath
Nothing

replaceFileName :: Path rel -> PathPiece -> Path rel Source #

Replace the last piece of a path with the given last piece.

>>> replaceFileName "/directory/other.txt" "file.ext" :: AbsPath
/directory/file.ext
>>> replaceFileName "." "file.ext" :: RelPath
file.ext
>>> replaceFileName "/" "file.ext" :: AbsPath
/file.ext

If the given path piece is degenerate, this is what happens:

>>> replaceFileName "/directory/other.txt" "..." :: AbsPath
/directory

dropFileNameExact :: Path rel -> Maybe (Path rel) Source #

Drop the last piece of a path, exactly

>>> dropFileNameExact ("directory/file.ext" :: RelPath)
Just directory
>>> dropFileNameExact ("/directory/file.ext" :: AbsPath)
Just /directory

This evaluates to Nothing when given an empty path

>>> dropFileNameExact ("/" :: AbsPath)
Nothing
>>> dropFileNameExact ("." :: RelPath)
Nothing

dropFileName :: Path rel -> Path rel Source #

Drop the last piece of a path

>>> dropFileName ("directory/file.ext" :: RelPath)
directory
>>> dropFileName ("/directory/file.ext" :: AbsPath)
/directory

This evaluates to an empty path when given an empty path

>>> dropFileName ("/" :: AbsPath)
/
>>> dropFileName ("." :: RelPath)
.

Replaces System.FilePath.dropFileName and System.FilePath.takeDirectory

takeBaseNameExact :: Path rel -> Maybe LastPathPiece Source #

Take the last piece (no extensions)

>>> takeBaseNameExact ("file.ext" :: RelPath)
Just file
>>> takeBaseNameExact ("dir/and/file.ext" :: RelPath)
Just file

This will evaluate to Nothing when given an empty path:

>>> takeBaseNameExact ("." :: RelPath)
Nothing
>>> takeBaseNameExact ("/" :: AbsPath)
Nothing

takeBaseName :: Path rel -> LastPathPiece Source #

Take the last piece (no extensions)

>>> takeBaseName ("file.ext" :: RelPath)
file
>>> takeBaseName ("dir/and/file.ext" :: RelPath)
file

This will evaluate to an empty last path piece when given an empty path:

Replaces System.FilePath.takeBaseName

replaceBaseNameExact :: Path rel -> LastPathPiece -> Maybe (Path rel) Source #

Replace the last piece exactly: fails on empty last piece

>>> replaceBaseNameExact "file.ext" "piece" :: Maybe RelPath
Just piece.ext
>>> replaceBaseNameExact "." "thing" :: Maybe RelPath
Just thing
>>> replaceBaseNameExact "/" "thing" :: Maybe AbsPath
Just /thing
>>> replaceBaseNameExact "/directory/file" "" :: Maybe AbsPath
Nothing

replaceBaseName :: Path rel -> LastPathPiece -> Path rel Source #

Replace the last piece

>>> replaceBaseName "file.ext" "piece" :: RelPath
piece.ext
>>> replaceBaseName "." "thing" :: RelPath
thing
>>> replaceBaseName "/" "thing" :: AbsPath
/thing
>>> replaceBaseName "/directory/file" "" :: AbsPath
/directory

Replaces System.FilePath.replaceBaseName

replaceDirectoryExact :: Path r -> Path s -> Maybe (Path s) Source #

Replace everthing but the last piece, exactly

>>> replaceDirectoryExact ("/dir/and/file" :: AbsPath) ("other/directory" :: RelPath)
Just other/directory/file

This will evaluate to Nothing if the first argument is an empty path.

>>> replaceDirectoryExact ("." :: RelPath) ("a/directory" :: RelPath)
Nothing
>>> replaceDirectoryExact ("/" :: AbsPath) ("a/directory" :: RelPath)
Nothing

This will evaluate to Nothing if the second argument is an empty path.

>>> replaceDirectoryExact ("dir/file" :: RelPath) ("." :: RelPath)
Nothing
>>> replaceDirectoryExact ("dir/file" :: RelPath) ("/" :: AbsPath)
Nothing

replaceDirectory :: Path r -> Path s -> Path s Source #

Replace everthing but the last piece

>>> replaceDirectory ("/dir/and/file" :: AbsPath) ("other/directory" :: RelPath)
other/directory/file
>>> replaceDirectory ("." :: RelPath) ("a/directory" :: RelPath)
a/directory
>>> replaceDirectory ("/" :: AbsPath) ("a/directory" :: RelPath)
a/directory
>>> replaceDirectory ("dir/file" :: RelPath) ("." :: RelPath)
file
>>> replaceDirectory ("dir/file" :: RelPath) ("/" :: AbsPath)
/file

Replaces System.FilePath.replaceDirectory

combineExact :: Path rel -> RelPath -> Maybe (Path rel) Source #

Combine two paths, exactly

If the first path has extensions, they will be appended to the last pathpiece before concatenation

>>> combineExact "/directory/path" "another/path.ext" :: Maybe AbsPath
Just /directory/path/another/path.ext
>>> combineExact "directory/path"  "another/path.ext" :: Maybe RelPath
Just directory/path/another/path.ext
>>> combineExact "/file.ext1.ext2" "other/file.ext3"  :: Maybe AbsPath
Just /file.ext1.ext2/other/file.ext3
>>> combineExact "file.ext1.ext2"  "other/file.ext3"  :: Maybe RelPath
Just file.ext1.ext2/other/file.ext3

This evaluates to Nothing if any of the given paths are empty

>>> combineExact "." "file.ext" :: Maybe RelPath
Nothing
>>> combineExact "/" "file.ext" :: Maybe AbsPath
Nothing

combine :: Path rel -> RelPath -> Path rel Source #

Combine two paths

If the first path has extensions, they will be appended to the last pathpiece before concatenation

>>> combine "/directory/path" "another/path.ext" :: AbsPath
/directory/path/another/path.ext
>>> combine "directory/path"  "another/path.ext" :: RelPath
directory/path/another/path.ext
>>> combine "/file.ext1.ext2" "other/file.ext3"  :: AbsPath
/file.ext1.ext2/other/file.ext3
>>> combine "file.ext1.ext2"  "other/file.ext3"  :: RelPath
file.ext1.ext2/other/file.ext3

This treats empty paths as identities to the operation.

>>> combine "file.ext" "." :: RelPath
file.ext
>>> combine "." "file.ext" :: RelPath
file.ext
>>> combine "/" "file.ext" :: AbsPath
/file.ext
>>> combine "." "." :: RelPath
.
>>> combine "/" "." :: AbsPath
/

Replaces System.FilePath.combine

(</>) :: Path rel -> RelPath -> Path rel Source #

Combine two paths

equivalent to combine

>>> "/directory/path" </> "another/path.ext" :: AbsPath
/directory/path/another/path.ext
>>> "directory/path"  </> "another/path.ext" :: RelPath
directory/path/another/path.ext
>>> "/file.ext1.ext2" </> "other/file.ext3"  :: AbsPath
/file.ext1.ext2/other/file.ext3
>>> "file.ext1.ext2"  </> "other/file.ext3"  :: RelPath
file.ext1.ext2/other/file.ext3
>>> "." </> "file.ext" :: RelPath
file.ext
>>> "/" </> "file.ext" :: AbsPath
/file.ext

Replaces System.FilePath.(/)

splitPath :: Path rel -> [PathPiece] Source #

Split a path up into pieces

>>> splitPath ("/a/full/absolute/directory/path" :: AbsPath)
[a,full,absolute,directory,path]

joinPath :: [PathPiece] -> Maybe (Path rel) Source #

Join path pieces back into a path

>>> joinPath ["a", "full", "absolute", "directory", "path"] :: Maybe AbsPath
Just /a/full/absolute/directory/path
>>> joinPath [] :: Maybe RelPath
Just .
>>> joinPath [] :: Maybe AbsPath
Just /
>>> joinPath [".", "."] :: Maybe RelPath
Nothing

initMay :: [a] -> Maybe [a] Source #

lastMay :: [a] -> Maybe a Source #

unsnoc :: [a] -> Maybe ([a], a) Source #

uncons :: [a] -> Maybe (a, [a]) Source #