summaryrefslogtreecommitdiff
path: root/Utility/Path.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2020-01-02 12:34:10 -0400
committerJoey Hess <joeyh@joeyh.name>2020-01-02 12:42:57 -0400
commit9df8a6eb9405dde4464d27133c04f5ee539a85de (patch)
tree8a7ac5f52be8679f8a2525515a0b2c1b715c99ad /Utility/Path.hs
parent16022a8b98f4bc134542e78a42538364d2f97d92 (diff)
downloadgit-repair-9df8a6eb9405dde4464d27133c04f5ee539a85de.tar.gz
merge from git-annex and relicense accordingly
Merge git library and utility from git-annex. The former is now relicensed AGPL, so git-repair as a whole becomes AGPL. For simplicity, I am relicensing the remainder of the code in git-repair AGPL as well, per the header changes in this commit. While that code is also technically available under the GPL license, as it's been released under that license before, changes going forward will be only released by me under the AGPL.
Diffstat (limited to 'Utility/Path.hs')
-rw-r--r--Utility/Path.hs92
1 files changed, 34 insertions, 58 deletions
diff --git a/Utility/Path.hs b/Utility/Path.hs
index dc91ce5..ecc752c 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -5,10 +5,32 @@
- License: BSD-2-clause
-}
-{-# LANGUAGE PackageImports, CPP #-}
+{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
-module Utility.Path where
+module Utility.Path (
+ simplifyPath,
+ absPathFrom,
+ parentDir,
+ upFrom,
+ dirContains,
+ absPath,
+ relPathCwdToFile,
+ relPathDirToFile,
+ relPathDirToFileAbs,
+ segmentPaths,
+ runSegmentPaths,
+ relHome,
+ inPath,
+ searchPath,
+ dotfile,
+ sanitizeFilePath,
+ splitShortExtensions,
+
+ prop_upFrom_basics,
+ prop_relPathDirToFile_basics,
+ prop_relPathDirToFile_regressionTest,
+) where
import System.FilePath
import Data.List
@@ -17,17 +39,11 @@ import Data.Char
import Control.Applicative
import Prelude
-#ifdef mingw32_HOST_OS
-import qualified System.FilePath.Posix as Posix
-#else
-import System.Posix.Files
-import Utility.Exception
-#endif
-
import Utility.Monad
import Utility.UserInfo
import Utility.Directory
import Utility.Split
+import Utility.FileSystemEncoding
{- Simplifies a path, removing any "." component, collapsing "dir/..",
- and removing the trailing path separator.
@@ -97,7 +113,10 @@ prop_upFrom_basics dir
- are all equivilant.
-}
dirContains :: FilePath -> FilePath -> Bool
-dirContains a b = a == b || a' == b' || (addTrailingPathSeparator a') `isPrefixOf` b'
+dirContains a b = a == b
+ || a' == b'
+ || (addTrailingPathSeparator a') `isPrefixOf` b'
+ || a' == "." && normalise ("." </> b') == b'
where
a' = norm a
b' = norm b
@@ -185,20 +204,21 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
- we stop preserving ordering at that point. Presumably a user passing
- that many paths in doesn't care too much about order of the later ones.
-}
-segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
+segmentPaths :: [RawFilePath] -> [RawFilePath] -> [[RawFilePath]]
segmentPaths [] new = [new]
segmentPaths [_] new = [new] -- optimisation
segmentPaths (l:ls) new = found : segmentPaths ls rest
where
(found, rest) = if length ls < 100
- then partition (l `dirContains`) new
- else break (\p -> not (l `dirContains` p)) new
+ then partition inl new
+ else break (not . inl) new
+ inl f = fromRawFilePath l `dirContains` fromRawFilePath f
{- This assumes that it's cheaper to call segmentPaths on the result,
- than it would be to run the action separately with each path. In
- the case of git file list commands, that assumption tends to hold.
-}
-runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
+runSegmentPaths :: ([RawFilePath] -> IO [RawFilePath]) -> [RawFilePath] -> IO [[RawFilePath]]
runSegmentPaths a paths = segmentPaths paths <$> a paths
{- Converts paths in the home directory to use ~/ -}
@@ -247,50 +267,6 @@ dotfile file
where
f = takeFileName file
-{- Converts a DOS style path to a msys2 style path. Only on Windows.
- - Any trailing '\' is preserved as a trailing '/'
- -
- - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
- -
- - The virtual filesystem contains:
- - /c, /d, ... mount points for Windows drives
- -}
-toMSYS2Path :: FilePath -> FilePath
-#ifndef mingw32_HOST_OS
-toMSYS2Path = id
-#else
-toMSYS2Path p
- | null drive = recombine parts
- | otherwise = recombine $ "/" : driveletter drive : parts
- where
- (drive, p') = splitDrive p
- parts = splitDirectories p'
- driveletter = map toLower . takeWhile (/= ':')
- recombine = fixtrailing . Posix.joinPath
- fixtrailing s
- | hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
- | otherwise = s
-#endif
-
-{- Maximum size to use for a file in a specified directory.
- -
- - Many systems have a 255 byte limit to the name of a file,
- - so that's taken as the max if the system has a larger limit, or has no
- - limit.
- -}
-fileNameLengthLimit :: FilePath -> IO Int
-#ifdef mingw32_HOST_OS
-fileNameLengthLimit _ = return 255
-#else
-fileNameLengthLimit dir = do
- -- getPathVar can fail due to statfs(2) overflow
- l <- catchDefaultIO 0 $
- fromIntegral <$> getPathVar dir FileNameLimit
- if l <= 0
- then return 255
- else return $ minimum [l, 255]
-#endif
-
{- Given a string that we'd like to use as the basis for FilePath, but that
- was provided by a third party and is not to be trusted, returns the closest
- sane FilePath.