diff options
| -rw-r--r-- | Annex/Branch.hs | 8 | ||||
| -rw-r--r-- | Annex/CatFile.hs | 2 | ||||
| -rw-r--r-- | Annex/Content.hs | 4 | ||||
| -rw-r--r-- | Checks.hs | 4 | ||||
| -rw-r--r-- | Command.hs | 17 | ||||
| -rw-r--r-- | Command/Describe.hs | 2 | ||||
| -rw-r--r-- | Command/FromKey.hs | 2 | ||||
| -rw-r--r-- | Command/Fsck.hs | 4 | ||||
| -rw-r--r-- | Command/Migrate.hs | 4 | ||||
| -rw-r--r-- | Command/Move.hs | 4 | ||||
| -rw-r--r-- | Command/Uninit.hs | 4 | ||||
| -rw-r--r-- | Common.hs | 63 | ||||
| -rw-r--r-- | Common/Annex.hs | 21 | ||||
| -rw-r--r-- | Config.hs | 2 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 2 | ||||
| -rw-r--r-- | Git/UnionMerge.hs | 2 | ||||
| -rw-r--r-- | Logs/Remote.hs | 2 | ||||
| -rw-r--r-- | Logs/Trust.hs | 4 | ||||
| -rw-r--r-- | Logs/UUID.hs | 2 | ||||
| -rw-r--r-- | Logs/UUIDBased.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 2 | ||||
| -rw-r--r-- | Remote/Helper/Special.hs | 2 | ||||
| -rw-r--r-- | Seek.hs | 6 | ||||
| -rw-r--r-- | Upgrade/V1.hs | 4 | ||||
| -rw-r--r-- | configure.hs | 2 | ||||
| -rw-r--r-- | git-annex.cabal | 2 |
26 files changed, 71 insertions, 102 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 6c28a0c84..05c89ed97 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -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 diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index a043e1ae3..99cc519f5 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -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 diff --git a/Annex/Content.hs b/Annex/Content.hs index 7586bb96f..83839ea13 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -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 diff --git a/Command.hs b/Command.hs index 083be37f2..d22c2d12f 100644 --- a/Command.hs +++ b/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 -} diff --git a/Command/Describe.hs b/Command/Describe.hs index 1cc81bcbd..61297e77c 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -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 diff --git a/Command/FromKey.hs b/Command/FromKey.hs index b910dd1f0..ec194e06e 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -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" diff --git a/Command/Fsck.hs b/Command/Fsck.hs index bdc509941..99dda99e5 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 3c87f4136..860c4bd47 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -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 diff --git a/Command/Move.hs b/Command/Move.hs index 9553d1639..155f4d605 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 8987240be..ca18c478c 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -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 @@ -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 diff --git a/Common/Annex.hs b/Common/Annex.hs index 6b5bc31de..e90825f0e 100644 --- a/Common/Annex.hs +++ b/Common/Annex.hs @@ -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. diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index bceee26fc..85215fe04 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -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] diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index 32966c846..30778d034 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -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 diff --git a/Logs/Remote.hs b/Logs/Remote.hs index e2b04bf47..8d15f3151 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -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 diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 8c4507dcb..cb91861fd 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -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 } diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 77cfb5ce0..da611d7bf 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -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 diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index 9609d7321..42908ab1d 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -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 diff --git a/Remote/Git.hs b/Remote/Git.hs index 30d992e8c..541d8e5f6 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -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 diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 5bbf4169d..77478eb1d 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -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 @@ -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 diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 377e4b21b..567cf8e5b 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -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 diff --git a/configure.hs b/configure.hs index 1d1c02335..cb73af2a9 100644 --- a/configure.hs +++ b/configure.hs @@ -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 diff --git a/git-annex.cabal b/git-annex.cabal index 4b3a708a4..7b9459b46 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -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> |