{-# 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 forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath -> FilePath
joinDrive FilePath
drive forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
joinPath forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [FilePath]
norm [] 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 [] = forall a. [a] -> [a]
reverse [FilePath]
c
norm [FilePath]
c (FilePath
p:[FilePath]
ps)
| FilePath
p' forall a. Eq a => a -> a -> Bool
== FilePath
".." Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
c) Bool -> Bool -> Bool
&& FilePath -> FilePath
dropTrailingPathSeparator ([FilePath]
c forall a. [a] -> Int -> a
!! Int
0) forall a. Eq a => a -> a -> Bool
/= FilePath
".." =
[FilePath] -> [FilePath] -> [FilePath]
norm (forall a. Int -> [a] -> [a]
drop Int
1 [FilePath]
c) [FilePath]
ps
| FilePath
p' forall a. Eq a => a -> a -> Bool
== FilePath
"." = [FilePath] -> [FilePath] -> [FilePath]
norm [FilePath]
c [FilePath]
ps
| Bool
otherwise = [FilePath] -> [FilePath] -> [FilePath]
norm (FilePath
pforall 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropTrailingPathSeparator
upFrom :: FilePath -> Maybe FilePath
upFrom :: FilePath -> Maybe FilePath
upFrom FilePath
dir
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dirs forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
joinDrive FilePath
drive forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
s forall a b. (a -> b) -> a -> b
$ 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ 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
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir = Bool
True
| FilePath
dir forall a. Eq a => a -> a -> Bool
== FilePath
"/" = Maybe FilePath
p forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
| Bool
otherwise = Maybe FilePath
p forall a. Eq a => a -> a -> Bool
/= 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 forall a. Eq a => a -> a -> Bool
== FilePath
b Bool -> Bool -> Bool
|| FilePath
a' forall a. Eq a => a -> a -> Bool
== FilePath
b' Bool -> Bool -> Bool
|| (FilePath -> FilePath
addTrailingPathSeparator FilePath
a') 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
absPath FilePath
from 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 forall a b. (a -> b) -> a -> b
$ [FilePath]
dotdots 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 = forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropTrailingPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropDrive
common :: [FilePath]
common = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall {a}. Eq a => (a, a) -> Bool
same forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
pfrom [FilePath]
pto
same :: (a, a) -> Bool
same (a
c,a
d) = a
c forall a. Eq a => a -> a -> Bool
== a
d
uncommon :: [FilePath]
uncommon = forall a. Int -> [a] -> [a]
drop Int
numcommon [FilePath]
pto
dotdots :: [FilePath]
dotdots = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
pfrom forall a. Num a => a -> a -> a
- Int
numcommon) FilePath
".."
numcommon :: Int
numcommon = 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
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
from Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
to = Bool
True
| FilePath
from forall a. Eq a => a -> a -> Bool
== FilePath
to = forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r
| Bool
otherwise = Bool -> Bool
not (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 forall a. a -> [a] -> [a]
: FilePath
"tmp", FilePath
"r", FilePath
"lll", FilePath
"xxx", FilePath
"yyy", FilePath
"18"])
([FilePath] -> FilePath
joinPath [Char
pathSeparator 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"])
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 forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
ls [FilePath]
rest
where
([FilePath]
found, [FilePath]
rest) = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ls forall a. Ord a => a -> a -> Bool
< Int
100
then forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath
l FilePath -> FilePath -> Bool
`dirContains`) [FilePath]
new
else 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if FilePath -> FilePath -> Bool
dirContains FilePath
home FilePath
path
then 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 = forall a. Maybe a -> Bool
isJust 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
command
check :: FilePath -> IO (Maybe FilePath)
check FilePath
f = 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 forall a. Eq a => a -> a -> Bool
== FilePath
"." = Bool
False
| FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
".." = Bool
False
| FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
"" = Bool
False
| Bool
otherwise = FilePath
"." 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 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
sanitize
where
sanitize :: Char -> Char
sanitize Char
c
| Char
c 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 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 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
maxextension Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
base) =
[FilePath] -> FilePath -> (FilePath, [FilePath])
go (FilePath
extforall 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
ext