{-# LANGUAGE CPP #-}
module Darcs.Util.Path
( encodeWhite
, decodeWhite
, encodeWhiteName
, decodeWhiteName
, AbsolutePath
, makeAbsolute
, ioAbsolute
, AbsolutePathOrStd
, makeAbsoluteOrStd
, ioAbsoluteOrStd
, useAbsoluteOrStd
, stdOut
, AbsoluteOrRemotePath
, ioAbsoluteOrRemote
, isRemote
, SubPath
, makeSubPathOf
, simpleSubPath
, floatSubPath
, makeRelativeTo
, FilePathOrURL(..)
, FilePathLike(toFilePath)
, getCurrentDirectory
, setCurrentDirectory
, getUniquePathName
, filterPaths
, Name
, name2fp
, makeName
, rawMakeName
, eqAnycase
, AnchoredPath(..)
, anchoredRoot
, appendPath
, anchorPath
, isPrefix
, movedirfilename
, parent
, parents
, replaceParent
, catPaths
, flatten
, inDarcsdir
, displayPath
, realPath
, isRoot
, darcsdirName
, floatPath
, unsafeFloatPath
) where
import Darcs.Prelude
import Control.Exception ( bracket_ )
import Control.Monad ( when, (<=<) )
import Darcs.Util.ByteString ( decodeLocale, encodeLocale )
import Data.Binary
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Char ( chr, isSpace, ord, toLower )
import Data.List ( inits, isPrefixOf, isSuffixOf, stripPrefix )
import GHC.Stack ( HasCallStack )
import qualified System.Directory ( setCurrentDirectory )
import System.Directory ( doesDirectoryExist, doesPathExist )
import qualified System.FilePath as NativeFilePath
import qualified System.FilePath.Posix as FilePath
import System.Posix.Files ( fileID, getFileStatus, isDirectory )
import Darcs.Util.Exception ( ifDoesNotExistError )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.URL ( isAbsolute, isHttpUrl, isRelative, isSshNopath, isSshUrl )
import qualified Darcs.Util.Workaround as Workaround ( getCurrentDirectory )
displayPath :: AnchoredPath -> FilePath
displayPath :: AnchoredPath -> String
displayPath AnchoredPath
p
| AnchoredPath -> Bool
isRoot AnchoredPath
p = String
"."
| Bool
otherwise = String -> AnchoredPath -> String
anchorPath String
"." AnchoredPath
p
realPath :: AnchoredPath -> FilePath
realPath :: AnchoredPath -> String
realPath = String -> AnchoredPath -> String
anchorPath String
""
encodeWhite :: FilePath -> String
encodeWhite :: String -> String
encodeWhite (Char
c:String
cs) | Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' =
Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Char -> Int
ord Char
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
encodeWhite String
cs
encodeWhite (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
encodeWhite String
cs
encodeWhite [] = []
decodeWhite :: String -> Either String FilePath
decodeWhite :: String -> Either String String
decodeWhite String
cs_ = String -> String -> Bool -> Either String String
go String
cs_ [] Bool
False
where go :: String -> String -> Bool -> Either String String
go String
"" String
acc Bool
True = String -> Either String String
forall a b. b -> Either a b
Right (String -> String
forall a. [a] -> [a]
reverse String
acc)
go String
"" String
_ Bool
False = String -> Either String String
forall a b. b -> Either a b
Right String
cs_
go (Char
'\\':String
cs) String
acc Bool
_ =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\\') String
cs of
(String
theord, Char
'\\':String
rest) ->
String -> String -> Bool -> Either String String
go String
rest (Int -> Char
chr (String -> Int
forall a. Read a => String -> a
read String
theord) Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Bool
True
(String, String)
_ -> String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"malformed filename: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs_
go (Char
c:String
cs) String
acc Bool
modified = String -> String -> Bool -> Either String String
go String
cs (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Bool
modified
class FilePathOrURL a where
toPath :: a -> String
class FilePathOrURL a => FilePathLike a where
toFilePath :: a -> FilePath
newtype SubPath = SubPath FilePath deriving (SubPath -> SubPath -> Bool
(SubPath -> SubPath -> Bool)
-> (SubPath -> SubPath -> Bool) -> Eq SubPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubPath -> SubPath -> Bool
== :: SubPath -> SubPath -> Bool
$c/= :: SubPath -> SubPath -> Bool
/= :: SubPath -> SubPath -> Bool
Eq, Eq SubPath
Eq SubPath =>
(SubPath -> SubPath -> Ordering)
-> (SubPath -> SubPath -> Bool)
-> (SubPath -> SubPath -> Bool)
-> (SubPath -> SubPath -> Bool)
-> (SubPath -> SubPath -> Bool)
-> (SubPath -> SubPath -> SubPath)
-> (SubPath -> SubPath -> SubPath)
-> Ord SubPath
SubPath -> SubPath -> Bool
SubPath -> SubPath -> Ordering
SubPath -> SubPath -> SubPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubPath -> SubPath -> Ordering
compare :: SubPath -> SubPath -> Ordering
$c< :: SubPath -> SubPath -> Bool
< :: SubPath -> SubPath -> Bool
$c<= :: SubPath -> SubPath -> Bool
<= :: SubPath -> SubPath -> Bool
$c> :: SubPath -> SubPath -> Bool
> :: SubPath -> SubPath -> Bool
$c>= :: SubPath -> SubPath -> Bool
>= :: SubPath -> SubPath -> Bool
$cmax :: SubPath -> SubPath -> SubPath
max :: SubPath -> SubPath -> SubPath
$cmin :: SubPath -> SubPath -> SubPath
min :: SubPath -> SubPath -> SubPath
Ord)
newtype AbsolutePath = AbsolutePath FilePath deriving (AbsolutePath -> AbsolutePath -> Bool
(AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool) -> Eq AbsolutePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsolutePath -> AbsolutePath -> Bool
== :: AbsolutePath -> AbsolutePath -> Bool
$c/= :: AbsolutePath -> AbsolutePath -> Bool
/= :: AbsolutePath -> AbsolutePath -> Bool
Eq, Eq AbsolutePath
Eq AbsolutePath =>
(AbsolutePath -> AbsolutePath -> Ordering)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> AbsolutePath)
-> (AbsolutePath -> AbsolutePath -> AbsolutePath)
-> Ord AbsolutePath
AbsolutePath -> AbsolutePath -> Bool
AbsolutePath -> AbsolutePath -> Ordering
AbsolutePath -> AbsolutePath -> AbsolutePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsolutePath -> AbsolutePath -> Ordering
compare :: AbsolutePath -> AbsolutePath -> Ordering
$c< :: AbsolutePath -> AbsolutePath -> Bool
< :: AbsolutePath -> AbsolutePath -> Bool
$c<= :: AbsolutePath -> AbsolutePath -> Bool
<= :: AbsolutePath -> AbsolutePath -> Bool
$c> :: AbsolutePath -> AbsolutePath -> Bool
> :: AbsolutePath -> AbsolutePath -> Bool
$c>= :: AbsolutePath -> AbsolutePath -> Bool
>= :: AbsolutePath -> AbsolutePath -> Bool
$cmax :: AbsolutePath -> AbsolutePath -> AbsolutePath
max :: AbsolutePath -> AbsolutePath -> AbsolutePath
$cmin :: AbsolutePath -> AbsolutePath -> AbsolutePath
min :: AbsolutePath -> AbsolutePath -> AbsolutePath
Ord)
data AbsolutePathOrStd = AP AbsolutePath | APStd deriving (AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
(AbsolutePathOrStd -> AbsolutePathOrStd -> Bool)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> Bool)
-> Eq AbsolutePathOrStd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
== :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$c/= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
/= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
Eq, Eq AbsolutePathOrStd
Eq AbsolutePathOrStd =>
(AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> Bool)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> Bool)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> Bool)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> Bool)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd)
-> (AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd)
-> Ord AbsolutePathOrStd
AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering
AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering
compare :: AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering
$c< :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
< :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$c<= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
<= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$c> :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
> :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$c>= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
>= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$cmax :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
max :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
$cmin :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
min :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
Ord)
data AbsoluteOrRemotePath = AbsP AbsolutePath | RmtP String deriving (AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
(AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool)
-> (AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool)
-> Eq AbsoluteOrRemotePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
== :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$c/= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
/= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
Eq, Eq AbsoluteOrRemotePath
Eq AbsoluteOrRemotePath =>
(AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Ordering)
-> (AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool)
-> (AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool)
-> (AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool)
-> (AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool)
-> (AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath)
-> (AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath)
-> Ord AbsoluteOrRemotePath
AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Ordering
AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Ordering
compare :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Ordering
$c< :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
< :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$c<= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
<= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$c> :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
> :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$c>= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
>= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$cmax :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
max :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
$cmin :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
min :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
Ord)
instance FilePathOrURL AbsolutePath where
toPath :: AbsolutePath -> String
toPath (AbsolutePath String
x) = String
x
instance FilePathOrURL SubPath where
toPath :: SubPath -> String
toPath (SubPath String
x) = String
x
instance FilePathOrURL AbsoluteOrRemotePath where
toPath :: AbsoluteOrRemotePath -> String
toPath (AbsP AbsolutePath
a) = AbsolutePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsolutePath
a
toPath (RmtP String
r) = String
r
instance FilePathOrURL FilePath where
toPath :: String -> String
toPath = String -> String
forall a. a -> a
id
instance FilePathLike AbsolutePath where
toFilePath :: AbsolutePath -> String
toFilePath (AbsolutePath String
x) = String
x
instance FilePathLike SubPath where
toFilePath :: SubPath -> String
toFilePath (SubPath String
x) = String
x
instance FilePathLike FilePath where
toFilePath :: String -> String
toFilePath = String -> String
forall a. a -> a
id
makeSubPathOf :: AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf :: AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf (AbsolutePath String
p1) (AbsolutePath String
p2) =
if String
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p2 Bool -> Bool -> Bool
|| (String
p1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
p2
then SubPath -> Maybe SubPath
forall a. a -> Maybe a
Just (SubPath -> Maybe SubPath) -> SubPath -> Maybe SubPath
forall a b. (a -> b) -> a -> b
$ String -> SubPath
SubPath (String -> SubPath) -> String -> SubPath
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
p2
else Maybe SubPath
forall a. Maybe a
Nothing
simpleSubPath :: HasCallStack => FilePath -> Maybe SubPath
simpleSubPath :: HasCallStack => String -> Maybe SubPath
simpleSubPath String
x | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x = String -> Maybe SubPath
forall a. HasCallStack => String -> a
error String
"simpleSubPath called with empty path"
| String -> Bool
isRelative String
x = SubPath -> Maybe SubPath
forall a. a -> Maybe a
Just (SubPath -> Maybe SubPath) -> SubPath -> Maybe SubPath
forall a b. (a -> b) -> a -> b
$ String -> SubPath
SubPath (String -> SubPath) -> String -> SubPath
forall a b. (a -> b) -> a -> b
$ String -> String
FilePath.normalise (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
pathToPosix String
x
| Bool
otherwise = Maybe SubPath
forall a. Maybe a
Nothing
ioAbsolute :: FilePath -> IO AbsolutePath
ioAbsolute :: String -> IO AbsolutePath
ioAbsolute String
dir =
do Bool
isdir <- String -> IO Bool
doesDirectoryExist String
dir
AbsolutePath
here <- IO AbsolutePath
getCurrentDirectory
if Bool
isdir
then IO () -> IO () -> IO AbsolutePath -> IO AbsolutePath
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (String -> IO ()
forall p. (HasCallStack, FilePathLike p) => p -> IO ()
setCurrentDirectory String
dir)
(String -> IO ()
forall p. (HasCallStack, FilePathLike p) => p -> IO ()
setCurrentDirectory (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
here)
IO AbsolutePath
getCurrentDirectory
else let super_dir :: String
super_dir = case String -> String
NativeFilePath.takeDirectory String
dir of
String
"" -> String
"."
String
d -> String
d
file :: String
file = String -> String
NativeFilePath.takeFileName String
dir
in do AbsolutePath
abs_dir <- if String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
super_dir
then AbsolutePath -> IO AbsolutePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsolutePath -> IO AbsolutePath)
-> AbsolutePath -> IO AbsolutePath
forall a b. (a -> b) -> a -> b
$ String -> AbsolutePath
AbsolutePath String
dir
else String -> IO AbsolutePath
ioAbsolute String
super_dir
AbsolutePath -> IO AbsolutePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsolutePath -> IO AbsolutePath)
-> AbsolutePath -> IO AbsolutePath
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String -> AbsolutePath
makeAbsolute AbsolutePath
abs_dir String
file
makeRelativeTo :: HasCallStack => AbsolutePath -> AbsolutePath -> IO (Maybe SubPath)
makeRelativeTo :: HasCallStack => AbsolutePath -> AbsolutePath -> IO (Maybe SubPath)
makeRelativeTo (AbsolutePath String
dir) (AbsolutePath String
path) = do
FileStatus
dir_stat <- String -> IO FileStatus
getFileStatus String
dir
let dir_id :: FileID
dir_id = FileStatus -> FileID
fileID FileStatus
dir_stat
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (FileStatus -> Bool
isDirectory FileStatus
dir_stat)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"makeRelativeTo called with non-dir " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir
FileID -> String -> [String] -> IO (Maybe SubPath)
findParent FileID
dir_id String
path []
where
findParent :: FileID -> String -> [String] -> IO (Maybe SubPath)
findParent FileID
dir_id String
ap [String]
acc = do
Maybe FileStatus
map_stat <- Maybe FileStatus -> IO (Maybe FileStatus) -> IO (Maybe FileStatus)
forall a. a -> IO a -> IO a
ifDoesNotExistError Maybe FileStatus
forall a. Maybe a
Nothing (FileStatus -> Maybe FileStatus
forall a. a -> Maybe a
Just (FileStatus -> Maybe FileStatus)
-> IO FileStatus -> IO (Maybe FileStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
ap)
case Maybe FileStatus
map_stat of
Just FileStatus
ap_stat | FileStatus -> FileID
fileID FileStatus
ap_stat FileID -> FileID -> Bool
forall a. Eq a => a -> a -> Bool
== FileID
dir_id -> do
Maybe SubPath -> IO (Maybe SubPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SubPath -> IO (Maybe SubPath))
-> Maybe SubPath -> IO (Maybe SubPath)
forall a b. (a -> b) -> a -> b
$ SubPath -> Maybe SubPath
forall a. a -> Maybe a
Just (SubPath -> Maybe SubPath) -> SubPath -> Maybe SubPath
forall a b. (a -> b) -> a -> b
$ String -> SubPath
SubPath (String -> SubPath) -> String -> SubPath
forall a b. (a -> b) -> a -> b
$ [String] -> String
FilePath.joinPath [String]
acc
Maybe FileStatus
_ -> do
let (String
parent_,String
child) =
String -> (String, String)
NativeFilePath.splitFileName (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$
String -> String
NativeFilePath.dropTrailingPathSeparator String
ap
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
child then
Maybe SubPath -> IO (Maybe SubPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SubPath
forall a. Maybe a
Nothing
else
FileID -> String -> [String] -> IO (Maybe SubPath)
findParent FileID
dir_id String
parent_ (String
childString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc)
makeAbsolute :: AbsolutePath -> FilePath -> AbsolutePath
makeAbsolute :: AbsolutePath -> String -> AbsolutePath
makeAbsolute AbsolutePath
a String
dir = if Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir) Bool -> Bool -> Bool
&& String -> Bool
isAbsolute String
dir
then String -> AbsolutePath
AbsolutePath (String -> String
normSlashes String
dir')
else AbsolutePath -> String -> AbsolutePath
ma AbsolutePath
a String
dir'
where
dir' :: String
dir' = String -> String
FilePath.normalise (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
pathToPosix String
dir
ma :: AbsolutePath -> String -> AbsolutePath
ma AbsolutePath
here (Char
'.':Char
'.':Char
'/':String
r) = AbsolutePath -> String -> AbsolutePath
ma (AbsolutePath -> AbsolutePath
takeDirectory AbsolutePath
here) String
r
ma AbsolutePath
here String
".." = AbsolutePath -> AbsolutePath
takeDirectory AbsolutePath
here
ma AbsolutePath
here String
"." = AbsolutePath
here
ma AbsolutePath
here String
"" = AbsolutePath
here
ma AbsolutePath
here String
r = AbsolutePath
here AbsolutePath -> String -> AbsolutePath
/- (Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
r)
(/-) :: AbsolutePath -> String -> AbsolutePath
AbsolutePath
x /- :: AbsolutePath -> String -> AbsolutePath
/- (Char
'/':String
r) = AbsolutePath
x AbsolutePath -> String -> AbsolutePath
/- String
r
(AbsolutePath String
"/") /- String
r = String -> AbsolutePath
AbsolutePath (Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
simpleClean String
r)
(AbsolutePath String
x) /- String
r = String -> AbsolutePath
AbsolutePath (String
xString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
simpleClean String
r)
simpleClean :: String -> String
simpleClean :: String -> String
simpleClean = String -> String
normSlashes (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pathToPosix
makeAbsoluteOrStd :: AbsolutePath -> String -> AbsolutePathOrStd
makeAbsoluteOrStd :: AbsolutePath -> String -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
_ String
"-" = AbsolutePathOrStd
APStd
makeAbsoluteOrStd AbsolutePath
a String
p = AbsolutePath -> AbsolutePathOrStd
AP (AbsolutePath -> AbsolutePathOrStd)
-> AbsolutePath -> AbsolutePathOrStd
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String -> AbsolutePath
makeAbsolute AbsolutePath
a String
p
stdOut :: AbsolutePathOrStd
stdOut :: AbsolutePathOrStd
stdOut = AbsolutePathOrStd
APStd
ioAbsoluteOrStd :: String -> IO AbsolutePathOrStd
ioAbsoluteOrStd :: String -> IO AbsolutePathOrStd
ioAbsoluteOrStd String
"-" = AbsolutePathOrStd -> IO AbsolutePathOrStd
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePathOrStd
APStd
ioAbsoluteOrStd String
p = AbsolutePath -> AbsolutePathOrStd
AP (AbsolutePath -> AbsolutePathOrStd)
-> IO AbsolutePath -> IO AbsolutePathOrStd
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO AbsolutePath
ioAbsolute String
p
useAbsoluteOrStd :: (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd :: forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd AbsolutePath -> a
_ a
f AbsolutePathOrStd
APStd = a
f
useAbsoluteOrStd AbsolutePath -> a
f a
_ (AP AbsolutePath
x) = AbsolutePath -> a
f AbsolutePath
x
ioAbsoluteOrRemote :: String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote :: String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
p = do
Bool
isdir <- String -> IO Bool
doesDirectoryExist String
p
if Bool -> Bool
not Bool
isdir
then AbsoluteOrRemotePath -> IO AbsoluteOrRemotePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsoluteOrRemotePath -> IO AbsoluteOrRemotePath)
-> AbsoluteOrRemotePath -> IO AbsoluteOrRemotePath
forall a b. (a -> b) -> a -> b
$ String -> AbsoluteOrRemotePath
RmtP (String -> AbsoluteOrRemotePath) -> String -> AbsoluteOrRemotePath
forall a b. (a -> b) -> a -> b
$
case () of ()
_ | String -> Bool
isSshNopath String
p -> String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"."
| String
"/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
p -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
p
| Bool
otherwise -> String
p
else AbsolutePath -> AbsoluteOrRemotePath
AbsP (AbsolutePath -> AbsoluteOrRemotePath)
-> IO AbsolutePath -> IO AbsoluteOrRemotePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO AbsolutePath
ioAbsolute String
p
isRemote :: AbsoluteOrRemotePath -> Bool
isRemote :: AbsoluteOrRemotePath -> Bool
isRemote (RmtP String
_) = Bool
True
isRemote AbsoluteOrRemotePath
_ = Bool
False
takeDirectory :: AbsolutePath -> AbsolutePath
takeDirectory :: AbsolutePath -> AbsolutePath
takeDirectory (AbsolutePath String
x) =
case String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
x of
String
"" -> String -> AbsolutePath
AbsolutePath String
"/"
String
x' -> String -> AbsolutePath
AbsolutePath String
x'
instance Show AbsolutePath where
show :: AbsolutePath -> String
show = String -> String
forall a. Show a => a -> String
show (String -> String)
-> (AbsolutePath -> String) -> AbsolutePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath
instance Show SubPath where
show :: SubPath -> String
show = String -> String
forall a. Show a => a -> String
show (String -> String) -> (SubPath -> String) -> SubPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath
instance Show AbsolutePathOrStd where
show :: AbsolutePathOrStd -> String
show (AP AbsolutePath
a) = AbsolutePath -> String
forall a. Show a => a -> String
show AbsolutePath
a
show AbsolutePathOrStd
APStd = String
"standard input/output"
instance Show AbsoluteOrRemotePath where
show :: AbsoluteOrRemotePath -> String
show (AbsP AbsolutePath
a) = AbsolutePath -> String
forall a. Show a => a -> String
show AbsolutePath
a
show (RmtP String
r) = String -> String
forall a. Show a => a -> String
show String
r
pathToPosix :: FilePath -> FilePath
#ifdef WIN32
pathToPosix = map convert where
convert '\\' = '/'
convert c = c
#else
pathToPosix :: String -> String
pathToPosix = String -> String
forall a. a -> a
id
#endif
normSlashes :: FilePath -> FilePath
#ifndef WIN32
normSlashes :: String -> String
normSlashes (Char
'/':String
p) = Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
p
#endif
normSlashes String
p = String
p
getCurrentDirectory :: IO AbsolutePath
getCurrentDirectory :: IO AbsolutePath
getCurrentDirectory = String -> AbsolutePath
AbsolutePath (String -> AbsolutePath) -> IO String -> IO AbsolutePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO String
Workaround.getCurrentDirectory
setCurrentDirectory :: HasCallStack => FilePathLike p => p -> IO ()
setCurrentDirectory :: forall p. (HasCallStack, FilePathLike p) => p -> IO ()
setCurrentDirectory p
path
| String -> Bool
isHttpUrl (p -> String
forall a. FilePathLike a => a -> String
toFilePath p
path) Bool -> Bool -> Bool
|| String -> Bool
isSshUrl (p -> String
forall a. FilePathLike a => a -> String
toFilePath p
path) =
String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"setCurrentDirectory " String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. FilePathLike a => a -> String
toFilePath p
path
setCurrentDirectory p
path = String -> IO ()
System.Directory.setCurrentDirectory (p -> String
forall a. FilePathLike a => a -> String
toFilePath p
path)
getUniquePathName :: Bool -> (FilePath -> String) -> (Int -> FilePath) -> IO FilePath
getUniquePathName :: Bool -> (String -> String) -> (Int -> String) -> IO String
getUniquePathName Bool
talkative String -> String
buildMsg Int -> String
buildName = Int -> IO String
go (-Int
1)
where
go :: Int -> IO FilePath
go :: Int -> IO String
go Int
i = do
Bool
exists <- String -> IO Bool
doesPathExist String
thename
if Bool -> Bool
not Bool
exists
then do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 Bool -> Bool -> Bool
&& Bool
talkative) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
buildMsg String
thename
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
thename
else Int -> IO String
go (Int -> IO String) -> Int -> IO String
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
where thename :: String
thename = Int -> String
buildName Int
i
newtype Name = Name { Name -> ByteString
unName :: B.ByteString } deriving (Get Name
[Name] -> Put
Name -> Put
(Name -> Put) -> Get Name -> ([Name] -> Put) -> Binary Name
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Name -> Put
put :: Name -> Put
$cget :: Get Name
get :: Get Name
$cputList :: [Name] -> Put
putList :: [Name] -> Put
Binary, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Int -> Name -> String -> String
[Name] -> String -> String
Name -> String
(Int -> Name -> String -> String)
-> (Name -> String) -> ([Name] -> String -> String) -> Show Name
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Name -> String -> String
showsPrec :: Int -> Name -> String -> String
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> String -> String
showList :: [Name] -> String -> String
Show, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord)
newtype AnchoredPath = AnchoredPath [Name] deriving (Get AnchoredPath
[AnchoredPath] -> Put
AnchoredPath -> Put
(AnchoredPath -> Put)
-> Get AnchoredPath
-> ([AnchoredPath] -> Put)
-> Binary AnchoredPath
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: AnchoredPath -> Put
put :: AnchoredPath -> Put
$cget :: Get AnchoredPath
get :: Get AnchoredPath
$cputList :: [AnchoredPath] -> Put
putList :: [AnchoredPath] -> Put
Binary, AnchoredPath -> AnchoredPath -> Bool
(AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath -> AnchoredPath -> Bool) -> Eq AnchoredPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnchoredPath -> AnchoredPath -> Bool
== :: AnchoredPath -> AnchoredPath -> Bool
$c/= :: AnchoredPath -> AnchoredPath -> Bool
/= :: AnchoredPath -> AnchoredPath -> Bool
Eq, Int -> AnchoredPath -> String -> String
[AnchoredPath] -> String -> String
AnchoredPath -> String
(Int -> AnchoredPath -> String -> String)
-> (AnchoredPath -> String)
-> ([AnchoredPath] -> String -> String)
-> Show AnchoredPath
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> AnchoredPath -> String -> String
showsPrec :: Int -> AnchoredPath -> String -> String
$cshow :: AnchoredPath -> String
show :: AnchoredPath -> String
$cshowList :: [AnchoredPath] -> String -> String
showList :: [AnchoredPath] -> String -> String
Show, Eq AnchoredPath
Eq AnchoredPath =>
(AnchoredPath -> AnchoredPath -> Ordering)
-> (AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath -> AnchoredPath -> AnchoredPath)
-> (AnchoredPath -> AnchoredPath -> AnchoredPath)
-> Ord AnchoredPath
AnchoredPath -> AnchoredPath -> Bool
AnchoredPath -> AnchoredPath -> Ordering
AnchoredPath -> AnchoredPath -> AnchoredPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AnchoredPath -> AnchoredPath -> Ordering
compare :: AnchoredPath -> AnchoredPath -> Ordering
$c< :: AnchoredPath -> AnchoredPath -> Bool
< :: AnchoredPath -> AnchoredPath -> Bool
$c<= :: AnchoredPath -> AnchoredPath -> Bool
<= :: AnchoredPath -> AnchoredPath -> Bool
$c> :: AnchoredPath -> AnchoredPath -> Bool
> :: AnchoredPath -> AnchoredPath -> Bool
$c>= :: AnchoredPath -> AnchoredPath -> Bool
>= :: AnchoredPath -> AnchoredPath -> Bool
$cmax :: AnchoredPath -> AnchoredPath -> AnchoredPath
max :: AnchoredPath -> AnchoredPath -> AnchoredPath
$cmin :: AnchoredPath -> AnchoredPath -> AnchoredPath
min :: AnchoredPath -> AnchoredPath -> AnchoredPath
Ord)
isPrefix :: AnchoredPath -> AnchoredPath -> Bool
(AnchoredPath [Name]
a) isPrefix :: AnchoredPath -> AnchoredPath -> Bool
`isPrefix` (AnchoredPath [Name]
b) = [Name]
a [Name] -> [Name] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Name]
b
appendPath :: AnchoredPath -> Name -> AnchoredPath
appendPath :: AnchoredPath -> Name -> AnchoredPath
appendPath (AnchoredPath [Name]
p) Name
n = [Name] -> AnchoredPath
AnchoredPath ([Name] -> AnchoredPath) -> [Name] -> AnchoredPath
forall a b. (a -> b) -> a -> b
$ [Name]
p [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
n]
catPaths :: AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths :: AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths (AnchoredPath [Name]
p) (AnchoredPath [Name]
n) = [Name] -> AnchoredPath
AnchoredPath ([Name]
p [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
n)
parent :: AnchoredPath -> Maybe AnchoredPath
parent :: AnchoredPath -> Maybe AnchoredPath
parent (AnchoredPath []) = Maybe AnchoredPath
forall a. Maybe a
Nothing
parent (AnchoredPath [Name]
x) = AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just ([Name] -> AnchoredPath
AnchoredPath ([Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
init [Name]
x))
parents :: AnchoredPath -> [AnchoredPath]
parents :: AnchoredPath -> [AnchoredPath]
parents (AnchoredPath []) = []
parents (AnchoredPath [Name]
xs) = ([Name] -> AnchoredPath) -> [[Name]] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map [Name] -> AnchoredPath
AnchoredPath ([[Name]] -> [AnchoredPath]) -> [[Name]] -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ [Name] -> [[Name]]
forall a. [a] -> [[a]]
inits ([Name] -> [[Name]]) -> [Name] -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
init [Name]
xs
anchorPath :: FilePath -> AnchoredPath -> FilePath
anchorPath :: String -> AnchoredPath -> String
anchorPath String
dir AnchoredPath
p = String
dir String -> String -> String
FilePath.</> ByteString -> String
decodeLocale (AnchoredPath -> ByteString
flatten AnchoredPath
p)
{-# INLINE anchorPath #-}
name2fp :: Name -> FilePath
name2fp :: Name -> String
name2fp (Name ByteString
ps) = ByteString -> String
decodeLocale ByteString
ps
flatten :: AnchoredPath -> BC.ByteString
flatten :: AnchoredPath -> ByteString
flatten (AnchoredPath []) = Char -> ByteString
BC.singleton Char
'.'
flatten (AnchoredPath [Name]
p) = ByteString -> [ByteString] -> ByteString
BC.intercalate (Char -> ByteString
BC.singleton Char
'/') [ByteString
n | (Name ByteString
n) <- [Name]
p]
makeName :: String -> Either String Name
makeName :: String -> Either String Name
makeName = ByteString -> Either String Name
rawMakeName (ByteString -> Either String Name)
-> (String -> ByteString) -> String -> Either String Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
encodeLocale
unsafeFloatPath :: HasCallStack => FilePath -> AnchoredPath
unsafeFloatPath :: HasCallStack => String -> AnchoredPath
unsafeFloatPath = (String -> AnchoredPath)
-> (AnchoredPath -> AnchoredPath)
-> Either String AnchoredPath
-> AnchoredPath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> AnchoredPath
forall a. HasCallStack => String -> a
error AnchoredPath -> AnchoredPath
forall a. a -> a
id (Either String AnchoredPath -> AnchoredPath)
-> (String -> Either String AnchoredPath) -> String -> AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String AnchoredPath
floatPath
floatPath :: FilePath -> Either String AnchoredPath
floatPath :: String -> Either String AnchoredPath
floatPath String
path = do
[Name]
r <- (String -> Either String Name) -> [String] -> Either String [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> Either String Name
makeName (String -> [String]
prepare String
path)
AnchoredPath -> Either String AnchoredPath
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> AnchoredPath
AnchoredPath [Name]
r)
where
sensible :: String -> Bool
sensible String
s = String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"", String
"."]
prepare :: String -> [String]
prepare = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
sensible ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [String]
NativeFilePath.splitDirectories (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
NativeFilePath.normalise (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String
NativeFilePath.dropTrailingPathSeparator
anchoredRoot :: AnchoredPath
anchoredRoot :: AnchoredPath
anchoredRoot = [Name] -> AnchoredPath
AnchoredPath []
parentChild :: AnchoredPath -> Maybe (AnchoredPath, Name)
parentChild :: AnchoredPath -> Maybe (AnchoredPath, Name)
parentChild (AnchoredPath []) = Maybe (AnchoredPath, Name)
forall a. Maybe a
Nothing
parentChild (AnchoredPath [Name]
xs) = (AnchoredPath, Name) -> Maybe (AnchoredPath, Name)
forall a. a -> Maybe a
Just ([Name] -> AnchoredPath
AnchoredPath ([Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
init [Name]
xs), [Name] -> Name
forall a. HasCallStack => [a] -> a
last [Name]
xs)
replaceParent :: AnchoredPath -> AnchoredPath -> Maybe AnchoredPath
replaceParent :: AnchoredPath -> AnchoredPath -> Maybe AnchoredPath
replaceParent (AnchoredPath [Name]
xs) AnchoredPath
p =
case AnchoredPath -> Maybe (AnchoredPath, Name)
parentChild AnchoredPath
p of
Maybe (AnchoredPath, Name)
Nothing -> Maybe AnchoredPath
forall a. Maybe a
Nothing
Just (AnchoredPath
_,Name
x) -> AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just ([Name] -> AnchoredPath
AnchoredPath ([Name]
xs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
x]))
rawMakeName :: B.ByteString -> Either String Name
rawMakeName :: ByteString -> Either String Name
rawMakeName ByteString
s
| ByteString -> Bool
isBadName ByteString
s =
String -> Either String Name
forall a b. a -> Either a b
Left (String -> Either String Name) -> String -> Either String Name
forall a b. (a -> b) -> a -> b
$ String
"'"String -> String -> String
forall a. [a] -> [a] -> [a]
++ByteString -> String
decodeLocale ByteString
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"' is not a valid AnchoredPath component name"
| Bool
otherwise = Name -> Either String Name
forall a b. b -> Either a b
Right (ByteString -> Name
Name ByteString
s)
isBadName :: B.ByteString -> Bool
isBadName :: ByteString -> Bool
isBadName ByteString
n = ByteString -> Bool
hasPathSeparator ByteString
n Bool -> Bool -> Bool
|| ByteString
n ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
forbiddenNames
forbiddenNames :: [B.ByteString]
forbiddenNames :: [ByteString]
forbiddenNames = [ByteString
BC.empty, String -> ByteString
BC.pack String
".", String -> ByteString
BC.pack String
".."]
hasPathSeparator :: B.ByteString -> Bool
hasPathSeparator :: ByteString -> Bool
hasPathSeparator = Char -> ByteString -> Bool
BC.elem Char
'/'
eqAnycase :: Name -> Name -> Bool
eqAnycase :: Name -> Name -> Bool
eqAnycase (Name ByteString
a) (Name ByteString
b) = (Char -> Char) -> ByteString -> ByteString
BC.map Char -> Char
toLower ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ByteString -> ByteString
BC.map Char -> Char
toLower ByteString
b
encodeWhiteName :: Name -> B.ByteString
encodeWhiteName :: Name -> ByteString
encodeWhiteName = String -> ByteString
encodeLocale (String -> ByteString) -> (Name -> String) -> Name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
encodeWhite (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
decodeLocale (ByteString -> String) -> (Name -> ByteString) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ByteString
unName
decodeWhiteName :: B.ByteString -> Either String Name
decodeWhiteName :: ByteString -> Either String Name
decodeWhiteName =
ByteString -> Either String Name
rawMakeName (ByteString -> Either String Name)
-> (String -> ByteString) -> String -> Either String Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
encodeLocale (String -> Either String Name)
-> (ByteString -> Either String String)
-> ByteString
-> Either String Name
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Either String String
decodeWhite (String -> Either String String)
-> (ByteString -> String) -> ByteString -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
decodeLocale
movedirfilename :: AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename :: AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename (AnchoredPath [Name]
old) newp :: AnchoredPath
newp@(AnchoredPath [Name]
new) orig :: AnchoredPath
orig@(AnchoredPath [Name]
path) =
case [Name] -> [Name] -> Maybe [Name]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Name]
old [Name]
path of
Just [] -> AnchoredPath
newp
Just [Name]
rest -> [Name] -> AnchoredPath
AnchoredPath ([Name]
new [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
rest)
Maybe [Name]
Nothing -> AnchoredPath
orig
filterPaths :: [AnchoredPath] -> AnchoredPath -> t -> Bool
filterPaths :: forall t. [AnchoredPath] -> AnchoredPath -> t -> Bool
filterPaths [AnchoredPath]
files AnchoredPath
p t
_ = (AnchoredPath -> Bool) -> [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\AnchoredPath
x -> AnchoredPath
x AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
p Bool -> Bool -> Bool
|| AnchoredPath
p AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
x) [AnchoredPath]
files
floatSubPath :: SubPath -> Either String AnchoredPath
floatSubPath :: SubPath -> Either String AnchoredPath
floatSubPath = String -> Either String AnchoredPath
floatPath (String -> Either String AnchoredPath)
-> (SubPath -> String) -> SubPath -> Either String AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath
inDarcsdir :: AnchoredPath -> Bool
inDarcsdir :: AnchoredPath -> Bool
inDarcsdir (AnchoredPath (Name
x:[Name]
_)) | Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
darcsdirName = Bool
True
inDarcsdir AnchoredPath
_ = Bool
False
darcsdirName :: Name
darcsdirName :: Name
darcsdirName = (String -> Name) -> (Name -> Name) -> Either String Name -> Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Name
forall a. HasCallStack => String -> a
error Name -> Name
forall a. a -> a
id (String -> Either String Name
makeName String
darcsdir)
isRoot :: AnchoredPath -> Bool
isRoot :: AnchoredPath -> Bool
isRoot (AnchoredPath [Name]
xs) = [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
xs