diff --git a/pathtype.cabal b/pathtype.cabal --- a/pathtype.cabal +++ b/pathtype.cabal @@ -1,87 +1,204 @@ Name: pathtype -Version: 0.6 +Version: 0.7 Synopsis: Type-safe replacement for System.FilePath etc -Description: This package provides type-safe access to filepath manipulations. - . - "System.Path" is designed to be used instead of "System.FilePath". - (It is intended to provide versions of functions from that - module which have equivalent functionality but are more - typesafe). "System.Path.Directory" is a companion module - providing a type-safe alternative to "System.Directory". - . - The heart of this module is the @'Path' ar fd@ abstract type which - represents file and directory paths. The idea is that there are - two phantom type parameters - the first should be 'Abs' or 'Rel', - and the second 'File' or 'Dir'. A number of type synonyms are - provided for common types: - . - > type AbsFile = Path Abs File - > type RelFile = Path Rel File - > type AbsDir = Path Abs Dir - > type RelDir = Path Rel Dir - > - > type 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. - . - Related packages: - . - * @path@: Provides a wrapper type around 'FilePath' - and maps to functions from @filepath@ package. - This warrants consistency with @filepath@ functions. - Requires Template Haskell. - . - * @data-filepath@: - Requires 'Typeable' and Template Haskell. +Description: + This package provides type-safe access to filepath manipulations. + . + "System.Path" is designed to be used instead of "System.FilePath". + (It is intended to provide versions of functions from that + module which have equivalent functionality but are more + typesafe). "System.Path.Directory" is a companion module + providing a type-safe alternative to "System.Directory". + . + The heart of this module is the @'Path' ar fd@ abstract type which + represents file and directory paths. The idea is that there are + two 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. + . + You can use the construction functions as follows: + . + > f :: Path.RelFile + > f = relDir "tmp" relFile "someFile" <.> "ext" + . + or... + . + > f :: Path.RelFile + > f = dirPath "tmp" filePath "someFile" <.> "ext" + . + or... + . + > f :: Path.RelFile + > f = path "tmp" path "someFile" <.> "ext" + . + or just... + . + > f :: Path.RelFile + > f = relFile "tmp/someFile.ext" + . + The first and the last implementations force the most specific types + and thus should be prefered. + . + Overloaded string literals are no longer supported, + since this extension is intended for alternative text storage types. + It would also decrease the type safety + if you could omit the path type and let the compiler guess its type. + . + You will typically want to import as follows: + . + > import qualified System.Path.Directory as Dir + > import qualified System.Path.IO as PathIO + > import qualified System.Path as Path + > import System.Path (()) + . + "System.Path.Generic" provides all functions with the OS as type parameter. + "System.Path.Posix" and "System.Path.Windows" + offers only path constructors and destructors + fixed to the corresponding operating system. + "System.Path" exports either "System.Path.Posix" or "System.Path.Windows" + depending on the host system + and additionally the manipulation functions from "System.Path.Generic". + This mix should be appropriate for the average use + and should free the user from writing type annotations. + . + The basic API (and properties satisfied) are heavily influenced + by Neil Mitchell's "System.FilePath" module. + . + . + Some notes on how to choose proper type parameters: + . + The @ar@ and the @fd@ type parameters have quite different meaning. + The types @Abs@ and @Rel@ refer to a property of the path, + whereas the type @File@ and @Dir@ refers to a property of a disk object. + You can decide whether a path is absolute or relative + by just watching (the beginning of) the path string. + In contrast to that, you have to access the disk + in order to check the existence and type of an disk object. + Even more, the disk object might change at any time, + e.g. the user might delete a file and create a directory of the same name, + or the disk object might not exist, + and the purpose of the path is to create an according file or directory. + That's why even if you have a path of type @FilePath ar@, + every function accessing the file must check + that the refered object exists and is a file. + Conversely, there is not much sense in checking the disk object type + and then chosing the path accordingly. + Instead, you must choose the path type according + to what type of disk object your application needs. + The reality check must be performed + and is performed by the standard functions + for every access to the object. + If an disk object is not of the type required by the path type + then this is a runtime exception that must be handled at runtime + but it is not a programming error. + . + Sometimes you have to change the type of a path + as an intermediate step to construct a path for an object of different type. + E.g. you may convert the path \"pkg\" from @DirPath@ to @FilePath@ + because in the next step you like to extend it to \"pkg.tar.gz\". + This is valid use of the @Path@ type. + E.g. the function @dropExtensions@ + reduces the @FilePath@ \"pkg.tar.gz\" to the new @FilePath@ \"pkg\" + although no-one expects that there is or will be a file with name \"pkg\". + Thus, if a function has a @FilePath@ parameter + then there is no warranty that it accesses the according file + and does not touch related disk objects. + It may well be that the function derives other file and directory names + from the path and accesses them. + That is, a @FilePath@ or @DirPath@ parameter + is mainly for documentation purposes + but it cannot prevent you seriously from any damage. + . + How to cope with user input? + You may get a path from the user, e.g. as command-line argument. + It might be either absolute or relative + and it might refer to an actual file or directory or + to something yet non-existing. + In most cases it will not be important + whether the path is absolute or relative, + thus you should choose the @AbsOrRel@ type parameter. + If somewhere in the program an @Abs@ path is needed + then you can assert that the path is actually absolutized somewhere + e.g. by @dynamicMakeAbsolute@. + If you prevent usage of @genericMakeAbsolute@ + then you avoid to absolutize a path that is already absolutized. + . + The choice of the @fd@ type parameter follows a different reasoning: + Often you have a clear idea of + whether the user must pass a file or directory path. + The rule is: Just give the path the type you expect + but do not perform any checking + (unless you want to warn the user earlier about imminent danger). + The disk object type must checked for every access to the object, anyway, + so there is no point in checking it immediately. + With your choice of the @fd@ parameter + you just document its intended use. + . + It might be that the path is only a base name + used to construct other directory and file names. + E.g. for an Audacity project named @music@ + you have to create the directory @music_data@ and the file @music.aup@. + In this case we recommend to give @music@ the type @FilePath@. + This type warrants that there is at least one final path component + in contrast to a directory path that might be empty. + You can easily convert a file path to a directory path + using @Path.dirFromFile@. + The reverse conversion is partial. + . + . + Some notes on file system links: + . + This package does not explicitly handle file system links. + We treat a file path containing links like any other file path. + The same holds for directory paths. + A link is handled like any other path component. + . + . + Some notes on drive-relative paths on Windows: + . + We use the @Rel@ type for paths that can be relative to any directory. + We use the @Abs@ type for all other paths, + i.e. for paths with explicit locations or + with restrictions on the set of locations. + Windows has a notion of drives and + maintains a current directory for every drive. + E.g. the path @\"c:text.txt\"@ refers to the current directory of drive @C@. + Since it cannot be freely combined with other directories + we treat this path like an absolute path. + This is consistent with the behaviour of the @filepath@ package. + E.g. @filepath@ evaluates all of the expressions + @\"\\\\abs\" \<\/\> \"c:driverel\"@, @\"c:\\\\abs\" \<\/\> \"c:driverel\"@, + @\"d:\\\\abs\" \<\/\> \"c:driverel\"@ to @\"c:driverel\"@. + In our package you would have to use @genericMakeAbsolute@ + but we recommend to avoid its use. + . + Related packages: + . + * @path@: Provides a wrapper type around 'FilePath' + and maps to functions from @filepath@ package. + This warrants consistency with @filepath@ functions. + Requires Template Haskell. + . + * @data-filepath@: + Requires 'Typeable' and Template Haskell. Stability: experimental License: BSD3 Category: System @@ -93,7 +210,8 @@ Cabal-Version: >=1.8 Extra-Source-Files: test/TestTemplate.hs - src/System/Path/Internal.hs + posix/System/Path/Host.hs + windows/System/Path/Host.hs directory/pre-1.2/System/Path/ModificationTime.hs directory/post-incl-1.2/System/Path/ModificationTime.hs @@ -102,7 +220,7 @@ Location: http://hub.darcs.net/thielema/pathtype/ Source-Repository this - Tag: 0.6 + Tag: 0.7 Type: darcs Location: http://hub.darcs.net/thielema/pathtype/ @@ -116,9 +234,12 @@ Library Build-Depends: + utility-ht >=0.0.11 && <0.1, QuickCheck >= 2.1.0.1 && < 3, deepseq >= 1.3 && <1.5, time >= 1.0 && < 2, + transformers >=0.3 && <0.5, + tagged >=0.7 && <0.9, base >= 4 && < 5 If flag(old-time) @@ -129,13 +250,21 @@ Hs-Source-Dirs: directory/post-incl-1.2 Hs-Source-Dirs: src + If os(windows) + Hs-Source-Dirs: windows + Else + Hs-Source-Dirs: posix Exposed-Modules: System.Path + System.Path.Generic System.Path.Directory System.Path.IO System.Path.Posix System.Path.Windows Other-Modules: + System.Path.Host + System.Path.Internal + System.Path.RegularExpression System.Path.ModificationTime GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind @@ -156,9 +285,10 @@ Executable create-pathtype-test If flag(buildTools) Build-Depends: + utility-ht >=0.0.12 && <0.1, base Else - Buildable: True + Buildable: False Main-Is: CreateTest.hs Hs-Source-Dirs: tool diff --git a/posix/System/Path/Host.hs b/posix/System/Path/Host.hs new file mode 100644 --- /dev/null +++ b/posix/System/Path/Host.hs @@ -0,0 +1,2 @@ +module System.Path.Host (module System.Path.Posix) where +import System.Path.Posix diff --git a/src/System/Path.hs b/src/System/Path.hs --- a/src/System/Path.hs +++ b/src/System/Path.hs @@ -1,86 +1,22 @@ -{-# 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 - +module System.Path ( + module System.Path.Host, + module System.Path.Generic, + ) where +import System.Path.Host +import System.Path.Generic hiding ( + System, Path, + AbsFile, RelFile, AbsDir, RelDir, + AbsPath, RelPath, FilePath, DirPath, + AbsOrRelFile, AbsOrRelDir, AbsFileOrDir, RelFileOrDir, + AbsOrRelPath, FileOrDirPath, AbsOrRelFileOrDir, + asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath, + isAbsoluteString, isRelativeString, equalFilePath, + path, maybePath, + relFile, relDir, absFile, absDir, + relPath, absPath, filePath, dirPath, + rootDir, currentDir, emptyFile, + toString, + ) diff --git a/src/System/Path/Directory.hs b/src/System/Path/Directory.hs --- a/src/System/Path/Directory.hs +++ b/src/System/Path/Directory.hs @@ -63,7 +63,13 @@ where -import System.Path +import qualified System.Path as Path +import System.Path ( + Path, AbsOrRelClass, FileOrDirClass, path, + AbsPath, AbsDir, AbsFile, RelPath, RelDir, RelFile, + DirPath, FilePath, absDir, (), + ) + import System.Path.ModificationTime (convertTime) import Data.Time (UTCTime) @@ -73,6 +79,7 @@ import Control.Applicative ((<$>)) import Data.List (partition) +import Data.Tuple.HT (mapPair) import Prelude hiding (FilePath) @@ -80,32 +87,37 @@ ------------------------------------------------------------------------ -- Actions on directories -createDirectory :: AbsRelClass ar => DirPath ar -> IO () -createDirectory = SD.createDirectory . getPathString +createDirectory :: AbsOrRelClass ar => DirPath ar -> IO () +createDirectory = SD.createDirectory . Path.toString -createDirectoryIfMissing :: AbsRelClass ar => Bool -> DirPath ar -> IO () -createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . getPathString +createDirectoryIfMissing :: AbsOrRelClass ar => Bool -> DirPath ar -> IO () +createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . Path.toString -removeDirectory :: AbsRelClass ar => DirPath ar -> IO () -removeDirectory = SD.removeDirectory . getPathString +removeDirectory :: AbsOrRelClass ar => DirPath ar -> IO () +removeDirectory = SD.removeDirectory . Path.toString -removeDirectoryRecursive :: AbsRelClass ar => DirPath ar -> IO () -removeDirectoryRecursive = SD.removeDirectoryRecursive . getPathString +removeDirectoryRecursive :: AbsOrRelClass ar => DirPath ar -> IO () +removeDirectoryRecursive = SD.removeDirectoryRecursive . Path.toString -renameDirectory :: (AbsRelClass ar1, AbsRelClass ar2) => DirPath ar1 -> DirPath ar2 -> IO () -renameDirectory p1 p2 = SD.renameDirectory (getPathString p1) (getPathString p2) +renameDirectory :: + (AbsOrRelClass ar1, AbsOrRelClass ar2) => DirPath ar1 -> DirPath ar2 -> IO () +renameDirectory p1 p2 = + SD.renameDirectory (Path.toString p1) (Path.toString p2) --- | An alias for 'relDirectoryContents'. -getDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile]) -getDirectoryContents = relDirectoryContents +-- | Retrieve the contents of a directory without any directory prefixes. +-- In contrast to 'System.Directory.getDirectoryContents', +-- exclude special directories \".\" and \"..\". +getDirectoryContents :: AbsOrRelClass ar => DirPath ar -> IO [Path.RelFileOrDir] +getDirectoryContents dir = + map Path.path <$> plainDirectoryContents dir -- | Retrieve the contents of a directory path (which may be relative) as absolute paths -absDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile]) +absDirectoryContents :: + AbsOrRelClass 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) + cd <- absDir <$> SD.getCurrentDirectory + let dir = Path.absRel id (cd ) p + mapPair (map (dir ), map (dir )) <$> relDirectoryContents dir -- | Returns paths relative /to/ the supplied (abs or relative) directory path. -- eg (for current working directory of @\/somewhere\/cwd\/@): @@ -113,97 +125,105 @@ -- > show (relDirectoryContents "d/e/f/") == (["subDir1A","subDir1B"], -- > ["file1A","file1B"]) -- -relDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile]) +relDirectoryContents :: + AbsOrRelClass 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) + filenames <- plainDirectoryContents dir + mapPair (map (Path.relDir . fst), map (Path.relFile . fst)) . + partition snd . zip filenames + <$> mapM (doesDirectoryExist . (dir ) . Path.relPath) filenames +plainDirectoryContents :: AbsOrRelClass ar => DirPath ar -> IO [String] +plainDirectoryContents dir = + filter (not . flip elem [".",".."]) <$> + SD.getDirectoryContents (Path.toString dir) + -- | A convenient alternative to 'relDirectoryContents' if you only want files. -filesInDir :: AbsRelClass ar => DirPath ar -> IO [RelFile] +filesInDir :: AbsOrRelClass 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 :: AbsOrRelClass ar => DirPath ar -> IO [RelDir] dirsInDir dir = fst <$> relDirectoryContents dir getCurrentDirectory :: IO AbsDir -getCurrentDirectory = asAbsDir <$> SD.getCurrentDirectory +getCurrentDirectory = absDir <$> SD.getCurrentDirectory -setCurrentDirectory :: AbsRelClass ar => DirPath ar -> IO () -setCurrentDirectory = SD.setCurrentDirectory . getPathString +setCurrentDirectory :: AbsOrRelClass ar => DirPath ar -> IO () +setCurrentDirectory = SD.setCurrentDirectory . Path.toString ------------------------------------------------------------------------ -- Pre-defined directories getHomeDirectory :: IO AbsDir -getHomeDirectory = asAbsDir <$> SD.getHomeDirectory +getHomeDirectory = absDir <$> SD.getHomeDirectory getAppUserDataDirectory :: String -> IO AbsDir -getAppUserDataDirectory user = asAbsDir <$> SD.getAppUserDataDirectory user +getAppUserDataDirectory user = absDir <$> SD.getAppUserDataDirectory user getUserDocumentsDirectory :: IO AbsDir -getUserDocumentsDirectory = asAbsDir <$> SD.getUserDocumentsDirectory +getUserDocumentsDirectory = absDir <$> SD.getUserDocumentsDirectory getTemporaryDirectory :: IO AbsDir -getTemporaryDirectory = asAbsDir <$> SD.getTemporaryDirectory +getTemporaryDirectory = absDir <$> SD.getTemporaryDirectory ------------------------------------------------------------------------ -- Actions on files -removeFile :: AbsRelClass ar => FilePath ar -> IO () -removeFile = SD.removeFile . getPathString +removeFile :: AbsOrRelClass ar => FilePath ar -> IO () +removeFile = SD.removeFile . Path.toString -renameFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO () -renameFile p1 p2 = SD.renameFile (getPathString p1) (getPathString p2) +renameFile :: + (AbsOrRelClass ar1, AbsOrRelClass ar2) => + FilePath ar1 -> FilePath ar2 -> IO () +renameFile p1 p2 = SD.renameFile (Path.toString p1) (Path.toString p2) -copyFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO () -copyFile p1 p2 = SD.copyFile (getPathString p1) (getPathString p2) +copyFile :: + (AbsOrRelClass ar1, AbsOrRelClass ar2) => + FilePath ar1 -> FilePath ar2 -> IO () +copyFile p1 p2 = SD.copyFile (Path.toString p1) (Path.toString p2) canonicalizePath :: - (AbsRelClass ar, FileDirClass fd) => Path ar fd -> IO (AbsPath fd) -canonicalizePath p = asPath <$> SD.canonicalizePath (getPathString p) + (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> IO (AbsPath fd) +canonicalizePath p = path <$> SD.canonicalizePath (Path.toString p) makeRelativeToCurrentDirectory :: - (AbsRelClass ar, FileDirClass fd) => Path ar fd -> IO (RelPath fd) + (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> IO (RelPath fd) makeRelativeToCurrentDirectory p = - asPath <$> SD.makeRelativeToCurrentDirectory (getPathString p) + path <$> SD.makeRelativeToCurrentDirectory (Path.toString p) findExecutable :: String -> IO (Maybe AbsFile) -findExecutable s = fmap asPath <$> SD.findExecutable s +findExecutable s = fmap path <$> SD.findExecutable s ------------------------------------------------------------------------ -- Existence tests -doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool -doesFileExist = SD.doesFileExist . getPathString +doesFileExist :: AbsOrRelClass ar => FilePath ar -> IO Bool +doesFileExist = SD.doesFileExist . Path.toString -doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool -doesDirectoryExist = SD.doesDirectoryExist . getPathString +doesDirectoryExist :: AbsOrRelClass ar => DirPath ar -> IO Bool +doesDirectoryExist = SD.doesDirectoryExist . Path.toString ------------------------------------------------------------------------ -- Permissions getPermissions :: - (AbsRelClass ar, FileDirClass fd) => Path ar fd -> IO Permissions -getPermissions p = SD.getPermissions (getPathString p) + (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> IO Permissions +getPermissions p = SD.getPermissions (Path.toString p) setPermissions :: - (AbsRelClass ar, FileDirClass fd) => Path ar fd -> Permissions -> IO () -setPermissions p perms = SD.setPermissions (getPathString p) perms + (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> Permissions -> IO () +setPermissions p perms = SD.setPermissions (Path.toString p) perms ------------------------------------------------------------------------ -- Timestamps getModificationTime :: - (AbsRelClass ar, FileDirClass fd) => Path ar fd -> IO UTCTime -getModificationTime p = convertTime <$> SD.getModificationTime (getPathString p) + (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> IO UTCTime +getModificationTime p = convertTime <$> SD.getModificationTime (Path.toString p) diff --git a/src/System/Path/Generic.hs b/src/System/Path/Generic.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Generic.hs @@ -0,0 +1,22 @@ +{- | +This module provides type-safe access to filepath manipulations +independent from the operating system. + +Normally you would import 'System.Path' +since this contains types fixed to your host system +and otherwise generic functions. +However, importing this explicitly +allows for manipulation of non-native paths. +-} +module System.Path.Generic ( + module System.Path.Internal, + Core.System, + ) where + +import qualified System.Path.Internal as Core +import System.Path.Internal hiding ( + System(..), + extSeparator, isExtSeparator, + searchPathSeparator, isSearchPathSeparator, + testAll, + ) diff --git a/src/System/Path/IO.hs b/src/System/Path/IO.hs --- a/src/System/Path/IO.hs +++ b/src/System/Path/IO.hs @@ -90,13 +90,14 @@ where -import System.Path +import qualified System.Path as Path +import System.Path (AbsOrRelClass, DirPath, FilePath, AbsFile, RelFile) import qualified System.IO as SIO import System.IO (IOMode, Handle) -import Control.Arrow (first) import Control.Applicative ((<$>)) +import Data.Tuple.HT (mapFst) import Prelude hiding (FilePath, readFile, writeFile, appendFile) @@ -104,29 +105,37 @@ ------------------------------------------------------------------------ -- Covers for System.IO functions -withFile :: AbsRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r -withFile f = SIO.withFile (getPathString f) +withFile :: + AbsOrRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r +withFile f = SIO.withFile (Path.toString f) -openFile :: AbsRelClass ar => FilePath ar -> IOMode -> IO Handle -openFile f = SIO.openFile (getPathString f) +openFile :: AbsOrRelClass ar => FilePath ar -> IOMode -> IO Handle +openFile f = SIO.openFile (Path.toString f) -readFile :: AbsRelClass ar => FilePath ar -> IO String -readFile f = SIO.readFile (getPathString f) +readFile :: AbsOrRelClass ar => FilePath ar -> IO String +readFile f = SIO.readFile (Path.toString f) -writeFile :: AbsRelClass ar => FilePath ar -> String -> IO () -writeFile f = SIO.writeFile (getPathString f) +writeFile :: AbsOrRelClass ar => FilePath ar -> String -> IO () +writeFile f = SIO.writeFile (Path.toString f) -appendFile :: AbsRelClass ar => FilePath ar -> String -> IO () -appendFile f = SIO.appendFile (getPathString f) +appendFile :: AbsOrRelClass ar => FilePath ar -> String -> IO () +appendFile f = SIO.appendFile (Path.toString f) -withBinaryFile :: AbsRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile f = SIO.withBinaryFile (getPathString f) +withBinaryFile :: + AbsOrRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile f = SIO.withBinaryFile (Path.toString f) -openBinaryFile :: AbsRelClass ar => FilePath ar -> IOMode -> IO Handle -openBinaryFile f = SIO.openBinaryFile (getPathString f) +openBinaryFile :: AbsOrRelClass ar => FilePath ar -> IOMode -> IO Handle +openBinaryFile f = SIO.openBinaryFile (Path.toString f) -openTempFile :: AbsRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle) -openTempFile f template = first asAbsFile <$> SIO.openTempFile (getPathString f) (getPathString template) +openTempFile :: + AbsOrRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle) +openTempFile f template = + mapFst Path.absFile <$> + SIO.openTempFile (Path.toString f) (Path.toString template) -openBinaryTempFile :: AbsRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle) -openBinaryTempFile f template = first asAbsFile <$> SIO.openBinaryTempFile (getPathString f) (getPathString template) +openBinaryTempFile :: + AbsOrRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle) +openBinaryTempFile f template = + mapFst Path.absFile <$> + SIO.openBinaryTempFile (Path.toString f) (Path.toString template) diff --git a/src/System/Path/Internal.hs b/src/System/Path/Internal.hs --- a/src/System/Path/Internal.hs +++ b/src/System/Path/Internal.hs @@ -1,1211 +1,1833 @@ - --- LANGUAGE pragmas need to go in System.Path.[Windows|Posix] -module System.Path.MODULE_NAME -( - -- * The main filepath (& dirpath) abstract type - Path, -- kept abstract - - -- * Phantom Types - Abs, - Rel, - File, - Dir, - - -- * Type Synonyms - AbsFile, - RelFile, - AbsDir, - RelDir, - AbsPath, - RelPath, - FilePath, - DirPath, - - -- * Classes - AbsRelClass(..), - FileDirClass(..), - - -- * Path to String conversion - getPathString, - - -- * Constants - rootDir, - currentDir, - - -- * Unchecked Construction Functions - asPath, - asRelFile, - asRelDir, - asAbsFile, - asAbsDir, - asRelPath, - asAbsPath, - asFilePath, - asDirPath, - - -- * Checked Construction Functions - mkPathAbsOrRel, - mkPathFileOrDir, - mkAbsPath, - mkAbsPathFromCwd, - - -- * Basic Manipulation Functions - (), - (<.>), - addExtension, - combine, - dropExtension, - dropExtensions, - dropFileName, - replaceExtension, - replaceBaseName, - replaceDirectory, - replaceFileName, - splitExtension, - splitExtensions, - splitFileName, - takeBaseName, - takeDirectory, - takeExtension, - takeExtensions, - takeFileName, - - -- * Auxillary Manipulation Functions - equalFilePath, - joinPath, - normalise, - splitPath, - makeRelative, - makeAbsolute, - makeAbsoluteFromCwd, - genericMakeAbsolute, - genericMakeAbsoluteFromCwd, - pathMap, - - -- * Path Predicates - isAbsolute, - isAbsoluteString, - isRelative, - isRelativeString, - hasAnExtension, - hasExtension, - - -- * Separators - addTrailingPathSeparator, - dropTrailingPathSeparator, - extSeparator, - hasTrailingPathSeparator, - pathSeparator, - pathSeparators, - searchPathSeparator, - isExtSeparator, - isPathSeparator, - isSearchPathSeparator, - - -- * Generic Manipulation Functions - genericAddExtension, - genericDropExtension, - genericDropExtensions, - genericSplitExtension, - genericSplitExtensions, - genericTakeExtension, - genericTakeExtensions -) - -where - -import qualified System.Directory as SD - -import Control.Arrow (first, second, (|||), (***)) -import Control.Monad (guard, mplus) -import Control.Applicative ((<$>)) -import Control.DeepSeq (NFData(rnf)) -import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intersperse) -import Data.String (IsString(fromString)) -import Data.Maybe (fromMaybe, maybeToList) -import Data.Char (toLower, isAlpha, isSpace) - -import Text.Printf (printf) - -import qualified Test.QuickCheck as QC -import Test.QuickCheck - (Gen, Property, property, Arbitrary(arbitrary), - oneof, frequency, quickCheck) - -import Prelude hiding (FilePath) - - ------------------------------------------------------------------------- --- Types - -newtype Abs = Abs String deriving (Eq, Ord) -data Rel = Rel deriving (Eq, Ord) - -newtype File = File PathComponent deriving (Eq, Ord) -data Dir = Dir deriving (Eq, Ord) - --- | This is the main filepath abstract datatype -data Path ar fd = Path ar [PathComponent] fd - -instance (AbsRelClass ar, FileDirClass fd) => Eq (Path ar fd) where - Path ar0 pcs0 fd0 == Path ar1 pcs1 fd1 = - (WrapAbsRel ar0, pcs0, WrapFileDir fd0) - == - (WrapAbsRel ar1, pcs1, WrapFileDir fd1) - -instance (AbsRelClass ar, FileDirClass fd) => Ord (Path ar fd) where - compare (Path ar0 pcs0 fd0) (Path ar1 pcs1 fd1) = - compare - (WrapAbsRel ar0, pcs0, WrapFileDir fd0) - (WrapAbsRel ar1, pcs1, WrapFileDir fd1) - - -newtype WrapAbsRel ar = WrapAbsRel {unwrapAbsRel :: ar} - -instance (AbsRelClass ar) => Eq (WrapAbsRel ar) where - (==) = switchRelation switchAbsRel unwrapAbsRel (==) (==) - -instance (AbsRelClass ar) => Ord (WrapAbsRel ar) where - compare = switchRelation switchAbsRel unwrapAbsRel compare compare - - -newtype WrapFileDir fd = WrapFileDir {unwrapFileDir :: fd} - -instance (FileDirClass fd) => Eq (WrapFileDir fd) where - (==) = switchRelation switchFileDir unwrapFileDir (==) (==) - -instance (FileDirClass fd) => Ord (WrapFileDir fd) where - compare = switchRelation switchFileDir unwrapFileDir compare compare - - -newtype Relation res a = Relation {runRelation :: a -> a -> res} - -switchRelation :: - (Relation res a -> Relation res b -> Relation res c) -> - (wrapped -> c) -> - (a -> a -> res) -> - (b -> b -> res) -> - wrapped -> wrapped -> res -switchRelation switch unwrap fFile fDir ar0 ar1 = - runRelation - (switch (Relation fFile) (Relation fDir)) - (unwrap ar0) (unwrap ar1) - - -newtype PathComponent = PathComponent String - -instance Eq PathComponent where - PathComponent x == PathComponent y = - if isPosix - then x==y - else map toLower x == map toLower y - -instance Ord PathComponent where - compare (PathComponent x) (PathComponent y) = - if isPosix - then compare x y - else compare (map toLower x) (map toLower y) - - -type AbsFile = Path Abs File -type RelFile = Path Rel File -type AbsDir = Path Abs Dir -type RelDir = Path Rel Dir - -type AbsPath fd = Path Abs fd -type RelPath fd = Path Rel fd -type FilePath ar = Path ar File -type DirPath ar = Path ar Dir - -instance NFData PathComponent where - rnf (PathComponent pc) = rnf pc - -instance NFData Abs where - rnf (Abs drive) = rnf drive - -instance NFData Rel where - rnf Rel = () - -instance NFData File where - rnf (File pc) = rnf pc - -instance NFData Dir where - rnf Dir = () - -instance (AbsRelClass ar, FileDirClass fd) => NFData (Path ar fd) where - rnf (Path ar pcs fd) = - rnf (absRelPlain rnf rnf ar, pcs, fileDirPlain rnf rnf fd) - -absRelPlain :: (AbsRelClass ar) => (Abs -> a) -> (Rel -> a) -> ar -> a -absRelPlain fAbs fRel = - runFuncArg $ switchAbsRel (FuncArg fAbs) (FuncArg fRel) - -fileDirPlain :: (FileDirClass fd) => (File -> a) -> (Dir -> a) -> fd -> a -fileDirPlain fFile fDir = - runFuncArg $ switchFileDir (FuncArg fFile) (FuncArg fDir) - -newtype FuncArg b a = FuncArg {runFuncArg :: a -> b} - --- I don't think this basic type of fold is appropriate for a nested datatype --- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a --- pathFold pr f PathRoot = pr --- pathFold pr f (FileDir d pc) = f (pathFold pr f d) (unPathComponent pc) - --- | Map over the components of the path. --- --- >> Posix.pathMap (map toLower) "/tmp/Reports/SpreadSheets" == Posix.asAbsDir "/tmp/reports/spreadsheets" -pathMap :: (FileDirClass fd) => (String -> String) -> Path ar fd -> Path ar fd -pathMap f (Path ar pcs fd) = Path ar (map (pcMap f) pcs) (fdMap f fd) - -newtype FDMap ar fd = FDMap {runFDMap :: fd -> fd} - -fdMap :: (FileDirClass fd) => (String -> String) -> fd -> fd -fdMap f = - runFDMap $ - switchFileDir (FDMap $ \(File pc) -> File $ pcMap f pc) (FDMap id) - -pcMap :: (String -> String) -> PathComponent -> PathComponent -pcMap f (PathComponent s) = PathComponent (f s) - - ------------------------------------------------------------------------- --- Type classes and machinery for switching on Abs/Rel and File/Dir - --- | This class provides a way to prevent other modules --- from making further 'AbsRelClass' or 'FileDirClass' --- instances -class Private p -instance Private Abs -instance Private Rel -instance Private File -instance Private Dir - --- | This class allows selective behaviour for absolute and --- relative paths and is mostly for internal use. -class Private ar => AbsRelClass ar where - -- | See - -- for the used technique. - switchAbsRel :: f Abs -> f Rel -> f ar - -- | Will become a top-level function in future - absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a - absRel f g = runAbsRel $ switchAbsRel (AbsRel f) (AbsRel g) - -newtype AbsRel fd a ar = AbsRel {runAbsRel :: Path ar fd -> a} - -instance AbsRelClass Abs where switchAbsRel f _g = f -instance AbsRelClass Rel where switchAbsRel _f g = g - --- | This class allows selective behaviour for file and --- directory paths and is mostly for internal use. -class Private fd => FileDirClass fd where - switchFileDir :: f File -> f Dir -> f fd - -- | Will become a top-level function in future - fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a - fileDir f g = runFileDir $ switchFileDir (FileDir f) (FileDir g) - -newtype FileDir ar a fd = FileDir {runFileDir :: Path ar fd -> a} - -instance FileDirClass File where switchFileDir f _g = f -instance FileDirClass Dir where switchFileDir _f g = g - - --- | Currently not exported -_pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd) -_pathAbsRel = absRel Left Right - --- | Currently not exported -_pathFileDir :: FileDirClass fd => Path ar fd -> Either (FilePath ar) (DirPath ar) -_pathFileDir = fileDir Left Right - ------------------------------------------------------------------------- --- Read & Show instances - --- >> show (Posix.rootDir "bla" Posix.asRelFile "blub") == "rootDir \"bla\" \"blub\"" --- >> show (Just (Posix.rootDir "bla" Posix.asRelFile "blub")) == "Just (rootDir \"bla\" \"blub\")" --- >> show (Posix.currentDir "bla" Posix.asRelFile "blub") == "currentDir \"bla\" \"blub\"" --- >> show (Just (Posix.currentDir "bla" Posix.asRelFile "blub")) == "Just (currentDir \"bla\" \"blub\")" --- >> show (Windows.asAbsDir "c:" Windows. "bla" Windows. Windows.asRelFile "blub") == "asAbsDir \"c:\" \"bla\" \"blub\"" --- >> show (Just (Windows.asAbsDir "c:\\" Windows. "bla" Windows. Windows.asRelFile "blub")) == "Just (asAbsDir \"c:\" \"bla\" \"blub\")" -instance (AbsRelClass ar, FileDirClass fd) => Show (Path ar fd) where - showsPrec d x = - case pathComponents x of - (ar, pcs) -> - showParen (d>9) $ - foldr (.) id $ - intersperse - (showChar ' ' . - showString combineOperator . showChar ' ') $ - absRelPlain - (\(Abs drive) -> - if null drive - then showString rootName - else showString absDirName . - showString drive . - showChar '"') - (const $ showString currentName) - ar : - map (\(PathComponent pc) -> shows pc) pcs - --- >> let path = Posix.rootDir "bla" Posix.asRelFile "blub" in read (show path) == path --- >> let path = Just (Posix.rootDir "bla" Posix.asRelFile "blub") in read (show path) == path --- >> let path = Posix.currentDir "bla" Posix.asRelFile "blub" in read (show path) == path --- >> let path = Just (Posix.currentDir "bla" Posix.asRelFile "blub") in read (show path) == path --- >> let path = Windows.rootDir Windows. "bla" Windows. Windows.asRelFile "blub" in read (show path) == path --- >> let path = Just (Windows.rootDir Windows. "bla" Windows. Windows.asRelFile "blub") in read (show path) == path -instance (AbsRelClass ar, FileDirClass fd) => Read (Path ar fd) where - readsPrec d = readParen (d>9) $ \str -> - let go :: ReadS [PathComponent] - go s0 = - case stripPrefix combineOperator $ dropWhile isSpace s0 of - Nothing -> [([], s0)] - Just s1 -> do - (pc, s2) <- reads s1 - (pcs, s3) <- go s2 - return (PathComponent pc : pcs, s3) - in do - (ar, s0) <- maybeToList $ readsSplitDrive $ dropWhile isSpace str - (pcs, s1) <- go s0 - path <- maybeToList $ maybePathFromComponents ar pcs - return (path, s1) - -newtype - ReadsSplitDrive ar = - ReadsSplitDrive {runReadsSplitDrive :: Maybe (ar, String)} - -readsSplitDrive :: (AbsRelClass ar) => String -> Maybe (ar, String) -readsSplitDrive str0 = - runReadsSplitDrive $ - switchAbsRel - (ReadsSplitDrive $ - (fmap ((,) (Abs "")) $ stripPrefix rootName str0) - `mplus` - do str1 <- stripPrefix absDirName str0 - (drive, '"':str2) <- Just $ break ('"'==) str1 - return (Abs drive, str2)) - (ReadsSplitDrive $ - fmap ((,) Rel) $ stripPrefix currentName str0) - --- | Convert the 'Path' into a plain 'String' as required for OS calls. -getPathString :: (AbsRelClass ar, FileDirClass fd) => Path ar fd -> String -getPathString = flip getPathStringS "" - -getPathStringS :: (AbsRelClass ar, FileDirClass fd) => Path ar fd -> ShowS -getPathStringS x = - case pathComponents x of - (ar, []) -> - absRelPlain - (\(Abs drive) -> showString drive . showChar pathSeparator) - (const $ showString currentDirComponent) ar - (ar, pcs) -> - foldr (.) id $ intersperse (showChar pathSeparator) $ - absRelPlain (\(Abs drive) -> (showString drive :)) (const id) ar $ - map (\(PathComponent pc) -> showString pc) pcs - -prop_asPath_getPathString :: AbsFile -> Property -prop_asPath_getPathString p = property $ p == asPath (getPathString p) - - ------------------------------------------------------------------------- --- Windows / Posix - -isPosix :: Bool -isPosix = not isWindows - -isWindows :: Bool -isWindows = IS_WINDOWS - ------------------------------------------------------------------------- --- Constants - -rootDir :: AbsDir -rootDir = Path (Abs "") [] Dir - -currentDir :: RelDir -currentDir = Path Rel [] Dir - -rootName :: String -rootName = "rootDir" - -currentName :: String -currentName = "currentDir" - -currentDirComponent :: String -currentDirComponent = "." - -absDirName :: String -absDirName = "asAbsDir \"" - ------------------------------------------------------------------------- --- Unchecked Construction Functions --- NB - these construction functions are non-IO and do no checking!! - --- | Use a 'String' as a 'Path' whose type is determined --- by its context. --- --- >> Posix.asPath "/tmp" == Posix.asAbsDir "/tmp" --- >> Posix.asPath "file.txt" == Posix.asRelFile "file.txt" --- >> Posix.isAbsolute (Posix.asAbsDir "/tmp") --- >> Posix.isRelative (Posix.asRelDir "/tmp") --- >> Posix.getPathString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" --- >> Posix.getPathString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" --- >> Windows.getPathString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" --- >> Windows.getPathString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" --- >> Windows.getPathString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp" -asPath :: (AbsRelClass ar, FileDirClass fd) => String -> Path ar fd -asPath = uncurry mkPathFromComponents . mkPathComponents - -newtype AbsRelDefault ar = AbsRelDefault {getAbsRelDefault :: ar} - -absRelDefault :: (AbsRelClass ar) => ar -absRelDefault = - getAbsRelDefault $ switchAbsRel (AbsRelDefault $ Abs "") (AbsRelDefault Rel) - - --- | Use a 'String' as a 'RelFile'. No checking is done. --- --- >> Posix.getPathString (Posix.asRelFile "file.txt") == "file.txt" --- >> Posix.getPathString (Posix.asRelFile "/file.txt") == "file.txt" --- >> Posix.getPathString (Posix.asRelFile "tmp") == "tmp" --- >> Posix.getPathString (Posix.asRelFile "/tmp") == "tmp" -asRelFile :: String -> RelFile -asRelFile = asPath - --- | Use a 'String' as a 'RelDir'. No checking is done. --- --- >> Posix.getPathString (Posix.asRelDir ".") == "." --- >> Posix.getPathString (Posix.asRelDir "file.txt") == "file.txt" --- >> Posix.getPathString (Posix.asRelDir "/file.txt") == "file.txt" --- >> Posix.getPathString (Posix.asRelDir "tmp") == "tmp" --- >> Posix.getPathString (Posix.asRelDir "/tmp") == "tmp" -asRelDir :: String -> RelDir -asRelDir = asPath - --- | Use a 'String' as an 'AbsFile'. No checking is done. --- --- >> Posix.getPathString (Posix.asAbsFile "file.txt") == "/file.txt" --- >> Posix.getPathString (Posix.asAbsFile "/file.txt") == "/file.txt" --- >> Posix.getPathString (Posix.asAbsFile "tmp") == "/tmp" --- >> Posix.getPathString (Posix.asAbsFile "/tmp") == "/tmp" -asAbsFile :: String -> AbsFile -asAbsFile = asPath - --- | Use a 'String' as an 'AbsDir'. No checking is done. --- --- >> Posix.getPathString (Posix.asAbsDir "file.txt") == "/file.txt" --- >> Posix.getPathString (Posix.asAbsDir "/file.txt") == "/file.txt" --- >> Posix.getPathString (Posix.asAbsDir "tmp") == "/tmp" --- >> Posix.getPathString (Posix.asAbsDir "/tmp") == "/tmp" -asAbsDir :: String -> AbsDir -asAbsDir = asPath - --- | Use a 'String' as a 'RelPath fd'. No checking is done. -asRelPath :: (FileDirClass fd) => String -> RelPath fd -asRelPath = asPath - --- | Use a 'String' as an 'AbsPath fd'. No checking is done. -asAbsPath :: (FileDirClass fd) => String -> AbsPath fd -asAbsPath = asPath - --- | Use a 'String' as a 'FilePath ar'. No checking is done. -asFilePath :: (AbsRelClass ar) => String -> FilePath ar -asFilePath = asPath - --- | Use a 'String' as a 'DirPath ar'. No checking is done. -asDirPath :: (AbsRelClass ar) => String -> DirPath ar -asDirPath = asPath - --- | Allow use of OverloadedStrings if desired -instance - (AbsRelClass ar, FileDirClass fd) => - IsString (Path ar fd) where fromString = asPath - ------------------------------------------------------------------------- --- Checked Construction Functions - --- | Examines the supplied string and constructs an absolute or --- relative path as appropriate. --- --- >> Posix.mkPathAbsOrRel "/tmp" == Left (Posix.asAbsDir "/tmp") --- >> Posix.mkPathAbsOrRel "tmp" == Right (Posix.asRelDir "tmp") --- >> Windows.mkPathAbsOrRel "\\tmp" == Left (Windows.asAbsDir "\\tmp") --- >> Windows.mkPathAbsOrRel "d:\\tmp" == Left (Windows.asAbsDir "d:\\tmp") --- >> Windows.mkPathAbsOrRel "tmp" == Right (Windows.asRelDir "tmp") -mkPathAbsOrRel :: - (FileDirClass fd) => String -> Either (AbsPath fd) (RelPath fd) -mkPathAbsOrRel s = - if isAbsoluteString s - then Left $ asAbsPath s - else Right $ asRelPath s - --- | Searches for a file or directory with the supplied path string --- and returns a 'File' or 'Dir' path as appropriate. If neither exists --- at the supplied path, 'Nothing' is returned. -mkPathFileOrDir :: - AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath ar))) -mkPathFileOrDir s = do - isfile <- SD.doesFileExist s - isdir <- SD.doesDirectoryExist s - case (isfile, isdir) of - (False, False) -> return Nothing - (True, False) -> return $ Just $ Left $ asPath s - (False, True ) -> return $ Just $ Right $ asPath s - (True, True ) -> ioError $ userError "mkPathFileOrDir - object type changed while checking" - --- | Convert a 'String' into an 'AbsPath' by interpreting it as --- relative to the supplied directory if necessary. --- --- >> Posix.mkAbsPath "/tmp" "foo.txt" == Posix.asAbsFile "/tmp/foo.txt" --- >> Posix.mkAbsPath "/tmp" "/etc/foo.txt" == Posix.asAbsFile "/etc/foo.txt" -mkAbsPath :: (FileDirClass fd) => AbsDir -> String -> AbsPath fd -mkAbsPath d = (id ||| makeAbsolute d) . mkPathAbsOrRel - --- | Convert a 'String' into an 'AbsPath' by interpreting it as --- relative to the cwd if necessary. -mkAbsPathFromCwd :: (FileDirClass fd) => String -> IO (AbsPath fd) -mkAbsPathFromCwd = (return ||| makeAbsoluteFromCwd) . mkPathAbsOrRel - - ------------------------------------------------------------------------- --- Internal Functions for PathComponent manipulation - -mkPathFromComponents :: (FileDirClass fd) => ar -> [PathComponent] -> Path ar fd -mkPathFromComponents ar pcs = - switchFileDir - (fromMaybe (Path ar [] $ File $ PathComponent "") $ - mkFilePathFromComponents ar pcs) - (mkDirPathFromComponents ar pcs) - -maybePathFromComponents :: - (FileDirClass fd) => ar -> [PathComponent] -> Maybe (Path ar fd) -maybePathFromComponents ar pcs = - getFunctorPath $ - switchFileDir - (FunctorPath $ mkFilePathFromComponents ar pcs) - (FunctorPath $ Just $ mkDirPathFromComponents ar pcs) - -newtype - FunctorPath f ar fd = - FunctorPath {getFunctorPath :: f (Path ar fd)} - -mkDirPathFromComponents :: ar -> [PathComponent] -> Path ar Dir -mkDirPathFromComponents ar pcs = Path ar pcs Dir - -mkFilePathFromComponents :: ar -> [PathComponent] -> Maybe (Path ar File) -mkFilePathFromComponents _ [] = Nothing -mkFilePathFromComponents ar0 (q:qs) = - let mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd - go p [] = Path ar0 [] (File p) - go p0 (p1:ps) = mapPathDirs (p0:) $ go p1 ps - in Just $ go q qs - -mkPathComponents :: (AbsRelClass ar) => String -> (ar, [PathComponent]) -mkPathComponents = - let go xs = - case break isPathSeparator $ dropWhile isPathSeparator xs of - ("","") -> [] - (s,rest) -> s : go rest - split [] = (absRelDefault, []) - split (pc:pcs) = - second (map PathComponent) $ - case splitDrive pc of - (drive, "") -> (drive, pcs) - (drive, pc0) -> (drive, pc0:pcs) - in split . go - -newtype SplitDrive ar = SplitDrive {runSplitDrive :: (ar, String)} - -splitDrive :: (AbsRelClass ar) => String -> (ar, String) -splitDrive str = - runSplitDrive $ - switchAbsRel - (SplitDrive $ first Abs $ - if isPosix - then ("", str) - else - case break (':'==) str of - (drive, ':':rest) -> (drive++":", rest) - _ -> ("", str)) - (SplitDrive (Rel, str)) - -pathComponents :: (FileDirClass fd) => Path ar fd -> (ar, [PathComponent]) -pathComponents (Path ar pcs fd) = (ar, pcs ++ fileDirComponent fd) - -fileDirComponent :: (FileDirClass fd) => fd -> [PathComponent] -fileDirComponent = fileDirPlain (\(File pc) -> [pc]) (\Dir -> []) - -prop_mkPathFromComponents_pathComponents :: AbsDir -> Property -prop_mkPathFromComponents_pathComponents p = - property $ uncurry mkPathFromComponents (pathComponents p) == p - - - ------------------------------------------------------------------------- --- Basic Manipulation Functions - -combineOperator :: String -combineOperator = "" - --- | Infix variant of 'combine'. --- --- >> Posix.getPathString (Posix.asAbsDir "/tmp" Posix.asRelFile "file.txt") == "/tmp/file.txt" --- >> Posix.getPathString (Posix.asAbsDir "/tmp" Posix.asRelDir "dir" Posix.asRelFile "file.txt") == "/tmp/dir/file.txt" --- >> Posix.getPathString (Posix.asRelDir "dir" Posix.asRelFile "file.txt") == "dir/file.txt" --- >> Windows.getPathString (Windows.asAbsDir "\\tmp" Windows. Windows.asRelFile "file.txt") == "\\tmp\\file.txt" --- >> Windows.getPathString (Windows.asAbsDir "c:\\tmp" Windows. Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt" --- >> Windows.getPathString (Windows.asAbsDir "c:" Windows. Windows.asRelDir "tmp" Windows. Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt" --- >> Windows.getPathString (Windows.asRelDir "dir" Windows. Windows.asRelFile "file.txt") == "dir\\file.txt" -() :: DirPath ar -> RelPath fd -> Path ar fd -(Path ar pcs0 Dir) (Path Rel pcs1 fd) = Path ar (pcs0 ++ pcs1) fd - --- | Infix variant of 'addExtension'. --- We only allow files (and not directories) to have extensions added --- by this function. This is because it's the vastly common case and --- an attempt to add one to a directory will - more often than not - --- represent an error. --- We don't however want to prevent the corresponding operation on --- directories, and so we provide a function that is more flexible: --- 'genericAddExtension'. -(<.>) :: FilePath ar -> String -> FilePath ar -Path ar pcs (File pc) <.> ext = Path ar pcs (File $ addExtensionPC pc ext) - --- | Add an extension, even if there is already one there. --- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@. --- --- >> Posix.addExtension (Posix.asRelFile "file.txt") "bib" == "file.txt.bib" --- >> Posix.addExtension (Posix.asRelFile "file.") ".bib" == "file..bib" --- >> Posix.addExtension (Posix.asRelFile "file") ".bib" == "file.bib" --- >> Posix.addExtension (Posix.asRelFile "") "bib" == ".bib" --- >> Posix.addExtension (Posix.asRelFile "") ".bib" == ".bib" --- >> Posix.takeFileName (Posix.addExtension (Posix.asRelFile "") "ext") == ".ext" -addExtension :: FilePath ar -> String -> FilePath ar -addExtension = (<.>) - --- | Join an (absolute or relative) directory path with a relative --- (file or directory) path to form a new path. -combine :: DirPath ar -> RelPath fd -> Path ar fd -combine = () - - --- | Remove last extension, and the \".\" preceding it. --- --- >> Posix.dropExtension x == fst (Posix.splitExtension x) -dropExtension :: FilePath ar -> FilePath ar -dropExtension = fst . splitExtension - --- | Drop all extensions --- --- >> not $ Posix.hasAnExtension (Posix.dropExtensions x) -dropExtensions :: FilePath ar -> FilePath ar -dropExtensions = fst . splitExtensions - --- | Synonym for 'takeDirectory' -dropFileName :: FilePath ar -> DirPath ar -dropFileName = fst . splitFileName - - --- | Set the extension of a file, overwriting one if already present. --- --- >> Posix.replaceExtension (Posix.asRelFile "file.txt") ".bob" == "file.bob" --- >> Posix.replaceExtension (Posix.asRelFile "file.txt") "bob" == "file.bob" --- >> Posix.replaceExtension (Posix.asRelFile "file") ".bob" == "file.bob" --- >> Posix.replaceExtension (Posix.asRelFile "file.txt") "" == "file" --- >> Posix.replaceExtension (Posix.asRelFile "file.fred.bob") "txt" == "file.fred.txt" -replaceExtension :: FilePath ar -> String -> FilePath ar -replaceExtension p ext = dropExtension p <.> ext - -replaceBaseName :: FilePath ar -> String -> FilePath ar -replaceBaseName (Path ar pcs (File pc)) bn = - Path ar pcs $ File $ - addExtensionPC (PathComponent bn) $ snd $ splitExtensionPC pc - -replaceDirectory :: FilePath ar1 -> DirPath ar2 -> FilePath ar2 -replaceDirectory (Path _ _ fd) (Path ar pcs _) = Path ar pcs fd - -replaceFileName :: FilePath ar -> String -> FilePath ar -replaceFileName (Path ar pcs _) fn = Path ar pcs (File (PathComponent fn)) - - --- | Split on the extension. 'addExtension' is the inverse. --- --- >> uncurry (<.>) (Posix.splitExtension x) == x --- >> uncurry Posix.addExtension (Posix.splitExtension x) == x --- >> Posix.splitExtension (Posix.asRelFile "file.txt") == ("file",".txt") --- >> Posix.splitExtension (Posix.asRelFile "file") == ("file","") --- >> Posix.splitExtension (Posix.asRelFile "file/file.txt") == ("file/file",".txt") --- >> Posix.splitExtension (Posix.asRelFile "file.txt/boris") == ("file.txt/boris","") --- >> Posix.splitExtension (Posix.asRelFile "file.txt/boris.ext") == ("file.txt/boris",".ext") --- >> Posix.splitExtension (Posix.asRelFile "file/path.txt.bob.fred") == ("file/path.txt.bob",".fred") -splitExtension :: FilePath ar -> (FilePath ar, String) -splitExtension (Path ar pcs (File pc)) = - first (Path ar pcs . File) $ splitExtensionPC pc - --- | Split on all extensions --- --- >> Posix.splitExtensions (Posix.asRelFile "file.tar.gz") == ("file",".tar.gz") -splitExtensions :: FilePath ar -> (FilePath ar, String) -splitExtensions (Path ar pcs (File pc)) = - first (Path ar pcs . File) $ splitExtensionsPC pc - -prop_split_combineExt :: AbsFile -> Property -prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p) - -splitFileName :: FilePath ar -> (DirPath ar, RelFile) -splitFileName (Path ar pcs fd) = (Path ar pcs Dir, Path Rel [] fd) - -prop_split_combine :: AbsFile -> Property -prop_split_combine p = property $ uncurry combine (splitFileName p) == p - - --- | Get the basename of a file --- --- >> Posix.takeBaseName (Posix.asAbsFile "/tmp/somedir/myfile.txt") == "myfile" --- >> Posix.takeBaseName (Posix.asRelFile "./myfile.txt") == "myfile" --- >> Posix.takeBaseName (Posix.asRelFile "myfile.txt") == "myfile" -takeBaseName :: FilePath ar -> RelFile -takeBaseName = takeFileName . dropExtension - -takeDirectory :: FilePath ar -> DirPath ar -takeDirectory = fst . splitFileName - --- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. --- --- >> Posix.takeExtension x == snd (Posix.splitExtension x) --- >> Posix.takeExtension (Posix.addExtension x "ext") == ".ext" --- >> Posix.takeExtension (Posix.replaceExtension x "ext") == ".ext" -takeExtension :: FilePath ar -> String -takeExtension = snd . splitExtension - --- | Get all extensions --- --- >> Posix.takeExtensions (Posix.asRelFile "file.tar.gz") == ".tar.gz" -takeExtensions :: FilePath ar -> String -takeExtensions = snd . splitExtensions - --- | Get the filename component of a file path (ie stripping all parent dirs) --- --- >> Posix.takeFileName (Posix.asAbsFile "/tmp/somedir/myfile.txt") == "myfile.txt" --- >> Posix.takeFileName (Posix.asRelFile "./myfile.txt") == "myfile.txt" --- >> Posix.takeFileName (Posix.asRelFile "myfile.txt") == "myfile.txt" -takeFileName :: FilePath ar -> RelFile -takeFileName (Path _ _ fd) = Path Rel [] fd - -prop_takeFileName_end :: AbsFile -> Property -prop_takeFileName_end p = property $ show (takeFileName p) `isSuffixOf` show p - - ------------------------------------------------------------------------- --- Auxillary Manipulation Functions - --- | Check whether two strings are equal as file paths. --- --- >> Posix.equalFilePath "/tmp/" "/tmp" --- >> not $ Posix.equalFilePath "/tmp" "tmp" --- >> Windows.equalFilePath "file" "File" --- >> not $ Windows.equalFilePath "file" "dir" -equalFilePath :: String -> String -> Bool -equalFilePath s1 s2 = - let abs1 = isAbsoluteString s1 - abs2 = isAbsoluteString s2 - in abs1 == abs2 && - if abs1 - then asAbsDir s1 == asAbsDir s2 - else asRelDir s1 == asRelDir s2 - --- | Constructs a 'RelPath' from a list of components. --- It is an unchecked error if the path components contain path separators. --- It is an unchecked error if a 'RelFile' path is empty. --- --- >> Posix.joinPath ["tmp","someDir","dir"] == Posix.asRelDir "tmp/someDir/dir" --- >> Posix.joinPath ["tmp","someDir","file.txt"] == Posix.asRelFile "tmp/someDir/file.txt" -joinPath :: (FileDirClass fd) => [String] -> RelPath fd -joinPath = mkPathFromComponents Rel . map PathComponent - --- | Currently just transforms: --- --- >> Posix.normalise "/tmp/fred/./jim/./file" == Posix.asAbsFile "/tmp/fred/jim/file" -normalise :: Path ar fd -> Path ar fd -normalise (Path ar pcs fd) = - Path ar (filter (PathComponent currentDirComponent /=) pcs) fd - --- | Deconstructs a path into its components. --- --- >> Posix.splitPath (Posix.asAbsDir "/tmp/someDir/mydir.dir") == (True, ["tmp","someDir","mydir.dir"], Nothing) --- >> Posix.splitPath (Posix.asAbsFile "/tmp/someDir/myfile.txt") == (True, ["tmp","someDir"], Just "myfile.txt") -splitPath :: - (AbsRelClass ar, FileDirClass fd) => - Path ar fd -> (Bool, [RelDir], Maybe RelFile) -splitPath (Path ar pcs fd) = - (isAbsolutePlain ar, - map (\pc -> Path Rel [pc] Dir) pcs, - maybeFileDir fd) - -isAbsolutePlain :: (AbsRelClass ar) => ar -> Bool -isAbsolutePlain = absRelPlain (const True) (const False) - -maybeFileDir :: (FileDirClass fd) => fd -> Maybe RelFile -maybeFileDir = fileDirPlain (Just . Path Rel []) (\Dir -> Nothing) - --- | This function can be used to construct a relative path by removing --- the supplied 'AbsDir' from the front. It is a runtime 'error' if the --- supplied 'AbsPath' doesn't start with the 'AbsDir'. --- --- >> Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == Posix.asRelFile "anotherdir/file.txt" --- >> Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == Posix.asRelDir "anotherdir/dir" --- >> Windows.makeRelative "c:\\tmp\\somedir" "c:\\Tmp\\SomeDir\\AnotherDir\\File.txt" == Windows.asRelFile "AnotherDir\\File.txt" --- >> Windows.makeRelative "c:\\tmp\\somedir" "c:\\tmp\\somedir\\anotherdir\\dir" == Windows.asRelDir "anotherdir\\dir" -makeRelative :: (FileDirClass fd) => AbsDir -> AbsPath fd -> RelPath fd -makeRelative relTo@(Path relToAR relToPCs Dir) orig@(Path origAR origPCs fd) = - maybe (error msg) (flip (Path Rel) fd) $ - guard (relToAR == origAR) >> stripPrefix relToPCs origPCs - where - msg = - printf "System.Path can't make (%s) relative to (%s)" - (show orig) (show relTo) - --- | Joins an absolute directory with a relative path to construct a --- new absolute path. --- --- >> Posix.makeAbsolute "/tmp" "file.txt" == Posix.asAbsFile "/tmp/file.txt" --- >> Posix.makeAbsolute "/tmp" "adir/file.txt" == Posix.asAbsFile "/tmp/adir/file.txt" --- >> Posix.makeAbsolute "/tmp" "adir/dir" == Posix.asAbsDir "/tmp/adir/dir" -makeAbsolute :: AbsDir -> RelPath fd -> AbsPath fd -makeAbsolute = genericMakeAbsolute - --- | Converts a relative path into an absolute one by --- prepending the current working directory. -makeAbsoluteFromCwd :: RelPath fd -> IO (AbsPath fd) -makeAbsoluteFromCwd = genericMakeAbsoluteFromCwd - --- | As for 'makeAbsolute', but for use when the path may already be --- absolute (in which case it is left unchanged). --- --- >> Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "file.txt") == "/tmp/file.txt" --- >> Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "adir/file.txt") == "/tmp/adir/file.txt" --- >> Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "adir/file.txt") == "/adir/file.txt" --- >> Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "/adir/file.txt") == "/adir/file.txt" -genericMakeAbsolute :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath fd -genericMakeAbsolute base p = absRel id (base ) p - --- | As for 'makeAbsoluteFromCwd', but for use when the path may already be --- absolute (in which case it is left unchanged). -genericMakeAbsoluteFromCwd :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd) -genericMakeAbsoluteFromCwd p = do - cwdString <- SD.getCurrentDirectory -- we don't use System.Path.Directory impl here to avoid module cycle - return $ genericMakeAbsolute (asAbsDir cwdString) p - -prop_makeAbsoluteFromDir_endSame :: AbsDir -> RelFile -> Property -prop_makeAbsoluteFromDir_endSame base p = - property $ show p `isSuffixOf` show (makeAbsolute base p) - -prop_makeAbsoluteFromDir_startSame :: AbsDir -> RelFile -> Property -prop_makeAbsoluteFromDir_startSame base p = - property $ show base `isPrefixOf` show (makeAbsolute base p) - --- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir -> AbsFile -> Property --- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p) - - ------------------------------------------------------------------------- --- NYI - Not Yet Implemented - -{- -splitSearchPath :: String -> [String] -getSearchPath :: IO [String] -splitDrive :: String -> (String, String) -joinDrive :: String -> String -> String -takeDrive :: String -> String -hasDrive :: String -> Bool -dropDrive :: String -> String -isDrive :: String -> Bool -isValid :: String -> Bool -makeValid :: String -> String --} - - ------------------------------------------------------------------------- --- Path Predicates - --- | Test whether a @'Path' ar fd@ is absolute. --- --- >> Posix.isAbsolute (Posix.asAbsFile "fred") --- >> Posix.isAbsolute (Posix.asAbsFile "/fred") --- >> Windows.isAbsolute (Windows.asAbsFile "\\fred") --- >> Windows.isAbsolute (Windows.asAbsFile "c:\\fred") -isAbsolute :: AbsRelClass ar => Path ar fd -> Bool -isAbsolute = absRel (const True) (const False) - --- | Test whether the 'String' would correspond to an absolute path --- if interpreted as a 'Path'. -isAbsoluteString :: String -> Bool -isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators' -isAbsoluteString (x:xs) = - isPathSeparator x -- Absolute if first char is a path separator - || - isWindows && isAlpha x && isPrefixOf ":" xs - --- | Invariant - this should return True iff arg is of type @'Path' Rel _@ --- --- > isRelative = not . isAbsolute --- >> Posix.isRelative (Posix.asRelFile "fred") --- >> Posix.isRelative (Posix.asRelFile "/fred") --- >> Windows.isRelative (Windows.asRelFile "fred") -isRelative :: AbsRelClass ar => Path ar fd -> Bool -isRelative = not . isAbsolute - --- | Test whether the 'String' would correspond to a relative path --- if interpreted as a 'Path'. --- --- > isRelativeString = not . isAbsoluteString -isRelativeString :: String -> Bool -isRelativeString = not . isAbsoluteString - - --- | Does the given filename have an extension? --- --- >> null (Posix.takeExtension x) == not (Posix.hasAnExtension x) -hasAnExtension :: FilePath ar -> Bool -hasAnExtension = not . null . snd . splitExtension - --- | Does the given filename have the given extension? --- --- >> Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.hs") --- >> Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.bak.hs") --- >> not $ Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.hs.bak") -hasExtension :: String -> FilePath ar -> Bool -hasExtension ext = (==ext) . snd . splitExtension - - ------------------------------------------------------------------------- --- Separators - --- | This is largely for 'System.FilePath' compatability -addTrailingPathSeparator :: String -> String -addTrailingPathSeparator = (++[pathSeparator]) - --- | This is largely for 'System.FilePath' compatability -dropTrailingPathSeparator :: String -> String -dropTrailingPathSeparator = init - --- | File extension character --- --- >> Posix.extSeparator == '.' -extSeparator :: Char -extSeparator = '.' - --- | This is largely for 'System.FilePath' compatability -hasTrailingPathSeparator :: String -> Bool -hasTrailingPathSeparator = isPathSeparator . last - --- | The character that separates directories. In the case where more than --- one character is possible, 'pathSeparator' is the \'ideal\' one. --- --- >> Posix.isPathSeparator Posix.pathSeparator -pathSeparator :: Char -pathSeparator | isWindows = '\\' - | otherwise = '/' - --- | The list of all possible separators. --- --- >> Posix.pathSeparator `elem` Posix.pathSeparators -pathSeparators :: [Char] -pathSeparators = return pathSeparator - --- | The character that is used to separate the entries in the $PATH environment variable. --- -searchPathSeparator :: Char -searchPathSeparator = ':' - --- | Is the character an extension character? --- --- >> Posix.isExtSeparator a == (a == Posix.extSeparator) -isExtSeparator :: Char -> Bool -isExtSeparator = (== extSeparator) - --- | Rather than using @(== 'pathSeparator')@, use this. Test if something --- is a path separator. --- --- >> Posix.isPathSeparator a == (a `elem` Posix.pathSeparators) -isPathSeparator :: Char -> Bool -isPathSeparator = flip elem pathSeparators - --- | Is the character a file separator? --- --- >> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator) -isSearchPathSeparator :: Char -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - ------------------------------------------------------------------------- --- Generic Manipulation Functions - --- These functions support manipulation of extensions on directories --- as well as files. They have looser types than the corresponding --- 'Basic Manipulation Functions', but it is expected that the basic --- functions will be used more frequently as they provide more checks. - --- | This is a more flexible variant of 'addExtension' / '<.>' which can --- work with files or directories --- --- >> Posix.genericAddExtension "/" "x" == Posix.asAbsDir "/.x" --- >> Posix.genericAddExtension "/a" "x" == Posix.asAbsDir "/a.x" --- >> Posix.genericAddExtension "" "x" == Posix.asRelFile ".x" --- >> Posix.genericAddExtension "" "" == Posix.asRelFile "" -genericAddExtension :: (FileDirClass fd) => Path ar fd -> String -> Path ar fd -genericAddExtension p "" = p -genericAddExtension path ext = - runAddExtension - (switchFileDir - (AddExtension $ - \(Path ar pcs (File pc)) -> - Path ar pcs $ File $ addExtensionPC pc ext) - (AddExtension $ - \(Path ar pcs0 Dir) -> - let pcs = if null pcs0 then [PathComponent ""] else pcs0 - in Path ar (mapLast (flip addExtensionPC ext) pcs) Dir)) - path - -newtype - AddExtension ar fd = - AddExtension {runAddExtension :: Path ar fd -> Path ar fd} - -genericDropExtension :: (FileDirClass fd) => Path ar fd -> Path ar fd -genericDropExtension = fst . genericSplitExtension - -genericDropExtensions :: (FileDirClass fd) => Path ar fd -> Path ar fd -genericDropExtensions = fst . genericSplitExtensions - -genericSplitExtension :: - (FileDirClass fd) => Path ar fd -> (Path ar fd, String) -genericSplitExtension = - runSplitExtension $ - switchFileDir - (SplitExtension $ - \(Path ar pcs (File pc)) -> - first (Path ar pcs . File) $ splitExtensionPC pc) - (SplitExtension $ - \(Path ar pcs Dir) -> - first (flip (Path ar) Dir) $ - mapLastPair - (error "genericSplitExtension: empty path") - splitExtensionPC pcs) - -genericSplitExtensions :: - (FileDirClass fd) => Path ar fd -> (Path ar fd, String) -genericSplitExtensions = - runSplitExtension $ - switchFileDir - (SplitExtension $ - \(Path ar pcs (File pc)) -> - first (Path ar pcs . File) $ splitExtensionsPC pc) - (SplitExtension $ - \(Path ar pcs Dir) -> - first (flip (Path ar) Dir) $ - mapLastPair - (error "genericSplitExtensions: empty path") - splitExtensionsPC pcs) - -genericTakeExtension :: (FileDirClass fd) => Path ar fd -> String -genericTakeExtension = snd . genericSplitExtension - -genericTakeExtensions :: (FileDirClass fd) => Path ar fd -> String -genericTakeExtensions = snd . genericSplitExtension - -newtype - SplitExtension ar fd = - SplitExtension {runSplitExtension :: Path ar fd -> (Path ar fd, String)} - - --- move to utility-ht -mapLast :: (a -> a) -> [a] -> [a] -mapLast f xs = zipWith id (drop 1 $ map (const id) xs ++ [f]) xs - -mapLastPair :: b -> (a -> (a,b)) -> [a] -> ([a], b) -mapLastPair b0 f xs = - case reverse xs of - [] -> (xs, b0) - y:ys -> - let (a, b) = f y - in (reverse ys ++ [a], b) - -addExtensionPC :: PathComponent -> String -> PathComponent -addExtensionPC p "" = p -addExtensionPC (PathComponent pc) ext = - PathComponent $ pc ++ - if [extSeparator] `isPrefixOf` ext - then ext - else extSeparator : ext - -splitExtensionPC :: PathComponent -> (PathComponent, String) -splitExtensionPC (PathComponent s) = (PathComponent s1, s2) - where (s1,s2) = fixTrailingDot $ rbreak isExtSeparator s - fixTrailingDot ("",r2) = (r2,"") - fixTrailingDot (r1,r2) | [extSeparator] `isSuffixOf` r1 = (init r1, extSeparator:r2) - | otherwise = (r1,r2) - swap (x,y) = (y,x) - rbreak q = (reverse *** reverse) . swap . break q . reverse - -splitExtensionsPC :: PathComponent -> (PathComponent, String) -splitExtensionsPC (PathComponent s) = - first PathComponent $ break isExtSeparator s - ------------------------------------------------------------------------- --- QuickCheck - -_testall :: IO () -_testall = do - putStrLn "Running QuickCheck tests..." - quickCheck prop_asPath_getPathString - quickCheck prop_mkPathFromComponents_pathComponents - quickCheck prop_makeAbsoluteFromDir_endSame - quickCheck prop_makeAbsoluteFromDir_startSame - quickCheck prop_split_combine - quickCheck prop_takeFileName_end - quickCheck prop_split_combineExt - putStrLn "Tests completed." - --- test :: Testable a => a -> IO () --- test = quickCheck - -qcFileComponent :: Gen PathComponent -qcFileComponent = PathComponent <$> frequency [ - (1, return "someFile"), - (1, return "fileWith.ext"), - (1, return "file.with.multiple.exts"), - (1, return "file with spcs") - ] - -qcDirComponent :: Gen PathComponent -qcDirComponent = PathComponent <$> frequency [ - (1, return "someDir"), - (1, return "aDir"), - (1, return "aFolder"), - (1, return "a folder"), - (1, return "directory") - ] - -instance Arbitrary PathComponent where - arbitrary = oneof [qcFileComponent, qcDirComponent] - - -qcGenPath :: - (AbsRelClass ar, FileDirClass fd) => - Gen PathComponent -> Gen (Path ar fd) -qcGenPath qcLastComponent = do - ar <- switchAbsRel (fmap (Abs . (:":")) $ QC.choose ('a', 'z')) (return Rel) - pcs <- QC.listOf qcDirComponent - pc <- qcLastComponent - return $ mkPathFromComponents ar (pcs ++ [pc]) - -qcFilePath :: (AbsRelClass ar) => Gen (FilePath ar) -qcFilePath = qcGenPath qcFileComponent - -qcDirPath :: (AbsRelClass ar) => Gen (DirPath ar) -qcDirPath = qcGenPath qcDirComponent - -qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd) -qcPath = - getFunctorPath $ - switchFileDir (FunctorPath qcFilePath) (FunctorPath qcDirPath) - -instance (AbsRelClass ar, FileDirClass fd) => Arbitrary (Path ar fd) where +module System.Path.Internal +( + -- * The main filepath (& dirpath) abstract type + Path, -- kept abstract + + -- * Possible types for Path type parameters + Abs, + Rel, + AbsOrRel, + File, + Dir, + FileOrDir, + + -- * Type Synonyms + AbsFile, + RelFile, + AbsDir, + RelDir, + AbsOrRelFile, + AbsOrRelDir, + AbsFileOrDir, + RelFileOrDir, + AbsOrRelFileOrDir, + + AbsPath, + RelPath, + FilePath, + DirPath, + AbsOrRelPath, + FileOrDirPath, + + -- * Classes + AbsRelClass(..), AbsOrRelClass(..), absRel, + FileOrDirClass(..), FileDirClass(..), fileDir, + + -- * Path to String conversion + toString, + getPathString, + + -- * Constants + rootDir, + currentDir, + emptyFile, + + -- * Parsing Functions + maybePath, + parsePath, + + -- * Checked Construction Functions + path, + relFile, + relDir, + absFile, + absDir, + relPath, + absPath, + filePath, + dirPath, + + idAbsOrRel, idAbs, idRel, + idFileOrDir, idFile, idDir, + + -- * 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, + mapFileName, + + -- * Auxillary Manipulation Functions + equalFilePath, + joinPath, + normalise, + splitPath, + makeRelative, + makeRelativeMaybe, + makeAbsolute, + makeAbsoluteFromCwd, + dynamicMakeAbsolute, + dynamicMakeAbsoluteFromCwd, + genericMakeAbsolute, + genericMakeAbsoluteFromCwd, + pathMap, + dirFromFile, + fileFromDir, + toFileOrDir, + fromFileOrDir, + fileFromFileOrDir, + dirFromFileOrDir, + + -- * Path Predicates + isAbsolute, + isRelative, + isAbsoluteString, + isRelativeString, + hasAnExtension, + hasExtension, + + -- * Separators + System(..), + extSeparator, + searchPathSeparator, + isExtSeparator, + isSearchPathSeparator, + + -- * Generic Manipulation Functions + genericAddExtension, + genericDropExtension, + genericDropExtensions, + genericSplitExtension, + genericSplitExtensions, + genericTakeExtension, + genericTakeExtensions, + + -- * Tests + testAll, + isValid, +) + +where + +import qualified System.Directory as SD + +import qualified Control.Monad.Trans.Class as MT +import qualified Control.Monad.Trans.State as MS +import Control.Monad (MonadPlus, guard, liftM2, mplus, mzero) +import Control.Applicative (Const(Const), liftA2, (<$>)) +import Control.DeepSeq (NFData(rnf)) + +import qualified Data.Monoid.HT as MonHT +import qualified Data.List.HT as ListHT +import Data.Tagged (Tagged(Tagged), untag) +import Data.Functor.Compose (Compose(Compose), getCompose) +import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intersperse) +import Data.String (IsString(fromString)) +import Data.Maybe.HT (toMaybe) +import Data.Maybe (fromMaybe, maybeToList) +import Data.Tuple.HT (mapFst, mapSnd) +import Data.Monoid (Monoid(mempty, mappend, mconcat), Endo(Endo), appEndo) +import Data.Char (isSpace) +import Data.Ord.HT (comparing) +import Data.Eq.HT (equating) + +import Text.Show.HT (concatS) +import Text.Printf (printf) + +import qualified Test.QuickCheck as QC +import Test.QuickCheck + (Gen, Property, property, Arbitrary(arbitrary), frequency) + +import Prelude hiding (FilePath) + + +------------------------------------------------------------------------ +-- Types + +newtype Abs = Abs GenComponent +data Rel = Rel +data AbsOrRel = AbsO GenComponent | RelO + +absPC :: String -> Abs +absPC = Abs . PathComponent + +newtype File = File GenComponent +data Dir = Dir +data FileOrDir = FileOrDir + + +data Generic = Generic + +_osDummy :: Generic +_osDummy = Generic + + +-- | This is the main filepath abstract datatype +data Path os ar fd = Path ar [PathComponent os] fd + +instance + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Eq (Path os ar fd) where + (==) = equating inspectPath + +instance + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Ord (Path os ar fd) where + compare = comparing inspectPath + +inspectPath :: + Path os ar fd -> (WrapAbsRel os ar, [PathComponent os], WrapFileDir os fd) +inspectPath (Path ar pcs fd) = (WrapAbsRel ar, pcs, WrapFileDir fd) + + +newtype WrapAbsRel os ar = WrapAbsRel {unwrapAbsRel :: ar} + +instance (System os, AbsOrRelClass ar) => Eq (WrapAbsRel os ar) where + (==) = equating inspectAbsRel + +instance (System os, AbsOrRelClass ar) => Ord (WrapAbsRel os ar) where + compare = comparing inspectAbsRel + +inspectAbsRel :: + (AbsOrRelClass ar) => + WrapAbsRel os ar -> Either (PathComponent os) () +inspectAbsRel = + absRelPlain (Left . PathComponent) (Right ()) . unwrapAbsRel + + +newtype WrapFileDir os fd = WrapFileDir {unwrapFileDir :: fd} + +instance (System os, FileOrDirClass fd) => Eq (WrapFileDir os fd) where + (==) = equating inspectFileDir + +instance (System os, FileOrDirClass fd) => Ord (WrapFileDir os fd) where + compare = comparing inspectFileDir + +inspectFileDir :: + (FileOrDirClass ar) => + WrapFileDir os ar -> Either (PathComponent os) () +inspectFileDir = + fileOrDirPlain (Left . retagPC) (Right ()) (Right ()) . unwrapFileDir + + +{- | +We cannot have a PathComponent without phantom types plus a Tagged wrapper, +because we need specialised Eq and Ord instances. +-} +type GenComponent = PathComponent Generic + +newtype PathComponent os = PathComponent String + +instance (System os) => Eq (PathComponent os) where + (==) = equating (applyComp canonicalize) + +instance (System os) => Ord (PathComponent os) where + compare = comparing (applyComp canonicalize) + +applyComp :: Tagged os (String -> String) -> PathComponent os -> String +applyComp (Tagged canon) (PathComponent pc) = canon pc + +retagPC :: GenComponent -> PathComponent os +retagPC (PathComponent pc) = PathComponent pc + +untagPC :: PathComponent os -> GenComponent +untagPC (PathComponent pc) = PathComponent pc + +selTag :: Path os ar fd -> Tagged os a -> a +selTag _ = untag + + +type AbsFile os = Path os Abs File +type RelFile os = Path os Rel File +type AbsDir os = Path os Abs Dir +type RelDir os = Path os Rel Dir +type AbsOrRelFile os = Path os AbsOrRel File +type AbsOrRelDir os = Path os AbsOrRel Dir +type AbsFileOrDir os = Path os Abs FileOrDir +type RelFileOrDir os = Path os Rel FileOrDir +type AbsOrRelFileOrDir os = Path os AbsOrRel FileOrDir + +type AbsPath os fd = Path os Abs fd +type RelPath os fd = Path os Rel fd +type FilePath os ar = Path os ar File +type DirPath os ar = Path os ar Dir +type AbsOrRelPath os fd = Path os AbsOrRel fd +type FileOrDirPath os ar = Path os ar FileOrDir + +instance NFData (PathComponent os) where + rnf (PathComponent pc) = rnf pc + +instance NFData Abs where + rnf (Abs drive) = rnf drive + +instance NFData Rel where + rnf Rel = () + +instance NFData File where + rnf (File pc) = rnf pc + +instance NFData Dir where + rnf Dir = () + +instance NFData FileOrDir where + rnf FileOrDir = () + +instance (AbsOrRelClass ar, FileOrDirClass fd) => NFData (Path os ar fd) where + rnf (Path ar pcs fd) = + rnf (absRelPlain rnf () ar, pcs, fileOrDirPlain rnf () () fd) + +absRelPlain :: (AbsOrRelClass ar) => (String -> a) -> a -> ar -> a +absRelPlain fAbs fRel = + runFuncArg $ + switchAbsOrRel + (FuncArg $ \(Abs (PathComponent drive)) -> fAbs drive) + (FuncArg $ \Rel -> fRel) + (FuncArg $ \ar -> + case ar of + AbsO (PathComponent drive) -> fAbs drive + RelO -> fRel) + +fileDirPlain :: (FileDirClass fd) => (GenComponent -> a) -> a -> fd -> a +fileDirPlain fFile fDir = + runFuncArg $ + switchFileDir (FuncArg $ \(File pc) -> fFile pc) (FuncArg $ \Dir -> fDir) + +fileOrDirPlain :: + (FileOrDirClass fd) => (GenComponent -> a) -> a -> a -> fd -> a +fileOrDirPlain fFile fDir fFileOrDir = + runFuncArg $ + switchFileOrDir (FuncArg $ \(File pc) -> fFile pc) + (FuncArg $ \Dir -> fDir) (FuncArg $ \FileOrDir -> fFileOrDir) + +newtype FuncArg b a = FuncArg {runFuncArg :: a -> b} + +-- I don't think this basic type of fold is appropriate for a nested datatype +-- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a +-- pathFold pr f PathRoot = pr +-- pathFold pr f (FileDir d pc) = f (pathFold pr f d) (unPathComponent pc) + +-- | Map over the components of the path. +-- +-- >> Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets" +pathMap :: + (FileOrDirClass fd) => (String -> String) -> Path os ar fd -> Path os ar fd +pathMap f (Path ar pcs fd) = Path ar (map (pcMap f) pcs) (fdMap f fd) + +fdMap :: (FileOrDirClass fd) => (String -> String) -> fd -> fd +fdMap f = appEndo $ switchFileOrDir (Endo $ fileMap f) (Endo id) (Endo id) + +fileMap :: (String -> String) -> File -> File +fileMap f (File pc) = File $ pcMap f pc + +pcMap :: (String -> String) -> PathComponent os -> PathComponent os +pcMap f (PathComponent s) = PathComponent (f s) + + +mapFilePart :: + (GenComponent -> GenComponent) -> FilePath os ar -> FilePath os ar +mapFilePart f (Path ar pcs (File fd)) = Path ar pcs $ File $ f fd + +splitFilePart :: + (GenComponent -> (GenComponent, a)) -> FilePath os ar -> (FilePath os ar, a) +splitFilePart f (Path ar pcs (File fd)) = mapFst (Path ar pcs . File) $ f fd + +mapPathDirs :: + ([PathComponent os] -> [PathComponent os]) -> Path os ar fd -> Path os ar fd +mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd + + +------------------------------------------------------------------------ +-- 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 AbsOrRel +instance Private File +instance Private Dir +instance Private FileOrDir + +-- | This class allows selective behaviour for absolute and +-- relative paths and is mostly for internal use. +class Private ar => AbsOrRelClass ar where + {- | + See + for the used technique. + -} + switchAbsOrRel :: f Abs -> f Rel -> f AbsOrRel -> f ar + +instance AbsOrRelClass Abs where switchAbsOrRel f _ _ = f +instance AbsOrRelClass Rel where switchAbsOrRel _ f _ = f +instance AbsOrRelClass AbsOrRel where switchAbsOrRel _ _ f = f + +class AbsOrRelClass ar => AbsRelClass ar where + switchAbsRel :: f Abs -> f Rel -> f ar + +instance AbsRelClass Abs where switchAbsRel f _ = f +instance AbsRelClass Rel where switchAbsRel _ f = f + +absRel :: + (AbsOrRelClass ar) => + (AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a +absRel fAbs fRel (Path ar pcs fd) = + absRelPlain + (\drive -> fAbs $ Path (Abs (PathComponent drive)) pcs fd) + (fRel $ Path Rel pcs fd) + ar + +class AbsRelClass ar => IsAbs ar where switchAbs :: f Abs -> f ar +instance IsAbs Abs where switchAbs = id + +class AbsRelClass ar => IsRel ar where switchRel :: f Rel -> f ar +instance IsRel Rel where switchRel = id + + +-- | This class allows selective behaviour for file and +-- directory paths and is mostly for internal use. +class Private fd => FileOrDirClass fd where + switchFileOrDir :: f File -> f Dir -> f FileOrDir -> f fd + +instance FileOrDirClass File where switchFileOrDir f _ _ = f +instance FileOrDirClass Dir where switchFileOrDir _ f _ = f +instance FileOrDirClass FileOrDir where switchFileOrDir _ _ f = f + +switchFileOrDirPath :: + (FileOrDirClass fd) => + f (FilePath os ar) -> f (DirPath os ar) -> f (FileOrDirPath os ar) -> + f (Path os ar fd) +switchFileOrDirPath f d fd = + getCompose $ switchFileOrDir (Compose f) (Compose d) (Compose fd) + +class FileOrDirClass fd => FileDirClass fd where + switchFileDir :: f File -> f Dir -> f fd + +instance FileDirClass File where switchFileDir f _ = f +instance FileDirClass Dir where switchFileDir _ f = f + +switchFileDirPath :: + (FileDirClass fd) => + f (FilePath os ar) -> f (DirPath os ar) -> f (Path os ar fd) +switchFileDirPath f d = + getCompose $ switchFileDir (Compose f) (Compose d) + +fileDir :: + (FileDirClass fd) => + (FilePath os ar -> a) -> (DirPath os ar -> a) -> Path os ar fd -> a +fileDir f g = runFuncArg $ switchFileDirPath (FuncArg f) (FuncArg g) + +class FileDirClass fd => IsFile fd where switchFile :: f File -> f fd +instance IsFile File where switchFile = id + +class FileDirClass fd => IsDir fd where switchDir :: f Dir -> f fd +instance IsDir Dir where switchDir = id + + +-- | Currently not exported +_eitherFromAbsRel :: + AbsOrRelClass ar => Path os ar fd -> Either (AbsPath os fd) (RelPath os fd) +_eitherFromAbsRel = absRel Left Right + +-- | Currently not exported +_eitherFromFileDir :: + FileDirClass fd => Path os ar fd -> Either (FilePath os ar) (DirPath os ar) +_eitherFromFileDir = fileDir Left Right + +------------------------------------------------------------------------ +-- Read & Show instances + +{- | +We show and parse file path components +using the rather generic 'relPath' smart constructor +instead of 'relFile', 'relDir' and @relPath str :: FileOrDirPath ar@. +Otherwise handling of all cases of 'File', 'Dir' and 'FileOrDir' types +becomes pretty complicated. +-} +-- >> show (Posix.rootDir relDir "bla" relFile "blub") == "rootDir relPath \"bla\" relPath \"blub\"" +-- >> show (Just (Posix.rootDir relDir "bla" relFile "blub")) == "Just (rootDir relPath \"bla\" relPath \"blub\")" +-- >> show (Posix.currentDir relDir "bla" relFile "blub") == "currentDir relPath \"bla\" relPath \"blub\"" +-- >> show (Just (Posix.currentDir relDir "bla" relFile "blub")) == "Just (currentDir relPath \"bla\" relPath \"blub\")" +-- >> show (Windows.absDir "c:" relDir "bla" relFile "blub") == "absDir \"c:\" relPath \"bla\" relPath \"blub\"" +-- >> show (Just (Windows.absDir "c:\\" relDir "bla" relFile "blub")) == "Just (absDir \"c:\\\\\" relPath \"bla\" relPath \"blub\")" +instance + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Show (Path os ar fd) where + showsPrec = untag showsPrecTagged + +showsPrecTagged :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Tagged os (Int -> Path os ar fd -> ShowS) +showsPrecTagged = + flip fmap rootStringTagged $ \root d x -> + case pathComponents x of + (ar, pcs) -> + showParen (d>5) $ concatS $ + intersperse + (showChar ' ' . showString combineOperator . showChar ' ') $ + absRelPlain + (\drive -> + if drive == root + then showString rootName + else showsCons absDirName drive) + (showString currentName) + ar : + map (\(PathComponent pc) -> showsCons relPathName pc) pcs + +showsCons :: Show a => String -> a -> ShowS +showsCons name arg = showString name . showChar ' ' . showsPrec 11 arg + +{- | +Currently it also parses AbsOrRel and FileOrDir paths, +although these cannot be composed with the accepted combinators. +-} +-- >> read "rootDir" == Posix.rootDir +-- >> read "rootDir" == Windows.rootDir +-- >> read "currentDir" == Posix.currentDir +-- >> read "currentDir" == Windows.currentDir +-- >> let path = Posix.rootDir relDir "bla" relFile "blub" in read (show path) == path +-- >> let path = Just (Posix.rootDir relDir "bla" relFile "blub") in read (show path) == path +-- >> let path = Posix.currentDir relDir "bla" relFile "blub" in read (show path) == path +-- >> let path = Just (Posix.currentDir relDir "bla" relFile "blub") in read (show path) == path +-- >> let path = Windows.rootDir relDir "bla" relFile "blub" in read (show path) == path +-- >> let path = Just (Windows.rootDir relDir "bla" relFile "blub") in read (show path) == path +-- >> let path = Windows.absDir "c:" relDir "bla" relFile "blub" in read (show path) == path +instance + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Read (Path os ar fd) where + readsPrec d = readParen (d>5) $ untag readsPrecTagged + +readsPrecTagged :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Tagged os (ReadS (Path os ar fd)) +readsPrecTagged = + flip fmap readsSplitDrive $ \readsSplDrv -> + let go = + handleMismatch + (skipSpaces >> matchString combineOperator) + (return []) + (liftM2 (:) (fmap PathComponent $ readsCons relPathName) go) + in MS.runStateT $ do + skipSpaces + MT.lift . maybeToList =<< + liftM2 maybePathFromComponents readsSplDrv go + +skipSpaces :: (Monad m) => MS.StateT String m () +skipSpaces = MS.modify $ dropWhile isSpace + +readsCons :: (Read a) => String -> MS.StateT String [] a +readsCons name = do + skipSpaces + matchString name + MS.StateT $ readsPrec 11 + +handleMismatch :: + MS.StateT s Maybe () -> + MS.StateT s m a -> MS.StateT s m a -> MS.StateT s m a +handleMismatch act err success = + MS.StateT $ \s0 -> + case MS.execStateT act s0 of + Nothing -> MS.runStateT err s0 + Just s1 -> MS.runStateT success s1 + +matchString :: (MonadPlus m) => String -> MS.StateT String m () +matchString prefix = + MS.StateT $ maybe mzero (return . (,) ()) . stripPrefix prefix + +readsSplitDrive :: + (System os, AbsOrRelClass ar) => Tagged os (MS.StateT String [] ar) +readsSplitDrive = + flip fmap readsSplitDriveAbs $ \readsSplDrvAbs -> + switchAbsOrRel + readsSplDrvAbs + readsSplitDriveRel + (mplus + (fmap (\(Abs drive) -> AbsO drive) readsSplDrvAbs) + (fmap (\Rel -> RelO) readsSplitDriveRel)) + +readsSplitDriveAbs :: (System os) => Tagged os (MS.StateT String [] Abs) +readsSplitDriveAbs = + flip fmap rootStringTagged $ \root -> + fmap absPC $ + (matchString rootName >> return root) + `mplus` + readsCons absDirName + +readsSplitDriveRel :: (MonadPlus m) => MS.StateT String m Rel +readsSplitDriveRel = matchString currentName >> return Rel + + +-- | Synonym of 'getPathString' intended for qualified use. +toString :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> String +toString = getPathString + +-- | Convert the 'Path' into a plain 'String' as required for OS calls. +getPathString :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> String +getPathString = flip getPathStringS "" + +getPathStringS :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> ShowS +getPathStringS x = + case pathComponents x of + (ar, []) -> + absRelPlain showString (showString currentDirComponent) ar + (ar, pcs) -> + concatS $ + absRelPlain (\drive -> (showString drive :)) id ar $ + intersperse (showChar (selTag x pathSeparator)) $ + map (\(PathComponent pc) -> showString pc) pcs + +prop_asPath_getPathString :: (System os) => AbsFile os -> Property +prop_asPath_getPathString p = property $ p == asPath (getPathString p) + + +------------------------------------------------------------------------ +-- Constants + +-- >> Posix.toString Path.rootDir == "/" +-- >> Windows.toString Path.rootDir == "\\" +rootDir :: (System os) => AbsDir os +rootDir = untag rootDirTagged + +rootDirTagged :: (System os) => Tagged os (AbsDir os) +rootDirTagged = fmap (\root -> Path (absPC root) [] Dir) rootStringTagged + +rootStringTagged :: (System os) => Tagged os String +rootStringTagged = fmap (\sep -> [sep]) pathSeparator + +-- >> Posix.toString Path.currentDir == "." +-- >> Windows.toString Path.currentDir == "." +currentDir :: (System os) => RelDir os +currentDir = Path Rel [] Dir + +{- | +This is a file with path @\"\"@. +You will not be able to create a file with this name. +We also forbid parsing @\"\"@ by 'relFile'. +You might only need this file path as intermediate step +when manipulating extensions of files like @\".bashrc\"@. +-} +emptyFile :: (System os) => RelFile os +emptyFile = Path Rel [] $ File emptyPC + +emptyPC :: PathComponent os +emptyPC = PathComponent "" + +rootName :: String +rootName = "rootDir" + +currentName :: String +currentName = "currentDir" + +currentDirComponent :: String +currentDirComponent = "." + +absDirName :: String +absDirName = "absDir" + +relPathName :: String +relPathName = "relPath" + + +------------------------------------------------------------------------ +-- Parsing Functions + +-- | This function is intended for checking and parsing paths +-- provided as user input. +-- +-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" +-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" +-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" +-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" +-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing +-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp" +-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp" +-- >> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" +-- >> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing +-- >> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" +-- >> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" +-- >> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" +-- >> fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" +-- >> fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" +-- >> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" +-- >> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing +-- >> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing +-- >> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing +-- >> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing +maybePath :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + String -> Maybe (Path os ar fd) +maybePath str = do + let (ar0, pcs0, fd0) = untag makePathComponents str + ar <- + case ar0 of + AbsO pc -> switchAbsOrRel (Just $ Abs pc) Nothing (Just ar0) + RelO -> switchAbsOrRel Nothing (Just Rel) (Just ar0) + (pcs, fd) <- + case fd0 of + Left FileOrDir -> arrangeComponents pcs0 + Right Dir -> + fmap ((,) pcs0) $ + switchFileOrDir Nothing (Just Dir) (Just FileOrDir) + return $ Path ar pcs fd + +parsePath :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + String -> Either String (Path os ar fd) +parsePath = pathWithNames arName fdName + +pathWithNames :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Const String ar -> Const String fd -> + String -> Either String (Path os ar fd) +pathWithNames (Const ar) (Const fd) str = + maybe (Left (printf "\"%s\" is not a valid %s%spath" str ar fd)) Right $ + maybePath str + +arName :: (AbsOrRelClass ar) => Const String ar +arName = switchAbsOrRel (Const "absolute ") (Const "relative ") (Const "") + +fdName :: (FileOrDirClass fd) => Const String fd +fdName = switchFileOrDir (Const "file ") (Const "directory ") (Const "") + +------------------------------------------------------------------------ +-- Checked Construction Functions + +-- | This function is intended for converting path strings +-- with known content, e.g. string literals, to the 'Path' type. +path :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + String -> Path os ar fd +path = either error id . parsePath + +-- | Construct a 'RelFile' from a 'String'. +-- +-- >> Posix.toString (Posix.relFile "file.txt") == "file.txt" +-- >> Posix.toString (Posix.relFile "tmp") == "tmp" +relFile :: (System os) => String -> RelFile os +relFile = path + +-- | Construct a 'RelDir' from a 'String'. +-- +-- >> Posix.toString (Posix.relDir ".") == "." +-- >> Posix.toString (Posix.relDir "file.txt") == "file.txt" +-- >> Posix.toString (Posix.relDir "tmp") == "tmp" +relDir :: (System os) => String -> RelDir os +relDir = path + +-- | Construct an 'AbsFile' from a 'String'. +-- +-- >> Posix.toString (Posix.absFile "/file.txt") == "/file.txt" +-- >> Posix.toString (Posix.absFile "/tmp") == "/tmp" +absFile :: (System os) => String -> AbsFile os +absFile = path + +-- | Construct an 'AbsDir' from a 'String'. +-- +-- >> Posix.toString (Posix.absDir "/file.txt") == "/file.txt" +-- >> Posix.toString (Posix.absDir "/tmp") == "/tmp" +absDir :: (System os) => String -> AbsDir os +absDir = path + +-- | Construct a 'RelPath fd' from a 'String'. +relPath :: (System os, FileOrDirClass fd) => String -> RelPath os fd +relPath = path + +-- | Construct an 'AbsPath fd' from a 'String'. +absPath :: (System os, FileOrDirClass fd) => String -> AbsPath os fd +absPath = path + +-- | Construct a 'FilePath ar' from a 'String'. +filePath :: (System os, AbsOrRelClass ar) => String -> FilePath os ar +filePath = path + +-- | Construct a 'DirPath ar' from a 'String'. +dirPath :: (System os, AbsOrRelClass ar) => String -> DirPath os ar +dirPath = path + + + +idAbsOrRel :: AbsOrRelPath os fd -> AbsOrRelPath os fd +idAbsOrRel = id + +idAbs :: AbsPath os fd -> AbsPath os fd +idAbs = id + +idRel :: RelPath os fd -> RelPath os fd +idRel = id + + +idFileOrDir :: FileOrDirPath os fd -> FileOrDirPath os fd +idFileOrDir = id + +idFile :: FilePath os fd -> FilePath os fd +idFile = id + +idDir :: DirPath os fd -> DirPath os fd +idDir = id + + +{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-} +{-# DEPRECATED asRelFile "Use 'relFile' instead." #-} +{-# DEPRECATED asRelDir "Use 'relDir' instead." #-} +{-# DEPRECATED asAbsFile "Use 'absFile' instead." #-} +{-# DEPRECATED asAbsDir "Use 'absDir' instead." #-} +{-# DEPRECATED asRelPath "Use 'relPath' instead." #-} +{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-} +{-# DEPRECATED asFilePath "Use 'filePath' instead." #-} +{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-} + +------------------------------------------------------------------------ +-- 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. +-- You should not use this and other @as*@ functions, +-- since they may silently turn a relative path to an absolute one, +-- or vice versa, or they may accept a path as file path +-- although it ends on a slash. +-- If you are certain about the string content +-- then you should use 'path'. +-- If you got the string as user input then use 'maybePath' or 'parsePath'. +-- +-- >> Posix.asPath "/tmp" == Posix.absDir "/tmp" +-- >> Posix.asPath "file.txt" == Posix.relFile "file.txt" +-- >> Path.isAbsolute (Posix.asAbsDir "/tmp") +-- >> Path.isRelative (Posix.asRelDir "/tmp") +-- >> Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" +-- >> Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" +-- >> Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" +-- >> Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" +-- >> Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp" +-- >> Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp" +asPath :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => String -> Path os ar fd +asPath = uncurry mkPathFromComponents . untag mkPathComponents + + +-- | Use a 'String' as a 'RelFile'. No checking is done. +-- +-- >> Posix.toString (Posix.asRelFile "file.txt") == "file.txt" +-- >> Posix.toString (Posix.asRelFile "/file.txt") == "file.txt" +-- >> Posix.toString (Posix.asRelFile "tmp") == "tmp" +-- >> Posix.toString (Posix.asRelFile "/tmp") == "tmp" +asRelFile :: (System os) => String -> RelFile os +asRelFile = asPath + +-- | Use a 'String' as a 'RelDir'. No checking is done. +-- +-- >> Posix.toString (Posix.asRelDir ".") == "." +-- >> Posix.toString (Posix.asRelDir "file.txt") == "file.txt" +-- >> Posix.toString (Posix.asRelDir "/file.txt") == "file.txt" +-- >> Posix.toString (Posix.asRelDir "tmp") == "tmp" +-- >> Posix.toString (Posix.asRelDir "/tmp") == "tmp" +asRelDir :: (System os) => String -> RelDir os +asRelDir = asPath + +-- | Use a 'String' as an 'AbsFile'. No checking is done. +-- +-- >> Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt" +-- >> Posix.toString (Posix.asAbsFile "/tmp") == "/tmp" +asAbsFile :: (System os) => String -> AbsFile os +asAbsFile = asPath + +-- | Use a 'String' as an 'AbsDir'. No checking is done. +-- +-- >> Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt" +-- >> Posix.toString (Posix.asAbsDir "/tmp") == "/tmp" +asAbsDir :: (System os) => String -> AbsDir os +asAbsDir = asPath + +-- | Use a 'String' as a 'RelPath fd'. No checking is done. +asRelPath :: (System os, FileOrDirClass fd) => String -> RelPath os fd +asRelPath = asPath + +-- | Use a 'String' as an 'AbsPath fd'. No checking is done. +asAbsPath :: (System os, FileOrDirClass fd) => String -> AbsPath os fd +asAbsPath = asPath + +-- | Use a 'String' as a 'FilePath ar'. No checking is done. +asFilePath :: (System os, AbsOrRelClass ar) => String -> FilePath os ar +asFilePath = asPath + +-- | Use a 'String' as a 'DirPath ar'. No checking is done. +asDirPath :: (System os, AbsOrRelClass ar) => String -> DirPath os ar +asDirPath = asPath + +-- | Forbid use of OverloadedStrings and prevent custom orphan instances +instance + (ForbiddenSystem os, ForbiddenAbsRel ar, ForbiddenFileDir fd) => + IsString (Path os ar fd) where fromString = forbiddenFromString + +class System os => ForbiddenSystem os where + forbiddenFromString :: String -> Path os ar fd + +class AbsRelClass ar => ForbiddenAbsRel ar where +class FileDirClass fd => ForbiddenFileDir fd where + +------------------------------------------------------------------------ +-- Checked Construction Functions + +-- | Examines the supplied string and constructs an absolute or +-- relative path as appropriate. +-- +-- >> Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp") +-- >> Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp") +-- >> Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp") +-- >> Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp") +-- >> Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp") +-- >> Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp") +mkPathAbsOrRel :: + (System os, FileOrDirClass fd) => + String -> Either (AbsPath os fd) (RelPath os fd) +mkPathAbsOrRel = eitherAbsOrRel . asPath + +eitherAbsOrRel :: AbsOrRelPath os fd -> Either (AbsPath os fd) (RelPath os fd) +eitherAbsOrRel (Path ar pcs fd) = + case ar of + AbsO drive -> Left $ Path (Abs drive) pcs fd + RelO -> Right $ Path Rel pcs fd + +-- | 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 :: + (System os, AbsOrRelClass ar) => + String -> IO (Maybe (Either (FilePath os ar) (DirPath os 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. +-- +-- >> Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt" +-- >> Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt" +mkAbsPath :: + (System os, FileOrDirClass fd) => AbsDir os -> String -> AbsPath os fd +mkAbsPath d = either id (makeAbsolute d) . mkPathAbsOrRel + +-- | Convert a 'String' into an 'AbsPath' by interpreting it as +-- relative to the cwd if necessary. +mkAbsPathFromCwd :: + (System os, FileOrDirClass fd) => String -> IO (AbsPath os fd) +mkAbsPathFromCwd = either return makeAbsoluteFromCwd . mkPathAbsOrRel + + +------------------------------------------------------------------------ +-- Internal Functions for GenComponent manipulation + +mkPathFromComponents :: + (FileOrDirClass fd) => ar -> [PathComponent os] -> Path os ar fd +mkPathFromComponents ar pcs = + uncurry (Path ar) $ + switchFileOrDir + (mapSnd File $ + ListHT.switchR ([], emptyPC) (curry $ mapSnd untagPC) pcs) + (pcs, Dir) + (pcs, FileOrDir) + +maybePathFromComponents :: + (FileOrDirClass fd) => ar -> [PathComponent os] -> Maybe (Path os ar fd) +maybePathFromComponents ar pcs = + fmap (uncurry $ Path ar) $ arrangeComponents pcs + +arrangeComponents :: + (FileOrDirClass fd) => [PathComponent os] -> Maybe ([PathComponent os], fd) +arrangeComponents pcs = + getCompose $ + switchFileOrDir + (Compose $ fmap (mapSnd (File . untagPC)) $ ListHT.viewR pcs) + (Compose $ Just (pcs, Dir)) + (Compose $ Just (pcs, FileOrDir)) + +mkPathComponents :: + (System os, AbsOrRelClass ar) => + Tagged os (String -> (ar, [PathComponent os])) +mkPathComponents = + liftA2 + (\isSep splDriveOS -> + mapSnd (nonEmptyComponents . ListHT.chop isSep) + . MS.runState splDriveOS) + isPathSeparator splitDriveOS + +{- | +Parse path string independent from expectations +expressed by the type parameters. +-} +makePathComponents :: + (System os) => + Tagged os (String -> (AbsOrRel, [PathComponent os], Either FileOrDir Dir)) +makePathComponents = + liftA2 + (\isSep splAbsolute str -> + let (ar, pct) = + mapSnd (ListHT.chop isSep) $ + MS.runState splAbsolute str + (pcs1, fd) = + case ListHT.viewR pct of + Nothing -> ([], Right Dir) + Just (pcs, pc) -> + if null pc -- caused by trailing slash + then (pcs, Right Dir) + else (pct, Left FileOrDir) + in (ar, nonEmptyComponents pcs1, fd)) + isPathSeparator splitAbsoluteO + +nonEmptyComponents :: [String] -> [PathComponent os] +nonEmptyComponents = map PathComponent . filter (not . null) + +splitDriveOS :: + (System os, AbsOrRelClass ar) => Tagged os (MS.State String ar) +splitDriveOS = + liftA2 + (\splDrive splAbsolute -> + switchAbsOrRel (fmap absPC splDrive) (return Rel) splAbsolute) + splitDriveAbs splitAbsoluteO + +splitDriveAbs :: (System os) => Tagged os (MS.State String String) +splitDriveAbs = + liftA2 + (\isSep splDrive -> do + drive <- splDrive + xt <- MS.get + case xt of + [] -> return drive + x:xs -> + if isSep x + then MS.put xs >> return (drive++[x]) + else return drive) + isPathSeparator splitDrive + +splitAbsoluteO :: (System os) => Tagged os (MS.State String AbsOrRel) +splitAbsoluteO = + fmap (\drive -> if null drive then RelO else AbsO $ PathComponent drive) + <$> + splitAbsolute + +pathComponents :: + (FileOrDirClass fd) => Path os ar fd -> (ar, [PathComponent os]) +pathComponents (Path ar pcs fd) = + (ar, pcs ++ fileOrDirPlain ((:[]) . retagPC) [] [] fd) + +prop_mkPathFromComponents_pathComponents :: (System os) => AbsDir os -> Property +prop_mkPathFromComponents_pathComponents p = + property $ uncurry mkPathFromComponents (pathComponents p) == p + + + +------------------------------------------------------------------------ +-- Basic Manipulation Functions + +combineOperator :: String +combineOperator = "" + + +instance (IsRel ar, IsDir fd) => Monoid (Path os ar fd) where + mempty = Path relVar [] dirVar + mappend (Path rel pcs0 _dir) (Path _rel pcs1 dir) = + Path rel (pcs0 ++ pcs1) dir + mconcat paths = + Path relVar (concatMap (\(Path _rel pcs _dir) -> pcs) paths) dirVar + +relVar :: IsRel ar => ar +relVar = unwrapAbsRel $ switchRel $ WrapAbsRel Rel + +dirVar :: IsDir fd => fd +dirVar = unwrapFileDir $ switchDir $ WrapFileDir Dir + + +-- | Infix variant of 'combine'. +-- +-- >> Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt" +-- >> Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt" +-- >> Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt" +-- >> Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt" +-- >> Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" +-- >> Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" +-- >> Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" +-- >> Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" +-- >> Windows.toString (Windows.relDir "dir" Windows.relFile "file.txt") == "dir\\file.txt" +() :: DirPath os ar -> RelPath os fd -> Path os ar fd +Path ar pcs0 Dir Path Rel pcs1 fd = Path ar (pcs0 ++ pcs1) fd + +infixr 5 + +-- | Infix variant of 'addExtension'. +-- We only allow files (and not directories) to have extensions added +-- by this function. This is because it's the vastly common case and +-- an attempt to add one to a directory will - more often than not - +-- represent an error. +-- We don't however want to prevent the corresponding operation on +-- directories, and so we provide a function that is more flexible: +-- 'genericAddExtension'. +(<.>) :: FilePath os ar -> String -> FilePath os ar +p <.> ext = mapFilePart (flip addExtensionPC ext) p + +infixl 7 <.> + +(<++>) :: FilePath os ar -> String -> FilePath os ar +p <++> str = mapFileName (++str) p + +infixl 7 <++> + +-- | Add an extension, even if there is already one there. +-- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@. +-- +-- >> Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib" +-- >> Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib" +-- >> Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib" +-- >> Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib" +-- >> Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib" +-- >> Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext" +addExtension :: FilePath os ar -> String -> FilePath os ar +addExtension = (<.>) + +-- | Join an (absolute or relative) directory path with a relative +-- (file or directory) path to form a new path. +combine :: DirPath os ar -> RelPath os fd -> Path os ar fd +combine = () + +prop_combine_currentDir :: (System os) => RelDir os -> Property +prop_combine_currentDir p = property $ combine currentDir p == p + + +-- | Remove last extension, and the \".\" preceding it. +-- +-- >> Path.dropExtension x == fst (Path.splitExtension x) +dropExtension :: FilePath os ar -> FilePath os ar +dropExtension = fst . splitExtension + +-- | Drop all extensions +-- +-- >> not $ Path.hasAnExtension (Path.dropExtensions x) +dropExtensions :: FilePath os ar -> FilePath os ar +dropExtensions = fst . splitExtensions + +-- | Synonym for 'takeDirectory' +dropFileName :: FilePath os ar -> DirPath os ar +dropFileName = fst . splitFileName + + +-- | Set the extension of a file, overwriting one if already present. +-- +-- >> Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob" +-- >> Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob" +-- >> Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob" +-- >> Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file" +-- >> Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt" +replaceExtension :: FilePath os ar -> String -> FilePath os ar +replaceExtension p ext = dropExtension p <.> ext + +replaceBaseName :: FilePath os ar -> String -> FilePath os ar +replaceBaseName p bn = + mapFilePart (addExtensionPC (PathComponent bn) . snd . splitExtensionPC) p + +replaceDirectory :: FilePath os ar1 -> DirPath os ar2 -> FilePath os ar2 +replaceDirectory (Path _ _ fd) (Path ar pcs _) = Path ar pcs fd + +replaceFileName :: FilePath os ar -> String -> FilePath os ar +replaceFileName p fn = mapFilePart (const (PathComponent fn)) p + + +-- | Split on the extension. 'addExtension' is the inverse. +-- +-- >> uncurry (<.>) (Path.splitExtension x) == x +-- >> uncurry Path.addExtension (Path.splitExtension x) == x +-- >> Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt") +-- >> Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc") +-- >> Path.splitExtension (relFile "file") == (Posix.relFile "file","") +-- >> Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt") +-- >> Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","") +-- >> Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext") +-- >> Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred") +splitExtension :: FilePath os ar -> (FilePath os ar, String) +splitExtension = splitFilePart splitExtensionPC + +-- | Split on all extensions +-- +-- >> Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz") +splitExtensions :: FilePath os ar -> (FilePath os ar, String) +splitExtensions = splitFilePart splitExtensionsPC + +prop_split_combineExt :: (System os) => AbsFile os -> Property +prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p) + +splitFileName :: FilePath os ar -> (DirPath os ar, RelFile os) +splitFileName (Path ar pcs fd) = (Path ar pcs Dir, Path Rel [] fd) + +prop_split_combine :: (System os) => AbsFile os -> Property +prop_split_combine p = property $ uncurry combine (splitFileName p) == p + + +-- | Get the basename of a file +-- +-- >> Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile" +-- >> Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile" +-- >> Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile" +takeBaseName :: FilePath os ar -> RelFile os +takeBaseName = takeFileName . dropExtension + +takeDirectory :: FilePath os ar -> DirPath os ar +takeDirectory = fst . splitFileName + +-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. +-- +-- >> Path.takeExtension x == snd (Path.splitExtension x) +-- >> Path.takeExtension (Path.addExtension x "ext") == ".ext" +-- >> Path.takeExtension (Path.replaceExtension x "ext") == ".ext" +takeExtension :: FilePath os ar -> String +takeExtension = snd . splitExtension + +-- | Get all extensions +-- +-- >> Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz" +takeExtensions :: FilePath os ar -> String +takeExtensions = snd . splitExtensions + +-- | Get the filename component of a file path (ie stripping all parent dirs) +-- +-- >> Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt" +-- >> Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt" +-- >> Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt" +takeFileName :: FilePath os ar -> RelFile os +takeFileName (Path _ _ fd) = Path Rel [] fd + +prop_takeFileName_end :: (System os) => AbsFile os -> Property +prop_takeFileName_end p = + property $ getPathString (takeFileName p) `isSuffixOf` getPathString p + +mapFileName :: (String -> String) -> FilePath os ar -> FilePath os ar +mapFileName = mapFilePart . pcMap + + +------------------------------------------------------------------------ +-- Auxillary Manipulation Functions + +-- | Check whether two strings are equal as file paths. +-- +-- >> Posix.equalFilePath "abc/def" "abc/def" +-- >> Posix.equalFilePath "abc/def" "abc//def" +-- >> Posix.equalFilePath "/tmp/" "/tmp" +-- >> Posix.equalFilePath "/tmp" "//tmp" +-- >> Posix.equalFilePath "/tmp" "///tmp" +-- >> not $ Posix.equalFilePath "abc" "def" +-- >> not $ Posix.equalFilePath "/tmp" "tmp" +-- >> Windows.equalFilePath "abc\\def" "abc\\def" +-- >> Windows.equalFilePath "abc\\def" "abc\\\\def" +-- >> Windows.equalFilePath "file" "File" +-- >> Windows.equalFilePath "\\file" "\\\\file" +-- >> Windows.equalFilePath "\\file" "\\\\\\file" +-- >> not $ Windows.equalFilePath "abc" "def" +-- >> not $ Windows.equalFilePath "file" "dir" +equalFilePath :: (System os) => Tagged os (String -> String -> Bool) +equalFilePath = equating <$> mkPathAbsOrRelTagged + +mkPathAbsOrRelTagged :: + (System os) => + Tagged os (String -> Either (AbsFileOrDir os) (RelFileOrDir os)) +mkPathAbsOrRelTagged = Tagged mkPathAbsOrRel + +-- | Constructs a 'RelPath' from a list of components. +-- It is an unchecked error if the path components contain path separators. +-- It is an unchecked error if a 'RelFile' path is empty. +-- +-- >> Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir" +-- >> Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt" +joinPath :: (FileOrDirClass fd) => [String] -> RelPath os fd +joinPath = mkPathFromComponents Rel . map PathComponent + +-- | Currently just transforms: +-- +-- >> Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file" +normalise :: (System os) => Path os ar fd -> Path os ar fd +normalise = mapPathDirs (filter (PathComponent currentDirComponent /=)) + +-- | Deconstructs a path into its components. +-- +-- >> Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing) +-- >> Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt") +splitPath :: + (AbsOrRelClass ar, FileDirClass fd) => + Path os ar fd -> (Bool, [RelDir os], Maybe (RelFile os)) +splitPath (Path ar pcs fd) = + (isAbsolutePlain ar, + map (\pc -> Path Rel [pc] Dir) pcs, + maybeFileDir fd) + +isAbsolutePlain :: (AbsOrRelClass ar) => ar -> Bool +isAbsolutePlain = absRelPlain (const True) False + +maybeFileDir :: (FileDirClass fd) => fd -> Maybe (RelFile os) +maybeFileDir = fileDirPlain (Just . Path Rel [] . File) Nothing + +-- | This function can be used to construct a relative path by removing +-- the supplied 'AbsDir' from the front. It is a runtime 'error' if the +-- supplied 'AbsPath' doesn't start with the 'AbsDir'. +-- +-- >> Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt" +-- >> Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir" +-- >> Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt" +-- >> Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" +-- >> Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" +makeRelative :: + (System os, FileOrDirClass fd) => + AbsDir os -> AbsPath os fd -> RelPath os fd +makeRelative relTo orig = + fromMaybe + (error $ + printf "System.Path can't make (%s) relative to (%s)" + (getPathString orig) (getPathString relTo)) $ + makeRelativeMaybe relTo orig + +-- >> Path.makeRelativeMaybe (Posix.absDir "/tmp/somedir") (absFile "/tmp/anotherdir/file.txt") == Nothing +-- >> Path.makeRelativeMaybe (Posix.absDir "/Tmp") (absFile "/tmp/anotherdir/file.txt") == Nothing +-- >> Path.makeRelativeMaybe (Windows.absDir "\\Tmp") (absFile "\\tmp\\anotherdir\\file.txt") == Just (relFile "anotherdir\\file.txt") +makeRelativeMaybe :: + (System os, FileOrDirClass fd) => + AbsDir os -> AbsPath os fd -> Maybe (RelPath os fd) +makeRelativeMaybe relTo orig = + case (inspectPath relTo, inspectPath orig) of + ((relToAR, relToPCs, WrapFileDir Dir), + (origAR, origPCs, WrapFileDir fd)) -> + fmap (flip (Path Rel) fd) $ + guard (relToAR == origAR) >> stripPrefix relToPCs origPCs + +-- | Joins an absolute directory with a relative path to construct a +-- new absolute path. +-- +-- >> Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" +-- >> Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" +-- >> Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir" +makeAbsolute :: (System os) => AbsDir os -> RelPath os fd -> AbsPath os fd +makeAbsolute = genericMakeAbsolute + +-- | Converts a relative path into an absolute one by +-- prepending the current working directory. +makeAbsoluteFromCwd :: (System os) => RelPath os fd -> IO (AbsPath os fd) +makeAbsoluteFromCwd = genericMakeAbsoluteFromCwd + +dynamicMakeAbsolute :: + (System os) => AbsDir os -> AbsOrRelPath os fd -> AbsPath os fd +dynamicMakeAbsolute = genericMakeAbsolute + +dynamicMakeAbsoluteFromCwd :: + (System os) => AbsOrRelPath os fd -> IO (AbsPath os fd) +dynamicMakeAbsoluteFromCwd = genericMakeAbsoluteFromCwd + +-- | As for 'makeAbsolute', but for use when the path may already be +-- absolute (in which case it is left unchanged). +-- You should avoid the use of 'genericMakeAbsolute'-type functions, +-- because then you avoid to absolutize a path that was already absolutized. +-- +-- >> Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" +-- >> Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" +-- >> Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt" +genericMakeAbsolute :: + (System os, AbsOrRelClass ar) => AbsDir os -> Path os ar fd -> AbsPath os 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 :: + (System os, AbsOrRelClass ar) => Path os ar fd -> IO (AbsPath os 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 :: + (System os) => AbsDir os -> RelFile os -> Property +prop_makeAbsoluteFromDir_endSame base p = + property $ getPathString p `isSuffixOf` getPathString (makeAbsolute base p) + +prop_makeAbsoluteFromDir_startSame :: + (System os) => AbsDir os -> RelFile os -> Property +prop_makeAbsoluteFromDir_startSame base p = + property $ getPathString base `isPrefixOf` getPathString (makeAbsolute base p) + +-- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir os -> AbsFile -> Property +-- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p) + + +-- | Convert a file to a directory path. +-- Obviously, the corresponding disk object won't change accordingly. +-- The purpose of this function is to be an intermediate step +-- when deriving a directory name from a file name. +dirFromFile :: FilePath os ar -> DirPath os ar +dirFromFile p = uncurry Path (pathComponents p) Dir + +-- | Convert a directory to a file path. +-- The function returns 'Nothing' if the directory path is empty. +-- The purpose of this function is to be an intermediate step +-- when deriving a file name from a directory name. +fileFromDir :: DirPath os ar -> Maybe (FilePath os ar) +fileFromDir = fileFromAny + +toFileOrDir :: (FileOrDirClass fd) => Path os ar fd -> FileOrDirPath os ar +toFileOrDir p = uncurry Path (pathComponents p) FileOrDir + +fromFileOrDir :: + (FileOrDirClass fd) => FileOrDirPath os ar -> Maybe (Path os ar fd) +fromFileOrDir p = + switchFileOrDirPath + (fileFromFileOrDir p) + (Just $ dirFromFileOrDir p) + (Just p) + +fileFromFileOrDir :: FileOrDirPath os ar -> Maybe (FilePath os ar) +fileFromFileOrDir = fileFromAny + +fileFromAny :: Path os ar fd -> Maybe (FilePath os ar) +fileFromAny (Path ar pcs _) = + fmap (uncurry (Path ar) . mapSnd (File . untagPC)) $ ListHT.viewR pcs + +dirFromFileOrDir :: FileOrDirPath os ar -> DirPath os ar +dirFromFileOrDir (Path ar pcs FileOrDir) = Path ar pcs Dir + + +------------------------------------------------------------------------ +-- 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. +-- +-- >> Path.isAbsolute (Posix.absFile "/fred") +-- >> Path.isAbsolute (Windows.absFile "\\fred") +-- >> Path.isAbsolute (Windows.absFile "c:\\fred") +-- >> Path.isAbsolute (Windows.absFile "c:fred") +isAbsolute :: AbsOrRelClass ar => Path os ar fd -> Bool +isAbsolute = absRel (const True) (const False) + +-- | Invariant - this should return True iff arg is of type @'Path' Rel _@ +-- +-- > isRelative = not . isAbsolute +-- >> Path.isRelative (Posix.relFile "fred") +-- >> Path.isRelative (Windows.relFile "fred") +isRelative :: AbsOrRelClass ar => Path os ar fd -> Bool +isRelative = not . isAbsolute + + +{- | +Test whether the 'String' would correspond +to an absolute path if interpreted as a 'Path'. +-} +isAbsoluteString :: (System os) => Tagged os (String -> Bool) +isAbsoluteString = + fmap (\split -> not . null . MS.evalState split) splitAbsolute + +{- | +Test whether the 'String' would correspond +to a relative path if interpreted as a 'Path'. + +> isRelativeString = not . isAbsoluteString +-} +isRelativeString :: (System os) => Tagged os (String -> Bool) +isRelativeString = (not .) <$> isAbsoluteString + + +-- | Does the given filename have an extension? +-- +-- >> null (Path.takeExtension x) == not (Path.hasAnExtension x) +hasAnExtension :: FilePath os ar -> Bool +hasAnExtension = not . null . snd . splitExtension + +-- | Does the given filename have the given extension? +-- +-- >> Path.hasExtension ".hs" (Posix.relFile "MyCode.hs") +-- >> Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs") +-- >> not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak") +hasExtension :: String -> FilePath os ar -> Bool +hasExtension ext = (==ext) . snd . splitExtension + + +------------------------------------------------------------------------ +-- Separators + +-- | File extension character +-- +-- >> Posix.extSeparator == '.' +extSeparator :: Char +extSeparator = '.' + +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +searchPathSeparator :: Char +searchPathSeparator = ':' + +-- | Is the character an extension character? +-- +-- >> Posix.isExtSeparator a == (a == Posix.extSeparator) +isExtSeparator :: Char -> Bool +isExtSeparator = (== extSeparator) + +-- | Is the character a file separator? +-- +-- >> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator) +isSearchPathSeparator :: Char -> Bool +isSearchPathSeparator = (== searchPathSeparator) + + +------------------------------------------------------------------------ +-- Generic Manipulation Functions + +-- These functions support manipulation of extensions on directories +-- as well as files. They have looser types than the corresponding +-- 'Basic Manipulation Functions', but it is expected that the basic +-- functions will be used more frequently as they provide more checks. + +-- | This is a more flexible variant of 'addExtension' / '<.>' which can +-- work with files or directories +-- +-- >> Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x" +-- >> Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x" +-- >> Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x" +-- >> Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile +genericAddExtension :: + (FileOrDirClass fd) => Path os ar fd -> String -> Path os ar fd +genericAddExtension = + flip $ \ext -> + appEndo $ MonHT.when (not $ null ext) $ + switchFileOrDirPath + (Endo $ flip addExtension ext) + (Endo $ componentsAddExtension ext) + (Endo $ componentsAddExtension ext) + +componentsAddExtension :: String -> Path os ar fd -> Path os ar fd +componentsAddExtension ext (Path ar pcs0 fd) = + let pcs = if null pcs0 then [emptyPC] else pcs0 + in Path ar (mapLast (flip addExtensionPC ext) pcs) fd + +genericDropExtension :: (FileOrDirClass fd) => Path os ar fd -> Path os ar fd +genericDropExtension = fst . genericSplitExtension + +genericDropExtensions :: (FileOrDirClass fd) => Path os ar fd -> Path os ar fd +genericDropExtensions = fst . genericSplitExtensions + +genericSplitExtension :: + (FileOrDirClass fd) => Path os ar fd -> (Path os ar fd, String) +genericSplitExtension = + runSplitExtension $ + switchFileOrDirPath + (SplitExtension splitExtension) + (SplitExtension componentsSplitExtension) + (SplitExtension componentsSplitExtension) + +componentsSplitExtension :: Path os ar b -> (Path os ar b, String) +componentsSplitExtension (Path ar pcs fd) = + mapFst (flip (Path ar) fd) $ + mapLastPair + (error "genericSplitExtension: empty path") + splitExtensionPC pcs + +genericSplitExtensions :: + (FileOrDirClass fd) => Path os ar fd -> (Path os ar fd, String) +genericSplitExtensions = + runSplitExtension $ + switchFileOrDirPath + (SplitExtension splitExtensions) + (SplitExtension componentsSplitExtensions) + (SplitExtension componentsSplitExtensions) + +componentsSplitExtensions :: Path os ar b -> (Path os ar b, String) +componentsSplitExtensions (Path ar pcs fd) = + mapFst (flip (Path ar) fd) $ + mapLastPair + (error "genericSplitExtensions: empty path") + splitExtensionsPC pcs + +genericTakeExtension :: (FileOrDirClass fd) => Path os ar fd -> String +genericTakeExtension = snd . genericSplitExtension + +genericTakeExtensions :: (FileOrDirClass fd) => Path os ar fd -> String +genericTakeExtensions = snd . genericSplitExtension + +newtype + SplitExtension path = + SplitExtension {runSplitExtension :: path -> (path, String)} + + +-- move to utility-ht +mapLast :: (a -> a) -> [a] -> [a] +mapLast f xs = zipWith id (drop 1 $ map (const id) xs ++ [f]) xs + +mapLastPair :: b -> (a -> (a,b)) -> [a] -> ([a], b) +mapLastPair b f = + ListHT.switchR ([], b) (\as a -> mapFst ((as++) . (:[])) $ f a) + +mapLastPairFoldr :: b -> (a -> (a,b)) -> [a] -> ([a], b) +mapLastPairFoldr b _ [] = ([], b) +mapLastPairFoldr _ f (x:xs) = + foldr + (\y1 go y0 -> mapFst (y0:) $ go y1) + (\y -> mapFst (:[]) $ f y) + xs x + +mapLastPairRec :: b -> (a -> (a,b)) -> [a] -> ([a], b) +mapLastPairRec b _ [] = ([], b) +mapLastPairRec _ f (x:xs) = + let go y [] = mapFst (:[]) $ f y + go y0 (y1:ys) = mapFst (y0:) $ go y1 ys + in go x xs + +mapLastPairRev :: b -> (a -> (a,b)) -> [a] -> ([a], b) +mapLastPairRev b0 f xs = + case reverse xs of + [] -> (xs, b0) + y:ys -> + let (a, b) = f y + in (reverse ys ++ [a], b) + +_prop_mapLastPair :: String -> Int -> [String] -> Bool +_prop_mapLastPair b n strs = + let f = splitAt n + in all (mapLastPair b f strs ==) $ + mapLastPairFoldr b f strs : + mapLastPairRev b f strs : + mapLastPairRec b f strs : + [] + + +addExtensionPC :: PathComponent os -> String -> PathComponent os +addExtensionPC p "" = p +addExtensionPC (PathComponent pc) ext = + PathComponent $ pc ++ + if [extSeparator] `isPrefixOf` ext + then ext + else extSeparator : ext + +splitExtensionPC :: PathComponent os -> (PathComponent os, String) +splitExtensionPC (PathComponent s) = + mapFst PathComponent $ + maybe (s, "") (mapFst concat) $ + ((\p@(pcs,_) -> toMaybe (not (null pcs)) p) =<<) $ ListHT.viewR $ + ListHT.segmentBefore isExtSeparator s + +_splitExtensionPC :: PathComponent os -> (PathComponent os, String) +_splitExtensionPC (PathComponent s) = + mapFst PathComponent $ + case break isExtSeparator $ reverse s of + (_, "") -> (s, "") + (rext, dot:rstem) -> (reverse rstem, dot : reverse rext) + +splitExtensionsPC :: PathComponent os -> (PathComponent os, String) +splitExtensionsPC (PathComponent s) = + mapFst PathComponent $ break isExtSeparator s + + + +class System os where + -- | The character that separates directories. In the case where more than + -- one character is possible, 'pathSeparator' is the \'ideal\' one. + -- + -- >> Posix.isPathSeparator Posix.pathSeparator + pathSeparator :: Tagged os Char + + -- | The list of all possible separators. + -- + -- >> Posix.pathSeparator `elem` Posix.pathSeparators + pathSeparators :: Tagged os [Char] + pathSeparators = (:[]) <$> pathSeparator + + -- | Rather than using @(== 'pathSeparator')@, use this. Test if something + -- is a path separator. + -- + -- >> Posix.isPathSeparator a == (a `elem` Posix.pathSeparators) + isPathSeparator :: Tagged os (Char -> Bool) + isPathSeparator = flip elem <$> pathSeparators + + splitAbsolute :: Tagged os (MS.State String String) + + canonicalize :: Tagged os (String -> String) + + splitDrive :: Tagged os (MS.State String String) + genDrive :: Tagged os (Gen String) + + +{- | +Check internal integrity of the path data structure. +-} +isValid :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Path os ar fd -> Bool +isValid = untag isValidTagged + +isValidTagged :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Tagged os (Path os ar fd -> Bool) +isValidTagged = + fmap + (\isValidPC (Path ar pcs fd) -> + absRelPlain isValidComponent True ar + && + all isValidPC pcs + && + fileOrDirPlain (isValidPC . retagPC) True True fd) + isValidPathComponent + +isValidComponent :: String -> Bool +isValidComponent = not . null + +isValidPathComponent :: + (System os) => Tagged os (PathComponent os -> Bool) +isValidPathComponent = + fmap + (\isSep (PathComponent str) -> + isValidComponent str && not (any isSep str)) + isPathSeparator + +------------------------------------------------------------------------ +-- QuickCheck + +testAll :: (System os) => os -> [(String, IO ())] +testAll os = + ("asPath_getPathString", + quickCheck os prop_asPath_getPathString) : + ("mkPathFromComponents_pathComponents", + quickCheck os prop_mkPathFromComponents_pathComponents) : + ("combine_currentDir", + quickCheck os prop_combine_currentDir) : + ("makeAbsoluteFromDir_endSame", + quickCheck os prop_makeAbsoluteFromDir_endSame) : + ("makeAbsoluteFromDir_startSame", + quickCheck os prop_makeAbsoluteFromDir_startSame) : + ("split_combine", + quickCheck os prop_split_combine) : + ("takeFileName_end", + quickCheck os prop_takeFileName_end) : + ("split_combineExt", + quickCheck os prop_split_combineExt) : + [] + +quickCheck :: + (QC.Testable prop, System os, FileOrDirClass fd, AbsOrRelClass ar) => + os -> (Path os ar fd -> prop) -> IO () +quickCheck _ = QC.quickCheck + +-- test :: Testable a => a -> IO () +-- test = quickCheck + +qcFileComponent :: Gen (PathComponent os) +qcFileComponent = PathComponent <$> frequency [ + (1, return "someFile"), + (1, return "fileWith.ext"), + (1, return "file.with.multiple.exts"), + (1, return "file with spcs") + ] + +qcDirComponent :: Gen (PathComponent os) +qcDirComponent = PathComponent <$> frequency [ + (1, return "someDir"), + (1, return "aDir"), + (1, return "aFolder"), + (1, return "a folder"), + (1, return "directory") + ] + + +qcAbsRel :: (System os, AbsOrRelClass ar) => Tagged os (Gen ar) +qcAbsRel = + flip fmap genDrive $ \drive -> + switchAbsOrRel (fmap absPC drive) (return Rel) + (QC.oneof [fmap (AbsO . PathComponent) drive, return RelO]) + +qcGenPath :: + Tagged os (Gen ar) -> + (Gen ar -> Gen (Path os ar fd)) -> + Gen (Path os ar fd) +qcGenPath qcAR gen = gen $ untag qcAR + +qcFilePath :: (System os, AbsOrRelClass ar) => Gen (FilePath os ar) +qcFilePath = qcGenPath qcAbsRel $ \qcAR -> do + ar <- qcAR + pcs <- QC.listOf qcDirComponent + pc <- qcFileComponent + return $ Path ar pcs $ File pc + +qcDirPath :: (System os, AbsOrRelClass ar) => fd -> Gen (Path os ar fd) +qcDirPath fd = qcGenPath qcAbsRel $ \qcAR -> do + ar <- qcAR + pcs <- QC.listOf qcDirComponent + return $ Path ar pcs fd + +qcPath :: + (System os, AbsOrRelClass ar, FileOrDirClass fd) => Gen (Path os ar fd) +qcPath = switchFileOrDirPath qcFilePath (qcDirPath Dir) (qcDirPath FileOrDir) + +instance + (System os, AbsOrRelClass ar, FileOrDirClass fd) => + Arbitrary (Path os ar fd) where arbitrary = qcPath diff --git a/src/System/Path/Posix.hs b/src/System/Path/Posix.hs --- a/src/System/Path/Posix.hs +++ b/src/System/Path/Posix.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE CPP #-} -#define MODULE_NAME Posix -#define IS_WINDOWS False - +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- | This module provides type-safe access to filepath manipulations. -- -- Normally you would import 'System.Path' (which will use the @@ -9,9 +6,197 @@ -- However, importing this explicitly allows for manipulation of -- non-native paths. -- -#ifdef __HADDOCK__ -module System.Path.Posix where -#else -#include "Internal.hs" -#endif +module System.Path.Posix ( + Path, + AbsFile, RelFile, AbsDir, RelDir, + AbsPath, RelPath, FilePath, DirPath, + AbsOrRelFile, AbsOrRelDir, AbsFileOrDir, RelFileOrDir, + AbsOrRelPath, FileOrDirPath, AbsOrRelFileOrDir, + asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath, + path, maybePath, + relFile, relDir, absFile, absDir, + relPath, absPath, filePath, dirPath, + rootDir, currentDir, emptyFile, + toString, + isAbsoluteString, isRelativeString, equalFilePath, + pathSeparator, pathSeparators, isPathSeparator, + Core.extSeparator, Core.isExtSeparator, + Core.searchPathSeparator, Core.isSearchPathSeparator, + addTrailingPathSeparator, dropTrailingPathSeparator, + hasTrailingPathSeparator, + testAll, + ) where +import qualified System.Path.RegularExpression as RegEx +import qualified System.Path.Internal as Core +import System.Path.Internal ( + Abs, Rel, AbsOrRel, File, Dir, FileOrDir, + AbsRelClass, FileDirClass, + AbsOrRelClass, FileOrDirClass, + ) + +import Data.Tagged (Tagged(Tagged), untag) + +import Prelude hiding (FilePath) + + +data Posix = Posix + +_osDummy :: Posix +_osDummy = Posix + +type Path = Core.Path Posix + +type AbsFile = Path Abs File +type RelFile = Path Rel File +type AbsDir = Path Abs Dir +type RelDir = Path Rel Dir +type AbsOrRelFile = Path AbsOrRel File +type AbsOrRelDir = Path AbsOrRel Dir +type AbsFileOrDir = Path Abs FileOrDir +type RelFileOrDir = Path Rel FileOrDir +type AbsOrRelFileOrDir = Path AbsOrRel FileOrDir + +type AbsPath fd = Path Abs fd +type RelPath fd = Path Rel fd +type FilePath ar = Path ar File +type DirPath ar = Path ar Dir +type AbsOrRelPath fd = Path AbsOrRel fd +type FileOrDirPath ar = Path ar FileOrDir + +{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-} +asPath :: (AbsRelClass ar, FileDirClass fd) => String -> Path ar fd +asPath = Core.asPath + +{-# DEPRECATED asRelFile "Use 'relFile' instead." #-} +asRelFile :: String -> RelFile +asRelFile = Core.asRelFile + +{-# DEPRECATED asRelDir "Use 'relDir' instead." #-} +asRelDir :: String -> RelDir +asRelDir = Core.asRelDir + +{-# DEPRECATED asAbsFile "Use 'absFile' instead." #-} +asAbsFile :: String -> AbsFile +asAbsFile = Core.asAbsFile + +{-# DEPRECATED asAbsDir "Use 'absDir' instead." #-} +asAbsDir :: String -> AbsDir +asAbsDir = Core.asAbsDir + +{-# DEPRECATED asRelPath "Use 'relPath' instead." #-} +asRelPath :: (FileDirClass fd) => String -> RelPath fd +asRelPath = Core.asRelPath + +{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-} +asAbsPath :: (FileDirClass fd) => String -> AbsPath fd +asAbsPath = Core.asAbsPath + +{-# DEPRECATED asFilePath "Use 'filePath' instead." #-} +asFilePath :: (AbsRelClass ar) => String -> FilePath ar +asFilePath = Core.asFilePath + +{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-} +asDirPath :: (AbsRelClass ar) => String -> DirPath ar +asDirPath = Core.asDirPath + + +maybePath :: + (AbsOrRelClass ar, FileOrDirClass fd) => String -> Maybe (Path ar fd) +maybePath = Core.maybePath + + +path :: (AbsOrRelClass ar, FileOrDirClass fd) => String -> Path ar fd +path = Core.path + +relFile :: String -> RelFile +relFile = Core.relFile + +relDir :: String -> RelDir +relDir = Core.relDir + +absFile :: String -> AbsFile +absFile = Core.absFile + +absDir :: String -> AbsDir +absDir = Core.absDir + +relPath :: (FileOrDirClass fd) => String -> RelPath fd +relPath = Core.relPath + +absPath :: (FileOrDirClass fd) => String -> AbsPath fd +absPath = Core.absPath + +filePath :: (AbsOrRelClass ar) => String -> FilePath ar +filePath = Core.filePath + +dirPath :: (AbsOrRelClass ar) => String -> DirPath ar +dirPath = Core.dirPath + + +rootDir :: AbsDir +rootDir = Core.rootDir + +currentDir :: RelDir +currentDir = Core.currentDir + +emptyFile :: RelFile +emptyFile = Core.emptyFile + + +toString :: (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> String +toString = Core.toString + + +instance Core.System Posix where + pathSeparator = Tagged pathSeparator + splitAbsolute = Tagged $ RegEx.run $ RegEx.single isPathSeparator + canonicalize = Tagged id + splitDrive = Tagged $ return "" + genDrive = Tagged $ return "" + +withOS :: Tagged Posix a -> a +withOS = untag + + +equalFilePath :: String -> String -> Bool +equalFilePath = withOS Core.equalFilePath + +isAbsoluteString :: String -> Bool +isAbsoluteString = withOS Core.isAbsoluteString + +isRelativeString :: String -> Bool +isRelativeString = withOS Core.isRelativeString + + +pathSeparator :: Char +pathSeparator = '/' + +pathSeparators :: [Char] +pathSeparators = withOS Core.pathSeparators + +isPathSeparator :: Char -> Bool +isPathSeparator = withOS Core.isPathSeparator + + +{-# DEPRECATED addTrailingPathSeparator "Use System.FilePath.addTrailingPathSeparator instead." #-} +{-# DEPRECATED dropTrailingPathSeparator "Use System.FilePath.dropTrailingPathSeparator instead." #-} +{-# DEPRECATED hasTrailingPathSeparator "Use System.FilePath.hasTrailingPathSeparator instead." #-} + +-- | This is largely for 'System.FilePath' compatibility +addTrailingPathSeparator :: String -> String +addTrailingPathSeparator = (++[pathSeparator]) + +-- | This is largely for 'System.FilePath' compatibility +dropTrailingPathSeparator :: String -> String +dropTrailingPathSeparator = init + +-- | This is largely for 'System.FilePath' compatibility +hasTrailingPathSeparator :: String -> Bool +hasTrailingPathSeparator = isPathSeparator . last + + +testAll :: [(String, IO ())] +testAll = Core.testAll Posix diff --git a/src/System/Path/RegularExpression.hs b/src/System/Path/RegularExpression.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/RegularExpression.hs @@ -0,0 +1,31 @@ +module System.Path.RegularExpression where + +import qualified Control.Monad.Trans.State as MS +import Control.Monad (guard) +import Control.Applicative (liftA2, (<|>)) + +import qualified Data.List.HT as ListHT +import Data.Monoid (Monoid, mempty, mappend) +import Data.Maybe (fromMaybe) + + +newtype Parser a = Parser (MS.StateT [a] Maybe [a]) + +instance Monoid (Parser a) where + mempty = Parser $ return [] + mappend (Parser x) (Parser y) = Parser $ liftA2 (++) x y + +infixr 5 -|- + +(-|-) :: Parser a -> Parser a -> Parser a +Parser x -|- Parser y = Parser $ x <|> y + +single :: (a -> Bool) -> Parser a +single p = Parser $ do + c <- MS.StateT ListHT.viewL + guard $ p c + return [c] + +run :: Parser a -> MS.State [a] [a] +run (Parser x) = + MS.state $ \str -> fromMaybe ([], str) $ MS.runStateT x str diff --git a/src/System/Path/Windows.hs b/src/System/Path/Windows.hs --- a/src/System/Path/Windows.hs +++ b/src/System/Path/Windows.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE CPP #-} -#define MODULE_NAME Windows -#define IS_WINDOWS True - +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- | This module provides type-safe access to filepath manipulations. -- -- Normally you would import 'System.Path' (which will use the @@ -9,9 +6,207 @@ -- However, importing this explicitly allows for manipulation of -- non-native paths. -- -#ifdef __HADDOCK__ -module System.Path.Windows where -#else -#include "Internal.hs" -#endif +module System.Path.Windows ( + Path, + AbsFile, RelFile, AbsDir, RelDir, + AbsPath, RelPath, FilePath, DirPath, + AbsOrRelFile, AbsOrRelDir, AbsFileOrDir, RelFileOrDir, + AbsOrRelPath, FileOrDirPath, AbsOrRelFileOrDir, + asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath, + path, maybePath, + relFile, relDir, absFile, absDir, + relPath, absPath, filePath, dirPath, + rootDir, currentDir, emptyFile, + toString, + isAbsoluteString, isRelativeString, equalFilePath, + pathSeparator, pathSeparators, isPathSeparator, + Core.extSeparator, Core.isExtSeparator, + Core.searchPathSeparator, Core.isSearchPathSeparator, + addTrailingPathSeparator, dropTrailingPathSeparator, + hasTrailingPathSeparator, + testAll, + ) where +import qualified System.Path.RegularExpression as RegEx +import qualified System.Path.Internal as Core +import System.Path.RegularExpression ((-|-)) +import System.Path.Internal ( + Abs, Rel, AbsOrRel, File, Dir, FileOrDir, + AbsRelClass, FileDirClass, + AbsOrRelClass, FileOrDirClass, + ) + +import Data.Tagged (Tagged(Tagged), untag) +import Data.Char (isAlpha, toLower) +import Data.Monoid (mempty, (<>)) + +import qualified Test.QuickCheck as QC + +import Prelude hiding (FilePath) + + +data Windows = Windows + +_osDummy :: Windows +_osDummy = Windows + +type Path = Core.Path Windows + +type AbsFile = Path Abs File +type RelFile = Path Rel File +type AbsDir = Path Abs Dir +type RelDir = Path Rel Dir +type AbsOrRelFile = Path AbsOrRel File +type AbsOrRelDir = Path AbsOrRel Dir +type AbsFileOrDir = Path Abs FileOrDir +type RelFileOrDir = Path Rel FileOrDir +type AbsOrRelFileOrDir = Path AbsOrRel FileOrDir + +type AbsPath fd = Path Abs fd +type RelPath fd = Path Rel fd +type FilePath ar = Path ar File +type DirPath ar = Path ar Dir +type AbsOrRelPath fd = Path AbsOrRel fd +type FileOrDirPath ar = Path ar FileOrDir + +{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-} +asPath :: (AbsRelClass ar, FileDirClass fd) => String -> Path ar fd +asPath = Core.asPath + +{-# DEPRECATED asRelFile "Use 'relFile' instead." #-} +asRelFile :: String -> RelFile +asRelFile = Core.asRelFile + +{-# DEPRECATED asRelDir "Use 'relDir' instead." #-} +asRelDir :: String -> RelDir +asRelDir = Core.asRelDir + +{-# DEPRECATED asAbsFile "Use 'absFile' instead." #-} +asAbsFile :: String -> AbsFile +asAbsFile = Core.asAbsFile + +{-# DEPRECATED asAbsDir "Use 'absDir' instead." #-} +asAbsDir :: String -> AbsDir +asAbsDir = Core.asAbsDir + +{-# DEPRECATED asRelPath "Use 'relPath' instead." #-} +asRelPath :: (FileDirClass fd) => String -> RelPath fd +asRelPath = Core.asRelPath + +{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-} +asAbsPath :: (FileDirClass fd) => String -> AbsPath fd +asAbsPath = Core.asAbsPath + +{-# DEPRECATED asFilePath "Use 'filePath' instead." #-} +asFilePath :: (AbsRelClass ar) => String -> FilePath ar +asFilePath = Core.asFilePath + +{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-} +asDirPath :: (AbsRelClass ar) => String -> DirPath ar +asDirPath = Core.asDirPath + + +maybePath :: + (AbsOrRelClass ar, FileOrDirClass fd) => String -> Maybe (Path ar fd) +maybePath = Core.maybePath + + +path :: (AbsOrRelClass ar, FileOrDirClass fd) => String -> Path ar fd +path = Core.path + +relFile :: String -> RelFile +relFile = Core.relFile + +relDir :: String -> RelDir +relDir = Core.relDir + +absFile :: String -> AbsFile +absFile = Core.absFile + +absDir :: String -> AbsDir +absDir = Core.absDir + +relPath :: (FileOrDirClass fd) => String -> RelPath fd +relPath = Core.relPath + +absPath :: (FileOrDirClass fd) => String -> AbsPath fd +absPath = Core.absPath + +filePath :: (AbsOrRelClass ar) => String -> FilePath ar +filePath = Core.filePath + +dirPath :: (AbsOrRelClass ar) => String -> DirPath ar +dirPath = Core.dirPath + + +rootDir :: AbsDir +rootDir = Core.rootDir + +currentDir :: RelDir +currentDir = Core.currentDir + +emptyFile :: RelFile +emptyFile = Core.emptyFile + + +toString :: (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> String +toString = Core.toString + + +instance Core.System Windows where + pathSeparator = Tagged pathSeparator + splitAbsolute = Tagged $ RegEx.run $ + RegEx.single isPathSeparator + -|- + driveRegEx <> (RegEx.single isPathSeparator -|- mempty) + canonicalize = Tagged $ map toLower + splitDrive = Tagged $ RegEx.run driveRegEx + genDrive = Tagged $ fmap (:":") $ QC.choose ('a', 'z') + +driveRegEx :: RegEx.Parser Char +driveRegEx = RegEx.single isAlpha <> RegEx.single (':'==) + +withOS :: Tagged Windows a -> a +withOS = untag + +equalFilePath :: String -> String -> Bool +equalFilePath = withOS Core.equalFilePath + +isAbsoluteString :: String -> Bool +isAbsoluteString = withOS Core.isAbsoluteString + +isRelativeString :: String -> Bool +isRelativeString = withOS Core.isRelativeString + + +pathSeparator :: Char +pathSeparator = '\\' + +pathSeparators :: [Char] +pathSeparators = withOS Core.pathSeparators + +isPathSeparator :: Char -> Bool +isPathSeparator = withOS Core.isPathSeparator + + +{-# DEPRECATED addTrailingPathSeparator "Use System.FilePath.addTrailingPathSeparator instead." #-} +{-# DEPRECATED dropTrailingPathSeparator "Use System.FilePath.dropTrailingPathSeparator instead." #-} +{-# DEPRECATED hasTrailingPathSeparator "Use System.FilePath.hasTrailingPathSeparator instead." #-} + +-- | This is largely for 'System.FilePath' compatibility +addTrailingPathSeparator :: String -> String +addTrailingPathSeparator = (++[pathSeparator]) + +-- | This is largely for 'System.FilePath' compatibility +dropTrailingPathSeparator :: String -> String +dropTrailingPathSeparator = init + +-- | This is largely for 'System.FilePath' compatibility +hasTrailingPathSeparator :: String -> Bool +hasTrailingPathSeparator = isPathSeparator . last + + +testAll :: [(String, IO ())] +testAll = Core.testAll Windows diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -2,7 +2,9 @@ import TestResult (results) -import System.Path (rootDir, asRelDir, asRelFile, (), (<.>)) +import qualified System.Path.Posix as Posix +import qualified System.Path.Windows as Windows +import System.Path (rootDir, relDir, relFile, (), (<.>)) import System.Random (newStdGen, random) import System.Exit (exitFailure) import Control.Monad (void) @@ -14,7 +16,7 @@ g <- newStdGen let (a,_g') = random g -- TODO - integrate with QuickCheck - x = rootDir asRelDir "tmp" asRelFile "someFile" <.> "ext" + x = rootDir relDir "tmp" relFile "someFile" <.> "ext" let allResults = results a x void $ printf "Running %d tests...\n" $ length allResults @@ -27,3 +29,10 @@ putStrLn "Failed tests:" mapM_ putStrLn fails exitFailure + + putStrLn "Running QuickCheck tests ..." + let runQC prefix = + mapM_ $ \(name, test) -> putStr (prefix ++ name ++ ": ") >> test + runQC "Posix." Posix.testAll + runQC "Windows." Windows.testAll + putStrLn "Tests completed." diff --git a/test/TestResult.hs b/test/TestResult.hs --- a/test/TestResult.hs +++ b/test/TestResult.hs @@ -1,391 +1,564 @@ {- Do not edit! Created from test/TestTemplate.hs -} -{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module TestResult (results) where +import qualified System.Path.Generic as Path import qualified System.Path.Posix as Posix import qualified System.Path.Windows as Windows -import System.Path ((), (<.>)) +import System.Path.Generic ((), (<.>), relFile, relDir, absFile, absDir) import Data.Char (toLower) -results :: (Posix.AbsRelClass ar) => Char -> Posix.FilePath ar -> [(String, Bool)] +results :: + (Path.AbsRelClass ar) => Char -> Posix.FilePath ar -> [(String, Bool)] results a x = - {-# LINE 255 "src/System/Path/Internal.hs" #-} - ("Posix.pathMap (map toLower) \"/tmp/Reports/SpreadSheets\" == Posix.asAbsDir \"/tmp/reports/spreadsheets\"", - Posix.pathMap (map toLower) "/tmp/Reports/SpreadSheets" == Posix.asAbsDir "/tmp/reports/spreadsheets") : - {-# LINE 322 "src/System/Path/Internal.hs" #-} - ("show (Posix.rootDir \"bla\" Posix.asRelFile \"blub\") == \"rootDir \\\"bla\\\" \\\"blub\\\"\"", - show (Posix.rootDir "bla" Posix.asRelFile "blub") == "rootDir \"bla\" \"blub\"") : - {-# LINE 323 "src/System/Path/Internal.hs" #-} - ("show (Just (Posix.rootDir \"bla\" Posix.asRelFile \"blub\")) == \"Just (rootDir \\\"bla\\\" \\\"blub\\\")\"", - show (Just (Posix.rootDir "bla" Posix.asRelFile "blub")) == "Just (rootDir \"bla\" \"blub\")") : - {-# LINE 324 "src/System/Path/Internal.hs" #-} - ("show (Posix.currentDir \"bla\" Posix.asRelFile \"blub\") == \"currentDir \\\"bla\\\" \\\"blub\\\"\"", - show (Posix.currentDir "bla" Posix.asRelFile "blub") == "currentDir \"bla\" \"blub\"") : - {-# LINE 325 "src/System/Path/Internal.hs" #-} - ("show (Just (Posix.currentDir \"bla\" Posix.asRelFile \"blub\")) == \"Just (currentDir \\\"bla\\\" \\\"blub\\\")\"", - show (Just (Posix.currentDir "bla" Posix.asRelFile "blub")) == "Just (currentDir \"bla\" \"blub\")") : - {-# LINE 326 "src/System/Path/Internal.hs" #-} - ("show (Windows.asAbsDir \"c:\" Windows. \"bla\" Windows. Windows.asRelFile \"blub\") == \"asAbsDir \\\"c:\\\" \\\"bla\\\" \\\"blub\\\"\"", - show (Windows.asAbsDir "c:" Windows. "bla" Windows. Windows.asRelFile "blub") == "asAbsDir \"c:\" \"bla\" \"blub\"") : - {-# LINE 327 "src/System/Path/Internal.hs" #-} - ("show (Just (Windows.asAbsDir \"c:\\\\\" Windows. \"bla\" Windows. Windows.asRelFile \"blub\")) == \"Just (asAbsDir \\\"c:\\\" \\\"bla\\\" \\\"blub\\\")\"", - show (Just (Windows.asAbsDir "c:\\" Windows. "bla" Windows. Windows.asRelFile "blub")) == "Just (asAbsDir \"c:\" \"bla\" \"blub\")") : - {-# LINE 348 "src/System/Path/Internal.hs" #-} - ("let path = Posix.rootDir \"bla\" Posix.asRelFile \"blub\" in read (show path) == path", - let path = Posix.rootDir "bla" Posix.asRelFile "blub" in read (show path) == path) : - {-# LINE 349 "src/System/Path/Internal.hs" #-} - ("let path = Just (Posix.rootDir \"bla\" Posix.asRelFile \"blub\") in read (show path) == path", - let path = Just (Posix.rootDir "bla" Posix.asRelFile "blub") in read (show path) == path) : - {-# LINE 350 "src/System/Path/Internal.hs" #-} - ("let path = Posix.currentDir \"bla\" Posix.asRelFile \"blub\" in read (show path) == path", - let path = Posix.currentDir "bla" Posix.asRelFile "blub" in read (show path) == path) : - {-# LINE 351 "src/System/Path/Internal.hs" #-} - ("let path = Just (Posix.currentDir \"bla\" Posix.asRelFile \"blub\") in read (show path) == path", - let path = Just (Posix.currentDir "bla" Posix.asRelFile "blub") in read (show path) == path) : - {-# LINE 352 "src/System/Path/Internal.hs" #-} - ("let path = Windows.rootDir Windows. \"bla\" Windows. Windows.asRelFile \"blub\" in read (show path) == path", - let path = Windows.rootDir Windows. "bla" Windows. Windows.asRelFile "blub" in read (show path) == path) : - {-# LINE 353 "src/System/Path/Internal.hs" #-} - ("let path = Just (Windows.rootDir Windows. \"bla\" Windows. Windows.asRelFile \"blub\") in read (show path) == path", - let path = Just (Windows.rootDir Windows. "bla" Windows. Windows.asRelFile "blub") in read (show path) == path) : - {-# LINE 444 "src/System/Path/Internal.hs" #-} - ("Posix.asPath \"/tmp\" == Posix.asAbsDir \"/tmp\"", - Posix.asPath "/tmp" == Posix.asAbsDir "/tmp") : - {-# LINE 445 "src/System/Path/Internal.hs" #-} - ("Posix.asPath \"file.txt\" == Posix.asRelFile \"file.txt\"", - Posix.asPath "file.txt" == Posix.asRelFile "file.txt") : - {-# LINE 446 "src/System/Path/Internal.hs" #-} - ("Posix.isAbsolute (Posix.asAbsDir \"/tmp\")", - Posix.isAbsolute (Posix.asAbsDir "/tmp")) : - {-# LINE 447 "src/System/Path/Internal.hs" #-} - ("Posix.isRelative (Posix.asRelDir \"/tmp\")", - Posix.isRelative (Posix.asRelDir "/tmp")) : - {-# LINE 448 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asPath \"/tmp\" :: Posix.AbsDir) == \"/tmp\"", - Posix.getPathString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp") : - {-# LINE 449 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asPath \"/tmp\" :: Posix.RelDir) == \"tmp\"", - Posix.getPathString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp") : - {-# LINE 450 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asPath \"\\\\tmp\" :: Windows.AbsDir) == \"\\\\tmp\"", - Windows.getPathString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp") : - {-# LINE 451 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asPath \"a:\\\\tmp\" :: Windows.AbsDir) == \"a:\\\\tmp\"", - Windows.getPathString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp") : - {-# LINE 452 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asPath \"tmp\" :: Windows.RelDir) == \"tmp\"", - Windows.getPathString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp") : - {-# LINE 465 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelFile \"file.txt\") == \"file.txt\"", - Posix.getPathString (Posix.asRelFile "file.txt") == "file.txt") : - {-# LINE 466 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelFile \"/file.txt\") == \"file.txt\"", - Posix.getPathString (Posix.asRelFile "/file.txt") == "file.txt") : - {-# LINE 467 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelFile \"tmp\") == \"tmp\"", - Posix.getPathString (Posix.asRelFile "tmp") == "tmp") : - {-# LINE 468 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelFile \"/tmp\") == \"tmp\"", - Posix.getPathString (Posix.asRelFile "/tmp") == "tmp") : - {-# LINE 474 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelDir \".\") == \".\"", - Posix.getPathString (Posix.asRelDir ".") == ".") : - {-# LINE 475 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelDir \"file.txt\") == \"file.txt\"", - Posix.getPathString (Posix.asRelDir "file.txt") == "file.txt") : - {-# LINE 476 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelDir \"/file.txt\") == \"file.txt\"", - Posix.getPathString (Posix.asRelDir "/file.txt") == "file.txt") : - {-# LINE 477 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelDir \"tmp\") == \"tmp\"", - Posix.getPathString (Posix.asRelDir "tmp") == "tmp") : - {-# LINE 478 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelDir \"/tmp\") == \"tmp\"", - Posix.getPathString (Posix.asRelDir "/tmp") == "tmp") : - {-# LINE 484 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsFile \"file.txt\") == \"/file.txt\"", - Posix.getPathString (Posix.asAbsFile "file.txt") == "/file.txt") : + {-# LINE 355 "src/System/Path/Internal.hs" #-} + ("Path.pathMap (map toLower) (absDir \"/tmp/Reports/SpreadSheets\") == Posix.absDir \"/tmp/reports/spreadsheets\"", + Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets") : {-# LINE 485 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsFile \"/file.txt\") == \"/file.txt\"", - Posix.getPathString (Posix.asAbsFile "/file.txt") == "/file.txt") : + ("show (Posix.rootDir relDir \"bla\" relFile \"blub\") == \"rootDir relDir \\\"bla\\\" relFile \\\"blub\\\"\"", + show (Posix.rootDir relDir "bla" relFile "blub") == "rootDir relDir \"bla\" relFile \"blub\"") : {-# LINE 486 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsFile \"tmp\") == \"/tmp\"", - Posix.getPathString (Posix.asAbsFile "tmp") == "/tmp") : + ("show (Just (Posix.rootDir relDir \"bla\" relFile \"blub\")) == \"Just (rootDir relDir \\\"bla\\\" relFile \\\"blub\\\")\"", + show (Just (Posix.rootDir relDir "bla" relFile "blub")) == "Just (rootDir relDir \"bla\" relFile \"blub\")") : {-# LINE 487 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsFile \"/tmp\") == \"/tmp\"", - Posix.getPathString (Posix.asAbsFile "/tmp") == "/tmp") : - {-# LINE 493 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsDir \"file.txt\") == \"/file.txt\"", - Posix.getPathString (Posix.asAbsDir "file.txt") == "/file.txt") : - {-# LINE 494 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsDir \"/file.txt\") == \"/file.txt\"", - Posix.getPathString (Posix.asAbsDir "/file.txt") == "/file.txt") : - {-# LINE 495 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsDir \"tmp\") == \"/tmp\"", - Posix.getPathString (Posix.asAbsDir "tmp") == "/tmp") : - {-# LINE 496 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsDir \"/tmp\") == \"/tmp\"", - Posix.getPathString (Posix.asAbsDir "/tmp") == "/tmp") : + ("show (Posix.currentDir relDir \"bla\" relFile \"blub\") == \"currentDir relDir \\\"bla\\\" relFile \\\"blub\\\"\"", + show (Posix.currentDir relDir "bla" relFile "blub") == "currentDir relDir \"bla\" relFile \"blub\"") : + {-# LINE 488 "src/System/Path/Internal.hs" #-} + ("show (Just (Posix.currentDir relDir \"bla\" relFile \"blub\")) == \"Just (currentDir relDir \\\"bla\\\" relFile \\\"blub\\\")\"", + show (Just (Posix.currentDir relDir "bla" relFile "blub")) == "Just (currentDir relDir \"bla\" relFile \"blub\")") : + {-# LINE 489 "src/System/Path/Internal.hs" #-} + ("show (Windows.absDir \"c:\" relDir \"bla\" relFile \"blub\") == \"absDir \\\"c:\\\" relDir \\\"bla\\\" relFile \\\"blub\\\"\"", + show (Windows.absDir "c:" relDir "bla" relFile "blub") == "absDir \"c:\" relDir \"bla\" relFile \"blub\"") : + {-# LINE 490 "src/System/Path/Internal.hs" #-} + ("show (Just (Windows.absDir \"c:\\\\\" relDir \"bla\" relFile \"blub\")) == \"Just (absDir \\\"c:\\\\\\\\\\\" relDir \\\"bla\\\" relFile \\\"blub\\\")\"", + show (Just (Windows.absDir "c:\\" relDir "bla" relFile "blub")) == "Just (absDir \"c:\\\\\" relDir \"bla\" relFile \"blub\")") : + {-# LINE 520 "src/System/Path/Internal.hs" #-} + ("read \"rootDir\" == Posix.rootDir", + read "rootDir" == Posix.rootDir) : + {-# LINE 521 "src/System/Path/Internal.hs" #-} + ("read \"rootDir\" == Windows.rootDir", + read "rootDir" == Windows.rootDir) : + {-# LINE 522 "src/System/Path/Internal.hs" #-} + ("read \"currentDir\" == Posix.currentDir", + read "currentDir" == Posix.currentDir) : + {-# LINE 523 "src/System/Path/Internal.hs" #-} + ("read \"currentDir\" == Windows.currentDir", + read "currentDir" == Windows.currentDir) : + {-# LINE 524 "src/System/Path/Internal.hs" #-} + ("let path = Posix.rootDir relDir \"bla\" relFile \"blub\" in read (show path) == path", + let path = Posix.rootDir relDir "bla" relFile "blub" in read (show path) == path) : + {-# LINE 525 "src/System/Path/Internal.hs" #-} + ("let path = Just (Posix.rootDir relDir \"bla\" relFile \"blub\") in read (show path) == path", + let path = Just (Posix.rootDir relDir "bla" relFile "blub") in read (show path) == path) : + {-# LINE 526 "src/System/Path/Internal.hs" #-} + ("let path = Posix.currentDir relDir \"bla\" relFile \"blub\" in read (show path) == path", + let path = Posix.currentDir relDir "bla" relFile "blub" in read (show path) == path) : {-# LINE 527 "src/System/Path/Internal.hs" #-} - ("Posix.mkPathAbsOrRel \"/tmp\" == Left (Posix.asAbsDir \"/tmp\")", - Posix.mkPathAbsOrRel "/tmp" == Left (Posix.asAbsDir "/tmp")) : + ("let path = Just (Posix.currentDir relDir \"bla\" relFile \"blub\") in read (show path) == path", + let path = Just (Posix.currentDir relDir "bla" relFile "blub") in read (show path) == path) : {-# LINE 528 "src/System/Path/Internal.hs" #-} - ("Posix.mkPathAbsOrRel \"tmp\" == Right (Posix.asRelDir \"tmp\")", - Posix.mkPathAbsOrRel "tmp" == Right (Posix.asRelDir "tmp")) : + ("let path = Windows.rootDir relDir \"bla\" relFile \"blub\" in read (show path) == path", + let path = Windows.rootDir relDir "bla" relFile "blub" in read (show path) == path) : {-# LINE 529 "src/System/Path/Internal.hs" #-} - ("Windows.mkPathAbsOrRel \"\\\\tmp\" == Left (Windows.asAbsDir \"\\\\tmp\")", - Windows.mkPathAbsOrRel "\\tmp" == Left (Windows.asAbsDir "\\tmp")) : + ("let path = Just (Windows.rootDir relDir \"bla\" relFile \"blub\") in read (show path) == path", + let path = Just (Windows.rootDir relDir "bla" relFile "blub") in read (show path) == path) : {-# LINE 530 "src/System/Path/Internal.hs" #-} - ("Windows.mkPathAbsOrRel \"d:\\\\tmp\" == Left (Windows.asAbsDir \"d:\\\\tmp\")", - Windows.mkPathAbsOrRel "d:\\tmp" == Left (Windows.asAbsDir "d:\\tmp")) : - {-# LINE 531 "src/System/Path/Internal.hs" #-} - ("Windows.mkPathAbsOrRel \"tmp\" == Right (Windows.asRelDir \"tmp\")", - Windows.mkPathAbsOrRel "tmp" == Right (Windows.asRelDir "tmp")) : - {-# LINE 556 "src/System/Path/Internal.hs" #-} - ("Posix.mkAbsPath \"/tmp\" \"foo.txt\" == Posix.asAbsFile \"/tmp/foo.txt\"", - Posix.mkAbsPath "/tmp" "foo.txt" == Posix.asAbsFile "/tmp/foo.txt") : - {-# LINE 557 "src/System/Path/Internal.hs" #-} - ("Posix.mkAbsPath \"/tmp\" \"/etc/foo.txt\" == Posix.asAbsFile \"/etc/foo.txt\"", - Posix.mkAbsPath "/tmp" "/etc/foo.txt" == Posix.asAbsFile "/etc/foo.txt") : - {-# LINE 649 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsDir \"/tmp\" Posix.asRelFile \"file.txt\") == \"/tmp/file.txt\"", - Posix.getPathString (Posix.asAbsDir "/tmp" Posix.asRelFile "file.txt") == "/tmp/file.txt") : - {-# LINE 650 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asAbsDir \"/tmp\" Posix.asRelDir \"dir\" Posix.asRelFile \"file.txt\") == \"/tmp/dir/file.txt\"", - Posix.getPathString (Posix.asAbsDir "/tmp" Posix.asRelDir "dir" Posix.asRelFile "file.txt") == "/tmp/dir/file.txt") : - {-# LINE 651 "src/System/Path/Internal.hs" #-} - ("Posix.getPathString (Posix.asRelDir \"dir\" Posix.asRelFile \"file.txt\") == \"dir/file.txt\"", - Posix.getPathString (Posix.asRelDir "dir" Posix.asRelFile "file.txt") == "dir/file.txt") : - {-# LINE 652 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asAbsDir \"\\\\tmp\" Windows. Windows.asRelFile \"file.txt\") == \"\\\\tmp\\\\file.txt\"", - Windows.getPathString (Windows.asAbsDir "\\tmp" Windows. Windows.asRelFile "file.txt") == "\\tmp\\file.txt") : - {-# LINE 653 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asAbsDir \"c:\\\\tmp\" Windows. Windows.asRelFile \"file.txt\") == \"c:\\\\tmp\\\\file.txt\"", - Windows.getPathString (Windows.asAbsDir "c:\\tmp" Windows. Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt") : - {-# LINE 654 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asAbsDir \"c:\" Windows. Windows.asRelDir \"tmp\" Windows. Windows.asRelFile \"file.txt\") == \"c:\\\\tmp\\\\file.txt\"", - Windows.getPathString (Windows.asAbsDir "c:" Windows. Windows.asRelDir "tmp" Windows. Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt") : - {-# LINE 655 "src/System/Path/Internal.hs" #-} - ("Windows.getPathString (Windows.asRelDir \"dir\" Windows. Windows.asRelFile \"file.txt\") == \"dir\\\\file.txt\"", - Windows.getPathString (Windows.asRelDir "dir" Windows. Windows.asRelFile "file.txt") == "dir\\file.txt") : + ("let path = Windows.absDir \"c:\" relDir \"bla\" relFile \"blub\" in read (show path) == path", + let path = Windows.absDir "c:" relDir "bla" relFile "blub" in read (show path) == path) : + {-# LINE 619 "src/System/Path/Internal.hs" #-} + ("Posix.toString Path.rootDir == \"/\"", + Posix.toString Path.rootDir == "/") : + {-# LINE 620 "src/System/Path/Internal.hs" #-} + ("Windows.toString Path.rootDir == \"\\\\\"", + Windows.toString Path.rootDir == "\\") : + {-# LINE 630 "src/System/Path/Internal.hs" #-} + ("Posix.toString Path.currentDir == \".\"", + Posix.toString Path.currentDir == ".") : + {-# LINE 631 "src/System/Path/Internal.hs" #-} + ("Windows.toString Path.currentDir == \".\"", + Windows.toString Path.currentDir == ".") : {-# LINE 673 "src/System/Path/Internal.hs" #-} - ("Posix.addExtension (Posix.asRelFile \"file.txt\") \"bib\" == \"file.txt.bib\"", - Posix.addExtension (Posix.asRelFile "file.txt") "bib" == "file.txt.bib") : + ("fmap Posix.toString (Posix.maybePath \"/\" :: Maybe Posix.AbsDir) == Just \"/\"", + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/") : {-# LINE 674 "src/System/Path/Internal.hs" #-} - ("Posix.addExtension (Posix.asRelFile \"file.\") \".bib\" == \"file..bib\"", - Posix.addExtension (Posix.asRelFile "file.") ".bib" == "file..bib") : + ("fmap Posix.toString (Posix.maybePath \"/\" :: Maybe Posix.AbsFile) == Nothing", + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing) : {-# LINE 675 "src/System/Path/Internal.hs" #-} - ("Posix.addExtension (Posix.asRelFile \"file\") \".bib\" == \"file.bib\"", - Posix.addExtension (Posix.asRelFile "file") ".bib" == "file.bib") : + ("fmap Posix.toString (Posix.maybePath \"/\" :: Maybe Posix.RelDir) == Nothing", + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing) : {-# LINE 676 "src/System/Path/Internal.hs" #-} - ("Posix.addExtension (Posix.asRelFile \"\") \"bib\" == \".bib\"", - Posix.addExtension (Posix.asRelFile "") "bib" == ".bib") : + ("fmap Posix.toString (Posix.maybePath \"/\" :: Maybe Posix.RelFile) == Nothing", + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing) : {-# LINE 677 "src/System/Path/Internal.hs" #-} - ("Posix.addExtension (Posix.asRelFile \"\") \".bib\" == \".bib\"", - Posix.addExtension (Posix.asRelFile "") ".bib" == ".bib") : + ("fmap Posix.toString (Posix.maybePath \"/tmp\" :: Maybe Posix.AbsDir) == Just \"/tmp\"", + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp") : {-# LINE 678 "src/System/Path/Internal.hs" #-} - ("Posix.takeFileName (Posix.addExtension (Posix.asRelFile \"\") \"ext\") == \".ext\"", - Posix.takeFileName (Posix.addExtension (Posix.asRelFile "") "ext") == ".ext") : + ("fmap Posix.toString (Posix.maybePath \"/tmp\" :: Maybe Posix.AbsFile) == Just \"/tmp\"", + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp") : + {-# LINE 679 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp\" :: Maybe Posix.RelDir) == Nothing", + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing) : + {-# LINE 680 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp\" :: Maybe Posix.RelFile) == Nothing", + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing) : + {-# LINE 681 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp/\" :: Maybe Posix.AbsDir) == Just \"/tmp\"", + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp") : + {-# LINE 682 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp/\" :: Maybe Posix.AbsFile) == Nothing", + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing) : + {-# LINE 683 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp/\" :: Maybe Posix.RelDir) == Nothing", + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing) : + {-# LINE 684 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp/\" :: Maybe Posix.RelFile) == Nothing", + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing) : + {-# LINE 685 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp\" :: Maybe Posix.AbsOrRelFileOrDir) == Just \"/tmp\"", + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp") : + {-# LINE 686 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"/tmp/\" :: Maybe Posix.AbsOrRelFileOrDir) == Just \"/tmp\"", + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp") : + {-# LINE 687 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"file.txt\" :: Maybe Posix.RelFile) == Just \"file.txt\"", + fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt") : + {-# LINE 688 "src/System/Path/Internal.hs" #-} + ("fmap Posix.toString (Posix.maybePath \"file.txt\" :: Maybe Posix.AbsFile) == Nothing", + fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing) : + {-# LINE 689 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"\\\\tmp\" :: Maybe Windows.AbsDir) == Just \"\\\\tmp\"", + fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp") : {-# LINE 690 "src/System/Path/Internal.hs" #-} - ("Posix.dropExtension x == fst (Posix.splitExtension x)", - Posix.dropExtension x == fst (Posix.splitExtension x)) : + ("fmap Windows.toString (Windows.maybePath \"a:\\\\tmp\" :: Maybe Windows.AbsDir) == Just \"a:\\\\tmp\"", + fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp") : + {-# LINE 691 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"a:tmp\" :: Maybe Windows.AbsDir) == Just \"a:tmp\"", + fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp") : + {-# LINE 692 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"a:\\\\\" :: Maybe Windows.AbsDir) == Just \"a:\\\\\"", + fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\") : + {-# LINE 693 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"a:\" :: Maybe Windows.AbsDir) == Just \"a:\"", + fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:") : + {-# LINE 694 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"tmp\" :: Maybe Windows.RelDir) == Just \"tmp\"", + fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp") : + {-# LINE 695 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"\\\\tmp\" :: Maybe Windows.RelDir) == Nothing", + fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing) : {-# LINE 696 "src/System/Path/Internal.hs" #-} - ("not $ Posix.hasAnExtension (Posix.dropExtensions x)", - not $ Posix.hasAnExtension (Posix.dropExtensions x)) : - {-# LINE 707 "src/System/Path/Internal.hs" #-} - ("Posix.replaceExtension (Posix.asRelFile \"file.txt\") \".bob\" == \"file.bob\"", - Posix.replaceExtension (Posix.asRelFile "file.txt") ".bob" == "file.bob") : - {-# LINE 708 "src/System/Path/Internal.hs" #-} - ("Posix.replaceExtension (Posix.asRelFile \"file.txt\") \"bob\" == \"file.bob\"", - Posix.replaceExtension (Posix.asRelFile "file.txt") "bob" == "file.bob") : - {-# LINE 709 "src/System/Path/Internal.hs" #-} - ("Posix.replaceExtension (Posix.asRelFile \"file\") \".bob\" == \"file.bob\"", - Posix.replaceExtension (Posix.asRelFile "file") ".bob" == "file.bob") : - {-# LINE 710 "src/System/Path/Internal.hs" #-} - ("Posix.replaceExtension (Posix.asRelFile \"file.txt\") \"\" == \"file\"", - Posix.replaceExtension (Posix.asRelFile "file.txt") "" == "file") : - {-# LINE 711 "src/System/Path/Internal.hs" #-} - ("Posix.replaceExtension (Posix.asRelFile \"file.fred.bob\") \"txt\" == \"file.fred.txt\"", - Posix.replaceExtension (Posix.asRelFile "file.fred.bob") "txt" == "file.fred.txt") : - {-# LINE 729 "src/System/Path/Internal.hs" #-} - ("uncurry (<.>) (Posix.splitExtension x) == x", - uncurry (<.>) (Posix.splitExtension x) == x) : - {-# LINE 730 "src/System/Path/Internal.hs" #-} - ("uncurry Posix.addExtension (Posix.splitExtension x) == x", - uncurry Posix.addExtension (Posix.splitExtension x) == x) : - {-# LINE 731 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtension (Posix.asRelFile \"file.txt\") == (\"file\",\".txt\")", - Posix.splitExtension (Posix.asRelFile "file.txt") == ("file",".txt")) : - {-# LINE 732 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtension (Posix.asRelFile \"file\") == (\"file\",\"\")", - Posix.splitExtension (Posix.asRelFile "file") == ("file","")) : - {-# LINE 733 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtension (Posix.asRelFile \"file/file.txt\") == (\"file/file\",\".txt\")", - Posix.splitExtension (Posix.asRelFile "file/file.txt") == ("file/file",".txt")) : - {-# LINE 734 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtension (Posix.asRelFile \"file.txt/boris\") == (\"file.txt/boris\",\"\")", - Posix.splitExtension (Posix.asRelFile "file.txt/boris") == ("file.txt/boris","")) : - {-# LINE 735 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtension (Posix.asRelFile \"file.txt/boris.ext\") == (\"file.txt/boris\",\".ext\")", - Posix.splitExtension (Posix.asRelFile "file.txt/boris.ext") == ("file.txt/boris",".ext")) : - {-# LINE 736 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtension (Posix.asRelFile \"file/path.txt.bob.fred\") == (\"file/path.txt.bob\",\".fred\")", - Posix.splitExtension (Posix.asRelFile "file/path.txt.bob.fred") == ("file/path.txt.bob",".fred")) : - {-# LINE 743 "src/System/Path/Internal.hs" #-} - ("Posix.splitExtensions (Posix.asRelFile \"file.tar.gz\") == (\"file\",\".tar.gz\")", - Posix.splitExtensions (Posix.asRelFile "file.tar.gz") == ("file",".tar.gz")) : - {-# LINE 760 "src/System/Path/Internal.hs" #-} - ("Posix.takeBaseName (Posix.asAbsFile \"/tmp/somedir/myfile.txt\") == \"myfile\"", - Posix.takeBaseName (Posix.asAbsFile "/tmp/somedir/myfile.txt") == "myfile") : - {-# LINE 761 "src/System/Path/Internal.hs" #-} - ("Posix.takeBaseName (Posix.asRelFile \"./myfile.txt\") == \"myfile\"", - Posix.takeBaseName (Posix.asRelFile "./myfile.txt") == "myfile") : + ("fmap Windows.toString (Windows.maybePath \"a:\\\\tmp\" :: Maybe Windows.RelDir) == Nothing", + fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing) : + {-# LINE 697 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"a:tmp\" :: Maybe Windows.RelDir) == Nothing", + fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing) : + {-# LINE 698 "src/System/Path/Internal.hs" #-} + ("fmap Windows.toString (Windows.maybePath \"tmp\" :: Maybe Windows.AbsDir) == Nothing", + fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing) : + {-# LINE 747 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.relFile \"file.txt\") == \"file.txt\"", + Posix.toString (Posix.relFile "file.txt") == "file.txt") : + {-# LINE 748 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.relFile \"tmp\") == \"tmp\"", + Posix.toString (Posix.relFile "tmp") == "tmp") : + {-# LINE 754 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.relDir \".\") == \".\"", + Posix.toString (Posix.relDir ".") == ".") : + {-# LINE 755 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.relDir \"file.txt\") == \"file.txt\"", + Posix.toString (Posix.relDir "file.txt") == "file.txt") : + {-# LINE 756 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.relDir \"tmp\") == \"tmp\"", + Posix.toString (Posix.relDir "tmp") == "tmp") : {-# LINE 762 "src/System/Path/Internal.hs" #-} - ("Posix.takeBaseName (Posix.asRelFile \"myfile.txt\") == \"myfile\"", - Posix.takeBaseName (Posix.asRelFile "myfile.txt") == "myfile") : - {-# LINE 771 "src/System/Path/Internal.hs" #-} - ("Posix.takeExtension x == snd (Posix.splitExtension x)", - Posix.takeExtension x == snd (Posix.splitExtension x)) : - {-# LINE 772 "src/System/Path/Internal.hs" #-} - ("Posix.takeExtension (Posix.addExtension x \"ext\") == \".ext\"", - Posix.takeExtension (Posix.addExtension x "ext") == ".ext") : - {-# LINE 773 "src/System/Path/Internal.hs" #-} - ("Posix.takeExtension (Posix.replaceExtension x \"ext\") == \".ext\"", - Posix.takeExtension (Posix.replaceExtension x "ext") == ".ext") : - {-# LINE 779 "src/System/Path/Internal.hs" #-} - ("Posix.takeExtensions (Posix.asRelFile \"file.tar.gz\") == \".tar.gz\"", - Posix.takeExtensions (Posix.asRelFile "file.tar.gz") == ".tar.gz") : - {-# LINE 785 "src/System/Path/Internal.hs" #-} - ("Posix.takeFileName (Posix.asAbsFile \"/tmp/somedir/myfile.txt\") == \"myfile.txt\"", - Posix.takeFileName (Posix.asAbsFile "/tmp/somedir/myfile.txt") == "myfile.txt") : - {-# LINE 786 "src/System/Path/Internal.hs" #-} - ("Posix.takeFileName (Posix.asRelFile \"./myfile.txt\") == \"myfile.txt\"", - Posix.takeFileName (Posix.asRelFile "./myfile.txt") == "myfile.txt") : - {-# LINE 787 "src/System/Path/Internal.hs" #-} - ("Posix.takeFileName (Posix.asRelFile \"myfile.txt\") == \"myfile.txt\"", - Posix.takeFileName (Posix.asRelFile "myfile.txt") == "myfile.txt") : - {-# LINE 800 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.absFile \"/file.txt\") == \"/file.txt\"", + Posix.toString (Posix.absFile "/file.txt") == "/file.txt") : + {-# LINE 763 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.absFile \"/tmp\") == \"/tmp\"", + Posix.toString (Posix.absFile "/tmp") == "/tmp") : + {-# LINE 769 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.absDir \"/file.txt\") == \"/file.txt\"", + Posix.toString (Posix.absDir "/file.txt") == "/file.txt") : + {-# LINE 770 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.absDir \"/tmp\") == \"/tmp\"", + Posix.toString (Posix.absDir "/tmp") == "/tmp") : + {-# LINE 835 "src/System/Path/Internal.hs" #-} + ("Posix.asPath \"/tmp\" == Posix.absDir \"/tmp\"", + Posix.asPath "/tmp" == Posix.absDir "/tmp") : + {-# LINE 836 "src/System/Path/Internal.hs" #-} + ("Posix.asPath \"file.txt\" == Posix.relFile \"file.txt\"", + Posix.asPath "file.txt" == Posix.relFile "file.txt") : + {-# LINE 837 "src/System/Path/Internal.hs" #-} + ("Path.isAbsolute (Posix.asAbsDir \"/tmp\")", + Path.isAbsolute (Posix.asAbsDir "/tmp")) : + {-# LINE 838 "src/System/Path/Internal.hs" #-} + ("Path.isRelative (Posix.asRelDir \"/tmp\")", + Path.isRelative (Posix.asRelDir "/tmp")) : + {-# LINE 839 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asPath \"/tmp\" :: Posix.AbsDir) == \"/tmp\"", + Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp") : + {-# LINE 840 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asPath \"/tmp\" :: Posix.RelDir) == \"tmp\"", + Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp") : + {-# LINE 841 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.asPath \"\\\\tmp\" :: Windows.AbsDir) == \"\\\\tmp\"", + Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp") : + {-# LINE 842 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.asPath \"a:\\\\tmp\" :: Windows.AbsDir) == \"a:\\\\tmp\"", + Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp") : + {-# LINE 843 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.asPath \"a:tmp\" :: Windows.AbsDir) == \"a:tmp\"", + Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp") : + {-# LINE 844 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.asPath \"tmp\" :: Windows.RelDir) == \"tmp\"", + Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp") : + {-# LINE 852 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelFile \"file.txt\") == \"file.txt\"", + Posix.toString (Posix.asRelFile "file.txt") == "file.txt") : + {-# LINE 853 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelFile \"/file.txt\") == \"file.txt\"", + Posix.toString (Posix.asRelFile "/file.txt") == "file.txt") : + {-# LINE 854 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelFile \"tmp\") == \"tmp\"", + Posix.toString (Posix.asRelFile "tmp") == "tmp") : + {-# LINE 855 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelFile \"/tmp\") == \"tmp\"", + Posix.toString (Posix.asRelFile "/tmp") == "tmp") : + {-# LINE 861 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelDir \".\") == \".\"", + Posix.toString (Posix.asRelDir ".") == ".") : + {-# LINE 862 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelDir \"file.txt\") == \"file.txt\"", + Posix.toString (Posix.asRelDir "file.txt") == "file.txt") : + {-# LINE 863 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelDir \"/file.txt\") == \"file.txt\"", + Posix.toString (Posix.asRelDir "/file.txt") == "file.txt") : + {-# LINE 864 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelDir \"tmp\") == \"tmp\"", + Posix.toString (Posix.asRelDir "tmp") == "tmp") : + {-# LINE 865 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asRelDir \"/tmp\") == \"tmp\"", + Posix.toString (Posix.asRelDir "/tmp") == "tmp") : + {-# LINE 871 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asAbsFile \"/file.txt\") == \"/file.txt\"", + Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt") : + {-# LINE 872 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asAbsFile \"/tmp\") == \"/tmp\"", + Posix.toString (Posix.asAbsFile "/tmp") == "/tmp") : + {-# LINE 878 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asAbsDir \"/file.txt\") == \"/file.txt\"", + Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt") : + {-# LINE 879 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.asAbsDir \"/tmp\") == \"/tmp\"", + Posix.toString (Posix.asAbsDir "/tmp") == "/tmp") : + {-# LINE 916 "src/System/Path/Internal.hs" #-} + ("Path.mkPathAbsOrRel \"/tmp\" == Left (Posix.absDir \"/tmp\")", + Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp")) : + {-# LINE 917 "src/System/Path/Internal.hs" #-} + ("Path.mkPathAbsOrRel \"tmp\" == Right (Posix.relDir \"tmp\")", + Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp")) : + {-# LINE 918 "src/System/Path/Internal.hs" #-} + ("Path.mkPathAbsOrRel \"\\\\tmp\" == Left (Windows.absDir \"\\\\tmp\")", + Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp")) : + {-# LINE 919 "src/System/Path/Internal.hs" #-} + ("Path.mkPathAbsOrRel \"d:\\\\tmp\" == Left (Windows.absDir \"d:\\\\tmp\")", + Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp")) : + {-# LINE 920 "src/System/Path/Internal.hs" #-} + ("Path.mkPathAbsOrRel \"d:tmp\" == Left (Windows.absDir \"d:tmp\")", + Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp")) : + {-# LINE 921 "src/System/Path/Internal.hs" #-} + ("Path.mkPathAbsOrRel \"tmp\" == Right (Windows.relDir \"tmp\")", + Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp")) : + {-# LINE 951 "src/System/Path/Internal.hs" #-} + ("Path.mkAbsPath (absDir \"/tmp\") \"foo.txt\" == Posix.absFile \"/tmp/foo.txt\"", + Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt") : + {-# LINE 952 "src/System/Path/Internal.hs" #-} + ("Path.mkAbsPath (absDir \"/tmp\") \"/etc/foo.txt\" == Posix.absFile \"/etc/foo.txt\"", + Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt") : + {-# LINE 1089 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.absDir \"/tmp\" Posix.relFile \"file.txt\") == \"/tmp/file.txt\"", + Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt") : + {-# LINE 1090 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.absDir \"/tmp\" Posix.relDir \"dir\" Posix.relFile \"file.txt\") == \"/tmp/dir/file.txt\"", + Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt") : + {-# LINE 1091 "src/System/Path/Internal.hs" #-} + ("Posix.toString (Posix.relDir \"dir\" Posix.relFile \"file.txt\") == \"dir/file.txt\"", + Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt") : + {-# LINE 1092 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.absDir \"\\\\tmp\" Windows.relFile \"file.txt\") == \"\\\\tmp\\\\file.txt\"", + Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt") : + {-# LINE 1093 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.absDir \"c:\\\\tmp\" Windows.relFile \"file.txt\") == \"c:\\\\tmp\\\\file.txt\"", + Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt") : + {-# LINE 1094 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.absDir \"c:tmp\" Windows.relFile \"file.txt\") == \"c:tmp\\\\file.txt\"", + Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt") : + {-# LINE 1095 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.absDir \"c:\\\\\" Windows.relDir \"tmp\" Windows.relFile \"file.txt\") == \"c:\\\\tmp\\\\file.txt\"", + Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt") : + {-# LINE 1096 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.absDir \"c:\" Windows.relDir \"tmp\" Windows.relFile \"file.txt\") == \"c:tmp\\\\file.txt\"", + Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt") : + {-# LINE 1097 "src/System/Path/Internal.hs" #-} + ("Windows.toString (Windows.relDir \"dir\" Windows.relFile \"file.txt\") == \"dir\\\\file.txt\"", + Windows.toString (Windows.relDir "dir" Windows.relFile "file.txt") == "dir\\file.txt") : + {-# LINE 1124 "src/System/Path/Internal.hs" #-} + ("Path.addExtension (relFile \"file.txt\") \"bib\" == Posix.relFile \"file.txt.bib\"", + Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib") : + {-# LINE 1125 "src/System/Path/Internal.hs" #-} + ("Path.addExtension (relFile \"file.\") \".bib\" == Posix.relFile \"file..bib\"", + Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib") : + {-# LINE 1126 "src/System/Path/Internal.hs" #-} + ("Path.addExtension (relFile \"file\") \".bib\" == Posix.relFile \"file.bib\"", + Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib") : + {-# LINE 1127 "src/System/Path/Internal.hs" #-} + ("Path.addExtension Path.emptyFile \"bib\" == Posix.relFile \".bib\"", + Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib") : + {-# LINE 1128 "src/System/Path/Internal.hs" #-} + ("Path.addExtension Path.emptyFile \".bib\" == Posix.relFile \".bib\"", + Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib") : + {-# LINE 1129 "src/System/Path/Internal.hs" #-} + ("Path.takeFileName (Path.addExtension Path.emptyFile \"ext\") == Posix.relFile \".ext\"", + Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext") : + {-# LINE 1144 "src/System/Path/Internal.hs" #-} + ("Path.dropExtension x == fst (Path.splitExtension x)", + Path.dropExtension x == fst (Path.splitExtension x)) : + {-# LINE 1150 "src/System/Path/Internal.hs" #-} + ("not $ Path.hasAnExtension (Path.dropExtensions x)", + not $ Path.hasAnExtension (Path.dropExtensions x)) : + {-# LINE 1161 "src/System/Path/Internal.hs" #-} + ("Path.replaceExtension (relFile \"file.txt\") \".bob\" == Posix.relFile \"file.bob\"", + Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob") : + {-# LINE 1162 "src/System/Path/Internal.hs" #-} + ("Path.replaceExtension (relFile \"file.txt\") \"bob\" == Posix.relFile \"file.bob\"", + Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob") : + {-# LINE 1163 "src/System/Path/Internal.hs" #-} + ("Path.replaceExtension (relFile \"file\") \".bob\" == Posix.relFile \"file.bob\"", + Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob") : + {-# LINE 1164 "src/System/Path/Internal.hs" #-} + ("Path.replaceExtension (relFile \"file.txt\") \"\" == Posix.relFile \"file\"", + Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file") : + {-# LINE 1165 "src/System/Path/Internal.hs" #-} + ("Path.replaceExtension (relFile \"file.fred.bob\") \"txt\" == Posix.relFile \"file.fred.txt\"", + Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt") : + {-# LINE 1182 "src/System/Path/Internal.hs" #-} + ("uncurry (<.>) (Path.splitExtension x) == x", + uncurry (<.>) (Path.splitExtension x) == x) : + {-# LINE 1183 "src/System/Path/Internal.hs" #-} + ("uncurry Path.addExtension (Path.splitExtension x) == x", + uncurry Path.addExtension (Path.splitExtension x) == x) : + {-# LINE 1184 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \"file.txt\") == (Posix.relFile \"file\",\".txt\")", + Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt")) : + {-# LINE 1185 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \".bashrc\") == (Posix.emptyFile, \".bashrc\")", + Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc")) : + {-# LINE 1186 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \"file\") == (Posix.relFile \"file\",\"\")", + Path.splitExtension (relFile "file") == (Posix.relFile "file","")) : + {-# LINE 1187 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \"file/file.txt\") == (Posix.relFile \"file/file\",\".txt\")", + Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt")) : + {-# LINE 1188 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \"file.txt/boris\") == (Posix.relFile \"file.txt/boris\",\"\")", + Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","")) : + {-# LINE 1189 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \"file.txt/boris.ext\") == (Posix.relFile \"file.txt/boris\",\".ext\")", + Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext")) : + {-# LINE 1190 "src/System/Path/Internal.hs" #-} + ("Path.splitExtension (relFile \"file/path.txt.bob.fred\") == (Posix.relFile \"file/path.txt.bob\",\".fred\")", + Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred")) : + {-# LINE 1196 "src/System/Path/Internal.hs" #-} + ("Path.splitExtensions (relFile \"file.tar.gz\") == (Posix.relFile \"file\",\".tar.gz\")", + Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz")) : + {-# LINE 1212 "src/System/Path/Internal.hs" #-} + ("Path.takeBaseName (absFile \"/tmp/somedir/myfile.txt\") == Posix.relFile \"myfile\"", + Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile") : + {-# LINE 1213 "src/System/Path/Internal.hs" #-} + ("Path.takeBaseName (relFile \"./myfile.txt\") == Posix.relFile \"myfile\"", + Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile") : + {-# LINE 1214 "src/System/Path/Internal.hs" #-} + ("Path.takeBaseName (relFile \"myfile.txt\") == Posix.relFile \"myfile\"", + Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile") : + {-# LINE 1223 "src/System/Path/Internal.hs" #-} + ("Path.takeExtension x == snd (Path.splitExtension x)", + Path.takeExtension x == snd (Path.splitExtension x)) : + {-# LINE 1224 "src/System/Path/Internal.hs" #-} + ("Path.takeExtension (Path.addExtension x \"ext\") == \".ext\"", + Path.takeExtension (Path.addExtension x "ext") == ".ext") : + {-# LINE 1225 "src/System/Path/Internal.hs" #-} + ("Path.takeExtension (Path.replaceExtension x \"ext\") == \".ext\"", + Path.takeExtension (Path.replaceExtension x "ext") == ".ext") : + {-# LINE 1231 "src/System/Path/Internal.hs" #-} + ("Path.takeExtensions (Posix.relFile \"file.tar.gz\") == \".tar.gz\"", + Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz") : + {-# LINE 1237 "src/System/Path/Internal.hs" #-} + ("Path.takeFileName (absFile \"/tmp/somedir/myfile.txt\") == Posix.relFile \"myfile.txt\"", + Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt") : + {-# LINE 1238 "src/System/Path/Internal.hs" #-} + ("Path.takeFileName (relFile \"./myfile.txt\") == Posix.relFile \"myfile.txt\"", + Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt") : + {-# LINE 1239 "src/System/Path/Internal.hs" #-} + ("Path.takeFileName (relFile \"myfile.txt\") == Posix.relFile \"myfile.txt\"", + Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt") : + {-# LINE 1256 "src/System/Path/Internal.hs" #-} + (" Posix.equalFilePath \"abc/def\" \"abc/def\"", + Posix.equalFilePath "abc/def" "abc/def") : + {-# LINE 1257 "src/System/Path/Internal.hs" #-} + (" Posix.equalFilePath \"abc/def\" \"abc//def\"", + Posix.equalFilePath "abc/def" "abc//def") : + {-# LINE 1258 "src/System/Path/Internal.hs" #-} (" Posix.equalFilePath \"/tmp/\" \"/tmp\"", Posix.equalFilePath "/tmp/" "/tmp") : - {-# LINE 801 "src/System/Path/Internal.hs" #-} + {-# LINE 1259 "src/System/Path/Internal.hs" #-} + (" Posix.equalFilePath \"/tmp\" \"//tmp\"", + Posix.equalFilePath "/tmp" "//tmp") : + {-# LINE 1260 "src/System/Path/Internal.hs" #-} + (" Posix.equalFilePath \"/tmp\" \"///tmp\"", + Posix.equalFilePath "/tmp" "///tmp") : + {-# LINE 1261 "src/System/Path/Internal.hs" #-} + ("not $ Posix.equalFilePath \"abc\" \"def\"", + not $ Posix.equalFilePath "abc" "def") : + {-# LINE 1262 "src/System/Path/Internal.hs" #-} ("not $ Posix.equalFilePath \"/tmp\" \"tmp\"", not $ Posix.equalFilePath "/tmp" "tmp") : - {-# LINE 802 "src/System/Path/Internal.hs" #-} + {-# LINE 1263 "src/System/Path/Internal.hs" #-} + (" Windows.equalFilePath \"abc\\\\def\" \"abc\\\\def\"", + Windows.equalFilePath "abc\\def" "abc\\def") : + {-# LINE 1264 "src/System/Path/Internal.hs" #-} + (" Windows.equalFilePath \"abc\\\\def\" \"abc\\\\\\\\def\"", + Windows.equalFilePath "abc\\def" "abc\\\\def") : + {-# LINE 1265 "src/System/Path/Internal.hs" #-} (" Windows.equalFilePath \"file\" \"File\"", Windows.equalFilePath "file" "File") : - {-# LINE 803 "src/System/Path/Internal.hs" #-} + {-# LINE 1266 "src/System/Path/Internal.hs" #-} + (" Windows.equalFilePath \"\\\\file\" \"\\\\\\\\file\"", + Windows.equalFilePath "\\file" "\\\\file") : + {-# LINE 1267 "src/System/Path/Internal.hs" #-} + (" Windows.equalFilePath \"\\\\file\" \"\\\\\\\\\\\\file\"", + Windows.equalFilePath "\\file" "\\\\\\file") : + {-# LINE 1268 "src/System/Path/Internal.hs" #-} + ("not $ Windows.equalFilePath \"abc\" \"def\"", + not $ Windows.equalFilePath "abc" "def") : + {-# LINE 1269 "src/System/Path/Internal.hs" #-} ("not $ Windows.equalFilePath \"file\" \"dir\"", not $ Windows.equalFilePath "file" "dir") : - {-# LINE 817 "src/System/Path/Internal.hs" #-} - ("Posix.joinPath [\"tmp\",\"someDir\",\"dir\"] == Posix.asRelDir \"tmp/someDir/dir\"", - Posix.joinPath ["tmp","someDir","dir"] == Posix.asRelDir "tmp/someDir/dir") : - {-# LINE 818 "src/System/Path/Internal.hs" #-} - ("Posix.joinPath [\"tmp\",\"someDir\",\"file.txt\"] == Posix.asRelFile \"tmp/someDir/file.txt\"", - Posix.joinPath ["tmp","someDir","file.txt"] == Posix.asRelFile "tmp/someDir/file.txt") : - {-# LINE 824 "src/System/Path/Internal.hs" #-} - ("Posix.normalise \"/tmp/fred/./jim/./file\" == Posix.asAbsFile \"/tmp/fred/jim/file\"", - Posix.normalise "/tmp/fred/./jim/./file" == Posix.asAbsFile "/tmp/fred/jim/file") : - {-# LINE 831 "src/System/Path/Internal.hs" #-} - ("Posix.splitPath (Posix.asAbsDir \"/tmp/someDir/mydir.dir\") == (True, [\"tmp\",\"someDir\",\"mydir.dir\"], Nothing)", - Posix.splitPath (Posix.asAbsDir "/tmp/someDir/mydir.dir") == (True, ["tmp","someDir","mydir.dir"], Nothing)) : - {-# LINE 832 "src/System/Path/Internal.hs" #-} - ("Posix.splitPath (Posix.asAbsFile \"/tmp/someDir/myfile.txt\") == (True, [\"tmp\",\"someDir\"], Just \"myfile.txt\")", - Posix.splitPath (Posix.asAbsFile "/tmp/someDir/myfile.txt") == (True, ["tmp","someDir"], Just "myfile.txt")) : - {-# LINE 851 "src/System/Path/Internal.hs" #-} - ("Posix.makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/file.txt\" == Posix.asRelFile \"anotherdir/file.txt\"", - Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == Posix.asRelFile "anotherdir/file.txt") : - {-# LINE 852 "src/System/Path/Internal.hs" #-} - ("Posix.makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/dir\" == Posix.asRelDir \"anotherdir/dir\"", - Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == Posix.asRelDir "anotherdir/dir") : - {-# LINE 853 "src/System/Path/Internal.hs" #-} - ("Windows.makeRelative \"c:\\\\tmp\\\\somedir\" \"c:\\\\Tmp\\\\SomeDir\\\\AnotherDir\\\\File.txt\" == Windows.asRelFile \"AnotherDir\\\\File.txt\"", - Windows.makeRelative "c:\\tmp\\somedir" "c:\\Tmp\\SomeDir\\AnotherDir\\File.txt" == Windows.asRelFile "AnotherDir\\File.txt") : - {-# LINE 854 "src/System/Path/Internal.hs" #-} - ("Windows.makeRelative \"c:\\\\tmp\\\\somedir\" \"c:\\\\tmp\\\\somedir\\\\anotherdir\\\\dir\" == Windows.asRelDir \"anotherdir\\\\dir\"", - Windows.makeRelative "c:\\tmp\\somedir" "c:\\tmp\\somedir\\anotherdir\\dir" == Windows.asRelDir "anotherdir\\dir") : - {-# LINE 867 "src/System/Path/Internal.hs" #-} - ("Posix.makeAbsolute \"/tmp\" \"file.txt\" == Posix.asAbsFile \"/tmp/file.txt\"", - Posix.makeAbsolute "/tmp" "file.txt" == Posix.asAbsFile "/tmp/file.txt") : - {-# LINE 868 "src/System/Path/Internal.hs" #-} - ("Posix.makeAbsolute \"/tmp\" \"adir/file.txt\" == Posix.asAbsFile \"/tmp/adir/file.txt\"", - Posix.makeAbsolute "/tmp" "adir/file.txt" == Posix.asAbsFile "/tmp/adir/file.txt") : - {-# LINE 869 "src/System/Path/Internal.hs" #-} - ("Posix.makeAbsolute \"/tmp\" \"adir/dir\" == Posix.asAbsDir \"/tmp/adir/dir\"", - Posix.makeAbsolute "/tmp" "adir/dir" == Posix.asAbsDir "/tmp/adir/dir") : - {-# LINE 881 "src/System/Path/Internal.hs" #-} - ("Posix.genericMakeAbsolute \"/tmp\" (Posix.asRelFile \"file.txt\") == \"/tmp/file.txt\"", - Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "file.txt") == "/tmp/file.txt") : - {-# LINE 882 "src/System/Path/Internal.hs" #-} - ("Posix.genericMakeAbsolute \"/tmp\" (Posix.asRelFile \"adir/file.txt\") == \"/tmp/adir/file.txt\"", - Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "adir/file.txt") == "/tmp/adir/file.txt") : - {-# LINE 883 "src/System/Path/Internal.hs" #-} - ("Posix.genericMakeAbsolute \"/tmp\" (Posix.asAbsFile \"adir/file.txt\") == \"/adir/file.txt\"", - Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "adir/file.txt") == "/adir/file.txt") : - {-# LINE 884 "src/System/Path/Internal.hs" #-} - ("Posix.genericMakeAbsolute \"/tmp\" (Posix.asAbsFile \"/adir/file.txt\") == \"/adir/file.txt\"", - Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "/adir/file.txt") == "/adir/file.txt") : - {-# LINE 929 "src/System/Path/Internal.hs" #-} - ("Posix.isAbsolute (Posix.asAbsFile \"fred\")", - Posix.isAbsolute (Posix.asAbsFile "fred")) : - {-# LINE 930 "src/System/Path/Internal.hs" #-} - ("Posix.isAbsolute (Posix.asAbsFile \"/fred\")", - Posix.isAbsolute (Posix.asAbsFile "/fred")) : - {-# LINE 931 "src/System/Path/Internal.hs" #-} - ("Windows.isAbsolute (Windows.asAbsFile \"\\\\fred\")", - Windows.isAbsolute (Windows.asAbsFile "\\fred")) : - {-# LINE 932 "src/System/Path/Internal.hs" #-} - ("Windows.isAbsolute (Windows.asAbsFile \"c:\\\\fred\")", - Windows.isAbsolute (Windows.asAbsFile "c:\\fred")) : - {-# LINE 948 "src/System/Path/Internal.hs" #-} - ("Posix.isRelative (Posix.asRelFile \"fred\")", - Posix.isRelative (Posix.asRelFile "fred")) : - {-# LINE 949 "src/System/Path/Internal.hs" #-} - ("Posix.isRelative (Posix.asRelFile \"/fred\")", - Posix.isRelative (Posix.asRelFile "/fred")) : - {-# LINE 950 "src/System/Path/Internal.hs" #-} - ("Windows.isRelative (Windows.asRelFile \"fred\")", - Windows.isRelative (Windows.asRelFile "fred")) : - {-# LINE 964 "src/System/Path/Internal.hs" #-} - ("null (Posix.takeExtension x) == not (Posix.hasAnExtension x)", - null (Posix.takeExtension x) == not (Posix.hasAnExtension x)) : - {-# LINE 970 "src/System/Path/Internal.hs" #-} - ("Posix.hasExtension \".hs\" (Posix.asRelFile \"MyCode.hs\")", - Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.hs")) : - {-# LINE 971 "src/System/Path/Internal.hs" #-} - ("Posix.hasExtension \".hs\" (Posix.asRelFile \"MyCode.bak.hs\")", - Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.bak.hs")) : - {-# LINE 972 "src/System/Path/Internal.hs" #-} - ("not $ Posix.hasExtension \".hs\" (Posix.asRelFile \"MyCode.hs.bak\")", - not $ Posix.hasExtension ".hs" (Posix.asRelFile "MyCode.hs.bak")) : - {-# LINE 990 "src/System/Path/Internal.hs" #-} + {-# LINE 1282 "src/System/Path/Internal.hs" #-} + ("Path.joinPath [\"tmp\",\"someDir\",\"dir\"] == Posix.relDir \"tmp/someDir/dir\"", + Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir") : + {-# LINE 1283 "src/System/Path/Internal.hs" #-} + ("Path.joinPath [\"tmp\",\"someDir\",\"file.txt\"] == Posix.relFile \"tmp/someDir/file.txt\"", + Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt") : + {-# LINE 1289 "src/System/Path/Internal.hs" #-} + ("Path.normalise (absFile \"/tmp/fred/./jim/./file\") == Posix.absFile \"/tmp/fred/jim/file\"", + Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file") : + {-# LINE 1295 "src/System/Path/Internal.hs" #-} + ("Path.splitPath (Posix.absDir \"/tmp/someDir/mydir.dir\") == (True, map relDir [\"tmp\",\"someDir\",\"mydir.dir\"], Nothing)", + Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing)) : + {-# LINE 1296 "src/System/Path/Internal.hs" #-} + ("Path.splitPath (Posix.absFile \"/tmp/someDir/myfile.txt\") == (True, map relDir [\"tmp\",\"someDir\"], Just $ relFile \"myfile.txt\")", + Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt")) : + {-# LINE 1315 "src/System/Path/Internal.hs" #-} + ("Path.makeRelative (absDir \"/tmp/somedir\") (absFile \"/tmp/somedir/anotherdir/file.txt\") == Posix.relFile \"anotherdir/file.txt\"", + Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt") : + {-# LINE 1316 "src/System/Path/Internal.hs" #-} + ("Path.makeRelative (absDir \"/tmp/somedir\") (absDir \"/tmp/somedir/anotherdir/dir\") == Posix.relDir \"anotherdir/dir\"", + Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir") : + {-# LINE 1317 "src/System/Path/Internal.hs" #-} + ("Path.makeRelative (absDir \"c:\\\\tmp\\\\somedir\") (absFile \"C:\\\\Tmp\\\\SomeDir\\\\AnotherDir\\\\File.txt\") == Windows.relFile \"AnotherDir\\\\File.txt\"", + Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt") : + {-# LINE 1318 "src/System/Path/Internal.hs" #-} + ("Path.makeRelative (absDir \"c:\\\\tmp\\\\somedir\") (absDir \"c:\\\\tmp\\\\somedir\\\\anotherdir\\\\dir\") == Windows.relDir \"anotherdir\\\\dir\"", + Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir") : + {-# LINE 1319 "src/System/Path/Internal.hs" #-} + ("Path.makeRelative (absDir \"c:tmp\\\\somedir\") (absDir \"c:tmp\\\\somedir\\\\anotherdir\\\\dir\") == Windows.relDir \"anotherdir\\\\dir\"", + Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir") : + {-# LINE 1330 "src/System/Path/Internal.hs" #-} + ("Path.makeRelativeMaybe (Posix.absDir \"/tmp/somedir\") (absFile \"/tmp/anotherdir/file.txt\") == Nothing", + Path.makeRelativeMaybe (Posix.absDir "/tmp/somedir") (absFile "/tmp/anotherdir/file.txt") == Nothing) : + {-# LINE 1331 "src/System/Path/Internal.hs" #-} + ("Path.makeRelativeMaybe (Posix.absDir \"/Tmp\") (absFile \"/tmp/anotherdir/file.txt\") == Nothing", + Path.makeRelativeMaybe (Posix.absDir "/Tmp") (absFile "/tmp/anotherdir/file.txt") == Nothing) : + {-# LINE 1332 "src/System/Path/Internal.hs" #-} + ("Path.makeRelativeMaybe (Windows.absDir \"\\\\Tmp\") (absFile \"\\\\tmp\\\\anotherdir\\\\file.txt\") == Just (relFile \"anotherdir\\\\file.txt\")", + Path.makeRelativeMaybe (Windows.absDir "\\Tmp") (absFile "\\tmp\\anotherdir\\file.txt") == Just (relFile "anotherdir\\file.txt")) : + {-# LINE 1346 "src/System/Path/Internal.hs" #-} + ("Path.makeAbsolute (absDir \"/tmp\") (relFile \"file.txt\") == Posix.absFile \"/tmp/file.txt\"", + Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt") : + {-# LINE 1347 "src/System/Path/Internal.hs" #-} + ("Path.makeAbsolute (absDir \"/tmp\") (relFile \"adir/file.txt\") == Posix.absFile \"/tmp/adir/file.txt\"", + Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt") : + {-# LINE 1348 "src/System/Path/Internal.hs" #-} + ("Path.makeAbsolute (absDir \"/tmp\") (relDir \"adir/dir\") == Posix.absDir \"/tmp/adir/dir\"", + Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir") : + {-# LINE 1370 "src/System/Path/Internal.hs" #-} + ("Path.genericMakeAbsolute (absDir \"/tmp\") (relFile \"file.txt\") == Posix.absFile \"/tmp/file.txt\"", + Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt") : + {-# LINE 1371 "src/System/Path/Internal.hs" #-} + ("Path.genericMakeAbsolute (absDir \"/tmp\") (relFile \"adir/file.txt\") == Posix.absFile \"/tmp/adir/file.txt\"", + Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt") : + {-# LINE 1372 "src/System/Path/Internal.hs" #-} + ("Path.genericMakeAbsolute (absDir \"/tmp\") (absFile \"/adir/file.txt\") == Posix.absFile \"/adir/file.txt\"", + Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt") : + {-# LINE 1457 "src/System/Path/Internal.hs" #-} + ("Path.isAbsolute (Posix.absFile \"/fred\")", + Path.isAbsolute (Posix.absFile "/fred")) : + {-# LINE 1458 "src/System/Path/Internal.hs" #-} + ("Path.isAbsolute (Windows.absFile \"\\\\fred\")", + Path.isAbsolute (Windows.absFile "\\fred")) : + {-# LINE 1459 "src/System/Path/Internal.hs" #-} + ("Path.isAbsolute (Windows.absFile \"c:\\\\fred\")", + Path.isAbsolute (Windows.absFile "c:\\fred")) : + {-# LINE 1460 "src/System/Path/Internal.hs" #-} + ("Path.isAbsolute (Windows.absFile \"c:fred\")", + Path.isAbsolute (Windows.absFile "c:fred")) : + {-# LINE 1467 "src/System/Path/Internal.hs" #-} + ("Path.isRelative (Posix.relFile \"fred\")", + Path.isRelative (Posix.relFile "fred")) : + {-# LINE 1468 "src/System/Path/Internal.hs" #-} + ("Path.isRelative (Windows.relFile \"fred\")", + Path.isRelative (Windows.relFile "fred")) : + {-# LINE 1493 "src/System/Path/Internal.hs" #-} + ("null (Path.takeExtension x) == not (Path.hasAnExtension x)", + null (Path.takeExtension x) == not (Path.hasAnExtension x)) : + {-# LINE 1499 "src/System/Path/Internal.hs" #-} + ("Path.hasExtension \".hs\" (Posix.relFile \"MyCode.hs\")", + Path.hasExtension ".hs" (Posix.relFile "MyCode.hs")) : + {-# LINE 1500 "src/System/Path/Internal.hs" #-} + ("Path.hasExtension \".hs\" (Posix.relFile \"MyCode.bak.hs\")", + Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs")) : + {-# LINE 1501 "src/System/Path/Internal.hs" #-} + ("not $ Path.hasExtension \".hs\" (Posix.relFile \"MyCode.hs.bak\")", + not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak")) : + {-# LINE 1511 "src/System/Path/Internal.hs" #-} ("Posix.extSeparator == '.'", Posix.extSeparator == '.') : - {-# LINE 1001 "src/System/Path/Internal.hs" #-} - ("Posix.isPathSeparator Posix.pathSeparator", - Posix.isPathSeparator Posix.pathSeparator) : - {-# LINE 1008 "src/System/Path/Internal.hs" #-} - ("Posix.pathSeparator `elem` Posix.pathSeparators", - Posix.pathSeparator `elem` Posix.pathSeparators) : - {-# LINE 1019 "src/System/Path/Internal.hs" #-} + {-# LINE 1522 "src/System/Path/Internal.hs" #-} ("Posix.isExtSeparator a == (a == Posix.extSeparator)", Posix.isExtSeparator a == (a == Posix.extSeparator)) : - {-# LINE 1026 "src/System/Path/Internal.hs" #-} - ("Posix.isPathSeparator a == (a `elem` Posix.pathSeparators)", - Posix.isPathSeparator a == (a `elem` Posix.pathSeparators)) : - {-# LINE 1032 "src/System/Path/Internal.hs" #-} + {-# LINE 1528 "src/System/Path/Internal.hs" #-} ("Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator)", Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator)) : - {-# LINE 1048 "src/System/Path/Internal.hs" #-} - ("Posix.genericAddExtension \"/\" \"x\" == Posix.asAbsDir \"/.x\"", - Posix.genericAddExtension "/" "x" == Posix.asAbsDir "/.x") : - {-# LINE 1049 "src/System/Path/Internal.hs" #-} - ("Posix.genericAddExtension \"/a\" \"x\" == Posix.asAbsDir \"/a.x\"", - Posix.genericAddExtension "/a" "x" == Posix.asAbsDir "/a.x") : - {-# LINE 1050 "src/System/Path/Internal.hs" #-} - ("Posix.genericAddExtension \"\" \"x\" == Posix.asRelFile \".x\"", - Posix.genericAddExtension "" "x" == Posix.asRelFile ".x") : - {-# LINE 1051 "src/System/Path/Internal.hs" #-} - ("Posix.genericAddExtension \"\" \"\" == Posix.asRelFile \"\"", - Posix.genericAddExtension "" "" == Posix.asRelFile "") : + {-# LINE 1544 "src/System/Path/Internal.hs" #-} + ("Path.genericAddExtension (absDir \"/\") \"x\" == Posix.absDir \"/.x\"", + Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x") : + {-# LINE 1545 "src/System/Path/Internal.hs" #-} + ("Path.genericAddExtension (absDir \"/a\") \"x\" == Posix.absDir \"/a.x\"", + Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x") : + {-# LINE 1546 "src/System/Path/Internal.hs" #-} + ("Path.genericAddExtension Path.emptyFile \"x\" == Posix.relFile \".x\"", + Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x") : + {-# LINE 1547 "src/System/Path/Internal.hs" #-} + ("Path.genericAddExtension Path.emptyFile \"\" == Posix.emptyFile", + Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile) : + {-# LINE 1685 "src/System/Path/Internal.hs" #-} + ("Posix.isPathSeparator Posix.pathSeparator", + Posix.isPathSeparator Posix.pathSeparator) : + {-# LINE 1690 "src/System/Path/Internal.hs" #-} + ("Posix.pathSeparator `elem` Posix.pathSeparators", + Posix.pathSeparator `elem` Posix.pathSeparators) : + {-# LINE 1697 "src/System/Path/Internal.hs" #-} + ("Posix.isPathSeparator a == (a `elem` Posix.pathSeparators)", + Posix.isPathSeparator a == (a `elem` Posix.pathSeparators)) : [] diff --git a/test/TestTemplate.hs b/test/TestTemplate.hs --- a/test/TestTemplate.hs +++ b/test/TestTemplate.hs @@ -1,13 +1,15 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module TestResult (results) where +import qualified System.Path.Generic as Path import qualified System.Path.Posix as Posix import qualified System.Path.Windows as Windows -import System.Path ((), (<.>)) +import System.Path.Generic ((), (<.>), relFile, relDir, absFile, absDir) import Data.Char (toLower) -results :: (Posix.AbsRelClass ar) => Char -> Posix.FilePath ar -> [(String, Bool)] +results :: + (Path.AbsRelClass ar) => Char -> Posix.FilePath ar -> [(String, Bool)] results a x = [] diff --git a/tool/CreateTest.hs b/tool/CreateTest.hs --- a/tool/CreateTest.hs +++ b/tool/CreateTest.hs @@ -1,8 +1,11 @@ module Main where -import Control.Applicative ((<$>)) +import qualified Control.Functor.HT as FuncHT +import Control.Applicative ((<$>), (<$)) import Data.List (stripPrefix, isInfixOf) import Data.Maybe (mapMaybe) +import Data.Tuple.HT (mapFst) +import Data.Char (isSpace) import Text.Printf (printf) @@ -20,13 +23,13 @@ main :: IO () main = do - let mapSndF f (a,b) = (,) a <$> f b let readFileNumbered path = - zipWith (\n row -> ((path,n), row)) [(0::Int)..] . lines <$> - readFile path + zip ((,) path <$> [(0::Int)..]) . lines <$> readFile path testLines <- - mapMaybe (mapSndF $ stripPrefix testPrefix) . concat <$> - mapM readFileNumbered srcfiles + mapMaybe (FuncHT.mapSnd $ stripPrefix testPrefix) . + map (\(n,row) -> mapFst ((,) n) $ span isSpace row) . + concat + <$> mapM readFileNumbered srcfiles (templateHead,_:templateTail) <- break (tok `isInfixOf`) . lines <$> readFile template {- @@ -34,9 +37,10 @@ such that GHC reports precise source file locations. -} let outLines = - (\((src,n),t) -> - printf " {-# LINE %d \"%s\" #-}\n (%s,\n %s) :" - n src (show t) t) <$> testLines + (\(((src,n),ind),t) -> + printf " {-# LINE %d \"%s\" #-}\n (%s,\n%s%s%s) :" + n src (show t) ind (' ' <$ testPrefix) t) + <$> testLines writeFile testModule $ unlines $ ("{- Do not edit! Created from " ++ template ++ " -}") : diff --git a/windows/System/Path/Host.hs b/windows/System/Path/Host.hs new file mode 100644 --- /dev/null +++ b/windows/System/Path/Host.hs @@ -0,0 +1,2 @@ +module System.Path.Host (module System.Path.Windows) where +import System.Path.Windows