packages feed

pathtype 0.0.1 → 0.0.2

raw patch · 6 files changed

+884/−279 lines, 6 filesdep +old-timedep ~base

Dependencies added: old-time

Dependency ranges changed: base

Files

System/Path.hs view
@@ -1,24 +1,28 @@-{-# LANGUAGE EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types #-}+{-# LANGUAGE EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types, OverloadedStrings #-}  -- | This module provides type-safe access to filepath manipulations. -----   It is designed to be imported instead of 'System.FilePath' and---   'System.Directory'. (It is intended to provide versions of---   functions from those modules which have equivalent functionality---   but are more typesafe).+--   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+--   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 RelPath fd = Path Rel fd---   > type DirPath ar = Path ar Dir+--   > 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: --@@ -28,15 +32,49 @@ --   a lot of the functions, and (hopefully) catch a bunch more --   errors at compile time. -----   The basic API (and properties satisfied) are heavily influenced---   by Neil Mitchell's 'System.FilePath' module.+--   Overloaded string literals are supported, so with the @OverloadedStrings@+--   extension enabled, you can: --+--   > f :: FilePath ar+--   > f = "tmp" </> "someFile" <.> "ext" -----   WARNING --- THE API IS NOT YET STABLE --- WARNING+--   If you don't want to use @OverloadedStrings@, you can use the construction fns: --+--   > f :: FilePath ar+--   > f = asDirPath "tmp" </> asFilePath "someFile" <.> "ext" ----- Ben Moseley - (c) Jan 2009+--   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+-- module System.Path (   -- * The main filepath (& dirpath) abstract type@@ -58,6 +96,10 @@   FilePath,   DirPath, +  -- * Classes+  AbsRelClass(..),+  FileDirClass(..),+   -- * Path to String conversion   getPathString, @@ -66,19 +108,21 @@   currentDir,    -- * Unchecked Construction Functions-  mkPath,-  mkRelFile,-  mkRelDir,-  mkAbsFile,-  mkAbsDir,-  mkRelPath,-  mkAbsPath,-  mkFile,-  mkDir,+  asPath,+  asRelFile,+  asRelDir,+  asAbsFile,+  asAbsDir,+  asRelPath,+  asAbsPath,+  asFilePath,+  asDirPath,    -- * Checked Construction Functions   mkPathAbsOrRel,   mkPathFileOrDir,+  mkAbsPath,+  mkAbsPathFromCwd,    -- * Basic Manipulation Functions   (</>),@@ -105,15 +149,20 @@   equalFilePath,   joinPath,   normalise,-  splitDirectories,   splitPath,   makeRelative,+  makeAbsolute,+  makeAbsoluteFromCwd,+  genericMakeAbsolute,+  genericMakeAbsoluteFromCwd,+  pathMap,    -- * Path Predicates   isAbsolute,   isAbsoluteString,   isRelative,   isRelativeString,+  hasAnExtension,   hasExtension,    -- * Separators@@ -128,19 +177,14 @@   isPathSeparator,   isSearchPathSeparator, -  -- * Flexible Manipulation Functions-  addFileOrDirExtension,-  dropFileOrDirExtension,-  dropFileOrDirExtensions,-  splitFileOrDirExtension,-  splitFileOrDirExtensions,-  takeFileOrDirExtension,-  takeFileOrDirExtensions,--  -- * System.Directory replacements-  getDirectoryContents,-  absDirectoryContents,-  relDirectoryContents+  -- * Generic Manipulation Functions+  genericAddExtension,+  genericDropExtension,+  genericDropExtensions,+  genericSplitExtension,+  genericSplitExtensions,+  genericTakeExtension,+  genericTakeExtensions )  where@@ -150,6 +194,7 @@ import Control.Applicative import Control.Arrow import Data.List+import GHC.Exts( IsString(..) ) import qualified System.Directory as SD  import System.IO hiding (FilePath)@@ -168,15 +213,13 @@  -- | This is the main filepath abstract datatype data Path ar fd = PathRoot -- ^ Invariant - this should always have type :: DirPath ar-                | FileDir (DirPath ar) PathComponent+                | FileDir !(DirPath ar) !PathComponent -- The fact that we recurse binding fd to Dir+                                                       -- makes this a "nested datatype"                   deriving (Eq, Ord)  newtype PathComponent = PathComponent { unPathComponent :: String } deriving (Eq,Ord) instance Show PathComponent where showsPrec _ (PathComponent s) = showString s -pcMap :: (String -> String) -> PathComponent -> PathComponent-pcMap f (PathComponent s) = PathComponent (f s)- type AbsFile = Path Abs File type RelFile = Path Rel File type AbsDir  = Path Abs Dir@@ -187,26 +230,59 @@ 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 -class AbsRelClass ar where+-- | 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 -class FileDirClass fd where+-- | 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@@ -226,15 +302,15 @@ -- 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 = [(mkPath s,"")]+    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_mkPath_getPathString :: AbsFile -> Property-prop_mkPath_getPathString p = property $ p == mkPath (getPathString p)+prop_asPath_getPathString :: AbsFile -> Property+prop_asPath_getPathString p = property $ p == asPath (getPathString p)   ------------------------------------------------------------------------@@ -251,44 +327,84 @@ -- Unchecked Construction Functions -- NB - these construction functions are pure and do no checking!! --- | Convert a 'String' into a 'Path' whose type is determined+-- | Use a 'String' as a 'Path' whose type is determined --   by its context.-mkPath :: String -> Path ar fd-mkPath = mkPathFromComponents . mkPathComponents+--+-- >> 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 -mkRelFile :: String -> RelFile-mkRelFile = mkPath+-- | 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 -mkRelDir :: String -> RelDir-mkRelDir = mkPath+-- | 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 -mkAbsFile :: String -> AbsFile-mkAbsFile = mkPath+-- | 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 -mkAbsDir :: String -> AbsDir-mkAbsDir = mkPath+-- | 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 -mkRelPath :: String -> RelPath fd-mkRelPath = mkPath+-- | Use a 'String' as a 'RelPath fd'. No checking is done.+asRelPath :: String -> RelPath fd+asRelPath = asPath -mkAbsPath :: String -> AbsPath fd-mkAbsPath = mkPath+-- | Use a 'String' as an 'AbsPath fd'. No checking is done.+asAbsPath :: String -> AbsPath fd+asAbsPath = asPath -mkFile :: String -> FilePath ar-mkFile = mkPath+-- | Use a 'String' as a 'FilePath ar'. No checking is done.+asFilePath :: String -> FilePath ar+asFilePath = asPath -mkDir :: String -> DirPath ar-mkDir = mkPath+-- | 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 (mkPath s)-                 | otherwise = Right (mkPath s)+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@@ -299,29 +415,37 @@   isdir <- doesDirectoryExist `onPathString` s   case (isfile, isdir) of     (False, False) -> return Nothing-    (True,  False) -> return $ Just $ Left $ mkPath s-    (False, True ) -> return $ Just $ Right $ mkPath s+    (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 --- | Lift a function which can operate on either Abs or Rel Path to one which---   operates on Strings-onPathString :: (forall ar . AbsRelClass ar => Path ar fd -> a) -> String -> a-onPathString f = (f ||| f) . mkPathAbsOrRel+-- | 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 -mkAbsFrom :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath fd-mkAbsFrom base p = absRel id (mkAbsFromRel base) p+-- | 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 -mkAbsFromRel :: AbsDir -> RelPath fd -> AbsPath fd-mkAbsFromRel = (</>) -prop_mkAbsFromRel_endSame :: AbsDir -> RelFile -> Property-prop_mkAbsFromRel_endSame base p = property $ show p `isSuffixOf` show (mkAbsFrom base p)--prop_mkAbsFromRel_startSame :: AbsDir -> RelFile -> Property-prop_mkAbsFromRel_startSame base p = property $ show base `isPrefixOf` show (mkAbsFrom base p)---- prop_mkAbsFromRel_startSameAbs :: AbsDir -> AbsFile -> Property--- prop_mkAbsFromRel_startSameAbs base p = property $ show base `isPrefixOf` show (mkAbsFrom base p)+-- | 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   ------------------------------------------------------------------------@@ -363,18 +487,17 @@ --   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:---   'addFileOrDirExtension'.+--   'genericAddExtension'. (<.>) :: FilePath ar -> String -> FilePath ar-(<.>) = addFileOrDirExtension+(<.>) = genericAddExtension  -- | Add an extension, even if there is already one there. --   E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@. ----- >> addExtension (mkFile "file.txt") "bib" == (mkFile "file.txt.bib")--- >> addExtension (mkFile "file.") ".bib" == (mkFile "file..bib")--- >> addExtension (mkFile "file") ".bib" == (mkFile "file.bib")--- >> takeFileName (addExtension (mkFile "") "ext") == mkFile ".ext"--- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"+-- >> 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 = (<.>) @@ -392,7 +515,7 @@  -- | Drop all extensions ----- >> not $ hasExtension (dropExtensions x)+-- >> not $ hasAnExtension (dropExtensions x) dropExtensions :: FilePath ar -> FilePath ar dropExtensions = fst . splitExtensions @@ -402,42 +525,42 @@  -- | Set the extension of a file, overwriting one if already present. ----- >> replaceExtension (mkFile "file.txt") ".bob" == (mkFile "file.bob")--- >> replaceExtension (mkFile "file.txt") "bob" == (mkFile "file.bob")--- >> replaceExtension (mkFile "file") ".bob" == (mkFile "file.bob")--- >> replaceExtension (mkFile "file.txt") "" == (mkFile "file")--- >> replaceExtension (mkFile "file.fred.bob") "txt" == (mkFile "file.fred.txt")+-- >> 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 </> (mkPath bn `addFileOrDirExtension` takeFileOrDirExtension p)+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 </> mkPath fn+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 (mkFile "file.txt") == (mkFile "file",".txt")--- >> splitExtension (mkFile "file") == (mkFile "file","")--- >> splitExtension (mkFile "file/file.txt") == (mkFile "file/file",".txt")--- >> splitExtension (mkFile "file.txt/boris") == (mkFile "file.txt/boris","")--- >> splitExtension (mkFile "file.txt/boris.ext") == (mkFile "file.txt/boris",".ext")--- >> splitExtension (mkFile "file/path.txt.bob.fred") == (mkFile "file/path.txt.bob",".fred")+-- >> 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 = splitFileOrDirExtension+splitExtension = genericSplitExtension  -- | Split on all extensions ----- >> splitExtensions (mkFile "file.tar.gz") == (mkFile "file",".tar.gz")+-- >> splitExtensions "file.tar.gz" == ("file",".tar.gz") splitExtensions :: FilePath ar -> (FilePath ar, String)-splitExtensions = splitFileOrDirExtensions+splitExtensions = genericSplitExtensions  prop_splitCombine :: AbsFile -> Property prop_splitCombine p = property $ p == p2 <.> ext@@ -451,8 +574,13 @@ 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 . dropFileOrDirExtension+takeBaseName = takeFileName . genericDropExtension  takeDirectory :: Path ar fd -> DirPath ar takeDirectory = fst . splitFileName@@ -467,10 +595,15 @@  -- | Get all extensions ----- >> takeExtensions (mkFile "file.tar.gz") == ".tar.gz"+-- >> 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@@ -482,26 +615,44 @@ ------------------------------------------------------------------------ -- 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 = mkPath s1 == mkPath s2+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 = mkPathFromComponents . map PathComponent+joinPath = asPath . intercalate [pathSeparator]  -- | Currently just transforms: ----- >> normalise (mkFile "/tmp/fred/./jim/./file") == mkFile "/tmp/fred/jim/file"+-- >> normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file" normalise :: Path ar fd -> Path ar fd normalise = mkPathFromComponents . filter (/=(PathComponent ".")) . pathComponents -splitDirectories :: Path ar fd -> [String]-splitDirectories PathRoot = []-splitDirectories p = map unPathComponent . init . pathComponents $ p--splitPath :: Path ar fd -> [String]-splitPath = map unPathComponent . 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@@ -509,6 +660,46 @@     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 @@ -529,28 +720,50 @@ ------------------------------------------------------------------------ -- 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 _@+-- | 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 (hasExtension x)-hasExtension :: FilePath ar -> Bool-hasExtension = not . null . snd . splitExtension+-- >> 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 @@ -575,24 +788,18 @@ -- | The character that separates directories. In the case where more than --   one character is possible, 'pathSeparator' is the \'ideal\' one. ----- > Windows: pathSeparator == '\\'--- > Posix:   pathSeparator ==  '/' -- >> isPathSeparator pathSeparator pathSeparator :: Char pathSeparator = '/'  -- | The list of all possible separators. ----- > Windows: pathSeparators == ['\\', '/']--- > Posix:   pathSeparators == ['/'] -- >> pathSeparator `elem` pathSeparators pathSeparators :: [Char] pathSeparators = return pathSeparator  -- | The character that is used to separate the entries in the $PATH environment variable. ----- > Windows: searchPathSeparator == ';'--- > Posix:   searchPathSeparator == ':' searchPathSeparator :: Char searchPathSeparator = ':' @@ -617,149 +824,52 @@   --------------------------------------------------------------------------- Flexible Manipulation Functions+-- 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+-- | This is a more flexible variant of 'addExtension' / '<.>' which can --   work with files or directories ----- >> addFileOrDirExtension (mkFile "/") "x" == (mkFile "/.x")-addFileOrDirExtension :: Path ar fd -> String -> Path ar fd-addFileOrDirExtension p "" = p-addFileOrDirExtension (FileDir p (PathComponent pc)) ext = FileDir p (PathComponent (pc ++ suffix))+-- >> 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-addFileOrDirExtension PathRoot ext = FileDir PathRoot (PathComponent suffix)+genericAddExtension PathRoot ext = FileDir PathRoot (PathComponent suffix)                                          where suffix | "." `isPrefixOf` ext = ext                                                       | otherwise = "." ++ ext -dropFileOrDirExtension :: Path ar fd -> Path ar fd-dropFileOrDirExtension = fst . splitFileOrDirExtension+genericDropExtension :: Path ar fd -> Path ar fd+genericDropExtension = fst . genericSplitExtension -dropFileOrDirExtensions :: Path ar fd -> Path ar fd-dropFileOrDirExtensions = fst . splitFileOrDirExtensions+genericDropExtensions :: Path ar fd -> Path ar fd+genericDropExtensions = fst . genericSplitExtensions -splitFileOrDirExtension :: Path ar fd -> (Path ar fd, String)-splitFileOrDirExtension (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)+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-splitFileOrDirExtension p = (p,"")+genericSplitExtension p = (p,"") -splitFileOrDirExtensions :: Path ar fd -> (Path ar fd, String)-splitFileOrDirExtensions (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)+genericSplitExtensions :: Path ar fd -> (Path ar fd, String)+genericSplitExtensions (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)     where (s1,s2) = break isExtSeparator s-splitFileOrDirExtensions p = (p,"")--takeFileOrDirExtension :: Path ar fd -> String-takeFileOrDirExtension = snd . splitFileOrDirExtension--takeFileOrDirExtensions :: Path ar fd -> String-takeFileOrDirExtensions = snd . splitFileOrDirExtension------------------------------------------------------------------------------ System.Directory replacements--doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool-doesFileExist = SD.doesFileExist . getPathString--doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool-doesDirectoryExist = SD.doesDirectoryExist . getPathString--getDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])-getDirectoryContents = absDirectoryContents---- | Retrieve the contents of a directory path (which may be relative) as absolute paths-absDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])-absDirectoryContents p = do-  cd <- mkAbsDir <$> SD.getCurrentDirectory-  let dir = absRel id (cd </>) p-  (rds, rfs) <- relDirectoryContents dir-  return (map (dir </>) rds, map (dir </>) rfs)---- | Returns paths relative /to/ the supplied (abs or relative) directory path.---   eg (for current working directory of @\/somewhere\/cwd\/@):------ > show (relDirectoryContents (mkRelDir "subDir1")) == (["subDir1A","subDir1B"],--- >                                                      ["file1A","file1B"])----relDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile])-relDirectoryContents dir = do-  filenames <- filter (not . flip elem [".",".."]) <$> SD.getDirectoryContents (getPathString dir)-  dirFlags  <- mapM (doesDirectoryExist . (dir </>) . mkPath) filenames-  let fileinfo = zip filenames dirFlags-      (dirs, files) = partition snd fileinfo-  return (map (FileDir currentDir . PathComponent . fst) dirs,-          map (FileDir currentDir . PathComponent . fst) files)--filesInDir :: AbsRelClass ar => DirPath ar -> IO [RelFile]-filesInDir dir = snd <$> relDirectoryContents dir--dirsInDir :: AbsRelClass ar => DirPath ar -> IO [RelDir]-dirsInDir dir = fst <$> relDirectoryContents dir--createDirectory :: AbsRelClass ar => DirPath ar -> IO ()-createDirectory = SD.createDirectory . getPathString--createDirectoryIfMissing :: AbsRelClass ar => Bool -> DirPath ar -> IO ()-createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . getPathString--removeDirectory :: AbsRelClass ar => DirPath ar -> IO ()-removeDirectory = SD.removeDirectory . getPathString--removeDirectoryRecursive :: AbsRelClass ar => DirPath ar -> IO ()-removeDirectoryRecursive = SD.removeDirectoryRecursive . getPathString--getCurrentDirectory :: IO AbsDir-getCurrentDirectory = mkAbsDir <$> SD.getCurrentDirectory--setCurrentDirectory :: AbsRelClass ar => FilePath ar -> IO ()-setCurrentDirectory = SD.setCurrentDirectory . getPathString--getHomeDirectory :: IO AbsDir-getHomeDirectory = mkAbsDir <$> SD.getHomeDirectory--getUserDocumentsDirectory :: IO AbsDir-getUserDocumentsDirectory = mkAbsDir <$> SD.getUserDocumentsDirectory--getTemporaryDirectory :: IO AbsDir-getTemporaryDirectory = mkAbsDir <$> SD.getTemporaryDirectory--getAppUserDataDirectory :: String -> IO AbsDir-getAppUserDataDirectory user = mkAbsDir <$> SD.getAppUserDataDirectory user--copyFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()-copyFile p1 p2 = SD.copyFile (getPathString p1) (getPathString p2)--removeFile :: AbsRelClass ar => FilePath ar -> IO ()-removeFile = SD.removeFile . getPathString--renameFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()-renameFile p1 p2 = SD.renameFile (getPathString p1) (getPathString p2)--makeRelativeToCurrentDirectory :: AbsRelClass ar => Path ar fd -> IO (RelPath fd)-makeRelativeToCurrentDirectory p = mkPath <$> SD.makeRelativeToCurrentDirectory (getPathString p)--renameDirectory :: (AbsRelClass ar1, AbsRelClass ar2) => DirPath ar1 -> DirPath ar2 -> IO ()-renameDirectory p1 p2 = SD.renameDirectory (getPathString p1) (getPathString p2)+genericSplitExtensions p = (p,"") -canonicalizePath :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd)-canonicalizePath p = mkPath <$> SD.canonicalizePath (getPathString p)+genericTakeExtension :: Path ar fd -> String+genericTakeExtension = snd . genericSplitExtension -{--findExecutable :: String -> IO (Maybe FilePath)-getPermissions :: FilePath -> IO Permissions-setPermissions :: FilePath -> Permissions -> IO ()-getModificationTime :: FilePath -> IO ClockTime--}+genericTakeExtensions :: Path ar fd -> String+genericTakeExtensions = snd . genericSplitExtension   ------------------------------------------------------------------------@@ -768,8 +878,8 @@ testall = do   putStrLn "Running QuickCheck tests..."   quickCheck prop_mkPathFromComponents_pathComponents-  quickCheck prop_mkAbsFromRel_endSame-  quickCheck prop_mkAbsFromRel_startSame+  quickCheck prop_makeAbsoluteFromDir_endSame+  quickCheck prop_makeAbsoluteFromDir_startSame   quickCheck prop_split_combine   quickCheck prop_takeFileName_end   quickCheck prop_splitCombine
+ System/Path/Directory.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides type-safe access to directory manipulations.+--+--   It is designed to be imported instead of "System.Directory".+--   (It is intended to provide versions of functions from that+--   module which have equivalent functionality but are more+--   typesafe). "System.Path" is a companion module providing+--   a type-safe alternative to "System.FilePath".+--+--   You will typically want to import as follows:+--+--   > import Prelude hiding (FilePath)+--   > import System.Path+--   > import System.Path.Directory+--   > import System.Path.IO+--+--+-- Ben Moseley - (c) 2009+--+module System.Path.Directory+(+  -- * Actions on directories+  createDirectory,+  createDirectoryIfMissing,+  removeDirectory,+  removeDirectoryRecursive,+  renameDirectory,++  getDirectoryContents,+  absDirectoryContents,+  relDirectoryContents,+  filesInDir,+  dirsInDir,++  getCurrentDirectory,+  setCurrentDirectory,++  -- * Pre-defined directories+  getHomeDirectory,+  getAppUserDataDirectory,+  getUserDocumentsDirectory,+  getTemporaryDirectory,++  -- * Actions on files+  removeFile,+  renameFile,+  copyFile,+  canonicalizePath,+  makeRelativeToCurrentDirectory,+  findExecutable,++  -- * Existence tests+  doesFileExist,+  doesDirectoryExist,++  -- * Permissions+  Permissions,+  getPermissions,+  setPermissions,++  -- * Timestamps+  getModificationTime+)++where++import Prelude hiding (FilePath)++import System.Path++import Control.Applicative+import Control.Arrow+import Data.List+import GHC.Exts(IsString(..))+import System.Directory (Permissions)+import qualified System.Directory as SD+import System.IO hiding (FilePath)+import System.IO.Error+import System.Time+import Test.QuickCheck+import Text.Printf+++------------------------------------------------------------------------+-- Actions on directories++createDirectory :: AbsRelClass ar => DirPath ar -> IO ()+createDirectory = SD.createDirectory . getPathString++createDirectoryIfMissing :: AbsRelClass ar => Bool -> DirPath ar -> IO ()+createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . getPathString++removeDirectory :: AbsRelClass ar => DirPath ar -> IO ()+removeDirectory = SD.removeDirectory . getPathString++removeDirectoryRecursive :: AbsRelClass ar => DirPath ar -> IO ()+removeDirectoryRecursive = SD.removeDirectoryRecursive . getPathString++renameDirectory :: (AbsRelClass ar1, AbsRelClass ar2) => DirPath ar1 -> DirPath ar2 -> IO ()+renameDirectory p1 p2 = SD.renameDirectory (getPathString p1) (getPathString p2)++-- | An alias for 'relDirectoryContents'.+getDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile])+getDirectoryContents = relDirectoryContents++-- | Retrieve the contents of a directory path (which may be relative) as absolute paths+absDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])+absDirectoryContents p = do+  cd <- asAbsDir <$> SD.getCurrentDirectory+  let dir = absRel id (cd </>) p+  (rds, rfs) <- relDirectoryContents dir+  return (map (dir </>) rds, map (dir </>) rfs)++-- | Returns paths relative /to/ the supplied (abs or relative) directory path.+--   eg (for current working directory of @\/somewhere\/cwd\/@):+--+-- > show (relDirectoryContents "d/e/f/") == (["subDir1A","subDir1B"],+-- >                                                      ["file1A","file1B"])+--+relDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile])+relDirectoryContents dir = do+  filenames <- filter (not . flip elem [".",".."]) <$> SD.getDirectoryContents (getPathString dir)+  dirFlags  <- mapM (doesDirectoryExist . (dir </>) . asRelPath) filenames+  let fileinfo = zip filenames dirFlags+      (dirs, files) = partition snd fileinfo+  return (map (combine currentDir . asRelDir . fst) dirs,+          map (combine currentDir . asRelFile . fst) files)++-- | A convenient alternative to 'relDirectoryContents' if you only want files.+filesInDir :: AbsRelClass ar => DirPath ar -> IO [RelFile]+filesInDir dir = snd <$> relDirectoryContents dir++-- | A convenient alternative to 'relDirectoryContents' if you only want directories.+dirsInDir :: AbsRelClass ar => DirPath ar -> IO [RelDir]+dirsInDir dir = fst <$> relDirectoryContents dir+++getCurrentDirectory :: IO AbsDir+getCurrentDirectory = asAbsDir <$> SD.getCurrentDirectory++setCurrentDirectory :: AbsRelClass ar => DirPath ar -> IO ()+setCurrentDirectory = SD.setCurrentDirectory . getPathString+++------------------------------------------------------------------------+-- Pre-defined directories++getHomeDirectory :: IO AbsDir+getHomeDirectory = asAbsDir <$> SD.getHomeDirectory++getAppUserDataDirectory :: String -> IO AbsDir+getAppUserDataDirectory user = asAbsDir <$> SD.getAppUserDataDirectory user++getUserDocumentsDirectory :: IO AbsDir+getUserDocumentsDirectory = asAbsDir <$> SD.getUserDocumentsDirectory++getTemporaryDirectory :: IO AbsDir+getTemporaryDirectory = asAbsDir <$> SD.getTemporaryDirectory+++------------------------------------------------------------------------+-- Actions on files++removeFile :: AbsRelClass ar => FilePath ar -> IO ()+removeFile = SD.removeFile . getPathString++renameFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()+renameFile p1 p2 = SD.renameFile (getPathString p1) (getPathString p2)++copyFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()+copyFile p1 p2 = SD.copyFile (getPathString p1) (getPathString p2)++canonicalizePath :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd)+canonicalizePath p = asPath <$> SD.canonicalizePath (getPathString p)++makeRelativeToCurrentDirectory :: AbsRelClass ar => Path ar fd -> IO (RelPath fd)+makeRelativeToCurrentDirectory p = asPath <$> SD.makeRelativeToCurrentDirectory (getPathString p)++findExecutable :: String -> IO (Maybe AbsFile)+findExecutable s = fmap asPath <$> SD.findExecutable s+++------------------------------------------------------------------------+-- Existence tests++doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool+doesFileExist = SD.doesFileExist . getPathString++doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool+doesDirectoryExist = SD.doesDirectoryExist . getPathString+++------------------------------------------------------------------------+-- Permissions++getPermissions :: AbsRelClass ar => Path ar fd -> IO Permissions+getPermissions p = SD.getPermissions (getPathString p)++setPermissions :: AbsRelClass ar => Path ar fd -> Permissions -> IO ()+setPermissions p perms = SD.setPermissions (getPathString p) perms+++------------------------------------------------------------------------+-- Timestamps++getModificationTime :: AbsRelClass ar => Path ar fd -> IO ClockTime+getModificationTime p = SD.getModificationTime (getPathString p)+++------------------------------------------------------------------------+-- QuickCheck++testall = do+  putStrLn "Running QuickCheck tests..."+  putStrLn "Tests completed."++vectorOf :: Gen a -> Int -> Gen [a]+vectorOf gen n = sequence [ gen | i <- [1..n] ]++-- test :: Testable a => a -> IO ()+-- test = quickCheck++
+ System/Path/IO.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides type-safe access to IO operations.+--+--   It is designed to be imported instead of "System.IO".+--   (It is intended to provide versions of functions from that+--   module which have equivalent functionality but are more+--   typesafe). "System.Path" is a companion module providing+--   a type-safe alternative to "System.FilePath".+--+--   You will typically want to import as follows:+--+--   > import Prelude hiding (FilePath)+--   > import System.Path+--   > import System.Path.Directory+--   > import System.Path.IO+--+--+-- Ben Moseley - (c) 2009+--+module System.Path.IO+(+  -- * Covers for System.IO functions+  withFile,+  openFile,+  System.Path.IO.readFile,+  System.Path.IO.writeFile,+  System.Path.IO.appendFile,+  withBinaryFile,+  openBinaryFile,+  openTempFile,+  openBinaryTempFile,++  -- * Re-exports+  IO,+  fixIO,+  Handle,+  stdin,+  stdout,+  stderr,+  IOMode(..),+  hClose,+  hFileSize,+  hSetFileSize,+  hIsEOF,+  isEOF,+  BufferMode(..),+  hSetBuffering,+  hGetBuffering,+  hFlush,+  hGetPosn,+  hSetPosn,+  HandlePosn,+  hSeek,+  SeekMode(..),+  hTell,+  hIsOpen,+  hIsClosed,+  hIsReadable,+  hIsWritable,+  hIsSeekable,+  hIsTerminalDevice,+  hSetEcho,+  hGetEcho,+  hShow,+  hWaitForInput,+  hReady,+  hGetChar,+  hGetLine,+  hLookAhead,+  hGetContents,+  hPutChar,+  hPutStr,+  hPutStrLn,+  hPrint,+  interact,+  putChar,+  putStr,+  putStrLn,+  print,+  getChar,+  getLine,+  getContents,+  readIO,+  readLn,+  hSetBinaryMode,+  hPutBuf,+  hGetBuf,+  hPutBufNonBlocking,+  hGetBufNonBlocking+)++where++import Prelude hiding (FilePath)++import System.Path++import Control.Applicative+import Control.Arrow+import Data.List+import GHC.Exts(IsString(..))+import System.Directory (Permissions)+import System.IO hiding (FilePath, withFile, openFile, readFile, writeFile, appendFile,+                                 withBinaryFile, openBinaryFile, openTempFile, openBinaryTempFile)+import qualified System.IO as SIO+import System.IO.Error+import System.Time+import Test.QuickCheck+import Text.Printf+++------------------------------------------------------------------------+-- Covers for System.IO functions++withFile :: AbsRelClass ar => Path ar fd -> IOMode -> (Handle -> IO r) -> IO r+withFile f = SIO.withFile (getPathString f)++openFile :: AbsRelClass ar => FilePath ar -> IOMode -> IO Handle+openFile f = SIO.openFile (getPathString f)++readFile :: AbsRelClass ar => FilePath ar -> IO String+readFile f = SIO.readFile (getPathString f)++writeFile :: AbsRelClass ar => FilePath ar -> String -> IO ()+writeFile f = SIO.writeFile (getPathString f)++appendFile :: AbsRelClass ar => FilePath ar -> String -> IO ()+appendFile f = SIO.appendFile (getPathString f)++withBinaryFile :: AbsRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r+withBinaryFile f = SIO.withBinaryFile (getPathString f)++openBinaryFile :: AbsRelClass ar => FilePath ar -> IOMode -> IO Handle+openBinaryFile f = SIO.openBinaryFile (getPathString f)++openTempFile :: AbsRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle)+openTempFile f template = first asAbsFile <$> SIO.openTempFile (getPathString f) (getPathString template)++openBinaryTempFile :: AbsRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle)+openBinaryTempFile f template = first asAbsFile <$> SIO.openBinaryTempFile (getPathString f) (getPathString template)++------------------------------------------------------------------------+-- QuickCheck++testall = do+  putStrLn "Running QuickCheck tests..."+  putStrLn "Tests completed."++vectorOf :: Gen a -> Int -> Gen [a]+vectorOf gen n = sequence [ gen | i <- [1..n] ]++-- test :: Testable a => a -> IO ()+-- test = quickCheck++
+ Test.hs view
@@ -0,0 +1,46 @@+module Test where++import Control.Applicative+import Control.Monad+import Data.List++import System.Path+import System.Process+import System.Exit+import Text.Printf++srcfiles   = ["System/Path.hs","System/Path/Directory.hs","System/Path/IO.hs"]+template   = "TestTemplate.hs"+testModule = "TestModule.hs"+tok        = "<TESTS_GO_HERE>"+testPrefix = "-- >> "++main = do+  sourceLines   <- concat <$> mapM (fmap lines . readFile) srcfiles+  templateLines <- lines <$> readFile template+  let testLines = [drop (length testPrefix) l | l <- sourceLines, testPrefix `isPrefixOf` l]+      (templateHead,_:templateTail) = break (tok `isInfixOf`) templateLines+      outLines = (\t -> "  "++t++",") <$> testLines+      numTestLines = zip [1..] testLines++  writeFile testModule $ unlines $ templateHead ++ outLines ++ templateTail++  let args = ["-e","TestModule.main",testModule]+      ghc = "ghc"+      stdinput = ""++  printf "Running %d tests...\n" (length testLines)+  x@(_ec, failedTestsStr, err) <- readProcessWithExitCode ghc args stdinput+  when (not $ null err) $ putStrLn err >> exitFailure++  let failedTests :: [Int]+      failedTests = read failedTestsStr+      numFailures = length failedTests++  when (not $ null failedTests) $ do+    putStrLn "Failures:"+    putStrLn $ unlines [s | (n,s) <- numTestLines, n `elem` failedTests]+    exitFailure++  putStrLn "Passed."+
+ TestTemplate.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+module TestModule ()+where++import System.Path+import System.Path.Directory+import System.Random+import Data.Char++main = do+  g <- newStdGen+  let (a,_g') = random g+      -- TODO - integrate with QuickCheck+      x = rootDir </> "tmp" </> "someFile" <.> "ext"++  let numResults = zip [1..] $ results a x+      fails = [n|(n,False) <-numResults]++  putStr $ show fails -- This can then be parsed by the invoking Test module++results a x = [+ <TESTS_GO_HERE>+ True -- Just so we can have commas at end of all preceding lines+ ]+
pathtype.cabal view
@@ -1,50 +1,96 @@ Name:                pathtype-Version:             0.0.1+Version:             0.0.2 Synopsis:            Type-safe replacement for System.FilePath etc-Description:         This module provides type-safe access to filepath manipulations.-                     .-		     It is designed to be imported instead of 'System.FilePath' and-		     'System.Directory' and is intended to provide versions of-		     functions from those modules which have equivalent functionality-		     but are more typesafe.-                     .-		     The heart of this module is the @Path ar fd@ abstract type which+Description:         This package provides type-safe access to filepath manipulations.+		     .+		     "System.Path" is designed to be used 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 RelPath fd = Path Rel fd-                     > type DirPath ar = Path ar Dir-                     .+		     .+		     > 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.+		     by Neil Mitchell's "System.FilePath" module.                      .-		     WARNING -- THE API IS NOT YET STABLE -- WARNING-+                     . Stability:           experimental License:             BSD3 Category:            System License-file:        LICENSE Author:              Ben Moseley Maintainer:          ben@moseley.name+HomePage:            http://code.haskell.org/pathtype Build-Type:          Simple-Cabal-Version:       >=1.2+Cabal-Version:       >=1.6+Extra-Source-Files: Test.hs, TestTemplate.hs +source-repository head+  type:     darcs+  location: http://code.haskell.org/pathtype+ Library-  Build-Depends:     base >= 3 && < 5, directory >= 1 && < 2, QuickCheck >= 1.2 && < 2+  Build-Depends:     base >= 4 && < 5, directory >= 1 && < 2, old-time >= 1.0 && < 2, QuickCheck >= 1.2 && < 2   Exposed-modules:-    System.Path-  Extensions:        EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types+    System.Path, System.Path.Directory, System.Path.IO+  Extensions:        EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types, OverloadedStrings