module CabalHelper.Compiletime.Types.RelativePath
( RelativePath
, mkRelativePath
, unRelativePath
) where
import System.FilePath
newtype RelativePath = RelativePath { RelativePath -> FilePath
unRelativePath :: FilePath }
deriving (Int -> RelativePath -> ShowS
[RelativePath] -> ShowS
RelativePath -> FilePath
(Int -> RelativePath -> ShowS)
-> (RelativePath -> FilePath)
-> ([RelativePath] -> ShowS)
-> Show RelativePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RelativePath] -> ShowS
$cshowList :: [RelativePath] -> ShowS
show :: RelativePath -> FilePath
$cshow :: RelativePath -> FilePath
showsPrec :: Int -> RelativePath -> ShowS
$cshowsPrec :: Int -> RelativePath -> ShowS
Show)
mkRelativePath :: FilePath -> RelativePath
mkRelativePath :: FilePath -> RelativePath
mkRelativePath FilePath
dir
| FilePath -> Bool
isAbsolute FilePath
dir =
FilePath -> RelativePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> RelativePath) -> FilePath -> RelativePath
forall a b. (a -> b) -> a -> b
$ FilePath
"mkRelativePath: the path given was absolute! got: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
dir
| FilePath -> Bool
doesRelativePathEscapeCWD FilePath
dir =
FilePath -> RelativePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> RelativePath) -> FilePath -> RelativePath
forall a b. (a -> b) -> a -> b
$ FilePath
"mkRelativePath: the path given escapes the base dir! got: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
dir
| Bool
otherwise =
FilePath -> RelativePath
RelativePath FilePath
dir
doesRelativePathEscapeCWD :: FilePath -> Bool
doesRelativePathEscapeCWD :: FilePath -> Bool
doesRelativePathEscapeCWD FilePath
path =
[FilePath] -> [FilePath] -> Bool
go [] ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ShowS
normalise FilePath
path
where
go :: [FilePath] -> [FilePath] -> Bool
go (FilePath
_:[FilePath]
xs) (FilePath
"..":[FilePath]
ys) = [FilePath] -> [FilePath] -> Bool
go [FilePath]
xs [FilePath]
ys
go [] (FilePath
"..":[FilePath]
__) = Bool
True
go [FilePath]
xs (FilePath
y :[FilePath]
ys) = [FilePath] -> [FilePath] -> Bool
go (FilePath
yFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs) [FilePath]
ys
go [FilePath]
_ [] = Bool
False