This commit is contained in:
Joey Hess 2011-11-11 01:52:58 -04:00
parent b327227ba5
commit 637b5feb45
26 changed files with 71 additions and 102 deletions

View file

@ -63,7 +63,7 @@ withIndex :: Annex a -> Annex a
withIndex = withIndex' False
withIndex' :: Bool -> Annex a -> Annex a
withIndex' bootstrapping a = do
f <- fromRepo $ index
f <- fromRepo index
bracketIO (Git.useIndex f) id $ do
unlessM (liftIO $ doesFileExist f) $ do
unless bootstrapping create
@ -336,8 +336,8 @@ stageJournalFiles = do
where
index_lines shas = map genline . zip shas
genline (sha, file) = Git.UnionMerge.update_index_line sha file
git_hash_object g = Git.gitCommandLine
[Param "hash-object", Param "-w", Param "--stdin-paths"] g
git_hash_object = Git.gitCommandLine
[Param "hash-object", Param "-w", Param "--stdin-paths"]
{- Checks if there are changes in the journal. -}
@ -366,7 +366,7 @@ fileJournal = replace "//" "_" . replace "_" "/"
- contention with other git-annex processes. -}
lockJournal :: Annex a -> Annex a
lockJournal a = do
file <- fromRepo $ gitAnnexJournalLock
file <- fromRepo gitAnnexJournalLock
bracketIO (lock file) unlock a
where
lock file = do

View file

@ -17,7 +17,7 @@ catFile :: String -> FilePath -> Annex String
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
where
startup = do
h <- inRepo $ Git.CatFile.catFileStart
h <- inRepo Git.CatFile.catFileStart
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
go h
go h = liftIO $ Git.CatFile.catFile h branch file

View file

@ -91,7 +91,7 @@ openForLock file writelock = bracket_ prep cleanup go
- have to fiddle with permissions to open for an
- exclusive lock. -}
forwritelock a =
when writelock $ whenM (doesFileExist file) $ a
when writelock $ whenM (doesFileExist file) a
prep = forwritelock $ allowWrite file
cleanup = forwritelock $ preventWrite file
@ -251,7 +251,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
moveBad :: Key -> Annex FilePath
moveBad key = do
src <- fromRepo $ gitAnnexLocation key
bad <- fromRepo $ gitAnnexBadDir
bad <- fromRepo gitAnnexBadDir
let dest = bad </> takeFileName src
liftIO $ do
createDirectoryIfMissing True (parentDir dest)

View file

@ -24,12 +24,12 @@ repoExists = CommandCheck 0 ensureInitialized
fromOpt :: CommandCheck
fromOpt = CommandCheck 1 $ do
v <- Annex.getState Annex.fromremote
unless (v == Nothing) $ error "cannot use --from with this command"
unless (isNothing v) $ error "cannot use --from with this command"
toOpt :: CommandCheck
toOpt = CommandCheck 2 $ do
v <- Annex.getState Annex.toremote
unless (v == Nothing) $ error "cannot use --to with this command"
unless (isNothing v) $ error "cannot use --to with this command"
dontCheck :: CommandCheck -> Command -> Command
dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c

View file

@ -6,10 +6,6 @@
-}
module Command (
module Types.Command,
module Seek,
module Checks,
module Options,
command,
next,
stop,
@ -19,20 +15,21 @@ module Command (
notAnnexed,
notBareRepo,
isBareRepo,
autoCopies
autoCopies,
module ReExported
) where
import Common.Annex
import qualified Backend
import qualified Annex
import qualified Git
import Types.Command
import Types.Command as ReExported
import Seek as ReExported
import Checks as ReExported
import Options as ReExported
import Logs.Trust
import Logs.Location
import Config
import Seek
import Checks
import Options
{- Generates a command with the common checks. -}
command :: String -> String -> [CommandSeek] -> String -> Command
@ -50,7 +47,7 @@ stop = return Nothing
- list of actions to perform to run the command. -}
prepCommand :: Command -> [String] -> Annex [CommandCleanup]
prepCommand Command { cmdseek = seek, cmdcheck = c } params = do
sequence_ $ map runCheck c
mapM_ runCheck c
map doCommand . concat <$> mapM (\s -> s params) seek
{- Runs a command through the start, perform and cleanup stages -}

