pathtype (empty) → 0.0.1

raw patch · 4 files changed

+907/−0 lines, 4 filesdep +QuickCheckdep +basedep +directorysetup-changed

Dependencies added: QuickCheck, base, directory

Files

LICENSE +24/−0
Setup.hs +3/−0
System/Path.hs +830/−0
pathtype.cabal +50/−0

+ LICENSE view

@@ -0,0 +1,24 @@+Copyright (c) 2009, Ben Moseley+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.+    * Neither the name of Ben Moseley nor the+      names of its contributors may be used to endorse or promote products+      derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY BEN MOSELEY ''AS IS'' AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL BEN MOSELEY BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+

+ System/Path.hs view

@@ -0,0 +1,830 @@+{-# LANGUAGE EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types #-}++-- | This module provides type-safe access to filepath manipulations.+--+--   It is designed to be imported instead of 'System.FilePath' and+--   'System.Directory'. (It is intended to provide versions of+--   functions from those modules which have equivalent functionality+--   but are more typesafe).+--+--   The heart of this module is the @Path ar fd@ abstract type which+--   represents file and directory paths. The idea is that there are+--   two phantom type parameters - the first should be 'Abs' or 'Rel',+--   and the second 'File' or 'Dir'. A number of type synonyms are+--   provided for common types:+--+--   > type AbsFile    = Path Abs File+--   > type RelFile    = Path Rel File+--   > type AbsDir     = Path Abs Dir+--   > type RelDir     = Path Rel Dir+--   > type RelPath fd = Path Rel fd+--   > type DirPath ar = Path ar Dir+--+--   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.+--+--   The basic API (and properties satisfied) are heavily influenced+--   by Neil Mitchell's 'System.FilePath' module.+--+--+--   WARNING --- THE API IS NOT YET STABLE --- WARNING+--+--+-- Ben Moseley - (c) Jan 2009+--+module System.Path+(+  -- * 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,++  -- * Path to String conversion+  getPathString,++  -- * Constants+  rootDir,+  currentDir,++  -- * Unchecked Construction Functions+  mkPath,+  mkRelFile,+  mkRelDir,+  mkAbsFile,+  mkAbsDir,+  mkRelPath,+  mkAbsPath,+  mkFile,+  mkDir,++  -- * Checked Construction Functions+  mkPathAbsOrRel,+  mkPathFileOrDir,++  -- * 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,+  splitDirectories,+  splitPath,+  makeRelative,++  -- * Path Predicates+  isAbsolute,+  isAbsoluteString,+  isRelative,+  isRelativeString,+  hasExtension,++  -- * Separators+  addTrailingPathSeparator,+  dropTrailingPathSeparator,+  extSeparator,+  hasTrailingPathSeparator,+  pathSeparator,+  pathSeparators,+  searchPathSeparator,+  isExtSeparator,+  isPathSeparator,+  isSearchPathSeparator,++  -- * Flexible Manipulation Functions+  addFileOrDirExtension,+  dropFileOrDirExtension,+  dropFileOrDirExtensions,+  splitFileOrDirExtension,+  splitFileOrDirExtensions,+  takeFileOrDirExtension,+  takeFileOrDirExtensions,++  -- * System.Directory replacements+  getDirectoryContents,+  absDirectoryContents,+  relDirectoryContents+)++where++import Prelude hiding (FilePath)++import Control.Applicative+import Control.Arrow+import Data.List+import qualified System.Directory as SD++import System.IO hiding (FilePath)+import System.IO.Error+import Text.Printf+import Test.QuickCheck+++------------------------------------------------------------------------+-- Types++data Abs+data Rel+data File+data Dir++-- | This is the main filepath abstract datatype+data Path ar fd = PathRoot -- ^ Invariant - this should always have type :: DirPath ar+                | FileDir (DirPath ar) PathComponent+                  deriving (Eq, Ord)++newtype PathComponent = PathComponent { unPathComponent :: String } deriving (Eq,Ord)+instance Show PathComponent where showsPrec _ (PathComponent s) = showString s++pcMap :: (String -> String) -> PathComponent -> PathComponent+pcMap f (PathComponent s) = PathComponent (f s)++type AbsFile = Path Abs File+type RelFile = Path Rel File+type AbsDir  = Path Abs Dir+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+++------------------------------------------------------------------------+-- Type classes and machinery for switching on Abs/Rel and File/Dir++class AbsRelClass ar where+    absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a++instance AbsRelClass Abs where absRel f g = f+instance AbsRelClass Rel where absRel f g = g++class FileDirClass fd where+    fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a++instance FileDirClass File where fileDir f g = f+instance FileDirClass Dir  where fileDir f g = g+++pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd)+pathAbsRel = absRel Left Right+++------------------------------------------------------------------------+-- Read & Show instances++instance AbsRelClass ar => Show (Path ar fd) where+    showsPrec d x@PathRoot                = absRel (const $ showString pathSeparators)+                                                   (const $ showString ".") x+    -- we need the clause below so that we don't duplicate the pathSeparator after an abs+    -- root and we don't want to display a "./" prefix on relative paths+    showsPrec d x@(FileDir p@PathRoot pc) = absRel (const $ showString pathSeparators)+                                                   (const id)+                                                   p .+                                            showsPrec d pc+    showsPrec d x@(FileDir p pc)          = showsPrec d p . showString pathSeparators .+                                            showsPrec d pc++-- This instance consumes all remaining input. Would it be better to, say,+-- give up at newlines or some set of non-allowable chars?+instance AbsRelClass ar => Read (Path ar fd) where+    readsPrec _ s = [(mkPath s,"")]++-- | Convert the 'Path' into a plain 'String'. This is simply an+--   alias for 'show'.+getPathString :: AbsRelClass ar => Path ar fd -> String+getPathString = show++prop_mkPath_getPathString :: AbsFile -> Property+prop_mkPath_getPathString p = property $ p == mkPath (getPathString p)+++------------------------------------------------------------------------+-- Constants++rootDir :: AbsDir+rootDir = PathRoot++currentDir :: RelDir+currentDir = PathRoot+++------------------------------------------------------------------------+-- Unchecked Construction Functions+-- NB - these construction functions are pure and do no checking!!++-- | Convert a 'String' into a 'Path' whose type is determined+--   by its context.+mkPath :: String -> Path ar fd+mkPath = mkPathFromComponents . mkPathComponents++mkRelFile :: String -> RelFile+mkRelFile = mkPath++mkRelDir :: String -> RelDir+mkRelDir = mkPath++mkAbsFile :: String -> AbsFile+mkAbsFile = mkPath++mkAbsDir :: String -> AbsDir+mkAbsDir = mkPath++mkRelPath :: String -> RelPath fd+mkRelPath = mkPath++mkAbsPath :: String -> AbsPath fd+mkAbsPath = mkPath++mkFile :: String -> FilePath ar+mkFile = mkPath++mkDir :: String -> DirPath ar+mkDir = mkPath+++------------------------------------------------------------------------+-- Checked Construction Functions++-- | Examines the supplied string and constructs an absolute or+-- relative path as appropriate.+mkPathAbsOrRel :: String -> Either (AbsPath fd) (RelPath fd)+mkPathAbsOrRel s | isAbsoluteString s = Left (mkPath s)+                 | otherwise = Right (mkPath s)++-- | Searches for a file or directory with the supplied path string+--   and returns a 'File' or 'Dir' path as appropriate. If neither exists+--   at the supplied path, 'Nothing' is returned.+mkPathFileOrDir :: AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath ar)))+mkPathFileOrDir s = do+  isfile <- doesFileExist `onPathString` s+  isdir <- doesDirectoryExist `onPathString` s+  case (isfile, isdir) of+    (False, False) -> return Nothing+    (True,  False) -> return $ Just $ Left $ mkPath s+    (False, True ) -> return $ Just $ Right $ mkPath s+    (True,  True ) -> ioError $ userError "mkPathFileOrDir - internal inconsistency - file&dir"++-- | Lift a function which can operate on either Abs or Rel Path to one which+--   operates on Strings+onPathString :: (forall ar . AbsRelClass ar => Path ar fd -> a) -> String -> a+onPathString f = (f ||| f) . mkPathAbsOrRel++mkAbsFrom :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath fd+mkAbsFrom base p = absRel id (mkAbsFromRel base) p++mkAbsFromRel :: AbsDir -> RelPath fd -> AbsPath fd+mkAbsFromRel = (</>)++prop_mkAbsFromRel_endSame :: AbsDir -> RelFile -> Property+prop_mkAbsFromRel_endSame base p = property $ show p `isSuffixOf` show (mkAbsFrom base p)++prop_mkAbsFromRel_startSame :: AbsDir -> RelFile -> Property+prop_mkAbsFromRel_startSame base p = property $ show base `isPrefixOf` show (mkAbsFrom base p)++-- prop_mkAbsFromRel_startSameAbs :: AbsDir -> AbsFile -> Property+-- prop_mkAbsFromRel_startSameAbs base p = property $ show base `isPrefixOf` show (mkAbsFrom base p)+++------------------------------------------------------------------------+-- Internal Functions for PathComponent manipulation++mkPathFromComponents :: [PathComponent] -> Path ar fd+mkPathFromComponents []  = PathRoot+mkPathFromComponents pcs | (p:ps) <- reverse pcs = FileDir (foldr (flip FileDir) PathRoot ps) p++mkPathComponents :: String -> [PathComponent]+mkPathComponents xs =+    case break isPathSeparator (dropWhile isPathSeparator xs) of+      ("","")  -> []+      (s,rest) -> PathComponent s : mkPathComponents rest++pathComponents :: Path ar fd -> [PathComponent]+pathComponents PathRoot = []+pathComponents (FileDir p pc) = pathComponents p ++ [pc]++prop_mkPathFromComponents_pathComponents :: AbsFile -> Property+prop_mkPathFromComponents_pathComponents p = property $+                                               mkPathFromComponents (pathComponents p) == p++++------------------------------------------------------------------------+-- Basic Manipulation Functions++-- | Join an (absolute or relative) directory path with a relative+--   (file or directory) path to form a new path.+(</>) :: DirPath ar -> RelPath fd -> Path ar fd+PathRoot         </> PathRoot       = PathRoot+(FileDir dp dpc) </> PathRoot       = FileDir dp dpc+d                </> (FileDir p pc) = FileDir (d </> p) pc++-- | We only allow files (and not directories) to have extensions added+--   by this function. This is because it's the vastly common case and+--   an attempt to add one to a directory will - more often than not -+--   represent an error.+--   We don't however want to prevent the corresponding operation on+--   directories, and so we provide a function that is more flexible:+--   'addFileOrDirExtension'.+(<.>) :: FilePath ar -> String -> FilePath ar+(<.>) = addFileOrDirExtension++-- | Add an extension, even if there is already one there.+--   E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.+--+-- >> addExtension (mkFile "file.txt") "bib" == (mkFile "file.txt.bib")+-- >> addExtension (mkFile "file.") ".bib" == (mkFile "file..bib")+-- >> addExtension (mkFile "file") ".bib" == (mkFile "file.bib")+-- >> takeFileName (addExtension (mkFile "") "ext") == mkFile ".ext"+-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"+addExtension :: 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 $ hasExtension (dropExtensions x)+dropExtensions :: FilePath ar -> FilePath ar+dropExtensions = fst . splitExtensions++dropFileName :: Path ar fd -> DirPath ar+dropFileName = fst . splitFileName+++-- | Set the extension of a file, overwriting one if already present.+--+-- >> replaceExtension (mkFile "file.txt") ".bob" == (mkFile "file.bob")+-- >> replaceExtension (mkFile "file.txt") "bob" == (mkFile "file.bob")+-- >> replaceExtension (mkFile "file") ".bob" == (mkFile "file.bob")+-- >> replaceExtension (mkFile "file.txt") "" == (mkFile "file")+-- >> replaceExtension (mkFile "file.fred.bob") "txt" == (mkFile "file.fred.txt")+replaceExtension :: FilePath ar -> String -> FilePath ar+replaceExtension p ext = dropExtension p <.> ext++replaceBaseName :: Path ar fd -> String -> Path ar fd+replaceBaseName p bn = takeDirectory p </> (mkPath bn `addFileOrDirExtension` takeFileOrDirExtension p)++replaceDirectory :: Path ar1 fd -> DirPath ar2 -> Path ar2 fd+replaceDirectory p d = d </> takeFileName p++replaceFileName :: Path ar fd -> String -> Path ar fd+replaceFileName p fn = takeDirectory p </> mkPath fn+++-- | Split on the extension. 'addExtension' is the inverse.+--+-- >> uncurry (<.>) (splitExtension x) == x+-- >> uncurry addExtension (splitExtension x) == x+-- >> splitExtension (mkFile "file.txt") == (mkFile "file",".txt")+-- >> splitExtension (mkFile "file") == (mkFile "file","")+-- >> splitExtension (mkFile "file/file.txt") == (mkFile "file/file",".txt")+-- >> splitExtension (mkFile "file.txt/boris") == (mkFile "file.txt/boris","")+-- >> splitExtension (mkFile "file.txt/boris.ext") == (mkFile "file.txt/boris",".ext")+-- >> splitExtension (mkFile "file/path.txt.bob.fred") == (mkFile "file/path.txt.bob",".fred")+splitExtension :: FilePath ar -> (FilePath ar, String)+splitExtension = splitFileOrDirExtension++-- | Split on all extensions+--+-- >> splitExtensions (mkFile "file.tar.gz") == (mkFile "file",".tar.gz")+splitExtensions :: FilePath ar -> (FilePath ar, String)+splitExtensions = splitFileOrDirExtensions++prop_splitCombine :: AbsFile -> Property+prop_splitCombine p = property $ p == p2 <.> ext+                      where+                        (p2, ext) = splitExtension p++splitFileName :: Path ar fd -> (DirPath ar, RelPath fd)+splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc])++prop_split_combine :: AbsFile -> Property+prop_split_combine p = property $ uncurry combine (splitFileName p) == p+++takeBaseName :: Path ar fd -> RelPath fd+takeBaseName = takeFileName . dropFileOrDirExtension++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 (mkFile "file.tar.gz") == ".tar.gz"+takeExtensions :: FilePath ar -> String+takeExtensions = snd . splitExtensions++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++equalFilePath :: String -> String -> Bool+equalFilePath s1 s2 = mkPath s1 == mkPath s2++-- | Constructs a 'Path' from a list of components.+joinPath :: [String] -> Path ar fd+joinPath = mkPathFromComponents . map PathComponent++-- | Currently just transforms:+--+-- >> normalise (mkFile "/tmp/fred/./jim/./file") == mkFile "/tmp/fred/jim/file"+normalise :: Path ar fd -> Path ar fd+normalise = mkPathFromComponents . filter (/=(PathComponent ".")) . pathComponents++splitDirectories :: Path ar fd -> [String]+splitDirectories PathRoot = []+splitDirectories p = map unPathComponent . init . pathComponents $ p++splitPath :: Path ar fd -> [String]+splitPath = map unPathComponent . pathComponents++makeRelative :: AbsDir -> AbsPath fd -> RelPath fd+makeRelative relTo orig = maybe err mkPathFromComponents $ stripPrefix relToPC origPC+  where+    err     = error $ printf "System.Path can't make %s relative to %s" (show origPC) (show relToPC)+    relToPC = pathComponents relTo+    origPC  = pathComponents orig++------------------------------------------------------------------------+-- 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++isAbsolute :: AbsRelClass ar => Path ar fd -> Bool+isAbsolute = absRel (const True) (const False)++isAbsoluteString :: String -> Bool+isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators'+isAbsoluteString (x:_) = any (== x) pathSeparators -- Absolute if first char is a path separator++-- | Invariant - this should return True iff arg is of type @Path Rel _@+isRelative :: AbsRelClass ar => Path ar fd -> Bool+isRelative = not . isAbsolute++isRelativeString :: String -> Bool+isRelativeString = not . isAbsoluteString+++-- | Does the given filename have an extension?+--+-- >> null (takeExtension x) == not (hasExtension x)+hasExtension :: FilePath ar -> Bool+hasExtension = not . null . snd . splitExtension+++------------------------------------------------------------------------+-- 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.+--+-- > Windows: pathSeparator == '\\'+-- > Posix:   pathSeparator ==  '/'+-- >> isPathSeparator pathSeparator+pathSeparator :: Char+pathSeparator = '/'++-- | The list of all possible separators.+--+-- > Windows: pathSeparators == ['\\', '/']+-- > Posix:   pathSeparators == ['/']+-- >> pathSeparator `elem` pathSeparators+pathSeparators :: [Char]+pathSeparators = return pathSeparator++-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > Windows: searchPathSeparator == ';'+-- > Posix:   searchPathSeparator == ':'+searchPathSeparator :: Char+searchPathSeparator = ':'++-- | Is the character an extension character?+--+-- >> isExtSeparator a == (a == extSeparator)+isExtSeparator :: Char -> Bool+isExtSeparator = (== extSeparator)++-- | Rather than using @(== 'pathSeparator')@, use this. Test if something+--   is a path separator.+--+-- >> isPathSeparator a == (a `elem` pathSeparators)+isPathSeparator :: Char -> Bool+isPathSeparator = (== pathSeparator)++-- | Is the character a file separator?+--+-- >> isSearchPathSeparator a == (a == searchPathSeparator)+isSearchPathSeparator :: Char -> Bool+isSearchPathSeparator = (== searchPathSeparator)+++------------------------------------------------------------------------+-- Flexible 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+--+-- >> addFileOrDirExtension (mkFile "/") "x" == (mkFile "/.x")+addFileOrDirExtension :: Path ar fd -> String -> Path ar fd+addFileOrDirExtension p "" = p+addFileOrDirExtension (FileDir p (PathComponent pc)) ext = FileDir p (PathComponent (pc ++ suffix))+                                         where suffix | "." `isPrefixOf` ext = ext+                                                      | otherwise = "." ++ ext+addFileOrDirExtension PathRoot ext = FileDir PathRoot (PathComponent suffix)+                                         where suffix | "." `isPrefixOf` ext = ext+                                                      | otherwise = "." ++ ext++dropFileOrDirExtension :: Path ar fd -> Path ar fd+dropFileOrDirExtension = fst . splitFileOrDirExtension++dropFileOrDirExtensions :: Path ar fd -> Path ar fd+dropFileOrDirExtensions = fst . splitFileOrDirExtensions++splitFileOrDirExtension :: Path ar fd -> (Path ar fd, String)+splitFileOrDirExtension (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)+    where (s1,s2) = fixTrailingDot $ rbreak isExtSeparator s+          fixTrailingDot ("",r2) = (r2,"")+          fixTrailingDot (r1,r2) | [extSeparator] `isSuffixOf` r1 = (init r1, extSeparator:r2)+                                 | otherwise = (r1,r2)+          swap (x,y) = (y,x)+          rbreak p = (reverse *** reverse) . swap . break p . reverse+splitFileOrDirExtension p = (p,"")++splitFileOrDirExtensions :: Path ar fd -> (Path ar fd, String)+splitFileOrDirExtensions (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)+    where (s1,s2) = break isExtSeparator s+splitFileOrDirExtensions p = (p,"")++takeFileOrDirExtension :: Path ar fd -> String+takeFileOrDirExtension = snd . splitFileOrDirExtension++takeFileOrDirExtensions :: Path ar fd -> String+takeFileOrDirExtensions = snd . splitFileOrDirExtension+++------------------------------------------------------------------------+-- System.Directory replacements++doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool+doesFileExist = SD.doesFileExist . getPathString++doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool+doesDirectoryExist = SD.doesDirectoryExist . getPathString++getDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])+getDirectoryContents = absDirectoryContents++-- | Retrieve the contents of a directory path (which may be relative) as absolute paths+absDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])+absDirectoryContents p = do+  cd <- mkAbsDir <$> SD.getCurrentDirectory+  let dir = absRel id (cd </>) p+  (rds, rfs) <- relDirectoryContents dir+  return (map (dir </>) rds, map (dir </>) rfs)++-- | Returns paths relative /to/ the supplied (abs or relative) directory path.+--   eg (for current working directory of @\/somewhere\/cwd\/@):+--+-- > show (relDirectoryContents (mkRelDir "subDir1")) == (["subDir1A","subDir1B"],+-- >                                                      ["file1A","file1B"])+--+relDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile])+relDirectoryContents dir = do+  filenames <- filter (not . flip elem [".",".."]) <$> SD.getDirectoryContents (getPathString dir)+  dirFlags  <- mapM (doesDirectoryExist . (dir </>) . mkPath) filenames+  let fileinfo = zip filenames dirFlags+      (dirs, files) = partition snd fileinfo+  return (map (FileDir currentDir . PathComponent . fst) dirs,+          map (FileDir currentDir . PathComponent . fst) files)++filesInDir :: AbsRelClass ar => DirPath ar -> IO [RelFile]+filesInDir dir = snd <$> relDirectoryContents dir++dirsInDir :: AbsRelClass ar => DirPath ar -> IO [RelDir]+dirsInDir dir = fst <$> relDirectoryContents dir++createDirectory :: AbsRelClass ar => DirPath ar -> IO ()+createDirectory = SD.createDirectory . getPathString++createDirectoryIfMissing :: AbsRelClass ar => Bool -> DirPath ar -> IO ()+createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . getPathString++removeDirectory :: AbsRelClass ar => DirPath ar -> IO ()+removeDirectory = SD.removeDirectory . getPathString++removeDirectoryRecursive :: AbsRelClass ar => DirPath ar -> IO ()+removeDirectoryRecursive = SD.removeDirectoryRecursive . getPathString++getCurrentDirectory :: IO AbsDir+getCurrentDirectory = mkAbsDir <$> SD.getCurrentDirectory++setCurrentDirectory :: AbsRelClass ar => FilePath ar -> IO ()+setCurrentDirectory = SD.setCurrentDirectory . getPathString++getHomeDirectory :: IO AbsDir+getHomeDirectory = mkAbsDir <$> SD.getHomeDirectory++getUserDocumentsDirectory :: IO AbsDir+getUserDocumentsDirectory = mkAbsDir <$> SD.getUserDocumentsDirectory++getTemporaryDirectory :: IO AbsDir+getTemporaryDirectory = mkAbsDir <$> SD.getTemporaryDirectory++getAppUserDataDirectory :: String -> IO AbsDir+getAppUserDataDirectory user = mkAbsDir <$> SD.getAppUserDataDirectory user++copyFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()+copyFile p1 p2 = SD.copyFile (getPathString p1) (getPathString p2)++removeFile :: AbsRelClass ar => FilePath ar -> IO ()+removeFile = SD.removeFile . getPathString++renameFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()+renameFile p1 p2 = SD.renameFile (getPathString p1) (getPathString p2)++makeRelativeToCurrentDirectory :: AbsRelClass ar => Path ar fd -> IO (RelPath fd)+makeRelativeToCurrentDirectory p = mkPath <$> SD.makeRelativeToCurrentDirectory (getPathString p)++renameDirectory :: (AbsRelClass ar1, AbsRelClass ar2) => DirPath ar1 -> DirPath ar2 -> IO ()+renameDirectory p1 p2 = SD.renameDirectory (getPathString p1) (getPathString p2)++canonicalizePath :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd)+canonicalizePath p = mkPath <$> SD.canonicalizePath (getPathString p)++{-+findExecutable :: String -> IO (Maybe FilePath)+getPermissions :: FilePath -> IO Permissions+setPermissions :: FilePath -> Permissions -> IO ()+getModificationTime :: FilePath -> IO ClockTime+-}+++------------------------------------------------------------------------+-- QuickCheck++testall = do+  putStrLn "Running QuickCheck tests..."+  quickCheck prop_mkPathFromComponents_pathComponents+  quickCheck prop_mkAbsFromRel_endSame+  quickCheck prop_mkAbsFromRel_startSame+  quickCheck prop_split_combine+  quickCheck prop_takeFileName_end+  quickCheck prop_splitCombine+  putStrLn "Tests completed."++vectorOf :: Gen a -> Int -> Gen [a]+vectorOf gen n = sequence [ gen | i <- [1..n] ]++-- test :: Testable a => a -> IO ()+-- test = quickCheck++qcFileComponent :: Gen PathComponent+qcFileComponent = PathComponent <$> frequency [+                    (1, return "someFile"),+                    (1, return "fileWith.ext"),+                    (1, return "file.with.multiple.exts"),+                    (1, return "file with spcs")+                  ]++qcDirComponent :: Gen PathComponent+qcDirComponent = PathComponent <$> frequency [+                    (1, return "someDir"),+                    (1, return "aDir"),+                    (1, return "aFolder"),+                    (1, return "a folder"),+                    (1, return "directory")+                  ]++qcFilePath :: Gen (FilePath ar)+qcFilePath = do+  numDirs <- arbitrary+  pcs <- vectorOf qcDirComponent numDirs+  pc <- qcFileComponent+  return $ mkPathFromComponents (pcs ++ [pc])++qcDirPath :: Gen (DirPath ar)+qcDirPath = do+  numDirs <- arbitrary+  pcs <- vectorOf qcDirComponent numDirs+  pc <- qcDirComponent+  return $ mkPathFromComponents (pcs ++ [pc])++-- qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd)+-- qcPath = absRel++instance Arbitrary PathComponent where+    arbitrary = oneof [qcFileComponent, qcDirComponent]+    coarbitrary = error "No PathComponent coarbitrary"++instance Arbitrary (Path ar File) where+    arbitrary = qcFilePath+    coarbitrary = error "No (FilePath ar) coarbitrary"++instance Arbitrary (Path ar Dir)  where+    arbitrary = qcDirPath+    coarbitrary = error "No DirPath coarbitrary"++

+ pathtype.cabal view

@@ -0,0 +1,50 @@+Name:                pathtype+Version:             0.0.1+Synopsis:            Type-safe replacement for System.FilePath etc+Description:         This module provides type-safe access to filepath manipulations.+                     .+		     It is designed to be imported instead of 'System.FilePath' and+		     'System.Directory' and is intended to provide versions of+		     functions from those modules which have equivalent functionality+		     but are more typesafe.+                     .+		     The heart of this module is the @Path ar fd@ abstract type which+		     represents file and directory paths. The idea is that there are+		     two phantom type parameters - the first should be 'Abs' or 'Rel',+		     and the second 'File' or 'Dir'. A number of type synonyms are+		     provided for common types:+                     .+                     > type AbsFile    = Path Abs File+                     > type RelFile    = Path Rel File+                     > type AbsDir     = Path Abs Dir+                     > type RelDir     = Path Rel Dir+                     > type RelPath fd = Path Rel fd+                     > type DirPath ar = Path ar Dir+                     .+		     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.+                     .+		     The basic API (and properties satisfied) are heavily influenced+		     by Neil Mitchell's 'System.FilePath' module.+                     .+		     WARNING -- THE API IS NOT YET STABLE -- WARNING++Stability:           experimental+License:             BSD3+Category:            System+License-file:        LICENSE+Author:              Ben Moseley+Maintainer:          ben@moseley.name+Build-Type:          Simple+Cabal-Version:       >=1.2++Library+  Build-Depends:     base >= 3 && < 5, directory >= 1 && < 2, QuickCheck >= 1.2 && < 2+  Exposed-modules:+    System.Path+  Extensions:        EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types