pathtype-0.6: src/System/Path/Internal.hs
-- LANGUAGE pragmas need to go in System.Path.[Windows|Posix]
module System.Path.MODULE_NAME
(
-- * The main filepath (& dirpath) abstract type
Path, -- kept abstract
-- * Phantom Types
Abs,
Rel,
File,
Dir,
-- * Type Synonyms
AbsFile,
RelFile,
AbsDir,
RelDir,
AbsPath,
RelPath,
FilePath,
DirPath,
-- * Classes
AbsRelClass(..),
FileDirClass(..),
-- * Path to String conversion
getPathString,
-- * Constants
rootDir,
currentDir,
-- * Unchecked Construction Functions
asPath,
asRelFile,
asRelDir,
asAbsFile,
asAbsDir,
asRelPath,
asAbsPath,
asFilePath,
asDirPath,
-- * Checked Construction Functions
mkPathAbsOrRel,
mkPathFileOrDir,
mkAbsPath,
mkAbsPathFromCwd,
-- * Basic Manipulation Functions
(</>),
(<.>),
addExtension,
combine,
dropExtension,
dropExtensions,
dropFileName,
replaceExtension,
replaceBaseName,
replaceDirectory,
replaceFileName,
splitExtension,
splitExtensions,
splitFileName,
takeBaseName,
takeDirectory,
takeExtension,
takeExtensions,
takeFileName,
-- * Auxillary Manipulation Functions
equalFilePath,
joinPath,
normalise,
splitPath,
makeRelative,
makeAbsolute,
makeAbsoluteFromCwd,
genericMakeAbsolute,
genericMakeAbsoluteFromCwd,
pathMap,
-- * Path Predicates
isAbsolute,
isAbsoluteString,
isRelative,
isRelativeString,
hasAnExtension,
hasExtension,
-- * Separators
addTrailingPathSeparator,
dropTrailingPathSeparator,
extSeparator,
hasTrailingPathSeparator,
pathSeparator,
pathSeparators,
searchPathSeparator,
isExtSeparator,
isPathSeparator,
isSearchPathSeparator,
-- * Generic Manipulation Functions
genericAddExtension,
genericDropExtension,
genericDropExtensions,
genericSplitExtension,
genericSplitExtensions,
genericTakeExtension,
genericTakeExtensions
)
where
import qualified System.Directory as SD
import Control.Arrow (first, second, (|||), (***))
import Control.Monad (guard, mplus)
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData(rnf))
import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intersperse)
import Data.String (IsString(fromString))
import Data.Maybe (fromMaybe, maybeToList)
import Data.Char (toLower, isAlpha, isSpace)
import Text.Printf (printf)
import qualified Test.QuickCheck as QC
import Test.QuickCheck
(Gen, Property, property, Arbitrary(arbitrary),
oneof, frequency, quickCheck)
import Prelude hiding (FilePath)
------------------------------------------------------------------------
-- Types
newtype Abs = Abs String deriving (Eq, Ord)
data Rel = Rel deriving (Eq, Ord)
newtype File = File PathComponent deriving (Eq, Ord)
data Dir = Dir deriving (Eq, Ord)
-- | This is the main filepath abstract datatype
data Path ar fd = Path ar [PathComponent] fd
instance (AbsRelClass ar, FileDirClass fd) => Eq (Path ar fd) where
Path ar0 pcs0 fd0 == Path ar1 pcs1 fd1 =
(WrapAbsRel ar0, pcs0, WrapFileDir fd0)
==
(WrapAbsRel ar1, pcs1, WrapFileDir fd1)
instance (AbsRelClass ar, FileDirClass fd) => Ord (Path ar fd) where
compare (Path ar0 pcs0 fd0) (Path ar1 pcs1 fd1) =
compare
(WrapAbsRel ar0, pcs0, WrapFileDir fd0)
(WrapAbsRel ar1, pcs1, WrapFileDir fd1)
newtype WrapAbsRel ar = WrapAbsRel {unwrapAbsRel :: ar}
instance (AbsRelClass ar) => Eq (WrapAbsRel ar) where
(==) = switchRelation switchAbsRel unwrapAbsRel (==) (==)
instance (AbsRelClass ar) => Ord (WrapAbsRel ar) where
compare = switchRelation switchAbsRel unwrapAbsRel compare compare
newtype WrapFileDir fd = WrapFileDir {unwrapFileDir :: fd}
instance (FileDirClass fd) => Eq (WrapFileDir fd) where
(==) = switchRelation switchFileDir unwrapFileDir (==) (==)
instance (FileDirClass fd) => Ord (WrapFileDir fd) where
compare = switchRelation switchFileDir unwrapFileDir compare compare
newtype Relation res a = Relation {runRelation :: a -> a -> res}
switchRelation ::
(Relation res a -> Relation res b -> Relation res c) ->
(wrapped -> c) ->
(a -> a -> res) ->
(b -> b -> res) ->
wrapped -> wrapped -> res
switchRelation switch unwrap fFile fDir ar0 ar1 =
runRelation
(switch (Relation fFile) (Relation fDir))
(unwrap ar0) (unwrap ar1)
newtype PathComponent = PathComponent String
instance Eq PathComponent where
PathComponent x == PathComponent y =
if isPosix
then x==y
else map toLower x == map toLower y
instance Ord PathComponent where
compare (PathComponent x) (PathComponent y) =
if isPosix
then compare x y
else compare (map toLower x) (map toLower y)
type AbsFile = Path Abs File
type RelFile = Path Rel File
type AbsDir = Path Abs Dir
type RelDir = Path Rel Dir
type AbsPath fd = Path Abs fd
type RelPath fd = Path Rel fd
type FilePath ar = Path ar File
type DirPath ar = Path ar Dir
instance NFData PathComponent where
rnf (PathComponent pc) = rnf pc
instance NFData Abs where
rnf (Abs drive) = rnf drive
instance NFData Rel where
rnf Rel = ()
instance NFData File where
rnf (File pc) = rnf pc
instance NFData Dir where
rnf Dir = ()
instance (AbsRelClass ar, FileDirClass fd) => NFData (Path ar fd) where
rnf (Path ar pcs fd) =
rnf (absRelPlain rnf rnf ar, pcs, fileDirPlain rnf rnf fd)
absRelPlain :: (AbsRelClass ar) => (Abs -> a) -> (Rel -> a) -> ar -> a
absRelPlain fAbs fRel =
runFuncArg $ switchAbsRel (FuncArg fAbs) (FuncArg fRel)
fileDirPlain :: (FileDirClass fd) => (File -> a) -> (Dir -> a) -> fd -> a
fileDirPlain fFile fDir =
runFuncArg $ switchFileDir (FuncArg fFile) (FuncArg fDir)
newtype FuncArg b a = FuncArg {runFuncArg :: a -> b}
-- I don't think this basic type of fold is appropriate for a nested datatype
-- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a
-- pathFold pr f PathRoot = pr
-- pathFold pr f (FileDir d pc) = f (pathFold pr f d) (unPathComponent pc)
-- | Map over the components of the path.
--
-- >> Posix.pathMap (map toLower) "/tmp/Reports/SpreadSheets" == Posix.asAbsDir "/tmp/reports/spreadsheets"
pathMap :: (FileDirClass fd) => (String -> String) -> Path ar fd -> Path ar fd
pathMap f (Path ar pcs fd) = Path ar (map (pcMap f) pcs) (fdMap f fd)
newtype FDMap ar fd = FDMap {runFDMap :: fd -> fd}
fdMap :: (FileDirClass fd) => (String -> String) -> fd -> fd
fdMap f =
runFDMap $
switchFileDir (FDMap $ \(File pc) -> File $ pcMap f pc) (FDMap id)
pcMap :: (String -> String) -> PathComponent -> PathComponent
pcMap f (PathComponent s) = PathComponent (f s)
------------------------------------------------------------------------
-- Type classes and machinery for switching on Abs/Rel and File/Dir
-- | This class provides a way to prevent other modules
-- from making further 'AbsRelClass' or 'FileDirClass'
-- instances
class Private p
instance Private Abs
instance Private Rel
instance Private File
instance Private Dir
-- | This class allows selective behaviour for absolute and
-- relative paths and is mostly for internal use.
class Private ar => AbsRelClass ar where
-- | See <https://wiki.haskell.org/Closed_world_instances>
-- for the used technique.
switchAbsRel :: f Abs -> f Rel -> f ar
-- | Will become a top-level function in future
absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a
absRel f g = runAbsRel $ switchAbsRel (AbsRel f) (AbsRel g)
newtype AbsRel fd a ar = AbsRel {runAbsRel :: Path ar fd -> a}
instance AbsRelClass Abs where switchAbsRel f _g = f
instance AbsRelClass Rel where switchAbsRel _f g = g
-- | This class allows selective behaviour for file and
-- directory paths and is mostly for internal use.
class Private fd => FileDirClass fd where
switchFileDir :: f File -> f Dir -> f fd
-- | Will become a top-level function in future
fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a
fileDir f g = runFileDir $ switchFileDir (FileDir f) (FileDir g)
newtype FileDir ar a fd = FileDir {runFileDir :: Path ar fd -> a}
instance FileDirClass File where switchFileDir f _g = f
instance FileDirClass Dir where switchFileDir _f g = g
-- | Currently not exported
_pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd)
_pathAbsRel = absRel Left Right
-- | Currently not exported
_pathFileDir :: FileDirClass fd => Path ar fd -> Either (FilePath ar) (DirPath ar)
_pathFileDir = fileDir Left Right
------------------------------------------------------------------------
-- Read & Show instances
-- >> show (Posix.rootDir </> "bla" </> Posix.asRelFile "blub") == "rootDir </> \"bla\" </> \"blub\""
-- >> show (Just (Posix.rootDir </> "bla" </> Posix.asRelFile "blub")) == "Just (rootDir </> \"bla\" </> \"blub\")"
-- >> show (Posix.currentDir </> "bla" </> Posix.asRelFile "blub") == "currentDir </> \"bla\" </> \"blub\""
-- >> show (Just (Posix.currentDir </> "bla" </> Posix.asRelFile "blub")) == "Just (currentDir </> \"bla\" </> \"blub\")"
-- >> show (Windows.asAbsDir "c:" Windows.</> "bla" Windows.</> Windows.asRelFile "blub") == "asAbsDir \"c:\" </> \"bla\" </> \"blub\""
-- >> show (Just (Windows.asAbsDir "c:\\" Windows.</> "bla" Windows.</> Windows.asRelFile "blub")) == "Just (asAbsDir \"c:\" </> \"bla\" </> \"blub\")"
instance (AbsRelClass ar, FileDirClass fd) => Show (Path ar fd) where
showsPrec d x =
case pathComponents x of
(ar, pcs) ->
showParen (d>9) $
foldr (.) id $
intersperse
(showChar ' ' .
showString combineOperator . showChar ' ') $
absRelPlain
(\(Abs drive) ->
if null drive
then showString rootName
else showString absDirName .
showString drive .
showChar '"')
(const $ showString currentName)
ar :
map (\(PathComponent pc) -> shows pc) pcs
-- >> let path = Posix.rootDir </> "bla" </> Posix.asRelFile "blub" in read (show path) == path
-- >> let path = Just (Posix.rootDir </> "bla" </> Posix.asRelFile "blub") in read (show path) == path
-- >> let path = Posix.currentDir </> "bla" </> Posix.asRelFile "blub" in read (show path) == path
-- >> let path = Just (Posix.currentDir </> "bla" </> Posix.asRelFile "blub") in read (show path) == path
-- >> let path = Windows.rootDir Windows.</> "bla" Windows.</> Windows.asRelFile "blub" in read (show path) == path
-- >> let path = Just (Windows.rootDir Windows.</> "bla" Windows.</> Windows.asRelFile "blub") in read (show path) == path
instance (AbsRelClass ar, FileDirClass fd) => Read (Path ar fd) where
readsPrec d = readParen (d>9) $ \str ->
let go :: ReadS [PathComponent]
go s0 =
case stripPrefix combineOperator $ dropWhile isSpace s0 of
Nothing -> [([], s0)]
Just s1 -> do
(pc, s2) <- reads s1
(pcs, s3) <- go s2
return (PathComponent pc : pcs, s3)
in do
(ar, s0) <- maybeToList $ readsSplitDrive $ dropWhile isSpace str
(pcs, s1) <- go s0
path <- maybeToList $ maybePathFromComponents ar pcs
return (path, s1)
newtype
ReadsSplitDrive ar =
ReadsSplitDrive {runReadsSplitDrive :: Maybe (ar, String)}
readsSplitDrive :: (AbsRelClass ar) => String -> Maybe (ar, String)
readsSplitDrive str0 =
runReadsSplitDrive $
switchAbsRel
(ReadsSplitDrive $
(fmap ((,) (Abs "")) $ stripPrefix rootName str0)
`mplus`
do str1 <- stripPrefix absDirName str0
(drive, '"':str2) <- Just $ break ('"'==) str1
return (Abs drive, str2))
(ReadsSplitDrive $
fmap ((,) Rel) $ stripPrefix currentName str0)
-- | Convert the 'Path' into a plain 'String' as required for OS calls.
getPathString :: (AbsRelClass ar, FileDirClass fd) => Path ar fd -> String
getPathString = flip getPathStringS ""
getPathStringS :: (AbsRelClass ar, FileDirClass fd) => Path ar fd -> ShowS
getPathStringS x =
case pathComponents x of
(ar, []) ->
absRelPlain
(\(Abs drive) -> showString drive . showChar pathSeparator)
(const $ showString currentDirComponent) ar
(ar, pcs) ->
foldr (.) id $ intersperse (showChar pathSeparator) $
absRelPlain (\(Abs drive) -> (showString drive :)) (const id) ar $
map (\(PathComponent pc) -> showString pc) pcs
prop_asPath_getPathString :: AbsFile -> Property
prop_asPath_getPathString p = property $ p == asPath (getPathString p)
------------------------------------------------------------------------
-- Windows / Posix
isPosix :: Bool
isPosix = not isWindows
isWindows :: Bool
isWindows = IS_WINDOWS
------------------------------------------------------------------------
-- Constants
rootDir :: AbsDir
rootDir = Path (Abs "") [] Dir
currentDir :: RelDir
currentDir = Path Rel [] Dir
rootName :: String
rootName = "rootDir"
currentName :: String
currentName = "currentDir"
currentDirComponent :: String
currentDirComponent = "."
absDirName :: String
absDirName = "asAbsDir \""
------------------------------------------------------------------------
-- Unchecked Construction Functions
-- NB - these construction functions are non-IO and do no checking!!
-- | Use a 'String' as a 'Path' whose type is determined
-- by its context.
--
-- >> Posix.asPath "/tmp" == Posix.asAbsDir "/tmp"
-- >> Posix.asPath "file.txt" == Posix.asRelFile "file.txt"
-- >> Posix.isAbsolute (Posix.asAbsDir "/tmp")
-- >> Posix.isRelative (Posix.asRelDir "/tmp")
-- >> Posix.getPathString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp"
-- >> Posix.getPathString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp"
-- >> Windows.getPathString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp"
-- >> Windows.getPathString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp"
-- >> Windows.getPathString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp"
asPath :: (AbsRelClass ar, FileDirClass fd) => String -> Path ar fd
asPath = uncurry mkPathFromComponents . mkPathComponents
newtype AbsRelDefault ar = AbsRelDefault {getAbsRelDefault :: ar}
absRelDefault :: (AbsRelClass ar) => ar
absRelDefault =
getAbsRelDefault $ switchAbsRel (AbsRelDefault $ Abs "") (AbsRelDefault Rel)
-- | Use a 'String' as a 'RelFile'. No checking is done.
--
-- >> Posix.getPathString (Posix.asRelFile "file.txt") == "file.txt"
-- >> Posix.getPathString (Posix.asRelFile "/file.txt") == "file.txt"
-- >> Posix.getPathString (Posix.asRelFile "tmp") == "tmp"
-- >> Posix.getPathString (Posix.asRelFile "/tmp") == "tmp"
asRelFile :: String -> RelFile
asRelFile = asPath
-- | Use a 'String' as a 'RelDir'. No checking is done.
--
-- >> Posix.getPathString (Posix.asRelDir ".") == "."
-- >> Posix.getPathString (Posix.asRelDir "file.txt") == "file.txt"
-- >> Posix.getPathString (Posix.asRelDir "/file.txt") == "file.txt"
-- >> Posix.getPathString (Posix.asRelDir "tmp") == "tmp"
-- >> Posix.getPathString (Posix.asRelDir "/tmp") == "tmp"
asRelDir :: String -> RelDir
asRelDir = asPath
-- | Use a 'String' as an 'AbsFile'. No checking is done.
--
-- >> Posix.getPathString (Posix.asAbsFile "file.txt") == "/file.txt"
-- >> Posix.getPathString (Posix.asAbsFile "/file.txt") == "/file.txt"
-- >> Posix.getPathString (Posix.asAbsFile "tmp") == "/tmp"
-- >> Posix.getPathString (Posix.asAbsFile "/tmp") == "/tmp"
asAbsFile :: String -> AbsFile
asAbsFile = asPath
-- | Use a 'String' as an 'AbsDir'. No checking is done.
--
-- >> Posix.getPathString (Posix.asAbsDir "file.txt") == "/file.txt"
-- >> Posix.getPathString (Posix.asAbsDir "/file.txt") == "/file.txt"
-- >> Posix.getPathString (Posix.asAbsDir "tmp") == "/tmp"
-- >> Posix.getPathString (Posix.asAbsDir "/tmp") == "/tmp"
asAbsDir :: String -> AbsDir
asAbsDir = asPath
-- | Use a 'String' as a 'RelPath fd'. No checking is done.
asRelPath :: (FileDirClass fd) => String -> RelPath fd
asRelPath = asPath
-- | Use a 'String' as an 'AbsPath fd'. No checking is done.
asAbsPath :: (FileDirClass fd) => String -> AbsPath fd
asAbsPath = asPath
-- | Use a 'String' as a 'FilePath ar'. No checking is done.
asFilePath :: (AbsRelClass ar) => String -> FilePath ar
asFilePath = asPath
-- | Use a 'String' as a 'DirPath ar'. No checking is done.
asDirPath :: (AbsRelClass ar) => String -> DirPath ar
asDirPath = asPath
-- | Allow use of OverloadedStrings if desired
instance
(AbsRelClass ar, FileDirClass fd) =>
IsString (Path ar fd) where fromString = asPath
------------------------------------------------------------------------
-- Checked Construction Functions
-- | Examines the supplied string and constructs an absolute or
-- relative path as appropriate.
--
-- >> Posix.mkPathAbsOrRel "/tmp" == Left (Posix.asAbsDir "/tmp")
-- >> Posix.mkPathAbsOrRel "tmp" == Right (Posix.asRelDir "tmp")
-- >> Windows.mkPathAbsOrRel "\\tmp" == Left (Windows.asAbsDir "\\tmp")
-- >> Windows.mkPathAbsOrRel "d:\\tmp" == Left (Windows.asAbsDir "d:\\tmp")
-- >> Windows.mkPathAbsOrRel "tmp" == Right (Windows.asRelDir "tmp")
mkPathAbsOrRel ::
(FileDirClass fd) => String -> Either (AbsPath fd) (RelPath fd)
mkPathAbsOrRel s =
if isAbsoluteString s
then Left $ asAbsPath s
else Right $ asRelPath s
-- | 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.
mkPathFileOrDir ::
AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath ar)))
mkPathFileOrDir s = do
isfile <- SD.doesFileExist s
isdir <- SD.doesDirectoryExist s
case (isfile, isdir) of
(False, False) -> return Nothing
(True, False) -> return $ Just $ Left $ asPath s
(False, True ) -> return $ Just $ Right $ asPath s
(True, True ) -> ioError $ userError "mkPathFileOrDir - object type changed while checking"
-- | Convert a 'String' into an 'AbsPath' by interpreting it as
-- relative to the supplied directory if necessary.
--
-- >> Posix.mkAbsPath "/tmp" "foo.txt" == Posix.asAbsFile "/tmp/foo.txt"
-- >> Posix.mkAbsPath "/tmp" "/etc/foo.txt" == Posix.asAbsFile "/etc/foo.txt"
mkAbsPath :: (FileDirClass fd) => AbsDir -> String -> AbsPath fd
mkAbsPath d = (id ||| makeAbsolute d) . mkPathAbsOrRel
-- | Convert a 'String' into an 'AbsPath' by interpreting it as
-- relative to the cwd if necessary.
mkAbsPathFromCwd :: (FileDirClass fd) => String -> IO (AbsPath fd)
mkAbsPathFromCwd = (return ||| makeAbsoluteFromCwd) . mkPathAbsOrRel
------------------------------------------------------------------------
-- Internal Functions for PathComponent manipulation
mkPathFromComponents :: (FileDirClass fd) => ar -> [PathComponent] -> Path ar fd
mkPathFromComponents ar pcs =
switchFileDir
(fromMaybe (Path ar [] $ File $ PathComponent "") $
mkFilePathFromComponents ar pcs)
(mkDirPathFromComponents ar pcs)
maybePathFromComponents ::
(FileDirClass fd) => ar -> [PathComponent] -> Maybe (Path ar fd)
maybePathFromComponents ar pcs =
getFunctorPath $
switchFileDir
(FunctorPath $ mkFilePathFromComponents ar pcs)
(FunctorPath $ Just $ mkDirPathFromComponents ar pcs)
newtype
FunctorPath f ar fd =
FunctorPath {getFunctorPath :: f (Path ar fd)}
mkDirPathFromComponents :: ar -> [PathComponent] -> Path ar Dir
mkDirPathFromComponents ar pcs = Path ar pcs Dir
mkFilePathFromComponents :: ar -> [PathComponent] -> Maybe (Path ar File)
mkFilePathFromComponents _ [] = Nothing
mkFilePathFromComponents ar0 (q:qs) =
let mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd
go p [] = Path ar0 [] (File p)
go p0 (p1:ps) = mapPathDirs (p0:) $ go p1 ps
in Just $ go q qs
mkPathComponents :: (AbsRelClass ar) => String -> (ar, [PathComponent])
mkPathComponents =
let go xs =
case break isPathSeparator $ dropWhile isPathSeparator xs of
("","") -> []
(s,rest) -> s : go rest
split [] = (absRelDefault, [])
split (pc:pcs) =
second (map PathComponent) $
case splitDrive pc of
(drive, "") -> (drive, pcs)
(drive, pc0) -> (drive, pc0:pcs)
in split . go
newtype SplitDrive ar = SplitDrive {runSplitDrive :: (ar, String)}
splitDrive :: (AbsRelClass ar) => String -> (ar, String)
splitDrive str =
runSplitDrive $
switchAbsRel
(SplitDrive $ first Abs $
if isPosix
then ("", str)
else
case break (':'==) str of
(drive, ':':rest) -> (drive++":", rest)
_ -> ("", str))
(SplitDrive (Rel, str))
pathComponents :: (FileDirClass fd) => Path ar fd -> (ar, [PathComponent])
pathComponents (Path ar pcs fd) = (ar, pcs ++ fileDirComponent fd)
fileDirComponent :: (FileDirClass fd) => fd -> [PathComponent]
fileDirComponent = fileDirPlain (\(File pc) -> [pc]) (\Dir -> [])
prop_mkPathFromComponents_pathComponents :: AbsDir -> Property
prop_mkPathFromComponents_pathComponents p =
property $ uncurry mkPathFromComponents (pathComponents p) == p
------------------------------------------------------------------------
-- Basic Manipulation Functions
combineOperator :: String
combineOperator = "</>"
-- | Infix variant of 'combine'.
--
-- >> Posix.getPathString (Posix.asAbsDir "/tmp" </> Posix.asRelFile "file.txt") == "/tmp/file.txt"
-- >> Posix.getPathString (Posix.asAbsDir "/tmp" </> Posix.asRelDir "dir" </> Posix.asRelFile "file.txt") == "/tmp/dir/file.txt"
-- >> Posix.getPathString (Posix.asRelDir "dir" </> Posix.asRelFile "file.txt") == "dir/file.txt"
-- >> Windows.getPathString (Windows.asAbsDir "\\tmp" Windows.</> Windows.asRelFile "file.txt") == "\\tmp\\file.txt"
-- >> Windows.getPathString (Windows.asAbsDir "c:\\tmp" Windows.</> Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt"
-- >> Windows.getPathString (Windows.asAbsDir "c:" Windows.</> Windows.asRelDir "tmp" Windows.</> Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt"
-- >> Windows.getPathString (Windows.asRelDir "dir" Windows.</> Windows.asRelFile "file.txt") == "dir\\file.txt"
(</>) :: DirPath ar -> RelPath fd -> Path ar fd
(Path ar pcs0 Dir) </> (Path Rel pcs1 fd) = Path ar (pcs0 ++ pcs1) fd
-- | 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'.
(<.>) :: FilePath ar -> String -> FilePath ar
Path ar pcs (File pc) <.> ext = Path ar pcs (File $ addExtensionPC pc ext)
-- | Add an extension, even if there is already one there.
-- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.
--
-- >> Posix.addExtension (Posix.asRelFile "file.txt") "bib" == "file.txt.bib"
-- >> Posix.addExtension (Posix.asRelFile "file.") ".bib" == "file..bib"
-- >> Posix.addExtension (Posix.asRelFile "file") ".bib" == "file.bib"
-- >> Posix.addExtension (Posix.asRelFile "") "bib" == ".bib"
-- >> Posix.addExtension (Posix.asRelFile "") ".bib" == ".bib"
-- >> Posix.takeFileName (Posix.addExtension (Posix.asRelFile "") "ext") == ".ext"
addExtension :: FilePath ar -> String -> FilePath ar
addExtension = (<.>)
-- | Join an (absolute or relative) directory path with a relative
-- (file or directory) path to form a new path.
combine :: DirPath ar -> RelPath fd -> Path ar fd
combine = (</>)
-- | Remove last extension, and the \".\" preceding it.
--
-- >> Posix.dropExtension x == fst (Posix.splitExtension x)
dropExtension :: FilePath ar -> FilePath ar
dropExtension = fst . splitExtension
-- | Drop all extensions
--
-- >> not $ Posix.hasAnExtension (Posix.dropExtensions x)
dropExtensions :: FilePath ar -> FilePath ar
dropExtensions = fst . splitExtensions
-- | Synonym for 'takeDirectory'
dropFileName :: FilePath ar -> DirPath ar
dropFileName = fst . splitFileName
-- | Set the extension of a file, overwriting one if already present.
--
-- >> Posix.replaceExtension (Posix.asRelFile "file.txt") ".bob" == "file.bob"
-- >> Posix.replaceExtension (Posix.asRelFile "file.txt") "bob" == "file.bob"
-- >> Posix.replaceExtension (Posix.asRelFile "file") ".bob" == "file.bob"
-- >> Posix.replaceExtension (Posix.asRelFile "file.txt") "" == "file"
-- >> Posix.replaceExtension (Posix.asRelFile "file.fred.bob") "txt" == "file.fred.txt"
replaceExtension :: FilePath ar -> String -> FilePath ar
replaceExtension p ext = dropExtension p <.> ext
replaceBaseName :: FilePath ar -> String -> FilePath ar
replaceBaseName (Path ar pcs (File pc)) bn =
Path ar pcs $ File $
addExtensionPC (PathComponent bn) $ snd $ splitExtensionPC pc
replaceDirectory :: FilePath ar1 -> DirPath ar2 -> FilePath ar2
replaceDirectory (Path _ _ fd) (Path ar pcs _) = Path ar pcs fd
replaceFileName :: FilePath ar -> String -> FilePath ar
replaceFileName (Path ar pcs _) fn = Path ar pcs (File (PathComponent fn))
-- | Split on the extension. 'addExtension' is the inverse.
--
-- >> uncurry (<.>) (Posix.splitExtension x) == x
-- >> uncurry Posix.addExtension (Posix.splitExtension x) == x
-- >> Posix.splitExtension (Posix.asRelFile "file.txt") == ("file",".txt")
-- >> Posix.splitExtension (Posix.asRelFile "file") == ("file","")
-- >> Posix.splitExtension (Posix.asRelFile "file/file.txt") == ("file/file",".txt")
-- >> Posix.splitExtension (Posix.asRelFile "file.txt/boris") == ("file.txt/boris","")
-- >> Posix.splitExtension (Posix.asRelFile "file.txt/boris.ext") == ("file.txt/boris",".ext")
-- >> Posix.splitExtension (Posix.asRelFile "file/path.txt.bob.fred") == ("file/path.txt.bob",".fred")
splitExtension :: FilePath ar -> (FilePath ar, String)
splitExtension (Path ar pcs (File pc)) =
first (Path ar pcs . File) $ splitExtensionPC pc
-- | Split on all extensions
--
-- >> Posix.splitExtensions (Posix.asRelFile "file.tar.gz") == ("file",".tar.gz")
splitExtensions :: FilePath ar -> (FilePath ar, String)
splitExtensions (Path ar pcs (File pc)) =
first (Path ar pcs . File) $ splitExtensionsPC pc
prop_split_combineExt :: AbsFile -> Property
prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p)
splitFileName :: FilePath ar -> (DirPath ar, RelFile)
splitFileName (Path ar pcs fd) = (Path ar pcs Dir, Path Rel [] fd)
prop_split_combine :: AbsFile -> Property
prop_split_combine p = property $ uncurry combine (splitFileName p) == p
-- | Get the basename of a file
--
-- >> Posix.takeBaseName (Posix.asAbsFile "/tmp/somedir/myfile.txt") == "myfile"
-- >> Posix.takeBaseName (Posix.asRelFile "./myfile.txt") == "myfile"
-- >> Posix.takeBaseName (Posix.asRelFile "myfile.txt") == "myfile"
takeBaseName :: FilePath ar -> RelFile
takeBaseName = takeFileName . dropExtension
takeDirectory :: FilePath ar -> DirPath ar
takeDirectory = fst . splitFileName
-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
-- >> Posix.takeExtension x == snd (Posix.splitExtension x)
-- >> Posix.takeExtension (Posix.addExtension x "ext") == ".ext"
-- >> Posix.takeExtension (Posix.replaceExtension x "ext") == ".ext"
takeExtension :: FilePath ar -> String
takeExtension = snd . splitExtension
-- | Get all extensions
--
-- >> Posix.takeExtensions (Posix.asRelFile "file.tar.gz") == ".tar.gz"
takeExtensions :: FilePath ar -> String
takeExtensions = snd . splitExtensions
-- | Get the filename component of a file path (ie stripping all parent dirs)
--
-- >> Posix.takeFileName (Posix.asAbsFile "/tmp/somedir/myfile.txt") == "myfile.txt"
-- >> Posix.takeFileName (Posix.asRelFile "./myfile.txt") == "myfile.txt"
-- >> Posix.takeFileName (Posix.asRelFile "myfile.txt") == "myfile.txt"
takeFileName :: FilePath ar -> RelFile
takeFileName (Path _ _ fd) = Path Rel [] fd
prop_takeFileName_end :: AbsFile -> Property
prop_takeFileName_end p = property $ show (takeFileName p) `isSuffixOf` show p
------------------------------------------------------------------------
-- Auxillary Manipulation Functions
-- | Check whether two strings are equal as file paths.
--
-- >> Posix.equalFilePath "/tmp/" "/tmp"
-- >> not $ Posix.equalFilePath "/tmp" "tmp"
-- >> Windows.equalFilePath "file" "File"
-- >> not $ Windows.equalFilePath "file" "dir"
equalFilePath :: String -> String -> Bool
equalFilePath s1 s2 =
let abs1 = isAbsoluteString s1
abs2 = isAbsoluteString s2
in abs1 == abs2 &&
if abs1
then asAbsDir s1 == asAbsDir s2
else asRelDir s1 == asRelDir s2
-- | 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.
--
-- >> Posix.joinPath ["tmp","someDir","dir"] == Posix.asRelDir "tmp/someDir/dir"
-- >> Posix.joinPath ["tmp","someDir","file.txt"] == Posix.asRelFile "tmp/someDir/file.txt"
joinPath :: (FileDirClass fd) => [String] -> RelPath fd
joinPath = mkPathFromComponents Rel . map PathComponent
-- | Currently just transforms:
--
-- >> Posix.normalise "/tmp/fred/./jim/./file" == Posix.asAbsFile "/tmp/fred/jim/file"
normalise :: Path ar fd -> Path ar fd
normalise (Path ar pcs fd) =
Path ar (filter (PathComponent currentDirComponent /=) pcs) fd
-- | Deconstructs a path into its components.
--
-- >> Posix.splitPath (Posix.asAbsDir "/tmp/someDir/mydir.dir") == (True, ["tmp","someDir","mydir.dir"], Nothing)
-- >> Posix.splitPath (Posix.asAbsFile "/tmp/someDir/myfile.txt") == (True, ["tmp","someDir"], Just "myfile.txt")
splitPath ::
(AbsRelClass ar, FileDirClass fd) =>
Path ar fd -> (Bool, [RelDir], Maybe RelFile)
splitPath (Path ar pcs fd) =
(isAbsolutePlain ar,
map (\pc -> Path Rel [pc] Dir) pcs,
maybeFileDir fd)
isAbsolutePlain :: (AbsRelClass ar) => ar -> Bool
isAbsolutePlain = absRelPlain (const True) (const False)
maybeFileDir :: (FileDirClass fd) => fd -> Maybe RelFile
maybeFileDir = fileDirPlain (Just . Path Rel []) (\Dir -> Nothing)
-- | 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'.
--
-- >> Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == Posix.asRelFile "anotherdir/file.txt"
-- >> Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == Posix.asRelDir "anotherdir/dir"
-- >> Windows.makeRelative "c:\\tmp\\somedir" "c:\\Tmp\\SomeDir\\AnotherDir\\File.txt" == Windows.asRelFile "AnotherDir\\File.txt"
-- >> Windows.makeRelative "c:\\tmp\\somedir" "c:\\tmp\\somedir\\anotherdir\\dir" == Windows.asRelDir "anotherdir\\dir"
makeRelative :: (FileDirClass fd) => AbsDir -> AbsPath fd -> RelPath fd
makeRelative relTo@(Path relToAR relToPCs Dir) orig@(Path origAR origPCs fd) =
maybe (error msg) (flip (Path Rel) fd) $
guard (relToAR == origAR) >> stripPrefix relToPCs origPCs
where
msg =
printf "System.Path can't make (%s) relative to (%s)"
(show orig) (show relTo)
-- | Joins an absolute directory with a relative path to construct a
-- new absolute path.
--
-- >> Posix.makeAbsolute "/tmp" "file.txt" == Posix.asAbsFile "/tmp/file.txt"
-- >> Posix.makeAbsolute "/tmp" "adir/file.txt" == Posix.asAbsFile "/tmp/adir/file.txt"
-- >> Posix.makeAbsolute "/tmp" "adir/dir" == Posix.asAbsDir "/tmp/adir/dir"
makeAbsolute :: AbsDir -> RelPath fd -> AbsPath fd
makeAbsolute = genericMakeAbsolute
-- | Converts a relative path into an absolute one by
-- prepending the current working directory.
makeAbsoluteFromCwd :: RelPath fd -> IO (AbsPath fd)
makeAbsoluteFromCwd = genericMakeAbsoluteFromCwd
-- | As for 'makeAbsolute', but for use when the path may already be
-- absolute (in which case it is left unchanged).
--
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "file.txt") == "/tmp/file.txt"
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "adir/file.txt") == "/tmp/adir/file.txt"
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "adir/file.txt") == "/adir/file.txt"
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "/adir/file.txt") == "/adir/file.txt"
genericMakeAbsolute :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath fd
genericMakeAbsolute base p = absRel id (base </>) p
-- | As for 'makeAbsoluteFromCwd', but for use when the path may already be
-- absolute (in which case it is left unchanged).
genericMakeAbsoluteFromCwd :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd)
genericMakeAbsoluteFromCwd p = do
cwdString <- SD.getCurrentDirectory -- we don't use System.Path.Directory impl here to avoid module cycle
return $ genericMakeAbsolute (asAbsDir cwdString) p
prop_makeAbsoluteFromDir_endSame :: AbsDir -> RelFile -> Property
prop_makeAbsoluteFromDir_endSame base p =
property $ show p `isSuffixOf` show (makeAbsolute base p)
prop_makeAbsoluteFromDir_startSame :: AbsDir -> RelFile -> Property
prop_makeAbsoluteFromDir_startSame base p =
property $ show base `isPrefixOf` show (makeAbsolute base p)
-- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir -> AbsFile -> Property
-- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p)
------------------------------------------------------------------------
-- NYI - Not Yet Implemented
{-
splitSearchPath :: String -> [String]
getSearchPath :: IO [String]
splitDrive :: String -> (String, String)
joinDrive :: String -> String -> String
takeDrive :: String -> String
hasDrive :: String -> Bool
dropDrive :: String -> String
isDrive :: String -> Bool
isValid :: String -> Bool
makeValid :: String -> String
-}
------------------------------------------------------------------------
-- Path Predicates
-- | Test whether a @'Path' ar fd@ is absolute.
--
-- >> Posix.isAbsolute (Posix.asAbsFile "fred")
-- >> Posix.isAbsolute (Posix.asAbsFile "/fred")
-- >> Windows.isAbsolute (Windows.asAbsFile "\\fred")
-- >> Windows.isAbsolute (Windows.asAbsFile "c:\\fred")
isAbsolute :: AbsRelClass ar => Path ar fd -> Bool
isAbsolute = absRel (const True) (const False)
-- | Test whether the 'String' would correspond to an absolute path
-- if interpreted as a 'Path'.
isAbsoluteString :: String -> Bool
isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators'
isAbsoluteString (x:xs) =
isPathSeparator x -- Absolute if first char is a path separator
||
isWindows && isAlpha x && isPrefixOf ":" xs
-- | Invariant - this should return True iff arg is of type @'Path' Rel _@
--
-- > isRelative = not . isAbsolute
-- >> Posix.isRelative (Posix.asRelFile "fred")
-- >> Posix.isRelative (Posix.asRelFile "/fred")
-- >> Windows.isRelative (Windows.asRelFile "fred")
isRelative :: AbsRelClass ar => Path ar fd -> Bool
isRelative = not . isAbsolute
-- | Test whether the 'String' would correspond to a relative path
-- if interpreted as a 'Path'.
--
-- > isRelativeString = not . isAbsoluteString
isRelativeString :: String -> Bool
isRelativeString = not . isAbsoluteString
-- | Does the given filename have an extension?
--
-- >> null (Posix.takeExtension x) == not (Posix.hasAnExtension x)
hasAnExtension :: FilePath ar -> Bool
hasAnExtension = not . null . snd . splitExtension
-- | Does the given filename have the given extension?
--
-- >> Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.hs")
-- >> Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.bak.hs")
-- >> not $ Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.hs.bak")
hasExtension :: String -> FilePath ar -> Bool
hasExtension ext = (==ext) . snd . splitExtension
------------------------------------------------------------------------
-- Separators
-- | This is largely for 'System.FilePath' compatability
addTrailingPathSeparator :: String -> String
addTrailingPathSeparator = (++[pathSeparator])
-- | This is largely for 'System.FilePath' compatability
dropTrailingPathSeparator :: String -> String
dropTrailingPathSeparator = init
-- | File extension character
--
-- >> Posix.extSeparator == '.'
extSeparator :: Char
extSeparator = '.'
-- | This is largely for 'System.FilePath' compatability
hasTrailingPathSeparator :: String -> Bool
hasTrailingPathSeparator = isPathSeparator . last
-- | The character that separates directories. In the case where more than
-- one character is possible, 'pathSeparator' is the \'ideal\' one.
--
-- >> Posix.isPathSeparator Posix.pathSeparator
pathSeparator :: Char
pathSeparator | isWindows = '\\'
| otherwise = '/'
-- | The list of all possible separators.
--
-- >> Posix.pathSeparator `elem` Posix.pathSeparators
pathSeparators :: [Char]
pathSeparators = return pathSeparator
-- | The character that is used to separate the entries in the $PATH environment variable.
--
searchPathSeparator :: Char
searchPathSeparator = ':'
-- | Is the character an extension character?
--
-- >> Posix.isExtSeparator a == (a == Posix.extSeparator)
isExtSeparator :: Char -> Bool
isExtSeparator = (== extSeparator)
-- | Rather than using @(== 'pathSeparator')@, use this. Test if something
-- is a path separator.
--
-- >> Posix.isPathSeparator a == (a `elem` Posix.pathSeparators)
isPathSeparator :: Char -> Bool
isPathSeparator = flip elem pathSeparators
-- | Is the character a file separator?
--
-- >> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator)
isSearchPathSeparator :: Char -> Bool
isSearchPathSeparator = (== searchPathSeparator)
------------------------------------------------------------------------
-- Generic Manipulation Functions
-- These functions support manipulation of extensions on directories
-- as well as files. They have looser types than the corresponding
-- 'Basic Manipulation Functions', but it is expected that the basic
-- functions will be used more frequently as they provide more checks.
-- | This is a more flexible variant of 'addExtension' / '<.>' which can
-- work with files or directories
--
-- >> Posix.genericAddExtension "/" "x" == Posix.asAbsDir "/.x"
-- >> Posix.genericAddExtension "/a" "x" == Posix.asAbsDir "/a.x"
-- >> Posix.genericAddExtension "" "x" == Posix.asRelFile ".x"
-- >> Posix.genericAddExtension "" "" == Posix.asRelFile ""
genericAddExtension :: (FileDirClass fd) => Path ar fd -> String -> Path ar fd
genericAddExtension p "" = p
genericAddExtension path ext =
runAddExtension
(switchFileDir
(AddExtension $
\(Path ar pcs (File pc)) ->
Path ar pcs $ File $ addExtensionPC pc ext)
(AddExtension $
\(Path ar pcs0 Dir) ->
let pcs = if null pcs0 then [PathComponent ""] else pcs0
in Path ar (mapLast (flip addExtensionPC ext) pcs) Dir))
path
newtype
AddExtension ar fd =
AddExtension {runAddExtension :: Path ar fd -> Path ar fd}
genericDropExtension :: (FileDirClass fd) => Path ar fd -> Path ar fd
genericDropExtension = fst . genericSplitExtension
genericDropExtensions :: (FileDirClass fd) => Path ar fd -> Path ar fd
genericDropExtensions = fst . genericSplitExtensions
genericSplitExtension ::
(FileDirClass fd) => Path ar fd -> (Path ar fd, String)
genericSplitExtension =
runSplitExtension $
switchFileDir
(SplitExtension $
\(Path ar pcs (File pc)) ->
first (Path ar pcs . File) $ splitExtensionPC pc)
(SplitExtension $
\(Path ar pcs Dir) ->
first (flip (Path ar) Dir) $
mapLastPair
(error "genericSplitExtension: empty path")
splitExtensionPC pcs)
genericSplitExtensions ::
(FileDirClass fd) => Path ar fd -> (Path ar fd, String)
genericSplitExtensions =
runSplitExtension $
switchFileDir
(SplitExtension $
\(Path ar pcs (File pc)) ->
first (Path ar pcs . File) $ splitExtensionsPC pc)
(SplitExtension $
\(Path ar pcs Dir) ->
first (flip (Path ar) Dir) $
mapLastPair
(error "genericSplitExtensions: empty path")
splitExtensionsPC pcs)
genericTakeExtension :: (FileDirClass fd) => Path ar fd -> String
genericTakeExtension = snd . genericSplitExtension
genericTakeExtensions :: (FileDirClass fd) => Path ar fd -> String
genericTakeExtensions = snd . genericSplitExtension
newtype
SplitExtension ar fd =
SplitExtension {runSplitExtension :: Path ar fd -> (Path ar fd, String)}
-- move to utility-ht
mapLast :: (a -> a) -> [a] -> [a]
mapLast f xs = zipWith id (drop 1 $ map (const id) xs ++ [f]) xs
mapLastPair :: b -> (a -> (a,b)) -> [a] -> ([a], b)
mapLastPair b0 f xs =
case reverse xs of
[] -> (xs, b0)
y:ys ->
let (a, b) = f y
in (reverse ys ++ [a], b)
addExtensionPC :: PathComponent -> String -> PathComponent
addExtensionPC p "" = p
addExtensionPC (PathComponent pc) ext =
PathComponent $ pc ++
if [extSeparator] `isPrefixOf` ext
then ext
else extSeparator : ext
splitExtensionPC :: PathComponent -> (PathComponent, String)
splitExtensionPC (PathComponent s) = (PathComponent s1, s2)
where (s1,s2) = fixTrailingDot $ rbreak isExtSeparator s
fixTrailingDot ("",r2) = (r2,"")
fixTrailingDot (r1,r2) | [extSeparator] `isSuffixOf` r1 = (init r1, extSeparator:r2)
| otherwise = (r1,r2)
swap (x,y) = (y,x)
rbreak q = (reverse *** reverse) . swap . break q . reverse
splitExtensionsPC :: PathComponent -> (PathComponent, String)
splitExtensionsPC (PathComponent s) =
first PathComponent $ break isExtSeparator s
------------------------------------------------------------------------
-- QuickCheck
_testall :: IO ()
_testall = do
putStrLn "Running QuickCheck tests..."
quickCheck prop_asPath_getPathString
quickCheck prop_mkPathFromComponents_pathComponents
quickCheck prop_makeAbsoluteFromDir_endSame
quickCheck prop_makeAbsoluteFromDir_startSame
quickCheck prop_split_combine
quickCheck prop_takeFileName_end
quickCheck prop_split_combineExt
putStrLn "Tests completed."
-- test :: Testable a => a -> IO ()
-- test = quickCheck
qcFileComponent :: Gen PathComponent
qcFileComponent = PathComponent <$> frequency [
(1, return "someFile"),
(1, return "fileWith.ext"),
(1, return "file.with.multiple.exts"),
(1, return "file with spcs")
]
qcDirComponent :: Gen PathComponent
qcDirComponent = PathComponent <$> frequency [
(1, return "someDir"),
(1, return "aDir"),
(1, return "aFolder"),
(1, return "a folder"),
(1, return "directory")
]
instance Arbitrary PathComponent where
arbitrary = oneof [qcFileComponent, qcDirComponent]
qcGenPath ::
(AbsRelClass ar, FileDirClass fd) =>
Gen PathComponent -> Gen (Path ar fd)
qcGenPath qcLastComponent = do
ar <- switchAbsRel (fmap (Abs . (:":")) $ QC.choose ('a', 'z')) (return Rel)
pcs <- QC.listOf qcDirComponent
pc <- qcLastComponent
return $ mkPathFromComponents ar (pcs ++ [pc])
qcFilePath :: (AbsRelClass ar) => Gen (FilePath ar)
qcFilePath = qcGenPath qcFileComponent
qcDirPath :: (AbsRelClass ar) => Gen (DirPath ar)
qcDirPath = qcGenPath qcDirComponent
qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd)
qcPath =
getFunctorPath $
switchFileDir (FunctorPath qcFilePath) (FunctorPath qcDirPath)
instance (AbsRelClass ar, FileDirClass fd) => Arbitrary (Path ar fd) where
arbitrary = qcPath