View file

@ -24,7 +24,7 @@ start (name:description) = do
showStart "describe" name
u <- Remote.nameToUUID name
next $ perform u $ unwords description
start _ = do error "Specify a repository and a description."
start _ = error "Specify a repository and a description."
perform :: UUID -> String -> CommandPerform
perform u description = do

View file

@ -22,7 +22,7 @@ seek = [withWords start]
start :: [String] -> CommandStart
start (keyname:file:[]) = notBareRepo $ do
let key = maybe (error "bad key") id $ readKey keyname
let key = fromMaybe (error "bad key") $ readKey keyname
inbackend <- inAnnex key
unless inbackend $ error $
"key ("++ keyname ++") is not present in backend"

View file

@ -50,7 +50,7 @@ withBarePresentKeys a params = isBareRepo >>= go
where
go False = return []
go True = do
unless (null params) $ do
unless (null params) $
error "fsck should be run without parameters in a bare repository"
prepStart a loggedKeys
@ -137,7 +137,7 @@ checkKeySize key = do
checkBackend :: Backend Annex -> Key -> Annex Bool
checkBackend backend key = (Types.Backend.fsckKey backend) key
checkBackend = Types.Backend.fsckKey
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do

View file

@ -46,7 +46,7 @@ perform file oldkey newbackend = do
-- The old backend's key is not dropped from it, because there may
-- be other files still pointing at that key.
src <- fromRepo $ gitAnnexLocation oldkey
tmp <- fromRepo $ gitAnnexTmpDir
tmp <- fromRepo gitAnnexTmpDir
let tmpfile = tmp </> takeFileName file
liftIO $ createLink src tmpfile
k <- Backend.genKey tmpfile $ Just newbackend
@ -64,7 +64,7 @@ perform file oldkey newbackend = do
-- associated urls, record them for
-- the new key as well.
urls <- getUrls oldkey
when (not $ null urls) $
unless (null urls) $
mapM_ (setUrlPresent newkey) urls
next $ Command.Add.cleanup file newkey True

View file

@ -82,7 +82,7 @@ toPerform dest move key = moveLock move key $ do
else Remote.hasKey dest key
case isthere of
Left err -> do
showNote $ err
showNote err
stop
Right False -> do
showAction $ "to " ++ Remote.name dest
@ -111,7 +111,7 @@ toPerform dest move key = moveLock move key $ do
-}
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
fromStart src move file key
| move == True = go
| move = go
| otherwise = do
ishere <- inAnnex key
if ishere then stop else go

View file

@ -51,11 +51,11 @@ perform = next cleanup
cleanup :: CommandCleanup
cleanup = do
annexdir <- fromRepo $ gitAnnexDir
annexdir <- fromRepo gitAnnexDir
uninitialize
mapM_ removeAnnex =<< getKeysPresent
liftIO $ removeDirectoryRecursive annexdir
-- avoid normal shutdown
saveState
inRepo $ Git.run "branch" [Param "-D", Param Annex.Branch.name]
liftIO $ exitSuccess
liftIO exitSuccess

View file

