From 8ef2095fa00408ce6729596a42bc0abdc7778098 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 3 Oct 2011 22:24:57 -0400 Subject: factor out common imports no code changes --- Annex.hs | 6 +++--- AnnexCommon.hs | 13 ++++++++++++ AnnexQueue.hs | 6 +----- Backend.hs | 12 +++-------- Backend/SHA.hs | 16 ++------------ Backend/URL.hs | 2 +- Backend/WORM.hs | 6 +----- Branch.hs | 50 +++++++++++++++----------------------------- CatFile.hs | 6 ++---- CmdLine.hs | 5 +---- Command.hs | 27 +++++++----------------- Command/Add.hs | 13 ++---------- Command/AddUrl.hs | 11 ++-------- Command/ConfigList.hs | 6 ++---- Command/Describe.hs | 2 +- Command/Drop.hs | 8 +++---- Command/DropKey.hs | 3 +-- Command/DropUnused.hs | 12 +++-------- Command/Find.hs | 4 +--- Command/Fix.hs | 8 +------ Command/FromKey.hs | 9 +------- Command/Fsck.hs | 15 +++---------- Command/Get.hs | 3 +-- Command/InAnnex.hs | 5 +---- Command/Init.hs | 5 ++--- Command/InitRemote.hs | 7 +------ Command/Lock.hs | 6 +----- Command/Map.hs | 11 ++-------- Command/Merge.hs | 2 +- Command/Migrate.hs | 15 ++----------- Command/Move.hs | 12 ++++------- Command/RecvKey.hs | 6 +----- Command/Semitrust.hs | 2 +- Command/SendKey.hs | 11 ++-------- Command/SetKey.hs | 5 +---- Command/Status.hs | 7 +------ Command/Trust.hs | 2 +- Command/Unannex.hs | 15 +++---------- Command/Uninit.hs | 9 ++------ Command/Unlock.hs | 14 +++---------- Command/Untrust.hs | 2 +- Command/Unused.hs | 28 ++++++++----------------- Command/Upgrade.hs | 2 +- Command/Version.hs | 5 +---- Command/Whereis.hs | 5 +---- Common.hs | 46 ++++++++++++++++++++++++++++++++++++++++ Config.hs | 15 ++++--------- Content.hs | 34 ++++++++++-------------------- Crypto.hs | 15 +++---------- Git.hs | 16 +------------- GitAnnex.hs | 6 ++---- Init.hs | 14 +++---------- Limit.hs | 6 ++---- LocationLog.hs | 7 +------ Locations.hs | 4 +--- Messages.hs | 4 +--- Options.hs | 3 +-- PresenceLog.hs | 4 +--- Remote.hs | 16 +++++--------- Remote/Bup.hs | 21 +++---------------- Remote/Directory.hs | 23 ++++++-------------- Remote/Git.hs | 27 ++++++++---------------- Remote/Helper/Encryptable.hs | 4 +--- Remote/Helper/Special.hs | 11 +++------- Remote/Hook.hs | 20 ++++-------------- Remote/Rsync.hs | 24 +++++---------------- Remote/S3real.hs | 16 +++----------- Remote/Web.hs | 12 ++--------- RemoteLog.hs | 5 +---- Trust.hs | 4 +--- Types/Key.hs | 3 ++- UUID.hs | 12 +++-------- Upgrade.hs | 2 +- Upgrade/V0.hs | 12 ++--------- Upgrade/V1.hs | 26 ++++++----------------- Upgrade/V2.hs | 20 ++++-------------- Utility.hs | 1 - Utility/CopyFile.hs | 6 +++--- Version.hs | 5 ++--- git-annex-shell.hs | 4 +--- git-annex.cabal | 2 +- git-union-merge.hs | 4 +--- test.hs | 8 ++----- 83 files changed, 263 insertions(+), 618 deletions(-) create mode 100644 AnnexCommon.hs create mode 100644 Common.hs diff --git a/Annex.hs b/Annex.hs index 8a386a044..687753774 100644 --- a/Annex.hs +++ b/Annex.hs @@ -19,10 +19,10 @@ module Annex ( gitRepo ) where -import Control.Monad.State import Control.Monad.IO.Control -import Control.Applicative hiding (empty) +import Control.Monad.State +import Common import qualified Git import Git.CatFile import Git.Queue @@ -75,7 +75,7 @@ newState gitrepo = AnnexState { repo = gitrepo , backends = [] , remotes = [] - , repoqueue = empty + , repoqueue = Git.Queue.empty , output = NormalOutput , force = False , fast = False diff --git a/AnnexCommon.hs b/AnnexCommon.hs new file mode 100644 index 000000000..bcdc5e264 --- /dev/null +++ b/AnnexCommon.hs @@ -0,0 +1,13 @@ +module AnnexCommon ( + module Common, + module Types, + module Annex, + module Locations, + module Messages, +) where + +import Common +import Types +import Annex (gitRepo) +import Locations +import Messages diff --git a/AnnexQueue.hs b/AnnexQueue.hs index d155a7b81..66843a75e 100644 --- a/AnnexQueue.hs +++ b/AnnexQueue.hs @@ -11,13 +11,9 @@ module AnnexQueue ( flushWhenFull ) where -import Control.Monad.State (liftIO) -import Control.Monad (when, unless) - +import AnnexCommon import Annex -import Messages import qualified Git.Queue -import Utility.SafeCommand {- Adds a git command to the queue. -} add :: String -> [CommandParam] -> [FilePath] -> Annex () diff --git a/Backend.hs b/Backend.hs index ca822de5c..94fe29607 100644 --- a/Backend.hs +++ b/Backend.hs @@ -16,20 +16,14 @@ module Backend ( maybeLookupBackendName ) where -import Control.Monad.State (liftIO, when) -import Control.Applicative import System.IO.Error (try) -import System.FilePath import System.Posix.Files -import Data.Maybe -import Locations +import AnnexCommon import qualified Git import qualified Annex -import Types import Types.Key import qualified Types.Backend as B -import Messages -- When adding a new backend, import it here and add it to the list. import qualified Backend.WORM @@ -59,7 +53,7 @@ orderedList = do Annex.changeState $ \state -> state { Annex.backends = l' } return l' getstandard = do - g <- Annex.gitRepo + g <- gitRepo return $ parseBackendList $ Git.configGet g "annex.backends" "" @@ -108,7 +102,7 @@ type BackendFile = (Maybe (Backend Annex), FilePath) -} chooseBackends :: [FilePath] -> Annex [BackendFile] chooseBackends fs = do - g <- Annex.gitRepo + g <- gitRepo forced <- Annex.getState Annex.forcebackend if isJust forced then do diff --git a/Backend/SHA.hs b/Backend/SHA.hs index 15d3fa20d..0c36ef0dc 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -7,23 +7,11 @@ module Backend.SHA (backends) where -import Control.Monad.State -import Data.String.Utils -import System.Cmd.Utils -import System.IO -import System.Directory -import Data.Maybe -import System.Posix.Files -import System.FilePath - -import Messages +import AnnexCommon import qualified Annex -import Locations import Content -import Types import Types.Backend import Types.Key -import Utility.SafeCommand import qualified Build.SysConfig as SysConfig type SHASize = Int @@ -110,7 +98,7 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE {- A key's checksum is checked during fsck. -} checkKeyChecksum :: SHASize -> Key -> Annex Bool checkKeyChecksum size key = do - g <- Annex.gitRepo + g <- gitRepo fast <- Annex.getState Annex.fast let file = gitAnnexLocation g key present <- liftIO $ doesFileExist file diff --git a/Backend/URL.hs b/Backend/URL.hs index f20aa1f95..0745de455 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -10,9 +10,9 @@ module Backend.URL ( fromUrl ) where +import AnnexCommon import Types.Backend import Types.Key -import Types backends :: [Backend Annex] backends = [backend] diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 831c9e8ce..80c652558 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -7,12 +7,8 @@ module Backend.WORM (backends) where -import Control.Monad.State -import System.FilePath -import System.Posix.Files - +import AnnexCommon import Types.Backend -import Types import Types.Key backends :: [Backend Annex] diff --git a/Branch.hs b/Branch.hs index f1ba97c94..3f1153c09 100644 --- a/Branch.hs +++ b/Branch.hs @@ -18,33 +18,17 @@ module Branch ( name ) where -import Control.Monad (unless, when, liftM, filterM) -import Control.Monad.State (liftIO) -import Control.Applicative ((<$>)) -import System.FilePath -import System.Directory -import Data.String.Utils -import System.Cmd.Utils -import System.IO import System.IO.Binary -import System.Posix.Process -import System.Posix.IO -import System.Posix.Files import System.Exit import qualified Data.ByteString.Lazy.Char8 as L import Control.Monad.IO.Control (liftIOOp) -import qualified Control.Exception.Base +import qualified Control.Exception +import AnnexCommon import Types.BranchState import qualified Git import qualified Git.UnionMerge import qualified Annex -import Utility -import Utility.Conditional -import Utility.SafeCommand -import Types -import Messages -import Locations import CatFile type GitRef = String @@ -79,7 +63,7 @@ withIndex :: Annex a -> Annex a withIndex = withIndex' False withIndex' :: Bool -> Annex a -> Annex a withIndex' bootstrapping a = do - g <- Annex.gitRepo + g <- gitRepo let f = index g reset <- liftIO $ Git.useIndex f @@ -123,7 +107,7 @@ getCache file = getState >>= handle {- Creates the branch, if it does not already exist. -} create :: Annex () create = unlessM hasBranch $ do - g <- Annex.gitRepo + g <- gitRepo e <- hasOrigin if e then liftIO $ Git.run g "branch" [Param name, Param originname] @@ -136,7 +120,7 @@ commit message = do fs <- getJournalFiles when (not $ null fs) $ lockJournal $ do stageJournalFiles fs - g <- Annex.gitRepo + g <- gitRepo withIndex $ liftIO $ Git.commit g message fullname [fullname] {- Ensures that the branch is up-to-date; should be called before @@ -161,13 +145,13 @@ update = do -} unless (null fs) $ stageJournalFiles fs mapM_ mergeref refs - g <- Annex.gitRepo + g <- gitRepo liftIO $ Git.commit g "update" fullname (fullname:refs) Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } } invalidateCache where checkref ref = do - g <- Annex.gitRepo + g <- gitRepo -- checking with log to see if there have been changes -- is less expensive than always merging diffs <- liftIO $ Git.pipeRead g [ @@ -189,14 +173,14 @@ update = do - advises users not to directly modify the - branch. -} - g <- Annex.gitRepo + g <- gitRepo liftIO $ Git.UnionMerge.merge g [ref] return $ Just ref {- Checks if a git ref exists. -} refExists :: GitRef -> Annex Bool refExists ref = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ Git.runBool g "show-ref" [Param "--verify", Param "-q", Param ref] @@ -216,7 +200,7 @@ hasSomeBranch = not . null <$> siblingBranches - from remotes. -} siblingBranches :: Annex [String] siblingBranches = do - g <- Annex.gitRepo + g <- gitRepo r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name] return $ map (last . words . L.unpack) (L.lines r) @@ -253,7 +237,7 @@ get file = do {- Lists all files on the branch. There may be duplicates in the list. -} files :: Annex [FilePath] files = withIndexUpdate $ do - g <- Annex.gitRepo + g <- gitRepo bfiles <- liftIO $ Git.pipeNullSplit g [Params "ls-tree --name-only -r -z", Param fullname] jfiles <- getJournalledFiles @@ -265,7 +249,7 @@ files = withIndexUpdate $ do - avoids git needing to rewrite the index after every change. -} setJournalFile :: FilePath -> String -> Annex () setJournalFile file content = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ catch (write g) $ const $ do createDirectoryIfMissing True $ gitAnnexJournalDir g createDirectoryIfMissing True $ gitAnnexTmpDir g @@ -281,7 +265,7 @@ setJournalFile file content = do {- Gets any journalled content for a file in the branch. -} getJournalFile :: FilePath -> Annex (Maybe String) getJournalFile file = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ catch (liftM Just . readFileStrict $ journalFile g file) (const $ return Nothing) @@ -292,7 +276,7 @@ getJournalledFiles = map fileJournal <$> getJournalFiles {- List of existing journal files. -} getJournalFiles :: Annex [FilePath] getJournalFiles = do - g <- Annex.gitRepo + g <- gitRepo fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g) (const $ return []) return $ filter (`notElem` [".", ".."]) fs @@ -300,7 +284,7 @@ getJournalFiles = do {- Stages the specified journalfiles. -} stageJournalFiles :: [FilePath] -> Annex () stageJournalFiles fs = do - g <- Annex.gitRepo + g <- gitRepo withIndex $ liftIO $ do let dir = gitAnnexJournalDir g let paths = map (dir ) fs @@ -346,9 +330,9 @@ fileJournal = replace "//" "_" . replace "_" "/" - contention with other git-annex processes. -} lockJournal :: Annex a -> Annex a lockJournal a = do - g <- Annex.gitRepo + g <- gitRepo let file = gitAnnexJournalLock g - liftIOOp (Control.Exception.Base.bracket (lock file) unlock) run + liftIOOp (Control.Exception.bracket (lock file) unlock) run where lock file = do l <- createFile file stdFileMode diff --git a/CatFile.hs b/CatFile.hs index 0eb1e74f6..8762109e7 100644 --- a/CatFile.hs +++ b/CatFile.hs @@ -9,17 +9,15 @@ module CatFile ( catFile ) where -import Control.Monad.State - +import AnnexCommon import qualified Git.CatFile -import Types import qualified Annex catFile :: String -> FilePath -> Annex String catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle where startup = do - g <- Annex.gitRepo + g <- gitRepo h <- liftIO $ Git.CatFile.catFileStart g Annex.changeState $ \s -> s { Annex.catfilehandle = Just h } go h diff --git a/CmdLine.hs b/CmdLine.hs index 38d4754da..34adb2556 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -13,17 +13,14 @@ module CmdLine ( import System.IO.Error (try) import System.Console.GetOpt -import Control.Monad.State (liftIO) -import Control.Monad (when) +import AnnexCommon import qualified Annex import qualified AnnexQueue import qualified Git import Content -import Types import Command import Options -import Messages import Init {- Runs the passed command line. -} diff --git a/Command.hs b/Command.hs index c061c7c46..20f3d79b6 100644 --- a/Command.hs +++ b/Command.hs @@ -7,22 +7,11 @@ module Command where -import Control.Monad.State (liftIO) -import System.Directory -import System.Posix.Files -import Control.Monad (filterM, liftM) -import Control.Applicative -import Data.Maybe - -import Types +import AnnexCommon import qualified Backend -import Messages import qualified Annex import qualified Git import qualified Git.LsFiles as LsFiles -import Utility -import Utility.Conditional -import Utility.Path import Types.Key import Trust import LocationLog @@ -98,7 +87,7 @@ isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file notBareRepo :: Annex a -> Annex a notBareRepo a = do - whenM (Git.repoIsLocalBare <$> Annex.gitRepo) $ + whenM (Git.repoIsLocalBare <$> gitRepo) $ error "You cannot run this subcommand in a bare repository." a @@ -106,11 +95,11 @@ notBareRepo a = do user's parameters, and prepare actions operating on them. -} withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit a params = do - repo <- Annex.gitRepo + repo <- gitRepo runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek withAttrFilesInGit attr a params = do - repo <- Annex.gitRepo + repo <- gitRepo files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek @@ -119,7 +108,7 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params go (file, v) = a file (readMaybe v) withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek withBackendFilesInGit a params = do - repo <- Annex.gitRepo + repo <- gitRepo files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params backendPairs a files withFilesMissing :: (String -> CommandStart) -> CommandSeek @@ -128,7 +117,7 @@ withFilesMissing a params = runFiltered a $ liftIO $ filterM missing params missing = liftM not . doesFileExist withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek withFilesNotInGit a params = do - repo <- Annex.gitRepo + repo <- gitRepo force <- Annex.getState Annex.force newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params backendPairs a newfiles @@ -138,7 +127,7 @@ withStrings :: (String -> CommandStart) -> CommandSeek withStrings a params = return $ map a params withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek withFilesToBeCommitted a params = do - repo <- Annex.gitRepo + repo <- gitRepo runFiltered a $ liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek @@ -148,7 +137,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek withFilesUnlocked' typechanged a params = do -- unlocked files have changed type from a symlink to a regular file - repo <- Annex.gitRepo + repo <- gitRepo typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params unlockedfiles <- liftIO $ filterM notSymlink $ map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles diff --git a/Command/Add.hs b/Command/Add.hs index 4b2ef24cd..c66c38131 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -7,26 +7,17 @@ module Command.Add where -import Control.Monad.State (liftIO) -import Control.Monad (when) -import System.Posix.Files -import System.Directory import Control.Exception.Control (handle) import Control.Exception.Base (throwIO) -import Control.Exception.Extensible (IOException) +import AnnexCommon import Command import qualified Annex import qualified AnnexQueue import qualified Backend import LocationLog -import Types import Content -import Messages -import Utility.Conditional import Utility.Touch -import Utility.SafeCommand -import Locations import Backend command :: [Command] @@ -72,7 +63,7 @@ undo file key e = do -- fromAnnex could fail if the file ownership is weird tryharder :: IOException -> Annex () tryharder _ = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ renameFile (gitAnnexLocation g key) file cleanup :: FilePath -> Key -> Bool -> CommandCleanup diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 2e9e04fd3..ce6e70699 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -7,12 +7,9 @@ module Command.AddUrl where -import Control.Monad.State import Network.URI -import Data.String.Utils -import Data.Maybe -import System.Directory +import AnnexCommon import Command import qualified Backend import qualified Utility.Url as Url @@ -20,12 +17,8 @@ import qualified Remote.Web import qualified Command.Add import qualified Annex import qualified Backend.URL -import Messages import Content import PresenceLog -import Locations -import Utility.Path -import Utility.Conditional command :: [Command] command = [repoCommand "addurl" (paramRepeating paramUrl) seek @@ -51,7 +44,7 @@ perform url file = do download :: String -> FilePath -> CommandPerform download url file = do - g <- Annex.gitRepo + g <- gitRepo showAction $ "downloading " ++ url ++ " " let dummykey = Backend.URL.fromUrl url let tmp = gitAnnexTmpLocation g dummykey diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 3de26c892..c38539fa0 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -7,9 +7,7 @@ module Command.ConfigList where -import Control.Monad.State (liftIO) - -import Annex +import AnnexCommon import Command import UUID @@ -22,7 +20,7 @@ seek = [withNothing start] start :: CommandStart start = do - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g liftIO $ putStrLn $ "annex.uuid=" ++ u stop diff --git a/Command/Describe.hs b/Command/Describe.hs index 8d2f9071b..b1c144872 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -7,10 +7,10 @@ module Command.Describe where +import AnnexCommon import Command import qualified Remote import UUID -import Messages command :: [Command] command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek diff --git a/Command/Drop.hs b/Command/Drop.hs index 4a7596921..7210184f8 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -7,14 +7,12 @@ module Command.Drop where +import AnnexCommon import Command import qualified Remote import qualified Annex import LocationLog -import Types import Content -import Messages -import Utility.Conditional import Trust import Config @@ -71,9 +69,9 @@ dropKey key numcopiesM = do | length have >= need = return True | otherwise = do let u = Remote.uuid r - let dup = u `elem` have + let duplicate = u `elem` have haskey <- Remote.hasKey r key - case (dup, haskey) of + case (duplicate, haskey) of (False, Right True) -> findcopies need (u:have) rs bad (False, Left _) -> findcopies need have rs (r:bad) _ -> findcopies need have rs bad diff --git a/Command/DropKey.hs b/Command/DropKey.hs index b9938585e..7ead1c4bc 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -7,12 +7,11 @@ module Command.DropKey where +import AnnexCommon import Command import qualified Annex import LocationLog -import Types import Content -import Messages command :: [Command] command = [repoCommand "dropkey" (paramRepeating paramKey) seek diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 90fea050e..ed4f71e7e 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -7,22 +7,16 @@ module Command.DropUnused where -import Control.Monad.State (liftIO) import qualified Data.Map as M -import System.Directory -import Data.Maybe +import AnnexCommon import Command -import Types -import Messages -import Locations import qualified Annex import qualified Command.Drop import qualified Command.Move import qualified Remote import qualified Git import Types.Key -import Utility.Conditional type UnusedMap = M.Map String Key @@ -67,14 +61,14 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform performOther filespec key = do - g <- Annex.gitRepo + g <- gitRepo let f = filespec g key liftIO $ whenM (doesFileExist f) $ removeFile f next $ return True readUnusedLog :: FilePath -> Annex UnusedMap readUnusedLog prefix = do - g <- Annex.gitRepo + g <- gitRepo let f = gitAnnexUnusedLog prefix g e <- liftIO $ doesFileExist f if e diff --git a/Command/Find.hs b/Command/Find.hs index effb33184..8d80659d0 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -7,11 +7,9 @@ module Command.Find where -import Control.Monad.State - +import AnnexCommon import Command import Content -import Utility.Conditional import Limit command :: [Command] diff --git a/Command/Fix.hs b/Command/Fix.hs index 481da52f2..a66a1c44a 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -7,16 +7,10 @@ module Command.Fix where -import Control.Monad.State (liftIO) -import System.Posix.Files -import System.Directory - +import AnnexCommon import Command import qualified AnnexQueue -import Utility.Path -import Utility.SafeCommand import Content -import Messages command :: [Command] command = [repoCommand "fix" paramPaths seek diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 9ff126a45..e60025bf7 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -7,18 +7,11 @@ module Command.FromKey where -import Control.Monad.State (liftIO) -import System.Posix.Files -import System.Directory -import Control.Monad (unless) - +import AnnexCommon import Command import qualified AnnexQueue -import Utility.SafeCommand import Content -import Messages import Types.Key -import Utility.Path command :: [Command] command = [repoCommand "fromkey" paramPath seek diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 0c58add6a..33a8405a6 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -7,25 +7,16 @@ module Command.Fsck where -import Control.Monad (when) -import Control.Monad.State (liftIO) -import System.Directory -import System.Posix.Files - +import AnnexCommon import Command -import qualified Annex import qualified Remote import qualified Types.Backend import qualified Types.Key import UUID -import Types -import Messages import Content import LocationLog -import Locations import Trust import Utility.DataUnits -import Utility.Path import Utility.FileMode import Config @@ -54,7 +45,7 @@ perform key file backend numcopies = do in this repository only. -} verifyLocationLog :: Key -> FilePath -> Annex Bool verifyLocationLog key file = do - g <- Annex.gitRepo + g <- gitRepo present <- inAnnex key -- Since we're checking that a key's file is present, throw @@ -98,7 +89,7 @@ fsckKey backend key file numcopies = do - the key's metadata, if available. -} checkKeySize :: Key -> Annex Bool checkKeySize key = do - g <- Annex.gitRepo + g <- gitRepo let file = gitAnnexLocation g key present <- liftIO $ doesFileExist file case (present, Types.Key.keySize key) of diff --git a/Command/Get.hs b/Command/Get.hs index 4fd654f63..34f56aa2d 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -7,12 +7,11 @@ module Command.Get where +import AnnexCommon import Command import qualified Annex import qualified Remote -import Types import Content -import Messages import qualified Command.Move command :: [Command] diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index 713492c2f..36b6d40e6 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -7,12 +7,9 @@ module Command.InAnnex where -import Control.Monad.State (liftIO) -import System.Exit - +import AnnexCommon import Command import Content -import Types command :: [Command] command = [repoCommand "inannex" (paramRepeating paramKey) seek diff --git a/Command/Init.hs b/Command/Init.hs index 2351763a9..f3d8834ba 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -7,10 +7,9 @@ module Command.Init where +import AnnexCommon import Command -import qualified Annex import UUID -import Messages import Init command :: [Command] @@ -30,7 +29,7 @@ start ws = do perform :: String -> CommandPerform perform description = do initialize - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g describeUUID u description next $ return True diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index c6d9f5200..2ce86e9c6 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -8,18 +8,13 @@ module Command.InitRemote where import qualified Data.Map as M -import Control.Monad (when) -import Control.Monad.State (liftIO) -import Data.Maybe -import Data.String.Utils +import AnnexCommon import Command import qualified Remote import qualified RemoteLog import qualified Types.Remote as R -import Types import UUID -import Messages command :: [Command] command = [repoCommand "initremote" diff --git a/Command/Lock.hs b/Command/Lock.hs index 04d1bb94d..af7b92ad6 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -7,13 +7,9 @@ module Command.Lock where -import Control.Monad.State (liftIO) -import System.Directory - +import AnnexCommon import Command -import Messages import qualified AnnexQueue -import Utility.SafeCommand import Backend command :: [Command] diff --git a/Command/Map.hs b/Command/Map.hs index 7e23da774..8e63f6dd6 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -7,19 +7,12 @@ module Command.Map where -import Control.Monad.State (liftIO) import Control.Exception.Extensible -import System.Cmd.Utils import qualified Data.Map as M -import Data.List.Utils -import Data.Maybe +import AnnexCommon import Command -import qualified Annex import qualified Git -import Messages -import Types -import Utility.SafeCommand import UUID import Trust import Utility.Ssh @@ -36,7 +29,7 @@ seek = [withNothing start] start :: CommandStart start = do - g <- Annex.gitRepo + g <- gitRepo rs <- spider g umap <- uuidMap diff --git a/Command/Merge.hs b/Command/Merge.hs index 832cde512..b365e0e0c 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -7,9 +7,9 @@ module Command.Merge where +import AnnexCommon import Command import qualified Branch -import Messages command :: [Command] command = [repoCommand "merge" paramNothing seek diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 054db6e27..24f23baf5 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -7,22 +7,11 @@ module Command.Migrate where -import Control.Monad.State (liftIO) -import Control.Applicative -import System.Posix.Files -import System.Directory -import System.FilePath -import Data.Maybe - +import AnnexCommon import Command -import qualified Annex import qualified Backend import qualified Types.Key -import Locations -import Types import Content -import Messages -import Utility.Conditional import qualified Command.Add import Backend @@ -53,7 +42,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file oldkey newbackend = do - g <- Annex.gitRepo + g <- gitRepo -- Store the old backend's cached key in the new backend -- (the file can't be stored as usual, because it's already a symlink). diff --git a/Command/Move.hs b/Command/Move.hs index 15dae3938..d2870b1e4 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -7,18 +7,14 @@ module Command.Move where -import Control.Monad (when) - +import AnnexCommon import Command import qualified Command.Drop import qualified Annex import LocationLog -import Types import Content import qualified Remote import UUID -import Messages -import Utility.Conditional command :: [Command] command = [repoCommand "move" paramPaths seek @@ -60,7 +56,7 @@ showMoveAction False file = showStart "copy" file remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex () remoteHasKey remote key present = do let remoteuuid = Remote.uuid remote - g <- Annex.gitRepo + g <- gitRepo logChange g key remoteuuid status where status = if present then InfoPresent else InfoMissing @@ -76,7 +72,7 @@ remoteHasKey remote key present = do -} toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart toStart dest move file = isAnnexed file $ \(key, _) -> do - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g ishere <- inAnnex key if not ishere || u == Remote.uuid dest @@ -126,7 +122,7 @@ toCleanup dest move key = do -} fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart fromStart src move file = isAnnexed file $ \(key, _) -> do - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g remotes <- Remote.keyPossibilities key if u == Remote.uuid src || not (any (== src) remotes) diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 33792e5b6..400e81102 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -7,15 +7,11 @@ module Command.RecvKey where -import Control.Monad.State (liftIO) -import System.Exit - +import AnnexCommon import Command import CmdLine import Content import Utility.RsyncFile -import Utility.Conditional -import Types command :: [Command] command = [repoCommand "recvkey" paramKey seek diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index 3b12bb747..236ba2879 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -7,11 +7,11 @@ module Command.Semitrust where +import AnnexCommon import Command import qualified Remote import UUID import Trust -import Messages command :: [Command] command = [repoCommand "semitrust" (paramRepeating paramRemote) seek diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 98d257338..f397d9ae6 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -7,17 +7,10 @@ module Command.SendKey where -import Control.Monad.State (liftIO) -import System.Exit - -import Locations -import qualified Annex +import AnnexCommon import Command import Content import Utility.RsyncFile -import Utility.Conditional -import Messages -import Types command :: [Command] command = [repoCommand "sendkey" paramKey seek @@ -28,7 +21,7 @@ seek = [withKeys start] start :: Key -> CommandStart start key = do - g <- Annex.gitRepo + g <- gitRepo let file = gitAnnexLocation g key whenM (inAnnex key) $ liftIO $ rsyncServerSend file -- does not return diff --git a/Command/SetKey.hs b/Command/SetKey.hs index c03c5d044..12ef5b74a 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -7,13 +7,10 @@ module Command.SetKey where -import Control.Monad.State (liftIO) - +import AnnexCommon import Command -import Utility.SafeCommand import LocationLog import Content -import Messages command :: [Command] command = [repoCommand "setkey" paramPath seek diff --git a/Command/Status.hs b/Command/Status.hs index 07c0958bb..de49f84d5 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -8,25 +8,20 @@ module Command.Status where import Control.Monad.State -import Control.Applicative -import Data.Maybe -import System.IO -import Data.List import qualified Data.Map as M import qualified Data.Set as S import Data.Set (Set) +import AnnexCommon import qualified Types.Backend as B import qualified Types.Remote as R import qualified Remote import qualified Command.Unused import qualified Git import Command -import Types import Utility.DataUnits import Content import Types.Key -import Locations import Backend import UUID import Remote diff --git a/Command/Trust.hs b/Command/Trust.hs index 5e25b519b..04c68a5d3 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -7,11 +7,11 @@ module Command.Trust where +import AnnexCommon import Command import qualified Remote import Trust import UUID -import Messages command :: [Command] command = [repoCommand "trust" (paramRepeating paramRemote) seek diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 4d4281eb0..c5c5e90a6 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -7,25 +7,16 @@ module Command.Unannex where -import Control.Monad.State (liftIO) -import Control.Monad (unless) -import System.Directory -import System.Posix.Files - +import AnnexCommon import Command import qualified Command.Drop import qualified Annex import qualified AnnexQueue -import Utility.SafeCommand -import Utility.Path import Utility.FileMode import LocationLog -import Types import Content import qualified Git import qualified Git.LsFiles as LsFiles -import Messages -import Locations command :: [Command] command = [repoCommand "unannex" paramPaths seek "undo accidential add command"] @@ -41,7 +32,7 @@ start file = isAnnexed file $ \(key, _) -> do then do force <- Annex.getState Annex.force unless force $ do - g <- Annex.gitRepo + g <- gitRepo staged <- liftIO $ LsFiles.staged g [Git.workTree g] unless (null staged) $ error "This command cannot be run when there are already files staged for commit." @@ -60,7 +51,7 @@ perform file key = do cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ removeFile file liftIO $ Git.run g "rm" [Params "--quiet --", File file] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index ce1266542..3ba7a7cf3 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -7,19 +7,14 @@ module Command.Uninit where -import Control.Monad.State (liftIO) -import System.Directory -import System.Exit - +import AnnexCommon import Command -import Utility.SafeCommand import qualified Git import qualified Annex import qualified Command.Unannex import Init import qualified Branch import Content -import Locations command :: [Command] command = [repoCommand "uninit" paramPaths seek @@ -44,7 +39,7 @@ perform = next cleanup cleanup :: CommandCleanup cleanup = do - g <- Annex.gitRepo + g <- gitRepo uninitialize mapM_ removeAnnex =<< getKeysPresent liftIO $ removeDirectoryRecursive (gitAnnexDir g) diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 44b92545c..220d57829 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -7,18 +7,10 @@ module Command.Unlock where -import Control.Monad.State (liftIO) -import System.Directory hiding (copyFile) - +import AnnexCommon import Command -import qualified Annex -import Types -import Messages -import Locations import Content -import Utility.Conditional import Utility.CopyFile -import Utility.Path import Utility.FileMode command :: [Command] @@ -43,12 +35,12 @@ perform dest key = do checkDiskSpace key - g <- Annex.gitRepo + g <- gitRepo let src = gitAnnexLocation g key let tmpdest = gitAnnexTmpLocation g key liftIO $ createDirectoryIfMissing True (parentDir tmpdest) showAction "copying" - ok <- liftIO $ copyFile src tmpdest + ok <- liftIO $ copyFileExternal src tmpdest if ok then do liftIO $ do diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 9f7e52198..30ade85ce 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -7,11 +7,11 @@ module Command.Untrust where +import AnnexCommon import Command import qualified Remote import UUID import Trust -import Messages command :: [Command] command = [repoCommand "untrust" (paramRepeating paramRemote) seek diff --git a/Command/Unused.hs b/Command/Unused.hs index 987f36720..1ba4f5301 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -9,23 +9,13 @@ module Command.Unused where -import Control.Monad (filterM, unless, forM_) -import Control.Monad.State (liftIO) import qualified Data.Set as S -import Data.Maybe -import System.FilePath -import System.Directory -import Data.List import qualified Data.ByteString.Lazy.Char8 as L +import AnnexCommon import Command -import Types import Content -import Messages -import Locations -import Utility import Utility.FileMode -import Utility.SafeCommand import LocationLog import qualified Annex import qualified Git @@ -92,7 +82,7 @@ checkRemoteUnused' r = do writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex () writeUnusedFile prefix l = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $ unlines $ map (\(n, k) -> show n ++ " " ++ show k) l @@ -164,7 +154,7 @@ unusedKeys = do excludeReferenced :: [Key] -> Annex [Key] excludeReferenced [] = return [] -- optimisation excludeReferenced l = do - g <- Annex.gitRepo + g <- gitRepo c <- liftIO $ Git.pipeRead g [Param "show-ref"] removewith (getKeysReferenced : map getKeysReferencedInGit (refs c)) (S.fromList l) @@ -200,7 +190,7 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller {- List of keys referenced by symlinks in the git repo. -} getKeysReferenced :: Annex [Key] getKeysReferenced = do - g <- Annex.gitRepo + g <- gitRepo files <- liftIO $ LsFiles.inRepo g [Git.workTree g] keypairs <- mapM Backend.lookupFile files return $ map fst $ catMaybes keypairs @@ -209,7 +199,7 @@ getKeysReferenced = do getKeysReferencedInGit :: String -> Annex [Key] getKeysReferencedInGit ref = do showAction $ "checking " ++ Git.refDescribe ref - g <- Annex.gitRepo + g <- gitRepo findkeys [] =<< liftIO (LsTree.lsTree g ref) where findkeys c [] = return c @@ -232,17 +222,17 @@ staleKeysPrune dirspec present = do contents <- staleKeys dirspec let stale = contents `exclude` present - let dup = contents `exclude` stale + let dups = contents `exclude` stale - g <- Annex.gitRepo + g <- gitRepo let dir = dirspec g - liftIO $ forM_ dup $ \t -> removeFile $ dir keyFile t + liftIO $ forM_ dups $ \t -> removeFile $ dir keyFile t return stale staleKeys :: (Git.Repo -> FilePath) -> Annex [Key] staleKeys dirspec = do - g <- Annex.gitRepo + g <- gitRepo let dir = dirspec g exists <- liftIO $ doesDirectoryExist dir if not exists diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 5d9ed92fa..d79f895d8 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -7,10 +7,10 @@ module Command.Upgrade where +import AnnexCommon import Command import Upgrade import Version -import Messages command :: [Command] command = [standaloneCommand "upgrade" paramNothing seek diff --git a/Command/Version.hs b/Command/Version.hs index af547949c..1e44fbb0b 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -7,10 +7,7 @@ module Command.Version where -import Control.Monad.State (liftIO) -import Data.String.Utils -import Data.Maybe - +import AnnexCommon import Command import qualified Build.SysConfig as SysConfig import Version diff --git a/Command/Whereis.hs b/Command/Whereis.hs index a414428f7..3fb636c04 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -7,13 +7,10 @@ module Command.Whereis where -import Control.Monad - +import AnnexCommon import LocationLog import Command -import Messages import Remote -import Types import Trust command :: [Command] diff --git a/Common.hs b/Common.hs new file mode 100644 index 000000000..e88342ae4 --- /dev/null +++ b/Common.hs @@ -0,0 +1,46 @@ +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, + module Utility.Conditional, + module Utility.SafeCommand, + module Utility.Path, +) where + +import Control.Monad hiding (join) +import Control.Applicative +import Control.Monad.State (liftIO) +import Control.Exception.Extensible (IOException) + +import Data.Maybe +import Data.List +import Data.String.Utils + +import System.Path +import System.FilePath +import System.Directory +import System.Cmd.Utils +import System.IO hiding (FilePath) +import System.Posix.Files +import System.Posix.IO +import System.Posix.Process hiding (executeFile) +import System.Exit + +import Utility +import Utility.Conditional +import Utility.SafeCommand +import Utility.Path diff --git a/Config.hs b/Config.hs index fe847fce1..c0328794e 100644 --- a/Config.hs +++ b/Config.hs @@ -7,23 +7,16 @@ module Config where -import Data.Maybe -import Control.Monad.State (liftIO) -import Control.Applicative -import System.Cmd.Utils - +import AnnexCommon import qualified Git import qualified Annex -import Types -import Utility -import Utility.SafeCommand type ConfigKey = String {- Changes a git config setting in both internal state and .git/config -} setConfig :: ConfigKey -> String -> Annex () setConfig k value = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ Git.run g "config" [Param k, Param value] -- re-read git config and update the repo's state g' <- liftIO $ Git.configRead g @@ -33,7 +26,7 @@ setConfig k value = do - Failing that, tries looking for a global config option. -} getConfig :: Git.Repo -> ConfigKey -> String -> Annex String getConfig r key def = do - g <- Annex.gitRepo + g <- gitRepo let def' = Git.configGet g ("annex." ++ key) def return $ Git.configGet g (remoteConfig r key) def' @@ -95,7 +88,7 @@ getNumCopies v = where use (Just n) = return n use Nothing = do - g <- Annex.gitRepo + g <- gitRepo return $ read $ Git.configGet g config "1" config = "annex.numcopies" diff --git a/Content.hs b/Content.hs index f963c48b4..567e4caa5 100644 --- a/Content.hs +++ b/Content.hs @@ -21,26 +21,14 @@ module Content ( saveState ) where -import System.Directory -import Control.Monad.State (liftIO) -import System.Path -import Control.Monad -import System.Posix.Files -import System.FilePath -import Data.Maybe - -import Types -import Locations +import AnnexCommon import LocationLog import UUID import qualified Git import qualified Annex import qualified AnnexQueue import qualified Branch -import Utility -import Utility.Conditional import Utility.StatFS -import Utility.Path import Utility.FileMode import Types.Key import Utility.DataUnits @@ -49,14 +37,14 @@ import Config {- Checks if a given key is currently present in the gitAnnexLocation. -} inAnnex :: Key -> Annex Bool inAnnex key = do - g <- Annex.gitRepo + g <- gitRepo when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo" liftIO $ doesFileExist $ gitAnnexLocation g key {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath calcGitLink file key = do - g <- Annex.gitRepo + g <- gitRepo cwd <- liftIO getCurrentDirectory let absfile = fromMaybe whoops $ absNormPath cwd file return $ relPathDirToFile (parentDir absfile) @@ -68,7 +56,7 @@ calcGitLink file key = do - repository. -} logStatus :: Key -> LogStatus -> Annex () logStatus key status = do - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g logChange g key u status @@ -77,7 +65,7 @@ logStatus key status = do - the annex as a key's content. -} getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmp key action = do - g <- Annex.gitRepo + g <- gitRepo let tmp = gitAnnexTmpLocation g key -- Check that there is enough free disk space. @@ -96,7 +84,7 @@ getViaTmp key action = do prepTmp :: Key -> Annex FilePath prepTmp key = do - g <- Annex.gitRepo + g <- gitRepo let tmp = gitAnnexTmpLocation g key liftIO $ createDirectoryIfMissing True (parentDir tmp) return tmp @@ -133,7 +121,7 @@ checkDiskSpace = checkDiskSpace' 0 checkDiskSpace' :: Integer -> Key -> Annex () checkDiskSpace' adjustment key = do - g <- Annex.gitRepo + g <- gitRepo r <- getConfig g "diskreserve" "" let reserve = fromMaybe megabyte $ readSize dataUnits r stats <- liftIO $ getFileSystemStats (gitAnnexDir g) @@ -174,7 +162,7 @@ checkDiskSpace' adjustment key = do -} moveAnnex :: Key -> FilePath -> Annex () moveAnnex key src = do - g <- Annex.gitRepo + g <- gitRepo let dest = gitAnnexLocation g key let dir = parentDir dest e <- liftIO $ doesFileExist dest @@ -189,7 +177,7 @@ moveAnnex key src = do withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a withObjectLoc key a = do - g <- Annex.gitRepo + g <- gitRepo let file = gitAnnexLocation g key let dir = parentDir file a (dir, file) @@ -213,7 +201,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do - returns the file it was moved to. -} moveBad :: Key -> Annex FilePath moveBad key = do - g <- Annex.gitRepo + g <- gitRepo let src = gitAnnexLocation g key let dest = gitAnnexBadDir g takeFileName src liftIO $ do @@ -227,7 +215,7 @@ moveBad key = do {- List of keys whose content exists in .git/annex/objects/ -} getKeysPresent :: Annex [Key] getKeysPresent = do - g <- Annex.gitRepo + g <- gitRepo getKeysPresent' $ gitAnnexObjectDir g getKeysPresent' :: FilePath -> Annex [Key] getKeysPresent' dir = do diff --git a/Crypto.hs b/Crypto.hs index 9b2d73f28..4cc16b424 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -30,26 +30,17 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import Data.ByteString.Lazy.UTF8 (fromString) import Data.Digest.Pure.SHA -import System.Cmd.Utils -import Data.String.Utils -import Data.List -import Data.Maybe -import System.IO -import System.Posix.IO import System.Posix.Types -import System.Posix.Process import Control.Applicative import Control.Concurrent import Control.Exception (finally) import System.Exit import System.Environment -import Types +import AnnexCommon import Types.Key import Types.Remote -import Utility import Utility.Base64 -import Utility.SafeCommand import Types.Crypto {- The first half of a Cipher is used for HMAC; the remainder @@ -97,9 +88,9 @@ updateCipher :: RemoteConfig -> EncryptedCipher -> IO EncryptedCipher updateCipher c encipher@(EncryptedCipher _ ks) = do ks' <- configKeyIds c cipher <- decryptCipher c encipher - encryptCipher cipher (combine ks ks') + encryptCipher cipher (merge ks ks') where - combine (KeyIds a) (KeyIds b) = KeyIds $ a ++ b + merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b describeCipher :: EncryptedCipher -> String describeCipher (EncryptedCipher _ (KeyIds ks)) = diff --git a/Git.hs b/Git.hs index d32aaaa56..7a3d55dea 100644 --- a/Git.hs +++ b/Git.hs @@ -64,34 +64,20 @@ module Git ( prop_idempotent_deencode ) where -import Control.Monad (unless, when, liftM2) -import Control.Applicative -import System.Directory -import System.FilePath import System.Posix.Directory import System.Posix.User -import System.Posix.Process -import System.Path -import System.Cmd.Utils import IO (bracket_, try) -import Data.String.Utils -import System.IO import qualified Data.Map as M hiding (map, split) import Network.URI -import Data.Maybe import Data.Char import Data.Word (Word8) import Codec.Binary.UTF8.String (encode) import Text.Printf -import Data.List (isInfixOf, isPrefixOf, isSuffixOf) import System.Exit import System.Posix.Env (setEnv, unsetEnv, getEnv) import qualified Data.ByteString.Lazy.Char8 as L -import Utility -import Utility.Path -import Utility.Conditional -import Utility.SafeCommand +import Common {- There are two types of repositories; those on local disk and those - accessed via an URL. -} diff --git a/GitAnnex.hs b/GitAnnex.hs index a9d469b44..fcfbf44b4 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -8,14 +8,12 @@ module GitAnnex where import System.Console.GetOpt -import Control.Monad.State (liftIO) +import AnnexCommon import qualified Git import CmdLine import Command import Options -import Utility -import Types import Types.TrustLevel import qualified Annex import qualified Remote @@ -122,7 +120,7 @@ options = commonOptions ++ setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v } setgitconfig :: String -> Annex () setgitconfig v = do - g <- Annex.gitRepo + g <- gitRepo g' <- liftIO $ Git.configStore g v Annex.changeState $ \s -> s { Annex.repo = g' } diff --git a/Init.hs b/Init.hs index 4df159933..57eaf39d2 100644 --- a/Init.hs +++ b/Init.hs @@ -11,18 +11,10 @@ module Init ( uninitialize ) where -import Control.Monad.State (liftIO) -import Control.Monad (unless) -import System.Directory - -import qualified Annex +import AnnexCommon import qualified Git import qualified Branch import Version -import Messages -import Types -import Utility -import Utility.Conditional import UUID initialize :: Annex () @@ -73,12 +65,12 @@ gitPreCommitHookUnWrite = unlessBare $ do unlessBare :: Annex () -> Annex () unlessBare a = do - g <- Annex.gitRepo + g <- gitRepo unless (Git.repoIsLocalBare g) a preCommitHook :: Annex FilePath preCommitHook = do - g <- Annex.gitRepo + g <- gitRepo return $ Git.gitDir g ++ "/hooks/pre-commit" preCommitScript :: String diff --git a/Limit.hs b/Limit.hs index 10fc0ea6c..334ae325d 100644 --- a/Limit.hs +++ b/Limit.hs @@ -9,15 +9,13 @@ module Limit where import Text.Regex.PCRE.Light.Char8 import System.Path.WildMatch -import Control.Applicative -import Data.Maybe -import Annex +import AnnexCommon +import qualified Annex import qualified Utility.Matcher import qualified Remote import qualified Backend import LocationLog -import Utility import Content type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) diff --git a/LocationLog.hs b/LocationLog.hs index 0cdf88bc6..759bee830 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -21,15 +21,10 @@ module LocationLog ( logFileKey ) where -import System.FilePath -import Control.Applicative -import Data.Maybe - +import AnnexCommon import qualified Git import qualified Branch import UUID -import Types -import Locations import PresenceLog {- Log a change in the presence of a key's value in a repository. -} diff --git a/Locations.hs b/Locations.hs index b18444e72..4579fe05b 100644 --- a/Locations.hs +++ b/Locations.hs @@ -26,13 +26,11 @@ module Locations ( prop_idempotent_fileKey ) where -import System.FilePath -import Data.String.Utils -import Data.List import Bits import Word import Data.Hash.MD5 +import Common import Types import Types.Key import qualified Git diff --git a/Messages.hs b/Messages.hs index c663c17c2..e029c5072 100644 --- a/Messages.hs +++ b/Messages.hs @@ -23,11 +23,9 @@ module Messages ( setupConsole ) where -import Control.Monad.State (liftIO) -import System.IO -import Data.String.Utils import Text.JSON +import Common import Types import qualified Annex import qualified Messages.JSON as JSON diff --git a/Options.hs b/Options.hs index b5eaf98cd..9d6029200 100644 --- a/Options.hs +++ b/Options.hs @@ -9,10 +9,9 @@ module Options where import System.Console.GetOpt import System.Log.Logger -import Control.Monad.State (liftIO) +import AnnexCommon import qualified Annex -import Types import Command import Limit diff --git a/PresenceLog.hs b/PresenceLog.hs index 2db1ee59b..23c288257 100644 --- a/PresenceLog.hs +++ b/PresenceLog.hs @@ -26,11 +26,9 @@ import Data.Time.Clock.POSIX import Data.Time import System.Locale import qualified Data.Map as M -import Control.Monad.State (liftIO) -import Control.Applicative +import AnnexCommon import qualified Branch -import Types data LogLine = LogLine { date :: POSIXTime, diff --git a/Remote.hs b/Remote.hs index efa7a5cc8..2371b7bf2 100644 --- a/Remote.hs +++ b/Remote.hs @@ -28,23 +28,17 @@ module Remote ( forceTrust ) where -import Control.Monad.State (filterM) -import Data.List import qualified Data.Map as M -import Data.String.Utils -import Data.Maybe -import Control.Applicative import Text.JSON import Text.JSON.Generic -import Types +import AnnexCommon import Types.Remote import UUID import qualified Annex import Config import Trust import LocationLog -import Messages import RemoteLog import qualified Remote.Git @@ -110,7 +104,7 @@ byName' n = do - and returns its UUID. Finds even remotes that are not configured in - .git/config. -} nameToUUID :: String -> Annex UUID -nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo +nameToUUID "." = getUUID =<< gitRepo -- special case for current repo nameToUUID n = do res <- byName' n case res of @@ -135,7 +129,7 @@ nameToUUID n = do - of the UUIDs. -} prettyPrintUUIDs :: String -> [UUID] -> Annex String prettyPrintUUIDs desc uuids = do - here <- getUUID =<< Annex.gitRepo + here <- getUUID =<< gitRepo m <- M.unionWith addname <$> uuidMap <*> remoteMap maybeShowJSON [(desc, map (jsonify m here) uuids)] return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids @@ -184,7 +178,7 @@ keyPossibilitiesTrusted = keyPossibilities' True keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID]) keyPossibilities' withtrusted key = do - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g trusted <- if withtrusted then trustGet Trusted else return [] @@ -204,7 +198,7 @@ keyPossibilities' withtrusted key = do {- Displays known locations of a key. -} showLocations :: Key -> [UUID] -> Annex () showLocations key exclude = do - g <- Annex.gitRepo + g <- gitRepo u <- getUUID g uuids <- keyLocations key untrusteduuids <- trustGet UnTrusted diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 29c7a0419..958831019 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -8,30 +8,15 @@ module Remote.Bup (remote) where import qualified Data.ByteString.Lazy.Char8 as L -import System.IO import System.IO.Error -import Control.Exception.Extensible (IOException) import qualified Data.Map as M -import Control.Monad (when) -import Control.Monad.State (liftIO) import System.Process -import System.Exit -import System.FilePath -import Data.Maybe -import Data.List.Utils -import System.Cmd.Utils -import Types +import AnnexCommon import Types.Remote import qualified Git -import qualified Annex import UUID -import Locations import Config -import Utility -import Utility.Conditional -import Utility.SafeCommand -import Messages import Utility.Ssh import Remote.Helper.Special import Remote.Helper.Encryptable @@ -118,14 +103,14 @@ bupSplitParams r buprepo k src = do store :: Git.Repo -> BupRepo -> Key -> Annex Bool store r buprepo k = do - g <- Annex.gitRepo + g <- gitRepo let src = gitAnnexLocation g k params <- bupSplitParams r buprepo k (File src) liftIO $ boolSystem "bup" params storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted r buprepo (cipher, enck) k = do - g <- Annex.gitRepo + g <- gitRepo let src = gitAnnexLocation g k params <- bupSplitParams r buprepo enck (Param "-") liftIO $ catchBool $ diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 18835c5de..664f8ca5f 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -9,25 +9,14 @@ module Remote.Directory (remote) where import qualified Data.ByteString.Lazy.Char8 as L import System.IO.Error -import Control.Exception.Extensible (IOException) import qualified Data.Map as M -import Control.Monad (when) -import Control.Monad.State (liftIO) -import System.Directory hiding (copyFile) -import System.FilePath -import Data.Maybe -import Types +import AnnexCommon +import Utility.CopyFile import Types.Remote import qualified Git -import qualified Annex import UUID -import Locations -import Utility.CopyFile import Config -import Utility -import Utility.Conditional -import Utility.Path import Utility.FileMode import Remote.Helper.Special import Remote.Helper.Encryptable @@ -82,14 +71,14 @@ dirKey d k = d hashDirMixed k f f store :: FilePath -> Key -> Annex Bool store d k = do - g <- Annex.gitRepo + g <- gitRepo let src = gitAnnexLocation g k let dest = dirKey d k - liftIO $ catchBool $ storeHelper dest $ copyFile src dest + liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted d (cipher, enck) k = do - g <- Annex.gitRepo + g <- gitRepo let src = gitAnnexLocation g k let dest = dirKey d enck liftIO $ catchBool $ storeHelper dest $ encrypt src dest @@ -110,7 +99,7 @@ storeHelper dest a = do return ok retrieve :: FilePath -> Key -> FilePath -> Annex Bool -retrieve d k f = liftIO $ copyFile (dirKey d k) f +retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool retrieveEncrypted d (cipher, enck) f = diff --git a/Remote/Git.hs b/Remote/Git.hs index d50899c67..a457c5905 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -8,26 +8,17 @@ module Remote.Git (remote) where import Control.Exception.Extensible -import Control.Monad.State (liftIO) import qualified Data.Map as M -import System.Cmd.Utils -import System.Posix.Files -import System.IO -import Types +import AnnexCommon +import Utility.CopyFile +import Utility.RsyncFile +import Utility.Ssh import Types.Remote import qualified Git import qualified Annex -import Locations import UUID -import Utility import qualified Content -import Messages -import Utility.CopyFile -import Utility.RsyncFile -import Utility.Ssh -import Utility.SafeCommand -import Utility.Path import qualified Utility.Url as Url import Config import Init @@ -42,7 +33,7 @@ remote = RemoteType { list :: Annex [Git.Repo] list = do - g <- Annex.gitRepo + g <- gitRepo return $ Git.remotes g gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) @@ -109,7 +100,7 @@ tryGitConfigRead r store a = do r' <- a - g <- Annex.gitRepo + g <- gitRepo let l = Git.remotes g let g' = Git.remotesAdd g $ exchange l r' Annex.changeState $ \s -> s { Annex.repo = g' } @@ -169,7 +160,7 @@ copyFromRemote r key file copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote r key | not $ Git.repoIsUrl r = do - g <- Annex.gitRepo + g <- gitRepo let keysrc = gitAnnexLocation g key -- run copy from perspective of remote liftIO $ onLocal r $ do @@ -178,7 +169,7 @@ copyToRemote r key Content.saveState return ok | Git.repoIsSsh r = do - g <- Annex.gitRepo + g <- gitRepo let keysrc = gitAnnexLocation g key rsyncHelper =<< rsyncParamsRemote r False key keysrc | otherwise = error "copying to non-ssh repo not supported" @@ -200,7 +191,7 @@ rsyncOrCopyFile r src dest = do ss <- liftIO $ getFileStatus $ parentDir src ds <- liftIO $ getFileStatus $ parentDir dest if deviceID ss == deviceID ds - then liftIO $ copyFile src dest + then liftIO $ copyFileExternal src dest else do params <- rsyncParams r rsyncHelper $ params ++ [Param src, Param dest] diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 04041c655..42503e4d4 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -8,13 +8,11 @@ module Remote.Helper.Encryptable where import qualified Data.Map as M -import Control.Monad.State (liftIO) -import Types +import AnnexCommon import Types.Remote import Crypto import qualified Annex -import Messages import Config {- Encryption setup for a remote. The user must specify whether to use diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index b842588c0..905db04c5 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -8,16 +8,11 @@ module Remote.Helper.Special where import qualified Data.Map as M -import Data.Maybe -import Data.String.Utils -import Control.Monad.State (liftIO) -import Types +import AnnexCommon import Types.Remote import qualified Git -import qualified Annex import UUID -import Utility.SafeCommand {- Special remotes don't have a configured url, so Git.Repo does not - automatically generate remotes for them. This looks for a different @@ -25,7 +20,7 @@ import Utility.SafeCommand -} findSpecialRemotes :: String -> Annex [Git.Repo] findSpecialRemotes s = do - g <- Annex.gitRepo + g <- gitRepo return $ map construct $ remotepairs g where remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r @@ -35,7 +30,7 @@ findSpecialRemotes s = do {- Sets up configuration for a special remote in .git/config. -} gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex () gitConfigSpecialRemote u c k v = do - g <- Annex.gitRepo + g <- gitRepo liftIO $ do Git.run g "config" [Param (configsetting $ "annex-"++k), Param v] Git.run g "config" [Param (configsetting "annex-uuid"), Param u] diff --git a/Remote/Hook.hs b/Remote/Hook.hs index aaeb702c7..3bbda1924 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -8,31 +8,19 @@ module Remote.Hook (remote) where import qualified Data.ByteString.Lazy.Char8 as L -import Control.Exception.Extensible (IOException) import qualified Data.Map as M -import Control.Monad.State (liftIO) -import System.FilePath -import System.Posix.Process hiding (executeFile) -import System.Posix.IO -import System.IO import System.IO.Error (try) import System.Exit -import Data.Maybe -import Types +import AnnexCommon import Types.Remote import qualified Git -import qualified Annex import UUID -import Locations import Config import Content -import Utility -import Utility.SafeCommand import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto -import Messages remote :: RemoteType Annex remote = RemoteType { @@ -86,7 +74,7 @@ hookEnv k f = Just $ fileenv f ++ keyenv lookupHook :: String -> String -> Annex (Maybe String) lookupHook hooktype hook =do - g <- Annex.gitRepo + g <- gitRepo command <- getConfig g hookname "" if null command then do @@ -111,12 +99,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h store :: String -> Key -> Annex Bool store h k = do - g <- Annex.gitRepo + g <- gitRepo runHook h "store" k (Just $ gitAnnexLocation g k) $ return True storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do - g <- Annex.gitRepo + g <- gitRepo let f = gitAnnexLocation g k liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s runHook h "store" enck (Just tmp) $ return True diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 9d2d7ddcf..6a1c297c5 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -8,32 +8,18 @@ module Remote.Rsync (remote) where import qualified Data.ByteString.Lazy.Char8 as L -import Control.Exception.Extensible (IOException) import qualified Data.Map as M -import Control.Monad.State (liftIO) -import System.FilePath -import System.Directory -import System.Posix.Files -import System.Posix.Process -import Data.Maybe - -import Types + +import AnnexCommon import Types.Remote import qualified Git -import qualified Annex import UUID -import Locations import Config import Content -import Utility -import Utility.Conditional import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto -import Messages import Utility.RsyncFile -import Utility.SafeCommand -import Utility.Path type RsyncUrl = String @@ -106,12 +92,12 @@ rsyncKeyDir o k = rsyncUrl o hashDirMixed k shellEscape (keyFile k) store :: RsyncOpts -> Key -> Annex Bool store o k = do - g <- Annex.gitRepo + g <- gitRepo rsyncSend o k (gitAnnexLocation g k) storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do - g <- Annex.gitRepo + g <- gitRepo let f = gitAnnexLocation g k liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s rsyncSend o enck tmp @@ -166,7 +152,7 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial" - up trees for rsync. -} withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool withRsyncScratchDir a = do - g <- Annex.gitRepo + g <- gitRepo pid <- liftIO getProcessID let tmp = gitAnnexTmpDir g "rsynctmp" show pid nuke tmp diff --git a/Remote/S3real.hs b/Remote/S3real.hs index cafa4f15a..b2ea4b0c8 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -7,31 +7,21 @@ module Remote.S3 (remote) where -import Control.Exception.Extensible (IOException) import Network.AWS.AWSConnection import Network.AWS.S3Object import Network.AWS.S3Bucket hiding (size) import Network.AWS.AWSResult import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M -import Data.Maybe -import Data.List import Data.Char -import Data.String.Utils -import Control.Monad (when) -import Control.Monad.State (liftIO) import System.Environment -import System.Posix.Files import System.Posix.Env (setEnv) -import Types +import AnnexCommon import Types.Remote import Types.Key import qualified Git -import qualified Annex import UUID -import Messages -import Locations import Config import Remote.Helper.Special import Remote.Helper.Encryptable @@ -123,7 +113,7 @@ s3Setup u c = handlehost $ M.lookup "host" c store :: Remote Annex -> Key -> Annex Bool store r k = s3Action r False $ \(conn, bucket) -> do - g <- Annex.gitRepo + g <- gitRepo res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k s3Bool res @@ -132,7 +122,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> do - g <- Annex.gitRepo + g <- gitRepo let f = gitAnnexLocation g k liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s res <- liftIO $ storeHelper (conn, bucket) r enck tmp diff --git a/Remote/Web.hs b/Remote/Web.hs index 8fb29ec40..732f4d46c 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -10,21 +10,13 @@ module Remote.Web ( setUrl ) where -import Control.Monad.State (liftIO) -import Control.Exception -import System.FilePath - -import Types +import AnnexCommon import Types.Remote import qualified Git -import qualified Annex -import Messages import UUID import Config import PresenceLog import LocationLog -import Locations -import Utility import qualified Utility.Url as Url type URLString = String @@ -80,7 +72,7 @@ getUrls key = do {- Records a change in an url for a key. -} setUrl :: Key -> URLString -> LogStatus -> Annex () setUrl key url status = do - g <- Annex.gitRepo + g <- gitRepo addLog (urlLog key) =<< logNow status url -- update location log to indicate that the web has the key, or not diff --git a/RemoteLog.hs b/RemoteLog.hs index f9c7997e4..2e43265f5 100644 --- a/RemoteLog.hs +++ b/RemoteLog.hs @@ -15,14 +15,11 @@ module RemoteLog ( prop_idempotent_configEscape ) where -import Data.List import qualified Data.Map as M -import Data.Maybe import Data.Char -import Control.Applicative +import AnnexCommon import qualified Branch -import Types import Types.Remote import UUID diff --git a/Trust.hs b/Trust.hs index 0c8836c85..13f0354bd 100644 --- a/Trust.hs +++ b/Trust.hs @@ -13,13 +13,11 @@ module Trust ( trustPartition ) where -import Control.Monad.State import qualified Data.Map as M -import Data.List +import AnnexCommon import Types.TrustLevel import qualified Branch -import Types import UUID import qualified Annex diff --git a/Types/Key.hs b/Types/Key.hs index b26bb8989..165f814d4 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -15,9 +15,10 @@ module Types.Key ( prop_idempotent_key_read_show ) where -import Utility import System.Posix.Types +import Common + {- A Key has a unique name, is associated with a key/value backend, - and may contain other optional metadata. -} data Key = Key { diff --git a/UUID.hs b/UUID.hs index eab6bd4df..633938be4 100644 --- a/UUID.hs +++ b/UUID.hs @@ -22,18 +22,12 @@ module UUID ( uuidLog ) where -import Control.Monad.State -import Control.Applicative -import System.Cmd.Utils -import System.IO import qualified Data.Map as M -import Data.Maybe +import AnnexCommon import qualified Git import qualified Branch -import Types import Types.UUID -import qualified Annex import qualified Build.SysConfig as SysConfig import Config @@ -60,7 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h -} getUUID :: Git.Repo -> Annex UUID getUUID r = do - g <- Annex.gitRepo + g <- gitRepo let c = cached g let u = getUncachedUUID r @@ -81,7 +75,7 @@ getUncachedUUID r = Git.configGet r configkey "" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () prepUUID = do - u <- getUUID =<< Annex.gitRepo + u <- getUUID =<< gitRepo when ("" == u) $ do uuid <- liftIO genUUID setConfig configkey uuid diff --git a/Upgrade.hs b/Upgrade.hs index a724ecce3..666f8d08a 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -7,7 +7,7 @@ module Upgrade where -import Types +import AnnexCommon import Version import qualified Upgrade.V0 import qualified Upgrade.V1 diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs index 3aabe0770..f8e6cda56 100644 --- a/Upgrade/V0.hs +++ b/Upgrade/V0.hs @@ -8,23 +8,15 @@ module Upgrade.V0 where import System.IO.Error (try) -import System.Directory -import Control.Monad.State (liftIO) -import Control.Monad (filterM, forM_) -import System.Posix.Files -import System.FilePath +import AnnexCommon import Content -import Types -import Locations -import qualified Annex -import Messages import qualified Upgrade.V1 upgrade :: Annex Bool upgrade = do showAction "v0 to v1" - g <- Annex.gitRepo + g <- gitRepo -- do the reorganisation of the key files let olddir = gitAnnexDir g diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 329f90ed6..bc50b857c 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -8,33 +8,19 @@ module Upgrade.V1 where import System.IO.Error (try) -import System.Directory -import Control.Monad.State (liftIO) -import Control.Monad (filterM, forM_, unless) -import Control.Applicative -import System.Posix.Files -import System.FilePath -import Data.String.Utils import System.Posix.Types -import Data.Maybe import Data.Char +import AnnexCommon import Types.Key import Content -import Types -import Locations import PresenceLog -import qualified Annex import qualified AnnexQueue import qualified Git import qualified Git.LsFiles as LsFiles import Backend -import Messages import Version -import Utility import Utility.FileMode -import Utility.SafeCommand -import Utility.Path import qualified Upgrade.V2 -- v2 adds hashing of filenames of content and location log files. @@ -64,7 +50,7 @@ upgrade :: Annex Bool upgrade = do showAction "v1 to v2" - g <- Annex.gitRepo + g <- gitRepo if Git.repoIsLocalBare g then do moveContent @@ -96,7 +82,7 @@ moveContent = do updateSymlinks :: Annex () updateSymlinks = do showAction "updating symlinks" - g <- Annex.gitRepo + g <- gitRepo files <- liftIO $ LsFiles.inRepo g [Git.workTree g] forM_ files fixlink where @@ -117,7 +103,7 @@ moveLocationLogs = do forM_ logkeys move where oldlocationlogs = do - g <- Annex.gitRepo + g <- gitRepo let dir = Upgrade.V2.gitStateDir g exists <- liftIO $ doesDirectoryExist dir if exists @@ -126,7 +112,7 @@ moveLocationLogs = do return $ mapMaybe oldlog2key contents else return [] move (l, k) = do - g <- Annex.gitRepo + g <- gitRepo let dest = logFile2 g k let dir = Upgrade.V2.gitStateDir g let f = dir l @@ -220,7 +206,7 @@ lookupFile1 file = do getKeyFilesPresent1 :: Annex [FilePath] getKeyFilesPresent1 = do - g <- Annex.gitRepo + g <- gitRepo getKeyFilesPresent1' $ gitAnnexObjectDir g getKeyFilesPresent1' :: FilePath -> Annex [FilePath] getKeyFilesPresent1' dir = do diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 4e686288f..922dfff28 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -7,21 +7,9 @@ module Upgrade.V2 where -import System.Directory -import System.FilePath -import Control.Monad.State (unless, when, liftIO) -import Data.List -import Data.Maybe - -import Types.Key -import Types -import qualified Annex +import AnnexCommon import qualified Git import qualified Branch -import Messages -import Utility -import Utility.Conditional -import Utility.SafeCommand import LocationLog import Content @@ -48,7 +36,7 @@ olddir g upgrade :: Annex Bool upgrade = do showAction "v2 to v3" - g <- Annex.gitRepo + g <- gitRepo let bare = Git.repoIsLocalBare g Branch.create @@ -85,7 +73,7 @@ locationLogs repo = liftIO $ do inject :: FilePath -> FilePath -> Annex () inject source dest = do - g <- Annex.gitRepo + g <- gitRepo new <- liftIO (readFile $ olddir g source) Branch.change dest $ \prev -> unlines $ nub $ lines prev ++ lines new @@ -114,7 +102,7 @@ push = do Branch.update -- just in case showAction "pushing new git-annex branch to origin" showOutput - g <- Annex.gitRepo + g <- gitRepo liftIO $ Git.run g "push" [Param "origin", Param Branch.name] _ -> do -- no origin exists, so just let the user diff --git a/Utility.hs b/Utility.hs index a3d461d28..4e82e63c9 100644 --- a/Utility.hs +++ b/Utility.hs @@ -11,7 +11,6 @@ module Utility ( readMaybe, viaTmp, withTempFile, - dirContains, dirContents, myHomeDir, catchBool, diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index 901935719..5d6855bf0 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Utility.CopyFile (copyFile) where +module Utility.CopyFile (copyFileExternal) where import System.Directory (doesFileExist, removeFile) @@ -15,8 +15,8 @@ import qualified Build.SysConfig as SysConfig {- The cp command is used, because I hate reinventing the wheel, - and because this allows easy access to features like cp --reflink. -} -copyFile :: FilePath -> FilePath -> IO Bool -copyFile src dest = do +copyFileExternal :: FilePath -> FilePath -> IO Bool +copyFileExternal src dest = do whenM (doesFileExist dest) $ removeFile dest boolSystem "cp" [params, File src, File dest] diff --git a/Version.hs b/Version.hs index fcf6bc4d1..304e9f0e1 100644 --- a/Version.hs +++ b/Version.hs @@ -7,8 +7,7 @@ module Version where -import Types -import qualified Annex +import AnnexCommon import qualified Git import Config @@ -28,7 +27,7 @@ versionField = "annex.version" getVersion :: Annex (Maybe Version) getVersion = do - g <- Annex.gitRepo + g <- gitRepo let v = Git.configGet g versionField "" if not $ null v then return $ Just v diff --git a/git-annex-shell.hs b/git-annex-shell.hs index 1fb928f9d..6147545ab 100644 --- a/git-annex-shell.hs +++ b/git-annex-shell.hs @@ -6,13 +6,11 @@ -} import System.Environment -import Data.List +import AnnexCommon import qualified Git import CmdLine import Command -import Utility.Conditional -import Utility.SafeCommand import Options import qualified Command.ConfigList diff --git a/git-annex.cabal b/git-annex.cabal index 3f31ee4dc..5645eb043 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 3.20110928 +Version: 3.20110929 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess diff --git a/git-union-merge.hs b/git-union-merge.hs index 8b70e678c..34f22d06f 100644 --- a/git-union-merge.hs +++ b/git-union-merge.hs @@ -6,10 +6,8 @@ -} import System.Environment -import System.FilePath -import System.Directory -import Control.Monad (when) +import Common import qualified Git.UnionMerge import qualified Git diff --git a/test.hs b/test.hs index f8701db66..654af5713 100644 --- a/test.hs +++ b/test.hs @@ -9,23 +9,19 @@ import Test.HUnit import Test.HUnit.Tools import Test.QuickCheck -import System.Directory import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Files import IO (bracket_, bracket) -import Control.Monad (unless, when, filterM) -import Data.List import System.IO.Error import System.Posix.Env import qualified Control.Exception.Extensible as E import Control.Exception (throw) -import Data.Maybe import qualified Data.Map as M -import System.Path (recurseDir) import System.IO.HVFS (SystemFS(..)) -import Utility.SafeCommand +import Common +import qualified Utility.SafeCommand import qualified Annex import qualified Backend import qualified Git -- cgit v1.2.3