module System.Path.Internal ( -- * The main filepath (& dirpath) abstract type Path, -- kept abstract -- * Possible types for Path type parameters Abs, Rel, AbsOrRel, File, Dir, FileOrDir, -- * Type Synonyms AbsFile, RelFile, AbsDir, RelDir, AbsOrRelFile, AbsOrRelDir, AbsFileOrDir, RelFileOrDir, AbsOrRelFileOrDir, AbsPath, RelPath, FilePath, DirPath, AbsOrRelPath, FileOrDirPath, -- * Classes AbsRelClass(..), AbsOrRelClass(..), absRel, FileOrDirClass(..), FileDirClass(..), fileDir, -- * Path to String conversion toString, getPathString, -- * Constants rootDir, currentDir, emptyFile, -- * Parsing Functions maybePath, parsePath, -- * Checked Construction Functions path, relFile, relDir, absFile, absDir, relPath, absPath, filePath, dirPath, idAbsOrRel, idAbs, idRel, idFileOrDir, idFile, idDir, -- * Unchecked Construction Functions asPath, asRelFile, asRelDir, asAbsFile, asAbsDir, asRelPath, asAbsPath, asFilePath, asDirPath, -- * Checked Construction Functions mkPathAbsOrRel, mkPathFileOrDir, mkAbsPath, mkAbsPathFromCwd, -- * Basic Manipulation Functions (), (<.>), (<++>), addExtension, combine, dropExtension, dropExtensions, dropFileName, replaceExtension, replaceBaseName, replaceDirectory, replaceFileName, splitExtension, splitExtensions, splitFileName, takeBaseName, takeDirectory, takeExtension, takeExtensions, takeFileName, mapFileName, -- * Auxillary Manipulation Functions equalFilePath, joinPath, normalise, splitPath, makeRelative, makeRelativeMaybe, makeAbsolute, makeAbsoluteFromCwd, dynamicMakeAbsolute, dynamicMakeAbsoluteFromCwd, genericMakeAbsolute, genericMakeAbsoluteFromCwd, pathMap, dirFromFile, fileFromDir, toFileOrDir, fromFileOrDir, fileFromFileOrDir, dirFromFileOrDir, -- * Path Predicates isAbsolute, isRelative, isAbsoluteString, isRelativeString, hasAnExtension, hasExtension, -- * Separators System(..), extSeparator, searchPathSeparator, isExtSeparator, isSearchPathSeparator, -- * Generic Manipulation Functions genericAddExtension, genericDropExtension, genericDropExtensions, genericSplitExtension, genericSplitExtensions, genericTakeExtension, genericTakeExtensions, -- * Tests testAll, isValid, ) where import qualified System.Directory as SD import qualified Control.Monad.Trans.Class as MT import qualified Control.Monad.Trans.State as MS import Control.Monad (MonadPlus, guard, liftM2, mplus, mzero) import Control.Applicative (Const(Const), liftA2, (<$>)) import Control.DeepSeq (NFData(rnf)) import qualified Data.Monoid.HT as MonHT import qualified Data.List.HT as ListHT import Data.Tagged (Tagged(Tagged), untag) import Data.Functor.Compose (Compose(Compose), getCompose) import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intersperse) import Data.String (IsString(fromString)) import Data.Maybe.HT (toMaybe) import Data.Maybe (fromMaybe, maybeToList) import Data.Tuple.HT (mapFst, mapSnd) import Data.Monoid (Monoid(mempty, mappend, mconcat), Endo(Endo), appEndo) import Data.Char (isSpace) import Data.Ord.HT (comparing) import Data.Eq.HT (equating) import Text.Show.HT (concatS) import Text.Printf (printf) import qualified Test.QuickCheck as QC import Test.QuickCheck (Gen, Property, property, Arbitrary(arbitrary), frequency) import Prelude hiding (FilePath) ------------------------------------------------------------------------ -- Types newtype Abs = Abs GenComponent data Rel = Rel data AbsOrRel = AbsO GenComponent | RelO absPC :: String -> Abs absPC = Abs . PathComponent newtype File = File GenComponent data Dir = Dir data FileOrDir = FileOrDir data Generic = Generic _osDummy :: Generic _osDummy = Generic -- | This is the main filepath abstract datatype data Path os ar fd = Path ar [PathComponent os] fd instance (System os, AbsOrRelClass ar, FileOrDirClass fd) => Eq (Path os ar fd) where (==) = equating inspectPath instance (System os, AbsOrRelClass ar, FileOrDirClass fd) => Ord (Path os ar fd) where compare = comparing inspectPath inspectPath :: Path os ar fd -> (WrapAbsRel os ar, [PathComponent os], WrapFileDir os fd) inspectPath (Path ar pcs fd) = (WrapAbsRel ar, pcs, WrapFileDir fd) newtype WrapAbsRel os ar = WrapAbsRel {unwrapAbsRel :: ar} instance (System os, AbsOrRelClass ar) => Eq (WrapAbsRel os ar) where (==) = equating inspectAbsRel instance (System os, AbsOrRelClass ar) => Ord (WrapAbsRel os ar) where compare = comparing inspectAbsRel inspectAbsRel :: (AbsOrRelClass ar) => WrapAbsRel os ar -> Either (PathComponent os) () inspectAbsRel = absRelPlain (Left . PathComponent) (Right ()) . unwrapAbsRel newtype WrapFileDir os fd = WrapFileDir {unwrapFileDir :: fd} instance (System os, FileOrDirClass fd) => Eq (WrapFileDir os fd) where (==) = equating inspectFileDir instance (System os, FileOrDirClass fd) => Ord (WrapFileDir os fd) where compare = comparing inspectFileDir inspectFileDir :: (FileOrDirClass ar) => WrapFileDir os ar -> Either (PathComponent os) () inspectFileDir = fileOrDirPlain (Left . retagPC) (Right ()) (Right ()) . unwrapFileDir {- | We cannot have a PathComponent without phantom types plus a Tagged wrapper, because we need specialised Eq and Ord instances. -} type GenComponent = PathComponent Generic newtype PathComponent os = PathComponent String instance (System os) => Eq (PathComponent os) where (==) = equating (applyComp canonicalize) instance (System os) => Ord (PathComponent os) where compare = comparing (applyComp canonicalize) applyComp :: Tagged os (String -> String) -> PathComponent os -> String applyComp (Tagged canon) (PathComponent pc) = canon pc retagPC :: GenComponent -> PathComponent os retagPC (PathComponent pc) = PathComponent pc untagPC :: PathComponent os -> GenComponent untagPC (PathComponent pc) = PathComponent pc selTag :: Path os ar fd -> Tagged os a -> a selTag _ = untag type AbsFile os = Path os Abs File type RelFile os = Path os Rel File type AbsDir os = Path os Abs Dir type RelDir os = Path os Rel Dir type AbsOrRelFile os = Path os AbsOrRel File type AbsOrRelDir os = Path os AbsOrRel Dir type AbsFileOrDir os = Path os Abs FileOrDir type RelFileOrDir os = Path os Rel FileOrDir type AbsOrRelFileOrDir os = Path os AbsOrRel FileOrDir type AbsPath os fd = Path os Abs fd type RelPath os fd = Path os Rel fd type FilePath os ar = Path os ar File type DirPath os ar = Path os ar Dir type AbsOrRelPath os fd = Path os AbsOrRel fd type FileOrDirPath os ar = Path os ar FileOrDir instance NFData (PathComponent os) where rnf (PathComponent pc) = rnf pc instance NFData Abs where rnf (Abs drive) = rnf drive instance NFData Rel where rnf Rel = () instance NFData File where rnf (File pc) = rnf pc instance NFData Dir where rnf Dir = () instance NFData FileOrDir where rnf FileOrDir = () instance (AbsOrRelClass ar, FileOrDirClass fd) => NFData (Path os ar fd) where rnf (Path ar pcs fd) = rnf (absRelPlain rnf () ar, pcs, fileOrDirPlain rnf () () fd) absRelPlain :: (AbsOrRelClass ar) => (String -> a) -> a -> ar -> a absRelPlain fAbs fRel = runFuncArg $ switchAbsOrRel (FuncArg $ \(Abs (PathComponent drive)) -> fAbs drive) (FuncArg $ \Rel -> fRel) (FuncArg $ \ar -> case ar of AbsO (PathComponent drive) -> fAbs drive RelO -> fRel) fileDirPlain :: (FileDirClass fd) => (GenComponent -> a) -> a -> fd -> a fileDirPlain fFile fDir = runFuncArg $ switchFileDir (FuncArg $ \(File pc) -> fFile pc) (FuncArg $ \Dir -> fDir) fileOrDirPlain :: (FileOrDirClass fd) => (GenComponent -> a) -> a -> a -> fd -> a fileOrDirPlain fFile fDir fFileOrDir = runFuncArg $ switchFileOrDir (FuncArg $ \(File pc) -> fFile pc) (FuncArg $ \Dir -> fDir) (FuncArg $ \FileOrDir -> fFileOrDir) newtype FuncArg b a = FuncArg {runFuncArg :: a -> b} -- I don't think this basic type of fold is appropriate for a nested datatype -- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a -- pathFold pr f PathRoot = pr -- pathFold pr f (FileDir d pc) = f (pathFold pr f d) (unPathComponent pc) -- | Map over the components of the path. -- -- >> Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets" pathMap :: (FileOrDirClass fd) => (String -> String) -> Path os ar fd -> Path os ar fd pathMap f (Path ar pcs fd) = Path ar (map (pcMap f) pcs) (fdMap f fd) fdMap :: (FileOrDirClass fd) => (String -> String) -> fd -> fd fdMap f = appEndo $ switchFileOrDir (Endo $ fileMap f) (Endo id) (Endo id) fileMap :: (String -> String) -> File -> File fileMap f (File pc) = File $ pcMap f pc pcMap :: (String -> String) -> PathComponent os -> PathComponent os pcMap f (PathComponent s) = PathComponent (f s) mapFilePart :: (GenComponent -> GenComponent) -> FilePath os ar -> FilePath os ar mapFilePart f (Path ar pcs (File fd)) = Path ar pcs $ File $ f fd splitFilePart :: (GenComponent -> (GenComponent, a)) -> FilePath os ar -> (FilePath os ar, a) splitFilePart f (Path ar pcs (File fd)) = mapFst (Path ar pcs . File) $ f fd mapPathDirs :: ([PathComponent os] -> [PathComponent os]) -> Path os ar fd -> Path os ar fd mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd ------------------------------------------------------------------------ -- Type classes and machinery for switching on Abs/Rel and File/Dir -- | This class provides a way to prevent other modules -- from making further 'AbsRelClass' or 'FileDirClass' -- instances class Private p instance Private Abs instance Private Rel instance Private AbsOrRel instance Private File instance Private Dir instance Private FileOrDir -- | This class allows selective behaviour for absolute and -- relative paths and is mostly for internal use. class Private ar => AbsOrRelClass ar where {- | See for the used technique. -} switchAbsOrRel :: f Abs -> f Rel -> f AbsOrRel -> f ar instance AbsOrRelClass Abs where switchAbsOrRel f _ _ = f instance AbsOrRelClass Rel where switchAbsOrRel _ f _ = f instance AbsOrRelClass AbsOrRel where switchAbsOrRel _ _ f = f class AbsOrRelClass ar => AbsRelClass ar where switchAbsRel :: f Abs -> f Rel -> f ar instance AbsRelClass Abs where switchAbsRel f _ = f instance AbsRelClass Rel where switchAbsRel _ f = f absRel :: (AbsOrRelClass ar) => (AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a absRel fAbs fRel (Path ar pcs fd) = absRelPlain (\drive -> fAbs $ Path (Abs (PathComponent drive)) pcs fd) (fRel $ Path Rel pcs fd) ar class AbsRelClass ar => IsAbs ar where switchAbs :: f Abs -> f ar instance IsAbs Abs where switchAbs = id class AbsRelClass ar => IsRel ar where switchRel :: f Rel -> f ar instance IsRel Rel where switchRel = id -- | This class allows selective behaviour for file and -- directory paths and is mostly for internal use. class Private fd => FileOrDirClass fd where switchFileOrDir :: f File -> f Dir -> f FileOrDir -> f fd instance FileOrDirClass File where switchFileOrDir f _ _ = f instance FileOrDirClass Dir where switchFileOrDir _ f _ = f instance FileOrDirClass FileOrDir where switchFileOrDir _ _ f = f switchFileOrDirPath :: (FileOrDirClass fd) => f (FilePath os ar) -> f (DirPath os ar) -> f (FileOrDirPath os ar) -> f (Path os ar fd) switchFileOrDirPath f d fd = getCompose $ switchFileOrDir (Compose f) (Compose d) (Compose fd) class FileOrDirClass fd => FileDirClass fd where switchFileDir :: f File -> f Dir -> f fd instance FileDirClass File where switchFileDir f _ = f instance FileDirClass Dir where switchFileDir _ f = f switchFileDirPath :: (FileDirClass fd) => f (FilePath os ar) -> f (DirPath os ar) -> f (Path os ar fd) switchFileDirPath f d = getCompose $ switchFileDir (Compose f) (Compose d) fileDir :: (FileDirClass fd) => (FilePath os ar -> a) -> (DirPath os ar -> a) -> Path os ar fd -> a fileDir f g = runFuncArg $ switchFileDirPath (FuncArg f) (FuncArg g) class FileDirClass fd => IsFile fd where switchFile :: f File -> f fd instance IsFile File where switchFile = id class FileDirClass fd => IsDir fd where switchDir :: f Dir -> f fd instance IsDir Dir where switchDir = id -- | Currently not exported _eitherFromAbsRel :: AbsOrRelClass ar => Path os ar fd -> Either (AbsPath os fd) (RelPath os fd) _eitherFromAbsRel = absRel Left Right -- | Currently not exported _eitherFromFileDir :: FileDirClass fd => Path os ar fd -> Either (FilePath os ar) (DirPath os ar) _eitherFromFileDir = fileDir Left Right ------------------------------------------------------------------------ -- Read & Show instances {- | We show and parse file path components using the rather generic 'relPath' smart constructor instead of 'relFile', 'relDir' and @relPath str :: FileOrDirPath ar@. Otherwise handling of all cases of 'File', 'Dir' and 'FileOrDir' types becomes pretty complicated. -} -- >> show (Posix.rootDir relDir "bla" relFile "blub") == "rootDir relPath \"bla\" relPath \"blub\"" -- >> show (Just (Posix.rootDir relDir "bla" relFile "blub")) == "Just (rootDir relPath \"bla\" relPath \"blub\")" -- >> show (Posix.currentDir relDir "bla" relFile "blub") == "currentDir relPath \"bla\" relPath \"blub\"" -- >> show (Just (Posix.currentDir relDir "bla" relFile "blub")) == "Just (currentDir relPath \"bla\" relPath \"blub\")" -- >> show (Windows.absDir "c:" relDir "bla" relFile "blub") == "absDir \"c:\" relPath \"bla\" relPath \"blub\"" -- >> show (Just (Windows.absDir "c:\\" relDir "bla" relFile "blub")) == "Just (absDir \"c:\\\\\" relPath \"bla\" relPath \"blub\")" instance (System os, AbsOrRelClass ar, FileOrDirClass fd) => Show (Path os ar fd) where showsPrec = untag showsPrecTagged showsPrecTagged :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Tagged os (Int -> Path os ar fd -> ShowS) showsPrecTagged = flip fmap rootStringTagged $ \root d x -> case pathComponents x of (ar, pcs) -> showParen (d>5) $ concatS $ intersperse (showChar ' ' . showString combineOperator . showChar ' ') $ absRelPlain (\drive -> if drive == root then showString rootName else showsCons absDirName drive) (showString currentName) ar : map (\(PathComponent pc) -> showsCons relPathName pc) pcs showsCons :: Show a => String -> a -> ShowS showsCons name arg = showString name . showChar ' ' . showsPrec 11 arg {- | Currently it also parses AbsOrRel and FileOrDir paths, although these cannot be composed with the accepted combinators. -} -- >> read "rootDir" == Posix.rootDir -- >> read "rootDir" == Windows.rootDir -- >> read "currentDir" == Posix.currentDir -- >> read "currentDir" == Windows.currentDir -- >> let path = Posix.rootDir relDir "bla" relFile "blub" in read (show path) == path -- >> let path = Just (Posix.rootDir relDir "bla" relFile "blub") in read (show path) == path -- >> let path = Posix.currentDir relDir "bla" relFile "blub" in read (show path) == path -- >> let path = Just (Posix.currentDir relDir "bla" relFile "blub") in read (show path) == path -- >> let path = Windows.rootDir relDir "bla" relFile "blub" in read (show path) == path -- >> let path = Just (Windows.rootDir relDir "bla" relFile "blub") in read (show path) == path -- >> let path = Windows.absDir "c:" relDir "bla" relFile "blub" in read (show path) == path instance (System os, AbsOrRelClass ar, FileOrDirClass fd) => Read (Path os ar fd) where readsPrec d = readParen (d>5) $ untag readsPrecTagged readsPrecTagged :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Tagged os (ReadS (Path os ar fd)) readsPrecTagged = flip fmap readsSplitDrive $ \readsSplDrv -> let go = handleMismatch (skipSpaces >> matchString combineOperator) (return []) (liftM2 (:) (fmap PathComponent $ readsCons relPathName) go) in MS.runStateT $ do skipSpaces MT.lift . maybeToList =<< liftM2 maybePathFromComponents readsSplDrv go skipSpaces :: (Monad m) => MS.StateT String m () skipSpaces = MS.modify $ dropWhile isSpace readsCons :: (Read a) => String -> MS.StateT String [] a readsCons name = do skipSpaces matchString name MS.StateT $ readsPrec 11 handleMismatch :: MS.StateT s Maybe () -> MS.StateT s m a -> MS.StateT s m a -> MS.StateT s m a handleMismatch act err success = MS.StateT $ \s0 -> case MS.execStateT act s0 of Nothing -> MS.runStateT err s0 Just s1 -> MS.runStateT success s1 matchString :: (MonadPlus m) => String -> MS.StateT String m () matchString prefix = MS.StateT $ maybe mzero (return . (,) ()) . stripPrefix prefix readsSplitDrive :: (System os, AbsOrRelClass ar) => Tagged os (MS.StateT String [] ar) readsSplitDrive = flip fmap readsSplitDriveAbs $ \readsSplDrvAbs -> switchAbsOrRel readsSplDrvAbs readsSplitDriveRel (mplus (fmap (\(Abs drive) -> AbsO drive) readsSplDrvAbs) (fmap (\Rel -> RelO) readsSplitDriveRel)) readsSplitDriveAbs :: (System os) => Tagged os (MS.StateT String [] Abs) readsSplitDriveAbs = flip fmap rootStringTagged $ \root -> fmap absPC $ (matchString rootName >> return root) `mplus` readsCons absDirName readsSplitDriveRel :: (MonadPlus m) => MS.StateT String m Rel readsSplitDriveRel = matchString currentName >> return Rel -- | Synonym of 'getPathString' intended for qualified use. toString :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> String toString = getPathString -- | Convert the 'Path' into a plain 'String' as required for OS calls. getPathString :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> String getPathString = flip getPathStringS "" getPathStringS :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> ShowS getPathStringS x = case pathComponents x of (ar, []) -> absRelPlain showString (showString currentDirComponent) ar (ar, pcs) -> concatS $ absRelPlain (\drive -> (showString drive :)) id ar $ intersperse (showChar (selTag x pathSeparator)) $ map (\(PathComponent pc) -> showString pc) pcs prop_asPath_getPathString :: (System os) => AbsFile os -> Property prop_asPath_getPathString p = property $ p == asPath (getPathString p) ------------------------------------------------------------------------ -- Constants -- >> Posix.toString Path.rootDir == "/" -- >> Windows.toString Path.rootDir == "\\" rootDir :: (System os) => AbsDir os rootDir = untag rootDirTagged rootDirTagged :: (System os) => Tagged os (AbsDir os) rootDirTagged = fmap (\root -> Path (absPC root) [] Dir) rootStringTagged rootStringTagged :: (System os) => Tagged os String rootStringTagged = fmap (\sep -> [sep]) pathSeparator -- >> Posix.toString Path.currentDir == "." -- >> Windows.toString Path.currentDir == "." currentDir :: (System os) => RelDir os currentDir = Path Rel [] Dir {- | This is a file with path @\"\"@. You will not be able to create a file with this name. We also forbid parsing @\"\"@ by 'relFile'. You might only need this file path as intermediate step when manipulating extensions of files like @\".bashrc\"@. -} emptyFile :: (System os) => RelFile os emptyFile = Path Rel [] $ File emptyPC emptyPC :: PathComponent os emptyPC = PathComponent "" rootName :: String rootName = "rootDir" currentName :: String currentName = "currentDir" currentDirComponent :: String currentDirComponent = "." absDirName :: String absDirName = "absDir" relPathName :: String relPathName = "relPath" ------------------------------------------------------------------------ -- Parsing Functions -- | This function is intended for checking and parsing paths -- provided as user input. -- -- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/" -- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp" -- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp" -- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp" -- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing -- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp" -- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp" -- >> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt" -- >> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing -- >> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp" -- >> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp" -- >> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp" -- >> fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\" -- >> fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:" -- >> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp" -- >> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing -- >> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing -- >> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing -- >> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing maybePath :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => String -> Maybe (Path os ar fd) maybePath str = do let (ar0, pcs0, fd0) = untag makePathComponents str ar <- case ar0 of AbsO pc -> switchAbsOrRel (Just $ Abs pc) Nothing (Just ar0) RelO -> switchAbsOrRel Nothing (Just Rel) (Just ar0) (pcs, fd) <- case fd0 of Left FileOrDir -> arrangeComponents pcs0 Right Dir -> fmap ((,) pcs0) $ switchFileOrDir Nothing (Just Dir) (Just FileOrDir) return $ Path ar pcs fd parsePath :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => String -> Either String (Path os ar fd) parsePath = pathWithNames arName fdName pathWithNames :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Const String ar -> Const String fd -> String -> Either String (Path os ar fd) pathWithNames (Const ar) (Const fd) str = maybe (Left (printf "\"%s\" is not a valid %s%spath" str ar fd)) Right $ maybePath str arName :: (AbsOrRelClass ar) => Const String ar arName = switchAbsOrRel (Const "absolute ") (Const "relative ") (Const "") fdName :: (FileOrDirClass fd) => Const String fd fdName = switchFileOrDir (Const "file ") (Const "directory ") (Const "") ------------------------------------------------------------------------ -- Checked Construction Functions -- | This function is intended for converting path strings -- with known content, e.g. string literals, to the 'Path' type. path :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => String -> Path os ar fd path = either error id . parsePath -- | Construct a 'RelFile' from a 'String'. -- -- >> Posix.toString (Posix.relFile "file.txt") == "file.txt" -- >> Posix.toString (Posix.relFile "tmp") == "tmp" relFile :: (System os) => String -> RelFile os relFile = path -- | Construct a 'RelDir' from a 'String'. -- -- >> Posix.toString (Posix.relDir ".") == "." -- >> Posix.toString (Posix.relDir "file.txt") == "file.txt" -- >> Posix.toString (Posix.relDir "tmp") == "tmp" relDir :: (System os) => String -> RelDir os relDir = path -- | Construct an 'AbsFile' from a 'String'. -- -- >> Posix.toString (Posix.absFile "/file.txt") == "/file.txt" -- >> Posix.toString (Posix.absFile "/tmp") == "/tmp" absFile :: (System os) => String -> AbsFile os absFile = path -- | Construct an 'AbsDir' from a 'String'. -- -- >> Posix.toString (Posix.absDir "/file.txt") == "/file.txt" -- >> Posix.toString (Posix.absDir "/tmp") == "/tmp" absDir :: (System os) => String -> AbsDir os absDir = path -- | Construct a 'RelPath fd' from a 'String'. relPath :: (System os, FileOrDirClass fd) => String -> RelPath os fd relPath = path -- | Construct an 'AbsPath fd' from a 'String'. absPath :: (System os, FileOrDirClass fd) => String -> AbsPath os fd absPath = path -- | Construct a 'FilePath ar' from a 'String'. filePath :: (System os, AbsOrRelClass ar) => String -> FilePath os ar filePath = path -- | Construct a 'DirPath ar' from a 'String'. dirPath :: (System os, AbsOrRelClass ar) => String -> DirPath os ar dirPath = path idAbsOrRel :: AbsOrRelPath os fd -> AbsOrRelPath os fd idAbsOrRel = id idAbs :: AbsPath os fd -> AbsPath os fd idAbs = id idRel :: RelPath os fd -> RelPath os fd idRel = id idFileOrDir :: FileOrDirPath os fd -> FileOrDirPath os fd idFileOrDir = id idFile :: FilePath os fd -> FilePath os fd idFile = id idDir :: DirPath os fd -> DirPath os fd idDir = id {-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-} {-# DEPRECATED asRelFile "Use 'relFile' instead." #-} {-# DEPRECATED asRelDir "Use 'relDir' instead." #-} {-# DEPRECATED asAbsFile "Use 'absFile' instead." #-} {-# DEPRECATED asAbsDir "Use 'absDir' instead." #-} {-# DEPRECATED asRelPath "Use 'relPath' instead." #-} {-# DEPRECATED asAbsPath "Use 'absPath' instead." #-} {-# DEPRECATED asFilePath "Use 'filePath' instead." #-} {-# DEPRECATED asDirPath "Use 'dirPath' instead." #-} ------------------------------------------------------------------------ -- Unchecked Construction Functions -- NB - these construction functions are non-IO and do no checking!! -- | Use a 'String' as a 'Path' whose type is determined by its context. -- You should not use this and other @as*@ functions, -- since they may silently turn a relative path to an absolute one, -- or vice versa, or they may accept a path as file path -- although it ends on a slash. -- If you are certain about the string content -- then you should use 'path'. -- If you got the string as user input then use 'maybePath' or 'parsePath'. -- -- >> Posix.asPath "/tmp" == Posix.absDir "/tmp" -- >> Posix.asPath "file.txt" == Posix.relFile "file.txt" -- >> Path.isAbsolute (Posix.asAbsDir "/tmp") -- >> Path.isRelative (Posix.asRelDir "/tmp") -- >> Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp" -- >> Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp" -- >> Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp" -- >> Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp" -- >> Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp" -- >> Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp" asPath :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => String -> Path os ar fd asPath = uncurry mkPathFromComponents . untag mkPathComponents -- | Use a 'String' as a 'RelFile'. No checking is done. -- -- >> Posix.toString (Posix.asRelFile "file.txt") == "file.txt" -- >> Posix.toString (Posix.asRelFile "/file.txt") == "file.txt" -- >> Posix.toString (Posix.asRelFile "tmp") == "tmp" -- >> Posix.toString (Posix.asRelFile "/tmp") == "tmp" asRelFile :: (System os) => String -> RelFile os asRelFile = asPath -- | Use a 'String' as a 'RelDir'. No checking is done. -- -- >> Posix.toString (Posix.asRelDir ".") == "." -- >> Posix.toString (Posix.asRelDir "file.txt") == "file.txt" -- >> Posix.toString (Posix.asRelDir "/file.txt") == "file.txt" -- >> Posix.toString (Posix.asRelDir "tmp") == "tmp" -- >> Posix.toString (Posix.asRelDir "/tmp") == "tmp" asRelDir :: (System os) => String -> RelDir os asRelDir = asPath -- | Use a 'String' as an 'AbsFile'. No checking is done. -- -- >> Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt" -- >> Posix.toString (Posix.asAbsFile "/tmp") == "/tmp" asAbsFile :: (System os) => String -> AbsFile os asAbsFile = asPath -- | Use a 'String' as an 'AbsDir'. No checking is done. -- -- >> Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt" -- >> Posix.toString (Posix.asAbsDir "/tmp") == "/tmp" asAbsDir :: (System os) => String -> AbsDir os asAbsDir = asPath -- | Use a 'String' as a 'RelPath fd'. No checking is done. asRelPath :: (System os, FileOrDirClass fd) => String -> RelPath os fd asRelPath = asPath -- | Use a 'String' as an 'AbsPath fd'. No checking is done. asAbsPath :: (System os, FileOrDirClass fd) => String -> AbsPath os fd asAbsPath = asPath -- | Use a 'String' as a 'FilePath ar'. No checking is done. asFilePath :: (System os, AbsOrRelClass ar) => String -> FilePath os ar asFilePath = asPath -- | Use a 'String' as a 'DirPath ar'. No checking is done. asDirPath :: (System os, AbsOrRelClass ar) => String -> DirPath os ar asDirPath = asPath -- | Forbid use of OverloadedStrings and prevent custom orphan instances instance (ForbiddenSystem os, ForbiddenAbsRel ar, ForbiddenFileDir fd) => IsString (Path os ar fd) where fromString = forbiddenFromString class System os => ForbiddenSystem os where forbiddenFromString :: String -> Path os ar fd class AbsRelClass ar => ForbiddenAbsRel ar where class FileDirClass fd => ForbiddenFileDir fd where ------------------------------------------------------------------------ -- Checked Construction Functions -- | Examines the supplied string and constructs an absolute or -- relative path as appropriate. -- -- >> Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp") -- >> Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp") -- >> Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp") -- >> Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp") -- >> Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp") -- >> Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp") mkPathAbsOrRel :: (System os, FileOrDirClass fd) => String -> Either (AbsPath os fd) (RelPath os fd) mkPathAbsOrRel = eitherAbsOrRel . asPath eitherAbsOrRel :: AbsOrRelPath os fd -> Either (AbsPath os fd) (RelPath os fd) eitherAbsOrRel (Path ar pcs fd) = case ar of AbsO drive -> Left $ Path (Abs drive) pcs fd RelO -> Right $ Path Rel pcs fd -- | Searches for a file or directory with the supplied path string -- and returns a 'File' or 'Dir' path as appropriate. If neither exists -- at the supplied path, 'Nothing' is returned. mkPathFileOrDir :: (System os, AbsOrRelClass ar) => String -> IO (Maybe (Either (FilePath os ar) (DirPath os ar))) mkPathFileOrDir s = do isfile <- SD.doesFileExist s isdir <- SD.doesDirectoryExist s case (isfile, isdir) of (False, False) -> return Nothing (True, False) -> return $ Just $ Left $ asPath s (False, True ) -> return $ Just $ Right $ asPath s (True, True ) -> ioError $ userError "mkPathFileOrDir - object type changed while checking" -- | Convert a 'String' into an 'AbsPath' by interpreting it as -- relative to the supplied directory if necessary. -- -- >> Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt" -- >> Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt" mkAbsPath :: (System os, FileOrDirClass fd) => AbsDir os -> String -> AbsPath os fd mkAbsPath d = either id (makeAbsolute d) . mkPathAbsOrRel -- | Convert a 'String' into an 'AbsPath' by interpreting it as -- relative to the cwd if necessary. mkAbsPathFromCwd :: (System os, FileOrDirClass fd) => String -> IO (AbsPath os fd) mkAbsPathFromCwd = either return makeAbsoluteFromCwd . mkPathAbsOrRel ------------------------------------------------------------------------ -- Internal Functions for GenComponent manipulation mkPathFromComponents :: (FileOrDirClass fd) => ar -> [PathComponent os] -> Path os ar fd mkPathFromComponents ar pcs = uncurry (Path ar) $ switchFileOrDir (mapSnd File $ ListHT.switchR ([], emptyPC) (curry $ mapSnd untagPC) pcs) (pcs, Dir) (pcs, FileOrDir) maybePathFromComponents :: (FileOrDirClass fd) => ar -> [PathComponent os] -> Maybe (Path os ar fd) maybePathFromComponents ar pcs = fmap (uncurry $ Path ar) $ arrangeComponents pcs arrangeComponents :: (FileOrDirClass fd) => [PathComponent os] -> Maybe ([PathComponent os], fd) arrangeComponents pcs = getCompose $ switchFileOrDir (Compose $ fmap (mapSnd (File . untagPC)) $ ListHT.viewR pcs) (Compose $ Just (pcs, Dir)) (Compose $ Just (pcs, FileOrDir)) mkPathComponents :: (System os, AbsOrRelClass ar) => Tagged os (String -> (ar, [PathComponent os])) mkPathComponents = liftA2 (\isSep splDriveOS -> mapSnd (nonEmptyComponents . ListHT.chop isSep) . MS.runState splDriveOS) isPathSeparator splitDriveOS {- | Parse path string independent from expectations expressed by the type parameters. -} makePathComponents :: (System os) => Tagged os (String -> (AbsOrRel, [PathComponent os], Either FileOrDir Dir)) makePathComponents = liftA2 (\isSep splAbsolute str -> let (ar, pct) = mapSnd (ListHT.chop isSep) $ MS.runState splAbsolute str (pcs1, fd) = case ListHT.viewR pct of Nothing -> ([], Right Dir) Just (pcs, pc) -> if null pc -- caused by trailing slash then (pcs, Right Dir) else (pct, Left FileOrDir) in (ar, nonEmptyComponents pcs1, fd)) isPathSeparator splitAbsoluteO nonEmptyComponents :: [String] -> [PathComponent os] nonEmptyComponents = map PathComponent . filter (not . null) splitDriveOS :: (System os, AbsOrRelClass ar) => Tagged os (MS.State String ar) splitDriveOS = liftA2 (\splDrive splAbsolute -> switchAbsOrRel (fmap absPC splDrive) (return Rel) splAbsolute) splitDriveAbs splitAbsoluteO splitDriveAbs :: (System os) => Tagged os (MS.State String String) splitDriveAbs = liftA2 (\isSep splDrive -> do drive <- splDrive xt <- MS.get case xt of [] -> return drive x:xs -> if isSep x then MS.put xs >> return (drive++[x]) else return drive) isPathSeparator splitDrive splitAbsoluteO :: (System os) => Tagged os (MS.State String AbsOrRel) splitAbsoluteO = fmap (\drive -> if null drive then RelO else AbsO $ PathComponent drive) <$> splitAbsolute pathComponents :: (FileOrDirClass fd) => Path os ar fd -> (ar, [PathComponent os]) pathComponents (Path ar pcs fd) = (ar, pcs ++ fileOrDirPlain ((:[]) . retagPC) [] [] fd) prop_mkPathFromComponents_pathComponents :: (System os) => AbsDir os -> Property prop_mkPathFromComponents_pathComponents p = property $ uncurry mkPathFromComponents (pathComponents p) == p ------------------------------------------------------------------------ -- Basic Manipulation Functions combineOperator :: String combineOperator = "" instance (IsRel ar, IsDir fd) => Monoid (Path os ar fd) where mempty = Path relVar [] dirVar mappend (Path rel pcs0 _dir) (Path _rel pcs1 dir) = Path rel (pcs0 ++ pcs1) dir mconcat paths = Path relVar (concatMap (\(Path _rel pcs _dir) -> pcs) paths) dirVar relVar :: IsRel ar => ar relVar = unwrapAbsRel $ switchRel $ WrapAbsRel Rel dirVar :: IsDir fd => fd dirVar = unwrapFileDir $ switchDir $ WrapFileDir Dir -- | Infix variant of 'combine'. -- -- >> Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt" -- >> Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt" -- >> Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt" -- >> Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt" -- >> Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" -- >> Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" -- >> Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt" -- >> Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt" -- >> Windows.toString (Windows.relDir "dir" Windows.relFile "file.txt") == "dir\\file.txt" () :: DirPath os ar -> RelPath os fd -> Path os ar fd Path ar pcs0 Dir Path Rel pcs1 fd = Path ar (pcs0 ++ pcs1) fd infixr 5 -- | Infix variant of 'addExtension'. -- We only allow files (and not directories) to have extensions added -- by this function. This is because it's the vastly common case and -- an attempt to add one to a directory will - more often than not - -- represent an error. -- We don't however want to prevent the corresponding operation on -- directories, and so we provide a function that is more flexible: -- 'genericAddExtension'. (<.>) :: FilePath os ar -> String -> FilePath os ar p <.> ext = mapFilePart (flip addExtensionPC ext) p infixl 7 <.> (<++>) :: FilePath os ar -> String -> FilePath os ar p <++> str = mapFileName (++str) p infixl 7 <++> -- | Add an extension, even if there is already one there. -- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@. -- -- >> Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib" -- >> Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib" -- >> Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib" -- >> Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib" -- >> Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib" -- >> Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext" addExtension :: FilePath os ar -> String -> FilePath os ar addExtension = (<.>) -- | Join an (absolute or relative) directory path with a relative -- (file or directory) path to form a new path. combine :: DirPath os ar -> RelPath os fd -> Path os ar fd combine = () prop_combine_currentDir :: (System os) => RelDir os -> Property prop_combine_currentDir p = property $ combine currentDir p == p -- | Remove last extension, and the \".\" preceding it. -- -- >> Path.dropExtension x == fst (Path.splitExtension x) dropExtension :: FilePath os ar -> FilePath os ar dropExtension = fst . splitExtension -- | Drop all extensions -- -- >> not $ Path.hasAnExtension (Path.dropExtensions x) dropExtensions :: FilePath os ar -> FilePath os ar dropExtensions = fst . splitExtensions -- | Synonym for 'takeDirectory' dropFileName :: FilePath os ar -> DirPath os ar dropFileName = fst . splitFileName -- | Set the extension of a file, overwriting one if already present. -- -- >> Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob" -- >> Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob" -- >> Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob" -- >> Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file" -- >> Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt" replaceExtension :: FilePath os ar -> String -> FilePath os ar replaceExtension p ext = dropExtension p <.> ext replaceBaseName :: FilePath os ar -> String -> FilePath os ar replaceBaseName p bn = mapFilePart (addExtensionPC (PathComponent bn) . snd . splitExtensionPC) p replaceDirectory :: FilePath os ar1 -> DirPath os ar2 -> FilePath os ar2 replaceDirectory (Path _ _ fd) (Path ar pcs _) = Path ar pcs fd replaceFileName :: FilePath os ar -> String -> FilePath os ar replaceFileName p fn = mapFilePart (const (PathComponent fn)) p -- | Split on the extension. 'addExtension' is the inverse. -- -- >> uncurry (<.>) (Path.splitExtension x) == x -- >> uncurry Path.addExtension (Path.splitExtension x) == x -- >> Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt") -- >> Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc") -- >> Path.splitExtension (relFile "file") == (Posix.relFile "file","") -- >> Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt") -- >> Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","") -- >> Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext") -- >> Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred") splitExtension :: FilePath os ar -> (FilePath os ar, String) splitExtension = splitFilePart splitExtensionPC -- | Split on all extensions -- -- >> Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz") splitExtensions :: FilePath os ar -> (FilePath os ar, String) splitExtensions = splitFilePart splitExtensionsPC prop_split_combineExt :: (System os) => AbsFile os -> Property prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p) splitFileName :: FilePath os ar -> (DirPath os ar, RelFile os) splitFileName (Path ar pcs fd) = (Path ar pcs Dir, Path Rel [] fd) prop_split_combine :: (System os) => AbsFile os -> Property prop_split_combine p = property $ uncurry combine (splitFileName p) == p -- | Get the basename of a file -- -- >> Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile" -- >> Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile" -- >> Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile" takeBaseName :: FilePath os ar -> RelFile os takeBaseName = takeFileName . dropExtension takeDirectory :: FilePath os ar -> DirPath os ar takeDirectory = fst . splitFileName -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. -- -- >> Path.takeExtension x == snd (Path.splitExtension x) -- >> Path.takeExtension (Path.addExtension x "ext") == ".ext" -- >> Path.takeExtension (Path.replaceExtension x "ext") == ".ext" takeExtension :: FilePath os ar -> String takeExtension = snd . splitExtension -- | Get all extensions -- -- >> Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz" takeExtensions :: FilePath os ar -> String takeExtensions = snd . splitExtensions -- | Get the filename component of a file path (ie stripping all parent dirs) -- -- >> Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt" -- >> Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt" -- >> Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt" takeFileName :: FilePath os ar -> RelFile os takeFileName (Path _ _ fd) = Path Rel [] fd prop_takeFileName_end :: (System os) => AbsFile os -> Property prop_takeFileName_end p = property $ getPathString (takeFileName p) `isSuffixOf` getPathString p mapFileName :: (String -> String) -> FilePath os ar -> FilePath os ar mapFileName = mapFilePart . pcMap ------------------------------------------------------------------------ -- Auxillary Manipulation Functions -- | Check whether two strings are equal as file paths. -- -- >> Posix.equalFilePath "abc/def" "abc/def" -- >> Posix.equalFilePath "abc/def" "abc//def" -- >> Posix.equalFilePath "/tmp/" "/tmp" -- >> Posix.equalFilePath "/tmp" "//tmp" -- >> Posix.equalFilePath "/tmp" "///tmp" -- >> not $ Posix.equalFilePath "abc" "def" -- >> not $ Posix.equalFilePath "/tmp" "tmp" -- >> Windows.equalFilePath "abc\\def" "abc\\def" -- >> Windows.equalFilePath "abc\\def" "abc\\\\def" -- >> Windows.equalFilePath "file" "File" -- >> Windows.equalFilePath "\\file" "\\\\file" -- >> Windows.equalFilePath "\\file" "\\\\\\file" -- >> not $ Windows.equalFilePath "abc" "def" -- >> not $ Windows.equalFilePath "file" "dir" equalFilePath :: (System os) => Tagged os (String -> String -> Bool) equalFilePath = equating <$> mkPathAbsOrRelTagged mkPathAbsOrRelTagged :: (System os) => Tagged os (String -> Either (AbsFileOrDir os) (RelFileOrDir os)) mkPathAbsOrRelTagged = Tagged mkPathAbsOrRel -- | Constructs a 'RelPath' from a list of components. -- It is an unchecked error if the path components contain path separators. -- It is an unchecked error if a 'RelFile' path is empty. -- -- >> Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir" -- >> Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt" joinPath :: (FileOrDirClass fd) => [String] -> RelPath os fd joinPath = mkPathFromComponents Rel . map PathComponent -- | Currently just transforms: -- -- >> Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file" normalise :: (System os) => Path os ar fd -> Path os ar fd normalise = mapPathDirs (filter (PathComponent currentDirComponent /=)) -- | Deconstructs a path into its components. -- -- >> Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing) -- >> Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt") splitPath :: (AbsOrRelClass ar, FileDirClass fd) => Path os ar fd -> (Bool, [RelDir os], Maybe (RelFile os)) splitPath (Path ar pcs fd) = (isAbsolutePlain ar, map (\pc -> Path Rel [pc] Dir) pcs, maybeFileDir fd) isAbsolutePlain :: (AbsOrRelClass ar) => ar -> Bool isAbsolutePlain = absRelPlain (const True) False maybeFileDir :: (FileDirClass fd) => fd -> Maybe (RelFile os) maybeFileDir = fileDirPlain (Just . Path Rel [] . File) Nothing -- | This function can be used to construct a relative path by removing -- the supplied 'AbsDir' from the front. It is a runtime 'error' if the -- supplied 'AbsPath' doesn't start with the 'AbsDir'. -- -- >> Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt" -- >> Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir" -- >> Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt" -- >> Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" -- >> Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir" makeRelative :: (System os, FileOrDirClass fd) => AbsDir os -> AbsPath os fd -> RelPath os fd makeRelative relTo orig = fromMaybe (error $ printf "System.Path can't make (%s) relative to (%s)" (getPathString orig) (getPathString relTo)) $ makeRelativeMaybe relTo orig -- >> Path.makeRelativeMaybe (Posix.absDir "/tmp/somedir") (absFile "/tmp/anotherdir/file.txt") == Nothing -- >> Path.makeRelativeMaybe (Posix.absDir "/Tmp") (absFile "/tmp/anotherdir/file.txt") == Nothing -- >> Path.makeRelativeMaybe (Windows.absDir "\\Tmp") (absFile "\\tmp\\anotherdir\\file.txt") == Just (relFile "anotherdir\\file.txt") makeRelativeMaybe :: (System os, FileOrDirClass fd) => AbsDir os -> AbsPath os fd -> Maybe (RelPath os fd) makeRelativeMaybe relTo orig = case (inspectPath relTo, inspectPath orig) of ((relToAR, relToPCs, WrapFileDir Dir), (origAR, origPCs, WrapFileDir fd)) -> fmap (flip (Path Rel) fd) $ guard (relToAR == origAR) >> stripPrefix relToPCs origPCs -- | Joins an absolute directory with a relative path to construct a -- new absolute path. -- -- >> Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" -- >> Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" -- >> Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir" makeAbsolute :: (System os) => AbsDir os -> RelPath os fd -> AbsPath os fd makeAbsolute = genericMakeAbsolute -- | Converts a relative path into an absolute one by -- prepending the current working directory. makeAbsoluteFromCwd :: (System os) => RelPath os fd -> IO (AbsPath os fd) makeAbsoluteFromCwd = genericMakeAbsoluteFromCwd dynamicMakeAbsolute :: (System os) => AbsDir os -> AbsOrRelPath os fd -> AbsPath os fd dynamicMakeAbsolute = genericMakeAbsolute dynamicMakeAbsoluteFromCwd :: (System os) => AbsOrRelPath os fd -> IO (AbsPath os fd) dynamicMakeAbsoluteFromCwd = genericMakeAbsoluteFromCwd -- | As for 'makeAbsolute', but for use when the path may already be -- absolute (in which case it is left unchanged). -- You should avoid the use of 'genericMakeAbsolute'-type functions, -- because then you avoid to absolutize a path that was already absolutized. -- -- >> Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt" -- >> Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt" -- >> Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt" genericMakeAbsolute :: (System os, AbsOrRelClass ar) => AbsDir os -> Path os ar fd -> AbsPath os fd genericMakeAbsolute base p = absRel id (base ) p -- | As for 'makeAbsoluteFromCwd', but for use when the path may already be -- absolute (in which case it is left unchanged). genericMakeAbsoluteFromCwd :: (System os, AbsOrRelClass ar) => Path os ar fd -> IO (AbsPath os fd) genericMakeAbsoluteFromCwd p = do cwdString <- SD.getCurrentDirectory -- we don't use System.Path.Directory impl here to avoid module cycle return $ genericMakeAbsolute (asAbsDir cwdString) p prop_makeAbsoluteFromDir_endSame :: (System os) => AbsDir os -> RelFile os -> Property prop_makeAbsoluteFromDir_endSame base p = property $ getPathString p `isSuffixOf` getPathString (makeAbsolute base p) prop_makeAbsoluteFromDir_startSame :: (System os) => AbsDir os -> RelFile os -> Property prop_makeAbsoluteFromDir_startSame base p = property $ getPathString base `isPrefixOf` getPathString (makeAbsolute base p) -- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir os -> AbsFile -> Property -- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p) -- | Convert a file to a directory path. -- Obviously, the corresponding disk object won't change accordingly. -- The purpose of this function is to be an intermediate step -- when deriving a directory name from a file name. dirFromFile :: FilePath os ar -> DirPath os ar dirFromFile p = uncurry Path (pathComponents p) Dir -- | Convert a directory to a file path. -- The function returns 'Nothing' if the directory path is empty. -- The purpose of this function is to be an intermediate step -- when deriving a file name from a directory name. fileFromDir :: DirPath os ar -> Maybe (FilePath os ar) fileFromDir = fileFromAny toFileOrDir :: (FileOrDirClass fd) => Path os ar fd -> FileOrDirPath os ar toFileOrDir p = uncurry Path (pathComponents p) FileOrDir fromFileOrDir :: (FileOrDirClass fd) => FileOrDirPath os ar -> Maybe (Path os ar fd) fromFileOrDir p = switchFileOrDirPath (fileFromFileOrDir p) (Just $ dirFromFileOrDir p) (Just p) fileFromFileOrDir :: FileOrDirPath os ar -> Maybe (FilePath os ar) fileFromFileOrDir = fileFromAny fileFromAny :: Path os ar fd -> Maybe (FilePath os ar) fileFromAny (Path ar pcs _) = fmap (uncurry (Path ar) . mapSnd (File . untagPC)) $ ListHT.viewR pcs dirFromFileOrDir :: FileOrDirPath os ar -> DirPath os ar dirFromFileOrDir (Path ar pcs FileOrDir) = Path ar pcs Dir ------------------------------------------------------------------------ -- NYI - Not Yet Implemented {- splitSearchPath :: String -> [String] getSearchPath :: IO [String] splitDrive :: String -> (String, String) joinDrive :: String -> String -> String takeDrive :: String -> String hasDrive :: String -> Bool dropDrive :: String -> String isDrive :: String -> Bool isValid :: String -> Bool makeValid :: String -> String -} ------------------------------------------------------------------------ -- Path Predicates -- | Test whether a @'Path' ar fd@ is absolute. -- -- >> Path.isAbsolute (Posix.absFile "/fred") -- >> Path.isAbsolute (Windows.absFile "\\fred") -- >> Path.isAbsolute (Windows.absFile "c:\\fred") -- >> Path.isAbsolute (Windows.absFile "c:fred") isAbsolute :: AbsOrRelClass ar => Path os ar fd -> Bool isAbsolute = absRel (const True) (const False) -- | Invariant - this should return True iff arg is of type @'Path' Rel _@ -- -- > isRelative = not . isAbsolute -- >> Path.isRelative (Posix.relFile "fred") -- >> Path.isRelative (Windows.relFile "fred") isRelative :: AbsOrRelClass ar => Path os ar fd -> Bool isRelative = not . isAbsolute {- | Test whether the 'String' would correspond to an absolute path if interpreted as a 'Path'. -} isAbsoluteString :: (System os) => Tagged os (String -> Bool) isAbsoluteString = fmap (\split -> not . null . MS.evalState split) splitAbsolute {- | Test whether the 'String' would correspond to a relative path if interpreted as a 'Path'. > isRelativeString = not . isAbsoluteString -} isRelativeString :: (System os) => Tagged os (String -> Bool) isRelativeString = (not .) <$> isAbsoluteString -- | Does the given filename have an extension? -- -- >> null (Path.takeExtension x) == not (Path.hasAnExtension x) hasAnExtension :: FilePath os ar -> Bool hasAnExtension = not . null . snd . splitExtension -- | Does the given filename have the given extension? -- -- >> Path.hasExtension ".hs" (Posix.relFile "MyCode.hs") -- >> Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs") -- >> not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak") hasExtension :: String -> FilePath os ar -> Bool hasExtension ext = (==ext) . snd . splitExtension ------------------------------------------------------------------------ -- Separators -- | File extension character -- -- >> Posix.extSeparator == '.' extSeparator :: Char extSeparator = '.' -- | The character that is used to separate the entries in the $PATH environment variable. -- searchPathSeparator :: Char searchPathSeparator = ':' -- | Is the character an extension character? -- -- >> Posix.isExtSeparator a == (a == Posix.extSeparator) isExtSeparator :: Char -> Bool isExtSeparator = (== extSeparator) -- | Is the character a file separator? -- -- >> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator) isSearchPathSeparator :: Char -> Bool isSearchPathSeparator = (== searchPathSeparator) ------------------------------------------------------------------------ -- Generic Manipulation Functions -- These functions support manipulation of extensions on directories -- as well as files. They have looser types than the corresponding -- 'Basic Manipulation Functions', but it is expected that the basic -- functions will be used more frequently as they provide more checks. -- | This is a more flexible variant of 'addExtension' / '<.>' which can -- work with files or directories -- -- >> Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x" -- >> Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x" -- >> Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x" -- >> Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile genericAddExtension :: (FileOrDirClass fd) => Path os ar fd -> String -> Path os ar fd genericAddExtension = flip $ \ext -> appEndo $ MonHT.when (not $ null ext) $ switchFileOrDirPath (Endo $ flip addExtension ext) (Endo $ componentsAddExtension ext) (Endo $ componentsAddExtension ext) componentsAddExtension :: String -> Path os ar fd -> Path os ar fd componentsAddExtension ext (Path ar pcs0 fd) = let pcs = if null pcs0 then [emptyPC] else pcs0 in Path ar (mapLast (flip addExtensionPC ext) pcs) fd genericDropExtension :: (FileOrDirClass fd) => Path os ar fd -> Path os ar fd genericDropExtension = fst . genericSplitExtension genericDropExtensions :: (FileOrDirClass fd) => Path os ar fd -> Path os ar fd genericDropExtensions = fst . genericSplitExtensions genericSplitExtension :: (FileOrDirClass fd) => Path os ar fd -> (Path os ar fd, String) genericSplitExtension = runSplitExtension $ switchFileOrDirPath (SplitExtension splitExtension) (SplitExtension componentsSplitExtension) (SplitExtension componentsSplitExtension) componentsSplitExtension :: Path os ar b -> (Path os ar b, String) componentsSplitExtension (Path ar pcs fd) = mapFst (flip (Path ar) fd) $ mapLastPair (error "genericSplitExtension: empty path") splitExtensionPC pcs genericSplitExtensions :: (FileOrDirClass fd) => Path os ar fd -> (Path os ar fd, String) genericSplitExtensions = runSplitExtension $ switchFileOrDirPath (SplitExtension splitExtensions) (SplitExtension componentsSplitExtensions) (SplitExtension componentsSplitExtensions) componentsSplitExtensions :: Path os ar b -> (Path os ar b, String) componentsSplitExtensions (Path ar pcs fd) = mapFst (flip (Path ar) fd) $ mapLastPair (error "genericSplitExtensions: empty path") splitExtensionsPC pcs genericTakeExtension :: (FileOrDirClass fd) => Path os ar fd -> String genericTakeExtension = snd . genericSplitExtension genericTakeExtensions :: (FileOrDirClass fd) => Path os ar fd -> String genericTakeExtensions = snd . genericSplitExtension newtype SplitExtension path = SplitExtension {runSplitExtension :: path -> (path, String)} -- move to utility-ht mapLast :: (a -> a) -> [a] -> [a] mapLast f xs = zipWith id (drop 1 $ map (const id) xs ++ [f]) xs mapLastPair :: b -> (a -> (a,b)) -> [a] -> ([a], b) mapLastPair b f = ListHT.switchR ([], b) (\as a -> mapFst ((as++) . (:[])) $ f a) mapLastPairFoldr :: b -> (a -> (a,b)) -> [a] -> ([a], b) mapLastPairFoldr b _ [] = ([], b) mapLastPairFoldr _ f (x:xs) = foldr (\y1 go y0 -> mapFst (y0:) $ go y1) (\y -> mapFst (:[]) $ f y) xs x mapLastPairRec :: b -> (a -> (a,b)) -> [a] -> ([a], b) mapLastPairRec b _ [] = ([], b) mapLastPairRec _ f (x:xs) = let go y [] = mapFst (:[]) $ f y go y0 (y1:ys) = mapFst (y0:) $ go y1 ys in go x xs mapLastPairRev :: b -> (a -> (a,b)) -> [a] -> ([a], b) mapLastPairRev b0 f xs = case reverse xs of [] -> (xs, b0) y:ys -> let (a, b) = f y in (reverse ys ++ [a], b) _prop_mapLastPair :: String -> Int -> [String] -> Bool _prop_mapLastPair b n strs = let f = splitAt n in all (mapLastPair b f strs ==) $ mapLastPairFoldr b f strs : mapLastPairRev b f strs : mapLastPairRec b f strs : [] addExtensionPC :: PathComponent os -> String -> PathComponent os addExtensionPC p "" = p addExtensionPC (PathComponent pc) ext = PathComponent $ pc ++ if [extSeparator] `isPrefixOf` ext then ext else extSeparator : ext splitExtensionPC :: PathComponent os -> (PathComponent os, String) splitExtensionPC (PathComponent s) = mapFst PathComponent $ maybe (s, "") (mapFst concat) $ ((\p@(pcs,_) -> toMaybe (not (null pcs)) p) =<<) $ ListHT.viewR $ ListHT.segmentBefore isExtSeparator s _splitExtensionPC :: PathComponent os -> (PathComponent os, String) _splitExtensionPC (PathComponent s) = mapFst PathComponent $ case break isExtSeparator $ reverse s of (_, "") -> (s, "") (rext, dot:rstem) -> (reverse rstem, dot : reverse rext) splitExtensionsPC :: PathComponent os -> (PathComponent os, String) splitExtensionsPC (PathComponent s) = mapFst PathComponent $ break isExtSeparator s class System os where -- | The character that separates directories. In the case where more than -- one character is possible, 'pathSeparator' is the \'ideal\' one. -- -- >> Posix.isPathSeparator Posix.pathSeparator pathSeparator :: Tagged os Char -- | The list of all possible separators. -- -- >> Posix.pathSeparator `elem` Posix.pathSeparators pathSeparators :: Tagged os [Char] pathSeparators = (:[]) <$> pathSeparator -- | Rather than using @(== 'pathSeparator')@, use this. Test if something -- is a path separator. -- -- >> Posix.isPathSeparator a == (a `elem` Posix.pathSeparators) isPathSeparator :: Tagged os (Char -> Bool) isPathSeparator = flip elem <$> pathSeparators splitAbsolute :: Tagged os (MS.State String String) canonicalize :: Tagged os (String -> String) splitDrive :: Tagged os (MS.State String String) genDrive :: Tagged os (Gen String) {- | Check internal integrity of the path data structure. -} isValid :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> Bool isValid = untag isValidTagged isValidTagged :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Tagged os (Path os ar fd -> Bool) isValidTagged = fmap (\isValidPC (Path ar pcs fd) -> absRelPlain isValidComponent True ar && all isValidPC pcs && fileOrDirPlain (isValidPC . retagPC) True True fd) isValidPathComponent isValidComponent :: String -> Bool isValidComponent = not . null isValidPathComponent :: (System os) => Tagged os (PathComponent os -> Bool) isValidPathComponent = fmap (\isSep (PathComponent str) -> isValidComponent str && not (any isSep str)) isPathSeparator ------------------------------------------------------------------------ -- QuickCheck testAll :: (System os) => os -> [(String, IO ())] testAll os = ("asPath_getPathString", quickCheck os prop_asPath_getPathString) : ("mkPathFromComponents_pathComponents", quickCheck os prop_mkPathFromComponents_pathComponents) : ("combine_currentDir", quickCheck os prop_combine_currentDir) : ("makeAbsoluteFromDir_endSame", quickCheck os prop_makeAbsoluteFromDir_endSame) : ("makeAbsoluteFromDir_startSame", quickCheck os prop_makeAbsoluteFromDir_startSame) : ("split_combine", quickCheck os prop_split_combine) : ("takeFileName_end", quickCheck os prop_takeFileName_end) : ("split_combineExt", quickCheck os prop_split_combineExt) : [] quickCheck :: (QC.Testable prop, System os, FileOrDirClass fd, AbsOrRelClass ar) => os -> (Path os ar fd -> prop) -> IO () quickCheck _ = QC.quickCheck -- test :: Testable a => a -> IO () -- test = quickCheck qcFileComponent :: Gen (PathComponent os) qcFileComponent = PathComponent <$> frequency [ (1, return "someFile"), (1, return "fileWith.ext"), (1, return "file.with.multiple.exts"), (1, return "file with spcs") ] qcDirComponent :: Gen (PathComponent os) qcDirComponent = PathComponent <$> frequency [ (1, return "someDir"), (1, return "aDir"), (1, return "aFolder"), (1, return "a folder"), (1, return "directory") ] qcAbsRel :: (System os, AbsOrRelClass ar) => Tagged os (Gen ar) qcAbsRel = flip fmap genDrive $ \drive -> switchAbsOrRel (fmap absPC drive) (return Rel) (QC.oneof [fmap (AbsO . PathComponent) drive, return RelO]) qcGenPath :: Tagged os (Gen ar) -> (Gen ar -> Gen (Path os ar fd)) -> Gen (Path os ar fd) qcGenPath qcAR gen = gen $ untag qcAR qcFilePath :: (System os, AbsOrRelClass ar) => Gen (FilePath os ar) qcFilePath = qcGenPath qcAbsRel $ \qcAR -> do ar <- qcAR pcs <- QC.listOf qcDirComponent pc <- qcFileComponent return $ Path ar pcs $ File pc qcDirPath :: (System os, AbsOrRelClass ar) => fd -> Gen (Path os ar fd) qcDirPath fd = qcGenPath qcAbsRel $ \qcAR -> do ar <- qcAR pcs <- QC.listOf qcDirComponent return $ Path ar pcs fd qcPath :: (System os, AbsOrRelClass ar, FileOrDirClass fd) => Gen (Path os ar fd) qcPath = switchFileOrDirPath qcFilePath (qcDirPath Dir) (qcDirPath FileOrDir) instance (System os, AbsOrRelClass ar, FileOrDirClass fd) => Arbitrary (Path os ar fd) where arbitrary = qcPath