@ -1,46 +1,25 @@
module Common (
module Control.Monad,
module Control.Applicative,
module Control.Monad.State,
module Control.Exception.Extensible,
module Data.Maybe,
module Data.List,
module Data.String.Utils,
module System.Path,
module System.FilePath,
module System.Directory,
module System.Cmd.Utils,
module System.IO,
module System.Posix.Files,
module System.Posix.IO,
module System.Posix.Process,
module System.Exit,
module Utility.Misc,
module Utility.Conditional,
module Utility.SafeCommand,
module Utility.Path,
) where
module Common (module X) where
import Control.Monad hiding (join)
import Control.Applicative
import Control.Monad.State (liftIO)
import Control.Exception.Extensible (IOException)
import Control.Monad as X hiding (join)
import Control.Applicative as X
import Control.Monad.State as X (liftIO)
import Control.Exception.Extensible as X (IOException)
import Data.Maybe
import Data.List
import Data.String.Utils
import Data.Maybe as X
import Data.List as X
import Data.String.Utils as X
import System.Path
import System.FilePath
import System.Directory
import System.Cmd.Utils hiding (safeSystem)
import System.IO hiding (FilePath)
import System.Posix.Files
import System.Posix.IO
import System.Posix.Process hiding (executeFile)
import System.Exit
import System.Path as X
import System.FilePath as X
import System.Directory as X
import System.Cmd.Utils as X hiding (safeSystem)
import System.IO as X hiding (FilePath)
import System.Posix.Files as X
import System.Posix.IO as X
import System.Posix.Process as X hiding (executeFile)
import System.Exit as X
import Utility.Misc
import Utility.Conditional
import Utility.SafeCommand
import Utility.Path
import Utility.Misc as X
import Utility.Conditional as X
import Utility.SafeCommand as X
import Utility.Path as X

View file

@ -1,15 +1,8 @@
module Common.Annex (
module Common,
module Types,
module Types.UUID,
module Annex,
module Locations,
module Messages,
) where
module Common.Annex (module X) where
import Common
import Types
import Types.UUID (toUUID, fromUUID)
import Annex (gitRepo, inRepo, fromRepo)
import Locations
import Messages
import Common as X
import Types as X
import Types.UUID as X (toUUID, fromUUID)
import Annex as X (gitRepo, inRepo, fromRepo)
import Locations as X
import Messages as X

View file

@ -18,7 +18,7 @@ setConfig :: ConfigKey -> String -> Annex ()
setConfig k value = do
inRepo $ Git.run "config" [Param k, Param value]
-- re-read git config and update the repo's state
newg <- inRepo $ Git.configRead
newg <- inRepo Git.configRead
Annex.changeState $ \s -> s { Annex.repo = newg }
{- Looks up a per-remote config setting in git config.

View file

@ -20,7 +20,7 @@ import Utility.SafeCommand
{- Scans for files that are checked into git at the specified locations. -}
inRepo :: [FilePath] -> Repo -> IO [FilePath]
inRepo l repo = pipeNullSplit (Params "ls-files --cached -z --" : map File l) repo
inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
{- Scans for files at the specified locations that are not checked into git. -}
notInRepo :: Bool -> [FilePath] -> Repo -> IO [FilePath]

View file

@ -37,7 +37,7 @@ merge x y repo = do
- the index are preserved (and participate in the merge). -}
merge_index :: Repo -> [String] -> IO ()
merge_index repo bs =
update_index repo =<< concat <$> mapM (\b -> merge_tree_index b repo) bs
update_index repo =<< concat <$> mapM (`merge_tree_index` repo) bs
{- Feeds a list into update-index. Later items in the list can override
- earlier ones, so the list can be generated from any combination of

View file

@ -30,7 +30,7 @@ remoteLog = "remote.log"
{- Adds or updates a remote's config in the log. -}
configSet :: UUID -> RemoteConfig -> Annex ()
configSet u c = do
ts <- liftIO $ getPOSIXTime
ts <- liftIO getPOSIXTime
Annex.Branch.change remoteLog $
showLog showConfig . changeLog ts u c . parseLog parseConfig

View file

@ -47,7 +47,7 @@ parseTrust :: String -> Maybe TrustLevel
parseTrust s
| length w > 0 = Just $ parse $ head w
-- back-compat; the trust.log used to only list trusted repos
| otherwise = Just $ Trusted
| otherwise = Just Trusted
where
w = words s
parse "1" = Trusted
@ -62,7 +62,7 @@ showTrust Trusted = "1"
{- Changes the trust level for a uuid in the trustLog. -}
trustSet :: UUID -> TrustLevel -> Annex ()
trustSet uuid@(UUID _) level = do
ts <- liftIO $ getPOSIXTime
ts <- liftIO getPOSIXTime
Annex.Branch.change trustLog $
showLog showTrust . changeLog ts uuid level . parseLog parseTrust
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }

View file

@ -34,7 +34,7 @@ logfile = "uuid.log"
{- Records a description for a uuid in the log. -}
describeUUID :: UUID -> String -> Annex ()
describeUUID uuid desc = do
ts <- liftIO $ getPOSIXTime
ts <- liftIO getPOSIXTime
Annex.Branch.change logfile $
showLog id . changeLog ts uuid desc . parseLog Just

View file

@ -55,7 +55,7 @@ showLog shower = unlines . map showpair . M.toList
unwords [fromUUID k, shower v]
parseLog :: (String -> Maybe a) -> String -> Log a
parseLog parser = M.fromListWith best . catMaybes . map parse . lines
parseLog parser = M.fromListWith best . mapMaybe parse . lines
where
parse line
| null ws = Nothing

View file

@ -166,7 +166,7 @@ onLocal r a = do
-- for anything onLocal is used to do.
Annex.Branch.disableUpdate
ret <- a
liftIO $ Git.reap
liftIO Git.reap
return ret
keyUrl :: Git.Repo -> Key -> String

View file

@ -19,7 +19,7 @@ import qualified Git
-}
findSpecialRemotes :: String -> Annex [Git.Repo]
findSpecialRemotes s = do
m <- fromRepo $ Git.configMap
m <- fromRepo Git.configMap
return $ map construct $ remotepairs m
where
remotepairs = M.toList . M.filterWithKey match

