1{- git FilePath library
2 -
3 - Different git commands use different types of FilePaths to refer to
4 - files in the repository. Some commands use paths relative to the
5 - top of the repository even when run in a subdirectory. Adding some
6 - types helps keep that straight.
7 -
8 - Copyright 2012-2019 Joey Hess <id@joeyh.name>
9 -
10 - Licensed under the GNU AGPL version 3 or higher.
11 -}
12
13{-# LANGUAGE CPP #-}
14{-# LANGUAGE DeriveGeneric #-}
15{-# LANGUAGE OverloadedStrings #-}
16
17module Git.FilePath (
18	TopFilePath,
19	BranchFilePath(..),
20	descBranchFilePath,
21	getTopFilePath,
22	fromTopFilePath,
23	toTopFilePath,
24	asTopFilePath,
25	InternalGitPath,
26	toInternalGitPath,
27	fromInternalGitPath,
28	absoluteGitPath
29) where
30
31import Common
32import Git
33
34import qualified System.FilePath.ByteString as P
35import qualified System.FilePath.Posix.ByteString
36import GHC.Generics
37import Control.DeepSeq
38import qualified Data.ByteString as S
39
40{- A RawFilePath, relative to the top of the git repository. -}
41newtype TopFilePath = TopFilePath { getTopFilePath :: RawFilePath }
42	deriving (Show, Eq, Ord, Generic)
43
44instance NFData TopFilePath
45
46{- A file in a branch or other treeish. -}
47data BranchFilePath = BranchFilePath Ref TopFilePath
48	deriving (Show, Eq, Ord)
49
50{- Git uses the branch:file form to refer to a BranchFilePath -}
51descBranchFilePath :: BranchFilePath -> S.ByteString
52descBranchFilePath (BranchFilePath b f) =
53	fromRef' b <> ":" <> getTopFilePath f
54
55{- Path to a TopFilePath, within the provided git repo. -}
56fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath
57fromTopFilePath p repo = P.combine (repoPath repo) (getTopFilePath p)
58
59{- The input FilePath can be absolute, or relative to the CWD. -}
60toTopFilePath :: RawFilePath -> Git.Repo -> IO TopFilePath
61toTopFilePath file repo = TopFilePath <$> relPathDirToFile (repoPath repo) file
62
63{- The input RawFilePath must already be relative to the top of the git
64 - repository -}
65asTopFilePath :: RawFilePath -> TopFilePath
66asTopFilePath file = TopFilePath file
67
68{- Git may use a different representation of a path when storing
69 - it internally.
70 -
71 - On Windows, git uses '/' to separate paths stored in the repository,
72 - despite Windows using '\'.
73 -
74 -}
75type InternalGitPath = RawFilePath
76
77toInternalGitPath :: RawFilePath -> InternalGitPath
78#ifndef mingw32_HOST_OS
79toInternalGitPath = id
80#else
81toInternalGitPath = encodeBS . replace "\\" "/" . decodeBS
82#endif
83
84fromInternalGitPath :: InternalGitPath -> RawFilePath
85#ifndef mingw32_HOST_OS
86fromInternalGitPath = id
87#else
88fromInternalGitPath = encodeBS . replace "/" "\\" . decodeBS
89#endif
90
91{- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,
92 - so try posix paths.
93 -}
94absoluteGitPath :: RawFilePath -> Bool
95absoluteGitPath p = P.isAbsolute p ||
96	System.FilePath.Posix.ByteString.isAbsolute (toInternalGitPath p)
97