1{- Adjusting the environment while running git commands. 2 - 3 - Copyright 2014-2016 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8module Git.Env where 9 10import Common 11import Git 12import Git.Types 13import Utility.Env 14 15{- Adjusts the gitEnv of a Repo. Copies the system environment if the repo 16 - does not have any gitEnv yet. -} 17adjustGitEnv :: Repo -> ([(String, String)] -> [(String, String)]) -> IO Repo 18adjustGitEnv g adj = do 19 e <- maybe getEnvironment return (gitEnv g) 20 let e' = adj e 21 return $ g { gitEnv = Just e' } 22 where 23 24addGitEnv :: Repo -> String -> String -> IO Repo 25addGitEnv g var val = adjustGitEnv g (addEntry var val) 26 27{- Environment variables to use when running a command. 28 - Includes GIT_DIR pointing at the repo, and GIT_WORK_TREE when the repo 29 - is not bare. Also includes anything added to the Repo's gitEnv, 30 - and a copy of the rest of the system environment. -} 31propGitEnv :: Repo -> IO [(String, String)] 32propGitEnv g = do 33 g' <- addGitEnv g "GIT_DIR" (fromRawFilePath (localGitDir g)) 34 g'' <- maybe (pure g') 35 (addGitEnv g' "GIT_WORK_TREE" . fromRawFilePath) 36 (repoWorkTree g) 37 return $ fromMaybe [] (gitEnv g'') 38 39{- Use with any action that makes a commit to set metadata. -} 40commitWithMetaData :: CommitMetaData -> CommitMetaData -> (Repo -> IO a) -> Repo -> IO a 41commitWithMetaData authormetadata committermetadata a g = 42 a =<< adjustGitEnv g adj 43 where 44 adj = mkadj "AUTHOR" authormetadata 45 . mkadj "COMMITTER" committermetadata 46 mkadj p md = go "NAME" commitName 47 . go "EMAIL" commitEmail 48 . go "DATE" commitDate 49 where 50 go s getv = case getv md of 51 Nothing -> id 52 Just v -> addEntry ("GIT_" ++ p ++ "_" ++ s) v 53