blob: 4007fbbb0fc1ddbdbf48f85625d1f09ad76bbb62 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
{- absolute and relative path manipulation
-
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Path.AbsRel (
absPathFrom,
absPath,
relPathCwdToFile,
relPathDirToFile,
relPathDirToFileAbs,
relHome,
) where
import System.FilePath.ByteString
import qualified Data.ByteString as B
#ifdef mingw32_HOST_OS
import System.Directory (getCurrentDirectory)
#else
import System.Posix.Directory.ByteString (getWorkingDirectory)
#endif
import Control.Applicative
import Prelude
import Utility.Path
import Utility.UserInfo
import Utility.FileSystemEncoding
{- Makes a path absolute.
-
- Also simplifies it using simplifyPath.
-
- The first parameter is a base directory (ie, the cwd) to use if the path
- is not already absolute, and should itself be absolute.
-
- Does not attempt to deal with edge cases or ensure security with
- untrusted inputs.
-}
absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath
absPathFrom dir path = simplifyPath (combine dir path)
{- Converts a filename into an absolute path.
-
- Also simplifies it using simplifyPath.
-
- Unlike Directory.canonicalizePath, this does not require the path
- already exists. -}
absPath :: RawFilePath -> IO RawFilePath
absPath file
-- Avoid unncessarily getting the current directory when the path
-- is already absolute. absPathFrom uses simplifyPath
-- so also used here for consistency.
| isAbsolute file = return $ simplifyPath file
| otherwise = do
#ifdef mingw32_HOST_OS
cwd <- toRawFilePath <$> getCurrentDirectory
#else
cwd <- getWorkingDirectory
#endif
return $ absPathFrom cwd file
{- Constructs the minimal relative path from the CWD to a file.
-
- For example, assuming CWD is /tmp/foo/bar:
- relPathCwdToFile "/tmp/foo" == ".."
- relPathCwdToFile "/tmp/foo/bar" == ""
- relPathCwdToFile "../bar/baz" == "baz"
-}
relPathCwdToFile :: RawFilePath -> IO RawFilePath
relPathCwdToFile f
-- Optimisation: Avoid doing any IO when the path is relative
-- and does not contain any ".." component.
| isRelative f && not (".." `B.isInfixOf` f) = return f
| otherwise = do
#ifdef mingw32_HOST_OS
c <- toRawFilePath <$> getCurrentDirectory
#else
c <- getWorkingDirectory
#endif
relPathDirToFile c f
{- Constructs a minimal relative path from a directory to a file. -}
relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
{- Converts paths in the home directory to use ~/ -}
relHome :: FilePath -> IO String
relHome path = do
let path' = toRawFilePath path
home <- toRawFilePath <$> myHomeDir
return $ if dirContains home path'
then fromRawFilePath ("~/" <> relPathDirToFileAbs home path')
else path
|
