pathtype 0.5.4.2 → 0.5.4.3

raw patch · 21 files changed

+1635/−1427 lines, 21 filesdep +pathtypedep +randomdep −processdep ~basenew-component:exe:create-pathtype-test

Dependencies added: pathtype, random

Dependencies removed: process

Dependency ranges changed: base

Files

• System/Path.hs +0/−86
• System/Path/Directory.hs +0/−226
• System/Path/IO.hs +0/−132
• System/Path/Internal.hs +0/−873
• System/Path/Posix.hs +0/−18
• System/Path/Windows.hs +0/−18
• Test.hs +0/−40
• TestTemplate.hs +0/−30
• directory/post-incl-1.2/System/Path/ModificationTime.hs +6/−0
• directory/pre-1.2/System/Path/ModificationTime.hs +17/−0
• pathtype.cabal +31/−4
• src/System/Path.hs +86/−0
• src/System/Path/Directory.hs +203/−0
• src/System/Path/IO.hs +132/−0
• src/System/Path/Internal.hs +873/−0
• src/System/Path/Posix.hs +18/−0
• src/System/Path/Windows.hs +18/−0
• test/Test.hs +24/−0
• test/TestResult.hs +185/−0
• test/TestTemplate.hs +11/−0
• tool/CreateTest.hs +31/−0

@@ -1,86 +0,0 @@-{-# LANGUAGE CPP #-}--- | 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-----#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-module System.Path(module System.Path.Windows) where-import System.Path.Windows-#else-module System.Path(module System.Path.Posix) where-import System.Path.Posix-#endif--

@@ -1,226 +0,0 @@-{-# LANGUAGE CPP #-}--- | 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 System.Path--import qualified System.Directory as SD-import System.Directory (Permissions)--import Control.Applicative ((<$>))--import Data.List (partition)--import Prelude hiding (FilePath)----- directory < 1.2 used old-time;--- to present a consistent API we convert it to time:Data.Time.UTCTime.-#if MIN_VERSION_directory(1,2,0)-import Data.Time (UTCTime)-#else-import qualified Data.Time as Time-import qualified System.Time as SysTime-import Data.Time (UTCTime(UTCTime))-#endif----------------------------------------------------------------------------- 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 UTCTime-#if MIN_VERSION_directory(1,2,0)-getModificationTime p = SD.getModificationTime (getPathString p)-#else--- directory < 1.2 used the old-time package, convert to UTCTime-getModificationTime p = convertTime <$> SD.getModificationTime (getPathString p)-  where-    convertTime clock = UTCTime day (fromIntegral sec)-      where-        calendar = SysTime.toUTCTime clock-        day = Time.addDays (toInteger (SysTime.ctYDay calendar)) yearStart-        yearStart = Time.fromGregorian (toInteger (SysTime.ctYear calendar)) 1 1-        hour = SysTime.ctHour calendar-        minu = hour * 60 + SysTime.ctMin calendar-        sec = minu * 60 + SysTime.ctSec calendar-#endif

@@ -1,132 +0,0 @@--- | 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,-  readFile,-  writeFile,-  appendFile,-  withBinaryFile,-  openBinaryFile,-  openTempFile,-  openBinaryTempFile,--  -- * Re-exports-  IO,-  SIO.fixIO,-  Handle,-  SIO.stdin,-  SIO.stdout,-  SIO.stderr,-  SIO.IOMode(..),-  SIO.hClose,-  SIO.hFileSize,-  SIO.hSetFileSize,-  SIO.hIsEOF,-  SIO.isEOF,-  SIO.BufferMode(..),-  SIO.hSetBuffering,-  SIO.hGetBuffering,-  SIO.hFlush,-  SIO.hGetPosn,-  SIO.hSetPosn,-  SIO.HandlePosn,-  SIO.hSeek,-  SIO.SeekMode(..),-  SIO.hTell,-  SIO.hIsOpen,-  SIO.hIsClosed,-  SIO.hIsReadable,-  SIO.hIsWritable,-  SIO.hIsSeekable,-  SIO.hIsTerminalDevice,-  SIO.hSetEcho,-  SIO.hGetEcho,-  SIO.hShow,-  SIO.hWaitForInput,-  SIO.hReady,-  SIO.hGetChar,-  SIO.hGetLine,-  SIO.hLookAhead,-  SIO.hGetContents,-  SIO.hPutChar,-  SIO.hPutStr,-  SIO.hPutStrLn,-  SIO.hPrint,-  interact,-  putChar,-  putStr,-  putStrLn,-  print,-  getChar,-  getLine,-  getContents,-  readIO,-  readLn,-  SIO.hSetBinaryMode,-  SIO.hPutBuf,-  SIO.hGetBuf,-  SIO.hPutBufNonBlocking,-  SIO.hGetBufNonBlocking-)--where--import System.Path--import qualified System.IO as SIO-import System.IO (IOMode, Handle)--import Control.Arrow (first)-import Control.Applicative ((<$>))--import Prelude hiding (FilePath, readFile, writeFile, appendFile)------------------------------------------------------------------------------ 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)

