-- Copyright (C) 2007 Eric Kow
-- Copyright (C) 2010 Petr Rockai
--
-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use, copy,
-- modify, merge, publish, distribute, sublicense, and/or sell copies
-- of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.

{-# LANGUAGE CPP #-}
module Darcs.Util.Path
    ( FileName( )
    , fp2fn
    , fn2fp
    , fn2ps
    , ps2fn
    , breakOnDir
    , normPath
    , ownName
    , superName
    , movedirfilename
    , encodeWhite
    , decodeWhite
    , encodeWhiteName
    , decodeWhiteName
    , isParentOrEqOf
    -- * AbsolutePath
    , AbsolutePath
    , makeAbsolute
    , ioAbsolute
    , rootDirectory
    -- * AbsolutePathOrStd
    , AbsolutePathOrStd
    , makeAbsoluteOrStd
    , ioAbsoluteOrStd
    , useAbsoluteOrStd
    , stdOut
    -- * AbsoluteOrRemotePath
    , AbsoluteOrRemotePath
    , ioAbsoluteOrRemote
    , isRemote
    -- * SubPath
    , SubPath
    , makeSubPathOf
    , simpleSubPath
    , isSubPathOf
    , floatSubPath
    -- * Miscellaneous
    , sp2fn
    , FilePathOrURL(..)
    , FilePathLike(toFilePath)
    , getCurrentDirectory
    , setCurrentDirectory
    , getUniquePathName
    , doesPathExist
    -- * Check for malicious paths
    , isMaliciousPath
    , isMaliciousSubPath
    -- * Tree filtering.
    , filterFilePaths
    , filterPaths
    -- * AnchoredPaths: relative paths within a Tree. All paths are
    -- anchored at a certain root (this is usually the Tree root). They are
    -- represented by a list of Names (these are just strict bytestrings).
    , Name
    , unsafeMakeName
    , eqAnycase
    , AnchoredPath(..)
    , anchoredRoot
    , appendPath
    , anchorPath
    , isPrefix
    , parent, parents, catPaths, flatten, makeName, appendToName
    -- * Unsafe AnchoredPath functions.
    , floatPath, replacePrefixPath ) where

import Prelude ()
import Darcs.Prelude

import Data.List
    ( isPrefixOf
    , isSuffixOf
    , stripPrefix
    , intersect
    , inits
    )
import Data.Char ( isSpace, chr, ord, toLower )
import Control.Exception ( tryJust, bracket_ )
import Control.Monad ( when )
import System.IO.Error ( isDoesNotExistError )

import qualified Darcs.Util.Workaround as Workaround ( getCurrentDirectory )
import qualified System.Directory ( setCurrentDirectory )
import System.Directory ( doesDirectoryExist, doesFileExist )
import qualified System.FilePath.Posix as FilePath ( normalise, isRelative )
import qualified System.FilePath as NativeFilePath ( takeFileName, takeDirectory )
import System.FilePath( (</>), splitDirectories, normalise, dropTrailingPathSeparator )
import System.Posix.Files ( isDirectory, getSymbolicLinkStatus )

import Darcs.Util.ByteString ( encodeLocale, decodeLocale )
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString       as B

import Data.Binary
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.URL ( isAbsolute, isRelative, isSshNopath )

-- | FileName is an abstract type intended to facilitate the input and output of
-- unicode filenames.
newtype FileName = FN FilePath deriving ( FileName -> FileName -> Bool
(FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool) -> Eq FileName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileName -> FileName -> Bool
$c/= :: FileName -> FileName -> Bool
== :: FileName -> FileName -> Bool
$c== :: FileName -> FileName -> Bool
Eq, Eq FileName
Eq FileName =>
(FileName -> FileName -> Ordering)
-> (FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool)
-> (FileName -> FileName -> FileName)
-> (FileName -> FileName -> FileName)
-> Ord FileName
FileName -> FileName -> Bool
FileName -> FileName -> Ordering
FileName -> FileName -> FileName
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
min :: FileName -> FileName -> FileName
$cmin :: FileName -> FileName -> FileName
max :: FileName -> FileName -> FileName
$cmax :: FileName -> FileName -> FileName
>= :: FileName -> FileName -> Bool
$c>= :: FileName -> FileName -> Bool
> :: FileName -> FileName -> Bool
$c> :: FileName -> FileName -> Bool
<= :: FileName -> FileName -> Bool
$c<= :: FileName -> FileName -> Bool
< :: FileName -> FileName -> Bool
$c< :: FileName -> FileName -> Bool
compare :: FileName -> FileName -> Ordering
$ccompare :: FileName -> FileName -> Ordering
$cp1Ord :: Eq FileName
Ord )

instance Show FileName where
   showsPrec :: Int -> FileName -> ShowS
showsPrec d :: Int
d (FN fp :: String
fp) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "fp2fn " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) String
fp
      where appPrec :: Int
appPrec = 10

instance Binary FileName where
  put :: FileName -> Put
put (FN h :: String
h) = String -> Put
forall t. Binary t => t -> Put
put String
h
  get :: Get FileName
get = String -> FileName
FN (String -> FileName) -> Get String -> Get FileName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get String
forall t. Binary t => Get t
get

