git-annex/Init.hs

87 lines
2.4 KiB
Haskell
Raw Normal View History

{- git-annex repository initialization
-
2011-08-17 22:42:49 +00:00
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Init (
ensureInitialized,
isInitialized,
initialize,
uninitialize
) where
2011-10-05 20:02:51 +00:00
import Common.Annex
2011-10-16 04:31:25 +00:00
import Utility.TempFile
import qualified Git
2011-10-04 04:40:47 +00:00
import qualified Annex.Branch
import Logs.UUID
2011-10-04 04:40:47 +00:00
import Annex.Version
import Annex.UUID
2011-11-07 20:13:06 +00:00
initialize :: Maybe String -> Annex ()
initialize mdescription = do
prepUUID
2011-10-04 04:40:47 +00:00
Annex.Branch.create
setVersion
2011-08-17 22:52:58 +00:00
gitPreCommitHookWrite
2011-11-07 20:13:06 +00:00
u <- getUUID
maybe (recordUUID u) (describeUUID u) mdescription
uninitialize :: Annex ()
uninitialize = do
gitPreCommitHookUnWrite
removeRepoUUID
{- Will automatically initialize if there is already a git-annex
branch from somewhere. Otherwise, require a manual init
to avoid git-annex accidentially being run in git
repos that did not intend to use it. -}
ensureInitialized :: Annex ()
2011-08-17 22:42:49 +00:00
ensureInitialized = getVersion >>= maybe needsinit checkVersion
where
needsinit = ifM Annex.Branch.hasSibling
( initialize Nothing
, error "First run: git-annex init"
)
{- Checks if a repository is initialized. Does not check version for ugrade. -}
isInitialized :: Annex Bool
isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion
{- set up a git pre-commit hook, if one is not already present -}
2011-08-17 22:52:58 +00:00
gitPreCommitHookWrite :: Annex ()
gitPreCommitHookWrite = unlessBare $ do
hook <- preCommitHook
ifM (liftIO $ doesFileExist hook)
( warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
, liftIO $ do
viaTmp writeFile hook preCommitScript
p <- getPermissions hook
setPermissions hook $ p {executable = True}
)
2011-08-17 22:52:58 +00:00
gitPreCommitHookUnWrite :: Annex ()
gitPreCommitHookUnWrite = unlessBare $ do
hook <- preCommitHook
2012-03-16 05:59:07 +00:00
whenM (liftIO $ doesFileExist hook) $
ifM (liftIO $ (==) preCommitScript <$> readFile hook)
( liftIO $ removeFile hook
, warning $ "pre-commit hook (" ++ hook ++
") contents modified; not deleting." ++
" Edit it to remove call to git annex."
2012-03-16 05:59:07 +00:00
)
2011-08-17 22:52:58 +00:00
unlessBare :: Annex () -> Annex ()
2012-02-16 04:41:30 +00:00
unlessBare = unlessM $ fromRepo Git.repoIsLocalBare
2011-08-17 22:52:58 +00:00
preCommitHook :: Annex FilePath
Clean up handling of git directory and git worktree. Baked into the code was an assumption that a repository's git directory could be determined by adding ".git" to its work tree (or nothing for bare repos). That fails when core.worktree, or GIT_DIR and GIT_WORK_TREE are used to separate the two. This was attacked at the type level, by storing the gitdir and worktree separately, so Nothing for the worktree means a bare repo. A complication arose because we don't learn where a repository is bare until its configuration is read. So another Location type handles repositories that have not had their config read yet. I am not entirely happy with this being a Location type, rather than representing them entirely separate from the Git type. The new code is not worse than the old, but better types could enforce more safety. Added support for core.worktree. Overriding it with -c isn't supported because it's not really clear what to do if a git repo's config is read, is not bare, and is then overridden to bare. What is the right git directory in this case? I will worry about this if/when someone has a use case for overriding core.worktree with -c. (See Git.Config.updateLocation) Also removed and renamed some functions like gitDir and workTree that misused git's terminology. One minor regression is known: git annex add in a bare repository does not print a nice error message, but runs git ls-files in a way that fails earlier with a less nice error message. This is because before --work-tree was always passed to git commands, even in a bare repo, while now it's not.
2012-05-18 20:38:26 +00:00
preCommitHook = (</>) <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit"
preCommitScript :: String
preCommitScript =
2011-10-11 18:43:45 +00:00
"#!/bin/sh\n" ++
"# automatically configured by git-annex\n" ++
"git annex pre-commit .\n"