@@ -1,873 +0,0 @@---- 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 ((|||), (***))-import Control.Applicative ((<$>))-import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intercalate)-import Data.String (IsString(fromString))--import Text.Printf (printf)-import Test.QuickCheck-          (Gen, Property, property, Arbitrary(arbitrary),-           vectorOf, oneof, frequency,-           NonNegative(NonNegative), quickCheck)--import Prelude hiding (FilePath)------------------------------------------------------------------------------ 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 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 _ 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 _ 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 (FileDir p@PathRoot pc)   = absRel (const $ showString pathSeparators)-                                                   (const id)-                                                   p .-                                            showsPrec d pc-    showsPrec d (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 non-IO 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 <- 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.------ >> 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------------------------------------------------------------------------------ Internal Functions for PathComponent manipulation--mkPathFromComponents :: [PathComponent] -> Path ar fd-mkPathFromComponents pcs =-    case reverse pcs of-      [] -> PathRoot-      p:ps -> 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---- | Path must not be empty-splitFileName :: Path ar fd -> (DirPath ar, RelPath fd)-splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc])-splitFileName PathRoot = error "splitFileName: empty path"--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 =-    isAbsoluteString s1 == isAbsoluteString s2 && 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 q = (reverse *** reverse) . swap . break q . 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 :: 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_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) <- arbitrary-  pcs <- vectorOf numDirs qcDirComponent-  pc <- qcFileComponent-  return $ mkPathFromComponents (pcs ++ [pc])---qcDirPath :: Gen (DirPath ar)-qcDirPath = do-  (NonNegative numDirs) <- arbitrary-  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--

