1{- git data types
2 -
3 - Copyright 2010-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
9
10module Git.Types where
11
12import Network.URI
13import Data.String
14import Data.Default
15import qualified Data.Map as M
16import qualified Data.ByteString as S
17import System.Posix.Types
18import Utility.SafeCommand
19import Utility.FileSystemEncoding
20import qualified Data.Semigroup as Sem
21import Prelude
22
23{- Support repositories on local disk, and repositories accessed via an URL.
24 -
25 - Repos on local disk have a git directory, and unless bare, a worktree.
26 -
27 - A local repo may not have had its config read yet, in which case all
28 - that's known about it is its path.
29 -
30 - Finally, an Unknown repository may be known to exist, but nothing
31 - else known about it.
32 -}
33data RepoLocation
34	= Local { gitdir :: RawFilePath, worktree :: Maybe RawFilePath }
35	| LocalUnknown RawFilePath
36	| Url URI
37	| UnparseableUrl String
38	| Unknown
39	deriving (Show, Eq, Ord)
40
41data Repo = Repo
42	{ location :: RepoLocation
43	, config :: M.Map ConfigKey ConfigValue
44	-- a given git config key can actually have multiple values
45	, fullconfig :: M.Map ConfigKey [ConfigValue]
46	-- remoteName holds the name used for this repo in some other
47	-- repo's list of remotes, when this repo is such a remote
48	, remoteName :: Maybe RemoteName
49	-- alternate environment to use when running git commands
50	, gitEnv :: Maybe [(String, String)]
51	, gitEnvOverridesGitDir :: Bool
52	-- global options to pass to git when running git commands
53	, gitGlobalOpts :: [CommandParam]
54	} deriving (Show, Eq, Ord)
55
56newtype ConfigKey = ConfigKey S.ByteString
57	deriving (Ord, Eq)
58
59data ConfigValue
60	= ConfigValue S.ByteString
61	| NoConfigValue
62	-- ^ git treats a setting with no value as different than a setting
63	-- with an empty value
64	deriving (Ord, Eq)
65
66instance Sem.Semigroup ConfigValue where
67	ConfigValue a <> ConfigValue b = ConfigValue (a <> b)
68	a <> NoConfigValue = a
69	NoConfigValue <> b = b
70
71instance Monoid ConfigValue where
72	mempty = ConfigValue mempty
73
74instance Default ConfigValue where
75	def = ConfigValue mempty
76
77fromConfigKey :: ConfigKey -> String
78fromConfigKey (ConfigKey s) = decodeBS s
79
80instance Show ConfigKey where
81	show = fromConfigKey
82
83class FromConfigValue a where
84	fromConfigValue :: ConfigValue -> a
85
86instance FromConfigValue S.ByteString where
87	fromConfigValue (ConfigValue s) = s
88	fromConfigValue NoConfigValue = mempty
89
90instance FromConfigValue String where
91	fromConfigValue = decodeBS . fromConfigValue
92
93instance Show ConfigValue where
94	show = fromConfigValue
95
96instance IsString ConfigKey where
97	fromString = ConfigKey . encodeBS
98
99instance IsString ConfigValue where
100	fromString = ConfigValue . encodeBS
101
102type RemoteName = String
103
104{- A git ref. Can be a sha1, or a branch or tag name. -}
105newtype Ref = Ref S.ByteString
106	deriving (Eq, Ord, Read, Show)
107
108fromRef :: Ref -> String
109fromRef = decodeBS . fromRef'
110
111fromRef' :: Ref -> S.ByteString
112fromRef' (Ref s) = s
113
114{- Aliases for Ref. -}
115type Branch = Ref
116type Sha = Ref
117type Tag = Ref
118
119{- A date in the format described in gitrevisions. Includes the
120 - braces, eg, "{yesterday}" -}
121newtype RefDate = RefDate String
122
123{- Types of objects that can be stored in git. -}
124data ObjectType = BlobObject | CommitObject | TreeObject
125	deriving (Show)
126
127readObjectType :: S.ByteString -> Maybe ObjectType
128readObjectType "blob" = Just BlobObject
129readObjectType "commit" = Just CommitObject
130readObjectType "tree" = Just TreeObject
131readObjectType _ = Nothing
132
133fmtObjectType :: ObjectType -> S.ByteString
134fmtObjectType BlobObject = "blob"
135fmtObjectType CommitObject = "commit"
136fmtObjectType TreeObject = "tree"
137
138{- Types of items in a tree. -}
139data TreeItemType
140	= TreeFile
141	| TreeExecutable
142	| TreeSymlink
143	| TreeSubmodule
144	| TreeSubtree
145	deriving (Eq, Show)
146
147{- Git uses magic numbers to denote the type of a tree item. -}
148readTreeItemType :: S.ByteString -> Maybe TreeItemType
149readTreeItemType "100644" = Just TreeFile
150readTreeItemType "100755" = Just TreeExecutable
151readTreeItemType "120000" = Just TreeSymlink
152readTreeItemType "160000" = Just TreeSubmodule
153readTreeItemType "040000" = Just TreeSubtree
154readTreeItemType _ = Nothing
155
156fmtTreeItemType :: TreeItemType -> S.ByteString
157fmtTreeItemType TreeFile = "100644"
158fmtTreeItemType TreeExecutable = "100755"
159fmtTreeItemType TreeSymlink = "120000"
160fmtTreeItemType TreeSubmodule = "160000"
161fmtTreeItemType TreeSubtree = "040000"
162
163toTreeItemType :: FileMode -> Maybe TreeItemType
164toTreeItemType 0o100644 = Just TreeFile
165toTreeItemType 0o100755 = Just TreeExecutable
166toTreeItemType 0o120000 = Just TreeSymlink
167toTreeItemType 0o160000 = Just TreeSubmodule
168toTreeItemType 0o040000 = Just TreeSubtree
169toTreeItemType _ = Nothing
170
171fromTreeItemType :: TreeItemType -> FileMode
172fromTreeItemType TreeFile = 0o100644
173fromTreeItemType TreeExecutable = 0o100755
174fromTreeItemType TreeSymlink = 0o120000
175fromTreeItemType TreeSubmodule = 0o160000
176fromTreeItemType TreeSubtree = 0o040000
177
178data Commit = Commit
179	{ commitTree :: Sha
180	, commitParent :: [Sha]
181	, commitAuthorMetaData :: CommitMetaData
182	, commitCommitterMetaData :: CommitMetaData
183	, commitMessage :: String
184	}
185	deriving (Show)
186
187data CommitMetaData = CommitMetaData
188	{ commitName :: Maybe String
189	, commitEmail :: Maybe String
190	, commitDate :: Maybe String -- In raw git form, "epoch -tzoffset"
191	}
192	deriving (Show)
193