diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs index e5fc7125122a4103396b448968033ee28b3fbbe2..42a6fffe1d85cec0a863e0fbdba8efb47c430af8 100644 --- a/hadrian/src/Hadrian/Utilities.hs +++ b/hadrian/src/Hadrian/Utilities.hs @@ -166,14 +166,15 @@ makeRelativeNoSysLink a b -- Use removePrefix to get the relative paths relative to a new -- base directory as high in the directory tree as possible. (baseToA, baseToB) = removePrefix aRelSplit bRelSplit - aToBase = if isDirUp (head baseToA) - -- if baseToA contains any '..' then there is no way to get - -- a path from a to the base directory. - -- E.g. if baseToA == "../u/v" - -- then aToBase == "../../<UnknownDir>" - then error $ "Impossible to find relatieve path from " + aToBase = case baseToA of + (p: _) | isDirUp p -> + -- if baseToA contains any '..' then there is no way to get + -- a path from a to the base directory. + -- E.g. if baseToA == "../u/v" + -- then aToBase == "../../<UnknownDir>" + error $ "Impossible to find relatieve path from " ++ a ++ " to " ++ b - else".." <$ baseToA + _ -> ".." <$ baseToA aToB = aToBase ++ baseToB -- removePrefix "pre123" "prefix456" == ("123", "fix456")