lint
This commit is contained in:
parent
b327227ba5
commit
637b5feb45
26 changed files with 71 additions and 102 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
17
Command.hs
17
Command.hs
|
@ -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 -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
63
Common.hs
63
Common.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
6
Seek.hs
6
Seek.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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>
|
||||
|
|
Loading…
Reference in a new issue