turtle 1.6.0 → 1.6.1
raw patch · 5 files changed
+57/−23 lines, 5 filesdep ~ansi-wl-pprintdep ~optparse-applicativedep ~unix
Dependency ranges changed: ansi-wl-pprint, optparse-applicative, unix, unix-compat
Files
- CHANGELOG.md +8/−0
- src/Turtle/Internal.hs +24/−13
- src/Turtle/Prelude.hs +5/−6
- test/system-filepath.hs +19/−3
- turtle.cabal +1/−1
CHANGELOG.md view
@@ -1,3 +1,11 @@+1.6.1.++* BUG FIX: Fix `turtle` to build on Windows+* BUG FIX: `stripPrefix` and `commonPrefix` now correctly handle files with+ extensions+ * For example, before this fix `stripPrefix "./" "./foo.bar"` would+ return `Just "foo/.bar"`+ 1.6.0 * BREAKING CHANGE: Switch to the `FilePath` type from `base` instead of
src/Turtle/Internal.hs view
@@ -51,12 +51,16 @@ commonPrefix [ ] = mempty commonPrefix (path : paths) = foldr longestPathPrefix path paths where- longestPathPrefix left right =- FilePath.joinPath (longestPrefix leftComponents rightComponents)+ longestPathPrefix left right+ | leftComponents == rightComponents =+ FilePath.joinPath leftComponents+ ++ mconcat (longestPrefix leftExtensions rightExtensions)+ | otherwise =+ FilePath.joinPath (longestPrefix leftComponents rightComponents) where- leftComponents = splitExt (splitDirectories left)+ (leftComponents, leftExtensions) = splitExt (splitDirectories left) - rightComponents = splitExt (splitDirectories right)+ (rightComponents, rightExtensions) = splitExt (splitDirectories right) longestPrefix :: Eq a => [a] -> [a] -> [a] longestPrefix (l : ls) (r : rs)@@ -66,23 +70,30 @@ -- | Remove a prefix from a path stripPrefix :: FilePath -> FilePath -> Maybe FilePath stripPrefix prefix path = do- suffix <- List.stripPrefix prefixComponents pathComponents+ componentSuffix <- List.stripPrefix prefixComponents pathComponents - return (FilePath.joinPath suffix)+ if null componentSuffix+ then do+ prefixSuffix <- List.stripPrefix prefixExtensions pathExtensions++ return (mconcat prefixSuffix)+ else do+ return (FilePath.joinPath componentSuffix ++ mconcat pathExtensions) where- prefixComponents = splitExt (splitDirectories prefix)+ (prefixComponents, prefixExtensions) = splitExt (splitDirectories prefix) - pathComponents = splitExt (splitDirectories path)+ (pathComponents, pathExtensions) = splitExt (splitDirectories path) -- Internal helper function for `stripPrefix` and `commonPrefix`-splitExt :: [FilePath] -> [FilePath]-splitExt [ component ] = base : map ("." ++) exts+splitExt :: [FilePath] -> ([FilePath], [String])+splitExt [ component ] = ([ base ], map ("." ++) exts) where (base, exts) = splitExtensions component splitExt [ ] =- [ ]-splitExt (component : components) =- component : splitExt components+ ([ ], [ ])+splitExt (component : components) = (component : base, exts)+ where+ (base, exts) = splitExt components -- | Normalise a path collapse :: FilePath -> FilePath
src/Turtle/Prelude.hs view
@@ -982,13 +982,12 @@ reparse <- fmap reparsePoint (Win32.getFileAttributes path') if (canRead && not reparse) then bracket- (Win32.findFirstFile (Filesystem.encodeString (path </> "*")))+ (Win32.findFirstFile (path </> "*")) (\(h, _) -> Win32.findClose h) (\(h, fdat) -> do let loop x = do- file' <- Win32.getFindDataFileName fdat- let file = Filesystem.decodeString file'- x' <- if (file' /= "." && file' /= "..")+ file <- Win32.getFindDataFileName fdat+ x' <- if (file /= "." && file /= "..") then step x (path </> file) else return x more <- Win32.findNextFile h fdat@@ -1131,7 +1130,7 @@ -- a directory and fails to strip it as a prefix from `/tmp/foo`. Adding -- `(</> "")` to the end of the path makes clear that the path is a -- directory- Just suffix <- return (Internal.stripPrefix (oldTree ++ "/") oldPath)+ Just suffix <- return (Internal.stripPrefix (oldTree <> [ FilePath.pathSeparator ]) oldPath) let newPath = newTree </> suffix @@ -1221,7 +1220,7 @@ #ifdef mingw32_HOST_OS then do handle <- Win32.createFile- (Filesystem.encodeString file)+ file Win32.gENERIC_WRITE Win32.fILE_SHARE_NONE Nothing
test/system-filepath.hs view
@@ -27,9 +27,14 @@ test_Root :: TestTree test_Root = testCase "root" $ do "" @=? root ""+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "c:\\" @=? root "c:\\"+ "c:\\" @=? root "c:\\foo"+#else "/" @=? root "/"- "" @=? root "foo" "/" @=? root "/foo"+#endif+ "" @=? root "foo" test_Directory :: TestTree test_Directory = testCase "directory" $ do@@ -59,7 +64,11 @@ "../" @=? parent "../.." "../" @=? parent "../." +#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "c:\\" @=? parent "c:\\"+#else "/" @=? parent "/"+#endif "./" @=? parent "foo" "./" @=? parent "./foo" "./foo/" @=? parent "foo/bar"@@ -138,7 +147,6 @@ myAssert' "c:\\foo\\bar" myAssert "" myAssert "foo\\bar"- myAssert' "\\foo\\bar" #else myAssert' "/" myAssert' "/foo/bar"@@ -152,6 +160,7 @@ "./" @=? commonPrefix [".", "."] "" @=? commonPrefix [".", ".."] "foo/" @=? commonPrefix ["foo/bar", "foo/baz"]+ "foo/a.b" @=? commonPrefix ["foo/a.b.c", "foo/a.b.d"] "" @=? commonPrefix ["foo/", "bar/"] test_StripPrefix :: TestTree@@ -160,6 +169,8 @@ Just "/" @=? stripPrefix "" "/" Just "" @=? stripPrefix "/" "/" Just "foo" @=? stripPrefix "/" "/foo"+ Just "foo" @=? stripPrefix "./" "./foo"+ Just "foo.ext" @=? stripPrefix "./" "./foo.ext" Just "foo/bar" @=? stripPrefix "/" "/foo/bar" Just "bar" @=? stripPrefix "/foo/" "/foo/bar" Just "bar/baz" @=? stripPrefix "/foo/" "/foo/bar/baz"@@ -176,10 +187,15 @@ test_Collapse = testCase "collapse" $ do -- This behavior differs from the old `system-filepath` package, but this -- behavior is more correct in the presence of symlinks+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "foo\\..\\bar" @=? collapse "foo/../bar"+ "foo\\bar" @=? collapse "foo/bar"+ "foo\\bar" @=? collapse "foo/./bar"+#else "foo/../bar" @=? collapse "foo/../bar"- "foo/bar" @=? collapse "foo/bar" "foo/bar" @=? collapse "foo/./bar"+#endif test_SplitDirectories :: TestTree test_SplitDirectories = testCase "splitDirectories" $ do
turtle.cabal view
@@ -1,5 +1,5 @@ Name: turtle-Version: 1.6.0+Version: 1.6.1 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3