@@ -1,18 +0,0 @@-{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}-{-# LANGUAGE CPP #-}-#define MODULE_NAME     Posix-#define IS_WINDOWS      False---- | This module provides type-safe access to filepath manipulations.------   Normally you would import 'System.Path' (which will use the---   default implementation for the host platform) instead of this.---   However, importing this explicitly allows for manipulation of---   non-native paths.----#ifdef __HADDOCK__-module System.Path.Posix where-#else-#include "Internal.hs"-#endif-

@@ -1,18 +0,0 @@-{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}-{-# LANGUAGE CPP #-}-#define MODULE_NAME     Windows-#define IS_WINDOWS      True---- | This module provides type-safe access to filepath manipulations.------   Normally you would import 'System.Path' (which will use the---   default implementation for the host platform) instead of this.---   However, importing this explicitly allows for manipulation of---   non-native paths.----#ifdef __HADDOCK__-module System.Path.Windows where-#else-#include "Internal.hs"-#endif-

@@ -1,40 +0,0 @@-module Main where--import Control.Monad (void)-import Control.Applicative ((<$>))-import Data.List (stripPrefix, isInfixOf)-import Data.Maybe (mapMaybe)--import System.Process (rawSystem)-import System.Exit (exitWith)-import Text.Printf (printf)---srcfiles :: [String]-template, testModule, tok, testPrefix :: String--srcfiles   = ["System/Path/Internal.hs","System/Path/Directory.hs","System/Path/IO.hs"]-template   = "TestTemplate.hs"-testModule = "TestModule.hs"-tok        = "<TESTS_GO_HERE>"-testPrefix = "-- >> "--main :: IO ()-main = do-  testLines <--     mapMaybe (stripPrefix testPrefix) . concatMap lines <$> mapM readFile srcfiles-  (templateHead,_:templateTail) <--     break (tok `isInfixOf`) . lines <$> readFile template-  let outLines = (\t -> printf "  (%s,\n    %s) :" (show t) t) <$> testLines--  writeFile testModule $ unlines $-     ("{- Do not edit! Created from " ++ template ++ " -}") :-     templateHead ++ outLines ++ templateTail--  let ghc = "ghc"-      args =-        ["-optP-include", "-optPdist/build/autogen/cabal_macros.h",-         "-e", "TestModule.main", testModule]--  void $ printf "Running %d tests...\n" (length testLines)-  exitWith =<< rawSystem ghc args

@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module TestModule (main) where--import System.Path-import System.Random (newStdGen, random)-import System.Exit (ExitCode, exitFailure)-import Control.Monad (when)-import Data.Char (toLower)--main :: IO ()-main = do-  g <- newStdGen-  let (a,_g') = random g-      -- TODO - integrate with QuickCheck-      x = rootDir </> "tmp" </> "someFile" <.> "ext"--  let fails = map fst $ filter (not . snd) $ results a x--  if null fails-    then do-      putStrLn "Passed."-    else do-      putStrLn "Failed tests:"-      mapM_ putStrLn fails-      exitFailure--results :: Char -> System.Path.FilePath ar -> [(String, Bool)]-results a x =-  <TESTS_GO_HERE>-  []

@@ -0,0 +1,6 @@+module System.Path.ModificationTime where++import Data.Time (UTCTime)++convertTime :: UTCTime -> UTCTime+convertTime = id

@@ -0,0 +1,17 @@+module System.Path.ModificationTime where++import qualified System.Time as SysTime+import qualified Data.Time as Time+import Data.Time (UTCTime(UTCTime))++-- directory < 1.2 used old-time;+-- to present a consistent API we convert it to time:Data.Time.UTCTime.+convertTime :: SysTime.ClockTime -> UTCTime+convertTime clock = UTCTime day (fromIntegral sec)+  where+    calendar = SysTime.toUTCTime clock+    day = Time.addDays (toInteger (SysTime.ctYDay calendar)) yearStart+    yearStart = Time.fromGregorian (toInteger (SysTime.ctYear calendar)) 1 1+    hour = SysTime.ctHour calendar+    minu = hour * 60 + SysTime.ctMin calendar+    sec = minu * 60 + SysTime.ctSec calendar

@@ -1,5 +1,5 @@ Name:                pathtype-Version:             0.5.4.2+Version:             0.5.4.3 Synopsis:            Type-safe replacement for System.FilePath etc Description:         This package provides type-safe access to filepath manipulations. 		     .@@ -83,14 +83,18 @@ HomePage:            http://hub.darcs.net/thielema/pathtype/ Build-Type:          Simple Cabal-Version:       >=1.8-Extra-Source-Files: TestTemplate.hs, System/Path/Internal.hs+Extra-Source-Files:+  test/TestTemplate.hs+  src/System/Path/Internal.hs+  directory/pre-1.2/System/Path/ModificationTime.hs+  directory/post-incl-1.2/System/Path/ModificationTime.hs  Source-Repository head   Type:     darcs   Location: http://hub.darcs.net/thielema/pathtype/  Source-Repository this-  Tag:      0.5.4.2+  Tag:      0.5.4.3   Type:     darcs   Location: http://hub.darcs.net/thielema/pathtype/ @@ -98,6 +102,10 @@   Description: Build with directory < 1.2 and old-time   Default:     True +Flag buildTools+  Description: Build tool for updating test module+  Default:     True+ Library   Build-Depends:     QuickCheck >= 2.1.0.1 && < 3,@@ -106,24 +114,43 @@    If flag(old-time)     Build-Depends: directory >= 1 && < 1.2, old-time >= 1.0 && < 2+    Hs-Source-Dirs: directory/pre-1.2   Else     Build-Depends: directory >= 1.2 && < 2+    Hs-Source-Dirs: directory/post-incl-1.2 +  Hs-Source-Dirs: src   Exposed-Modules:     System.Path     System.Path.Directory     System.Path.IO     System.Path.Posix     System.Path.Windows+  Other-Modules:+    System.Path.ModificationTime    GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind  Test-Suite test   Type: exitcode-stdio-1.0   Main-Is: Test.hs+  Other-Modules: TestResult+  Hs-Source-Dirs: test    Build-Depends:-    process >=1.1 && <1.3,+    pathtype,+    random >=1.0 && <1.2,     base++  GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind++Executable create-pathtype-test+  If flag(buildTools)+    Build-Depends:+      base+  Else+    Buildable: True+  Main-Is: CreateTest.hs+  Hs-Source-Dirs: tool    GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind

@@ -0,0 +1,86 @@+{-# LANGUAGE CPP #-}+-- | 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+--++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+module System.Path(module System.Path.Windows) where+import System.Path.Windows+#else+module System.Path(module System.Path.Posix) where+import System.Path.Posix+#endif++

@@ -0,0 +1,203 @@+-- | 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 System.Path+import System.Path.ModificationTime (convertTime)+import Data.Time (UTCTime)++import qualified System.Directory as SD+import System.Directory (Permissions)++import Control.Applicative ((<$>))++import Data.List (partition)++import Prelude hiding (FilePath)+++------------------------------------------------------------------------+-- 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 UTCTime+getModificationTime p = convertTime <$> SD.getModificationTime (getPathString p)

@@ -0,0 +1,132 @@+-- | 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,+  readFile,+  writeFile,+  appendFile,+  withBinaryFile,+  openBinaryFile,+  openTempFile,+  openBinaryTempFile,++  -- * Re-exports+  IO,+  SIO.fixIO,+  Handle,+  SIO.stdin,+  SIO.stdout,+  SIO.stderr,+  SIO.IOMode(..),+  SIO.hClose,+  SIO.hFileSize,+  SIO.hSetFileSize,+  SIO.hIsEOF,+  SIO.isEOF,+  SIO.BufferMode(..),+  SIO.hSetBuffering,+  SIO.hGetBuffering,+  SIO.hFlush,+  SIO.hGetPosn,+  SIO.hSetPosn,+  SIO.HandlePosn,+  SIO.hSeek,+  SIO.SeekMode(..),+  SIO.hTell,+  SIO.hIsOpen,+  SIO.hIsClosed,+  SIO.hIsReadable,+  SIO.hIsWritable,+  SIO.hIsSeekable,+  SIO.hIsTerminalDevice,+  SIO.hSetEcho,+  SIO.hGetEcho,+  SIO.hShow,+  SIO.hWaitForInput,+  SIO.hReady,+  SIO.hGetChar,+  SIO.hGetLine,+  SIO.hLookAhead,+  SIO.hGetContents,+  SIO.hPutChar,+  SIO.hPutStr,+  SIO.hPutStrLn,+  SIO.hPrint,+  interact,+  putChar,+  putStr,+  putStrLn,+  print,+  getChar,+  getLine,+  getContents,+  readIO,+  readLn,+  SIO.hSetBinaryMode,+  SIO.hPutBuf,+  SIO.hGetBuf,+  SIO.hPutBufNonBlocking,+  SIO.hGetBufNonBlocking+)++where++import System.Path++import qualified System.IO as SIO+import System.IO (IOMode, Handle)++import Control.Arrow (first)+import Control.Applicative ((<$>))++import Prelude hiding (FilePath, readFile, writeFile, appendFile)+++------------------------------------------------------------------------+-- 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)

@@ -0,0 +1,873 @@++-- 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 ((|||), (***))+import Control.Applicative ((<$>))+import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intercalate)+import Data.String (IsString(fromString))++import Text.Printf (printf)+import Test.QuickCheck+          (Gen, Property, property, Arbitrary(arbitrary),+           vectorOf, oneof, frequency,+           NonNegative(NonNegative), quickCheck)++import Prelude hiding (FilePath)+++------------------------------------------------------------------------+-- 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 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 _ 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 _ 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 (FileDir p@PathRoot pc)   = absRel (const $ showString pathSeparators)+                                                   (const id)+                                                   p .+                                            showsPrec d pc+    showsPrec d (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 non-IO 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 <- 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.+--+-- >> 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+++------------------------------------------------------------------------+-- Internal Functions for PathComponent manipulation++mkPathFromComponents :: [PathComponent] -> Path ar fd+mkPathFromComponents pcs =+    case reverse pcs of+      [] -> PathRoot+      p:ps -> 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++-- | Path must not be empty+splitFileName :: Path ar fd -> (DirPath ar, RelPath fd)+splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc])+splitFileName PathRoot = error "splitFileName: empty path"++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 =+    isAbsoluteString s1 == isAbsoluteString s2 && 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 q = (reverse *** reverse) . swap . break q . 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 :: 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_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) <- arbitrary+  pcs <- vectorOf numDirs qcDirComponent+  pc <- qcFileComponent+  return $ mkPathFromComponents (pcs ++ [pc])+++qcDirPath :: Gen (DirPath ar)+qcDirPath = do+  (NonNegative numDirs) <- arbitrary+  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++

