{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Path where
import System.FilePath
import Data.List
import Data.Maybe
import Data.Char
import Control.Applicative
import Prelude
import Utility.Monad
import Utility.UserInfo
import Utility.Directory
import Utility.Split
simplifyPath :: FilePath -> FilePath
simplifyPath :: FilePath -> FilePath
simplifyPath FilePath
path = FilePath -> FilePath
dropTrailingPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath -> FilePath
joinDrive FilePath
drive (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [FilePath]
norm [] ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
path'
where
(FilePath
drive, FilePath
path') = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path
norm :: [FilePath] -> [FilePath] -> [FilePath]
norm [FilePath]
c [] = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
c
norm [FilePath]
c (FilePath
p:[FilePath]
ps)
| FilePath
p' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".." Bool -> Bool -> Bool
&& Bool -> Bool
not ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
c) Bool -> Bool -> Bool
&& FilePath -> FilePath
dropTrailingPathSeparator ([FilePath]
c [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
0) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
".." =
[FilePath] -> [FilePath] -> [FilePath]
norm (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
1 [FilePath]
c) [FilePath]
ps
| FilePath
p' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." = [FilePath] -> [FilePath] -> [FilePath]
norm [FilePath]
c [FilePath]
ps
| Bool
otherwise = [FilePath] -> [FilePath] -> [FilePath]
norm (FilePath
pFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
c) [FilePath]
ps
where
p' :: FilePath
p' = FilePath -> FilePath
dropTrailingPathSeparator FilePath
p
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom FilePath
dir FilePath
path = FilePath -> FilePath
simplifyPath (FilePath -> FilePath -> FilePath
combine FilePath
dir FilePath
path)
parentDir :: FilePath -> FilePath
parentDir :: FilePath -> FilePath
parentDir = FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropTrailingPathSeparator
upFrom :: FilePath -> Maybe FilePath
upFrom :: FilePath -> Maybe FilePath
upFrom FilePath
dir
| [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dirs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Maybe FilePath
forall a. Maybe a
Nothing
| Bool
otherwise = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
joinDrive FilePath
drive (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
s ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
init [FilePath]
dirs
where
(FilePath
drive, FilePath
path) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
dir
s :: FilePath
s = [Char
pathSeparator]
dirs :: [FilePath]
dirs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
split FilePath
s FilePath
path
prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics FilePath
dir
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir = Bool
True
| FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/" = Maybe FilePath
p Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FilePath
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe FilePath
p Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir
where
p :: Maybe FilePath
p = FilePath -> Maybe FilePath
upFrom FilePath
dir
dirContains :: FilePath -> FilePath -> Bool
dirContains :: FilePath -> FilePath -> Bool
dirContains FilePath
a FilePath
b = FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b Bool -> Bool -> Bool
|| FilePath
a' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b' Bool -> Bool -> Bool
|| (FilePath -> FilePath
addTrailingPathSeparator FilePath
a') FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
b'
where
a' :: FilePath
a' = FilePath -> FilePath
norm FilePath
a
b' :: FilePath
b' = FilePath -> FilePath
norm FilePath
b
norm :: FilePath -> FilePath
norm = FilePath -> FilePath
normalise (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
simplifyPath
absPath :: FilePath -> IO FilePath
absPath :: FilePath -> IO FilePath
absPath FilePath
file = do
FilePath
cwd <- IO FilePath
getCurrentDirectory
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
absPathFrom FilePath
cwd FilePath
file
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile FilePath
f = do
FilePath
c <- IO FilePath
getCurrentDirectory
FilePath -> FilePath -> IO FilePath
relPathDirToFile FilePath
c FilePath
f
relPathDirToFile :: FilePath -> FilePath -> IO FilePath
relPathDirToFile :: FilePath -> FilePath -> IO FilePath
relPathDirToFile FilePath
from FilePath
to = FilePath -> FilePath -> FilePath
relPathDirToFileAbs (FilePath -> FilePath -> FilePath)
-> IO FilePath -> IO (FilePath -> FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
absPath FilePath
from IO (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO FilePath
absPath FilePath
to
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
from FilePath
to
#ifdef mingw32_HOST_OS
| normdrive from /= normdrive to = to
#endif
| Bool
otherwise = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
dotdots [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
uncommon
where
pfrom :: [FilePath]
pfrom = FilePath -> [FilePath]
sp FilePath
from
pto :: [FilePath]
pto = FilePath -> [FilePath]
sp FilePath
to
sp :: FilePath -> [FilePath]
sp = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropTrailingPathSeparator ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropDrive
common :: [FilePath]
common = ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath, FilePath) -> Bool
forall {a}. Eq a => (a, a) -> Bool
same ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
pfrom [FilePath]
pto
same :: (a, a) -> Bool
same (a
c,a
d) = a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d
uncommon :: [FilePath]
uncommon = Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
numcommon [FilePath]
pto
dotdots :: [FilePath]
dotdots = Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
pfrom Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numcommon) FilePath
".."
numcommon :: Int
numcommon = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
common
#ifdef mingw32_HOST_OS
normdrive = map toLower . takeWhile (/= ':') . takeDrive
#endif
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics FilePath
from FilePath
to
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
from Bool -> Bool -> Bool
|| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
to = Bool
True
| FilePath
from FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
to = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r
| Bool
otherwise = Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r)
where
r :: FilePath
r = FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
from FilePath
to
prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest = Bool
same_dir_shortcurcuits_at_difference
where
same_dir_shortcurcuits_at_difference :: Bool
same_dir_shortcurcuits_at_difference =
FilePath -> FilePath -> FilePath
relPathDirToFileAbs ([FilePath] -> FilePath
joinPath [Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
"tmp", FilePath
"r", FilePath
"lll", FilePath
"xxx", FilePath
"yyy", FilePath
"18"])
([FilePath] -> FilePath
joinPath [Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
"tmp", FilePath
"r", FilePath
".git", FilePath
"annex", FilePath
"objects", FilePath
"18", FilePath
"gk", FilePath
"SHA256-foo", FilePath
"SHA256-foo"])
FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath] -> FilePath
joinPath [FilePath
"..", FilePath
"..", FilePath
"..", FilePath
"..", FilePath
".git", FilePath
"annex", FilePath
"objects", FilePath
"18", FilePath
"gk", FilePath
"SHA256-foo", FilePath
"SHA256-foo"]
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [] [FilePath]
new = [[FilePath]
new]
segmentPaths [FilePath
_] [FilePath]
new = [[FilePath]
new]
segmentPaths (FilePath
l:[FilePath]
ls) [FilePath]
new = [FilePath]
found [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
ls [FilePath]
rest
where
([FilePath]
found, [FilePath]
rest) = if [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100
then (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath
l FilePath -> FilePath -> Bool
`dirContains`) [FilePath]
new
else (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\FilePath
p -> Bool -> Bool
not (FilePath
l FilePath -> FilePath -> Bool
`dirContains` FilePath
p)) [FilePath]
new
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
runSegmentPaths [FilePath] -> IO [FilePath]
a [FilePath]
paths = [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
paths ([FilePath] -> [[FilePath]]) -> IO [FilePath] -> IO [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO [FilePath]
a [FilePath]
paths
relHome :: FilePath -> IO String
relHome :: FilePath -> IO FilePath
relHome FilePath
path = do
FilePath
home <- IO FilePath
myHomeDir
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ if FilePath -> FilePath -> Bool
dirContains FilePath
home FilePath
path
then FilePath
"~/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
home FilePath
path
else FilePath
path
inPath :: String -> IO Bool
inPath :: FilePath -> IO Bool
inPath FilePath
command = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
searchPath FilePath
command
searchPath :: String -> IO (Maybe FilePath)
searchPath :: FilePath -> IO (Maybe FilePath)
searchPath FilePath
command
| FilePath -> Bool
isAbsolute FilePath
command = FilePath -> IO (Maybe FilePath)
check FilePath
command
| Bool
otherwise = IO [FilePath]
getSearchPath IO [FilePath]
-> ([FilePath] -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO (Maybe FilePath)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM FilePath -> IO (Maybe FilePath)
indir
where
indir :: FilePath -> IO (Maybe FilePath)
indir FilePath
d = FilePath -> IO (Maybe FilePath)
check (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
command
check :: FilePath -> IO (Maybe FilePath)
check FilePath
f = (FilePath -> IO Bool) -> [FilePath] -> IO (Maybe FilePath)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM FilePath -> IO Bool
doesFileExist
#ifdef mingw32_HOST_OS
[f, f ++ ".exe"]
#else
[FilePath
f]
#endif
dotfile :: FilePath -> Bool
dotfile :: FilePath -> Bool
dotfile FilePath
file
| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." = Bool
False
| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".." = Bool
False
| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" = Bool
False
| Bool
otherwise = FilePath
"." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f Bool -> Bool -> Bool
|| FilePath -> Bool
dotfile (FilePath -> FilePath
takeDirectory FilePath
file)
where
f :: FilePath
f = FilePath -> FilePath
takeFileName FilePath
file
sanitizeFilePath :: String -> FilePath
sanitizeFilePath :: FilePath -> FilePath
sanitizeFilePath = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
sanitize
where
sanitize :: Char -> Char
sanitize Char
c
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = Char
c
| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = Char
'_'
| Bool
otherwise = Char
c
splitShortExtensions :: FilePath -> (FilePath, [String])
splitShortExtensions :: FilePath -> (FilePath, [FilePath])
splitShortExtensions = Int -> FilePath -> (FilePath, [FilePath])
splitShortExtensions' Int
5
splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])
splitShortExtensions' :: Int -> FilePath -> (FilePath, [FilePath])
splitShortExtensions' Int
maxextension = [FilePath] -> FilePath -> (FilePath, [FilePath])
go []
where
go :: [FilePath] -> FilePath -> (FilePath, [FilePath])
go [FilePath]
c FilePath
f
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxextension Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
base) =
[FilePath] -> FilePath -> (FilePath, [FilePath])
go (FilePath
extFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
c) FilePath
base
| Bool
otherwise = (FilePath
f, [FilePath]
c)
where
(FilePath
base, FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
f
len :: Int
len = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
ext