pathtype 0.5 → 0.5.1
raw patch · 2 files changed
+957/−2 lines, 2 files
Files
- System/Path/Internal.hs +955/−0
- pathtype.cabal +2/−2
+ System/Path/Internal.hs view
@@ -0,0 +1,955 @@+-- LANGUAGE pragmas need to go in System.Path.[Windows|Posix]++-- | This module provides type-safe access to filepath manipulations.+--+-- It is designed to be imported instead of "System.FilePath".+-- (It is intended to provide versions of functions from that+-- module which have equivalent functionality but are more+-- typesafe). "System.Path.Directory" is a companion module+-- providing a type-safe alternative to "System.Directory".+--+-- The heart of this module is the @'Path' ar fd@ abstract type which+-- represents file and directory paths. The idea is that there are+-- two phantom type parameters - the first should be 'Abs' or 'Rel',+-- and the second 'File' or 'Dir'. A number of type synonyms are+-- provided for common types:+--+-- > 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+--+-- The type of the 'combine' (aka '</>') function gives the idea:+--+-- > (</>) :: DirPath ar -> RelPath fd -> Path ar fd+--+-- Together this enables us to give more meaningful types to+-- a lot of the functions, and (hopefully) catch a bunch more+-- errors at compile time.+--+-- Overloaded string literals are supported, so with the @OverloadedStrings@+-- extension enabled, you can:+--+-- > f :: FilePath ar+-- > f = "tmp" </> "someFile" <.> "ext"+--+-- If you don't want to use @OverloadedStrings@, you can use the construction fns:+--+-- > f :: FilePath ar+-- > f = asDirPath "tmp" </> asFilePath "someFile" <.> "ext"+--+-- or...+--+-- > f :: FilePath ar+-- > f = asPath "tmp" </> asPath "someFile" <.> "ext"+--+-- or just...+--+-- > f :: FilePath ar+-- > f = asPath "tmp/someFile.ext"+--+-- One point to note is that whether one of these is interpreted as+-- an absolute or a relative path depends on the type at which it is+-- used:+--+-- > *System.Path> f :: AbsFile+-- > /tmp/someFile.ext+-- > *System.Path> f :: RelFile+-- > tmp/someFile.ext+--+-- You will typically want to import as follows:+--+-- > import Prelude hiding (FilePath)+-- > import System.Path+-- > import System.Path.Directory+-- > import System.Path.IO+--+-- The basic API (and properties satisfied) are heavily influenced+-- by Neil Mitchell's "System.FilePath" module.+--+--+-- Ben Moseley - (c) 2009-2010+--+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 Prelude hiding (FilePath)++import Control.Applicative+import Control.Arrow+import Data.List+import GHC.Exts( IsString(..) )+import qualified System.Directory as SD++import System.IO hiding (FilePath)+import System.IO.Error+import Text.Printf+import Test.QuickCheck+++------------------------------------------------------------------------+-- Types++data Abs+data Rel+data File+data Dir++-- | This is the main filepath abstract datatype+data Path ar fd = PathRoot -- ^ Invariant - this should always have type :: DirPath ar+ | FileDir !(DirPath ar) !PathComponent -- The fact that we recurse binding fd to Dir+ -- makes this a "nested datatype"+ deriving (Eq, Ord)++-- Possible GADT version...+--+-- data Path ar fd where+-- AbsRoot :: Path Abs Dir+-- RelRoot :: Path Rel Dir+-- File :: Path ar Dir -> PathComponent -> Path ar File+-- Dir :: Path ar Dir -> PathComponent -> Path ar Dir+--+-- ... doesn't presently seem to add much value over non-GADT.++newtype PathComponent = PathComponent { unPathComponent :: String } deriving (Eq,Ord)+instance Show PathComponent where showsPrec _ (PathComponent s) = showString s++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++-- 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.+--+-- >> pathMap (map toLower) "/tmp/Reports/SpreadSheets" == "/tmp/reports/spreadsheets"+pathMap :: (String -> String) -> Path ar fd -> Path ar fd+pathMap f PathRoot = PathRoot+pathMap f (FileDir d pc) = FileDir (pathMap f d) (pcMap f pc)++-- Private fn+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+ absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a++instance AbsRelClass Abs where absRel f g = f+instance AbsRelClass Rel where absRel 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+ fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a++instance FileDirClass File where fileDir f g = f+instance FileDirClass Dir where fileDir 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++instance AbsRelClass ar => Show (Path ar fd) where+ showsPrec d x@PathRoot = absRel (const $ showString pathSeparators)+ (const $ showString ".") x+ -- we need the clause below so that we don't duplicate the pathSeparator after an abs+ -- root and we don't want to display a "./" prefix on relative paths+ showsPrec d x@(FileDir p@PathRoot pc) = absRel (const $ showString pathSeparators)+ (const id)+ p .+ showsPrec d pc+ showsPrec d x@(FileDir p pc) = showsPrec d p . showString pathSeparators .+ showsPrec d pc++-- This instance consumes all remaining input. Would it be better to, say,+-- give up at newlines or some set of non-allowable chars?+instance AbsRelClass ar => Read (Path ar fd) where+ readsPrec _ s = [(asPath s,"")]++-- | Convert the 'Path' into a plain 'String'. This is simply an+-- alias for 'show'.+getPathString :: AbsRelClass ar => Path ar fd -> String+getPathString = show++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 = PathRoot++currentDir :: RelDir+currentDir = PathRoot+++------------------------------------------------------------------------+-- Unchecked Construction Functions+-- NB - these construction functions are pure and do no checking!!++-- | Use a 'String' as a 'Path' whose type is determined+-- by its context.+--+-- >> asPath "/tmp" == "/tmp"+-- >> asPath "file.txt" == "file.txt"+-- >> isAbsolute (asPath "/tmp" :: AbsDir) == True+-- >> isAbsolute (asPath "/tmp" :: RelDir) == False+-- >> getPathString (asPath "/tmp" :: AbsDir) == "/tmp"+-- >> getPathString (asPath "/tmp" :: RelDir) == "tmp"+asPath :: String -> Path ar fd+asPath = mkPathFromComponents . mkPathComponents++-- | Use a 'String' as a 'RelFile'. No checking is done.+--+-- >> getPathString (asRelFile "file.txt") == "file.txt"+-- >> getPathString (asRelFile "/file.txt") == "file.txt"+-- >> getPathString (asRelFile "tmp") == "tmp"+-- >> getPathString (asRelFile "/tmp") == "tmp"+asRelFile :: String -> RelFile+asRelFile = asPath++-- | Use a 'String' as a 'RelDir'. No checking is done.+--+-- >> getPathString (asRelDir "file.txt") == "file.txt"+-- >> getPathString (asRelDir "/file.txt") == "file.txt"+-- >> getPathString (asRelDir "tmp") == "tmp"+-- >> getPathString (asRelDir "/tmp") == "tmp"+asRelDir :: String -> RelDir+asRelDir = asPath++-- | Use a 'String' as an 'AbsFile'. No checking is done.+--+-- >> getPathString (asAbsFile "file.txt") == "/file.txt"+-- >> getPathString (asAbsFile "/file.txt") == "/file.txt"+-- >> getPathString (asAbsFile "tmp") == "/tmp"+-- >> getPathString (asAbsFile "/tmp") == "/tmp"+asAbsFile :: String -> AbsFile+asAbsFile = asPath++-- | Use a 'String' as an 'AbsDir'. No checking is done.+--+-- >> getPathString (asAbsDir "file.txt") == "/file.txt"+-- >> getPathString (asAbsDir "/file.txt") == "/file.txt"+-- >> getPathString (asAbsDir "tmp") == "/tmp"+-- >> getPathString (asAbsDir "/tmp") == "/tmp"+asAbsDir :: String -> AbsDir+asAbsDir = asPath++-- | Use a 'String' as a 'RelPath fd'. No checking is done.+asRelPath :: String -> RelPath fd+asRelPath = asPath++-- | Use a 'String' as an 'AbsPath fd'. No checking is done.+asAbsPath :: String -> AbsPath fd+asAbsPath = asPath++-- | Use a 'String' as a 'FilePath ar'. No checking is done.+asFilePath :: String -> FilePath ar+asFilePath = asPath++-- | Use a 'String' as a 'DirPath ar'. No checking is done.+asDirPath :: String -> DirPath ar+asDirPath = asPath++-- | Allow use of OverloadedStrings if desired+instance IsString (Path ar fd) where fromString = asPath++------------------------------------------------------------------------+-- Checked Construction Functions++-- | Examines the supplied string and constructs an absolute or+-- relative path as appropriate.+--+-- >> either id (const "fred") (mkPathAbsOrRel "/tmp") == "/tmp"+-- >> either id (const "fred") (mkPathAbsOrRel "tmp") == "fred"+mkPathAbsOrRel :: String -> Either (AbsPath fd) (RelPath fd)+mkPathAbsOrRel s | isAbsoluteString s = Left (asPath s)+ | otherwise = Right (asPath 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 <- doesFileExist `onPathString` s+ isdir <- doesDirectoryExist `onPathString` 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 - internal inconsistency - file&dir"+ where+ -- We duplicate these from System.Path.Directory to avoid a module cycle+ doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool+ doesFileExist = SD.doesFileExist . getPathString+ doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool+ doesDirectoryExist = SD.doesDirectoryExist . getPathString++-- | Convert a 'String' into an 'AbsPath' by interpreting it as+-- relative to the supplied directory if necessary.+--+-- >> mkAbsPath "/tmp" "foo.txt" == "/tmp/foo.txt"+-- >> mkAbsPath "/tmp" "/etc/foo.txt" == "/etc/foo.txt"+mkAbsPath :: 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 :: String -> IO (AbsPath fd)+mkAbsPathFromCwd = (return ||| makeAbsoluteFromCwd) . mkPathAbsOrRel+++-- | Lift a function which can operate on either Abs or Rel Path to one which+-- operates on Strings.+-- At present this fn is the only reason we have Rank-2 types, it's also not+-- doing anything useful at present. We /may/ want to expose it later though+-- so leave it for now...+onPathString :: (forall ar . AbsRelClass ar => Path ar fd -> a) -> String -> a+onPathString f = (f ||| f) . mkPathAbsOrRel+++------------------------------------------------------------------------+-- Internal Functions for PathComponent manipulation++mkPathFromComponents :: [PathComponent] -> Path ar fd+mkPathFromComponents [] = PathRoot+mkPathFromComponents pcs | (p:ps) <- reverse pcs = FileDir (foldr (flip FileDir) PathRoot ps) p++mkPathComponents :: String -> [PathComponent]+mkPathComponents xs =+ case break isPathSeparator (dropWhile isPathSeparator xs) of+ ("","") -> []+ (s,rest) -> PathComponent s : mkPathComponents rest++pathComponents :: Path ar fd -> [PathComponent]+pathComponents PathRoot = []+pathComponents (FileDir p pc) = pathComponents p ++ [pc]++prop_mkPathFromComponents_pathComponents :: AbsFile -> Property+prop_mkPathFromComponents_pathComponents p = property $+ mkPathFromComponents (pathComponents p) == p++++------------------------------------------------------------------------+-- Basic Manipulation Functions++-- | Join an (absolute or relative) directory path with a relative+-- (file or directory) path to form a new path.+(</>) :: DirPath ar -> RelPath fd -> Path ar fd+PathRoot </> PathRoot = PathRoot+(FileDir dp dpc) </> PathRoot = FileDir dp dpc+d </> (FileDir p pc) = FileDir (d </> p) pc++-- | 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+(<.>) = genericAddExtension++-- | Add an extension, even if there is already one there.+-- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.+--+-- >> addExtension "file.txt" "bib" == "file.txt.bib"+-- >> addExtension "file." ".bib" == "file..bib"+-- >> addExtension "file" ".bib" == "file.bib"+-- >> takeFileName (addExtension "" "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.+--+-- >> dropExtension x == fst (splitExtension x)+dropExtension :: FilePath ar -> FilePath ar+dropExtension = fst . splitExtension++-- | Drop all extensions+--+-- >> not $ hasAnExtension (dropExtensions x)+dropExtensions :: FilePath ar -> FilePath ar+dropExtensions = fst . splitExtensions++dropFileName :: Path ar fd -> DirPath ar+dropFileName = fst . splitFileName+++-- | Set the extension of a file, overwriting one if already present.+--+-- >> replaceExtension "file.txt" ".bob" == "file.bob"+-- >> replaceExtension "file.txt" "bob" == "file.bob"+-- >> replaceExtension "file" ".bob" == "file.bob"+-- >> replaceExtension "file.txt" "" == "file"+-- >> replaceExtension "file.fred.bob" "txt" == "file.fred.txt"+replaceExtension :: FilePath ar -> String -> FilePath ar+replaceExtension p ext = dropExtension p <.> ext++replaceBaseName :: Path ar fd -> String -> Path ar fd+replaceBaseName p bn = takeDirectory p </> (asPath bn `genericAddExtension` genericTakeExtension p)++replaceDirectory :: Path ar1 fd -> DirPath ar2 -> Path ar2 fd+replaceDirectory p d = d </> takeFileName p++replaceFileName :: Path ar fd -> String -> Path ar fd+replaceFileName p fn = takeDirectory p </> asPath fn+++-- | Split on the extension. 'addExtension' is the inverse.+--+-- >> uncurry (<.>) (splitExtension x) == x+-- >> uncurry addExtension (splitExtension x) == x+-- >> splitExtension "file.txt" == ("file",".txt")+-- >> splitExtension "file" == ("file","")+-- >> splitExtension "file/file.txt" == ("file/file",".txt")+-- >> splitExtension "file.txt/boris" == ("file.txt/boris","")+-- >> splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")+-- >> splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")+splitExtension :: FilePath ar -> (FilePath ar, String)+splitExtension = genericSplitExtension++-- | Split on all extensions+--+-- >> splitExtensions "file.tar.gz" == ("file",".tar.gz")+splitExtensions :: FilePath ar -> (FilePath ar, String)+splitExtensions = genericSplitExtensions++prop_splitCombine :: AbsFile -> Property+prop_splitCombine p = property $ p == p2 <.> ext+ where+ (p2, ext) = splitExtension p++splitFileName :: Path ar fd -> (DirPath ar, RelPath fd)+splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc])++prop_split_combine :: AbsFile -> Property+prop_split_combine p = property $ uncurry combine (splitFileName p) == p+++-- | Get the basename of a file+--+-- >> takeBaseName "/tmp/somedir/myfile.txt" == "myfile"+-- >> takeBaseName "./myfile.txt" == "myfile"+-- >> takeBaseName "myfile.txt" == "myfile"+takeBaseName :: Path ar fd -> RelPath fd+takeBaseName = takeFileName . genericDropExtension++takeDirectory :: Path ar fd -> DirPath ar+takeDirectory = fst . splitFileName++-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.+--+-- >> takeExtension x == snd (splitExtension x)+-- >> takeExtension (addExtension x "ext") == ".ext"+-- >> takeExtension (replaceExtension x "ext") == ".ext"+takeExtension :: FilePath ar -> String+takeExtension = snd . splitExtension++-- | Get all extensions+--+-- >> takeExtensions "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)+--+-- >> takeFileName "/tmp/somedir/myfile.txt" == "myfile.txt"+-- >> takeFileName "./myfile.txt" == "myfile.txt"+-- >> takeFileName "myfile.txt" == "myfile.txt"+takeFileName :: Path ar fd -> RelPath fd+takeFileName PathRoot = PathRoot -- becomes a relative root+takeFileName (FileDir _ pc) = FileDir PathRoot pc++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.+--+-- >> equalFilePath "/tmp/" "/tmp" == True+-- >> equalFilePath "/tmp" "tmp" == False+equalFilePath :: String -> String -> Bool+equalFilePath s1 s2 | a1 <- isAbsoluteString s1,+ a2 <- isAbsoluteString s2 = a1 == a2 && asPath s1 == asPath s2++-- | Constructs a 'Path' from a list of components.+--+-- >> joinPath ["/tmp","someDir","file.txt"] == "/tmp/someDir/file.txt"+-- >> (joinPath ["/tmp","someDir","file.txt"] :: RelFile) == "tmp/someDir/file.txt"+joinPath :: [String] -> Path ar fd+joinPath = asPath . intercalate [pathSeparator]++-- | Currently just transforms:+--+-- >> normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file"+normalise :: Path ar fd -> Path ar fd+normalise = mkPathFromComponents . filter (/=(PathComponent ".")) . pathComponents++-- | Deconstructs a path into its components.+--+-- >> splitPath ("/tmp/someDir/myfile.txt" :: AbsDir) == (["tmp","someDir","myfile.txt"],Nothing)+-- >> splitPath ("/tmp/someDir/myfile.txt" :: AbsFile) == (["tmp","someDir"],Just "myfile.txt")+-- >> splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"],Just "myfile.txt")+splitPath :: FileDirClass fd => Path ar fd -> ([RelDir],Maybe RelFile)+splitPath PathRoot = ([],Nothing)+splitPath p@(FileDir d pc) =+ fileDir (\_->(map (FileDir PathRoot) . pathComponents $ d, Just (FileDir PathRoot pc)))+ (\_->(map (FileDir PathRoot) . pathComponents $ p, Nothing))+ p++-- | 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'.+--+-- >> makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == "anotherdir/file.txt"+makeRelative :: AbsDir -> AbsPath fd -> RelPath fd+makeRelative relTo orig = maybe err mkPathFromComponents $ stripPrefix relToPC origPC+ where+ err = error $ printf "System.Path can't make %s relative to %s" (show origPC) (show relToPC)+ relToPC = pathComponents relTo+ origPC = pathComponents orig++-- | Joins an absolute directory with a relative path to construct a+-- new absolute path.+--+-- >> makeAbsolute "/tmp" "file.txt" == "/tmp/file.txt"+-- >> makeAbsolute "/tmp" "adir/file.txt" == "/tmp/adir/file.txt"+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).+--+-- >> genericMakeAbsolute "/tmp" (asRelFile "file.txt") == "/tmp/file.txt"+-- >> genericMakeAbsolute "/tmp" (asRelFile "adir/file.txt") == "/tmp/adir/file.txt"+-- >> genericMakeAbsolute "/tmp" (asAbsFile "adir/file.txt") == "/adir/file.txt"+-- >> genericMakeAbsolute "/tmp" (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.+--+-- >> isAbsolute (asAbsFile "fred") == True+-- >> isAbsolute (asRelFile "fred") == False+-- >> isAbsolute (asAbsFile "/fred") == True+-- >> isAbsolute (asRelFile "/fred") == False+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:_) = any (== x) pathSeparators -- Absolute if first char is a path separator++-- | Invariant - this should return True iff arg is of type @'Path' Rel _@+--+-- > isRelative = not . isAbsolute+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 (takeExtension x) == not (hasAnExtension x)+hasAnExtension :: FilePath ar -> Bool+hasAnExtension = not . null . snd . splitExtension++-- | Does the given filename have the given extension?+--+-- >> hasExtension ".hs" "MyCode.hs" == True+-- >> hasExtension ".hs" "MyCode.hs.bak" == False+-- >> hasExtension ".hs" "MyCode.bak.hs" == True+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+--+-- >> 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.+--+-- >> isPathSeparator pathSeparator+pathSeparator :: Char+pathSeparator | isWindows = '\\'+ | otherwise = '/'++-- | The list of all possible separators.+--+-- >> pathSeparator `elem` 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?+--+-- >> isExtSeparator a == (a == extSeparator)+isExtSeparator :: Char -> Bool+isExtSeparator = (== extSeparator)++-- | Rather than using @(== 'pathSeparator')@, use this. Test if something+-- is a path separator.+--+-- >> isPathSeparator a == (a `elem` pathSeparators)+isPathSeparator :: Char -> Bool+isPathSeparator = (== pathSeparator)++-- | Is the character a file separator?+--+-- >> isSearchPathSeparator a == (a == 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+--+-- >> genericAddExtension "/" "x" == "/.x"+genericAddExtension :: Path ar fd -> String -> Path ar fd+genericAddExtension p "" = p+genericAddExtension (FileDir p (PathComponent pc)) ext = FileDir p (PathComponent (pc ++ suffix))+ where suffix | "." `isPrefixOf` ext = ext+ | otherwise = "." ++ ext+genericAddExtension PathRoot ext = FileDir PathRoot (PathComponent suffix)+ where suffix | "." `isPrefixOf` ext = ext+ | otherwise = "." ++ ext++genericDropExtension :: Path ar fd -> Path ar fd+genericDropExtension = fst . genericSplitExtension++genericDropExtensions :: Path ar fd -> Path ar fd+genericDropExtensions = fst . genericSplitExtensions++genericSplitExtension :: Path ar fd -> (Path ar fd, String)+genericSplitExtension (FileDir p (PathComponent s)) = (FileDir p (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 p = (reverse *** reverse) . swap . break p . reverse+genericSplitExtension p = (p,"")++genericSplitExtensions :: Path ar fd -> (Path ar fd, String)+genericSplitExtensions (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)+ where (s1,s2) = break isExtSeparator s+genericSplitExtensions p = (p,"")++genericTakeExtension :: Path ar fd -> String+genericTakeExtension = snd . genericSplitExtension++genericTakeExtensions :: Path ar fd -> String+genericTakeExtensions = snd . genericSplitExtension+++------------------------------------------------------------------------+-- QuickCheck++testall = do+ putStrLn "Running QuickCheck tests..."+ quickCheck prop_mkPathFromComponents_pathComponents+ quickCheck prop_makeAbsoluteFromDir_endSame+ quickCheck prop_makeAbsoluteFromDir_startSame+ quickCheck prop_split_combine+ quickCheck prop_takeFileName_end+ quickCheck prop_splitCombine+ 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")+ ]++qcFilePath :: Gen (FilePath ar)+qcFilePath = do+ (NonNegative numDirs) <- arbitrarySizedIntegral+ pcs <- vectorOf numDirs qcDirComponent+ pc <- qcFileComponent+ return $ mkPathFromComponents (pcs ++ [pc])+++qcDirPath :: Gen (DirPath ar)+qcDirPath = do+ (NonNegative numDirs) <- arbitrarySizedIntegral+ pcs <- vectorOf numDirs qcDirComponent+ pc <- qcDirComponent+ return $ mkPathFromComponents (pcs ++ [pc])++-- qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd)+-- qcPath = absRel++instance Arbitrary PathComponent where+ arbitrary = oneof [qcFileComponent, qcDirComponent]++instance Arbitrary (Path ar File) where+ arbitrary = qcFilePath++instance Arbitrary (Path ar Dir) where+ arbitrary = qcDirPath++
pathtype.cabal view
@@ -1,5 +1,5 @@ Name: pathtype-Version: 0.5+Version: 0.5.1 Synopsis: Type-safe replacement for System.FilePath etc Description: This package provides type-safe access to filepath manipulations. .@@ -83,7 +83,7 @@ HomePage: http://code.haskell.org/pathtype Build-Type: Simple Cabal-Version: >=1.6-Extra-Source-Files: Test.hs, TestTemplate.hs+Extra-Source-Files: Test.hs, TestTemplate.hs, System/Path/Internal.hs source-repository head type: darcs