@@ -0,0 +1,18 @@+{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}+{-# LANGUAGE CPP #-}+#define MODULE_NAME     Posix+#define IS_WINDOWS      False++-- | This module provides type-safe access to filepath manipulations.+--+--   Normally you would import 'System.Path' (which will use the+--   default implementation for the host platform) instead of this.+--   However, importing this explicitly allows for manipulation of+--   non-native paths.+--+#ifdef __HADDOCK__+module System.Path.Posix where+#else+#include "Internal.hs"+#endif+

@@ -0,0 +1,18 @@+{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}+{-# LANGUAGE CPP #-}+#define MODULE_NAME     Windows+#define IS_WINDOWS      True++-- | This module provides type-safe access to filepath manipulations.+--+--   Normally you would import 'System.Path' (which will use the+--   default implementation for the host platform) instead of this.+--   However, importing this explicitly allows for manipulation of+--   non-native paths.+--+#ifdef __HADDOCK__+module System.Path.Windows where+#else+#include "Internal.hs"+#endif+

@@ -0,0 +1,24 @@+module Main (main) where++import TestResult (results)++import System.Path (rootDir, asRelDir, asRelFile, (</>), (<.>))+import System.Random (newStdGen, random)+import System.Exit (exitFailure)++main :: IO ()+main = do+  g <- newStdGen+  let (a,_g') = random g+      -- TODO - integrate with QuickCheck+      x = rootDir </> asRelDir "tmp" </> asRelFile "someFile" <.> "ext"++  let fails = map fst $ filter (not . snd) $ results a x++  if null fails+    then do+      putStrLn "Passed."+    else do+      putStrLn "Failed tests:"+      mapM_ putStrLn fails+      exitFailure

@@ -0,0 +1,185 @@+{- Do not edit! Created from test/TestTemplate.hs -}+{-# LANGUAGE OverloadedStrings #-}+module TestResult (results) where++import System.Path+import Data.Char (toLower)+++results :: Char -> System.Path.FilePath ar -> [(String, Bool)]+results a x =+  ("pathMap (map toLower) \"/tmp/Reports/SpreadSheets\" == \"/tmp/reports/spreadsheets\"",+    pathMap (map toLower) "/tmp/Reports/SpreadSheets" == "/tmp/reports/spreadsheets") :+  ("asPath \"/tmp\" == \"/tmp\"",+    asPath "/tmp" == "/tmp") :+  ("asPath \"file.txt\" == \"file.txt\"",+    asPath "file.txt" == "file.txt") :+  ("isAbsolute (asPath \"/tmp\" :: AbsDir) == True",+    isAbsolute (asPath "/tmp" :: AbsDir) == True) :+  ("isAbsolute (asPath \"/tmp\" :: RelDir) == False",+    isAbsolute (asPath "/tmp" :: RelDir) == False) :+  ("getPathString (asPath \"/tmp\" :: AbsDir) == \"/tmp\"",+    getPathString (asPath "/tmp" :: AbsDir) == "/tmp") :+  ("getPathString (asPath \"/tmp\" :: RelDir) == \"tmp\"",+    getPathString (asPath "/tmp" :: RelDir) == "tmp") :+  ("getPathString (asRelFile \"file.txt\") == \"file.txt\"",+    getPathString (asRelFile "file.txt") == "file.txt") :+  ("getPathString (asRelFile \"/file.txt\") == \"file.txt\"",+    getPathString (asRelFile "/file.txt") == "file.txt") :+  ("getPathString (asRelFile \"tmp\") == \"tmp\"",+    getPathString (asRelFile "tmp") == "tmp") :+  ("getPathString (asRelFile \"/tmp\") == \"tmp\"",+    getPathString (asRelFile "/tmp") == "tmp") :+  ("getPathString (asRelDir \"file.txt\") == \"file.txt\"",+    getPathString (asRelDir "file.txt") == "file.txt") :+  ("getPathString (asRelDir \"/file.txt\") == \"file.txt\"",+    getPathString (asRelDir "/file.txt") == "file.txt") :+  ("getPathString (asRelDir \"tmp\") == \"tmp\"",+    getPathString (asRelDir "tmp") == "tmp") :+  ("getPathString (asRelDir \"/tmp\") == \"tmp\"",+    getPathString (asRelDir "/tmp") == "tmp") :+  ("getPathString (asAbsFile \"file.txt\") == \"/file.txt\"",+    getPathString (asAbsFile "file.txt") == "/file.txt") :+  ("getPathString (asAbsFile \"/file.txt\") == \"/file.txt\"",+    getPathString (asAbsFile "/file.txt") == "/file.txt") :+  ("getPathString (asAbsFile \"tmp\") == \"/tmp\"",+    getPathString (asAbsFile "tmp") == "/tmp") :+  ("getPathString (asAbsFile \"/tmp\") == \"/tmp\"",+    getPathString (asAbsFile "/tmp") == "/tmp") :+  ("getPathString (asAbsDir \"file.txt\") == \"/file.txt\"",+    getPathString (asAbsDir "file.txt") == "/file.txt") :+  ("getPathString (asAbsDir \"/file.txt\") == \"/file.txt\"",+    getPathString (asAbsDir "/file.txt") == "/file.txt") :+  ("getPathString (asAbsDir \"tmp\") == \"/tmp\"",+    getPathString (asAbsDir "tmp") == "/tmp") :+  ("getPathString (asAbsDir \"/tmp\") == \"/tmp\"",+    getPathString (asAbsDir "/tmp") == "/tmp") :+  ("either id (const \"fred\") (mkPathAbsOrRel \"/tmp\") == \"/tmp\"",+    either id (const "fred") (mkPathAbsOrRel "/tmp") == "/tmp") :+  ("either id (const \"fred\") (mkPathAbsOrRel  \"tmp\") == \"fred\"",+    either id (const "fred") (mkPathAbsOrRel  "tmp") == "fred") :+  ("mkAbsPath \"/tmp\" \"foo.txt\" == \"/tmp/foo.txt\"",+    mkAbsPath "/tmp" "foo.txt" == "/tmp/foo.txt") :+  ("mkAbsPath \"/tmp\" \"/etc/foo.txt\" == \"/etc/foo.txt\"",+    mkAbsPath "/tmp" "/etc/foo.txt" == "/etc/foo.txt") :+  ("addExtension \"file.txt\" \"bib\" == \"file.txt.bib\"",+    addExtension "file.txt" "bib" == "file.txt.bib") :+  ("addExtension \"file.\" \".bib\" == \"file..bib\"",+    addExtension "file." ".bib" == "file..bib") :+  ("addExtension \"file\" \".bib\" == \"file.bib\"",+    addExtension "file" ".bib" == "file.bib") :+  ("takeFileName (addExtension \"\" \"ext\") == \".ext\"",+    takeFileName (addExtension "" "ext") == ".ext") :+  ("dropExtension x == fst (splitExtension x)",+    dropExtension x == fst (splitExtension x)) :+  ("not $ hasAnExtension (dropExtensions x)",+    not $ hasAnExtension (dropExtensions x)) :+  ("replaceExtension \"file.txt\" \".bob\" == \"file.bob\"",+    replaceExtension "file.txt" ".bob" == "file.bob") :+  ("replaceExtension \"file.txt\" \"bob\" == \"file.bob\"",+    replaceExtension "file.txt" "bob" == "file.bob") :+  ("replaceExtension \"file\" \".bob\" == \"file.bob\"",+    replaceExtension "file" ".bob" == "file.bob") :+  ("replaceExtension \"file.txt\" \"\" == \"file\"",+    replaceExtension "file.txt" "" == "file") :+  ("replaceExtension \"file.fred.bob\" \"txt\" == \"file.fred.txt\"",+    replaceExtension "file.fred.bob" "txt" == "file.fred.txt") :+  ("uncurry (<.>) (splitExtension x) == x",+    uncurry (<.>) (splitExtension x) == x) :+  ("uncurry addExtension (splitExtension x) == x",+    uncurry addExtension (splitExtension x) == x) :+  ("splitExtension \"file.txt\" == (\"file\",\".txt\")",+    splitExtension "file.txt" == ("file",".txt")) :+  ("splitExtension \"file\" == (\"file\",\"\")",+    splitExtension "file" == ("file","")) :+  ("splitExtension \"file/file.txt\" == (\"file/file\",\".txt\")",+    splitExtension "file/file.txt" == ("file/file",".txt")) :+  ("splitExtension \"file.txt/boris\" == (\"file.txt/boris\",\"\")",+    splitExtension "file.txt/boris" == ("file.txt/boris","")) :+  ("splitExtension \"file.txt/boris.ext\" == (\"file.txt/boris\",\".ext\")",+    splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")) :+  ("splitExtension \"file/path.txt.bob.fred\" == (\"file/path.txt.bob\",\".fred\")",+    splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")) :+  ("splitExtensions \"file.tar.gz\" == (\"file\",\".tar.gz\")",+    splitExtensions "file.tar.gz" == ("file",".tar.gz")) :+  ("takeBaseName \"/tmp/somedir/myfile.txt\" == \"myfile\"",+    takeBaseName "/tmp/somedir/myfile.txt" == "myfile") :+  ("takeBaseName \"./myfile.txt\" == \"myfile\"",+    takeBaseName "./myfile.txt" == "myfile") :+  ("takeBaseName \"myfile.txt\" == \"myfile\"",+    takeBaseName "myfile.txt" == "myfile") :+  ("takeExtension x == snd (splitExtension x)",+    takeExtension x == snd (splitExtension x)) :+  ("takeExtension (addExtension x \"ext\") == \".ext\"",+    takeExtension (addExtension x "ext") == ".ext") :+  ("takeExtension (replaceExtension x \"ext\") == \".ext\"",+    takeExtension (replaceExtension x "ext") == ".ext") :+  ("takeExtensions \"file.tar.gz\" == \".tar.gz\"",+    takeExtensions "file.tar.gz" == ".tar.gz") :+  ("takeFileName \"/tmp/somedir/myfile.txt\" == \"myfile.txt\"",+    takeFileName "/tmp/somedir/myfile.txt" == "myfile.txt") :+  ("takeFileName \"./myfile.txt\" == \"myfile.txt\"",+    takeFileName "./myfile.txt" == "myfile.txt") :+  ("takeFileName \"myfile.txt\" == \"myfile.txt\"",+    takeFileName "myfile.txt" == "myfile.txt") :+  ("equalFilePath \"/tmp/\" \"/tmp\" == True",+    equalFilePath "/tmp/" "/tmp" == True) :+  ("equalFilePath \"/tmp\"  \"tmp\"  == False",+    equalFilePath "/tmp"  "tmp"  == False) :+  ("joinPath [\"/tmp\",\"someDir\",\"file.txt\"] == \"/tmp/someDir/file.txt\"",+    joinPath ["/tmp","someDir","file.txt"] == "/tmp/someDir/file.txt") :+  ("(joinPath [\"/tmp\",\"someDir\",\"file.txt\"] :: RelFile) == \"tmp/someDir/file.txt\"",+    (joinPath ["/tmp","someDir","file.txt"] :: RelFile) == "tmp/someDir/file.txt") :+  ("normalise \"/tmp/fred/./jim/./file\" == \"/tmp/fred/jim/file\"",+    normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file") :+  ("splitPath (\"/tmp/someDir/myfile.txt\" :: AbsDir)  == ([\"tmp\",\"someDir\",\"myfile.txt\"],Nothing)",+    splitPath ("/tmp/someDir/myfile.txt" :: AbsDir)  == (["tmp","someDir","myfile.txt"],Nothing)) :+  ("splitPath (\"/tmp/someDir/myfile.txt\" :: AbsFile) == ([\"tmp\",\"someDir\"],Just \"myfile.txt\")",+    splitPath ("/tmp/someDir/myfile.txt" :: AbsFile) == (["tmp","someDir"],Just "myfile.txt")) :+  ("splitPath (asAbsFile \"/tmp/someDir/myfile.txt\")  == ([\"tmp\",\"someDir\"],Just \"myfile.txt\")",+    splitPath (asAbsFile "/tmp/someDir/myfile.txt")  == (["tmp","someDir"],Just "myfile.txt")) :+  ("makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/file.txt\" == \"anotherdir/file.txt\"",+    makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == "anotherdir/file.txt") :+  ("makeAbsolute \"/tmp\" \"file.txt\"      == \"/tmp/file.txt\"",+    makeAbsolute "/tmp" "file.txt"      == "/tmp/file.txt") :+  ("makeAbsolute \"/tmp\" \"adir/file.txt\" == \"/tmp/adir/file.txt\"",+    makeAbsolute "/tmp" "adir/file.txt" == "/tmp/adir/file.txt") :+  ("genericMakeAbsolute \"/tmp\" (asRelFile \"file.txt\")       == \"/tmp/file.txt\"",+    genericMakeAbsolute "/tmp" (asRelFile "file.txt")       == "/tmp/file.txt") :+  ("genericMakeAbsolute \"/tmp\" (asRelFile \"adir/file.txt\")  == \"/tmp/adir/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 \"/tmp\" (asAbsFile \"/adir/file.txt\") == \"/adir/file.txt\"",+    genericMakeAbsolute "/tmp" (asAbsFile "/adir/file.txt") == "/adir/file.txt") :+  ("isAbsolute (asAbsFile \"fred\")  == True",+    isAbsolute (asAbsFile "fred")  == True) :+  ("isAbsolute (asRelFile \"fred\")  == False",+    isAbsolute (asRelFile "fred")  == False) :+  ("isAbsolute (asAbsFile \"/fred\") == True",+    isAbsolute (asAbsFile "/fred") == True) :+  ("isAbsolute (asRelFile \"/fred\") == False",+    isAbsolute (asRelFile "/fred") == False) :+  ("null (takeExtension x) == not (hasAnExtension x)",+    null (takeExtension x) == not (hasAnExtension x)) :+  ("hasExtension \".hs\" \"MyCode.hs\" == True",+    hasExtension ".hs" "MyCode.hs" == True) :+  ("hasExtension \".hs\" \"MyCode.hs.bak\" == False",+    hasExtension ".hs" "MyCode.hs.bak" == False) :+  ("hasExtension \".hs\" \"MyCode.bak.hs\" == True",+    hasExtension ".hs" "MyCode.bak.hs" == True) :+  ("extSeparator == '.'",+    extSeparator == '.') :+  ("isPathSeparator pathSeparator",+    isPathSeparator pathSeparator) :+  ("pathSeparator `elem` pathSeparators",+    pathSeparator `elem` pathSeparators) :+  ("isExtSeparator a == (a == extSeparator)",+    isExtSeparator a == (a == extSeparator)) :+  ("isPathSeparator a == (a `elem` pathSeparators)",+    isPathSeparator a == (a `elem` pathSeparators)) :+  ("isSearchPathSeparator a == (a == searchPathSeparator)",+    isSearchPathSeparator a == (a == searchPathSeparator)) :+  ("genericAddExtension \"/\" \"x\" == \"/.x\"",+    genericAddExtension "/" "x" == "/.x") :+  []

@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+module TestResult (results) where++import System.Path+import Data.Char (toLower)+++results :: Char -> System.Path.FilePath ar -> [(String, Bool)]+results a x =+  <TESTS_GO_HERE>+  []

@@ -0,0 +1,31 @@+module Main where++import Control.Applicative ((<$>))+import Data.List (stripPrefix, isInfixOf)+import Data.Maybe (mapMaybe)++import Text.Printf (printf)+++srcfiles :: [String]+template, testModule, tok, testPrefix :: String++srcfiles   =+   map ("src/System/Path/" ++) $+   ["Internal.hs", "Directory.hs", "IO.hs"]+template   = "test/TestTemplate.hs"+testModule = "test/TestResult.hs"+tok        = "<TESTS_GO_HERE>"+testPrefix = "-- >> "++main :: IO ()+main = do+  testLines <-+     mapMaybe (stripPrefix testPrefix) . concatMap lines <$> mapM readFile srcfiles+  (templateHead,_:templateTail) <-+     break (tok `isInfixOf`) . lines <$> readFile template+  let outLines = (\t -> printf "  (%s,\n    %s) :" (show t) t) <$> testLines++  writeFile testModule $ unlines $+     ("{- Do not edit! Created from " ++ template ++ " -}") :+     templateHead ++ outLines ++ templateTail