{-# INLINE fp2fn #-}
fp2fn :: FilePath -> FileName
fp2fn :: String -> FileName
fp2fn = String -> FileName
FN

{-# INLINE fn2fp #-}
fn2fp :: FileName -> FilePath
fn2fp :: FileName -> String
fn2fp (FN fp :: String
fp) = String
fp

{-# INLINE fn2ps #-}
fn2ps :: FileName -> B.ByteString
fn2ps :: FileName -> ByteString
fn2ps (FN fp :: String
fp) = String -> ByteString
encodeLocale (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
encodeWhite String
fp

{-# INLINE ps2fn #-}
ps2fn :: B.ByteString -> FileName
ps2fn :: ByteString -> FileName
ps2fn ps :: ByteString
ps = String -> FileName
FN (String -> FileName) -> String -> FileName
forall a b. (a -> b) -> a -> b
$ ShowS
decodeWhite ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
decodeLocale ByteString
ps

{-# INLINE sp2fn #-}
sp2fn :: SubPath -> FileName
sp2fn :: SubPath -> FileName
sp2fn = String -> FileName
fp2fn (String -> FileName) -> (SubPath -> String) -> SubPath -> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath

-- | 'encodeWhite' translates whitespace in filenames to a darcs-specific
--   format (numerical representation according to 'ord' surrounded by
--   backslashes).  Note that backslashes are also escaped since they are used
--   in the encoding.
--
--   > encodeWhite "hello there" == "hello\32\there"
--   > encodeWhite "hello\there" == "hello\92\there"
encodeWhite :: FilePath -> String
encodeWhite :: ShowS
encodeWhite (c :: Char
c:cs :: String
cs) | Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' =
    '\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Char -> Int
ord Char
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
encodeWhite String
cs
encodeWhite (c :: Char
c:cs :: String
cs) = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeWhite String
cs
encodeWhite [] = []

-- | 'decodeWhite' interprets the Darcs-specific \"encoded\" filenames
--   produced by 'encodeWhite'
--
--   > decodeWhite "hello\32\there"  == "hello there"
--   > decodeWhite "hello\92\there"  == "hello\there"
--   > decodeWhite "hello\there"   == error "malformed filename"
decodeWhite :: String -> FilePath
decodeWhite :: ShowS
decodeWhite cs_ :: String
cs_ = String -> String -> Bool -> String
go String
cs_ [] Bool
False
 where go :: String -> String -> Bool -> String
go "" acc :: String
acc True  = ShowS
forall a. [a] -> [a]
reverse String
acc -- if there was a replace, use new string
       go "" _   False = String
cs_         -- if not, use input string
       go ('\\':cs :: String
cs) acc :: String
acc _ =
         case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\\') String
cs of
           (theord :: String
theord, '\\':rest :: String
rest) ->
             String -> String -> Bool -> String
go String
rest (Int -> Char
chr (String -> Int
forall a. Read a => String -> a
read String
theord) Char -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
True
           _ -> ShowS
forall a. HasCallStack => String -> a
error "malformed filename"
       go (c :: Char
c:cs :: String
cs) acc :: String
acc modified :: Bool
modified = String -> String -> Bool -> String
go String
cs (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
modified

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
. ShowS
encodeWhite ShowS -> (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 -> Name
decodeWhiteName :: ByteString -> Name
decodeWhiteName = ByteString -> Name
Name (ByteString -> Name)
-> (ByteString -> ByteString) -> ByteString -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
encodeLocale (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
decodeWhite ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
decodeLocale

ownName :: FileName -> FileName
ownName :: FileName -> FileName
ownName (FN f :: String
f) =  case Char -> String -> Maybe (String, String)
breakLast '/' String
f of Nothing -> String -> FileName
FN String
f
                                          Just (_,f' :: String
f') -> String -> FileName
FN String
f'
superName :: FileName -> FileName
superName :: FileName -> FileName
superName fn :: FileName
fn = case FileName -> FileName
normPath FileName
fn of
                FN f :: String
f -> case Char -> String -> Maybe (String, String)
breakLast '/' String
f of
                        Nothing -> String -> FileName
FN "."
                        Just (d :: String
d,_) -> String -> FileName
FN String
d
breakOnDir :: FileName -> Maybe (FileName,FileName)
breakOnDir :: FileName -> Maybe (FileName, FileName)
breakOnDir (FN p :: String
p) = case Char -> String -> Maybe (String, String)
breakFirst '/' String
p of
                      Nothing -> Maybe (FileName, FileName)
forall a. Maybe a
Nothing
                      Just (d :: String
d,f :: String
f) | String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "." -> FileName -> Maybe (FileName, FileName)
breakOnDir (FileName -> Maybe (FileName, FileName))
-> FileName -> Maybe (FileName, FileName)
forall a b. (a -> b) -> a -> b
$ String -> FileName
FN String
f
                                 | Bool
otherwise -> (FileName, FileName) -> Maybe (FileName, FileName)
forall a. a -> Maybe a
Just (String -> FileName
FN String
d, String -> FileName
FN String
f)

-- | convert a path string into a sequence of directories strings
--   "/", "." and ".." are generally interpreted as expected.
--   Behaviour with too many '..' is to leave them.
--
--   Examples:
--     Splitting:
--       "aa/bb/cc"       -> ["aa","bb","cc"]
--     Ignoring "." and extra "/":
--       "aa/./bb"        -> ["aa","bb"]
--       "aa//bb"         -> ["aa","bb"]
--       "/aa/bb/"        -> ["aa","bb"]
--     Handling "..":
--       "aa/../bb/cc"    -> ["bb","cc"]
--       "aa/bb/../../cc" -> ["cc"]
--       "aa/../bb/../cc" -> ["cc"]
--       "../cc"          -> ["..","cc"]
normPath :: FileName -> FileName
normPath :: FileName -> FileName
normPath (FN p :: String
p) = String -> FileName
FN (String -> FileName) -> String -> FileName
forall a b. (a -> b) -> a -> b
$ ShowS
norm String
p

norm :: String -> String
norm :: ShowS
norm ('.':'/':s :: String
s) = ShowS
norm String
s
norm ('/':s :: String
s)     = ShowS
norm String
s
norm "."         = ""
norm s :: String
s = String -> String -> Bool -> String
go String
s [] Bool
False
 where go :: String -> String -> Bool -> String
go "" _   False = String
s           -- no modification
       go "" acc :: String
acc True  = ShowS
forall a. [a] -> [a]
reverse String
acc
       go ('/':r :: String
r)         acc :: String
acc _ | String -> Bool
sep String
r = String -> String -> Bool -> String
go String
r String
acc Bool
True
       go ('/':'.':r :: String
r)     acc :: String
acc _ | String -> Bool
sep String
r = String -> String -> Bool -> String
go String
r String
acc Bool
True
       go ('/':'.':'.':r :: String
r) acc :: String
acc _ | String -> Bool
sep String
r = String -> String -> Bool -> String
go String
r (ShowS
doDotDot String
acc) Bool
True
       go (c :: Char
c:s' :: String
s') acc :: String
acc changed :: Bool
changed = String -> String -> Bool -> String
go String
s' (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
changed
       -- remove last path or add "/.." if impossible
       doDotDot :: ShowS
doDotDot ""                       = ".."
       doDotDot acc :: String
acc@('.':'.':r :: String
r) | String -> Bool
sep String
r  = '.'Char -> ShowS
forall a. a -> [a] -> [a]
:'.'Char -> ShowS
forall a. a -> [a] -> [a]
:'/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
acc
       doDotDot acc :: String
acc = let a' :: String
a' = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='/') String
acc in -- eat dir
                       if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a' then "" else ShowS
forall a. [a] -> [a]
tail String
a'
       -- check if is a path separator
       sep :: String -> Bool
sep ('/':_) = Bool
True
       sep []      = Bool
True -- end of string is considered separator
       sep _       = Bool
False

breakFirst :: Char -> String -> Maybe (String,String)
breakFirst :: Char -> String -> Maybe (String, String)
breakFirst c :: Char
c = String -> String -> Maybe (String, String)
bf []
    where bf :: String -> String -> Maybe (String, String)
bf a :: String
a (r :: Char
r:rs :: String
rs) | Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (ShowS
forall a. [a] -> [a]
reverse String
a,String
rs)
                      | Bool
otherwise = String -> String -> Maybe (String, String)
bf (Char
rChar -> ShowS
forall a. a -> [a] -> [a]
:String
a) String
rs
          bf _ [] = Maybe (String, String)
forall a. Maybe a
Nothing
breakLast :: Char -> String -> Maybe (String,String)
breakLast :: Char -> String -> Maybe (String, String)
breakLast c :: Char
c l :: String
l = case Char -> String -> Maybe (String, String)
breakFirst Char
c (ShowS
forall a. [a] -> [a]
reverse String
l) of
                Nothing -> Maybe (String, String)
forall a. Maybe a
Nothing
                Just (a :: String
a,b :: String
b) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (ShowS
forall a. [a] -> [a]
reverse String
b, ShowS
forall a. [a] -> [a]
reverse String
a)

isParentOrEqOf :: FileName -> FileName -> Bool
isParentOrEqOf :: FileName -> FileName -> Bool
isParentOrEqOf fn1 :: FileName
fn1 fn2 :: FileName
fn2 = case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FileName -> String
fn2fp FileName
fn1) (FileName -> String
fn2fp FileName
fn2) of
    Just ('/' : _) -> Bool
True
    Just [] -> Bool
True
    _ -> Bool
False

movedirfilename :: FileName -> FileName -> FileName -> FileName
movedirfilename :: FileName -> FileName -> FileName -> FileName
movedirfilename old :: FileName
old new :: FileName
new name :: FileName
name =
    if String
name' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
old'
        then FileName
new
        else case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
old' String
name' of
            Just rest :: String
rest@('/':_) -> String -> FileName
fp2fn (String -> FileName) -> String -> FileName
forall a b. (a -> b) -> a -> b
$ "./" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
new' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest
            _ -> FileName
name
        where old' :: String
old' = FileName -> String
fn2fp (FileName -> String) -> FileName -> String
forall a b. (a -> b) -> a -> b
$ FileName -> FileName
normPath FileName
old
              new' :: String
new' = FileName -> String
fn2fp (FileName -> String) -> FileName -> String
forall a b. (a -> b) -> a -> b
$ FileName -> FileName
normPath FileName
new
              name' :: String
name' = FileName -> String
fn2fp (FileName -> String) -> FileName -> String
forall a b. (a -> b) -> a -> b
$ FileName -> FileName
normPath FileName
name


class FilePathOrURL a where
  toPath :: a -> String

class FilePathOrURL a => FilePathLike a where
  toFilePath :: a -> FilePath

-- | Paths which are relative to the local darcs repository and normalized.
-- Note: These are understood not to have the dot in front.
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
/= :: SubPath -> SubPath -> Bool
$c/= :: SubPath -> SubPath -> Bool
== :: SubPath -> SubPath -> Bool
$c== :: 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
min :: SubPath -> SubPath -> SubPath
$cmin :: SubPath -> SubPath -> SubPath
max :: SubPath -> SubPath -> SubPath
$cmax :: SubPath -> SubPath -> SubPath
>= :: SubPath -> SubPath -> Bool
$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
compare :: SubPath -> SubPath -> Ordering
$ccompare :: SubPath -> SubPath -> Ordering
$cp1Ord :: Eq 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
/= :: AbsolutePath -> AbsolutePath -> Bool
$c/= :: AbsolutePath -> AbsolutePath -> Bool
== :: AbsolutePath -> AbsolutePath -> Bool
$c== :: 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
min :: AbsolutePath -> AbsolutePath -> AbsolutePath
$cmin :: AbsolutePath -> AbsolutePath -> AbsolutePath
max :: AbsolutePath -> AbsolutePath -> AbsolutePath
$cmax :: AbsolutePath -> AbsolutePath -> AbsolutePath
>= :: AbsolutePath -> AbsolutePath -> Bool
$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
compare :: AbsolutePath -> AbsolutePath -> Ordering
$ccompare :: AbsolutePath -> AbsolutePath -> Ordering
$cp1Ord :: Eq AbsolutePath
Ord)

-- | This is for situations where a string (e.g. a command line argument)
-- may take the value \"-\" to mean stdin or stdout (which one depends on
-- context) instead of a normal file path.
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
/= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$c/= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
== :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$c== :: 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
min :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
$cmin :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
max :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
$cmax :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd
>= :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool
$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
compare :: AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering
$ccompare :: AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering
$cp1Ord :: Eq 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
/= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$c/= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
== :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$c== :: 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
min :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
$cmin :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
max :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
$cmax :: AbsoluteOrRemotePath
-> AbsoluteOrRemotePath -> AbsoluteOrRemotePath
>= :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Bool
$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
compare :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Ordering
$ccompare :: AbsoluteOrRemotePath -> AbsoluteOrRemotePath -> Ordering
$cp1Ord :: Eq AbsoluteOrRemotePath
Ord)

instance FilePathOrURL AbsolutePath where
  toPath :: AbsolutePath -> String
toPath (AbsolutePath x :: String
x) = String
x
instance FilePathOrURL SubPath where
  toPath :: SubPath -> String
toPath (SubPath x :: String
x) = String
x
instance CharLike c => FilePathOrURL [c] where
  toPath :: [c] -> String
toPath = [c] -> String
forall a. FilePathLike a => a -> String
toFilePath

instance FilePathOrURL AbsoluteOrRemotePath where
  toPath :: AbsoluteOrRemotePath -> String
toPath (AbsP a :: AbsolutePath
a) = AbsolutePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsolutePath
a
  toPath (RmtP r :: String
r) = String
r

instance FilePathOrURL FileName where
  toPath :: FileName -> String
toPath = FileName -> String
fn2fp
instance FilePathLike FileName where
  toFilePath :: FileName -> String
toFilePath = FileName -> String
fn2fp

instance FilePathLike AbsolutePath where
  toFilePath :: AbsolutePath -> String
toFilePath (AbsolutePath x :: String
x) = String
x
instance FilePathLike SubPath where
  toFilePath :: SubPath -> String
toFilePath (SubPath x :: String
x) = String
x

class CharLike c where
  toChar :: c -> Char

instance CharLike Char where
  toChar :: Char -> Char
toChar = Char -> Char
forall a. a -> a
id

instance CharLike c => FilePathLike [c] where
  toFilePath :: [c] -> String
toFilePath = (c -> Char) -> [c] -> String
forall a b. (a -> b) -> [a] -> [b]
map c -> Char
forall c. CharLike c => c -> Char
toChar

-- | Make the second path relative to the first, if possible
makeSubPathOf :: AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf :: AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf (AbsolutePath p1 :: String
p1) (AbsolutePath p2 :: String
p2) =
 -- The slash prevents "foobar" from being treated as relative to "foo"
 if String
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p2 Bool -> Bool -> Bool
|| (String
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/") 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 -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) String
p2
    else Maybe SubPath
forall a. Maybe a
Nothing

simpleSubPath :: FilePath -> Maybe SubPath
simpleSubPath :: String -> Maybe SubPath
simpleSubPath x :: String
x | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x = String -> Maybe SubPath
forall a. String -> a
bug "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
$ ShowS
FilePath.normalise ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
pathToPosix String
x
                | Bool
otherwise = Maybe SubPath
forall a. Maybe a
Nothing

isSubPathOf :: SubPath -> SubPath -> Bool
isSubPathOf :: SubPath -> SubPath -> Bool
isSubPathOf (SubPath p1 :: String
p1) (SubPath p2 :: String
p2) =
    String
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
|| String
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p2 Bool -> Bool -> Bool
|| (String
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
p2

-- | Ensure directory exists and is not a symbolic link.
doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist :: String -> IO Bool
doesDirectoryReallyExist f :: String
f = do
    Either () Bool
x <- (IOError -> Maybe ()) -> IO Bool -> IO (Either () Bool)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (\x :: IOError
x -> if IOError -> Bool
isDoesNotExistError IOError
x then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing) (IO Bool -> IO (Either () Bool)) -> IO Bool -> IO (Either () Bool)
forall a b. (a -> b) -> a -> b
$
        FileStatus -> Bool
isDirectory (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getSymbolicLinkStatus String
f
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case Either () Bool
x of
        Left () -> Bool
False
        Right y :: Bool
y -> Bool
y

doesPathExist :: FilePath -> IO Bool
doesPathExist :: String -> IO Bool
doesPathExist p :: String
p = do
   Bool
dir_exists <- String -> IO Bool
doesDirectoryExist String
p
   Bool
file_exists <- String -> IO Bool
doesFileExist String
p
   Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
dir_exists Bool -> Bool -> Bool
|| Bool
file_exists

-- | Interpret a possibly relative path wrt the current working directory.
ioAbsolute :: FilePath -> IO AbsolutePath
ioAbsolute :: String -> IO AbsolutePath
ioAbsolute dir :: String
dir =
    do Bool
isdir <- String -> IO Bool
doesDirectoryReallyExist 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. FilePathLike p => p -> IO ()
setCurrentDirectory String
dir)
                       (String -> IO ()
forall p. 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 ShowS
NativeFilePath.takeDirectory String
dir of
                                "" ->  "."
                                d :: String
d  -> String
d
                  file :: String
file = ShowS
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 (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 (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

-- | Take an absolute path and a string representing a (possibly relative)
-- path and combine them into an absolute path. If the second argument is
-- already absolute, then the first argument gets ignored. This function also
-- takes care that the result is converted to Posix convention and
-- normalized. Also, parent directories (\"..\") at the front of the string
-- argument get canceled out against trailing directory parts of the
-- absolute path argument.
--
-- Regarding the last point, someone more familiar with how these functions
-- are used should verify that this is indeed necessary or at least useful.
makeAbsolute :: AbsolutePath -> FilePath -> AbsolutePath
makeAbsolute :: AbsolutePath -> String -> AbsolutePath
makeAbsolute a :: AbsolutePath
a dir :: String
dir = if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir) Bool -> Bool -> Bool
&& String -> Bool
isAbsolute String
dir
                     then String -> AbsolutePath
AbsolutePath (ShowS
normSlashes String
dir')
                     else AbsolutePath -> String -> AbsolutePath
ma AbsolutePath
a String
dir'
  where
    dir' :: String
dir' = ShowS
FilePath.normalise ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
pathToPosix String
dir
    -- Why do we care to reduce ".." here?
    -- Why not do this throughout the whole path, i.e. "x/y/../z" -> "x/z" ?
    ma :: AbsolutePath -> String -> AbsolutePath
ma here :: AbsolutePath
here ('.':'.':'/':r :: String
r) = AbsolutePath -> String -> AbsolutePath
ma (AbsolutePath -> AbsolutePath
takeDirectory AbsolutePath
here) String
r
    ma here :: AbsolutePath
here ".." = AbsolutePath -> AbsolutePath
takeDirectory AbsolutePath
here
    ma here :: AbsolutePath
here "." = AbsolutePath
here
    ma here :: AbsolutePath
here "" = AbsolutePath
here
    ma here :: AbsolutePath
here r :: String
r = AbsolutePath
here AbsolutePath -> String -> AbsolutePath
/- ('/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
r)

(/-) :: AbsolutePath -> String -> AbsolutePath
x :: AbsolutePath
x /- :: AbsolutePath -> String -> AbsolutePath
/- ('/':r :: String
r) = AbsolutePath
x AbsolutePath -> String -> AbsolutePath
/- String
r
(AbsolutePath "/") /- r :: String
r = String -> AbsolutePath
AbsolutePath ('/'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
simpleClean String
r)
(AbsolutePath x :: String
x) /- r :: String
r = String -> AbsolutePath
AbsolutePath (String
xString -> ShowS
forall a. [a] -> [a] -> [a]
++'/'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
simpleClean String
r)

-- | Convert to posix, remove trailing slashes, and (under Posix)
-- reduce multiple leading slashes to one.
simpleClean :: String -> String
simpleClean :: ShowS
simpleClean = ShowS
normSlashes ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='/') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
pathToPosix

-- | The root directory as an absolute path.
rootDirectory :: AbsolutePath
rootDirectory :: AbsolutePath
rootDirectory = String -> AbsolutePath
AbsolutePath "/"

makeAbsoluteOrStd :: AbsolutePath -> String -> AbsolutePathOrStd
makeAbsoluteOrStd :: AbsolutePath -> String -> AbsolutePathOrStd
makeAbsoluteOrStd _ "-" = AbsolutePathOrStd
APStd
makeAbsoluteOrStd a :: AbsolutePath
a p :: 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 "-" = AbsolutePathOrStd -> IO AbsolutePathOrStd
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePathOrStd
APStd
ioAbsoluteOrStd p :: String
p = AbsolutePath -> AbsolutePathOrStd
AP (AbsolutePath -> AbsolutePathOrStd)
-> IO AbsolutePath -> IO AbsolutePathOrStd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO AbsolutePath
ioAbsolute String
p

-- | Execute either the first or the second argument action, depending on
-- whether the given path is an 'AbsolutePath' or stdin/stdout.
useAbsoluteOrStd :: (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd :: (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd _ f :: a
f APStd = a
f
useAbsoluteOrStd f :: AbsolutePath -> a
f _ (AP x :: AbsolutePath
x) = AbsolutePath -> a
f AbsolutePath
x

ioAbsoluteOrRemote :: String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote :: String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote p :: String
p = do
  Bool
isdir <- String -> IO Bool
doesDirectoryExist String
p
  if Bool -> Bool
not Bool
isdir
     then AbsoluteOrRemotePath -> IO AbsoluteOrRemotePath
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 -> ShowS
forall a. [a] -> [a] -> [a]
++"."
                       | "/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
p -> ShowS
forall a. [a] -> [a]
init String
p
                       | Bool
otherwise          -> String
p
     else AbsolutePath -> AbsoluteOrRemotePath
AbsP (AbsolutePath -> AbsoluteOrRemotePath)
-> IO AbsolutePath -> IO AbsoluteOrRemotePath
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 _) = Bool
True
isRemote _ = Bool
False

takeDirectory :: AbsolutePath -> AbsolutePath
takeDirectory :: AbsolutePath -> AbsolutePath
takeDirectory (AbsolutePath x :: String
x) =
    case ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='/') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
x of
    "" -> String -> AbsolutePath
AbsolutePath "/"
    x' :: String
x' -> String -> AbsolutePath
AbsolutePath String
x'

instance Show AbsolutePath where
 show :: AbsolutePath -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (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 = ShowS
forall a. Show a => a -> String
show ShowS -> (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 a :: AbsolutePath
a) = AbsolutePath -> String
forall a. Show a => a -> String
show AbsolutePath
a
    show APStd = "standard input/output"
instance Show AbsoluteOrRemotePath where
    show :: AbsoluteOrRemotePath -> String
show (AbsP a :: AbsolutePath
a) = AbsolutePath -> String
forall a. Show a => a -> String
show AbsolutePath
a
    show (RmtP r :: String
r) = ShowS
forall a. Show a => a -> String
show String
r

-- | Normalize the path separator to Posix style (slash, not backslash).
-- This only affects Windows systems.
pathToPosix :: FilePath -> FilePath
pathToPosix :: ShowS
pathToPosix = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
forall a. a -> a
convert where
#ifdef WIN32
  convert '\\' = '/'
#endif
  convert :: p -> p
convert c :: p
c = p
c

-- | Reduce multiple leading slashes to one. This only affects Posix systems.
normSlashes :: FilePath -> FilePath
#ifndef WIN32
-- multiple slashes in front are ignored under Posix
normSlashes :: ShowS
normSlashes ('/':p :: String
p) = '/' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') String
p
#endif
normSlashes p :: String
p = String
p

getCurrentDirectory :: IO AbsolutePath
getCurrentDirectory :: IO AbsolutePath
getCurrentDirectory = String -> AbsolutePath
AbsolutePath (String -> AbsolutePath) -> IO String -> IO AbsolutePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO String
Workaround.getCurrentDirectory

setCurrentDirectory :: FilePathLike p => p -> IO ()
setCurrentDirectory :: p -> IO ()
setCurrentDirectory = String -> IO ()
System.Directory.setCurrentDirectory (String -> IO ()) -> (p -> String) -> p -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> String
forall a. FilePathLike a => a -> String
toFilePath

{-|
  What is a malicious path?

  A spoofed path is a malicious path.

  1. Darcs only creates explicitly relative paths (beginning with @\".\/\"@),
     so any not explicitly relative path is surely spoofed.

  2. Darcs normalizes paths so they never contain @\"\/..\/\"@, so paths with
     @\"\/..\/\"@ are surely spoofed.

  A path to a darcs repository's meta data can modify \"trusted\" patches or
  change safety defaults in that repository, so we check for paths
  containing @\"\/_darcs\/\"@ which is the entry to darcs meta data.

  To do?

  * How about get repositories?

  * Would it be worth adding a --semi-safe-paths option for allowing
    changes to certain preference files (_darcs\/prefs\/) in sub
    repositories'?

  TODO:
    Properly review the way we handle paths on Windows - it's not enough
    to just use the OS native concept of path separator. Windows often
    accepts both path separators, and repositories always use the UNIX
    separator anyway.
-}
isMaliciousPath :: String -> Bool
isMaliciousPath :: String -> Bool
isMaliciousPath fp :: String
fp =
    Bool -> Bool
not (String -> Bool
isExplicitlyRelative String
fp) Bool -> Bool -> Bool
|| String -> Bool
isGenerallyMalicious String
fp

-- | Warning : this is less rigorous than isMaliciousPath
--   but it's to allow for subpath representations that
--   don't start with ./
isMaliciousSubPath :: String -> Bool
isMaliciousSubPath :: String -> Bool
isMaliciousSubPath fp :: String
fp =
    Bool -> Bool
not (String -> Bool
FilePath.isRelative String
fp) Bool -> Bool -> Bool
|| String -> Bool
isGenerallyMalicious String
fp

isGenerallyMalicious :: String -> Bool
isGenerallyMalicious :: String -> Bool
isGenerallyMalicious fp :: String
fp =
    String -> [String]
splitDirectories String
fp [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`contains_any` [ "..", String
darcsdir ]
 where
    contains_any :: [a] -> [a] -> Bool
contains_any a :: [a]
a b :: [a]
b = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
intersect [a]
a [a]
b


isExplicitlyRelative :: String -> Bool
isExplicitlyRelative :: String -> Bool
isExplicitlyRelative ('.':'/':_) = Bool
True  -- begins with "./"
isExplicitlyRelative _ = Bool
False

-- | Construct a filter from a list of AnchoredPaths, that will accept any path
-- that is either a parent or a child of any of the listed paths, and discard
-- everything else.
filterPaths :: [AnchoredPath]
            -> AnchoredPath
            -> t
            -> Bool
filterPaths :: [AnchoredPath] -> AnchoredPath -> t -> Bool
filterPaths files :: [AnchoredPath]
files p :: AnchoredPath
p _ = (AnchoredPath -> Bool) -> [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\x :: AnchoredPath
x -> AnchoredPath
x AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
p Bool -> Bool -> Bool
|| AnchoredPath
p AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
x) [AnchoredPath]
files


-- | Same as 'filterPath', but for ordinary 'FilePath's (as opposed to
-- AnchoredPath).
filterFilePaths :: [FilePath]
                -> AnchoredPath
                -> t
                -> Bool
filterFilePaths :: [String] -> AnchoredPath -> t -> Bool
filterFilePaths = [AnchoredPath] -> AnchoredPath -> t -> Bool
forall t. [AnchoredPath] -> AnchoredPath -> t -> Bool
filterPaths ([AnchoredPath] -> AnchoredPath -> t -> Bool)
-> ([String] -> [AnchoredPath])
-> [String]
-> AnchoredPath
-> t
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> AnchoredPath) -> [String] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map String -> AnchoredPath
floatPath

-- | Iteratively tries find first non-existing path generated by
-- buildName, it feeds to buildName the number starting with -1.  When
-- it generates non-existing path and it isn't first, it displays the
-- message created with buildMsg. Usually used for generation of the
-- name like <path>_<number> when <path> already exist
-- (e.g. darcs.net_0).
getUniquePathName :: Bool -> (FilePath -> String) -> (Int -> FilePath) -> IO FilePath
getUniquePathName :: Bool -> ShowS -> (Int -> String) -> IO String
getUniquePathName talkative :: Bool
talkative buildMsg :: ShowS
buildMsg buildName :: Int -> String
buildName = Int -> IO String
go (-1)
 where
  go :: Int -> IO FilePath
  go :: Int -> IO String
go i :: 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
/= -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
$ ShowS
buildMsg String
thename
               String -> IO String
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
+1
    where thename :: String
thename = Int -> String
buildName Int
i

-- | Transform a SubPath into an AnchoredPath.
floatSubPath :: SubPath -> AnchoredPath
floatSubPath :: SubPath -> AnchoredPath
floatSubPath = String -> AnchoredPath
floatPath (String -> AnchoredPath)
-> (SubPath -> String) -> SubPath -> AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> String
fn2fp (FileName -> String) -> (SubPath -> FileName) -> SubPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPath -> FileName
sp2fn
 
-------------------------------
-- AnchoredPath utilities
--

newtype Name = Name { Name -> ByteString
unName :: B.ByteString } deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
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
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$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
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord)

-- | This is a type of "sane" file paths. These are always canonic in the sense
-- that there are no stray slashes, no ".." components and similar. They are
-- usually used to refer to a location within a Tree, but a relative filesystem
-- path works just as well. These are either constructed from individual name
-- components (using "appendPath", "catPaths" and "makeName"), or converted
-- from a FilePath ("floatPath" -- but take care when doing that) or .
newtype AnchoredPath = AnchoredPath [Name] deriving (AnchoredPath -> AnchoredPath -> Bool
(AnchoredPath -> AnchoredPath -> Bool)
-> (AnchoredPath -> AnchoredPath -> Bool) -> Eq AnchoredPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnchoredPath -> AnchoredPath -> Bool
$c/= :: AnchoredPath -> AnchoredPath -> Bool
== :: AnchoredPath -> AnchoredPath -> Bool
$c== :: AnchoredPath -> AnchoredPath -> Bool
Eq, Int -> AnchoredPath -> ShowS
[AnchoredPath] -> ShowS
AnchoredPath -> String
(Int -> AnchoredPath -> ShowS)
-> (AnchoredPath -> String)
-> ([AnchoredPath] -> ShowS)
-> Show AnchoredPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnchoredPath] -> ShowS
$cshowList :: [AnchoredPath] -> ShowS
show :: AnchoredPath -> String
$cshow :: AnchoredPath -> String
showsPrec :: Int -> AnchoredPath -> ShowS
$cshowsPrec :: Int -> AnchoredPath -> ShowS
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
min :: AnchoredPath -> AnchoredPath -> AnchoredPath
$cmin :: AnchoredPath -> AnchoredPath -> AnchoredPath
max :: AnchoredPath -> AnchoredPath -> AnchoredPath
$cmax :: AnchoredPath -> AnchoredPath -> AnchoredPath
>= :: AnchoredPath -> AnchoredPath -> Bool
$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
compare :: AnchoredPath -> AnchoredPath -> Ordering
$ccompare :: AnchoredPath -> AnchoredPath -> Ordering
$cp1Ord :: Eq AnchoredPath
Ord)

-- | Check whether a path is a prefix of another path.
isPrefix :: AnchoredPath -> AnchoredPath -> Bool
(AnchoredPath a :: [Name]
a) isPrefix :: AnchoredPath -> AnchoredPath -> Bool
`isPrefix` (AnchoredPath b :: [Name]
b) = [Name]
a [Name] -> [Name] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Name]
b

-- | Append an element to the end of a path.
appendPath :: AnchoredPath -> Name -> AnchoredPath
appendPath :: AnchoredPath -> Name -> AnchoredPath
appendPath (AnchoredPath p :: [Name]
p) n :: Name
n =
    case Name
n of
      (Name s :: ByteString
s) | ByteString -> Bool
B.null ByteString
s -> [Name] -> AnchoredPath
AnchoredPath [Name]
p
               | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack "." -> [Name] -> AnchoredPath
AnchoredPath [Name]
p
               | Bool
otherwise -> [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]

-- | Catenate two paths together. Not very safe, but sometimes useful
-- (e.g. when you are representing paths relative to a different point than a
-- Tree root).
catPaths :: AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths :: AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths (AnchoredPath p :: [Name]
p) (AnchoredPath n :: [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

-- | Get parent (path) of a given path. foo/bar/baz -> foo/bar
parent :: AnchoredPath -> AnchoredPath
parent :: AnchoredPath -> AnchoredPath
parent (AnchoredPath x :: [Name]
x) = [Name] -> AnchoredPath
AnchoredPath ([Name] -> [Name]
forall a. [a] -> [a]
init [Name]
x)

-- | List all parents of a given path. foo/bar/baz -> [foo, foo/bar]
parents :: AnchoredPath -> [AnchoredPath]
parents :: AnchoredPath -> [AnchoredPath]
parents (AnchoredPath x :: [Name]
x) = ([Name] -> AnchoredPath) -> [[Name]] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map [Name] -> AnchoredPath
AnchoredPath ([[Name]] -> [AnchoredPath])
-> ([Name] -> [[Name]]) -> [Name] -> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Name]] -> [[Name]]
forall a. [a] -> [a]
init ([[Name]] -> [[Name]])
-> ([Name] -> [[Name]]) -> [Name] -> [[Name]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> [[Name]]
forall a. [a] -> [[a]]
inits ([Name] -> [AnchoredPath]) -> [Name] -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ [Name]
x

-- | Take a "root" directory and an anchored path and produce a full
-- 'FilePath'. Moreover, you can use @anchorPath \"\"@ to get a relative
-- 'FilePath'.
anchorPath :: FilePath -> AnchoredPath -> FilePath
anchorPath :: String -> AnchoredPath -> String
anchorPath dir :: String
dir p :: AnchoredPath
p = String
dir String -> ShowS
</> ByteString -> String
decodeLocale (AnchoredPath -> ByteString
flatten AnchoredPath
p)
{-# INLINE anchorPath #-}

flatten :: AnchoredPath -> BC.ByteString
flatten :: AnchoredPath -> ByteString
flatten (AnchoredPath []) = Char -> ByteString
BC.singleton '.'
flatten (AnchoredPath p :: [Name]
p) = ByteString -> [ByteString] -> ByteString
BC.intercalate (Char -> ByteString
BC.singleton '/')
                                           [ ByteString
n | (Name n :: ByteString
n) <- [Name]
p ]

makeName :: String -> Name
makeName :: String -> Name
makeName ".." = String -> Name
forall a. HasCallStack => String -> a
error ".. is not a valid AnchoredPath component name"
makeName n :: String
n | '/' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
n = String -> Name
forall a. HasCallStack => String -> a
error "/ may not occur in a valid AnchoredPath component name"
           | Bool
otherwise = ByteString -> Name
Name (ByteString -> Name) -> ByteString -> Name
forall a b. (a -> b) -> a -> b
$ String -> ByteString
encodeLocale String
n

-- | Take a relative FilePath and turn it into an AnchoredPath. The operation
-- is (relatively) unsafe. Basically, by using floatPath, you are testifying
-- that the argument is a path relative to some common root -- i.e. the root of
-- the associated "Tree" object. Also, there are certain invariants about
-- AnchoredPath that this function tries hard to preserve, but probably cannot
-- guarantee (i.e. this is a best-effort thing). You should sanitize any
-- FilePaths before you declare them "good" by converting into AnchoredPath
-- (using this function).
floatPath :: FilePath -> AnchoredPath
floatPath :: String -> AnchoredPath
floatPath = [String] -> AnchoredPath
make ([String] -> AnchoredPath)
-> (String -> [String]) -> String -> AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalise ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropTrailingPathSeparator
  where make :: [String] -> AnchoredPath
make ["."] = [Name] -> AnchoredPath
AnchoredPath []
        make x :: [String]
x = [Name] -> AnchoredPath
AnchoredPath ([Name] -> AnchoredPath) -> [Name] -> AnchoredPath
forall a b. (a -> b) -> a -> b
$ (String -> Name) -> [String] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Name
Name (ByteString -> Name) -> (String -> ByteString) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
encodeLocale) [String]
x


anchoredRoot :: AnchoredPath
anchoredRoot :: AnchoredPath
anchoredRoot = [Name] -> AnchoredPath
AnchoredPath []

-- | Take a prefix path, the changed prefix path, and a path to change.
-- Assumes the prefix path is a valid prefix. If prefix is wrong return
-- AnchoredPath [].
replacePrefixPath :: AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
replacePrefixPath :: AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
replacePrefixPath (AnchoredPath []) b :: AnchoredPath
b c :: AnchoredPath
c = AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths AnchoredPath
b AnchoredPath
c
replacePrefixPath (AnchoredPath (r :: Name
r:p :: [Name]
p)) b :: AnchoredPath
b (AnchoredPath (r' :: Name
r':p' :: [Name]
p'))
    | Name
r Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
r' = AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
replacePrefixPath ([Name] -> AnchoredPath
AnchoredPath [Name]
p) AnchoredPath
b ([Name] -> AnchoredPath
AnchoredPath [Name]
p')
    | Bool
otherwise = [Name] -> AnchoredPath
AnchoredPath []
replacePrefixPath _ _ _ = [Name] -> AnchoredPath
AnchoredPath []

-- | Append a String to the last Name of an AnchoredPath.
appendToName :: AnchoredPath -> String -> AnchoredPath
appendToName :: AnchoredPath -> String -> AnchoredPath
appendToName (AnchoredPath p :: [Name]
p) s :: String
s = [Name] -> AnchoredPath
AnchoredPath ([Name] -> [Name]
forall a. [a] -> [a]
init [Name]
p[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++[ByteString -> Name
Name ByteString
finalname])
    where suffix :: ByteString
suffix = String -> ByteString
encodeLocale String
s
          finalname :: ByteString
finalname | ByteString
suffix ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ByteString -> [ByteString]
BC.tails ByteString
lastname) = ByteString
lastname
                    | Bool
otherwise = ByteString -> ByteString -> ByteString
BC.append ByteString
lastname ByteString
suffix
          lastname :: ByteString
lastname = case [Name] -> Name
forall a. [a] -> a
last [Name]
p of
                        Name name :: ByteString
name -> ByteString
name

unsafeMakeName :: B.ByteString -> Name
unsafeMakeName :: ByteString -> Name
unsafeMakeName = ByteString -> Name
Name

eqAnycase :: Name -> Name -> Bool
eqAnycase :: Name -> Name -> Bool
eqAnycase (Name a :: ByteString
a) (Name b :: 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