aboutsummaryrefslogtreecommitdiff
path: root/Annex/MakeRepo.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-06-16 18:59:23 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-06-16 18:59:23 -0400
commitc3259ea59d3dfc997a3aceb444f3a76fb8ce22fb (patch)
treee80653a08b07dbf3b43682248317cb617da7e6c6 /Annex/MakeRepo.hs
parent23e9de01864cbc4660c2e4484b7a52dc823418e6 (diff)
refactor
Diffstat (limited to 'Annex/MakeRepo.hs')
-rw-r--r--Annex/MakeRepo.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs
new file mode 100644
index 000000000..695edd5f8
--- /dev/null
+++ b/Annex/MakeRepo.hs
@@ -0,0 +1,88 @@
+{- making local repositories (used by webapp mostly)
+ -
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.MakeRepo where
+
+import Assistant.WebApp.Common
+import Annex.Init
+import qualified Git.Construct
+import qualified Git.Config
+import qualified Git.Command
+import qualified Annex
+import Annex.UUID
+import Annex.Direct
+import Types.StandardGroups
+import Logs.PreferredContent
+import qualified Annex.Branch
+
+{- Makes a new git repository. Or, if a git repository already
+ - exists, returns False. -}
+makeRepo :: FilePath -> Bool -> IO Bool
+makeRepo path bare = ifM (probeRepoExists path)
+ ( return False
+ , do
+ (transcript, ok) <-
+ processTranscript "git" (toCommand params) Nothing
+ unless ok $
+ error $ "git init failed!\nOutput:\n" ++ transcript
+ return True
+ )
+ where
+ baseparams = [Param "init", Param "--quiet"]
+ params
+ | bare = baseparams ++ [Param "--bare", File path]
+ | otherwise = baseparams ++ [File path]
+
+{- Runs an action in the git repository in the specified directory. -}
+inDir :: FilePath -> Annex a -> IO a
+inDir dir a = do
+ state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir
+ Annex.eval state a
+
+{- Creates a new repository, and returns its UUID. -}
+initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID
+initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do
+ initRepo' desc mgroup
+ {- Initialize the master branch, so things that expect
+ - to have it will work, before any files are added. -}
+ unlessM (Git.Config.isBare <$> gitRepo) $
+ void $ inRepo $ Git.Command.runBool
+ [ Param "commit"
+ , Param "--quiet"
+ , Param "--allow-empty"
+ , Param "-m"
+ , Param "created repository"
+ ]
+ {- Repositories directly managed by the assistant use direct mode.
+ -
+ - Automatic gc is disabled, as it can be slow. Insted, gc is done
+ - once a day.
+ -}
+ when primary_assistant_repo $ do
+ setDirect True
+ inRepo $ Git.Command.run
+ [Param "config", Param "gc.auto", Param "0"]
+ getUUID
+{- Repo already exists, could be a non-git-annex repo though so
+ - still initialize it. -}
+initRepo False _ dir desc mgroup = inDir dir $ do
+ initRepo' desc mgroup
+ getUUID
+
+initRepo' :: Maybe String -> Maybe StandardGroup -> Annex ()
+initRepo' desc mgroup = unlessM isInitialized $ do
+ initialize desc
+ u <- getUUID
+ maybe noop (defaultStandardGroup u) mgroup
+ {- Ensure branch gets committed right away so it is
+ - available for merging immediately. -}
+ Annex.Branch.commit "update"
+
+{- Checks if a git repo exists at a location. -}
+probeRepoExists :: FilePath -> IO Bool
+probeRepoExists dir = isJust <$>
+ catchDefaultIO Nothing (Git.Construct.checkForRepo dir)