View file

@ -23,7 +23,7 @@ import qualified Limit
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
seekHelper a params = do
g <- gitRepo
liftIO $ runPreserveOrder (\p -> a p g) params
liftIO $ runPreserveOrder (`a` g) params
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
@ -73,7 +73,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
withFilesUnlocked' typechanged a params = do
-- unlocked files have changed type from a symlink to a regular file
top <- fromRepo $ Git.workTree
top <- fromRepo Git.workTree
typechangedfiles <- seekHelper typechanged params
unlockedfiles <- liftIO $ filterM notSymlink $
map (\f -> top ++ "/" ++ f) typechangedfiles
@ -109,7 +109,7 @@ prepFilteredGen a d fs = do
- command, using a list (ie of files) coming from an action. The list
- will be produced and consumed lazily. -}
prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
prepStart a fs = liftM (map a) fs
prepStart a = liftM (map a)
notSymlink :: FilePath -> IO Bool
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f

View file

@ -51,7 +51,7 @@ upgrade :: Annex Bool
upgrade = do
showAction "v1 to v2"
bare <- fromRepo $ Git.repoIsLocalBare
bare <- fromRepo Git.repoIsLocalBare
if bare
then do
moveContent
@ -113,7 +113,7 @@ moveLocationLogs = do
else return []
move (l, k) = do
dest <- fromRepo $ logFile2 k
dir <- fromRepo $ Upgrade.V2.gitStateDir
dir <- fromRepo Upgrade.V2.gitStateDir
let f = dir </> l
liftIO $ createDirectoryIfMissing True (parentDir dest)
-- could just git mv, but this way deals with

View file

@ -69,7 +69,7 @@ checkGitVersion = do
-- for git-check-attr behavior change
need = "1.7.7"
dotted = sum . mult 1 . reverse . extend 10 . map readi . split "."
extend n l = l ++ take (n - length l) (repeat 0)
extend n l = l ++ replicate (n - length l) 0
mult _ [] = []
mult n (x:xs) = (n*x) : (mult (n*100) xs)
readi :: String -> Integer

View file

@ -1,5 +1,5 @@
Name: git-annex
Version: 3.20111107
Version: 3.20111108
Cabal-Version: >= 1.6
License: GPL
Maintainer: Joey Hess <joey@kitenet.net>