diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,141 @@ +0.8: + +* relPath, absPath, filePath, dirPath deprecated in favor of + Path.rel, Path.abs, Path.absRel, Path.file, Path.dir + Same for the according type synonyms. + +* Deprecate extended path construction functions: + mkAbsPath, mkAbsPathFromCwd, mkPathAbsOrRel, mkPathFileOrDir + You better combine path constructors and further manipulations. + +* Deprecate functions based on path strings. + You should better use functions from the filepath package. + +* absRel -> withAbsRel, fileDir -> withFileDir + We do not need these functions very often + and instead we need Path.absRel as constructor name + that is consistent with Path.abs and Path.rel. + +* Split main module into multiple one, + in order to use a consistent name set for every aspect. + + E.g. we have: + Path.Abs: an absolute path + Path.Part.Abs: absolute (drive) part of a path + Path.PartClass.Abs: class for an absolute part + + Path.AbsRel: an absolute or relative path + Path.Part.AbsRel: initial part of an absolute or relative path + Path.PartClass.AbsRel: class for absolute or relative parts + + Path.Abs -> Part.Abs + Path.AbsOrRel -> Part.AbsRel + Path.AbsOrRelClass -> PartClass.AbsRel + Path.FileOrDirClass -> PartClass.FileDir + +0.7: + +* Move absRel and fileDir out of their classes. + A problem would arise if someone writes + import System.Path (AbsRelClass(absRel)) + He would have to replace it by + import System.Path (AbsRelClass, absRel) + +* Monoid instance for Path.RelDir + Requires helper classes IsRel, IsDir. + IsAbs and IsFile added for completeness. + +* Declare infix precedences of , <.> and <++> such that we can write: + dir0 dir1 dir2 base <++> "-foo" <++> "-bar" <.> "tar" <.> "gz" + This is similar to the fixities in the 'filepath' package, + but differs slightly + since in our package paths and extensions have different types. + +* Import packages 'transformers' and 'utility-ht' + that allow for some simplifications. + +* Deprecate asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath + +* Recommended are now the checking constructors 'path', maybePath, parsePath, + relFile, relDir, absFile, absDir, + relPath, absPath, filePath, dirPath + +* replace IsString instance for OverloadedStrings + by an instance that cannot be implemented. + +* getDirectoryContents is no longer synonym to relDirectoryContents. + Instead it returns the list of all directory objects as RelFileOrDir. + This is closer to the getDirectoryContents function + from the 'directory' package. + +* clarify meaning of AbsRel and FileDir tags of a path + +* clarify meaning of drive-relative paths on Windows + +* clarify handling of file system links + +0.6: + +* joinPath: restrict to RelPath and atomic path components + +* Add type class constraints and restrict types + in order to make the functions work with the new datatype. + E.g. we need to fix the type to FilePath + wherever a function requires a non-empty path. + +* Add support for MS Windows paths with leading drive labels + +0.5.5: + +* AbsRelClass, FileDirClass: turn into closed-world classes. + Strict accordance to PVP would require to bump version to 0.6, + but since the user cannot write instances of this class, + we can hardly break code. + +* instance {Show, Read} Path now emit and parse valid Haskell expressions + +* IO.withFile restricted to FilePath + This changes API but it should only break buggy code. + +0.5.4.3: + +* Make test suite static part of the source code, + but maintain a program to update the test suite to changed tests. + +0.5.4.1: + +* Merge git back to darcs, continue on hub.darcs.net + +0.5.4: + +* Migrated from darcs to git (on GitHub) + +0.5.3: + +* Upgrades + changes for GHC 7.6.1 - by Ben Millwood + +0.5.0: + +* Added System.Path.Windows and System.Path.Posix modules. These are modelled on the System.FilePath approach to supporting the two styles of path. + +0.0.2: + +* Split System.Path.Directory into its own module +* Implemented covers for all the remaining System.Directory functions +* Renamed 'hasExtension' to 'hasAnExtension', and added new 'hasExtension' fn which checks for a given extension +* Renamed the '...FileOrDir...' functions to be 'generic...' (thanks to Neil Mitchell for the suggestion!) +* Added support for OverloadedStrings +* Renamed the 'mk...' unchecked construction functions to 'as...' to better reflect what they do +* Added: makeAbsolute, makeAbsoluteFromCwd, genericMakeAbsolute, genericMakeAbsoluteFromCwd +* Added: mkAbsPath, mkAbsPathFromCwd +* Added System.Path.IO to cover System.IO +* Made the internal 'Path' type strict +* Removed 'splitDirectories' as it serves no purpose not covered by 'splitPath' +* Changed behaviour of 'getDirectoryContents' to return relative paths +* Fixed the type of 'setCurrentDirectory' + +0.0.1: + +Initial Release diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,243 @@ +# Construction of type-safe paths + +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. + + +# Modules + +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. + + +# How to choose proper type arguments + +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 a 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 a 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 `AbsRel` 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 be 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. + + +# AbsRel vs. `ar` type parameter + +In your application you will often know +whether your path denotes a file or directory, +thus you will use the `Path.File` or `Path.Dir` type synonym. +In contrast to that, you will often not know +whether the path is relative or absolute +and often it does not even matter. +You can express this either by using the monomorphic type `Path.AbsRelFile` +or by using the parameterized type `Path.File ar` +with constraint `PathClass.AbsRel ar`. +We recommend to use the first variant for command-line option parsing +and the second one for the application functions. +When you parse options it is the time where you know that you do not know +whether the path is absolute or relative. +That is, you could neither parse it as `Path.Abs` nor as `Path.Rel`. +Thus a type variable makes no sense. +You should always parse to type `Path.AbsRel`. +Conversely, your application would work equally well with +`Path.Abs`, `Path.Rel` and `Path.AbsRel`. +Thus, using an `ar` type variable is the way to go. +You must make sure to use different `ar`-like variables for independent paths. +By equality of `ar`-like type variables +you can also document dependencies of paths for the programmers. + + +# Command-line argument parsing with `optparse-applicative` + +For parsing of path options with the `optparse-applicative` package +you might use the following helper functions: + + module Option where + + import qualified System.Path.PartClass as PathC + import qualified System.Path as Path + import qualified Options.Applicative as OP + + path :: (PathC.FileDir fd) => OP.ReadM (Path.AbsRel fd) + path = OP.eitherReader Path.parse + + pathArgument :: + PathC.FileDir fd => + OP.Mod OP.ArgumentFields (Path.AbsRel fd) -> OP.Parser (Path.AbsRel fd) + pathArgument = OP.argument path + + pathOption :: + PathC.FileDir fd => + OP.Mod OP.OptionFields (Path.AbsRel fd) -> OP.Parser (Path.AbsRel fd) + pathOption = OP.option path + +It performs minimal checking of path strings as part of option parsing. +E.g. it will report a user error if the user passes "abc/" as a file path. + + +# 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. + + +# Drive-relative paths on MS 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. + + +# Path format strings + +You might allow a user to pass a format string such as +`"page%06d.png"` to your program. +How to integrate this into the type-safe path handling? +We recommend not to use the `Path` for the format string +but instead to define a custom type: + + newtype Format ar fd = Format String + + printf :: + (PathC.AbsRel ar) => + Format ar fd -> Int -> Either String (Path ar fd) + printf (Format fmt) n = Path.parse (Pf.printf fmt n) + +This makes sure that you will access a path on disk +only after formatting the path string. + + +# Known problems + +## Mac + +Currently we select the Posix module on Mac systems. +On the one hand this choice is right +since Mac uses slashes for path component separation. +On the other hand it is wrong +since Mac ignores case when comparing filepaths. diff --git a/pathtype.cabal b/pathtype.cabal --- a/pathtype.cabal +++ b/pathtype.cabal @@ -1,117 +1,100 @@ +Cabal-Version: 2.2 Name: pathtype -Version: 0.5.5 +Version: 0.8.1.4 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. - . - . +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 package 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 Path.AbsFile = Path Abs File + > type Path.RelFile = Path Rel File + > type Path.AbsDir = Path Abs Dir + > type Path.RelDir = Path Rel Dir + > + > type Path.Abs fd = Path Abs fd + > type Path.Rel fd = Path Rel fd + > type Path.File ar = Path ar File + > type Path.Dir ar = Path ar Dir + . + The type of the 'combine' (aka '') function gives the idea: + . + > () :: Path.Dir ar -> Path.Rel 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. + . + For more details see the README.md file. + . + Related packages: + . + * @filepath@: The API of Neil Mitchell's "System.FilePath" module + (and properties satisfied) heavily influenced our package. + . + * @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. + . + * @hpath@: + @ByteString@-based path type with type parameter + for absolute and relative paths. Stability: experimental -License: BSD3 +License: BSD-3-Clause Category: System License-file: LICENSE Author: Ben Moseley, Ben Millwood, Henning Thielemann -Maintainer: haskell@henning-thielemann.de, ben@moseley.name -HomePage: http://hub.darcs.net/thielema/pathtype/ +Maintainer: haskell@henning-thielemann.de +HomePage: https://hub.darcs.net/thielema/pathtype/ Build-Type: Simple -Cabal-Version: >=1.8 Extra-Source-Files: - test/TestTemplate.hs - src/System/Path/Internal.hs + README.md + 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 +Extra-Doc-Files: + CHANGELOG + Source-Repository head Type: darcs - Location: http://hub.darcs.net/thielema/pathtype/ + Location: https://hub.darcs.net/thielema/pathtype/ Source-Repository this - Tag: 0.5.5 + Tag: 0.8.1.4 Type: darcs - Location: http://hub.darcs.net/thielema/pathtype/ + Location: https://hub.darcs.net/thielema/pathtype/ Flag old-time Description: Build with directory < 1.2 and old-time - Default: True - -Flag buildTools - Description: Build tool for updating test module - Default: True + Default: False Library Build-Depends: - QuickCheck >= 2.1.0.1 && < 3, - deepseq >= 1.3 && <1.5, - time >= 1.0 && < 2, - base >= 4 && < 5 + utility-ht >=0.0.11 && <0.1, + doctest-exitcode-stdio >=0.0 && <0.1, + QuickCheck >=2.1.0.1 && <3, + deepseq >=1.3 && <1.7, + time >=1.0 && <2, + transformers >=0.3 && <0.7, + semigroups >=0.1 && <1, + tagged >=0.7 && <0.9, + base >=4.11 && <5 If flag(old-time) Build-Depends: directory >= 1 && < 1.2, old-time >= 1.0 && < 2 @@ -121,37 +104,49 @@ 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 + System.Path.Part + System.Path.PartClass Other-Modules: + System.Path.Host + System.Path.Internal + System.Path.Internal.Part + System.Path.Internal.PartClass + System.Path.Internal.Component + System.Path.Internal.Separator + System.Path.Internal.System + System.Path.RegularExpression System.Path.ModificationTime - GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind + GHC-Options: + -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind + Default-Language: Haskell98 Test-Suite test Type: exitcode-stdio-1.0 Main-Is: Test.hs - Other-Modules: TestResult + Other-Modules: + Test.Posix.System.Path.Internal + Test.Windows.System.Path.Internal Hs-Source-Dirs: test Build-Depends: pathtype, - random >=1.0 && <1.2, + QuickCheck, + doctest-exitcode-stdio, + doctest-lib >=0.1 && <0.1.2, base - GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind - -Executable create-pathtype-test - If flag(buildTools) - Build-Depends: - base - Else - Buildable: True - Main-Is: CreateTest.hs - Hs-Source-Dirs: tool - - GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind + GHC-Options: + -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind + Default-Language: Haskell98 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,25 @@ -{-# 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, + Abs, Rel, File, Dir, + AbsRelFile, AbsRelDir, AbsFileDir, RelFileDir, + AbsRel, FileDir, AbsRelFileDir, + AbsPath, RelPath, FilePath, DirPath, + AbsRelPath, FileDirPath, + asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath, + isAbsoluteString, isRelativeString, equalFilePath, + path, maybe, maybePath, parse, parsePath, + relFile, relDir, absFile, absDir, + abs, rel, absRel, file, dir, fileDir, + 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 @@ -8,14 +8,9 @@ -- -- You will typically want to import as follows: -- --- > import Prelude hiding (FilePath) --- > import System.Path --- > import System.Path.Directory --- > import System.Path.IO --- --- --- Ben Moseley - (c) 2009 --- +-- > import qualified System.Path.IO as PathIO +-- > import qualified System.Path as Path +-- > import System.Path.Directory (createDirectory) module System.Path.Directory ( -- * Actions on directories @@ -58,12 +53,19 @@ setPermissions, -- * Timestamps - getModificationTime + getModificationTime, ) where -import System.Path +import qualified System.Path.Internal.PartClass as Class +import qualified System.Path as Path +import System.Path ( + Path, path, + AbsPath, AbsDir, AbsFile, RelPath, RelDir, RelFile, + DirPath, FilePath, absDir, (), + ) + import System.Path.ModificationTime (convertTime) import Data.Time (UTCTime) @@ -73,6 +75,7 @@ import Control.Applicative ((<$>)) import Data.List (partition) +import Data.Tuple.HT (mapPair) import Prelude hiding (FilePath) @@ -80,32 +83,37 @@ ------------------------------------------------------------------------ -- Actions on directories -createDirectory :: AbsRelClass ar => DirPath ar -> IO () -createDirectory = SD.createDirectory . getPathString +createDirectory :: Class.AbsRel ar => DirPath ar -> IO () +createDirectory = SD.createDirectory . Path.toString -createDirectoryIfMissing :: AbsRelClass ar => Bool -> DirPath ar -> IO () -createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . getPathString +createDirectoryIfMissing :: Class.AbsRel ar => Bool -> DirPath ar -> IO () +createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . Path.toString -removeDirectory :: AbsRelClass ar => DirPath ar -> IO () -removeDirectory = SD.removeDirectory . getPathString +removeDirectory :: Class.AbsRel ar => DirPath ar -> IO () +removeDirectory = SD.removeDirectory . Path.toString -removeDirectoryRecursive :: AbsRelClass ar => DirPath ar -> IO () -removeDirectoryRecursive = SD.removeDirectoryRecursive . getPathString +removeDirectoryRecursive :: Class.AbsRel 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 :: + (Class.AbsRel ar1, Class.AbsRel 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 :: Class.AbsRel ar => DirPath ar -> IO [Path.RelFileDir] +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 :: + Class.AbsRel 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.withAbsRel 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,91 +121,105 @@ -- > show (relDirectoryContents "d/e/f/") == (["subDir1A","subDir1B"], -- > ["file1A","file1B"]) -- -relDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile]) +relDirectoryContents :: + Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: + (Class.AbsRel ar1, Class.AbsRel 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 :: + (Class.AbsRel ar1, Class.AbsRel ar2) => + FilePath ar1 -> FilePath ar2 -> IO () +copyFile p1 p2 = SD.copyFile (Path.toString p1) (Path.toString p2) -canonicalizePath :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd) -canonicalizePath p = asPath <$> SD.canonicalizePath (getPathString p) +canonicalizePath :: + (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO (AbsPath fd) +canonicalizePath p = path <$> SD.canonicalizePath (Path.toString p) -makeRelativeToCurrentDirectory :: AbsRelClass ar => Path ar fd -> IO (RelPath fd) -makeRelativeToCurrentDirectory p = asPath <$> SD.makeRelativeToCurrentDirectory (getPathString p) +makeRelativeToCurrentDirectory :: + (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO (RelPath fd) +makeRelativeToCurrentDirectory 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 :: Class.AbsRel ar => FilePath ar -> IO Bool +doesFileExist = SD.doesFileExist . Path.toString -doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool -doesDirectoryExist = SD.doesDirectoryExist . getPathString +doesDirectoryExist :: Class.AbsRel ar => DirPath ar -> IO Bool +doesDirectoryExist = SD.doesDirectoryExist . Path.toString ------------------------------------------------------------------------ -- Permissions -getPermissions :: AbsRelClass ar => Path ar fd -> IO Permissions -getPermissions p = SD.getPermissions (getPathString p) +getPermissions :: + (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO Permissions +getPermissions p = SD.getPermissions (Path.toString p) -setPermissions :: AbsRelClass ar => Path ar fd -> Permissions -> IO () -setPermissions p perms = SD.setPermissions (getPathString p) perms +setPermissions :: + (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> Permissions -> IO () +setPermissions p perms = SD.setPermissions (Path.toString p) perms ------------------------------------------------------------------------ -- Timestamps -getModificationTime :: AbsRelClass ar => Path ar fd -> IO UTCTime -getModificationTime p = convertTime <$> SD.getModificationTime (getPathString p) +getModificationTime :: + (Class.AbsRel ar, Class.FileDir 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 @@ -9,9 +9,9 @@ -- You will typically want to import as follows: -- -- > import Prelude hiding (FilePath) --- > import System.Path --- > import System.Path.Directory --- > import System.Path.IO +-- > import qualified System.Path as Path +-- > import qualified System.Path.Directory as Dir +-- > import qualified System.Path.IO as PIO -- -- -- Ben Moseley - (c) 2009 @@ -85,18 +85,20 @@ SIO.hPutBuf, SIO.hGetBuf, SIO.hPutBufNonBlocking, - SIO.hGetBufNonBlocking + SIO.hGetBufNonBlocking, ) where -import System.Path +import qualified System.Path.Internal.PartClass as Class +import qualified System.Path as Path +import System.Path (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 +106,37 @@ ------------------------------------------------------------------------ -- Covers for System.IO functions -withFile :: AbsRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r -withFile f = SIO.withFile (getPathString f) +withFile :: + Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: Class.AbsRel 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 :: + Class.AbsRel 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 :: Class.AbsRel 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 :: + Class.AbsRel 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 :: + Class.AbsRel 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,958 +1,1705 @@ - --- 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, (|||), (***)) -import Control.Applicative ((<$>)) -import Control.DeepSeq (NFData(rnf)) -import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intercalate) -import Data.String (IsString(fromString)) -import Data.Char (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 - -data Abs -data Rel -data File -data Dir - --- | This is the main filepath abstract datatype -data Path ar fd = PathRoot -- ^ Invariant - this should always have type :: DirPath ar - | FileDir !(DirPath ar) !PathComponent -- The fact that we recurse binding fd to Dir - -- makes this a "nested datatype" - deriving (Eq, Ord) - --- Possible GADT version... --- --- data Path ar fd where --- AbsRoot :: Path Abs Dir --- RelRoot :: Path Rel Dir --- File :: Path ar Dir -> PathComponent -> Path ar File --- Dir :: Path ar Dir -> PathComponent -> Path ar Dir --- --- ... doesn't presently seem to add much value over non-GADT. - -newtype PathComponent = PathComponent String deriving (Eq,Ord) - -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 (Path ar fd) where - rnf PathRoot = () - rnf (FileDir d pc) = rnf (d, pc) - --- I don't think this basic type of fold is appropriate for a nested datatype --- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a --- pathFold pr f PathRoot = pr --- pathFold pr f (FileDir d pc) = f (pathFold pr f d) (unPathComponent pc) - --- | Map over the components of the path. --- --- >> pathMap (map toLower) "/tmp/Reports/SpreadSheets" == "/tmp/reports/spreadsheets" -pathMap :: (String -> String) -> Path ar fd -> Path ar fd -pathMap _ PathRoot = PathRoot -pathMap f (FileDir d pc) = FileDir (pathMap f d) (pcMap f pc) - --- Private fn -pcMap :: (String -> String) -> PathComponent -> PathComponent -pcMap f (PathComponent s) = PathComponent (f s) - - ------------------------------------------------------------------------- --- Type classes and machinery for switching on Abs/Rel and File/Dir - --- | This class provides a way to prevent other modules --- from making further 'AbsRelClass' or 'FileDirClass' --- instances -class Private p -instance Private Abs -instance Private Rel -instance Private File -instance Private Dir - --- | This class allows selective behaviour for absolute and --- relative paths and is mostly for internal use. -class Private ar => AbsRelClass ar where - -- | 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 (FileDirFunc f) (FileDirFunc g) - -newtype FileDir ar a fd = FileDirFunc {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 (rootDir "bla" "blub") == "rootDir \"bla\" \"blub\"" --- >> show (Just (rootDir "bla" "blub")) == "Just (rootDir \"bla\" \"blub\")" --- >> show (currentDir "bla" "blub") == "currentDir \"bla\" \"blub\"" --- >> show (Just (currentDir "bla" "blub")) == "Just (currentDir \"bla\" \"blub\")" -instance AbsRelClass ar => Show (Path ar fd) where - showsPrec d = - let go :: AbsRelClass ar => Path ar fd -> ShowS - go x@PathRoot = - absRel (const $ showString rootName) (const $ showString currentName) x - go (FileDir p (PathComponent pc)) = - go p . showChar ' ' . - showString combineOperator . showChar ' ' . shows pc - in showParen (d>9) . go - --- >> read (show (rootDir "bla" "blub")) == rootDir "bla" "blub" --- >> read (show (Just (rootDir "bla" "blub"))) == Just (rootDir "bla" "blub") --- >> read (show (currentDir "bla" "blub")) == currentDir "bla" "blub" --- >> read (show (Just (currentDir "bla" "blub"))) == Just (currentDir "bla" "blub") -instance AbsRelClass ar => Read (Path ar fd) where - readsPrec d = readParen (d>9) $ \str -> - let go :: AbsRelClass ar => Path ar Dir -> ReadS (Path ar fd) - go path s0 = - case stripPrefix combineOperator $ dropWhile isSpace s0 of - Nothing -> [(relaxDir path, s0)] - Just s1 -> do - (pc, s2) <- reads s1 - go (FileDir path (PathComponent pc)) s2 - result = do - let required = absRel (const rootName) (const currentName) $ fst $ head result - maybe [] (go PathRoot) $ - stripPrefix required $ dropWhile isSpace str - in result - -relaxDir :: Path ar Dir -> Path ar fd -relaxDir PathRoot = PathRoot -relaxDir (FileDir p pc) = FileDir p pc - --- | Convert the 'Path' into a plain 'String' as required for OS calls. -getPathString :: AbsRelClass ar => Path ar fd -> String -getPathString = flip getPathStringS "" - -getPathStringS :: AbsRelClass ar => Path ar fd -> ShowS -getPathStringS = - let go :: AbsRelClass ar => Path ar fd -> ShowS - go x@PathRoot = - absRel - (const $ showChar pathSeparator) - (const $ showString currentDirComponent) x - -- we need the clause below so that we don't duplicate the pathSeparator after an abs - -- root and we don't want to display a "./" prefix on relative paths - go (FileDir p@PathRoot (PathComponent pc)) = - absRel (const $ showChar pathSeparator) (const id) p . - showString pc - go (FileDir p (PathComponent pc)) = - go p . showChar pathSeparator . showString pc - in go - -prop_asPath_getPathString :: AbsFile -> Property -prop_asPath_getPathString p = property $ p == asPath (getPathString p) - - ------------------------------------------------------------------------- --- Windows / Posix - -_isPosix :: Bool -_isPosix = not isWindows - -isWindows :: Bool -isWindows = IS_WINDOWS - ------------------------------------------------------------------------- --- Constants - -rootDir :: AbsDir -rootDir = PathRoot - -currentDir :: RelDir -currentDir = PathRoot - -rootName :: String -rootName = "rootDir" - -currentName :: String -currentName = "currentDir" - -currentDirComponent :: String -currentDirComponent = "." - - ------------------------------------------------------------------------- --- Unchecked Construction Functions --- NB - these construction functions are non-IO and do no checking!! - --- | Use a 'String' as a 'Path' whose type is determined --- by its context. --- --- >> asPath "/tmp" == "/tmp" --- >> asPath "file.txt" == "file.txt" --- >> isAbsolute (asPath "/tmp" :: AbsDir) == True --- >> isAbsolute (asPath "/tmp" :: RelDir) == False --- >> getPathString (asPath "/tmp" :: AbsDir) == "/tmp" --- >> getPathString (asPath "/tmp" :: RelDir) == "tmp" -asPath :: String -> Path ar fd -asPath = mkPathFromComponents . mkPathComponents - --- | Use a 'String' as a 'RelFile'. No checking is done. --- --- >> getPathString (asRelFile "file.txt") == "file.txt" --- >> getPathString (asRelFile "/file.txt") == "file.txt" --- >> getPathString (asRelFile "tmp") == "tmp" --- >> getPathString (asRelFile "/tmp") == "tmp" -asRelFile :: String -> RelFile -asRelFile = asPath - --- | Use a 'String' as a 'RelDir'. No checking is done. --- --- >> getPathString (asRelDir ".") == "." --- >> getPathString (asRelDir "file.txt") == "file.txt" --- >> getPathString (asRelDir "/file.txt") == "file.txt" --- >> getPathString (asRelDir "tmp") == "tmp" --- >> getPathString (asRelDir "/tmp") == "tmp" -asRelDir :: String -> RelDir -asRelDir = asPath - --- | Use a 'String' as an 'AbsFile'. No checking is done. --- --- >> getPathString (asAbsFile "file.txt") == "/file.txt" --- >> getPathString (asAbsFile "/file.txt") == "/file.txt" --- >> getPathString (asAbsFile "tmp") == "/tmp" --- >> getPathString (asAbsFile "/tmp") == "/tmp" -asAbsFile :: String -> AbsFile -asAbsFile = asPath - --- | Use a 'String' as an 'AbsDir'. No checking is done. --- --- >> getPathString (asAbsDir "file.txt") == "/file.txt" --- >> getPathString (asAbsDir "/file.txt") == "/file.txt" --- >> getPathString (asAbsDir "tmp") == "/tmp" --- >> getPathString (asAbsDir "/tmp") == "/tmp" -asAbsDir :: String -> AbsDir -asAbsDir = asPath - --- | Use a 'String' as a 'RelPath fd'. No checking is done. -asRelPath :: String -> RelPath fd -asRelPath = asPath - --- | Use a 'String' as an 'AbsPath fd'. No checking is done. -asAbsPath :: String -> AbsPath fd -asAbsPath = asPath - --- | Use a 'String' as a 'FilePath ar'. No checking is done. -asFilePath :: String -> FilePath ar -asFilePath = asPath - --- | Use a 'String' as a 'DirPath ar'. No checking is done. -asDirPath :: String -> DirPath ar -asDirPath = asPath - --- | Allow use of OverloadedStrings if desired -instance IsString (Path ar fd) where fromString = asPath - ------------------------------------------------------------------------- --- Checked Construction Functions - --- | Examines the supplied string and constructs an absolute or --- relative path as appropriate. --- --- >> mkPathAbsOrRel "/tmp" == Left (asAbsDir "/tmp") --- >> mkPathAbsOrRel "tmp" == Right (asRelDir "tmp") -mkPathAbsOrRel :: 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. --- --- >> mkAbsPath "/tmp" "foo.txt" == "/tmp/foo.txt" --- >> mkAbsPath "/tmp" "/etc/foo.txt" == "/etc/foo.txt" -mkAbsPath :: AbsDir -> String -> AbsPath fd -mkAbsPath d = (id ||| makeAbsolute d) . mkPathAbsOrRel - --- | Convert a 'String' into an 'AbsPath' by interpreting it as --- relative to the cwd if necessary. -mkAbsPathFromCwd :: String -> IO (AbsPath fd) -mkAbsPathFromCwd = (return ||| makeAbsoluteFromCwd) . mkPathAbsOrRel - - ------------------------------------------------------------------------- --- Internal Functions for PathComponent manipulation - -mkPathFromComponents :: [PathComponent] -> Path ar fd -mkPathFromComponents pcs = - case reverse pcs of - [] -> PathRoot - p:ps -> FileDir (foldr (flip FileDir) PathRoot ps) p - -mkPathComponents :: String -> [PathComponent] -mkPathComponents xs = - case break isPathSeparator (dropWhile isPathSeparator xs) of - ("","") -> [] - (s,rest) -> PathComponent s : mkPathComponents rest - -pathComponents :: Path ar fd -> [PathComponent] -pathComponents PathRoot = [] -pathComponents (FileDir p pc) = pathComponents p ++ [pc] - -prop_mkPathFromComponents_pathComponents :: AbsFile -> Property -prop_mkPathFromComponents_pathComponents p = - property $ mkPathFromComponents (pathComponents p) == p - - - ------------------------------------------------------------------------- --- Basic Manipulation Functions - -combineOperator :: String -combineOperator = "" - --- | Infix variant of 'combine'. -() :: DirPath ar -> RelPath fd -> Path ar fd -PathRoot PathRoot = PathRoot -(FileDir dp dpc) PathRoot = FileDir dp dpc -d (FileDir p pc) = FileDir (d p) pc - --- | 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 -(<.>) = genericAddExtension - --- | Add an extension, even if there is already one there. --- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@. --- --- >> addExtension "file.txt" "bib" == "file.txt.bib" --- >> addExtension "file." ".bib" == "file..bib" --- >> addExtension "file" ".bib" == "file.bib" --- >> addExtension "" "bib" == ".bib" --- >> addExtension "" ".bib" == ".bib" --- >> takeFileName (addExtension "" "ext") == ".ext" -addExtension :: FilePath ar -> String -> FilePath ar -addExtension = (<.>) - --- | Join an (absolute or relative) directory path with a relative --- (file or directory) path to form a new path. -combine :: DirPath ar -> RelPath fd -> Path ar fd -combine = () - - --- | Remove last extension, and the \".\" preceding it. --- --- >> dropExtension x == fst (splitExtension x) -dropExtension :: FilePath ar -> FilePath ar -dropExtension = fst . splitExtension - --- | Drop all extensions --- --- >> not $ hasAnExtension (dropExtensions x) -dropExtensions :: FilePath ar -> FilePath ar -dropExtensions = fst . splitExtensions - --- | Synonym for 'takeDirectory' -dropFileName :: Path ar fd -> DirPath ar -dropFileName = fst . splitFileName - - --- | Set the extension of a file, overwriting one if already present. --- --- >> replaceExtension "file.txt" ".bob" == "file.bob" --- >> replaceExtension "file.txt" "bob" == "file.bob" --- >> replaceExtension "file" ".bob" == "file.bob" --- >> replaceExtension "file.txt" "" == "file" --- >> replaceExtension "file.fred.bob" "txt" == "file.fred.txt" -replaceExtension :: FilePath ar -> String -> FilePath ar -replaceExtension p ext = dropExtension p <.> ext - -replaceBaseName :: Path ar fd -> String -> Path ar fd -replaceBaseName p bn = takeDirectory p (asPath bn `genericAddExtension` genericTakeExtension p) - -replaceDirectory :: Path ar1 fd -> DirPath ar2 -> Path ar2 fd -replaceDirectory p d = d takeFileName p - -replaceFileName :: Path ar fd -> String -> Path ar fd -replaceFileName p fn = takeDirectory p asPath fn - - --- | Split on the extension. 'addExtension' is the inverse. --- --- >> uncurry (<.>) (splitExtension x) == x --- >> uncurry addExtension (splitExtension x) == x --- >> splitExtension "file.txt" == ("file",".txt") --- >> splitExtension "file" == ("file","") --- >> splitExtension "file/file.txt" == ("file/file",".txt") --- >> splitExtension "file.txt/boris" == ("file.txt/boris","") --- >> splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext") --- >> splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") -splitExtension :: FilePath ar -> (FilePath ar, String) -splitExtension = genericSplitExtension - --- | Split on all extensions --- --- >> splitExtensions "file.tar.gz" == ("file",".tar.gz") -splitExtensions :: FilePath ar -> (FilePath ar, String) -splitExtensions = genericSplitExtensions - -prop_split_combineExt :: AbsFile -> Property -prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p) - --- | Path must not be empty -splitFileName :: Path ar fd -> (DirPath ar, RelPath fd) -splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc]) -splitFileName PathRoot = error "splitFileName: empty path" - -prop_split_combine :: AbsFile -> Property -prop_split_combine p = property $ uncurry combine (splitFileName p) == p - - --- | Get the basename of a file --- --- >> takeBaseName "/tmp/somedir/myfile.txt" == "myfile" --- >> takeBaseName "./myfile.txt" == "myfile" --- >> takeBaseName "myfile.txt" == "myfile" -takeBaseName :: Path ar fd -> RelPath fd -takeBaseName = takeFileName . genericDropExtension - -takeDirectory :: Path ar fd -> DirPath ar -takeDirectory = fst . splitFileName - --- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. --- --- >> takeExtension x == snd (splitExtension x) --- >> takeExtension (addExtension x "ext") == ".ext" --- >> takeExtension (replaceExtension x "ext") == ".ext" -takeExtension :: FilePath ar -> String -takeExtension = snd . splitExtension - --- | Get all extensions --- --- >> takeExtensions "file.tar.gz" == ".tar.gz" -takeExtensions :: FilePath ar -> String -takeExtensions = snd . splitExtensions - --- | Get the filename component of a file path (ie stripping all parent dirs) --- --- >> takeFileName "/tmp/somedir/myfile.txt" == "myfile.txt" --- >> takeFileName "./myfile.txt" == "myfile.txt" --- >> takeFileName "myfile.txt" == "myfile.txt" -takeFileName :: Path ar fd -> RelPath fd -takeFileName PathRoot = PathRoot -- becomes a relative root -takeFileName (FileDir _ pc) = FileDir PathRoot pc - -prop_takeFileName_end :: AbsFile -> Property -prop_takeFileName_end p = property $ show (takeFileName p) `isSuffixOf` show p - - ------------------------------------------------------------------------- --- Auxillary Manipulation Functions - --- | Check whether two strings are equal as file paths. --- --- >> equalFilePath "/tmp/" "/tmp" == True --- >> equalFilePath "/tmp" "tmp" == False -equalFilePath :: String -> String -> Bool -equalFilePath s1 s2 = - isAbsoluteString s1 == isAbsoluteString s2 && asPath s1 == asPath s2 - --- | Constructs a 'Path' from a list of components. --- --- >> joinPath ["/tmp","someDir","file.txt"] == "/tmp/someDir/file.txt" --- >> joinPath ["/tmp","someDir","file.txt"] == asRelFile "tmp/someDir/file.txt" -joinPath :: [String] -> Path ar fd -joinPath = asPath . intercalate [pathSeparator] - --- | Currently just transforms: --- --- >> normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file" -normalise :: Path ar fd -> Path ar fd -normalise = - mkPathFromComponents . - filter (/= PathComponent currentDirComponent) . - pathComponents - --- | Deconstructs a path into its components. --- --- >> splitPath (asAbsDir "/tmp/someDir/mydir.dir") == (["tmp","someDir","mydir.dir"], Nothing) --- >> splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"], Just "myfile.txt") -splitPath :: FileDirClass fd => Path ar fd -> ([RelDir], Maybe RelFile) -splitPath PathRoot = ([],Nothing) -splitPath p@(FileDir d pc) = - first (map (FileDir PathRoot)) $ - fileDir - (\ _ -> (pathComponents d, Just (FileDir PathRoot pc))) - (\ _ -> (pathComponents p, Nothing)) - p - --- | This function can be used to construct a relative path by removing --- the supplied 'AbsDir' from the front. It is a runtime 'error' if the --- supplied 'AbsPath' doesn't start with the 'AbsDir'. --- --- >> makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == asRelFile "anotherdir/file.txt" --- >> makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == asRelDir "anotherdir/dir" -makeRelative :: AbsDir -> AbsPath fd -> RelPath fd -makeRelative relTo orig = - maybe (error msg) mkPathFromComponents $ - stripPrefix (pathComponents relTo) (pathComponents orig) - 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. --- --- >> makeAbsolute "/tmp" "file.txt" == asAbsFile "/tmp/file.txt" --- >> makeAbsolute "/tmp" "adir/file.txt" == asAbsFile "/tmp/adir/file.txt" --- >> makeAbsolute "/tmp" "adir/dir" == 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). --- --- >> genericMakeAbsolute "/tmp" (asRelFile "file.txt") == "/tmp/file.txt" --- >> genericMakeAbsolute "/tmp" (asRelFile "adir/file.txt") == "/tmp/adir/file.txt" --- >> genericMakeAbsolute "/tmp" (asAbsFile "adir/file.txt") == "/adir/file.txt" --- >> genericMakeAbsolute "/tmp" (asAbsFile "/adir/file.txt") == "/adir/file.txt" -genericMakeAbsolute :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath fd -genericMakeAbsolute base p = absRel id (base ) p - --- | As for 'makeAbsoluteFromCwd', but for use when the path may already be --- absolute (in which case it is left unchanged). -genericMakeAbsoluteFromCwd :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd) -genericMakeAbsoluteFromCwd p = do - cwdString <- SD.getCurrentDirectory -- we don't use System.Path.Directory impl here to avoid module cycle - return $ genericMakeAbsolute (asAbsDir cwdString) p - -prop_makeAbsoluteFromDir_endSame :: AbsDir -> RelFile -> Property -prop_makeAbsoluteFromDir_endSame base p = - property $ show p `isSuffixOf` show (makeAbsolute base p) - -prop_makeAbsoluteFromDir_startSame :: AbsDir -> RelFile -> Property -prop_makeAbsoluteFromDir_startSame base p = - property $ show base `isPrefixOf` show (makeAbsolute base p) - --- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir -> AbsFile -> Property --- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p) - - ------------------------------------------------------------------------- --- NYI - Not Yet Implemented - -{- -splitSearchPath :: String -> [String] -getSearchPath :: IO [String] -splitDrive :: String -> (String, String) -joinDrive :: String -> String -> String -takeDrive :: String -> String -hasDrive :: String -> Bool -dropDrive :: String -> String -isDrive :: String -> Bool -isValid :: String -> Bool -makeValid :: String -> String --} - - ------------------------------------------------------------------------- --- Path Predicates - --- | Test whether a @'Path' ar fd@ is absolute. --- --- >> isAbsolute (asAbsFile "fred") == True --- >> isAbsolute (asRelFile "fred") == False --- >> isAbsolute (asAbsFile "/fred") == True --- >> isAbsolute (asRelFile "/fred") == False -isAbsolute :: AbsRelClass ar => Path ar fd -> Bool -isAbsolute = absRel (const True) (const False) - --- | Test whether the 'String' would correspond to an absolute path --- if interpreted as a 'Path'. -isAbsoluteString :: String -> Bool -isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators' -isAbsoluteString (x:_) = isPathSeparator x -- Absolute if first char is a path separator - --- | Invariant - this should return True iff arg is of type @'Path' Rel _@ --- --- > isRelative = not . isAbsolute -isRelative :: AbsRelClass ar => Path ar fd -> Bool -isRelative = not . isAbsolute - --- | Test whether the 'String' would correspond to a relative path --- if interpreted as a 'Path'. --- --- > isRelativeString = not . isAbsoluteString -isRelativeString :: String -> Bool -isRelativeString = not . isAbsoluteString - - --- | Does the given filename have an extension? --- --- >> null (takeExtension x) == not (hasAnExtension x) -hasAnExtension :: FilePath ar -> Bool -hasAnExtension = not . null . snd . splitExtension - --- | Does the given filename have the given extension? --- --- >> hasExtension ".hs" "MyCode.hs" == True --- >> hasExtension ".hs" "MyCode.hs.bak" == False --- >> hasExtension ".hs" "MyCode.bak.hs" == True -hasExtension :: String -> FilePath ar -> Bool -hasExtension ext = (==ext) . snd . splitExtension - - ------------------------------------------------------------------------- --- Separators - --- | This is largely for 'System.FilePath' compatability -addTrailingPathSeparator :: String -> String -addTrailingPathSeparator = (++[pathSeparator]) - --- | This is largely for 'System.FilePath' compatability -dropTrailingPathSeparator :: String -> String -dropTrailingPathSeparator = init - --- | File extension character --- --- >> extSeparator == '.' -extSeparator :: Char -extSeparator = '.' - --- | This is largely for 'System.FilePath' compatability -hasTrailingPathSeparator :: String -> Bool -hasTrailingPathSeparator = isPathSeparator . last - --- | The character that separates directories. In the case where more than --- one character is possible, 'pathSeparator' is the \'ideal\' one. --- --- >> isPathSeparator pathSeparator -pathSeparator :: Char -pathSeparator | isWindows = '\\' - | otherwise = '/' - --- | The list of all possible separators. --- --- >> pathSeparator `elem` pathSeparators -pathSeparators :: [Char] -pathSeparators = return pathSeparator - --- | The character that is used to separate the entries in the $PATH environment variable. --- -searchPathSeparator :: Char -searchPathSeparator = ':' - --- | Is the character an extension character? --- --- >> isExtSeparator a == (a == extSeparator) -isExtSeparator :: Char -> Bool -isExtSeparator = (== extSeparator) - --- | Rather than using @(== 'pathSeparator')@, use this. Test if something --- is a path separator. --- --- >> isPathSeparator a == (a `elem` pathSeparators) -isPathSeparator :: Char -> Bool -isPathSeparator = flip elem pathSeparators - --- | Is the character a file separator? --- --- >> isSearchPathSeparator a == (a == searchPathSeparator) -isSearchPathSeparator :: Char -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - ------------------------------------------------------------------------- --- Generic Manipulation Functions - --- These functions support manipulation of extensions on directories --- as well as files. They have looser types than the corresponding --- 'Basic Manipulation Functions', but it is expected that the basic --- functions will be used more frequently as they provide more checks. - --- | This is a more flexible variant of 'addExtension' / '<.>' which can --- work with files or directories --- --- >> genericAddExtension "/" "x" == asAbsDir "/.x" --- >> genericAddExtension "/a" "x" == asAbsDir "/a.x" --- >> genericAddExtension "" "x" == asRelFile ".x" --- >> genericAddExtension "" "" == asRelFile "" -genericAddExtension :: Path ar fd -> String -> Path ar fd -genericAddExtension p "" = p -genericAddExtension path ext = - let suffix = - if [extSeparator] `isPrefixOf` ext - then ext - else extSeparator : ext - in case path of - FileDir p (PathComponent pc) -> - FileDir p (PathComponent (pc ++ suffix)) - PathRoot -> - FileDir PathRoot (PathComponent suffix) - -genericDropExtension :: Path ar fd -> Path ar fd -genericDropExtension = fst . genericSplitExtension - -genericDropExtensions :: Path ar fd -> Path ar fd -genericDropExtensions = fst . genericSplitExtensions - -genericSplitExtension :: Path ar fd -> (Path ar fd, String) -genericSplitExtension (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2) - where (s1,s2) = fixTrailingDot $ rbreak isExtSeparator s - fixTrailingDot ("",r2) = (r2,"") - fixTrailingDot (r1,r2) | [extSeparator] `isSuffixOf` r1 = (init r1, extSeparator:r2) - | otherwise = (r1,r2) - swap (x,y) = (y,x) - rbreak q = (reverse *** reverse) . swap . break q . reverse -genericSplitExtension p = (p,"") - -genericSplitExtensions :: Path ar fd -> (Path ar fd, String) -genericSplitExtensions (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2) - where (s1,s2) = break isExtSeparator s -genericSplitExtensions p = (p,"") - -genericTakeExtension :: Path ar fd -> String -genericTakeExtension = snd . genericSplitExtension - -genericTakeExtensions :: Path ar fd -> String -genericTakeExtensions = snd . genericSplitExtension - - ------------------------------------------------------------------------- --- QuickCheck - -_testall :: IO () -_testall = do - putStrLn "Running QuickCheck tests..." - quickCheck prop_asPath_getPathString - quickCheck prop_mkPathFromComponents_pathComponents - quickCheck prop_makeAbsoluteFromDir_endSame - quickCheck prop_makeAbsoluteFromDir_startSame - quickCheck prop_split_combine - quickCheck prop_takeFileName_end - quickCheck prop_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 :: Gen PathComponent -> Gen (Path ar fd) -qcGenPath qcLastComponent = do - pcs <- QC.listOf qcDirComponent - pc <- qcLastComponent - return $ mkPathFromComponents (pcs ++ [pc]) - -qcFilePath :: Gen (FilePath ar) -qcFilePath = qcGenPath qcFileComponent - -qcDirPath :: Gen (DirPath ar) -qcDirPath = qcGenPath qcDirComponent - -newtype PathGen ar fd = PathGen {runPathGen :: Gen (Path ar fd)} - -qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd) -qcPath = runPathGen $ switchFileDir (PathGen qcFilePath) (PathGen qcDirPath) - -instance (AbsRelClass ar, FileDirClass fd) => Arbitrary (Path ar fd) where +module System.Path.Internal +( + -- * The main filepath (& dirpath) abstract type + Path, -- kept abstract + + -- * Type Synonyms + AbsFile, + RelFile, + AbsDir, + RelDir, + AbsRelFile, + AbsRelDir, + AbsFileDir, + RelFileDir, + AbsRelFileDir, + + AbsPath, Abs, + RelPath, Rel, + FilePath, File, + DirPath, Dir, + AbsRelPath, AbsRel, + FileDirPath, FileDir, + + -- * Decisions on path types + withAbsRel, withFileDir, + + -- * Path to String conversion + toString, + getPathString, + + -- * Constants + rootDir, + currentDir, + emptyFile, + + -- * Parsing Functions + maybePath, maybe, + parsePath, parse, + + -- * Checked Construction Functions + path, + relFile, + relDir, + absFile, + absDir, + relPath, rel, + absPath, abs, + filePath, file, + dirPath, dir, + absRel, fileDir, + + idAbsRel, idAbs, idRel, + idFileDir, 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, + splitDirName, + takeBaseName, + takeDirectory, + takeSuperDirectory, + takeExtension, + takeExtensions, + takeFileName, + takeDirName, + mapFileName, + mapFileNameF, + + -- * Auxillary Manipulation Functions + equalFilePath, + joinPath, + normalise, + splitPath, + makeRelative, + makeRelativeMaybe, + makeAbsolute, + makeAbsoluteFromCwd, + dynamicMakeAbsolute, + dynamicMakeAbsoluteFromCwd, + genericMakeAbsolute, + genericMakeAbsoluteFromCwd, + pathMap, + dirFromFile, + fileFromDir, + toFileDir, + fromFileDir, + fileFromFileDir, + dirFromFileDir, + toAbsRel, + fromAbsRel, + + -- * 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.Path.Internal.PartClass as Class +import qualified System.Path.Internal.Part as Part +import qualified System.Path.Internal.Component as PC +import qualified System.Path.Internal.Separator as Sep +import System.Path.Internal.PartClass as Class + (WrapFileDir(WrapFileDir), WrapAbsRel(WrapAbsRel), FuncArg(..), fdMap) +import System.Path.Internal.Part (absPC) +import System.Path.Internal.System (System(..)) +import System.Path.Internal.Component + (Component(Component), GenComponent) + +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, 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, mconcat), Endo(Endo), appEndo) +import Data.Semigroup (Semigroup(sconcat, (<>)), ) +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.DocTest.Driver as DocTest +import qualified Test.QuickCheck as QC +import Test.QuickCheck + (Gen, Property, property, Arbitrary(arbitrary), frequency) + +import qualified Prelude as P +import Prelude hiding (FilePath, maybe, abs) + + +{- $setup +>>> :set -fno-warn-warnings-deprecations +>>> import qualified System.Path.PartClass as Class +>>> import qualified System.Path.Generic as Path +>>> import qualified System.Path.Posix as Posix +>>> import qualified System.Path.Windows as Windows +>>> import System.Path.Generic ((), (<.>), relFile, relDir, absFile, absDir) +>>> import Data.List (isSuffixOf, isPrefixOf) +>>> import Data.Char (toLower) +>>> import qualified Test.QuickCheck as QC +>>> forAllAbsRel :: (Class.FileDir fd, QC.Testable prop) => (Default.AbsRel fd -> prop) -> QC.Property +>>> forAllAbsRel = QC.forAll QC.arbitrary +-} + + +------------------------------------------------------------------------ +-- Types + +-- | This is the main filepath abstract datatype +data Path os ar fd = Path ar [Component os] fd + +instance + (System os, Class.AbsRel ar, Class.FileDir fd) => + Eq (Path os ar fd) where + (==) = equating inspectPath + +instance + (System os, Class.AbsRel ar, Class.FileDir fd) => + Ord (Path os ar fd) where + compare = comparing inspectPath + +inspectPath :: + Path os ar fd -> (WrapAbsRel os ar, [Component os], WrapFileDir os fd) +inspectPath (Path ar pcs fd) = (WrapAbsRel ar, pcs, WrapFileDir fd) + + +selTag :: Path os ar fd -> Tagged os a -> a +selTag _ = untag + + +type AbsFile os = Path os Part.Abs Part.File +type RelFile os = Path os Part.Rel Part.File +type AbsDir os = Path os Part.Abs Part.Dir +type RelDir os = Path os Part.Rel Part.Dir +type AbsRelFile os = Path os Part.AbsRel Part.File +type AbsRelDir os = Path os Part.AbsRel Part.Dir +type AbsFileDir os = Path os Part.Abs Part.FileDir +type RelFileDir os = Path os Part.Rel Part.FileDir +type AbsRelFileDir os = Path os Part.AbsRel Part.FileDir + +type Abs os fd = Path os Part.Abs fd +type Rel os fd = Path os Part.Rel fd +type File os ar = Path os ar Part.File +type Dir os ar = Path os ar Part.Dir +type AbsRel os fd = Path os Part.AbsRel fd +type FileDir os ar = Path os ar Part.FileDir + +{-# DEPRECATED RelPath "Use Path.Rel instead." #-} +{-# DEPRECATED AbsPath "Use Path.Abs instead." #-} +{-# DEPRECATED AbsRelPath "Use Path.AbsRel instead." #-} +{-# DEPRECATED FilePath "Use Path.File instead." #-} +{-# DEPRECATED DirPath "Use Path.Dir instead." #-} +{-# DEPRECATED FileDirPath "Use Path.FileDir instead." #-} + +type AbsPath os fd = Path os Part.Abs fd +type RelPath os fd = Path os Part.Rel fd +type FilePath os ar = Path os ar Part.File +type DirPath os ar = Path os ar Part.Dir +type AbsRelPath os fd = Path os Part.AbsRel fd +type FileDirPath os ar = Path os ar Part.FileDir + +instance (Class.AbsRel ar, Class.FileDir fd) => NFData (Path os ar fd) where + rnf (Path ar pcs fd) = + rnf (Class.withAbsRel rnf () ar, pcs, Class.withFileDir rnf () () fd) + +-- 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. +-- +-- prop> Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets" +pathMap :: + (Class.FileDir fd) => (String -> String) -> Path os ar fd -> Path os ar fd +pathMap f (Path ar pcs fd) = Path ar (map (PC.map f) pcs) (fdMap f fd) + + +mapFilePart :: + (GenComponent -> GenComponent) -> FilePath os ar -> FilePath os ar +mapFilePart f (Path ar pcs (Part.File fd)) = Path ar pcs $ Part.File $ f fd + +mapFilePartF :: + (Functor f) => + (GenComponent -> f GenComponent) -> FilePath os ar -> f (FilePath os ar) +mapFilePartF f (Path ar pcs (Part.File fd)) = + Path ar pcs <$> Part.File <$> f fd + +splitFilePart :: + (GenComponent -> (GenComponent, a)) -> FilePath os ar -> (FilePath os ar, a) +splitFilePart f (Path ar pcs (Part.File fd)) = mapFst (Path ar pcs . Part.File) $ f fd + +mapPathDirs :: + ([Component os] -> [Component os]) -> Path os ar fd -> Path os ar fd +mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd + + +withAbsRel :: + (Class.AbsRel ar) => + (AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a +withAbsRel fAbs fRel (Path ar pcs fd) = + Class.withAbsRel + (\drive -> fAbs $ Path (Part.Abs (Component drive)) pcs fd) + (fRel $ Path Part.Rel pcs fd) + ar + +switchFileDir :: + (Class.FileDir fd) => + f (FilePath os ar) -> f (DirPath os ar) -> f (FileDirPath os ar) -> + f (Path os ar fd) +switchFileDir f d fd = + getCompose $ Class.switchFileDir (Compose f) (Compose d) (Compose fd) + +switchFileOrDir :: + (Class.FileOrDir fd) => + f (FilePath os ar) -> f (DirPath os ar) -> f (Path os ar fd) +switchFileOrDir f d = + getCompose $ Class.switchFileOrDir (Compose f) (Compose d) + +withFileDir :: + (Class.FileOrDir fd) => + (FilePath os ar -> a) -> (DirPath os ar -> a) -> Path os ar fd -> a +withFileDir f g = runFuncArg $ switchFileOrDir (FuncArg f) (FuncArg g) + + +-- | Currently not exported +eitherFromAbsRel :: + Class.AbsRel ar => Path os ar fd -> Either (AbsPath os fd) (RelPath os fd) +eitherFromAbsRel = withAbsRel Left Right + +-- | Currently not exported +_eitherFromFileDir :: + Class.FileOrDir fd => Path os ar fd -> Either (FilePath os ar) (DirPath os ar) +_eitherFromFileDir = withFileDir 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 :: FileDirPath ar@. +Otherwise handling of all cases of 'Part.File', 'Part.Dir' and 'Part.FileDir' types +becomes pretty complicated. + +>>> Posix.rootDir relDir "bla" relFile "blub" +rootDir relPath "bla" relPath "blub" +>>> Just (Posix.rootDir relDir "bla" relFile "blub") +Just (rootDir relPath "bla" relPath "blub") +>>> Posix.currentDir relDir "bla" relFile "blub" +currentDir relPath "bla" relPath "blub" +>>> Just (Posix.currentDir relDir "bla" relFile "blub") +Just (currentDir relPath "bla" relPath "blub") +>>> Windows.absDir "c:" relDir "bla" relFile "blub" +absDir "c:" relPath "bla" relPath "blub" +>>> Just (Windows.absDir "c:\\" relDir "bla" relFile "blub") +Just (absDir "c:\\" relPath "bla" relPath "blub") +-} +instance + (System os, Class.AbsRel ar, Class.FileDir fd) => + Show (Path os ar fd) where + showsPrec = untag showsPrecTagged + +showsPrecTagged :: + (System os, Class.AbsRel ar, Class.FileDir 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 ' ') $ + Class.withAbsRel + (\drive -> + if drive == root + then showString rootName + else showsCons absDirName drive) + (showString currentName) + ar : + map (\(Component pc) -> showsCons relPathName pc) pcs + +showsCons :: Show a => String -> a -> ShowS +showsCons name arg = showString name . showChar ' ' . showsPrec 11 arg + +{- | +Currently it also parses Part.AbsRel and Part.FileDir paths, +although these cannot be composed with the accepted combinators. +-} +-- prop> read "rootDir" == Posix.rootDir +-- prop> read "rootDir" == Windows.rootDir +-- prop> read "currentDir" == Posix.currentDir +-- prop> read "currentDir" == Windows.currentDir +-- prop> let path = Posix.rootDir relDir "bla" relFile "blub" in read (show path) == path +-- prop> let path = Just (Posix.rootDir relDir "bla" relFile "blub") in read (show path) == path +-- prop> let path = Posix.currentDir relDir "bla" relFile "blub" in read (show path) == path +-- prop> let path = Just (Posix.currentDir relDir "bla" relFile "blub") in read (show path) == path +-- prop> let path = Windows.rootDir relDir "bla" relFile "blub" in read (show path) == path +-- prop> let path = Just (Windows.rootDir relDir "bla" relFile "blub") in read (show path) == path +-- prop> let path = Windows.absDir "c:" relDir "bla" relFile "blub" in read (show path) == path +instance + (System os, Class.AbsRel ar, Class.FileDir fd) => + Read (Path os ar fd) where + readsPrec d = readParen (d>5) $ untag readsPrecTagged + +readsPrecTagged :: + (System os, Class.AbsRel ar, Class.FileDir fd) => + Tagged os (ReadS (Path os ar fd)) +readsPrecTagged = + flip fmap readsSplitDrive $ \readsSplDrv -> + let go = + handleMismatch + (skipSpaces >> matchString combineOperator) + (return []) + (liftM2 (:) (fmap Component $ 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 $ P.maybe mzero (return . (,) ()) . stripPrefix prefix + +readsSplitDrive :: + (System os, Class.AbsRel ar) => Tagged os (MS.StateT String [] ar) +readsSplitDrive = + flip fmap readsSplitDriveAbs $ \readsSplDrvAbs -> + Class.switchAbsRel + readsSplDrvAbs + readsSplitDriveRel + (mplus + (fmap (\(Part.Abs drive) -> Part.AbsO drive) readsSplDrvAbs) + (fmap (\Part.Rel -> Part.RelO) readsSplitDriveRel)) + +readsSplitDriveAbs :: (System os) => Tagged os (MS.StateT String [] Part.Abs) +readsSplitDriveAbs = + flip fmap rootStringTagged $ \root -> + fmap absPC $ + (root <$ matchString rootName) + `mplus` + readsCons absDirName + +readsSplitDriveRel :: (MonadPlus m) => MS.StateT String m Part.Rel +readsSplitDriveRel = matchString currentName >> return Part.Rel + + +-- | Convert the 'Path' into a plain 'String' as required for OS calls. +-- +-- prop> \p -> Path.asPath (Path.toString p) == (p::Default.AbsFile) +toString :: + (System os, Class.AbsRel ar, Class.FileDir fd) => Path os ar fd -> String +toString = flip toStringS "" + +{-# DEPRECATED getPathString "Use Path.toString instead." #-} + +-- | Synonym of 'toString' intended for unqualified use. +getPathString :: + (System os, Class.AbsRel ar, Class.FileDir fd) => Path os ar fd -> String +getPathString = toString + +toStringS :: + (System os, Class.AbsRel ar, Class.FileDir fd) => Path os ar fd -> ShowS +toStringS x = + case pathComponents x of + (ar, []) -> + Class.withAbsRel showString (showString currentDirComponent) ar + (ar, pcs) -> + concatS $ + Class.withAbsRel (\drive -> (showString drive :)) id ar $ + intersperse (showChar (selTag x pathSeparator)) $ + map (\(Component pc) -> showString pc) pcs + + +------------------------------------------------------------------------ +-- Constants + +-- prop> Posix.toString Path.rootDir == "/" +-- prop> 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) [] Part.Dir) rootStringTagged + +rootStringTagged :: (System os) => Tagged os String +rootStringTagged = fmap (\sep -> [sep]) pathSeparator + +-- prop> Posix.toString Path.currentDir == "." +-- prop> Windows.toString Path.currentDir == "." +currentDir :: (System os) => RelDir os +currentDir = mempty + +{- | +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 = atomicFile $ Part.File PC.empty + +atomicFile :: Part.File -> RelFile os +atomicFile = Path Part.Rel [] + +rootName :: String +rootName = "rootDir" + +currentName :: String +currentName = "currentDir" + +currentDirComponent :: String +currentDirComponent = "." + +absDirName :: String +absDirName = "absDir" + +relPathName :: String +relPathName = "relPath" + + +------------------------------------------------------------------------ +-- Parsing Functions + +{-# DEPRECATED maybePath "Use Path.maybe instead." #-} +{-# DEPRECATED parsePath "Use Path.parse instead." #-} + +-- | This function is intended for checking and parsing paths +-- provided as user input. +-- +-- prop> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" +-- prop> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" +-- prop> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" +-- prop> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" +-- prop> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing +-- prop> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" +-- prop> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" +-- prop> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" +-- prop> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing +-- prop> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" +-- prop> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" +-- prop> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" +-- prop> fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" +-- prop> fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" +-- prop> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" +-- prop> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing +-- prop> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing +-- prop> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing +-- prop> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing +maybe, maybePath :: + (System os, Class.AbsRel ar, Class.FileDir fd) => + String -> Maybe (Path os ar fd) +maybe str = do + let (ar0, pcs0, fd0) = untag makePathComponents str + ar <- Class.fromAbsRel ar0 + (pcs, fd) <- + case fd0 of + Left Part.FileDir -> arrangeComponents pcs0 + Right Part.Dir -> + fmap ((,) pcs0) $ + Class.switchFileDir Nothing (Just Part.Dir) (Just Part.FileDir) + return $ Path ar pcs fd + +maybePath = maybe + +parse, parsePath :: + (System os, Class.AbsRel ar, Class.FileDir fd) => + String -> Either String (Path os ar fd) +parse = pathWithNames arName fdName +parsePath = parse + +pathWithNames :: + (System os, Class.AbsRel ar, Class.FileDir fd) => + Const String ar -> Const String fd -> + String -> Either String (Path os ar fd) +pathWithNames (Const ar) (Const fd) str = + P.maybe (Left (printf "\"%s\" is not a valid %s%spath" str ar fd)) Right $ + maybePath str + +arName :: (Class.AbsRel ar) => Const String ar +arName = Class.switchAbsRel (Const "absolute ") (Const "relative ") (Const "") + +fdName :: (Class.FileDir fd) => Const String fd +fdName = Class.switchFileDir (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, Class.AbsRel ar, Class.FileDir fd) => + String -> Path os ar fd +path = either error id . parsePath + +-- | Construct a 'RelFile' from a 'String'. +-- +-- prop> Posix.toString (Posix.relFile "file.txt") == "file.txt" +-- prop> Posix.toString (Posix.relFile "tmp") == "tmp" +relFile :: (System os) => String -> RelFile os +relFile = path + +-- | Construct a 'RelDir' from a 'String'. +-- +-- prop> Posix.toString (Posix.relDir ".") == "." +-- prop> Posix.toString (Posix.relDir "file.txt") == "file.txt" +-- prop> Posix.toString (Posix.relDir "tmp") == "tmp" +relDir :: (System os) => String -> RelDir os +relDir = path + +-- | Construct an 'AbsFile' from a 'String'. +-- +-- prop> Posix.toString (Posix.absFile "/file.txt") == "/file.txt" +-- prop> Posix.toString (Posix.absFile "/tmp") == "/tmp" +absFile :: (System os) => String -> AbsFile os +absFile = path + +-- | Construct an 'AbsDir' from a 'String'. +-- +-- prop> Posix.toString (Posix.absDir "/file.txt") == "/file.txt" +-- prop> Posix.toString (Posix.absDir "/tmp") == "/tmp" +absDir :: (System os) => String -> AbsDir os +absDir = path + +-- | Construct a 'Rel fd' from a 'String'. +rel :: (System os, Class.FileDir fd) => String -> Rel os fd +rel = path + +-- | Construct an 'Abs fd' from a 'String'. +abs :: (System os, Class.FileDir fd) => String -> Abs os fd +abs = path + +-- | Construct an 'AbsRel fd' from a 'String'. +absRel :: (System os, Class.FileDir fd) => String -> AbsRel os fd +absRel = path + +-- | Construct a 'File ar' from a 'String'. +file :: (System os, Class.AbsRel ar) => String -> File os ar +file = path + +-- | Construct a 'Dir ar' from a 'String'. +dir :: (System os, Class.AbsRel ar) => String -> Dir os ar +dir = path + +-- | Construct a 'FileDir ar' from a 'String'. +fileDir :: (System os, Class.AbsRel ar) => String -> FileDir os ar +fileDir = path + + +{-# DEPRECATED relPath "Use Path.rel instead." #-} +{-# DEPRECATED absPath "Use Path.abs instead." #-} +{-# DEPRECATED filePath "Use Path.file instead." #-} +{-# DEPRECATED dirPath "Use Path.dir instead." #-} + +-- | Construct a 'RelPath fd' from a 'String'. +relPath :: (System os, Class.FileDir fd) => String -> RelPath os fd +relPath = path + +-- | Construct an 'AbsPath fd' from a 'String'. +absPath :: (System os, Class.FileDir fd) => String -> AbsPath os fd +absPath = path + +-- | Construct a 'FilePath ar' from a 'String'. +filePath :: (System os, Class.AbsRel ar) => String -> FilePath os ar +filePath = path + +-- | Construct a 'DirPath ar' from a 'String'. +dirPath :: (System os, Class.AbsRel ar) => String -> DirPath os ar +dirPath = path + + + +idAbsRel :: AbsRelPath os fd -> AbsRelPath os fd +idAbsRel = id + +idAbs :: AbsPath os fd -> AbsPath os fd +idAbs = id + +idRel :: RelPath os fd -> RelPath os fd +idRel = id + + +idFileDir :: FileDirPath os fd -> FileDirPath os fd +idFileDir = 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'. +-- +-- prop> Posix.asPath "/tmp" == Posix.absDir "/tmp" +-- prop> Posix.asPath "file.txt" == Posix.relFile "file.txt" +-- prop> Path.isAbsolute (Posix.asAbsDir "/tmp") +-- prop> Path.isRelative (Posix.asRelDir "/tmp") +-- prop> Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" +-- prop> Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" +-- prop> Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" +-- prop> Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" +-- prop> Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp" +-- prop> Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp" +asPath :: + (System os, Class.AbsRel ar, Class.FileDir fd) => String -> Path os ar fd +asPath = uncurry mkPathFromComponents . untag mkPathComponents + + +-- | Use a 'String' as a 'RelFile'. No checking is done. +-- +-- prop> Posix.toString (Posix.asRelFile "file.txt") == "file.txt" +-- prop> Posix.toString (Posix.asRelFile "/file.txt") == "file.txt" +-- prop> Posix.toString (Posix.asRelFile "tmp") == "tmp" +-- prop> Posix.toString (Posix.asRelFile "/tmp") == "tmp" +asRelFile :: (System os) => String -> RelFile os +asRelFile = asPath + +-- | Use a 'String' as a 'RelDir'. No checking is done. +-- +-- prop> Posix.toString (Posix.asRelDir ".") == "." +-- prop> Posix.toString (Posix.asRelDir "file.txt") == "file.txt" +-- prop> Posix.toString (Posix.asRelDir "/file.txt") == "file.txt" +-- prop> Posix.toString (Posix.asRelDir "tmp") == "tmp" +-- prop> Posix.toString (Posix.asRelDir "/tmp") == "tmp" +asRelDir :: (System os) => String -> RelDir os +asRelDir = asPath + +-- | Use a 'String' as an 'AbsFile'. No checking is done. +-- +-- prop> Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt" +-- prop> Posix.toString (Posix.asAbsFile "/tmp") == "/tmp" +asAbsFile :: (System os) => String -> AbsFile os +asAbsFile = asPath + +-- | Use a 'String' as an 'AbsDir'. No checking is done. +-- +-- prop> Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt" +-- prop> 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, Class.FileDir fd) => String -> RelPath os fd +asRelPath = asPath + +-- | Use a 'String' as an 'AbsPath fd'. No checking is done. +asAbsPath :: (System os, Class.FileDir fd) => String -> AbsPath os fd +asAbsPath = asPath + +-- | Use a 'String' as a 'FilePath ar'. No checking is done. +asFilePath :: (System os, Class.AbsRel ar) => String -> FilePath os ar +asFilePath = asPath + +-- | Use a 'String' as a 'DirPath ar'. No checking is done. +asDirPath :: (System os, Class.AbsRel 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 Class.AbsRel ar => ForbiddenAbsRel ar where +class Class.FileDir fd => ForbiddenFileDir fd where + +------------------------------------------------------------------------ +-- Checked Construction Functions + +{-# DEPRECATED mkPathAbsOrRel "Use Path.absRel instead." #-} + +-- | Examines the supplied string and constructs an absolute or +-- relative path as appropriate. +-- +-- prop> Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp") +-- prop> Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp") +-- prop> Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp") +-- prop> Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp") +-- prop> Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp") +-- prop> Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp") +mkPathAbsOrRel, mkPathAbsOrRelPriv :: + (System os, Class.FileDir fd) => + String -> Either (AbsPath os fd) (RelPath os fd) +mkPathAbsOrRel = mkPathAbsOrRelPriv +mkPathAbsOrRelPriv = eitherFromAbsRel . absRel + +{-# DEPRECATED mkPathFileOrDir "Don't let the path type depend on current file system content. Instead choose the path type according to the needed disk object type." #-} + +-- | Searches for a file or directory with the supplied path string +-- and returns a 'Part.File' or 'Part.Dir' path as appropriate. If neither exists +-- at the supplied path, 'Nothing' is returned. +mkPathFileOrDir :: + (System os, Class.AbsRel 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 $ path s + (False, True ) -> return $ Just $ Right $ path s + (True, True ) -> ioError $ userError "mkPathFileOrDir - object type changed while checking" + +{-# DEPRECATED mkAbsPath "Use Path.dynamicMakeAbsolute instead." #-} + +-- | Convert a 'String' into an 'AbsPath' by interpreting it as +-- relative to the supplied directory if necessary. +-- +-- prop> Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt" +-- prop> Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt" +mkAbsPath :: + (System os, Class.FileDir fd) => AbsDir os -> String -> AbsPath os fd +mkAbsPath d = either id (makeAbsolute d) . mkPathAbsOrRelPriv + +{-# DEPRECATED mkAbsPathFromCwd "Use Path.dynamicMakeAbsoluteFromCwd instead." #-} + +-- | Convert a 'String' into an 'AbsPath' by interpreting it as +-- relative to the cwd if necessary. +mkAbsPathFromCwd :: + (System os, Class.FileDir fd) => String -> IO (AbsPath os fd) +mkAbsPathFromCwd = either return makeAbsoluteFromCwd . mkPathAbsOrRelPriv + + +------------------------------------------------------------------------ +-- Internal Functions for GenComponent manipulation + +mkPathFromComponents :: + (Class.FileDir fd) => ar -> [Component os] -> Path os ar fd +mkPathFromComponents ar pcs = + uncurry (Path ar) $ + Class.switchFileDir + (mapSnd Part.File $ + ListHT.switchR ([], PC.empty) (curry $ mapSnd PC.untag) pcs) + (pcs, Part.Dir) + (pcs, Part.FileDir) + +maybePathFromComponents :: + (Class.FileDir fd) => ar -> [Component os] -> Maybe (Path os ar fd) +maybePathFromComponents ar pcs = + fmap (uncurry $ Path ar) $ arrangeComponents pcs + +arrangeComponents :: + (Class.FileDir fd) => [Component os] -> Maybe ([Component os], fd) +arrangeComponents pcs = + getCompose $ + Class.switchFileDir + (Compose $ fmap (mapSnd (Part.File . PC.untag)) $ ListHT.viewR pcs) + (Compose $ Just (pcs, Part.Dir)) + (Compose $ Just (pcs, Part.FileDir)) + +mkPathComponents :: + (System os, Class.AbsRel ar) => + Tagged os (String -> (ar, [Component 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 -> + (Part.AbsRel, [Component os], Either Part.FileDir Part.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 Part.Dir) + Just (pcs, pc) -> + if null pc -- caused by trailing slash + then (pcs, Right Part.Dir) + else (pct, Left Part.FileDir) + in (ar, nonEmptyComponents pcs1, fd)) + isPathSeparator splitAbsoluteO + +nonEmptyComponents :: [String] -> [Component os] +nonEmptyComponents = map Component . filter (not . null) + +splitDriveOS :: + (System os, Class.AbsRel ar) => Tagged os (MS.State String ar) +splitDriveOS = + liftA2 + (\splDrive splAbsolute -> + Class.switchAbsRel (fmap absPC splDrive) (return Part.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 Part.AbsRel) +splitAbsoluteO = + fmap (\drive -> if null drive then Part.RelO else Part.AbsO $ Component drive) + <$> + splitAbsolute + +-- | > \p -> uncurry Path.mkPathFromComponents (Path.pathComponents p) == (p::Default.AbsDir) +pathComponents :: + (Class.FileDir fd) => Path os ar fd -> (ar, [Component os]) +pathComponents (Path ar pcs fd) = + (ar, pcs ++ Class.withFileDir ((:[]) . PC.retag) [] [] 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 (Class.Rel ar, Class.Dir fd) => Semigroup (Path os ar fd) where + Path r pcs0 _dir <> Path _rel pcs1 d = Path r (pcs0 ++ pcs1) d + sconcat paths = + Path Class.relVar + (sconcat $ fmap (\(Path _rel pcs _dir) -> pcs) paths) Class.dirVar + +instance (Class.Rel ar, Class.Dir fd) => Monoid (Path os ar fd) where + mempty = Path Class.relVar [] Class.dirVar + mconcat paths = + Path Class.relVar + (concatMap (\(Path _rel pcs _dir) -> pcs) paths) Class.dirVar + + +-- | Infix variant of 'combine'. +-- +-- prop> Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt" +-- prop> Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt" +-- prop> Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt" +-- prop> Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt" +-- prop> Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" +-- prop> Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" +-- prop> Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" +-- prop> Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" +-- prop> 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 Part.Dir Path Part.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 PC.addExtension 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\"@. +-- +-- prop> Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib" +-- prop> Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib" +-- prop> Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib" +-- prop> Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib" +-- prop> Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib" +-- prop> 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. +-- +-- prop> \p -> Path.combine Path.currentDir p == (p::Default.RelDir) +combine :: DirPath os ar -> RelPath os fd -> Path os ar fd +combine = () + + +-- | Remove last extension, and the \".\" preceding it. +-- +-- prop> forAllAbsRel $ \x -> Path.dropExtension x == fst (Path.splitExtension x) +dropExtension :: FilePath os ar -> FilePath os ar +dropExtension = fst . splitExtension + +-- | Drop all extensions +-- +-- prop> forAllAbsRel $ \x -> 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. +-- +-- prop> Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob" +-- prop> Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob" +-- prop> Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob" +-- prop> Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file" +-- prop> 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 (PC.addExtension (Component bn) . snd . PC.splitExtension) 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 (Component fn)) p + + +-- | Split on the extension. 'addExtension' is the inverse. +-- +-- prop> forAllAbsRel $ \x -> uncurry (<.>) (Path.splitExtension x) == x +-- prop> forAllAbsRel $ \x -> uncurry Path.addExtension (Path.splitExtension x) == x +-- prop> Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt") +-- prop> Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc") +-- prop> Path.splitExtension (relFile "file") == (Posix.relFile "file","") +-- prop> Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt") +-- prop> Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","") +-- prop> Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext") +-- prop> 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 PC.splitExtension + +-- | Split on all extensions +-- +-- prop> Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz") +-- prop> \p -> uncurry (<.>) (Path.splitExtension p) == (p::Default.AbsFile) +splitExtensions :: FilePath os ar -> (FilePath os ar, String) +splitExtensions = splitFilePart PC.splitExtensions + +-- | prop> \p -> uncurry Path.combine (Path.splitFileName p) == (p::Default.AbsFile) +splitFileName :: FilePath os ar -> (DirPath os ar, RelFile os) +splitFileName (Path ar pcs fd) = (Path ar pcs Part.Dir, atomicFile fd) + +-- | > \p -> (uncurry Path.combine <$> Path.splitDirName p) == toMaybe (not $ Default.isDrive p) (p::Default.AbsDir) +splitDirName :: DirPath os ar -> Maybe (DirPath os ar, RelDir os) +splitDirName = fmap (mapSnd dirFromFile . splitFileName) . fileFromDir + +prop_splitDir_combine :: (System os) => AbsDir os -> Property +prop_splitDir_combine p = + property $ + (uncurry combine <$> splitDirName p) == toMaybe (not $ isDrive p) p + + +-- | Get the basename of a file +-- +-- prop> Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile" +-- prop> Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile" +-- prop> 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 + +-- prop> Path.takeSuperDirectory (Posix.absDir "/tmp/somedir") == Just (absDir "/tmp") +-- prop> Path.takeSuperDirectory (Posix.absDir "/tmp/") == Just (absDir "/") +-- prop> Path.takeSuperDirectory (Posix.absDir "/") == Nothing +-- prop> Path.takeSuperDirectory (Posix.relDir "tmp/somedir") == Just (relDir "tmp") +-- prop> Path.takeSuperDirectory (Posix.relDir "./somedir") == Just (relDir ".") +-- prop> Path.takeSuperDirectory (Posix.relDir "somedir") == Just Path.currentDir +-- prop> Path.takeSuperDirectory (Posix.relDir "") == Nothing +takeSuperDirectory :: DirPath os ar -> Maybe (DirPath os ar) +takeSuperDirectory = fmap takeDirectory . fileFromDir + +-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. +-- +-- prop> forAllAbsRel $ \x -> Path.takeExtension x == snd (Path.splitExtension x) +-- prop> forAllAbsRel $ \x -> Path.takeExtension (Path.addExtension x "ext") == ".ext" +-- prop> forAllAbsRel $ \x -> Path.takeExtension (Path.replaceExtension x "ext") == ".ext" +takeExtension :: FilePath os ar -> String +takeExtension = snd . splitExtension + +-- | Get all extensions +-- +-- prop> 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) +-- +-- prop> Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt" +-- prop> Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt" +-- prop> Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt" +-- prop> \p -> Path.toString (Path.takeFileName p) `isSuffixOf` Path.toString (p::Default.AbsFile) +takeFileName :: FilePath os ar -> RelFile os +takeFileName (Path _ _ fd) = atomicFile fd + +-- | > \p -> fmap (\d -> toString d `isSuffixOf` toString p) (takeDirName p) == toMaybe (not $ isDrive p) True +takeDirName :: DirPath os ar -> Maybe (RelDir os) +takeDirName = fmap snd . splitDirName + +prop_takeDirName_end :: (System os) => AbsDir os -> Property +prop_takeDirName_end p = + property $ + fmap (\d -> toString d `isSuffixOf` toString p) (takeDirName p) + == + toMaybe (not $ isDrive p) True + +mapFileName :: (String -> String) -> FilePath os ar -> FilePath os ar +mapFileName = mapFilePart . PC.map + +mapFileNameF :: + (Functor f) => + (String -> f String) -> FilePath os ar -> f (FilePath os ar) +mapFileNameF = mapFilePartF . PC.mapF + + +------------------------------------------------------------------------ +-- Auxillary Manipulation Functions + +-- | Check whether two strings are equal as file paths. +-- +-- prop> Posix.equalFilePath "abc/def" "abc/def" +-- prop> Posix.equalFilePath "abc/def" "abc//def" +-- prop> Posix.equalFilePath "/tmp/" "/tmp" +-- prop> Posix.equalFilePath "/tmp" "//tmp" +-- prop> Posix.equalFilePath "/tmp" "///tmp" +-- prop> not $ Posix.equalFilePath "abc" "def" +-- prop> not $ Posix.equalFilePath "/tmp" "tmp" +-- prop> Windows.equalFilePath "abc\\def" "abc\\def" +-- prop> Windows.equalFilePath "abc\\def" "abc\\\\def" +-- prop> Windows.equalFilePath "file" "File" +-- prop> Windows.equalFilePath "\\file" "\\\\file" +-- prop> Windows.equalFilePath "\\file" "\\\\\\file" +-- prop> not $ Windows.equalFilePath "abc" "def" +-- prop> not $ Windows.equalFilePath "file" "dir" +equalFilePath :: (System os) => Tagged os (String -> String -> Bool) +equalFilePath = equating <$> mkPathAbsOrRelTagged + +mkPathAbsOrRelTagged :: + (System os) => + Tagged os (String -> Either (AbsFileDir os) (RelFileDir os)) +mkPathAbsOrRelTagged = Tagged mkPathAbsOrRelPriv + +-- | 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. +-- +-- prop> Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir" +-- prop> Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt" +joinPath :: (Class.FileDir fd) => [String] -> RelPath os fd +joinPath = mkPathFromComponents Part.Rel . map Component + +-- | Currently just transforms: +-- +-- prop> 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 (Component currentDirComponent /=)) + +-- | Deconstructs a path into its components. +-- +-- prop> Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing) +-- prop> Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt") +splitPath :: + (Class.AbsRel ar, Class.FileOrDir fd) => + Path os ar fd -> (Bool, [RelDir os], Maybe (RelFile os)) +splitPath (Path ar pcs fd) = + (Class.isAbsolute ar, + map (\pc -> Path Part.Rel [pc] Part.Dir) pcs, + maybeFileDir fd) + +maybeFileDir :: (Class.FileOrDir fd) => fd -> Maybe (RelFile os) +maybeFileDir = Class.withFileOrDir (Just . atomicFile . Part.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'. +-- +-- prop> Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt" +-- prop> Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir" +-- prop> Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt" +-- prop> Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" +-- prop> Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" +makeRelative :: + (System os, Class.FileDir fd) => + AbsDir os -> AbsPath os fd -> RelPath os fd +makeRelative relTo orig = + fromMaybe + (error $ + printf "System.Path can't make (%s) relative to (%s)" + (toString orig) (toString relTo)) $ + makeRelativeMaybe relTo orig + +-- prop> Path.makeRelativeMaybe (Posix.absDir "/tmp/somedir") (absFile "/tmp/anotherdir/file.txt") == Nothing +-- prop> Path.makeRelativeMaybe (Posix.absDir "/Tmp") (absFile "/tmp/anotherdir/file.txt") == Nothing +-- prop> Path.makeRelativeMaybe (Windows.absDir "\\Tmp") (absFile "\\tmp\\anotherdir\\file.txt") == Just (relFile "anotherdir\\file.txt") +makeRelativeMaybe :: + (System os, Class.FileDir fd) => + AbsDir os -> AbsPath os fd -> Maybe (RelPath os fd) +makeRelativeMaybe relTo orig = + case (inspectPath relTo, inspectPath orig) of + ((relToAR, relToPCs, WrapFileDir Part.Dir), + (origAR, origPCs, WrapFileDir fd)) -> + fmap (flip (Path Part.Rel) fd) $ + guard (relToAR == origAR) >> stripPrefix relToPCs origPCs + +-- | Joins an absolute directory with a relative path to construct a +-- new absolute path. +-- +-- prop> Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" +-- prop> Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" +-- prop> Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir" +-- prop> \base p -> Default.toString p `isSuffixOf` Path.toString (Path.makeAbsolute base (Path.idFile p)) +-- prop> \base p -> Default.toString base `isPrefixOf` Path.toString (Path.makeAbsolute base (Path.idFile p)) +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 -> AbsRelPath os fd -> AbsPath os fd +dynamicMakeAbsolute = genericMakeAbsolute + +dynamicMakeAbsoluteFromCwd :: + (System os) => AbsRelPath 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. +-- +-- prop> Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" +-- prop> Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" +-- prop> Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt" +genericMakeAbsolute :: + (System os, Class.AbsRel ar) => AbsDir os -> Path os ar fd -> AbsPath os fd +genericMakeAbsolute base p = withAbsRel 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, Class.AbsRel 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_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) Part.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 + +toFileDir :: (Class.FileDir fd) => Path os ar fd -> FileDirPath os ar +toFileDir p = uncurry Path (pathComponents p) Part.FileDir + +fromFileDir :: + (Class.FileDir fd) => FileDirPath os ar -> Maybe (Path os ar fd) +fromFileDir p = + switchFileDir + (fileFromFileDir p) + (Just $ dirFromFileDir p) + (Just p) + +fileFromFileDir :: FileDirPath os ar -> Maybe (FilePath os ar) +fileFromFileDir = fileFromAny + +fileFromAny :: Path os ar fd -> Maybe (FilePath os ar) +fileFromAny (Path ar pcs _) = + fmap (uncurry (Path ar) . mapSnd (Part.File . PC.untag)) $ ListHT.viewR pcs + +dirFromFileDir :: FileDirPath os ar -> DirPath os ar +dirFromFileDir (Path ar pcs Part.FileDir) = Path ar pcs Part.Dir + + +toAbsRel :: (Class.AbsRel ar) => Path os ar fd -> AbsRelPath os fd +toAbsRel (Path ar pcs fd) = Path (Class.toAbsRel ar) pcs fd + +fromAbsRel :: (Class.AbsRel ar) => AbsRelPath os fd -> Maybe (Path os ar fd) +fromAbsRel (Path ar0 pcs fd) = (\ar -> Path ar pcs fd) <$> Class.fromAbsRel ar0 + + +------------------------------------------------------------------------ +-- 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 +-} + +isDrive :: AbsDir os -> Bool +isDrive (Path _ pcs _) = null pcs + + +------------------------------------------------------------------------ +-- Path Predicates + +-- | Test whether a @'Path' ar fd@ is absolute. +-- +-- prop> Path.isAbsolute (Posix.absFile "/fred") +-- prop> Path.isAbsolute (Windows.absFile "\\fred") +-- prop> Path.isAbsolute (Windows.absFile "c:\\fred") +-- prop> Path.isAbsolute (Windows.absFile "c:fred") +isAbsolute :: Class.AbsRel ar => Path os ar fd -> Bool +isAbsolute = withAbsRel (const True) (const False) + +-- | Invariant - this should return True iff arg is of type @'Path' Part.Rel _@ +-- +-- > isRelative = not . isAbsolute +-- prop> Path.isRelative (Posix.relFile "fred") +-- prop> Path.isRelative (Windows.relFile "fred") +isRelative :: Class.AbsRel 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? +-- +-- prop> forAllAbsRel $ \x -> 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? +-- +-- prop> Path.hasExtension ".hs" (Posix.relFile "MyCode.hs") +-- prop> Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs") +-- prop> not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak") +hasExtension :: String -> FilePath os ar -> Bool +hasExtension ext = (==ext) . snd . splitExtension + + +------------------------------------------------------------------------ +-- Separators + +-- | Part.File extension character +-- +-- prop> Posix.extSeparator == '.' +extSeparator :: Char +extSeparator = Sep.extension + +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +searchPathSeparator :: Char +searchPathSeparator = Sep.searchPath + +-- | Is the character an extension character? +-- +-- prop> \a -> Posix.isExtSeparator a == (a == Posix.extSeparator) +isExtSeparator :: Char -> Bool +isExtSeparator = Sep.isExtension + +-- | Is the character a file separator? +-- +-- prop> \a -> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator) +isSearchPathSeparator :: Char -> Bool +isSearchPathSeparator = Sep.isSearchPath + + +------------------------------------------------------------------------ +-- 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 +-- +-- prop> Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x" +-- prop> Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x" +-- prop> Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x" +-- prop> Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile +genericAddExtension :: + (Class.FileDir fd) => Path os ar fd -> String -> Path os ar fd +genericAddExtension = + flip $ \ext -> + appEndo $ MonHT.when (not $ null ext) $ + switchFileDir + (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 [PC.empty] else pcs0 + in Path ar (mapLast (flip PC.addExtension ext) pcs) fd + +genericDropExtension :: (Class.FileDir fd) => Path os ar fd -> Path os ar fd +genericDropExtension = fst . genericSplitExtension + +genericDropExtensions :: (Class.FileDir fd) => Path os ar fd -> Path os ar fd +genericDropExtensions = fst . genericSplitExtensions + +genericSplitExtension :: + (Class.FileDir fd) => Path os ar fd -> (Path os ar fd, String) +genericSplitExtension = + runSplitExtension $ + switchFileDir + (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") + PC.splitExtension pcs + +genericSplitExtensions :: + (Class.FileDir fd) => Path os ar fd -> (Path os ar fd, String) +genericSplitExtensions = + runSplitExtension $ + switchFileDir + (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") + PC.splitExtensions pcs + +genericTakeExtension :: (Class.FileDir fd) => Path os ar fd -> String +genericTakeExtension = snd . genericSplitExtension + +genericTakeExtensions :: (Class.FileDir 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 : + [] + + + +{- | +Check internal integrity of the path data structure. +-} +isValid :: + (System os, Class.AbsRel ar, Class.FileDir fd) => + Path os ar fd -> Bool +isValid = untag isValidTagged + +isValidTagged :: + (System os, Class.AbsRel ar, Class.FileDir fd) => + Tagged os (Path os ar fd -> Bool) +isValidTagged = + fmap + (\isValidPC (Path ar pcs fd) -> + Class.withAbsRel isValidComponent True ar + && + all isValidPC pcs + && + Class.withFileDir (isValidPC . PC.retag) True True fd) + isValidPathComponent + +isValidComponent :: String -> Bool +isValidComponent = not . null + +isValidPathComponent :: + (System os) => Tagged os (Component os -> Bool) +isValidPathComponent = + fmap + (\isSep (Component str) -> + isValidComponent str && not (any isSep str)) + isPathSeparator + +------------------------------------------------------------------------ +-- QuickCheck + +testAll :: (System os) => os -> [(String, DocTest.T ())] +testAll os = + ("mkPathFromComponents_pathComponents", + quickCheck os prop_mkPathFromComponents_pathComponents) : + ("splitDir_combine", + quickCheck os prop_splitDir_combine) : + ("takeDirName_end", + quickCheck os prop_takeDirName_end) : + [] + +quickCheck :: + (QC.Testable prop, System os, Class.FileDir fd, Class.AbsRel ar) => + os -> (Path os ar fd -> prop) -> DocTest.T () +quickCheck _ = DocTest.property + +-- test :: Testable a => a -> IO () +-- test = quickCheck + +qcFileComponent :: Gen (Component os) +qcFileComponent = Component <$> frequency [ + (1, return "someFile"), + (1, return "fileWith.ext"), + (1, return "file.with.multiple.exts"), + (1, return "file with spcs") + ] + +qcDirComponent :: Gen (Component os) +qcDirComponent = Component <$> frequency [ + (1, return "someDir"), + (1, return "aDir"), + (1, return "aFolder"), + (1, return "a folder"), + (1, return "directory") + ] + + +qcAbsRel :: (System os, Class.AbsRel ar) => Tagged os (Gen ar) +qcAbsRel = + flip fmap genDrive $ \drive -> + Class.switchAbsRel (fmap absPC drive) (return Part.Rel) + (QC.oneof + [fmap (Part.AbsO . Component) drive, return Part.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, Class.AbsRel ar) => Gen (FilePath os ar) +qcFilePath = qcGenPath qcAbsRel $ \qcAR -> do + ar <- qcAR + pcs <- QC.listOf qcDirComponent + pc <- qcFileComponent + return $ Path ar pcs $ Part.File pc + +qcDirPath :: (System os, Class.AbsRel 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, Class.AbsRel ar, Class.FileDir fd) => Gen (Path os ar fd) +qcPath = + switchFileDir qcFilePath (qcDirPath Part.Dir) (qcDirPath Part.FileDir) + +instance + (System os, Class.AbsRel ar, Class.FileDir fd) => + Arbitrary (Path os ar fd) where arbitrary = qcPath diff --git a/src/System/Path/Internal/Component.hs b/src/System/Path/Internal/Component.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Internal/Component.hs @@ -0,0 +1,88 @@ +module System.Path.Internal.Component where + +import qualified System.Path.Internal.Separator as Sep +import System.Path.Internal.System (System, canonicalize) + +import Control.DeepSeq (NFData(rnf)) +import Control.Applicative ((<$>)) + +import qualified Data.List.HT as ListHT +import Data.Tagged (Tagged(Tagged)) +import Data.List (isPrefixOf) +import Data.Maybe.HT (toMaybe) +import Data.Tuple.HT (mapFst) +import Data.Ord.HT (comparing) +import Data.Eq.HT (equating) + +import Prelude hiding (map) + + +newtype Component os = Component String + +empty :: Component os +empty = Component "" + +instance NFData (Component os) where + rnf (Component pc) = rnf pc + +instance (System os) => Eq (Component os) where + (==) = equating (applyComp canonicalize) + +instance (System os) => Ord (Component os) where + compare = comparing (applyComp canonicalize) + +applyComp :: Tagged os (String -> String) -> Component os -> String +applyComp (Tagged canon) (Component pc) = canon pc + +retag :: GenComponent -> Component os +retag (Component pc) = Component pc + +untag :: Component os -> GenComponent +untag (Component pc) = Component pc + + +map :: (String -> String) -> Component os -> Component os +map f (Component s) = Component $ f s + +mapF :: + (Functor f) => + (String -> f String) -> Component os -> f (Component os) +mapF f (Component s) = Component <$> f s + + + +addExtension :: Component os -> String -> Component os +addExtension p "" = p +addExtension (Component pc) ext = + Component $ pc ++ + if [Sep.extension] `isPrefixOf` ext + then ext + else Sep.extension : ext + +splitExtension :: Component os -> (Component os, String) +splitExtension (Component s) = + mapFst Component $ + maybe (s, "") (mapFst concat) $ + ((\p@(pcs,_) -> toMaybe (not (null pcs)) p) =<<) $ ListHT.viewR $ + ListHT.segmentBefore Sep.isExtension s + +_splitExtension :: Component os -> (Component os, String) +_splitExtension (Component s) = + mapFst Component $ + case break Sep.isExtension $ reverse s of + (_, "") -> (s, "") + (rext, dot:rstem) -> (reverse rstem, dot : reverse rext) + +splitExtensions :: Component os -> (Component os, String) +splitExtensions (Component s) = + mapFst Component $ break Sep.isExtension s + + + +data Generic = Generic + +{- | +We cannot have a Component without phantom types plus a Tagged wrapper, +because we need specialised Eq and Ord instances. +-} +type GenComponent = Component Generic diff --git a/src/System/Path/Internal/Part.hs b/src/System/Path/Internal/Part.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Internal/Part.hs @@ -0,0 +1,43 @@ +module System.Path.Internal.Part where + +import qualified System.Path.Internal.Component as PC +import System.Path.Internal.Component + (Component(Component), GenComponent) + +import Control.DeepSeq (NFData(rnf)) + + +newtype Abs = Abs GenComponent +data Rel = Rel +data AbsRel = AbsO GenComponent | RelO + +absPC :: String -> Abs +absPC = Abs . Component + +newtype File = File GenComponent +data Dir = Dir +data FileDir = FileDir + + +instance NFData Abs where + rnf (Abs drive) = rnf drive + +instance NFData Rel where + rnf Rel = () + +instance NFData AbsRel where + rnf (AbsO drive) = rnf drive + rnf RelO = () + +instance NFData File where + rnf (File pc) = rnf pc + +instance NFData Dir where + rnf Dir = () + +instance NFData FileDir where + rnf FileDir = () + + +fileMap :: (String -> String) -> File -> File +fileMap f (File pc) = File $ PC.map f pc diff --git a/src/System/Path/Internal/PartClass.hs b/src/System/Path/Internal/PartClass.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Internal/PartClass.hs @@ -0,0 +1,160 @@ +module System.Path.Internal.PartClass where + +import qualified System.Path.Internal.Component as PC +import qualified System.Path.Internal.Part as Part +import System.Path.Internal.System (System(..)) +import System.Path.Internal.Component + (Component(Component), GenComponent) + +import Data.Monoid (Endo(Endo), appEndo) +import Data.Ord.HT (comparing) +import Data.Eq.HT (equating) + + + +------------------------------------------------------------------------ +-- Type classes and machinery for switching on Part.Abs/Part.Rel and Part.File/Part.Dir + +-- | This class provides a way to prevent other modules +-- from making further 'AbsOrRel' or 'FileOrDir' +-- instances +class Private p +instance Private Part.Abs +instance Private Part.Rel +instance Private Part.AbsRel +instance Private Part.File +instance Private Part.Dir +instance Private Part.FileDir + + +-- | This class allows selective behaviour for absolute and +-- relative paths and is mostly for internal use. +class Private ar => AbsRel ar where + {- | + See + for the used technique. + -} + switchAbsRel :: f Part.Abs -> f Part.Rel -> f Part.AbsRel -> f ar + +instance AbsRel Part.Abs where switchAbsRel f _ _ = f +instance AbsRel Part.Rel where switchAbsRel _ f _ = f +instance AbsRel Part.AbsRel where switchAbsRel _ _ f = f + +class AbsRel ar => AbsOrRel ar where + switchAbsOrRel :: f Part.Abs -> f Part.Rel -> f ar + +instance AbsOrRel Part.Abs where switchAbsOrRel f _ = f +instance AbsOrRel Part.Rel where switchAbsOrRel _ f = f + + +class AbsOrRel ar => Abs ar where switchAbs :: f Part.Abs -> f ar +instance Abs Part.Abs where switchAbs = id + +class AbsOrRel ar => Rel ar where switchRel :: f Part.Rel -> f ar +instance Rel Part.Rel where switchRel = id + +relVar :: Rel ar => ar +relVar = unwrapAbsRel $ switchRel $ WrapAbsRel Part.Rel + + +-- | This class allows selective behaviour for file and +-- directory paths and is mostly for internal use. +class Private fd => FileDir fd where + switchFileDir :: f Part.File -> f Part.Dir -> f Part.FileDir -> f fd + +instance FileDir Part.File where switchFileDir f _ _ = f +instance FileDir Part.Dir where switchFileDir _ f _ = f +instance FileDir Part.FileDir where switchFileDir _ _ f = f + +class FileDir fd => FileOrDir fd where + switchFileOrDir :: f Part.File -> f Part.Dir -> f fd + +instance FileOrDir Part.File where switchFileOrDir f _ = f +instance FileOrDir Part.Dir where switchFileOrDir _ f = f + + +class FileOrDir fd => File fd where switchFile :: f Part.File -> f fd +instance File Part.File where switchFile = id + +class FileOrDir fd => Dir fd where switchDir :: f Part.Dir -> f fd +instance Dir Part.Dir where switchDir = id + +dirVar :: Dir fd => fd +dirVar = unwrapFileDir $ switchDir $ WrapFileDir Part.Dir + + +newtype FuncArg b a = FuncArg {runFuncArg :: a -> b} + +withAbsRel :: (AbsRel ar) => (String -> a) -> a -> ar -> a +withAbsRel fAbs fRel = + runFuncArg $ + switchAbsRel + (FuncArg $ \(Part.Abs (Component drive)) -> fAbs drive) + (FuncArg $ \Part.Rel -> fRel) + (FuncArg $ \ar -> + case ar of + Part.AbsO (Component drive) -> fAbs drive + Part.RelO -> fRel) + +withFileDir :: (FileDir fd) => (GenComponent -> a) -> a -> a -> fd -> a +withFileDir fFile fDir fFileOrDir = + runFuncArg $ + switchFileDir (FuncArg $ \(Part.File pc) -> fFile pc) + (FuncArg $ \Part.Dir -> fDir) (FuncArg $ \Part.FileDir -> fFileOrDir) + +withFileOrDir :: (FileOrDir fd) => (GenComponent -> a) -> a -> fd -> a +withFileOrDir fFile fDir = + runFuncArg $ + switchFileOrDir + (FuncArg $ \(Part.File pc) -> fFile pc) + (FuncArg $ \Part.Dir -> fDir) + + + +isAbsolute :: (AbsRel ar) => ar -> Bool +isAbsolute = withAbsRel (const True) False + +toAbsRel :: AbsRel ar => ar -> Part.AbsRel +toAbsRel = + runFuncArg $ + switchAbsRel + (FuncArg $ \(Part.Abs drive) -> Part.AbsO drive) + (FuncArg $ \Part.Rel -> Part.RelO) + (FuncArg id) + +fromAbsRel :: AbsRel ar => Part.AbsRel -> Maybe ar +fromAbsRel ar = + case ar of + Part.AbsO pc -> switchAbsRel (Just $ Part.Abs pc) Nothing (Just ar) + Part.RelO -> switchAbsRel Nothing (Just Part.Rel) (Just ar) + +fdMap :: (FileDir fd) => (String -> String) -> fd -> fd +fdMap f = appEndo $ switchFileDir (Endo $ Part.fileMap f) (Endo id) (Endo id) + + +newtype WrapAbsRel os ar = WrapAbsRel {unwrapAbsRel :: ar} + +inspectAbsRel :: + (AbsRel ar) => WrapAbsRel os ar -> Either (Component os) () +inspectAbsRel = + withAbsRel (Left . Component) (Right ()) . unwrapAbsRel + +instance (System os, AbsRel ar) => Eq (WrapAbsRel os ar) where + (==) = equating inspectAbsRel + +instance (System os, AbsRel ar) => Ord (WrapAbsRel os ar) where + compare = comparing inspectAbsRel + + +newtype WrapFileDir os fd = WrapFileDir {unwrapFileDir :: fd} + +inspectFileDir :: + (FileDir ar) => WrapFileDir os ar -> Either (Component os) () +inspectFileDir = + withFileDir (Left . PC.retag) (Right ()) (Right ()) . unwrapFileDir + +instance (System os, FileDir fd) => Eq (WrapFileDir os fd) where + (==) = equating inspectFileDir + +instance (System os, FileDir fd) => Ord (WrapFileDir os fd) where + compare = comparing inspectFileDir diff --git a/src/System/Path/Internal/Separator.hs b/src/System/Path/Internal/Separator.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Internal/Separator.hs @@ -0,0 +1,14 @@ +module System.Path.Internal.Separator where + + +extension :: Char +extension = '.' + +searchPath :: Char +searchPath = ':' + +isExtension :: Char -> Bool +isExtension = (== extension) + +isSearchPath :: Char -> Bool +isSearchPath = (== searchPath) diff --git a/src/System/Path/Internal/System.hs b/src/System/Path/Internal/System.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Internal/System.hs @@ -0,0 +1,37 @@ +module System.Path.Internal.System where + +import qualified Control.Monad.Trans.State as MS +import Control.Applicative ((<$>)) + +import Data.Tagged (Tagged) + +import Test.QuickCheck (Gen) + + + +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) diff --git a/src/System/Path/Part.hs b/src/System/Path/Part.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/Part.hs @@ -0,0 +1,11 @@ +module System.Path.Part ( + -- * Possible types for Path type parameters + Abs, + Rel, + AbsRel, + File, + Dir, + FileDir, + ) where + +import System.Path.Internal.Part diff --git a/src/System/Path/PartClass.hs b/src/System/Path/PartClass.hs new file mode 100644 --- /dev/null +++ b/src/System/Path/PartClass.hs @@ -0,0 +1,6 @@ +module System.Path.PartClass ( + AbsRel(..), AbsOrRel(..), + FileDir(..), FileOrDir(..), + ) where + +import System.Path.Internal.PartClass 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,8 +1,4 @@ -{-# LANGUAGE EmptyDataDecls #-} -{-# 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 @@ -10,9 +6,240 @@ -- 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, + Abs, Rel, File, Dir, + AbsRelFile, AbsRelDir, AbsFileDir, RelFileDir, + AbsRel, FileDir, AbsRelFileDir, + AbsPath, RelPath, FilePath, DirPath, + AbsRelPath, FileDirPath, + asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath, + path, maybe, maybePath, parse, parsePath, + relFile, relDir, absFile, absDir, + abs, rel, absRel, file, dir, fileDir, + 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.PartClass as Class +import qualified System.Path.Internal as Core + +import Data.Tagged (Tagged(Tagged), untag) + +import qualified Test.DocTest.Driver as DocTest + +import Prelude hiding (FilePath, maybe, abs) + + +data Posix = Posix + +_osDummy :: Posix +_osDummy = Posix + +type System = Posix + +type Path = Core.Path System + +type AbsFile = Core.AbsFile System +type RelFile = Core.RelFile System +type AbsDir = Core.AbsDir System +type RelDir = Core.RelDir System +type AbsRelFile = Core.AbsRelFile System +type AbsRelDir = Core.AbsRelDir System +type AbsFileDir = Core.AbsFileDir System +type RelFileDir = Core.RelFileDir System +type AbsRelFileDir = Core.AbsRelFileDir System + +type Abs fd = Core.Abs System fd +type Rel fd = Core.Rel System fd +type File ar = Core.File System ar +type Dir ar = Core.Dir System ar +type AbsRel fd = Core.AbsRel System fd +type FileDir ar = Core.FileDir System ar + +type AbsPath fd = Core.AbsPath System fd +type RelPath fd = Core.RelPath System fd +type FilePath ar = Core.FilePath System ar +type DirPath ar = Core.DirPath System ar +type AbsRelPath fd = Core.AbsRelPath System fd +type FileDirPath ar = Core.FileDirPath System ar + +{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-} +asPath :: (Class.AbsOrRel ar, Class.FileOrDir 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 :: (Class.FileOrDir fd) => String -> RelPath fd +asRelPath = Core.asRelPath + +{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-} +asAbsPath :: (Class.FileOrDir fd) => String -> AbsPath fd +asAbsPath = Core.asAbsPath + +{-# DEPRECATED asFilePath "Use 'filePath' instead." #-} +asFilePath :: (Class.AbsOrRel ar) => String -> FilePath ar +asFilePath = Core.asFilePath + +{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-} +asDirPath :: (Class.AbsOrRel ar) => String -> DirPath ar +asDirPath = Core.asDirPath + + +{-# DEPRECATED maybePath "Use Path.maybe instead." #-} +{-# DEPRECATED parsePath "Use Path.parse instead." #-} + +maybe, maybePath :: + (Class.AbsRel ar, Class.FileDir fd) => String -> Maybe (Path ar fd) +maybe = Core.maybe +maybePath = Core.maybe + +parse, parsePath :: + (Class.AbsRel ar, Class.FileDir fd) => String -> Either String (Path ar fd) +parse = Core.parse +parsePath = Core.parse + + +path :: (Class.AbsRel ar, Class.FileDir 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 + + +rel :: (Class.FileDir fd) => String -> Rel fd +rel = Core.rel + +abs :: (Class.FileDir fd) => String -> Abs fd +abs = Core.abs + +absRel :: (Class.FileDir fd) => String -> AbsRel fd +absRel = Core.absRel + +file :: (Class.AbsRel ar) => String -> File ar +file = Core.file + +dir :: (Class.AbsRel ar) => String -> Dir ar +dir = Core.dir + +fileDir :: (Class.AbsRel ar) => String -> FileDir ar +fileDir = Core.fileDir + + +relPath :: (Class.FileDir fd) => String -> RelPath fd +relPath = Core.relPath + +absPath :: (Class.FileDir fd) => String -> AbsPath fd +absPath = Core.absPath + +filePath :: (Class.AbsRel ar) => String -> FilePath ar +filePath = Core.filePath + +dirPath :: (Class.AbsRel ar) => String -> DirPath ar +dirPath = Core.dirPath + + +rootDir :: AbsDir +rootDir = Core.rootDir + +currentDir :: RelDir +currentDir = Core.currentDir + +emptyFile :: RelFile +emptyFile = Core.emptyFile + + +toString :: (Class.AbsRel ar, Class.FileDir 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 System a -> a +withOS = untag + + +{-# DEPRECATED equalFilePath "Use System.FilePath.equalFilePath instead." #-} +{-# DEPRECATED isAbsoluteString "Use System.FilePath.isAbsolute instead." #-} +{-# DEPRECATED isRelativeString "Use System.FilePath.isRelative instead." #-} + +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, DocTest.T ())] +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,34 @@ +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) +import Data.Semigroup (Semigroup, (<>)) +import Data.Maybe (fromMaybe) + + +newtype Parser a = Parser (MS.StateT [a] Maybe [a]) + +instance Semigroup (Parser a) where + Parser x <> Parser y = Parser $ liftA2 (++) x y + +instance Monoid (Parser a) where + mempty = Parser $ return [] + +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,8 +1,4 @@ -{-# LANGUAGE EmptyDataDecls #-} -{-# 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 @@ -10,9 +6,250 @@ -- 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, + Abs, Rel, File, Dir, + AbsRelFile, AbsRelDir, AbsFileDir, RelFileDir, + AbsRel, FileDir, AbsRelFileDir, + AbsPath, RelPath, FilePath, DirPath, + AbsRelPath, FileDirPath, + asPath, + asRelFile, asRelDir, asAbsFile, asAbsDir, + asRelPath, asAbsPath, asFilePath, asDirPath, + path, maybe, maybePath, parse, parsePath, + relFile, relDir, absFile, absDir, + abs, rel, absRel, file, dir, fileDir, + 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.PartClass as Class +import qualified System.Path.Internal as Core +import System.Path.RegularExpression ((-|-)) + +import Data.Tagged (Tagged(Tagged), untag) +import Data.Char (isAlpha, toLower) +import Data.Monoid (mempty, (<>)) + +import qualified Test.DocTest.Driver as DocTest +import qualified Test.QuickCheck as QC + +import Prelude hiding (FilePath, maybe, abs) + + +data Windows = Windows + +_osDummy :: Windows +_osDummy = Windows + +type System = Windows + +type Path = Core.Path System + +type AbsFile = Core.AbsFile System +type RelFile = Core.RelFile System +type AbsDir = Core.AbsDir System +type RelDir = Core.RelDir System +type AbsRelFile = Core.AbsRelFile System +type AbsRelDir = Core.AbsRelDir System +type AbsFileDir = Core.AbsFileDir System +type RelFileDir = Core.RelFileDir System +type AbsRelFileDir = Core.AbsRelFileDir System + +type Abs fd = Core.Abs System fd +type Rel fd = Core.Rel System fd +type File ar = Core.File System ar +type Dir ar = Core.Dir System ar +type AbsRel fd = Core.AbsRel System fd +type FileDir ar = Core.FileDir System ar + +type AbsPath fd = Core.AbsPath System fd +type RelPath fd = Core.RelPath System fd +type FilePath ar = Core.FilePath System ar +type DirPath ar = Core.DirPath System ar +type AbsRelPath fd = Core.AbsRelPath System fd +type FileDirPath ar = Core.FileDirPath System ar + +{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-} +asPath :: (Class.AbsOrRel ar, Class.FileOrDir 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 :: (Class.FileOrDir fd) => String -> RelPath fd +asRelPath = Core.asRelPath + +{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-} +asAbsPath :: (Class.FileOrDir fd) => String -> AbsPath fd +asAbsPath = Core.asAbsPath + +{-# DEPRECATED asFilePath "Use 'filePath' instead." #-} +asFilePath :: (Class.AbsOrRel ar) => String -> FilePath ar +asFilePath = Core.asFilePath + +{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-} +asDirPath :: (Class.AbsOrRel ar) => String -> DirPath ar +asDirPath = Core.asDirPath + + +{-# DEPRECATED maybePath "Use Path.maybe instead." #-} +{-# DEPRECATED parsePath "Use Path.parse instead." #-} + +maybe, maybePath :: + (Class.AbsRel ar, Class.FileDir fd) => String -> Maybe (Path ar fd) +maybe = Core.maybe +maybePath = Core.maybe + +parse, parsePath :: + (Class.AbsRel ar, Class.FileDir fd) => String -> Either String (Path ar fd) +parse = Core.parse +parsePath = Core.parse + + +path :: (Class.AbsRel ar, Class.FileDir 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 + + +rel :: (Class.FileDir fd) => String -> Rel fd +rel = Core.rel + +abs :: (Class.FileDir fd) => String -> Abs fd +abs = Core.abs + +absRel :: (Class.FileDir fd) => String -> AbsRel fd +absRel = Core.absRel + +file :: (Class.AbsRel ar) => String -> File ar +file = Core.file + +dir :: (Class.AbsRel ar) => String -> Dir ar +dir = Core.dir + +fileDir :: (Class.AbsRel ar) => String -> FileDir ar +fileDir = Core.fileDir + + +relPath :: (Class.FileDir fd) => String -> RelPath fd +relPath = Core.relPath + +absPath :: (Class.FileDir fd) => String -> AbsPath fd +absPath = Core.absPath + +filePath :: (Class.AbsRel ar) => String -> FilePath ar +filePath = Core.filePath + +dirPath :: (Class.AbsRel ar) => String -> DirPath ar +dirPath = Core.dirPath + + +rootDir :: AbsDir +rootDir = Core.rootDir + +currentDir :: RelDir +currentDir = Core.currentDir + +emptyFile :: RelFile +emptyFile = Core.emptyFile + + +toString :: (Class.AbsRel ar, Class.FileDir 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 System a -> a +withOS = untag + + +{-# DEPRECATED equalFilePath "Use System.FilePath.equalFilePath instead." #-} +{-# DEPRECATED isAbsoluteString "Use System.FilePath.isAbsolute instead." #-} +{-# DEPRECATED isRelativeString "Use System.FilePath.isRelative instead." #-} + +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, DocTest.T ())] +testAll = Core.testAll Windows diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,29 +1,24 @@ module Main (main) where -import TestResult (results) +import qualified Test.Posix.System.Path.Internal as TestPosix +import qualified Test.Windows.System.Path.Internal as TestWindows -import System.Path (rootDir, asRelDir, asRelFile, (), (<.>)) -import System.Random (newStdGen, random) -import System.Exit (exitFailure) -import Control.Monad (void) -import Text.Printf (printf) +import qualified Test.DocTest.Driver as DocTest +import qualified System.Path.Posix as Posix +import qualified System.Path.Windows as Windows -main :: IO () -main = do - g <- newStdGen - let (a,_g') = random g - -- TODO - integrate with QuickCheck - x = rootDir asRelDir "tmp" asRelFile "someFile" <.> "ext" - let allResults = results a x - void $ printf "Running %d tests...\n" $ length allResults +main :: IO () +main = DocTest.run $ do + DocTest.printLine "\nPosix" + TestPosix.test + DocTest.printLine "\nWindows" + TestWindows.test - let fails = map fst $ filter (not . snd) allResults - if null fails - then do - putStrLn "Passed." - else do - putStrLn "Failed tests:" - mapM_ putStrLn fails - exitFailure + DocTest.printLine "\nTests of internal functions" + let runQC prefix = + mapM_ $ \(name, test) -> + DocTest.printPrefix (prefix ++ name ++ ": ") >> test + runQC "Posix." Posix.testAll + runQC "Windows." Windows.testAll diff --git a/test/Test/Posix/System/Path/Internal.hs b/test/Test/Posix/System/Path/Internal.hs new file mode 100644 --- /dev/null +++ b/test/Test/Posix/System/Path/Internal.hs @@ -0,0 +1,1044 @@ +-- Do not edit! Automatically created with doctest-extract from src/System/Path/Internal.hs +{-# LINE 199 "src/System/Path/Internal.hs" #-} + +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +module Test.Posix.System.Path.Internal where + +import qualified System.Path.Posix as Default +import Test.DocTest.Base +import qualified Test.DocTest.Driver as DocTest + +{-# LINE 201 "src/System/Path/Internal.hs" #-} +import qualified System.Path.PartClass as Class +import qualified System.Path.Generic as Path +import qualified System.Path.Posix as Posix +import qualified System.Path.Windows as Windows +import System.Path.Generic ((), (<.>), relFile, relDir, absFile, absDir) +import Data.List (isSuffixOf, isPrefixOf) +import Data.Char (toLower) +import qualified Test.QuickCheck as QC +forAllAbsRel :: (Class.FileDir fd, QC.Testable prop) => (Default.AbsRel fd -> prop) -> QC.Property +forAllAbsRel = QC.forAll QC.arbitrary + +test :: DocTest.T () +test = do + DocTest.printPrefix "System.Path.Internal:281: " +{-# LINE 281 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 281 "src/System/Path/Internal.hs" #-} + Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets" + ) + DocTest.printPrefix "System.Path.Internal:354: " +{-# LINE 354 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 354 "src/System/Path/Internal.hs" #-} + Posix.rootDir relDir "bla" relFile "blub" + ) + [ExpectedLine [LineChunk "rootDir relPath \"bla\" relPath \"blub\""]] + DocTest.printPrefix "System.Path.Internal:356: " +{-# LINE 356 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 356 "src/System/Path/Internal.hs" #-} + Just (Posix.rootDir relDir "bla" relFile "blub") + ) + [ExpectedLine [LineChunk "Just (rootDir relPath \"bla\" relPath \"blub\")"]] + DocTest.printPrefix "System.Path.Internal:358: " +{-# LINE 358 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 358 "src/System/Path/Internal.hs" #-} + Posix.currentDir relDir "bla" relFile "blub" + ) + [ExpectedLine [LineChunk "currentDir relPath \"bla\" relPath \"blub\""]] + DocTest.printPrefix "System.Path.Internal:360: " +{-# LINE 360 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 360 "src/System/Path/Internal.hs" #-} + Just (Posix.currentDir relDir "bla" relFile "blub") + ) + [ExpectedLine [LineChunk "Just (currentDir relPath \"bla\" relPath \"blub\")"]] + DocTest.printPrefix "System.Path.Internal:362: " +{-# LINE 362 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 362 "src/System/Path/Internal.hs" #-} + Windows.absDir "c:" relDir "bla" relFile "blub" + ) + [ExpectedLine [LineChunk "absDir \"c:\" relPath \"bla\" relPath \"blub\""]] + DocTest.printPrefix "System.Path.Internal:364: " +{-# LINE 364 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 364 "src/System/Path/Internal.hs" #-} + Just (Windows.absDir "c:\\" relDir "bla" relFile "blub") + ) + [ExpectedLine [LineChunk "Just (absDir \"c:\\\\\" relPath \"bla\" relPath \"blub\")"]] + DocTest.printPrefix "System.Path.Internal:476: " +{-# LINE 476 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 476 "src/System/Path/Internal.hs" #-} + \p -> Path.asPath (Path.toString p) == (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:558: " +{-# LINE 558 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 558 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" + ) + DocTest.printPrefix "System.Path.Internal:559: " +{-# LINE 559 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 559 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:560: " +{-# LINE 560 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 560 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:561: " +{-# LINE 561 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 561 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:562: " +{-# LINE 562 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 562 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:563: " +{-# LINE 563 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 563 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:564: " +{-# LINE 564 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 564 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:565: " +{-# LINE 565 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 565 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:566: " +{-# LINE 566 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 566 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:567: " +{-# LINE 567 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 567 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:568: " +{-# LINE 568 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 568 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:569: " +{-# LINE 569 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 569 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:570: " +{-# LINE 570 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 570 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:571: " +{-# LINE 571 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 571 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:572: " +{-# LINE 572 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 572 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:573: " +{-# LINE 573 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 573 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:574: " +{-# LINE 574 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 574 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:575: " +{-# LINE 575 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 575 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:576: " +{-# LINE 576 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 576 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" + ) + DocTest.printPrefix "System.Path.Internal:577: " +{-# LINE 577 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 577 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" + ) + DocTest.printPrefix "System.Path.Internal:578: " +{-# LINE 578 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 578 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" + ) + DocTest.printPrefix "System.Path.Internal:579: " +{-# LINE 579 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 579 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" + ) + DocTest.printPrefix "System.Path.Internal:580: " +{-# LINE 580 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 580 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:581: " +{-# LINE 581 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 581 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:582: " +{-# LINE 582 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 582 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:583: " +{-# LINE 583 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 583 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:632: " +{-# LINE 632 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 632 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relFile "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:633: " +{-# LINE 633 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 633 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relFile "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:639: " +{-# LINE 639 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 639 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir ".") == "." + ) + DocTest.printPrefix "System.Path.Internal:640: " +{-# LINE 640 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 640 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:641: " +{-# LINE 641 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 641 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:647: " +{-# LINE 647 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 647 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absFile "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:648: " +{-# LINE 648 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 648 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absFile "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:654: " +{-# LINE 654 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 654 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:655: " +{-# LINE 655 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 655 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:750: " +{-# LINE 750 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 750 "src/System/Path/Internal.hs" #-} + Posix.asPath "/tmp" == Posix.absDir "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:751: " +{-# LINE 751 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 751 "src/System/Path/Internal.hs" #-} + Posix.asPath "file.txt" == Posix.relFile "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:752: " +{-# LINE 752 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 752 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Posix.asAbsDir "/tmp") + ) + DocTest.printPrefix "System.Path.Internal:753: " +{-# LINE 753 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 753 "src/System/Path/Internal.hs" #-} + Path.isRelative (Posix.asRelDir "/tmp") + ) + DocTest.printPrefix "System.Path.Internal:754: " +{-# LINE 754 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 754 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:755: " +{-# LINE 755 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 755 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:756: " +{-# LINE 756 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 756 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:757: " +{-# LINE 757 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 757 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:758: " +{-# LINE 758 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 758 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp" + ) + DocTest.printPrefix "System.Path.Internal:759: " +{-# LINE 759 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 759 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:767: " +{-# LINE 767 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 767 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:768: " +{-# LINE 768 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 768 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "/file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:769: " +{-# LINE 769 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 769 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:770: " +{-# LINE 770 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 770 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "/tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:776: " +{-# LINE 776 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 776 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir ".") == "." + ) + DocTest.printPrefix "System.Path.Internal:777: " +{-# LINE 777 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 777 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:778: " +{-# LINE 778 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 778 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "/file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:779: " +{-# LINE 779 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 779 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:780: " +{-# LINE 780 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 780 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "/tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:786: " +{-# LINE 786 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 786 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:787: " +{-# LINE 787 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 787 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsFile "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:793: " +{-# LINE 793 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 793 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:794: " +{-# LINE 794 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 794 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsDir "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:833: " +{-# LINE 833 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 833 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp") + ) + DocTest.printPrefix "System.Path.Internal:834: " +{-# LINE 834 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 834 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp") + ) + DocTest.printPrefix "System.Path.Internal:835: " +{-# LINE 835 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 835 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp") + ) + DocTest.printPrefix "System.Path.Internal:836: " +{-# LINE 836 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 836 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp") + ) + DocTest.printPrefix "System.Path.Internal:837: " +{-# LINE 837 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 837 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp") + ) + DocTest.printPrefix "System.Path.Internal:838: " +{-# LINE 838 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 838 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp") + ) + DocTest.printPrefix "System.Path.Internal:867: " +{-# LINE 867 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 867 "src/System/Path/Internal.hs" #-} + Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt" + ) + DocTest.printPrefix "System.Path.Internal:868: " +{-# LINE 868 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 868 "src/System/Path/Internal.hs" #-} + Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt" + ) + DocTest.printPrefix "System.Path.Internal:1009: " +{-# LINE 1009 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1009 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1010: " +{-# LINE 1010 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1010 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1011: " +{-# LINE 1011 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1011 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1012: " +{-# LINE 1012 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1012 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1013: " +{-# LINE 1013 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1013 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1014: " +{-# LINE 1014 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1014 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1015: " +{-# LINE 1015 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1015 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1016: " +{-# LINE 1016 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1016 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1017: " +{-# LINE 1017 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1017 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.relDir "dir" Windows.relFile "file.txt") == "dir\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1044: " +{-# LINE 1044 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1044 "src/System/Path/Internal.hs" #-} + Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib" + ) + DocTest.printPrefix "System.Path.Internal:1045: " +{-# LINE 1045 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1045 "src/System/Path/Internal.hs" #-} + Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib" + ) + DocTest.printPrefix "System.Path.Internal:1046: " +{-# LINE 1046 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1046 "src/System/Path/Internal.hs" #-} + Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib" + ) + DocTest.printPrefix "System.Path.Internal:1047: " +{-# LINE 1047 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1047 "src/System/Path/Internal.hs" #-} + Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib" + ) + DocTest.printPrefix "System.Path.Internal:1048: " +{-# LINE 1048 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1048 "src/System/Path/Internal.hs" #-} + Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib" + ) + DocTest.printPrefix "System.Path.Internal:1049: " +{-# LINE 1049 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1049 "src/System/Path/Internal.hs" #-} + Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext" + ) + DocTest.printPrefix "System.Path.Internal:1056: " +{-# LINE 1056 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1056 "src/System/Path/Internal.hs" #-} + \p -> Path.combine Path.currentDir p == (p::Default.RelDir) + ) + DocTest.printPrefix "System.Path.Internal:1063: " +{-# LINE 1063 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1063 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.dropExtension x == fst (Path.splitExtension x) + ) + DocTest.printPrefix "System.Path.Internal:1069: " +{-# LINE 1069 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1069 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> not $ Path.hasAnExtension (Path.dropExtensions x) + ) + DocTest.printPrefix "System.Path.Internal:1080: " +{-# LINE 1080 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1080 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob" + ) + DocTest.printPrefix "System.Path.Internal:1081: " +{-# LINE 1081 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1081 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob" + ) + DocTest.printPrefix "System.Path.Internal:1082: " +{-# LINE 1082 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1082 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob" + ) + DocTest.printPrefix "System.Path.Internal:1083: " +{-# LINE 1083 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1083 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file" + ) + DocTest.printPrefix "System.Path.Internal:1084: " +{-# LINE 1084 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1084 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt" + ) + DocTest.printPrefix "System.Path.Internal:1101: " +{-# LINE 1101 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1101 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> uncurry (<.>) (Path.splitExtension x) == x + ) + DocTest.printPrefix "System.Path.Internal:1102: " +{-# LINE 1102 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1102 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> uncurry Path.addExtension (Path.splitExtension x) == x + ) + DocTest.printPrefix "System.Path.Internal:1103: " +{-# LINE 1103 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1103 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt") + ) + DocTest.printPrefix "System.Path.Internal:1104: " +{-# LINE 1104 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1104 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc") + ) + DocTest.printPrefix "System.Path.Internal:1105: " +{-# LINE 1105 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1105 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file") == (Posix.relFile "file","") + ) + DocTest.printPrefix "System.Path.Internal:1106: " +{-# LINE 1106 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1106 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt") + ) + DocTest.printPrefix "System.Path.Internal:1107: " +{-# LINE 1107 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1107 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","") + ) + DocTest.printPrefix "System.Path.Internal:1108: " +{-# LINE 1108 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1108 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext") + ) + DocTest.printPrefix "System.Path.Internal:1109: " +{-# LINE 1109 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1109 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred") + ) + DocTest.printPrefix "System.Path.Internal:1115: " +{-# LINE 1115 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1115 "src/System/Path/Internal.hs" #-} + Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz") + ) + DocTest.printPrefix "System.Path.Internal:1116: " +{-# LINE 1116 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1116 "src/System/Path/Internal.hs" #-} + \p -> uncurry (<.>) (Path.splitExtension p) == (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:1120: " +{-# LINE 1120 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1120 "src/System/Path/Internal.hs" #-} + \p -> uncurry Path.combine (Path.splitFileName p) == (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:1136: " +{-# LINE 1136 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1136 "src/System/Path/Internal.hs" #-} + Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile" + ) + DocTest.printPrefix "System.Path.Internal:1137: " +{-# LINE 1137 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1137 "src/System/Path/Internal.hs" #-} + Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile" + ) + DocTest.printPrefix "System.Path.Internal:1138: " +{-# LINE 1138 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1138 "src/System/Path/Internal.hs" #-} + Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile" + ) + DocTest.printPrefix "System.Path.Internal:1157: " +{-# LINE 1157 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1157 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.takeExtension x == snd (Path.splitExtension x) + ) + DocTest.printPrefix "System.Path.Internal:1158: " +{-# LINE 1158 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1158 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.takeExtension (Path.addExtension x "ext") == ".ext" + ) + DocTest.printPrefix "System.Path.Internal:1159: " +{-# LINE 1159 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1159 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.takeExtension (Path.replaceExtension x "ext") == ".ext" + ) + DocTest.printPrefix "System.Path.Internal:1165: " +{-# LINE 1165 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1165 "src/System/Path/Internal.hs" #-} + Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz" + ) + DocTest.printPrefix "System.Path.Internal:1171: " +{-# LINE 1171 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1171 "src/System/Path/Internal.hs" #-} + Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt" + ) + DocTest.printPrefix "System.Path.Internal:1172: " +{-# LINE 1172 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1172 "src/System/Path/Internal.hs" #-} + Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt" + ) + DocTest.printPrefix "System.Path.Internal:1173: " +{-# LINE 1173 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1173 "src/System/Path/Internal.hs" #-} + Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt" + ) + DocTest.printPrefix "System.Path.Internal:1174: " +{-# LINE 1174 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1174 "src/System/Path/Internal.hs" #-} + \p -> Path.toString (Path.takeFileName p) `isSuffixOf` Path.toString (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:1203: " +{-# LINE 1203 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1203 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "abc/def" "abc/def" + ) + DocTest.printPrefix "System.Path.Internal:1204: " +{-# LINE 1204 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1204 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "abc/def" "abc//def" + ) + DocTest.printPrefix "System.Path.Internal:1205: " +{-# LINE 1205 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1205 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "/tmp/" "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:1206: " +{-# LINE 1206 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1206 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "/tmp" "//tmp" + ) + DocTest.printPrefix "System.Path.Internal:1207: " +{-# LINE 1207 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1207 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "/tmp" "///tmp" + ) + DocTest.printPrefix "System.Path.Internal:1208: " +{-# LINE 1208 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1208 "src/System/Path/Internal.hs" #-} + not $ Posix.equalFilePath "abc" "def" + ) + DocTest.printPrefix "System.Path.Internal:1209: " +{-# LINE 1209 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1209 "src/System/Path/Internal.hs" #-} + not $ Posix.equalFilePath "/tmp" "tmp" + ) + DocTest.printPrefix "System.Path.Internal:1210: " +{-# LINE 1210 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1210 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "abc\\def" "abc\\def" + ) + DocTest.printPrefix "System.Path.Internal:1211: " +{-# LINE 1211 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1211 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "abc\\def" "abc\\\\def" + ) + DocTest.printPrefix "System.Path.Internal:1212: " +{-# LINE 1212 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1212 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "file" "File" + ) + DocTest.printPrefix "System.Path.Internal:1213: " +{-# LINE 1213 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1213 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "\\file" "\\\\file" + ) + DocTest.printPrefix "System.Path.Internal:1214: " +{-# LINE 1214 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1214 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "\\file" "\\\\\\file" + ) + DocTest.printPrefix "System.Path.Internal:1215: " +{-# LINE 1215 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1215 "src/System/Path/Internal.hs" #-} + not $ Windows.equalFilePath "abc" "def" + ) + DocTest.printPrefix "System.Path.Internal:1216: " +{-# LINE 1216 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1216 "src/System/Path/Internal.hs" #-} + not $ Windows.equalFilePath "file" "dir" + ) + DocTest.printPrefix "System.Path.Internal:1229: " +{-# LINE 1229 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1229 "src/System/Path/Internal.hs" #-} + Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir" + ) + DocTest.printPrefix "System.Path.Internal:1230: " +{-# LINE 1230 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1230 "src/System/Path/Internal.hs" #-} + Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1236: " +{-# LINE 1236 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1236 "src/System/Path/Internal.hs" #-} + Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file" + ) + DocTest.printPrefix "System.Path.Internal:1242: " +{-# LINE 1242 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1242 "src/System/Path/Internal.hs" #-} + Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing) + ) + DocTest.printPrefix "System.Path.Internal:1243: " +{-# LINE 1243 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1243 "src/System/Path/Internal.hs" #-} + Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt") + ) + DocTest.printPrefix "System.Path.Internal:1259: " +{-# LINE 1259 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1259 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1260: " +{-# LINE 1260 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1260 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir" + ) + DocTest.printPrefix "System.Path.Internal:1261: " +{-# LINE 1261 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1261 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt" + ) + DocTest.printPrefix "System.Path.Internal:1262: " +{-# LINE 1262 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1262 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" + ) + DocTest.printPrefix "System.Path.Internal:1263: " +{-# LINE 1263 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1263 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" + ) + DocTest.printPrefix "System.Path.Internal:1290: " +{-# LINE 1290 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1290 "src/System/Path/Internal.hs" #-} + Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1291: " +{-# LINE 1291 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1291 "src/System/Path/Internal.hs" #-} + Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1292: " +{-# LINE 1292 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1292 "src/System/Path/Internal.hs" #-} + Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir" + ) + DocTest.printPrefix "System.Path.Internal:1293: " +{-# LINE 1293 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1293 "src/System/Path/Internal.hs" #-} + \base p -> Default.toString p `isSuffixOf` Path.toString (Path.makeAbsolute base (Path.idFile p)) + ) + DocTest.printPrefix "System.Path.Internal:1294: " +{-# LINE 1294 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1294 "src/System/Path/Internal.hs" #-} + \base p -> Default.toString base `isPrefixOf` Path.toString (Path.makeAbsolute base (Path.idFile p)) + ) + DocTest.printPrefix "System.Path.Internal:1316: " +{-# LINE 1316 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1316 "src/System/Path/Internal.hs" #-} + Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1317: " +{-# LINE 1317 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1317 "src/System/Path/Internal.hs" #-} + Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1318: " +{-# LINE 1318 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1318 "src/System/Path/Internal.hs" #-} + Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1403: " +{-# LINE 1403 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1403 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Posix.absFile "/fred") + ) + DocTest.printPrefix "System.Path.Internal:1404: " +{-# LINE 1404 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1404 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Windows.absFile "\\fred") + ) + DocTest.printPrefix "System.Path.Internal:1405: " +{-# LINE 1405 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1405 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Windows.absFile "c:\\fred") + ) + DocTest.printPrefix "System.Path.Internal:1406: " +{-# LINE 1406 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1406 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Windows.absFile "c:fred") + ) + DocTest.printPrefix "System.Path.Internal:1413: " +{-# LINE 1413 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1413 "src/System/Path/Internal.hs" #-} + Path.isRelative (Posix.relFile "fred") + ) + DocTest.printPrefix "System.Path.Internal:1414: " +{-# LINE 1414 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1414 "src/System/Path/Internal.hs" #-} + Path.isRelative (Windows.relFile "fred") + ) + DocTest.printPrefix "System.Path.Internal:1439: " +{-# LINE 1439 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1439 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> null (Path.takeExtension x) == not (Path.hasAnExtension x) + ) + DocTest.printPrefix "System.Path.Internal:1445: " +{-# LINE 1445 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1445 "src/System/Path/Internal.hs" #-} + Path.hasExtension ".hs" (Posix.relFile "MyCode.hs") + ) + DocTest.printPrefix "System.Path.Internal:1446: " +{-# LINE 1446 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1446 "src/System/Path/Internal.hs" #-} + Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs") + ) + DocTest.printPrefix "System.Path.Internal:1447: " +{-# LINE 1447 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1447 "src/System/Path/Internal.hs" #-} + not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak") + ) + DocTest.printPrefix "System.Path.Internal:1457: " +{-# LINE 1457 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1457 "src/System/Path/Internal.hs" #-} + Posix.extSeparator == '.' + ) + DocTest.printPrefix "System.Path.Internal:1468: " +{-# LINE 1468 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1468 "src/System/Path/Internal.hs" #-} + \a -> Posix.isExtSeparator a == (a == Posix.extSeparator) + ) + DocTest.printPrefix "System.Path.Internal:1474: " +{-# LINE 1474 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1474 "src/System/Path/Internal.hs" #-} + \a -> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator) + ) + DocTest.printPrefix "System.Path.Internal:1490: " +{-# LINE 1490 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1490 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x" + ) + DocTest.printPrefix "System.Path.Internal:1491: " +{-# LINE 1491 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1491 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x" + ) + DocTest.printPrefix "System.Path.Internal:1492: " +{-# LINE 1492 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1492 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x" + ) + DocTest.printPrefix "System.Path.Internal:1493: " +{-# LINE 1493 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1493 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile + ) diff --git a/test/Test/Windows/System/Path/Internal.hs b/test/Test/Windows/System/Path/Internal.hs new file mode 100644 --- /dev/null +++ b/test/Test/Windows/System/Path/Internal.hs @@ -0,0 +1,1044 @@ +-- Do not edit! Automatically created with doctest-extract from src/System/Path/Internal.hs +{-# LINE 199 "src/System/Path/Internal.hs" #-} + +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +module Test.Windows.System.Path.Internal where + +import qualified System.Path.Windows as Default +import Test.DocTest.Base +import qualified Test.DocTest.Driver as DocTest + +{-# LINE 201 "src/System/Path/Internal.hs" #-} +import qualified System.Path.PartClass as Class +import qualified System.Path.Generic as Path +import qualified System.Path.Posix as Posix +import qualified System.Path.Windows as Windows +import System.Path.Generic ((), (<.>), relFile, relDir, absFile, absDir) +import Data.List (isSuffixOf, isPrefixOf) +import Data.Char (toLower) +import qualified Test.QuickCheck as QC +forAllAbsRel :: (Class.FileDir fd, QC.Testable prop) => (Default.AbsRel fd -> prop) -> QC.Property +forAllAbsRel = QC.forAll QC.arbitrary + +test :: DocTest.T () +test = do + DocTest.printPrefix "System.Path.Internal:281: " +{-# LINE 281 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 281 "src/System/Path/Internal.hs" #-} + Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets" + ) + DocTest.printPrefix "System.Path.Internal:354: " +{-# LINE 354 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 354 "src/System/Path/Internal.hs" #-} + Posix.rootDir relDir "bla" relFile "blub" + ) + [ExpectedLine [LineChunk "rootDir relPath \"bla\" relPath \"blub\""]] + DocTest.printPrefix "System.Path.Internal:356: " +{-# LINE 356 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 356 "src/System/Path/Internal.hs" #-} + Just (Posix.rootDir relDir "bla" relFile "blub") + ) + [ExpectedLine [LineChunk "Just (rootDir relPath \"bla\" relPath \"blub\")"]] + DocTest.printPrefix "System.Path.Internal:358: " +{-# LINE 358 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 358 "src/System/Path/Internal.hs" #-} + Posix.currentDir relDir "bla" relFile "blub" + ) + [ExpectedLine [LineChunk "currentDir relPath \"bla\" relPath \"blub\""]] + DocTest.printPrefix "System.Path.Internal:360: " +{-# LINE 360 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 360 "src/System/Path/Internal.hs" #-} + Just (Posix.currentDir relDir "bla" relFile "blub") + ) + [ExpectedLine [LineChunk "Just (currentDir relPath \"bla\" relPath \"blub\")"]] + DocTest.printPrefix "System.Path.Internal:362: " +{-# LINE 362 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 362 "src/System/Path/Internal.hs" #-} + Windows.absDir "c:" relDir "bla" relFile "blub" + ) + [ExpectedLine [LineChunk "absDir \"c:\" relPath \"bla\" relPath \"blub\""]] + DocTest.printPrefix "System.Path.Internal:364: " +{-# LINE 364 "src/System/Path/Internal.hs" #-} + DocTest.example( +{-# LINE 364 "src/System/Path/Internal.hs" #-} + Just (Windows.absDir "c:\\" relDir "bla" relFile "blub") + ) + [ExpectedLine [LineChunk "Just (absDir \"c:\\\\\" relPath \"bla\" relPath \"blub\")"]] + DocTest.printPrefix "System.Path.Internal:476: " +{-# LINE 476 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 476 "src/System/Path/Internal.hs" #-} + \p -> Path.asPath (Path.toString p) == (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:558: " +{-# LINE 558 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 558 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" + ) + DocTest.printPrefix "System.Path.Internal:559: " +{-# LINE 559 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 559 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:560: " +{-# LINE 560 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 560 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:561: " +{-# LINE 561 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 561 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:562: " +{-# LINE 562 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 562 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:563: " +{-# LINE 563 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 563 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:564: " +{-# LINE 564 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 564 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:565: " +{-# LINE 565 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 565 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:566: " +{-# LINE 566 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 566 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:567: " +{-# LINE 567 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 567 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:568: " +{-# LINE 568 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 568 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:569: " +{-# LINE 569 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 569 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:570: " +{-# LINE 570 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 570 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:571: " +{-# LINE 571 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 571 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsRelFileDir) == Just "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:572: " +{-# LINE 572 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 572 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:573: " +{-# LINE 573 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 573 "src/System/Path/Internal.hs" #-} + fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:574: " +{-# LINE 574 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 574 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:575: " +{-# LINE 575 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 575 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:576: " +{-# LINE 576 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 576 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" + ) + DocTest.printPrefix "System.Path.Internal:577: " +{-# LINE 577 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 577 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" + ) + DocTest.printPrefix "System.Path.Internal:578: " +{-# LINE 578 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 578 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" + ) + DocTest.printPrefix "System.Path.Internal:579: " +{-# LINE 579 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 579 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" + ) + DocTest.printPrefix "System.Path.Internal:580: " +{-# LINE 580 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 580 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:581: " +{-# LINE 581 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 581 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:582: " +{-# LINE 582 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 582 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:583: " +{-# LINE 583 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 583 "src/System/Path/Internal.hs" #-} + fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing + ) + DocTest.printPrefix "System.Path.Internal:632: " +{-# LINE 632 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 632 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relFile "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:633: " +{-# LINE 633 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 633 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relFile "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:639: " +{-# LINE 639 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 639 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir ".") == "." + ) + DocTest.printPrefix "System.Path.Internal:640: " +{-# LINE 640 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 640 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:641: " +{-# LINE 641 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 641 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:647: " +{-# LINE 647 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 647 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absFile "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:648: " +{-# LINE 648 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 648 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absFile "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:654: " +{-# LINE 654 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 654 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:655: " +{-# LINE 655 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 655 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:750: " +{-# LINE 750 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 750 "src/System/Path/Internal.hs" #-} + Posix.asPath "/tmp" == Posix.absDir "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:751: " +{-# LINE 751 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 751 "src/System/Path/Internal.hs" #-} + Posix.asPath "file.txt" == Posix.relFile "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:752: " +{-# LINE 752 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 752 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Posix.asAbsDir "/tmp") + ) + DocTest.printPrefix "System.Path.Internal:753: " +{-# LINE 753 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 753 "src/System/Path/Internal.hs" #-} + Path.isRelative (Posix.asRelDir "/tmp") + ) + DocTest.printPrefix "System.Path.Internal:754: " +{-# LINE 754 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 754 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:755: " +{-# LINE 755 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 755 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:756: " +{-# LINE 756 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 756 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:757: " +{-# LINE 757 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 757 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" + ) + DocTest.printPrefix "System.Path.Internal:758: " +{-# LINE 758 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 758 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp" + ) + DocTest.printPrefix "System.Path.Internal:759: " +{-# LINE 759 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 759 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:767: " +{-# LINE 767 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 767 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:768: " +{-# LINE 768 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 768 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "/file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:769: " +{-# LINE 769 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 769 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:770: " +{-# LINE 770 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 770 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelFile "/tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:776: " +{-# LINE 776 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 776 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir ".") == "." + ) + DocTest.printPrefix "System.Path.Internal:777: " +{-# LINE 777 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 777 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:778: " +{-# LINE 778 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 778 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "/file.txt") == "file.txt" + ) + DocTest.printPrefix "System.Path.Internal:779: " +{-# LINE 779 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 779 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:780: " +{-# LINE 780 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 780 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asRelDir "/tmp") == "tmp" + ) + DocTest.printPrefix "System.Path.Internal:786: " +{-# LINE 786 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 786 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:787: " +{-# LINE 787 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 787 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsFile "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:793: " +{-# LINE 793 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 793 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:794: " +{-# LINE 794 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 794 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.asAbsDir "/tmp") == "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:833: " +{-# LINE 833 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 833 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp") + ) + DocTest.printPrefix "System.Path.Internal:834: " +{-# LINE 834 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 834 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp") + ) + DocTest.printPrefix "System.Path.Internal:835: " +{-# LINE 835 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 835 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp") + ) + DocTest.printPrefix "System.Path.Internal:836: " +{-# LINE 836 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 836 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp") + ) + DocTest.printPrefix "System.Path.Internal:837: " +{-# LINE 837 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 837 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp") + ) + DocTest.printPrefix "System.Path.Internal:838: " +{-# LINE 838 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 838 "src/System/Path/Internal.hs" #-} + Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp") + ) + DocTest.printPrefix "System.Path.Internal:867: " +{-# LINE 867 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 867 "src/System/Path/Internal.hs" #-} + Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt" + ) + DocTest.printPrefix "System.Path.Internal:868: " +{-# LINE 868 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 868 "src/System/Path/Internal.hs" #-} + Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt" + ) + DocTest.printPrefix "System.Path.Internal:1009: " +{-# LINE 1009 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1009 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1010: " +{-# LINE 1010 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1010 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1011: " +{-# LINE 1011 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1011 "src/System/Path/Internal.hs" #-} + Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1012: " +{-# LINE 1012 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1012 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1013: " +{-# LINE 1013 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1013 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1014: " +{-# LINE 1014 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1014 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1015: " +{-# LINE 1015 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1015 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1016: " +{-# LINE 1016 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1016 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1017: " +{-# LINE 1017 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1017 "src/System/Path/Internal.hs" #-} + Windows.toString (Windows.relDir "dir" Windows.relFile "file.txt") == "dir\\file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1044: " +{-# LINE 1044 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1044 "src/System/Path/Internal.hs" #-} + Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib" + ) + DocTest.printPrefix "System.Path.Internal:1045: " +{-# LINE 1045 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1045 "src/System/Path/Internal.hs" #-} + Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib" + ) + DocTest.printPrefix "System.Path.Internal:1046: " +{-# LINE 1046 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1046 "src/System/Path/Internal.hs" #-} + Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib" + ) + DocTest.printPrefix "System.Path.Internal:1047: " +{-# LINE 1047 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1047 "src/System/Path/Internal.hs" #-} + Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib" + ) + DocTest.printPrefix "System.Path.Internal:1048: " +{-# LINE 1048 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1048 "src/System/Path/Internal.hs" #-} + Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib" + ) + DocTest.printPrefix "System.Path.Internal:1049: " +{-# LINE 1049 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1049 "src/System/Path/Internal.hs" #-} + Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext" + ) + DocTest.printPrefix "System.Path.Internal:1056: " +{-# LINE 1056 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1056 "src/System/Path/Internal.hs" #-} + \p -> Path.combine Path.currentDir p == (p::Default.RelDir) + ) + DocTest.printPrefix "System.Path.Internal:1063: " +{-# LINE 1063 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1063 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.dropExtension x == fst (Path.splitExtension x) + ) + DocTest.printPrefix "System.Path.Internal:1069: " +{-# LINE 1069 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1069 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> not $ Path.hasAnExtension (Path.dropExtensions x) + ) + DocTest.printPrefix "System.Path.Internal:1080: " +{-# LINE 1080 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1080 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob" + ) + DocTest.printPrefix "System.Path.Internal:1081: " +{-# LINE 1081 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1081 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob" + ) + DocTest.printPrefix "System.Path.Internal:1082: " +{-# LINE 1082 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1082 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob" + ) + DocTest.printPrefix "System.Path.Internal:1083: " +{-# LINE 1083 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1083 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file" + ) + DocTest.printPrefix "System.Path.Internal:1084: " +{-# LINE 1084 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1084 "src/System/Path/Internal.hs" #-} + Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt" + ) + DocTest.printPrefix "System.Path.Internal:1101: " +{-# LINE 1101 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1101 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> uncurry (<.>) (Path.splitExtension x) == x + ) + DocTest.printPrefix "System.Path.Internal:1102: " +{-# LINE 1102 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1102 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> uncurry Path.addExtension (Path.splitExtension x) == x + ) + DocTest.printPrefix "System.Path.Internal:1103: " +{-# LINE 1103 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1103 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt") + ) + DocTest.printPrefix "System.Path.Internal:1104: " +{-# LINE 1104 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1104 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc") + ) + DocTest.printPrefix "System.Path.Internal:1105: " +{-# LINE 1105 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1105 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file") == (Posix.relFile "file","") + ) + DocTest.printPrefix "System.Path.Internal:1106: " +{-# LINE 1106 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1106 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt") + ) + DocTest.printPrefix "System.Path.Internal:1107: " +{-# LINE 1107 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1107 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","") + ) + DocTest.printPrefix "System.Path.Internal:1108: " +{-# LINE 1108 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1108 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext") + ) + DocTest.printPrefix "System.Path.Internal:1109: " +{-# LINE 1109 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1109 "src/System/Path/Internal.hs" #-} + Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred") + ) + DocTest.printPrefix "System.Path.Internal:1115: " +{-# LINE 1115 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1115 "src/System/Path/Internal.hs" #-} + Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz") + ) + DocTest.printPrefix "System.Path.Internal:1116: " +{-# LINE 1116 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1116 "src/System/Path/Internal.hs" #-} + \p -> uncurry (<.>) (Path.splitExtension p) == (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:1120: " +{-# LINE 1120 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1120 "src/System/Path/Internal.hs" #-} + \p -> uncurry Path.combine (Path.splitFileName p) == (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:1136: " +{-# LINE 1136 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1136 "src/System/Path/Internal.hs" #-} + Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile" + ) + DocTest.printPrefix "System.Path.Internal:1137: " +{-# LINE 1137 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1137 "src/System/Path/Internal.hs" #-} + Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile" + ) + DocTest.printPrefix "System.Path.Internal:1138: " +{-# LINE 1138 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1138 "src/System/Path/Internal.hs" #-} + Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile" + ) + DocTest.printPrefix "System.Path.Internal:1157: " +{-# LINE 1157 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1157 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.takeExtension x == snd (Path.splitExtension x) + ) + DocTest.printPrefix "System.Path.Internal:1158: " +{-# LINE 1158 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1158 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.takeExtension (Path.addExtension x "ext") == ".ext" + ) + DocTest.printPrefix "System.Path.Internal:1159: " +{-# LINE 1159 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1159 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> Path.takeExtension (Path.replaceExtension x "ext") == ".ext" + ) + DocTest.printPrefix "System.Path.Internal:1165: " +{-# LINE 1165 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1165 "src/System/Path/Internal.hs" #-} + Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz" + ) + DocTest.printPrefix "System.Path.Internal:1171: " +{-# LINE 1171 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1171 "src/System/Path/Internal.hs" #-} + Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt" + ) + DocTest.printPrefix "System.Path.Internal:1172: " +{-# LINE 1172 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1172 "src/System/Path/Internal.hs" #-} + Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt" + ) + DocTest.printPrefix "System.Path.Internal:1173: " +{-# LINE 1173 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1173 "src/System/Path/Internal.hs" #-} + Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt" + ) + DocTest.printPrefix "System.Path.Internal:1174: " +{-# LINE 1174 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1174 "src/System/Path/Internal.hs" #-} + \p -> Path.toString (Path.takeFileName p) `isSuffixOf` Path.toString (p::Default.AbsFile) + ) + DocTest.printPrefix "System.Path.Internal:1203: " +{-# LINE 1203 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1203 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "abc/def" "abc/def" + ) + DocTest.printPrefix "System.Path.Internal:1204: " +{-# LINE 1204 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1204 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "abc/def" "abc//def" + ) + DocTest.printPrefix "System.Path.Internal:1205: " +{-# LINE 1205 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1205 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "/tmp/" "/tmp" + ) + DocTest.printPrefix "System.Path.Internal:1206: " +{-# LINE 1206 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1206 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "/tmp" "//tmp" + ) + DocTest.printPrefix "System.Path.Internal:1207: " +{-# LINE 1207 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1207 "src/System/Path/Internal.hs" #-} + Posix.equalFilePath "/tmp" "///tmp" + ) + DocTest.printPrefix "System.Path.Internal:1208: " +{-# LINE 1208 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1208 "src/System/Path/Internal.hs" #-} + not $ Posix.equalFilePath "abc" "def" + ) + DocTest.printPrefix "System.Path.Internal:1209: " +{-# LINE 1209 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1209 "src/System/Path/Internal.hs" #-} + not $ Posix.equalFilePath "/tmp" "tmp" + ) + DocTest.printPrefix "System.Path.Internal:1210: " +{-# LINE 1210 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1210 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "abc\\def" "abc\\def" + ) + DocTest.printPrefix "System.Path.Internal:1211: " +{-# LINE 1211 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1211 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "abc\\def" "abc\\\\def" + ) + DocTest.printPrefix "System.Path.Internal:1212: " +{-# LINE 1212 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1212 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "file" "File" + ) + DocTest.printPrefix "System.Path.Internal:1213: " +{-# LINE 1213 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1213 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "\\file" "\\\\file" + ) + DocTest.printPrefix "System.Path.Internal:1214: " +{-# LINE 1214 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1214 "src/System/Path/Internal.hs" #-} + Windows.equalFilePath "\\file" "\\\\\\file" + ) + DocTest.printPrefix "System.Path.Internal:1215: " +{-# LINE 1215 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1215 "src/System/Path/Internal.hs" #-} + not $ Windows.equalFilePath "abc" "def" + ) + DocTest.printPrefix "System.Path.Internal:1216: " +{-# LINE 1216 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1216 "src/System/Path/Internal.hs" #-} + not $ Windows.equalFilePath "file" "dir" + ) + DocTest.printPrefix "System.Path.Internal:1229: " +{-# LINE 1229 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1229 "src/System/Path/Internal.hs" #-} + Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir" + ) + DocTest.printPrefix "System.Path.Internal:1230: " +{-# LINE 1230 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1230 "src/System/Path/Internal.hs" #-} + Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1236: " +{-# LINE 1236 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1236 "src/System/Path/Internal.hs" #-} + Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file" + ) + DocTest.printPrefix "System.Path.Internal:1242: " +{-# LINE 1242 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1242 "src/System/Path/Internal.hs" #-} + Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing) + ) + DocTest.printPrefix "System.Path.Internal:1243: " +{-# LINE 1243 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1243 "src/System/Path/Internal.hs" #-} + Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt") + ) + DocTest.printPrefix "System.Path.Internal:1259: " +{-# LINE 1259 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1259 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1260: " +{-# LINE 1260 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1260 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir" + ) + DocTest.printPrefix "System.Path.Internal:1261: " +{-# LINE 1261 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1261 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt" + ) + DocTest.printPrefix "System.Path.Internal:1262: " +{-# LINE 1262 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1262 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" + ) + DocTest.printPrefix "System.Path.Internal:1263: " +{-# LINE 1263 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1263 "src/System/Path/Internal.hs" #-} + Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" + ) + DocTest.printPrefix "System.Path.Internal:1290: " +{-# LINE 1290 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1290 "src/System/Path/Internal.hs" #-} + Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1291: " +{-# LINE 1291 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1291 "src/System/Path/Internal.hs" #-} + Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1292: " +{-# LINE 1292 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1292 "src/System/Path/Internal.hs" #-} + Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir" + ) + DocTest.printPrefix "System.Path.Internal:1293: " +{-# LINE 1293 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1293 "src/System/Path/Internal.hs" #-} + \base p -> Default.toString p `isSuffixOf` Path.toString (Path.makeAbsolute base (Path.idFile p)) + ) + DocTest.printPrefix "System.Path.Internal:1294: " +{-# LINE 1294 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1294 "src/System/Path/Internal.hs" #-} + \base p -> Default.toString base `isPrefixOf` Path.toString (Path.makeAbsolute base (Path.idFile p)) + ) + DocTest.printPrefix "System.Path.Internal:1316: " +{-# LINE 1316 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1316 "src/System/Path/Internal.hs" #-} + Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1317: " +{-# LINE 1317 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1317 "src/System/Path/Internal.hs" #-} + Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1318: " +{-# LINE 1318 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1318 "src/System/Path/Internal.hs" #-} + Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt" + ) + DocTest.printPrefix "System.Path.Internal:1403: " +{-# LINE 1403 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1403 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Posix.absFile "/fred") + ) + DocTest.printPrefix "System.Path.Internal:1404: " +{-# LINE 1404 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1404 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Windows.absFile "\\fred") + ) + DocTest.printPrefix "System.Path.Internal:1405: " +{-# LINE 1405 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1405 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Windows.absFile "c:\\fred") + ) + DocTest.printPrefix "System.Path.Internal:1406: " +{-# LINE 1406 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1406 "src/System/Path/Internal.hs" #-} + Path.isAbsolute (Windows.absFile "c:fred") + ) + DocTest.printPrefix "System.Path.Internal:1413: " +{-# LINE 1413 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1413 "src/System/Path/Internal.hs" #-} + Path.isRelative (Posix.relFile "fred") + ) + DocTest.printPrefix "System.Path.Internal:1414: " +{-# LINE 1414 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1414 "src/System/Path/Internal.hs" #-} + Path.isRelative (Windows.relFile "fred") + ) + DocTest.printPrefix "System.Path.Internal:1439: " +{-# LINE 1439 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1439 "src/System/Path/Internal.hs" #-} + forAllAbsRel $ \x -> null (Path.takeExtension x) == not (Path.hasAnExtension x) + ) + DocTest.printPrefix "System.Path.Internal:1445: " +{-# LINE 1445 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1445 "src/System/Path/Internal.hs" #-} + Path.hasExtension ".hs" (Posix.relFile "MyCode.hs") + ) + DocTest.printPrefix "System.Path.Internal:1446: " +{-# LINE 1446 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1446 "src/System/Path/Internal.hs" #-} + Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs") + ) + DocTest.printPrefix "System.Path.Internal:1447: " +{-# LINE 1447 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1447 "src/System/Path/Internal.hs" #-} + not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak") + ) + DocTest.printPrefix "System.Path.Internal:1457: " +{-# LINE 1457 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1457 "src/System/Path/Internal.hs" #-} + Posix.extSeparator == '.' + ) + DocTest.printPrefix "System.Path.Internal:1468: " +{-# LINE 1468 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1468 "src/System/Path/Internal.hs" #-} + \a -> Posix.isExtSeparator a == (a == Posix.extSeparator) + ) + DocTest.printPrefix "System.Path.Internal:1474: " +{-# LINE 1474 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1474 "src/System/Path/Internal.hs" #-} + \a -> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator) + ) + DocTest.printPrefix "System.Path.Internal:1490: " +{-# LINE 1490 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1490 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x" + ) + DocTest.printPrefix "System.Path.Internal:1491: " +{-# LINE 1491 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1491 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x" + ) + DocTest.printPrefix "System.Path.Internal:1492: " +{-# LINE 1492 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1492 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x" + ) + DocTest.printPrefix "System.Path.Internal:1493: " +{-# LINE 1493 "src/System/Path/Internal.hs" #-} + DocTest.property( +{-# LINE 1493 "src/System/Path/Internal.hs" #-} + Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile + ) diff --git a/test/TestResult.hs b/test/TestResult.hs deleted file mode 100644 --- a/test/TestResult.hs +++ /dev/null @@ -1,215 +0,0 @@ -{- Do not edit! Created from test/TestTemplate.hs -} -{-# LANGUAGE OverloadedStrings #-} -module TestResult (results) where - -import System.Path.Posix as Path -import Data.Char (toLower) - - -results :: Char -> Path.FilePath ar -> [(String, Bool)] -results a x = - ("pathMap (map toLower) \"/tmp/Reports/SpreadSheets\" == \"/tmp/reports/spreadsheets\"", - pathMap (map toLower) "/tmp/Reports/SpreadSheets" == "/tmp/reports/spreadsheets") : - ("show (rootDir \"bla\" \"blub\") == \"rootDir \\\"bla\\\" \\\"blub\\\"\"", - show (rootDir "bla" "blub") == "rootDir \"bla\" \"blub\"") : - ("show (Just (rootDir \"bla\" \"blub\")) == \"Just (rootDir \\\"bla\\\" \\\"blub\\\")\"", - show (Just (rootDir "bla" "blub")) == "Just (rootDir \"bla\" \"blub\")") : - ("show (currentDir \"bla\" \"blub\") == \"currentDir \\\"bla\\\" \\\"blub\\\"\"", - show (currentDir "bla" "blub") == "currentDir \"bla\" \"blub\"") : - ("show (Just (currentDir \"bla\" \"blub\")) == \"Just (currentDir \\\"bla\\\" \\\"blub\\\")\"", - show (Just (currentDir "bla" "blub")) == "Just (currentDir \"bla\" \"blub\")") : - ("read (show (rootDir \"bla\" \"blub\")) == rootDir \"bla\" \"blub\"", - read (show (rootDir "bla" "blub")) == rootDir "bla" "blub") : - ("read (show (Just (rootDir \"bla\" \"blub\"))) == Just (rootDir \"bla\" \"blub\")", - read (show (Just (rootDir "bla" "blub"))) == Just (rootDir "bla" "blub")) : - ("read (show (currentDir \"bla\" \"blub\")) == currentDir \"bla\" \"blub\"", - read (show (currentDir "bla" "blub")) == currentDir "bla" "blub") : - ("read (show (Just (currentDir \"bla\" \"blub\"))) == Just (currentDir \"bla\" \"blub\")", - read (show (Just (currentDir "bla" "blub"))) == Just (currentDir "bla" "blub")) : - ("asPath \"/tmp\" == \"/tmp\"", - asPath "/tmp" == "/tmp") : - ("asPath \"file.txt\" == \"file.txt\"", - asPath "file.txt" == "file.txt") : - ("isAbsolute (asPath \"/tmp\" :: AbsDir) == True", - isAbsolute (asPath "/tmp" :: AbsDir) == True) : - ("isAbsolute (asPath \"/tmp\" :: RelDir) == False", - isAbsolute (asPath "/tmp" :: RelDir) == False) : - ("getPathString (asPath \"/tmp\" :: AbsDir) == \"/tmp\"", - getPathString (asPath "/tmp" :: AbsDir) == "/tmp") : - ("getPathString (asPath \"/tmp\" :: RelDir) == \"tmp\"", - getPathString (asPath "/tmp" :: RelDir) == "tmp") : - ("getPathString (asRelFile \"file.txt\") == \"file.txt\"", - getPathString (asRelFile "file.txt") == "file.txt") : - ("getPathString (asRelFile \"/file.txt\") == \"file.txt\"", - getPathString (asRelFile "/file.txt") == "file.txt") : - ("getPathString (asRelFile \"tmp\") == \"tmp\"", - getPathString (asRelFile "tmp") == "tmp") : - ("getPathString (asRelFile \"/tmp\") == \"tmp\"", - getPathString (asRelFile "/tmp") == "tmp") : - ("getPathString (asRelDir \".\") == \".\"", - getPathString (asRelDir ".") == ".") : - ("getPathString (asRelDir \"file.txt\") == \"file.txt\"", - getPathString (asRelDir "file.txt") == "file.txt") : - ("getPathString (asRelDir \"/file.txt\") == \"file.txt\"", - getPathString (asRelDir "/file.txt") == "file.txt") : - ("getPathString (asRelDir \"tmp\") == \"tmp\"", - getPathString (asRelDir "tmp") == "tmp") : - ("getPathString (asRelDir \"/tmp\") == \"tmp\"", - getPathString (asRelDir "/tmp") == "tmp") : - ("getPathString (asAbsFile \"file.txt\") == \"/file.txt\"", - getPathString (asAbsFile "file.txt") == "/file.txt") : - ("getPathString (asAbsFile \"/file.txt\") == \"/file.txt\"", - getPathString (asAbsFile "/file.txt") == "/file.txt") : - ("getPathString (asAbsFile \"tmp\") == \"/tmp\"", - getPathString (asAbsFile "tmp") == "/tmp") : - ("getPathString (asAbsFile \"/tmp\") == \"/tmp\"", - getPathString (asAbsFile "/tmp") == "/tmp") : - ("getPathString (asAbsDir \"file.txt\") == \"/file.txt\"", - getPathString (asAbsDir "file.txt") == "/file.txt") : - ("getPathString (asAbsDir \"/file.txt\") == \"/file.txt\"", - getPathString (asAbsDir "/file.txt") == "/file.txt") : - ("getPathString (asAbsDir \"tmp\") == \"/tmp\"", - getPathString (asAbsDir "tmp") == "/tmp") : - ("getPathString (asAbsDir \"/tmp\") == \"/tmp\"", - getPathString (asAbsDir "/tmp") == "/tmp") : - ("mkPathAbsOrRel \"/tmp\" == Left (asAbsDir \"/tmp\")", - mkPathAbsOrRel "/tmp" == Left (asAbsDir "/tmp")) : - ("mkPathAbsOrRel \"tmp\" == Right (asRelDir \"tmp\")", - mkPathAbsOrRel "tmp" == Right (asRelDir "tmp")) : - ("mkAbsPath \"/tmp\" \"foo.txt\" == \"/tmp/foo.txt\"", - mkAbsPath "/tmp" "foo.txt" == "/tmp/foo.txt") : - ("mkAbsPath \"/tmp\" \"/etc/foo.txt\" == \"/etc/foo.txt\"", - mkAbsPath "/tmp" "/etc/foo.txt" == "/etc/foo.txt") : - ("addExtension \"file.txt\" \"bib\" == \"file.txt.bib\"", - addExtension "file.txt" "bib" == "file.txt.bib") : - ("addExtension \"file.\" \".bib\" == \"file..bib\"", - addExtension "file." ".bib" == "file..bib") : - ("addExtension \"file\" \".bib\" == \"file.bib\"", - addExtension "file" ".bib" == "file.bib") : - ("addExtension \"\" \"bib\" == \".bib\"", - addExtension "" "bib" == ".bib") : - ("addExtension \"\" \".bib\" == \".bib\"", - addExtension "" ".bib" == ".bib") : - ("takeFileName (addExtension \"\" \"ext\") == \".ext\"", - takeFileName (addExtension "" "ext") == ".ext") : - ("dropExtension x == fst (splitExtension x)", - dropExtension x == fst (splitExtension x)) : - ("not $ hasAnExtension (dropExtensions x)", - not $ hasAnExtension (dropExtensions x)) : - ("replaceExtension \"file.txt\" \".bob\" == \"file.bob\"", - replaceExtension "file.txt" ".bob" == "file.bob") : - ("replaceExtension \"file.txt\" \"bob\" == \"file.bob\"", - replaceExtension "file.txt" "bob" == "file.bob") : - ("replaceExtension \"file\" \".bob\" == \"file.bob\"", - replaceExtension "file" ".bob" == "file.bob") : - ("replaceExtension \"file.txt\" \"\" == \"file\"", - replaceExtension "file.txt" "" == "file") : - ("replaceExtension \"file.fred.bob\" \"txt\" == \"file.fred.txt\"", - replaceExtension "file.fred.bob" "txt" == "file.fred.txt") : - ("uncurry (<.>) (splitExtension x) == x", - uncurry (<.>) (splitExtension x) == x) : - ("uncurry addExtension (splitExtension x) == x", - uncurry addExtension (splitExtension x) == x) : - ("splitExtension \"file.txt\" == (\"file\",\".txt\")", - splitExtension "file.txt" == ("file",".txt")) : - ("splitExtension \"file\" == (\"file\",\"\")", - splitExtension "file" == ("file","")) : - ("splitExtension \"file/file.txt\" == (\"file/file\",\".txt\")", - splitExtension "file/file.txt" == ("file/file",".txt")) : - ("splitExtension \"file.txt/boris\" == (\"file.txt/boris\",\"\")", - splitExtension "file.txt/boris" == ("file.txt/boris","")) : - ("splitExtension \"file.txt/boris.ext\" == (\"file.txt/boris\",\".ext\")", - splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")) : - ("splitExtension \"file/path.txt.bob.fred\" == (\"file/path.txt.bob\",\".fred\")", - splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")) : - ("splitExtensions \"file.tar.gz\" == (\"file\",\".tar.gz\")", - splitExtensions "file.tar.gz" == ("file",".tar.gz")) : - ("takeBaseName \"/tmp/somedir/myfile.txt\" == \"myfile\"", - takeBaseName "/tmp/somedir/myfile.txt" == "myfile") : - ("takeBaseName \"./myfile.txt\" == \"myfile\"", - takeBaseName "./myfile.txt" == "myfile") : - ("takeBaseName \"myfile.txt\" == \"myfile\"", - takeBaseName "myfile.txt" == "myfile") : - ("takeExtension x == snd (splitExtension x)", - takeExtension x == snd (splitExtension x)) : - ("takeExtension (addExtension x \"ext\") == \".ext\"", - takeExtension (addExtension x "ext") == ".ext") : - ("takeExtension (replaceExtension x \"ext\") == \".ext\"", - takeExtension (replaceExtension x "ext") == ".ext") : - ("takeExtensions \"file.tar.gz\" == \".tar.gz\"", - takeExtensions "file.tar.gz" == ".tar.gz") : - ("takeFileName \"/tmp/somedir/myfile.txt\" == \"myfile.txt\"", - takeFileName "/tmp/somedir/myfile.txt" == "myfile.txt") : - ("takeFileName \"./myfile.txt\" == \"myfile.txt\"", - takeFileName "./myfile.txt" == "myfile.txt") : - ("takeFileName \"myfile.txt\" == \"myfile.txt\"", - takeFileName "myfile.txt" == "myfile.txt") : - ("equalFilePath \"/tmp/\" \"/tmp\" == True", - equalFilePath "/tmp/" "/tmp" == True) : - ("equalFilePath \"/tmp\" \"tmp\" == False", - equalFilePath "/tmp" "tmp" == False) : - ("joinPath [\"/tmp\",\"someDir\",\"file.txt\"] == \"/tmp/someDir/file.txt\"", - joinPath ["/tmp","someDir","file.txt"] == "/tmp/someDir/file.txt") : - ("joinPath [\"/tmp\",\"someDir\",\"file.txt\"] == asRelFile \"tmp/someDir/file.txt\"", - joinPath ["/tmp","someDir","file.txt"] == asRelFile "tmp/someDir/file.txt") : - ("normalise \"/tmp/fred/./jim/./file\" == \"/tmp/fred/jim/file\"", - normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file") : - ("splitPath (asAbsDir \"/tmp/someDir/mydir.dir\") == ([\"tmp\",\"someDir\",\"mydir.dir\"], Nothing)", - splitPath (asAbsDir "/tmp/someDir/mydir.dir") == (["tmp","someDir","mydir.dir"], Nothing)) : - ("splitPath (asAbsFile \"/tmp/someDir/myfile.txt\") == ([\"tmp\",\"someDir\"], Just \"myfile.txt\")", - splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"], Just "myfile.txt")) : - ("makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/file.txt\" == asRelFile \"anotherdir/file.txt\"", - makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == asRelFile "anotherdir/file.txt") : - ("makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/dir\" == asRelDir \"anotherdir/dir\"", - makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == asRelDir "anotherdir/dir") : - ("makeAbsolute \"/tmp\" \"file.txt\" == asAbsFile \"/tmp/file.txt\"", - makeAbsolute "/tmp" "file.txt" == asAbsFile "/tmp/file.txt") : - ("makeAbsolute \"/tmp\" \"adir/file.txt\" == asAbsFile \"/tmp/adir/file.txt\"", - makeAbsolute "/tmp" "adir/file.txt" == asAbsFile "/tmp/adir/file.txt") : - ("makeAbsolute \"/tmp\" \"adir/dir\" == asAbsDir \"/tmp/adir/dir\"", - makeAbsolute "/tmp" "adir/dir" == asAbsDir "/tmp/adir/dir") : - ("genericMakeAbsolute \"/tmp\" (asRelFile \"file.txt\") == \"/tmp/file.txt\"", - genericMakeAbsolute "/tmp" (asRelFile "file.txt") == "/tmp/file.txt") : - ("genericMakeAbsolute \"/tmp\" (asRelFile \"adir/file.txt\") == \"/tmp/adir/file.txt\"", - genericMakeAbsolute "/tmp" (asRelFile "adir/file.txt") == "/tmp/adir/file.txt") : - ("genericMakeAbsolute \"/tmp\" (asAbsFile \"adir/file.txt\") == \"/adir/file.txt\"", - genericMakeAbsolute "/tmp" (asAbsFile "adir/file.txt") == "/adir/file.txt") : - ("genericMakeAbsolute \"/tmp\" (asAbsFile \"/adir/file.txt\") == \"/adir/file.txt\"", - genericMakeAbsolute "/tmp" (asAbsFile "/adir/file.txt") == "/adir/file.txt") : - ("isAbsolute (asAbsFile \"fred\") == True", - isAbsolute (asAbsFile "fred") == True) : - ("isAbsolute (asRelFile \"fred\") == False", - isAbsolute (asRelFile "fred") == False) : - ("isAbsolute (asAbsFile \"/fred\") == True", - isAbsolute (asAbsFile "/fred") == True) : - ("isAbsolute (asRelFile \"/fred\") == False", - isAbsolute (asRelFile "/fred") == False) : - ("null (takeExtension x) == not (hasAnExtension x)", - null (takeExtension x) == not (hasAnExtension x)) : - ("hasExtension \".hs\" \"MyCode.hs\" == True", - hasExtension ".hs" "MyCode.hs" == True) : - ("hasExtension \".hs\" \"MyCode.hs.bak\" == False", - hasExtension ".hs" "MyCode.hs.bak" == False) : - ("hasExtension \".hs\" \"MyCode.bak.hs\" == True", - hasExtension ".hs" "MyCode.bak.hs" == True) : - ("extSeparator == '.'", - extSeparator == '.') : - ("isPathSeparator pathSeparator", - isPathSeparator pathSeparator) : - ("pathSeparator `elem` pathSeparators", - pathSeparator `elem` pathSeparators) : - ("isExtSeparator a == (a == extSeparator)", - isExtSeparator a == (a == extSeparator)) : - ("isPathSeparator a == (a `elem` pathSeparators)", - isPathSeparator a == (a `elem` pathSeparators)) : - ("isSearchPathSeparator a == (a == searchPathSeparator)", - isSearchPathSeparator a == (a == searchPathSeparator)) : - ("genericAddExtension \"/\" \"x\" == asAbsDir \"/.x\"", - genericAddExtension "/" "x" == asAbsDir "/.x") : - ("genericAddExtension \"/a\" \"x\" == asAbsDir \"/a.x\"", - genericAddExtension "/a" "x" == asAbsDir "/a.x") : - ("genericAddExtension \"\" \"x\" == asRelFile \".x\"", - genericAddExtension "" "x" == asRelFile ".x") : - ("genericAddExtension \"\" \"\" == asRelFile \"\"", - genericAddExtension "" "" == asRelFile "") : - [] diff --git a/test/TestTemplate.hs b/test/TestTemplate.hs deleted file mode 100644 --- a/test/TestTemplate.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module TestResult (results) where - -import System.Path.Posix as Path -import Data.Char (toLower) - - -results :: Char -> Path.FilePath ar -> [(String, Bool)] -results a x = - - [] diff --git a/tool/CreateTest.hs b/tool/CreateTest.hs deleted file mode 100644 --- a/tool/CreateTest.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Main where - -import Control.Applicative ((<$>)) -import Data.List (stripPrefix, isInfixOf) -import Data.Maybe (mapMaybe) - -import Text.Printf (printf) - - -srcfiles :: [String] -template, testModule, tok, testPrefix :: String - -srcfiles = - map ("src/System/Path/" ++) $ - ["Internal.hs", "Directory.hs", "IO.hs"] -template = "test/TestTemplate.hs" -testModule = "test/TestResult.hs" -tok = "" -testPrefix = "-- >> " - -main :: IO () -main = do - testLines <- - mapMaybe (stripPrefix testPrefix) . concatMap lines <$> mapM readFile srcfiles - (templateHead,_:templateTail) <- - break (tok `isInfixOf`) . lines <$> readFile template - let outLines = (\t -> printf " (%s,\n %s) :" (show t) t) <$> testLines - - writeFile testModule $ unlines $ - ("{- Do not edit! Created from " ++ template ++ " -}") : - templateHead ++ outLines ++ templateTail 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