git-annex/Command/Init.hs

98 lines
2.4 KiB
Haskell
Raw Normal View History

{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Init where
import Control.Monad.State (liftIO)
import Control.Monad (when)
2010-11-14 18:44:24 +00:00
import System.Directory
import Command
import qualified Annex
import qualified GitRepo as Git
import UUID
2010-11-08 20:40:28 +00:00
import Version
2010-11-08 19:15:21 +00:00
import Messages
2010-11-14 18:44:24 +00:00
import Locations
2010-12-03 04:33:41 +00:00
import Types
2010-11-11 22:54:52 +00:00
seek :: [SubCmdSeek]
seek = [withString start]
2010-11-11 22:54:52 +00:00
{- Stores description for the repository etc. -}
start :: SubCmdStartString
start description = do
2010-11-22 21:51:55 +00:00
when (null description) $
error "please specify a description of this repository\n"
showStart "init" description
return $ Just $ perform description
perform :: String -> SubCmdPerform
perform description = do
g <- Annex.gitRepo
u <- getUUID g
describeUUID u description
2010-11-08 20:40:28 +00:00
setVersion
2010-12-03 04:33:41 +00:00
liftIO $ gitAttributesWrite g
gitPreCommitHookWrite g
2010-11-22 21:51:55 +00:00
return $ Just cleanup
cleanup :: SubCmdCleanup
cleanup = do
g <- Annex.gitRepo
logfile <- uuidLog
liftIO $ Git.run g ["add", logfile]
liftIO $ Git.run g ["commit", "-m", "git annex init", logfile]
return True
2010-11-14 18:44:24 +00:00
{- configure git to use union merge driver on state files, if it is not
- already -}
2010-12-03 04:33:41 +00:00
gitAttributesWrite :: Git.Repo -> IO ()
gitAttributesWrite repo = do
2010-11-14 18:44:24 +00:00
exists <- doesFileExist attributes
2010-11-22 21:51:55 +00:00
if not exists
2010-11-14 18:44:24 +00:00
then do
writeFile attributes $ attrLine ++ "\n"
commit
else do
content <- readFile attributes
when (all (/= attrLine) (lines content)) $ do
appendFile attributes $ attrLine ++ "\n"
commit
where
attributes = Git.attributes repo
commit = do
Git.run repo ["add", attributes]
Git.run repo ["commit", "-m", "git-annex setup",
attributes]
2010-12-03 04:33:41 +00:00
attrLine :: String
attrLine = stateLoc ++ "*.log merge=union"
2010-11-14 18:44:24 +00:00
{- set up a git pre-commit hook, if one is not already present -}
2010-12-03 04:33:41 +00:00
gitPreCommitHookWrite :: Git.Repo -> Annex ()
gitPreCommitHookWrite repo = do
exists <- liftIO $ doesFileExist hook
2010-11-22 21:51:55 +00:00
if exists
2010-12-03 04:33:41 +00:00
then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
else liftIO $ do
writeFile hook preCommitScript
2010-11-14 18:44:24 +00:00
p <- getPermissions hook
setPermissions hook $ p {executable = True}
2010-12-03 04:33:41 +00:00
where
hook = preCommitHook repo
preCommitHook :: Git.Repo -> FilePath
preCommitHook repo =
Git.workTree repo ++ "/" ++ Git.gitDir repo ++ "/hooks/pre-commit"
preCommitScript :: String
preCommitScript =
"#!/bin/sh\n" ++
"# automatically configured by git-annex\n" ++
"git annex pre-commit .\n"