diff --git a/pathtype.cabal b/pathtype.cabal --- a/pathtype.cabal +++ b/pathtype.cabal @@ -1,5 +1,5 @@ Name: pathtype -Version: 0.5.4.3 +Version: 0.5.5 Synopsis: Type-safe replacement for System.FilePath etc Description: This package provides type-safe access to filepath manipulations. . @@ -94,7 +94,7 @@ Location: http://hub.darcs.net/thielema/pathtype/ Source-Repository this - Tag: 0.5.4.3 + Tag: 0.5.5 Type: darcs Location: http://hub.darcs.net/thielema/pathtype/ @@ -109,6 +109,7 @@ Library Build-Depends: QuickCheck >= 2.1.0.1 && < 3, + deepseq >= 1.3 && <1.5, time >= 1.0 && < 2, base >= 4 && < 5 diff --git a/src/System/Path/IO.hs b/src/System/Path/IO.hs --- a/src/System/Path/IO.hs +++ b/src/System/Path/IO.hs @@ -104,7 +104,7 @@ ------------------------------------------------------------------------ -- Covers for System.IO functions -withFile :: AbsRelClass ar => Path ar fd -> IOMode -> (Handle -> IO r) -> IO r +withFile :: AbsRelClass ar => FilePath ar -> IOMode -> (Handle -> IO r) -> IO r withFile f = SIO.withFile (getPathString f) openFile :: AbsRelClass ar => FilePath ar -> IOMode -> IO Handle diff --git a/src/System/Path/Internal.hs b/src/System/Path/Internal.hs --- a/src/System/Path/Internal.hs +++ b/src/System/Path/Internal.hs @@ -116,16 +116,19 @@ import qualified System.Directory as SD -import Control.Arrow ((|||), (***)) +import Control.Arrow (first, (|||), (***)) import Control.Applicative ((<$>)) +import Control.DeepSeq (NFData(rnf)) import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intercalate) import Data.String (IsString(fromString)) +import Data.Char (isSpace) import Text.Printf (printf) + +import qualified Test.QuickCheck as QC import Test.QuickCheck (Gen, Property, property, Arbitrary(arbitrary), - vectorOf, oneof, frequency, - NonNegative(NonNegative), quickCheck) + oneof, frequency, quickCheck) import Prelude hiding (FilePath) @@ -155,7 +158,6 @@ -- ... doesn't presently seem to add much value over non-GADT. newtype PathComponent = PathComponent String deriving (Eq,Ord) -instance Show PathComponent where showsPrec _ (PathComponent s) = showString s type AbsFile = Path Abs File type RelFile = Path Rel File @@ -167,6 +169,13 @@ type FilePath ar = Path ar File type DirPath ar = Path ar Dir +instance NFData PathComponent where + rnf (PathComponent pc) = rnf pc + +instance NFData (Path ar fd) where + rnf PathRoot = () + rnf (FileDir d pc) = rnf (d, pc) + -- I don't think this basic type of fold is appropriate for a nested datatype -- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a -- pathFold pr f PathRoot = pr @@ -199,20 +208,32 @@ -- | This class allows selective behaviour for absolute and -- relative paths and is mostly for internal use. class Private ar => AbsRelClass ar where + -- | See + -- for the used technique. + switchAbsRel :: f Abs -> f Rel -> f ar + -- | Will become a top-level function in future absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a + absRel f g = runAbsRel $ switchAbsRel (AbsRel f) (AbsRel g) -instance AbsRelClass Abs where absRel f _g = f -instance AbsRelClass Rel where absRel _f g = g +newtype AbsRel fd a ar = AbsRel {runAbsRel :: Path ar fd -> a} +instance AbsRelClass Abs where switchAbsRel f _g = f +instance AbsRelClass Rel where switchAbsRel _f g = g + -- | This class allows selective behaviour for file and -- directory paths and is mostly for internal use. class Private fd => FileDirClass fd where + switchFileDir :: f File -> f Dir -> f fd + -- | Will become a top-level function in future fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a + fileDir f g = runFileDir $ switchFileDir (FileDirFunc f) (FileDirFunc g) -instance FileDirClass File where fileDir f _g = f -instance FileDirClass Dir where fileDir _f g = g +newtype FileDir ar a fd = FileDirFunc {runFileDir :: Path ar fd -> a} +instance FileDirClass File where switchFileDir f _g = f +instance FileDirClass Dir where switchFileDir _f g = g + -- | Currently not exported _pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd) _pathAbsRel = absRel Left Right @@ -224,28 +245,63 @@ ------------------------------------------------------------------------ -- Read & Show instances +-- >> show (rootDir "bla" "blub") == "rootDir \"bla\" \"blub\"" +-- >> show (Just (rootDir "bla" "blub")) == "Just (rootDir \"bla\" \"blub\")" +-- >> show (currentDir "bla" "blub") == "currentDir \"bla\" \"blub\"" +-- >> show (Just (currentDir "bla" "blub")) == "Just (currentDir \"bla\" \"blub\")" instance AbsRelClass ar => Show (Path ar fd) where - showsPrec _ x@PathRoot = absRel (const $ showString pathSeparators) - (const $ showString ".") x - -- we need the clause below so that we don't duplicate the pathSeparator after an abs - -- root and we don't want to display a "./" prefix on relative paths - showsPrec d (FileDir p@PathRoot pc) = absRel (const $ showString pathSeparators) - (const id) - p . - showsPrec d pc - showsPrec d (FileDir p pc) = showsPrec d p . showString pathSeparators . - showsPrec d pc + showsPrec d = + let go :: AbsRelClass ar => Path ar fd -> ShowS + go x@PathRoot = + absRel (const $ showString rootName) (const $ showString currentName) x + go (FileDir p (PathComponent pc)) = + go p . showChar ' ' . + showString combineOperator . showChar ' ' . shows pc + in showParen (d>9) . go --- This instance consumes all remaining input. Would it be better to, say, --- give up at newlines or some set of non-allowable chars? +-- >> read (show (rootDir "bla" "blub")) == rootDir "bla" "blub" +-- >> read (show (Just (rootDir "bla" "blub"))) == Just (rootDir "bla" "blub") +-- >> read (show (currentDir "bla" "blub")) == currentDir "bla" "blub" +-- >> read (show (Just (currentDir "bla" "blub"))) == Just (currentDir "bla" "blub") instance AbsRelClass ar => Read (Path ar fd) where - readsPrec _ s = [(asPath s,"")] + readsPrec d = readParen (d>9) $ \str -> + let go :: AbsRelClass ar => Path ar Dir -> ReadS (Path ar fd) + go path s0 = + case stripPrefix combineOperator $ dropWhile isSpace s0 of + Nothing -> [(relaxDir path, s0)] + Just s1 -> do + (pc, s2) <- reads s1 + go (FileDir path (PathComponent pc)) s2 + result = do + let required = absRel (const rootName) (const currentName) $ fst $ head result + maybe [] (go PathRoot) $ + stripPrefix required $ dropWhile isSpace str + in result --- | Convert the 'Path' into a plain 'String'. This is simply an --- alias for 'show'. +relaxDir :: Path ar Dir -> Path ar fd +relaxDir PathRoot = PathRoot +relaxDir (FileDir p pc) = FileDir p pc + +-- | Convert the 'Path' into a plain 'String' as required for OS calls. getPathString :: AbsRelClass ar => Path ar fd -> String -getPathString = show +getPathString = flip getPathStringS "" +getPathStringS :: AbsRelClass ar => Path ar fd -> ShowS +getPathStringS = + let go :: AbsRelClass ar => Path ar fd -> ShowS + go x@PathRoot = + absRel + (const $ showChar pathSeparator) + (const $ showString currentDirComponent) x + -- we need the clause below so that we don't duplicate the pathSeparator after an abs + -- root and we don't want to display a "./" prefix on relative paths + go (FileDir p@PathRoot (PathComponent pc)) = + absRel (const $ showChar pathSeparator) (const id) p . + showString pc + go (FileDir p (PathComponent pc)) = + go p . showChar pathSeparator . showString pc + in go + prop_asPath_getPathString :: AbsFile -> Property prop_asPath_getPathString p = property $ p == asPath (getPathString p) @@ -268,7 +324,16 @@ currentDir :: RelDir currentDir = PathRoot +rootName :: String +rootName = "rootDir" +currentName :: String +currentName = "currentDir" + +currentDirComponent :: String +currentDirComponent = "." + + ------------------------------------------------------------------------ -- Unchecked Construction Functions -- NB - these construction functions are non-IO and do no checking!! @@ -296,6 +361,7 @@ -- | Use a 'String' as a 'RelDir'. No checking is done. -- +-- >> getPathString (asRelDir ".") == "." -- >> getPathString (asRelDir "file.txt") == "file.txt" -- >> getPathString (asRelDir "/file.txt") == "file.txt" -- >> getPathString (asRelDir "tmp") == "tmp" @@ -346,16 +412,19 @@ -- | Examines the supplied string and constructs an absolute or -- relative path as appropriate. -- --- >> either id (const "fred") (mkPathAbsOrRel "/tmp") == "/tmp" --- >> either id (const "fred") (mkPathAbsOrRel "tmp") == "fred" +-- >> mkPathAbsOrRel "/tmp" == Left (asAbsDir "/tmp") +-- >> mkPathAbsOrRel "tmp" == Right (asRelDir "tmp") mkPathAbsOrRel :: String -> Either (AbsPath fd) (RelPath fd) -mkPathAbsOrRel s | isAbsoluteString s = Left (asPath s) - | otherwise = Right (asPath s) +mkPathAbsOrRel s = + if isAbsoluteString s + then Left $ asAbsPath s + else Right $ asRelPath s -- | Searches for a file or directory with the supplied path string -- and returns a 'File' or 'Dir' path as appropriate. If neither exists -- at the supplied path, 'Nothing' is returned. -mkPathFileOrDir :: AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath ar))) +mkPathFileOrDir :: + AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath ar))) mkPathFileOrDir s = do isfile <- SD.doesFileExist s isdir <- SD.doesDirectoryExist s @@ -399,22 +468,25 @@ pathComponents (FileDir p pc) = pathComponents p ++ [pc] prop_mkPathFromComponents_pathComponents :: AbsFile -> Property -prop_mkPathFromComponents_pathComponents p = property $ - mkPathFromComponents (pathComponents p) == p +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. +combineOperator :: String +combineOperator = "" + +-- | Infix variant of 'combine'. () :: DirPath ar -> RelPath fd -> Path ar fd PathRoot PathRoot = PathRoot (FileDir dp dpc) PathRoot = FileDir dp dpc d (FileDir p pc) = FileDir (d p) pc --- | We only allow files (and not directories) to have extensions added +-- | 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. @@ -430,6 +502,8 @@ -- >> addExtension "file.txt" "bib" == "file.txt.bib" -- >> addExtension "file." ".bib" == "file..bib" -- >> addExtension "file" ".bib" == "file.bib" +-- >> addExtension "" "bib" == ".bib" +-- >> addExtension "" ".bib" == ".bib" -- >> takeFileName (addExtension "" "ext") == ".ext" addExtension :: FilePath ar -> String -> FilePath ar addExtension = (<.>) @@ -452,6 +526,7 @@ dropExtensions :: FilePath ar -> FilePath ar dropExtensions = fst . splitExtensions +-- | Synonym for 'takeDirectory' dropFileName :: Path ar fd -> DirPath ar dropFileName = fst . splitFileName @@ -495,10 +570,8 @@ splitExtensions :: FilePath ar -> (FilePath ar, String) splitExtensions = genericSplitExtensions -prop_splitCombine :: AbsFile -> Property -prop_splitCombine p = property $ p == p2 <.> ext - where - (p2, ext) = splitExtension p +prop_split_combineExt :: AbsFile -> Property +prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p) -- | Path must not be empty splitFileName :: Path ar fd -> (DirPath ar, RelPath fd) @@ -561,7 +634,7 @@ -- | Constructs a 'Path' from a list of components. -- -- >> joinPath ["/tmp","someDir","file.txt"] == "/tmp/someDir/file.txt" --- >> (joinPath ["/tmp","someDir","file.txt"] :: RelFile) == "tmp/someDir/file.txt" +-- >> joinPath ["/tmp","someDir","file.txt"] == asRelFile "tmp/someDir/file.txt" joinPath :: [String] -> Path ar fd joinPath = asPath . intercalate [pathSeparator] @@ -569,37 +642,45 @@ -- -- >> normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file" normalise :: Path ar fd -> Path ar fd -normalise = mkPathFromComponents . filter (/=(PathComponent ".")) . pathComponents +normalise = + mkPathFromComponents . + filter (/= PathComponent currentDirComponent) . + pathComponents -- | Deconstructs a path into its components. -- --- >> splitPath ("/tmp/someDir/myfile.txt" :: AbsDir) == (["tmp","someDir","myfile.txt"],Nothing) --- >> splitPath ("/tmp/someDir/myfile.txt" :: AbsFile) == (["tmp","someDir"],Just "myfile.txt") --- >> splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"],Just "myfile.txt") -splitPath :: FileDirClass fd => Path ar fd -> ([RelDir],Maybe RelFile) +-- >> splitPath (asAbsDir "/tmp/someDir/mydir.dir") == (["tmp","someDir","mydir.dir"], Nothing) +-- >> splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"], Just "myfile.txt") +splitPath :: FileDirClass fd => Path ar fd -> ([RelDir], Maybe RelFile) splitPath PathRoot = ([],Nothing) splitPath p@(FileDir d pc) = - fileDir (\_->(map (FileDir PathRoot) . pathComponents $ d, Just (FileDir PathRoot pc))) - (\_->(map (FileDir PathRoot) . pathComponents $ p, Nothing)) - p + first (map (FileDir PathRoot)) $ + fileDir + (\ _ -> (pathComponents d, Just (FileDir PathRoot pc))) + (\ _ -> (pathComponents p, Nothing)) + p -- | This function can be used to construct a relative path by removing -- the supplied 'AbsDir' from the front. It is a runtime 'error' if the -- supplied 'AbsPath' doesn't start with the 'AbsDir'. -- --- >> makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == "anotherdir/file.txt" +-- >> makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == asRelFile "anotherdir/file.txt" +-- >> makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == asRelDir "anotherdir/dir" makeRelative :: AbsDir -> AbsPath fd -> RelPath fd -makeRelative relTo orig = maybe err mkPathFromComponents $ stripPrefix relToPC origPC +makeRelative relTo orig = + maybe (error msg) mkPathFromComponents $ + stripPrefix (pathComponents relTo) (pathComponents orig) where - err = error $ printf "System.Path can't make %s relative to %s" (show origPC) (show relToPC) - relToPC = pathComponents relTo - origPC = pathComponents orig + msg = + printf "System.Path can't make (%s) relative to (%s)" + (show orig) (show relTo) -- | Joins an absolute directory with a relative path to construct a -- new absolute path. -- --- >> makeAbsolute "/tmp" "file.txt" == "/tmp/file.txt" --- >> makeAbsolute "/tmp" "adir/file.txt" == "/tmp/adir/file.txt" +-- >> makeAbsolute "/tmp" "file.txt" == asAbsFile "/tmp/file.txt" +-- >> makeAbsolute "/tmp" "adir/file.txt" == asAbsFile "/tmp/adir/file.txt" +-- >> makeAbsolute "/tmp" "adir/dir" == asAbsDir "/tmp/adir/dir" makeAbsolute :: AbsDir -> RelPath fd -> AbsPath fd makeAbsolute = genericMakeAbsolute @@ -626,10 +707,12 @@ return $ genericMakeAbsolute (asAbsDir cwdString) p prop_makeAbsoluteFromDir_endSame :: AbsDir -> RelFile -> Property -prop_makeAbsoluteFromDir_endSame base p = property $ show p `isSuffixOf` show (makeAbsolute base p) +prop_makeAbsoluteFromDir_endSame base p = + property $ show p `isSuffixOf` show (makeAbsolute base p) prop_makeAbsoluteFromDir_startSame :: AbsDir -> RelFile -> Property -prop_makeAbsoluteFromDir_startSame base p = property $ show base `isPrefixOf` show (makeAbsolute base p) +prop_makeAbsoluteFromDir_startSame base p = + property $ show base `isPrefixOf` show (makeAbsolute base p) -- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir -> AbsFile -> Property -- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p) @@ -668,7 +751,7 @@ -- if interpreted as a 'Path'. isAbsoluteString :: String -> Bool isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators' -isAbsoluteString (x:_) = any (== x) pathSeparators -- Absolute if first char is a path separator +isAbsoluteString (x:_) = isPathSeparator x -- Absolute if first char is a path separator -- | Invariant - this should return True iff arg is of type @'Path' Rel _@ -- @@ -750,7 +833,7 @@ -- -- >> isPathSeparator a == (a `elem` pathSeparators) isPathSeparator :: Char -> Bool -isPathSeparator = (== pathSeparator) +isPathSeparator = flip elem pathSeparators -- | Is the character a file separator? -- @@ -770,15 +853,22 @@ -- | This is a more flexible variant of 'addExtension' / '<.>' which can -- work with files or directories -- --- >> genericAddExtension "/" "x" == "/.x" +-- >> genericAddExtension "/" "x" == asAbsDir "/.x" +-- >> genericAddExtension "/a" "x" == asAbsDir "/a.x" +-- >> genericAddExtension "" "x" == asRelFile ".x" +-- >> genericAddExtension "" "" == asRelFile "" genericAddExtension :: Path ar fd -> String -> Path ar fd genericAddExtension p "" = p -genericAddExtension (FileDir p (PathComponent pc)) ext = FileDir p (PathComponent (pc ++ suffix)) - where suffix | "." `isPrefixOf` ext = ext - | otherwise = "." ++ ext -genericAddExtension PathRoot ext = FileDir PathRoot (PathComponent suffix) - where suffix | "." `isPrefixOf` ext = ext - | otherwise = "." ++ ext +genericAddExtension path ext = + let suffix = + if [extSeparator] `isPrefixOf` ext + then ext + else extSeparator : ext + in case path of + FileDir p (PathComponent pc) -> + FileDir p (PathComponent (pc ++ suffix)) + PathRoot -> + FileDir PathRoot (PathComponent suffix) genericDropExtension :: Path ar fd -> Path ar fd genericDropExtension = fst . genericSplitExtension @@ -820,7 +910,7 @@ quickCheck prop_makeAbsoluteFromDir_startSame quickCheck prop_split_combine quickCheck prop_takeFileName_end - quickCheck prop_splitCombine + quickCheck prop_split_combineExt putStrLn "Tests completed." -- test :: Testable a => a -> IO () @@ -843,31 +933,26 @@ (1, return "directory") ] -qcFilePath :: Gen (FilePath ar) -qcFilePath = do - (NonNegative numDirs) <- arbitrary - pcs <- vectorOf numDirs qcDirComponent - pc <- qcFileComponent - return $ mkPathFromComponents (pcs ++ [pc]) +instance Arbitrary PathComponent where + arbitrary = oneof [qcFileComponent, qcDirComponent] -qcDirPath :: Gen (DirPath ar) -qcDirPath = do - (NonNegative numDirs) <- arbitrary - pcs <- vectorOf numDirs qcDirComponent - pc <- qcDirComponent - return $ mkPathFromComponents (pcs ++ [pc]) - --- qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd) --- qcPath = absRel +qcGenPath :: Gen PathComponent -> Gen (Path ar fd) +qcGenPath qcLastComponent = do + pcs <- QC.listOf qcDirComponent + pc <- qcLastComponent + return $ mkPathFromComponents (pcs ++ [pc]) -instance Arbitrary PathComponent where - arbitrary = oneof [qcFileComponent, qcDirComponent] +qcFilePath :: Gen (FilePath ar) +qcFilePath = qcGenPath qcFileComponent -instance Arbitrary (Path ar File) where - arbitrary = qcFilePath +qcDirPath :: Gen (DirPath ar) +qcDirPath = qcGenPath qcDirComponent -instance Arbitrary (Path ar Dir) where - arbitrary = qcDirPath +newtype PathGen ar fd = PathGen {runPathGen :: Gen (Path ar fd)} +qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd) +qcPath = runPathGen $ switchFileDir (PathGen qcFilePath) (PathGen qcDirPath) +instance (AbsRelClass ar, FileDirClass fd) => Arbitrary (Path ar fd) where + arbitrary = qcPath diff --git a/src/System/Path/Posix.hs b/src/System/Path/Posix.hs --- a/src/System/Path/Posix.hs +++ b/src/System/Path/Posix.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} +{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE CPP #-} #define MODULE_NAME Posix #define IS_WINDOWS False diff --git a/src/System/Path/Windows.hs b/src/System/Path/Windows.hs --- a/src/System/Path/Windows.hs +++ b/src/System/Path/Windows.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} +{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE CPP #-} #define MODULE_NAME Windows #define IS_WINDOWS True diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -5,7 +5,10 @@ import System.Path (rootDir, asRelDir, asRelFile, (), (<.>)) import System.Random (newStdGen, random) import System.Exit (exitFailure) +import Control.Monad (void) +import Text.Printf (printf) + main :: IO () main = do g <- newStdGen @@ -13,8 +16,10 @@ -- TODO - integrate with QuickCheck x = rootDir asRelDir "tmp" asRelFile "someFile" <.> "ext" - let fails = map fst $ filter (not . snd) $ results a x + let allResults = results a x + void $ printf "Running %d tests...\n" $ length allResults + let fails = map fst $ filter (not . snd) allResults if null fails then do putStrLn "Passed." diff --git a/test/TestResult.hs b/test/TestResult.hs --- a/test/TestResult.hs +++ b/test/TestResult.hs @@ -2,14 +2,30 @@ {-# LANGUAGE OverloadedStrings #-} module TestResult (results) where -import System.Path +import System.Path.Posix as Path import Data.Char (toLower) -results :: Char -> System.Path.FilePath ar -> [(String, Bool)] +results :: Char -> Path.FilePath ar -> [(String, Bool)] results a x = ("pathMap (map toLower) \"/tmp/Reports/SpreadSheets\" == \"/tmp/reports/spreadsheets\"", pathMap (map toLower) "/tmp/Reports/SpreadSheets" == "/tmp/reports/spreadsheets") : + ("show (rootDir \"bla\" \"blub\") == \"rootDir \\\"bla\\\" \\\"blub\\\"\"", + show (rootDir "bla" "blub") == "rootDir \"bla\" \"blub\"") : + ("show (Just (rootDir \"bla\" \"blub\")) == \"Just (rootDir \\\"bla\\\" \\\"blub\\\")\"", + show (Just (rootDir "bla" "blub")) == "Just (rootDir \"bla\" \"blub\")") : + ("show (currentDir \"bla\" \"blub\") == \"currentDir \\\"bla\\\" \\\"blub\\\"\"", + show (currentDir "bla" "blub") == "currentDir \"bla\" \"blub\"") : + ("show (Just (currentDir \"bla\" \"blub\")) == \"Just (currentDir \\\"bla\\\" \\\"blub\\\")\"", + show (Just (currentDir "bla" "blub")) == "Just (currentDir \"bla\" \"blub\")") : + ("read (show (rootDir \"bla\" \"blub\")) == rootDir \"bla\" \"blub\"", + read (show (rootDir "bla" "blub")) == rootDir "bla" "blub") : + ("read (show (Just (rootDir \"bla\" \"blub\"))) == Just (rootDir \"bla\" \"blub\")", + read (show (Just (rootDir "bla" "blub"))) == Just (rootDir "bla" "blub")) : + ("read (show (currentDir \"bla\" \"blub\")) == currentDir \"bla\" \"blub\"", + read (show (currentDir "bla" "blub")) == currentDir "bla" "blub") : + ("read (show (Just (currentDir \"bla\" \"blub\"))) == Just (currentDir \"bla\" \"blub\")", + read (show (Just (currentDir "bla" "blub"))) == Just (currentDir "bla" "blub")) : ("asPath \"/tmp\" == \"/tmp\"", asPath "/tmp" == "/tmp") : ("asPath \"file.txt\" == \"file.txt\"", @@ -30,6 +46,8 @@ getPathString (asRelFile "tmp") == "tmp") : ("getPathString (asRelFile \"/tmp\") == \"tmp\"", getPathString (asRelFile "/tmp") == "tmp") : + ("getPathString (asRelDir \".\") == \".\"", + getPathString (asRelDir ".") == ".") : ("getPathString (asRelDir \"file.txt\") == \"file.txt\"", getPathString (asRelDir "file.txt") == "file.txt") : ("getPathString (asRelDir \"/file.txt\") == \"file.txt\"", @@ -54,10 +72,10 @@ getPathString (asAbsDir "tmp") == "/tmp") : ("getPathString (asAbsDir \"/tmp\") == \"/tmp\"", getPathString (asAbsDir "/tmp") == "/tmp") : - ("either id (const \"fred\") (mkPathAbsOrRel \"/tmp\") == \"/tmp\"", - either id (const "fred") (mkPathAbsOrRel "/tmp") == "/tmp") : - ("either id (const \"fred\") (mkPathAbsOrRel \"tmp\") == \"fred\"", - either id (const "fred") (mkPathAbsOrRel "tmp") == "fred") : + ("mkPathAbsOrRel \"/tmp\" == Left (asAbsDir \"/tmp\")", + mkPathAbsOrRel "/tmp" == Left (asAbsDir "/tmp")) : + ("mkPathAbsOrRel \"tmp\" == Right (asRelDir \"tmp\")", + mkPathAbsOrRel "tmp" == Right (asRelDir "tmp")) : ("mkAbsPath \"/tmp\" \"foo.txt\" == \"/tmp/foo.txt\"", mkAbsPath "/tmp" "foo.txt" == "/tmp/foo.txt") : ("mkAbsPath \"/tmp\" \"/etc/foo.txt\" == \"/etc/foo.txt\"", @@ -68,6 +86,10 @@ addExtension "file." ".bib" == "file..bib") : ("addExtension \"file\" \".bib\" == \"file.bib\"", addExtension "file" ".bib" == "file.bib") : + ("addExtension \"\" \"bib\" == \".bib\"", + addExtension "" "bib" == ".bib") : + ("addExtension \"\" \".bib\" == \".bib\"", + addExtension "" ".bib" == ".bib") : ("takeFileName (addExtension \"\" \"ext\") == \".ext\"", takeFileName (addExtension "" "ext") == ".ext") : ("dropExtension x == fst (splitExtension x)", @@ -128,22 +150,24 @@ equalFilePath "/tmp" "tmp" == False) : ("joinPath [\"/tmp\",\"someDir\",\"file.txt\"] == \"/tmp/someDir/file.txt\"", joinPath ["/tmp","someDir","file.txt"] == "/tmp/someDir/file.txt") : - ("(joinPath [\"/tmp\",\"someDir\",\"file.txt\"] :: RelFile) == \"tmp/someDir/file.txt\"", - (joinPath ["/tmp","someDir","file.txt"] :: RelFile) == "tmp/someDir/file.txt") : + ("joinPath [\"/tmp\",\"someDir\",\"file.txt\"] == asRelFile \"tmp/someDir/file.txt\"", + joinPath ["/tmp","someDir","file.txt"] == asRelFile "tmp/someDir/file.txt") : ("normalise \"/tmp/fred/./jim/./file\" == \"/tmp/fred/jim/file\"", normalise "/tmp/fred/./jim/./file" == "/tmp/fred/jim/file") : - ("splitPath (\"/tmp/someDir/myfile.txt\" :: AbsDir) == ([\"tmp\",\"someDir\",\"myfile.txt\"],Nothing)", - splitPath ("/tmp/someDir/myfile.txt" :: AbsDir) == (["tmp","someDir","myfile.txt"],Nothing)) : - ("splitPath (\"/tmp/someDir/myfile.txt\" :: AbsFile) == ([\"tmp\",\"someDir\"],Just \"myfile.txt\")", - splitPath ("/tmp/someDir/myfile.txt" :: AbsFile) == (["tmp","someDir"],Just "myfile.txt")) : - ("splitPath (asAbsFile \"/tmp/someDir/myfile.txt\") == ([\"tmp\",\"someDir\"],Just \"myfile.txt\")", - splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"],Just "myfile.txt")) : - ("makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/file.txt\" == \"anotherdir/file.txt\"", - makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == "anotherdir/file.txt") : - ("makeAbsolute \"/tmp\" \"file.txt\" == \"/tmp/file.txt\"", - makeAbsolute "/tmp" "file.txt" == "/tmp/file.txt") : - ("makeAbsolute \"/tmp\" \"adir/file.txt\" == \"/tmp/adir/file.txt\"", - makeAbsolute "/tmp" "adir/file.txt" == "/tmp/adir/file.txt") : + ("splitPath (asAbsDir \"/tmp/someDir/mydir.dir\") == ([\"tmp\",\"someDir\",\"mydir.dir\"], Nothing)", + splitPath (asAbsDir "/tmp/someDir/mydir.dir") == (["tmp","someDir","mydir.dir"], Nothing)) : + ("splitPath (asAbsFile \"/tmp/someDir/myfile.txt\") == ([\"tmp\",\"someDir\"], Just \"myfile.txt\")", + splitPath (asAbsFile "/tmp/someDir/myfile.txt") == (["tmp","someDir"], Just "myfile.txt")) : + ("makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/file.txt\" == asRelFile \"anotherdir/file.txt\"", + makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == asRelFile "anotherdir/file.txt") : + ("makeRelative \"/tmp/somedir\" \"/tmp/somedir/anotherdir/dir\" == asRelDir \"anotherdir/dir\"", + makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == asRelDir "anotherdir/dir") : + ("makeAbsolute \"/tmp\" \"file.txt\" == asAbsFile \"/tmp/file.txt\"", + makeAbsolute "/tmp" "file.txt" == asAbsFile "/tmp/file.txt") : + ("makeAbsolute \"/tmp\" \"adir/file.txt\" == asAbsFile \"/tmp/adir/file.txt\"", + makeAbsolute "/tmp" "adir/file.txt" == asAbsFile "/tmp/adir/file.txt") : + ("makeAbsolute \"/tmp\" \"adir/dir\" == asAbsDir \"/tmp/adir/dir\"", + makeAbsolute "/tmp" "adir/dir" == asAbsDir "/tmp/adir/dir") : ("genericMakeAbsolute \"/tmp\" (asRelFile \"file.txt\") == \"/tmp/file.txt\"", genericMakeAbsolute "/tmp" (asRelFile "file.txt") == "/tmp/file.txt") : ("genericMakeAbsolute \"/tmp\" (asRelFile \"adir/file.txt\") == \"/tmp/adir/file.txt\"", @@ -180,6 +204,12 @@ isPathSeparator a == (a `elem` pathSeparators)) : ("isSearchPathSeparator a == (a == searchPathSeparator)", isSearchPathSeparator a == (a == searchPathSeparator)) : - ("genericAddExtension \"/\" \"x\" == \"/.x\"", - genericAddExtension "/" "x" == "/.x") : + ("genericAddExtension \"/\" \"x\" == asAbsDir \"/.x\"", + genericAddExtension "/" "x" == asAbsDir "/.x") : + ("genericAddExtension \"/a\" \"x\" == asAbsDir \"/a.x\"", + genericAddExtension "/a" "x" == asAbsDir "/a.x") : + ("genericAddExtension \"\" \"x\" == asRelFile \".x\"", + genericAddExtension "" "x" == asRelFile ".x") : + ("genericAddExtension \"\" \"\" == asRelFile \"\"", + genericAddExtension "" "" == asRelFile "") : [] diff --git a/test/TestTemplate.hs b/test/TestTemplate.hs --- a/test/TestTemplate.hs +++ b/test/TestTemplate.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module TestResult (results) where -import System.Path +import System.Path.Posix as Path import Data.Char (toLower) -results :: Char -> System.Path.FilePath ar -> [(String, Bool)] +results :: Char -> Path.FilePath ar -> [(String, Bool)] results a x = []