rename and refactor
This commit is contained in:
parent
9aaab02e44
commit
19e26f091d
2 changed files with 18 additions and 12 deletions
|
@ -65,8 +65,8 @@ import qualified System.FilePath.ByteString as P
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
checkCanInitialize :: Annex a -> Annex a
|
checkInitializeAllowed :: Annex a -> Annex a
|
||||||
checkCanInitialize a = canInitialize' >>= \case
|
checkInitializeAllowed a = noAnnexFileContent' >>= \case
|
||||||
Nothing -> a
|
Nothing -> a
|
||||||
Just noannexmsg -> do
|
Just noannexmsg -> do
|
||||||
warning "Initialization prevented by .noannex file (remove the file to override)"
|
warning "Initialization prevented by .noannex file (remove the file to override)"
|
||||||
|
@ -74,11 +74,12 @@ checkCanInitialize a = canInitialize' >>= \case
|
||||||
warning noannexmsg
|
warning noannexmsg
|
||||||
giveup "Not initialized."
|
giveup "Not initialized."
|
||||||
|
|
||||||
canInitialize :: Annex Bool
|
initializeAllowed :: Annex Bool
|
||||||
canInitialize = isNothing <$> canInitialize'
|
initializeAllowed = isNothing <$> noAnnexFileContent'
|
||||||
|
|
||||||
canInitialize' :: Annex (Maybe String)
|
noAnnexFileContent' :: Annex (Maybe String)
|
||||||
canInitialize' = inRepo (noAnnexFileContent . fmap fromRawFilePath . Git.repoWorkTree)
|
noAnnexFileContent' = inRepo $
|
||||||
|
noAnnexFileContent . fmap fromRawFilePath . Git.repoWorkTree
|
||||||
|
|
||||||
genDescription :: Maybe String -> Annex UUIDDesc
|
genDescription :: Maybe String -> Annex UUIDDesc
|
||||||
genDescription (Just d) = return $ UUIDDesc $ encodeBS d
|
genDescription (Just d) = return $ UUIDDesc $ encodeBS d
|
||||||
|
@ -94,7 +95,7 @@ genDescription Nothing = do
|
||||||
Left _ -> [hostname, ":", reldir]
|
Left _ -> [hostname, ":", reldir]
|
||||||
|
|
||||||
initialize :: Maybe String -> Maybe RepoVersion -> Annex ()
|
initialize :: Maybe String -> Maybe RepoVersion -> Annex ()
|
||||||
initialize mdescription mversion = checkCanInitialize $ do
|
initialize mdescription mversion = checkInitializeAllowed $ do
|
||||||
{- Has to come before any commits are made as the shared
|
{- Has to come before any commits are made as the shared
|
||||||
- clone heuristic expects no local objects. -}
|
- clone heuristic expects no local objects. -}
|
||||||
sharedclone <- checkSharedClone
|
sharedclone <- checkSharedClone
|
||||||
|
@ -117,7 +118,7 @@ initialize mdescription mversion = checkCanInitialize $ do
|
||||||
-- Everything except for uuid setup, shared clone setup, and initial
|
-- Everything except for uuid setup, shared clone setup, and initial
|
||||||
-- description.
|
-- description.
|
||||||
initialize' :: Maybe RepoVersion -> Annex ()
|
initialize' :: Maybe RepoVersion -> Annex ()
|
||||||
initialize' mversion = checkCanInitialize $ do
|
initialize' mversion = checkInitializeAllowed $ do
|
||||||
checkLockSupport
|
checkLockSupport
|
||||||
checkFifoSupport
|
checkFifoSupport
|
||||||
checkCrippledFileSystem
|
checkCrippledFileSystem
|
||||||
|
@ -168,21 +169,26 @@ uninitialize = do
|
||||||
ensureInitialized :: Annex ()
|
ensureInitialized :: Annex ()
|
||||||
ensureInitialized = getVersion >>= maybe needsinit checkUpgrade
|
ensureInitialized = getVersion >>= maybe needsinit checkUpgrade
|
||||||
where
|
where
|
||||||
needsinit = ifM Annex.Branch.hasSibling
|
needsinit = ifM autoInitializeAllowed
|
||||||
( do
|
( do
|
||||||
initialize Nothing Nothing
|
initialize Nothing Nothing
|
||||||
autoEnableSpecialRemotes
|
autoEnableSpecialRemotes
|
||||||
, giveup "First run: git-annex init"
|
, giveup "First run: git-annex init"
|
||||||
)
|
)
|
||||||
|
|
||||||
{- Initialize if it can do so automatically.
|
{- Check if auto-initialize is allowed. -}
|
||||||
|
autoInitializeAllowed :: Annex Bool
|
||||||
|
autoInitializeAllowed = Annex.Branch.hasSibling
|
||||||
|
|
||||||
|
{- Initialize if it can do so automatically. Avoids failing if it cannot.
|
||||||
-
|
-
|
||||||
- Checks repository version and handles upgrades too.
|
- Checks repository version and handles upgrades too.
|
||||||
-}
|
-}
|
||||||
autoInitialize :: Annex ()
|
autoInitialize :: Annex ()
|
||||||
autoInitialize = getVersion >>= maybe needsinit checkUpgrade
|
autoInitialize = getVersion >>= maybe needsinit checkUpgrade
|
||||||
where
|
where
|
||||||
needsinit = whenM (canInitialize <&&> Annex.Branch.hasSibling) $ do
|
needsinit =
|
||||||
|
whenM (initializeAllowed <&&> autoInitializeAllowed) $ do
|
||||||
initialize Nothing Nothing
|
initialize Nothing Nothing
|
||||||
autoEnableSpecialRemotes
|
autoEnableSpecialRemotes
|
||||||
|
|
||||||
|
|
|
@ -29,7 +29,7 @@ programFile :: IO FilePath
|
||||||
programFile = userConfigFile "program"
|
programFile = userConfigFile "program"
|
||||||
|
|
||||||
{- A .noannex file in a git repository prevents git-annex from
|
{- A .noannex file in a git repository prevents git-annex from
|
||||||
- initializing that repository.. The content of the file is returned. -}
|
- initializing that repository. The content of the file is returned. -}
|
||||||
noAnnexFileContent :: Maybe FilePath -> IO (Maybe String)
|
noAnnexFileContent :: Maybe FilePath -> IO (Maybe String)
|
||||||
noAnnexFileContent repoworktree = case repoworktree of
|
noAnnexFileContent repoworktree = case repoworktree of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue