factor out common imports

no code changes
This commit is contained in:
Joey Hess 2011-10-03 22:24:57 -04:00
parent 003a604a6e
commit 8ef2095fa0
83 changed files with 264 additions and 619 deletions

View file

@ -19,10 +19,10 @@ module Annex (
gitRepo gitRepo
) where ) where
import Control.Monad.State
import Control.Monad.IO.Control import Control.Monad.IO.Control
import Control.Applicative hiding (empty) import Control.Monad.State
import Common
import qualified Git import qualified Git
import Git.CatFile import Git.CatFile
import Git.Queue import Git.Queue
@ -75,7 +75,7 @@ newState gitrepo = AnnexState
{ repo = gitrepo { repo = gitrepo
, backends = [] , backends = []
, remotes = [] , remotes = []
, repoqueue = empty , repoqueue = Git.Queue.empty
, output = NormalOutput , output = NormalOutput
, force = False , force = False
, fast = False , fast = False

13
AnnexCommon.hs Normal file
View file

@ -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

View file

@ -11,13 +11,9 @@ module AnnexQueue (
flushWhenFull flushWhenFull
) where ) where
import Control.Monad.State (liftIO) import AnnexCommon
import Control.Monad (when, unless)
import Annex import Annex
import Messages
import qualified Git.Queue import qualified Git.Queue
import Utility.SafeCommand
{- Adds a git command to the queue. -} {- Adds a git command to the queue. -}
add :: String -> [CommandParam] -> [FilePath] -> Annex () add :: String -> [CommandParam] -> [FilePath] -> Annex ()

View file

@ -16,20 +16,14 @@ module Backend (
maybeLookupBackendName maybeLookupBackendName
) where ) where
import Control.Monad.State (liftIO, when)
import Control.Applicative
import System.IO.Error (try) import System.IO.Error (try)
import System.FilePath
import System.Posix.Files import System.Posix.Files
import Data.Maybe
import Locations import AnnexCommon
import qualified Git import qualified Git
import qualified Annex import qualified Annex
import Types
import Types.Key import Types.Key
import qualified Types.Backend as B import qualified Types.Backend as B
import Messages
-- When adding a new backend, import it here and add it to the list. -- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM import qualified Backend.WORM
@ -59,7 +53,7 @@ orderedList = do
Annex.changeState $ \state -> state { Annex.backends = l' } Annex.changeState $ \state -> state { Annex.backends = l' }
return l' return l'
getstandard = do getstandard = do
g <- Annex.gitRepo g <- gitRepo
return $ parseBackendList $ return $ parseBackendList $
Git.configGet g "annex.backends" "" Git.configGet g "annex.backends" ""
@ -108,7 +102,7 @@ type BackendFile = (Maybe (Backend Annex), FilePath)
-} -}
chooseBackends :: [FilePath] -> Annex [BackendFile] chooseBackends :: [FilePath] -> Annex [BackendFile]
chooseBackends fs = do chooseBackends fs = do
g <- Annex.gitRepo g <- gitRepo
forced <- Annex.getState Annex.forcebackend forced <- Annex.getState Annex.forcebackend
if isJust forced if isJust forced
then do then do

View file

@ -7,23 +7,11 @@
module Backend.SHA (backends) where module Backend.SHA (backends) where
import Control.Monad.State import AnnexCommon
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 qualified Annex import qualified Annex
import Locations
import Content import Content
import Types
import Types.Backend import Types.Backend
import Types.Key import Types.Key
import Utility.SafeCommand
import qualified Build.SysConfig as SysConfig import qualified Build.SysConfig as SysConfig
type SHASize = Int 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. -} {- A key's checksum is checked during fsck. -}
checkKeyChecksum :: SHASize -> Key -> Annex Bool checkKeyChecksum :: SHASize -> Key -> Annex Bool
checkKeyChecksum size key = do checkKeyChecksum size key = do
g <- Annex.gitRepo g <- gitRepo
fast <- Annex.getState Annex.fast fast <- Annex.getState Annex.fast
let file = gitAnnexLocation g key let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file present <- liftIO $ doesFileExist file

View file

@ -10,9 +10,9 @@ module Backend.URL (
fromUrl fromUrl
) where ) where
import AnnexCommon
import Types.Backend import Types.Backend
import Types.Key import Types.Key
import Types
backends :: [Backend Annex] backends :: [Backend Annex]
backends = [backend] backends = [backend]

View file

@ -7,12 +7,8 @@
module Backend.WORM (backends) where module Backend.WORM (backends) where
import Control.Monad.State import AnnexCommon
import System.FilePath
import System.Posix.Files
import Types.Backend import Types.Backend
import Types
import Types.Key import Types.Key
backends :: [Backend Annex] backends :: [Backend Annex]

View file

@ -18,33 +18,17 @@ module Branch (
name name
) where ) 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.IO.Binary
import System.Posix.Process
import System.Posix.IO
import System.Posix.Files
import System.Exit import System.Exit
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad.IO.Control (liftIOOp) import Control.Monad.IO.Control (liftIOOp)
import qualified Control.Exception.Base import qualified Control.Exception
import AnnexCommon
import Types.BranchState import Types.BranchState
import qualified Git import qualified Git
import qualified Git.UnionMerge import qualified Git.UnionMerge
import qualified Annex import qualified Annex
import Utility
import Utility.Conditional
import Utility.SafeCommand
import Types
import Messages
import Locations
import CatFile import CatFile
type GitRef = String type GitRef = String
@ -79,7 +63,7 @@ withIndex :: Annex a -> Annex a
withIndex = withIndex' False withIndex = withIndex' False
withIndex' :: Bool -> Annex a -> Annex a withIndex' :: Bool -> Annex a -> Annex a
withIndex' bootstrapping a = do withIndex' bootstrapping a = do
g <- Annex.gitRepo g <- gitRepo
let f = index g let f = index g
reset <- liftIO $ Git.useIndex f reset <- liftIO $ Git.useIndex f
@ -123,7 +107,7 @@ getCache file = getState >>= handle
{- Creates the branch, if it does not already exist. -} {- Creates the branch, if it does not already exist. -}
create :: Annex () create :: Annex ()
create = unlessM hasBranch $ do create = unlessM hasBranch $ do
g <- Annex.gitRepo g <- gitRepo
e <- hasOrigin e <- hasOrigin
if e if e
then liftIO $ Git.run g "branch" [Param name, Param originname] then liftIO $ Git.run g "branch" [Param name, Param originname]
@ -136,7 +120,7 @@ commit message = do
fs <- getJournalFiles fs <- getJournalFiles
when (not $ null fs) $ lockJournal $ do when (not $ null fs) $ lockJournal $ do
stageJournalFiles fs stageJournalFiles fs
g <- Annex.gitRepo g <- gitRepo
withIndex $ liftIO $ Git.commit g message fullname [fullname] withIndex $ liftIO $ Git.commit g message fullname [fullname]
{- Ensures that the branch is up-to-date; should be called before {- Ensures that the branch is up-to-date; should be called before
@ -161,13 +145,13 @@ update = do
-} -}
unless (null fs) $ stageJournalFiles fs unless (null fs) $ stageJournalFiles fs
mapM_ mergeref refs mapM_ mergeref refs
g <- Annex.gitRepo g <- gitRepo
liftIO $ Git.commit g "update" fullname (fullname:refs) liftIO $ Git.commit g "update" fullname (fullname:refs)
Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } } Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
invalidateCache invalidateCache
where where
checkref ref = do checkref ref = do
g <- Annex.gitRepo g <- gitRepo
-- checking with log to see if there have been changes -- checking with log to see if there have been changes
-- is less expensive than always merging -- is less expensive than always merging
diffs <- liftIO $ Git.pipeRead g [ diffs <- liftIO $ Git.pipeRead g [
@ -189,14 +173,14 @@ update = do
- advises users not to directly modify the - advises users not to directly modify the
- branch. - branch.
-} -}
g <- Annex.gitRepo g <- gitRepo
liftIO $ Git.UnionMerge.merge g [ref] liftIO $ Git.UnionMerge.merge g [ref]
return $ Just ref return $ Just ref
{- Checks if a git ref exists. -} {- Checks if a git ref exists. -}
refExists :: GitRef -> Annex Bool refExists :: GitRef -> Annex Bool
refExists ref = do refExists ref = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ Git.runBool g "show-ref" liftIO $ Git.runBool g "show-ref"
[Param "--verify", Param "-q", Param ref] [Param "--verify", Param "-q", Param ref]
@ -216,7 +200,7 @@ hasSomeBranch = not . null <$> siblingBranches
- from remotes. -} - from remotes. -}
siblingBranches :: Annex [String] siblingBranches :: Annex [String]
siblingBranches = do siblingBranches = do
g <- Annex.gitRepo g <- gitRepo
r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name] r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]
return $ map (last . words . L.unpack) (L.lines r) 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. -} {- Lists all files on the branch. There may be duplicates in the list. -}
files :: Annex [FilePath] files :: Annex [FilePath]
files = withIndexUpdate $ do files = withIndexUpdate $ do
g <- Annex.gitRepo g <- gitRepo
bfiles <- liftIO $ Git.pipeNullSplit g bfiles <- liftIO $ Git.pipeNullSplit g
[Params "ls-tree --name-only -r -z", Param fullname] [Params "ls-tree --name-only -r -z", Param fullname]
jfiles <- getJournalledFiles jfiles <- getJournalledFiles
@ -265,7 +249,7 @@ files = withIndexUpdate $ do
- avoids git needing to rewrite the index after every change. -} - avoids git needing to rewrite the index after every change. -}
setJournalFile :: FilePath -> String -> Annex () setJournalFile :: FilePath -> String -> Annex ()
setJournalFile file content = do setJournalFile file content = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ catch (write g) $ const $ do liftIO $ catch (write g) $ const $ do
createDirectoryIfMissing True $ gitAnnexJournalDir g createDirectoryIfMissing True $ gitAnnexJournalDir g
createDirectoryIfMissing True $ gitAnnexTmpDir g createDirectoryIfMissing True $ gitAnnexTmpDir g
@ -281,7 +265,7 @@ setJournalFile file content = do
{- Gets any journalled content for a file in the branch. -} {- Gets any journalled content for a file in the branch. -}
getJournalFile :: FilePath -> Annex (Maybe String) getJournalFile :: FilePath -> Annex (Maybe String)
getJournalFile file = do getJournalFile file = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ catch (liftM Just . readFileStrict $ journalFile g file) liftIO $ catch (liftM Just . readFileStrict $ journalFile g file)
(const $ return Nothing) (const $ return Nothing)
@ -292,7 +276,7 @@ getJournalledFiles = map fileJournal <$> getJournalFiles
{- List of existing journal files. -} {- List of existing journal files. -}
getJournalFiles :: Annex [FilePath] getJournalFiles :: Annex [FilePath]
getJournalFiles = do getJournalFiles = do
g <- Annex.gitRepo g <- gitRepo
fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g) fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g)
(const $ return []) (const $ return [])
return $ filter (`notElem` [".", ".."]) fs return $ filter (`notElem` [".", ".."]) fs
@ -300,7 +284,7 @@ getJournalFiles = do
{- Stages the specified journalfiles. -} {- Stages the specified journalfiles. -}
stageJournalFiles :: [FilePath] -> Annex () stageJournalFiles :: [FilePath] -> Annex ()
stageJournalFiles fs = do stageJournalFiles fs = do
g <- Annex.gitRepo g <- gitRepo
withIndex $ liftIO $ do withIndex $ liftIO $ do
let dir = gitAnnexJournalDir g let dir = gitAnnexJournalDir g
let paths = map (dir </>) fs let paths = map (dir </>) fs
@ -346,9 +330,9 @@ fileJournal = replace "//" "_" . replace "_" "/"
- contention with other git-annex processes. -} - contention with other git-annex processes. -}
lockJournal :: Annex a -> Annex a lockJournal :: Annex a -> Annex a
lockJournal a = do lockJournal a = do
g <- Annex.gitRepo g <- gitRepo
let file = gitAnnexJournalLock g let file = gitAnnexJournalLock g
liftIOOp (Control.Exception.Base.bracket (lock file) unlock) run liftIOOp (Control.Exception.bracket (lock file) unlock) run
where where
lock file = do lock file = do
l <- createFile file stdFileMode l <- createFile file stdFileMode

View file

@ -9,17 +9,15 @@ module CatFile (
catFile catFile
) where ) where
import Control.Monad.State import AnnexCommon
import qualified Git.CatFile import qualified Git.CatFile
import Types
import qualified Annex import qualified Annex
catFile :: String -> FilePath -> Annex String catFile :: String -> FilePath -> Annex String
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
where where
startup = do startup = do
g <- Annex.gitRepo g <- gitRepo
h <- liftIO $ Git.CatFile.catFileStart g h <- liftIO $ Git.CatFile.catFileStart g
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h } Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
go h go h

View file

@ -13,17 +13,14 @@ module CmdLine (
import System.IO.Error (try) import System.IO.Error (try)
import System.Console.GetOpt import System.Console.GetOpt
import Control.Monad.State (liftIO)
import Control.Monad (when)
import AnnexCommon
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import qualified Git import qualified Git
import Content import Content
import Types
import Command import Command
import Options import Options
import Messages
import Init import Init
{- Runs the passed command line. -} {- Runs the passed command line. -}

View file

@ -7,22 +7,11 @@
module Command where module Command where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Directory
import System.Posix.Files
import Control.Monad (filterM, liftM)
import Control.Applicative
import Data.Maybe
import Types
import qualified Backend import qualified Backend
import Messages
import qualified Annex import qualified Annex
import qualified Git import qualified Git
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import Utility
import Utility.Conditional
import Utility.Path
import Types.Key import Types.Key
import Trust import Trust
import LocationLog import LocationLog
@ -98,7 +87,7 @@ isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
notBareRepo :: Annex a -> Annex a notBareRepo :: Annex a -> Annex a
notBareRepo a = do notBareRepo a = do
whenM (Git.repoIsLocalBare <$> Annex.gitRepo) $ whenM (Git.repoIsLocalBare <$> gitRepo) $
error "You cannot run this subcommand in a bare repository." error "You cannot run this subcommand in a bare repository."
a a
@ -106,11 +95,11 @@ notBareRepo a = do
user's parameters, and prepare actions operating on them. -} user's parameters, and prepare actions operating on them. -}
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGit a params = do withFilesInGit a params = do
repo <- Annex.gitRepo repo <- gitRepo
runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
withAttrFilesInGit attr a params = do withAttrFilesInGit attr a params = do
repo <- Annex.gitRepo repo <- gitRepo
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek 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) go (file, v) = a file (readMaybe v)
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
withBackendFilesInGit a params = do withBackendFilesInGit a params = do
repo <- Annex.gitRepo repo <- gitRepo
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
backendPairs a files backendPairs a files
withFilesMissing :: (String -> CommandStart) -> CommandSeek withFilesMissing :: (String -> CommandStart) -> CommandSeek
@ -128,7 +117,7 @@ withFilesMissing a params = runFiltered a $ liftIO $ filterM missing params
missing = liftM not . doesFileExist missing = liftM not . doesFileExist
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
withFilesNotInGit a params = do withFilesNotInGit a params = do
repo <- Annex.gitRepo repo <- gitRepo
force <- Annex.getState Annex.force force <- Annex.getState Annex.force
newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
backendPairs a newfiles backendPairs a newfiles
@ -138,7 +127,7 @@ withStrings :: (String -> CommandStart) -> CommandSeek
withStrings a params = return $ map a params withStrings a params = return $ map a params
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
withFilesToBeCommitted a params = do withFilesToBeCommitted a params = do
repo <- Annex.gitRepo repo <- gitRepo
runFiltered a $ runFiltered a $
liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
@ -148,7 +137,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
withFilesUnlocked' typechanged a params = do withFilesUnlocked' typechanged a params = do
-- unlocked files have changed type from a symlink to a regular file -- unlocked files have changed type from a symlink to a regular file
repo <- Annex.gitRepo repo <- gitRepo
typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
unlockedfiles <- liftIO $ filterM notSymlink $ unlockedfiles <- liftIO $ filterM notSymlink $
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles

View file

@ -7,26 +7,17 @@
module Command.Add where 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.Control (handle)
import Control.Exception.Base (throwIO) import Control.Exception.Base (throwIO)
import Control.Exception.Extensible (IOException)
import AnnexCommon
import Command import Command
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Types
import Content import Content
import Messages
import Utility.Conditional
import Utility.Touch import Utility.Touch
import Utility.SafeCommand
import Locations
import Backend import Backend
command :: [Command] command :: [Command]
@ -72,7 +63,7 @@ undo file key e = do
-- fromAnnex could fail if the file ownership is weird -- fromAnnex could fail if the file ownership is weird
tryharder :: IOException -> Annex () tryharder :: IOException -> Annex ()
tryharder _ = do tryharder _ = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ renameFile (gitAnnexLocation g key) file liftIO $ renameFile (gitAnnexLocation g key) file
cleanup :: FilePath -> Key -> Bool -> CommandCleanup cleanup :: FilePath -> Key -> Bool -> CommandCleanup

View file

@ -7,12 +7,9 @@
module Command.AddUrl where module Command.AddUrl where
import Control.Monad.State
import Network.URI import Network.URI
import Data.String.Utils
import Data.Maybe
import System.Directory
import AnnexCommon
import Command import Command
import qualified Backend import qualified Backend
import qualified Utility.Url as Url import qualified Utility.Url as Url
@ -20,12 +17,8 @@ import qualified Remote.Web
import qualified Command.Add import qualified Command.Add
import qualified Annex import qualified Annex
import qualified Backend.URL import qualified Backend.URL
import Messages
import Content import Content
import PresenceLog import PresenceLog
import Locations
import Utility.Path
import Utility.Conditional
command :: [Command] command :: [Command]
command = [repoCommand "addurl" (paramRepeating paramUrl) seek command = [repoCommand "addurl" (paramRepeating paramUrl) seek
@ -51,7 +44,7 @@ perform url file = do
download :: String -> FilePath -> CommandPerform download :: String -> FilePath -> CommandPerform
download url file = do download url file = do
g <- Annex.gitRepo g <- gitRepo
showAction $ "downloading " ++ url ++ " " showAction $ "downloading " ++ url ++ " "
let dummykey = Backend.URL.fromUrl url let dummykey = Backend.URL.fromUrl url
let tmp = gitAnnexTmpLocation g dummykey let tmp = gitAnnexTmpLocation g dummykey

View file

@ -7,9 +7,7 @@
module Command.ConfigList where module Command.ConfigList where
import Control.Monad.State (liftIO) import AnnexCommon
import Annex
import Command import Command
import UUID import UUID
@ -22,7 +20,7 @@ seek = [withNothing start]
start :: CommandStart start :: CommandStart
start = do start = do
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
liftIO $ putStrLn $ "annex.uuid=" ++ u liftIO $ putStrLn $ "annex.uuid=" ++ u
stop stop

View file

@ -7,10 +7,10 @@
module Command.Describe where module Command.Describe where
import AnnexCommon
import Command import Command
import qualified Remote import qualified Remote
import UUID import UUID
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek

View file

@ -7,14 +7,12 @@
module Command.Drop where module Command.Drop where
import AnnexCommon
import Command import Command
import qualified Remote import qualified Remote
import qualified Annex import qualified Annex
import LocationLog import LocationLog
import Types
import Content import Content
import Messages
import Utility.Conditional
import Trust import Trust
import Config import Config
@ -71,9 +69,9 @@ dropKey key numcopiesM = do
| length have >= need = return True | length have >= need = return True
| otherwise = do | otherwise = do
let u = Remote.uuid r let u = Remote.uuid r
let dup = u `elem` have let duplicate = u `elem` have
haskey <- Remote.hasKey r key haskey <- Remote.hasKey r key
case (dup, haskey) of case (duplicate, haskey) of
(False, Right True) -> findcopies need (u:have) rs bad (False, Right True) -> findcopies need (u:have) rs bad
(False, Left _) -> findcopies need have rs (r:bad) (False, Left _) -> findcopies need have rs (r:bad)
_ -> findcopies need have rs bad _ -> findcopies need have rs bad

View file

@ -7,12 +7,11 @@
module Command.DropKey where module Command.DropKey where
import AnnexCommon
import Command import Command
import qualified Annex import qualified Annex
import LocationLog import LocationLog
import Types
import Content import Content
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "dropkey" (paramRepeating paramKey) seek command = [repoCommand "dropkey" (paramRepeating paramKey) seek

View file

@ -7,22 +7,16 @@
module Command.DropUnused where module Command.DropUnused where
import Control.Monad.State (liftIO)
import qualified Data.Map as M import qualified Data.Map as M
import System.Directory
import Data.Maybe
import AnnexCommon
import Command import Command
import Types
import Messages
import Locations
import qualified Annex import qualified Annex
import qualified Command.Drop import qualified Command.Drop
import qualified Command.Move import qualified Command.Move
import qualified Remote import qualified Remote
import qualified Git import qualified Git
import Types.Key import Types.Key
import Utility.Conditional
type UnusedMap = M.Map String Key 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 :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do performOther filespec key = do
g <- Annex.gitRepo g <- gitRepo
let f = filespec g key let f = filespec g key
liftIO $ whenM (doesFileExist f) $ removeFile f liftIO $ whenM (doesFileExist f) $ removeFile f
next $ return True next $ return True
readUnusedLog :: FilePath -> Annex UnusedMap readUnusedLog :: FilePath -> Annex UnusedMap
readUnusedLog prefix = do readUnusedLog prefix = do
g <- Annex.gitRepo g <- gitRepo
let f = gitAnnexUnusedLog prefix g let f = gitAnnexUnusedLog prefix g
e <- liftIO $ doesFileExist f e <- liftIO $ doesFileExist f
if e if e

View file

@ -7,11 +7,9 @@
module Command.Find where module Command.Find where
import Control.Monad.State import AnnexCommon
import Command import Command
import Content import Content
import Utility.Conditional
import Limit import Limit
command :: [Command] command :: [Command]

View file

@ -7,16 +7,10 @@
module Command.Fix where module Command.Fix where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Posix.Files
import System.Directory
import Command import Command
import qualified AnnexQueue import qualified AnnexQueue
import Utility.Path
import Utility.SafeCommand
import Content import Content
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "fix" paramPaths seek command = [repoCommand "fix" paramPaths seek

View file

@ -7,18 +7,11 @@
module Command.FromKey where module Command.FromKey where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Posix.Files
import System.Directory
import Control.Monad (unless)
import Command import Command
import qualified AnnexQueue import qualified AnnexQueue
import Utility.SafeCommand
import Content import Content
import Messages
import Types.Key import Types.Key
import Utility.Path
command :: [Command] command :: [Command]
command = [repoCommand "fromkey" paramPath seek command = [repoCommand "fromkey" paramPath seek

View file

@ -7,25 +7,16 @@
module Command.Fsck where module Command.Fsck where
import Control.Monad (when) import AnnexCommon
import Control.Monad.State (liftIO)
import System.Directory
import System.Posix.Files
import Command import Command
import qualified Annex
import qualified Remote import qualified Remote
import qualified Types.Backend import qualified Types.Backend
import qualified Types.Key import qualified Types.Key
import UUID import UUID
import Types
import Messages
import Content import Content
import LocationLog import LocationLog
import Locations
import Trust import Trust
import Utility.DataUnits import Utility.DataUnits
import Utility.Path
import Utility.FileMode import Utility.FileMode
import Config import Config
@ -54,7 +45,7 @@ perform key file backend numcopies = do
in this repository only. -} in this repository only. -}
verifyLocationLog :: Key -> FilePath -> Annex Bool verifyLocationLog :: Key -> FilePath -> Annex Bool
verifyLocationLog key file = do verifyLocationLog key file = do
g <- Annex.gitRepo g <- gitRepo
present <- inAnnex key present <- inAnnex key
-- Since we're checking that a key's file is present, throw -- 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. -} - the key's metadata, if available. -}
checkKeySize :: Key -> Annex Bool checkKeySize :: Key -> Annex Bool
checkKeySize key = do checkKeySize key = do
g <- Annex.gitRepo g <- gitRepo
let file = gitAnnexLocation g key let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file present <- liftIO $ doesFileExist file
case (present, Types.Key.keySize key) of case (present, Types.Key.keySize key) of

View file

@ -7,12 +7,11 @@
module Command.Get where module Command.Get where
import AnnexCommon
import Command import Command
import qualified Annex import qualified Annex
import qualified Remote import qualified Remote
import Types
import Content import Content
import Messages
import qualified Command.Move import qualified Command.Move
command :: [Command] command :: [Command]

View file

@ -7,12 +7,9 @@
module Command.InAnnex where module Command.InAnnex where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Exit
import Command import Command
import Content import Content
import Types
command :: [Command] command :: [Command]
command = [repoCommand "inannex" (paramRepeating paramKey) seek command = [repoCommand "inannex" (paramRepeating paramKey) seek

View file

@ -7,10 +7,9 @@
module Command.Init where module Command.Init where
import AnnexCommon
import Command import Command
import qualified Annex
import UUID import UUID
import Messages
import Init import Init
command :: [Command] command :: [Command]
@ -30,7 +29,7 @@ start ws = do
perform :: String -> CommandPerform perform :: String -> CommandPerform
perform description = do perform description = do
initialize initialize
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
describeUUID u description describeUUID u description
next $ return True next $ return True

View file

@ -8,18 +8,13 @@
module Command.InitRemote where module Command.InitRemote where
import qualified Data.Map as M 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 Command
import qualified Remote import qualified Remote
import qualified RemoteLog import qualified RemoteLog
import qualified Types.Remote as R import qualified Types.Remote as R
import Types
import UUID import UUID
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "initremote" command = [repoCommand "initremote"

View file

@ -7,13 +7,9 @@
module Command.Lock where module Command.Lock where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Directory
import Command import Command
import Messages
import qualified AnnexQueue import qualified AnnexQueue
import Utility.SafeCommand
import Backend import Backend
command :: [Command] command :: [Command]

View file

@ -7,19 +7,12 @@
module Command.Map where module Command.Map where
import Control.Monad.State (liftIO)
import Control.Exception.Extensible import Control.Exception.Extensible
import System.Cmd.Utils
import qualified Data.Map as M import qualified Data.Map as M
import Data.List.Utils
import Data.Maybe
import AnnexCommon
import Command import Command
import qualified Annex
import qualified Git import qualified Git
import Messages
import Types
import Utility.SafeCommand
import UUID import UUID
import Trust import Trust
import Utility.Ssh import Utility.Ssh
@ -36,7 +29,7 @@ seek = [withNothing start]
start :: CommandStart start :: CommandStart
start = do start = do
g <- Annex.gitRepo g <- gitRepo
rs <- spider g rs <- spider g
umap <- uuidMap umap <- uuidMap

View file

@ -7,9 +7,9 @@
module Command.Merge where module Command.Merge where
import AnnexCommon
import Command import Command
import qualified Branch import qualified Branch
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "merge" paramNothing seek command = [repoCommand "merge" paramNothing seek

View file

@ -7,22 +7,11 @@
module Command.Migrate where module Command.Migrate where
import Control.Monad.State (liftIO) import AnnexCommon
import Control.Applicative
import System.Posix.Files
import System.Directory
import System.FilePath
import Data.Maybe
import Command import Command
import qualified Annex
import qualified Backend import qualified Backend
import qualified Types.Key import qualified Types.Key
import Locations
import Types
import Content import Content
import Messages
import Utility.Conditional
import qualified Command.Add import qualified Command.Add
import Backend import Backend
@ -53,7 +42,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key
perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do perform file oldkey newbackend = do
g <- Annex.gitRepo g <- gitRepo
-- Store the old backend's cached key in the new backend -- 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). -- (the file can't be stored as usual, because it's already a symlink).

View file

@ -7,18 +7,14 @@
module Command.Move where module Command.Move where
import Control.Monad (when) import AnnexCommon
import Command import Command
import qualified Command.Drop import qualified Command.Drop
import qualified Annex import qualified Annex
import LocationLog import LocationLog
import Types
import Content import Content
import qualified Remote import qualified Remote
import UUID import UUID
import Messages
import Utility.Conditional
command :: [Command] command :: [Command]
command = [repoCommand "move" paramPaths seek command = [repoCommand "move" paramPaths seek
@ -60,7 +56,7 @@ showMoveAction False file = showStart "copy" file
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex () remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
remoteHasKey remote key present = do remoteHasKey remote key present = do
let remoteuuid = Remote.uuid remote let remoteuuid = Remote.uuid remote
g <- Annex.gitRepo g <- gitRepo
logChange g key remoteuuid status logChange g key remoteuuid status
where where
status = if present then InfoPresent else InfoMissing status = if present then InfoPresent else InfoMissing
@ -76,7 +72,7 @@ remoteHasKey remote key present = do
-} -}
toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
toStart dest move file = isAnnexed file $ \(key, _) -> do toStart dest move file = isAnnexed file $ \(key, _) -> do
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
ishere <- inAnnex key ishere <- inAnnex key
if not ishere || u == Remote.uuid dest if not ishere || u == Remote.uuid dest
@ -126,7 +122,7 @@ toCleanup dest move key = do
-} -}
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
fromStart src move file = isAnnexed file $ \(key, _) -> do fromStart src move file = isAnnexed file $ \(key, _) -> do
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
remotes <- Remote.keyPossibilities key remotes <- Remote.keyPossibilities key
if u == Remote.uuid src || not (any (== src) remotes) if u == Remote.uuid src || not (any (== src) remotes)

View file

@ -7,15 +7,11 @@
module Command.RecvKey where module Command.RecvKey where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Exit
import Command import Command
import CmdLine import CmdLine
import Content import Content
import Utility.RsyncFile import Utility.RsyncFile
import Utility.Conditional
import Types
command :: [Command] command :: [Command]
command = [repoCommand "recvkey" paramKey seek command = [repoCommand "recvkey" paramKey seek

View file

@ -7,11 +7,11 @@
module Command.Semitrust where module Command.Semitrust where
import AnnexCommon
import Command import Command
import qualified Remote import qualified Remote
import UUID import UUID
import Trust import Trust
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "semitrust" (paramRepeating paramRemote) seek command = [repoCommand "semitrust" (paramRepeating paramRemote) seek

View file

@ -7,17 +7,10 @@
module Command.SendKey where module Command.SendKey where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Exit
import Locations
import qualified Annex
import Command import Command
import Content import Content
import Utility.RsyncFile import Utility.RsyncFile
import Utility.Conditional
import Messages
import Types
command :: [Command] command :: [Command]
command = [repoCommand "sendkey" paramKey seek command = [repoCommand "sendkey" paramKey seek
@ -28,7 +21,7 @@ seek = [withKeys start]
start :: Key -> CommandStart start :: Key -> CommandStart
start key = do start key = do
g <- Annex.gitRepo g <- gitRepo
let file = gitAnnexLocation g key let file = gitAnnexLocation g key
whenM (inAnnex key) $ whenM (inAnnex key) $
liftIO $ rsyncServerSend file -- does not return liftIO $ rsyncServerSend file -- does not return

View file

@ -7,13 +7,10 @@
module Command.SetKey where module Command.SetKey where
import Control.Monad.State (liftIO) import AnnexCommon
import Command import Command
import Utility.SafeCommand
import LocationLog import LocationLog
import Content import Content
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "setkey" paramPath seek command = [repoCommand "setkey" paramPath seek

View file

@ -8,25 +8,20 @@
module Command.Status where module Command.Status where
import Control.Monad.State 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.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Set (Set) import Data.Set (Set)
import AnnexCommon
import qualified Types.Backend as B import qualified Types.Backend as B
import qualified Types.Remote as R import qualified Types.Remote as R
import qualified Remote import qualified Remote
import qualified Command.Unused import qualified Command.Unused
import qualified Git import qualified Git
import Command import Command
import Types
import Utility.DataUnits import Utility.DataUnits
import Content import Content
import Types.Key import Types.Key
import Locations
import Backend import Backend
import UUID import UUID
import Remote import Remote

View file

@ -7,11 +7,11 @@
module Command.Trust where module Command.Trust where
import AnnexCommon
import Command import Command
import qualified Remote import qualified Remote
import Trust import Trust
import UUID import UUID
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "trust" (paramRepeating paramRemote) seek command = [repoCommand "trust" (paramRepeating paramRemote) seek

View file

@ -7,25 +7,16 @@
module Command.Unannex where module Command.Unannex where
import Control.Monad.State (liftIO) import AnnexCommon
import Control.Monad (unless)
import System.Directory
import System.Posix.Files
import Command import Command
import qualified Command.Drop import qualified Command.Drop
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import Utility.SafeCommand
import Utility.Path
import Utility.FileMode import Utility.FileMode
import LocationLog import LocationLog
import Types
import Content import Content
import qualified Git import qualified Git
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import Messages
import Locations
command :: [Command] command :: [Command]
command = [repoCommand "unannex" paramPaths seek "undo accidential add command"] command = [repoCommand "unannex" paramPaths seek "undo accidential add command"]
@ -41,7 +32,7 @@ start file = isAnnexed file $ \(key, _) -> do
then do then do
force <- Annex.getState Annex.force force <- Annex.getState Annex.force
unless force $ do unless force $ do
g <- Annex.gitRepo g <- gitRepo
staged <- liftIO $ LsFiles.staged g [Git.workTree g] staged <- liftIO $ LsFiles.staged g [Git.workTree g]
unless (null staged) $ unless (null staged) $
error "This command cannot be run when there are already files staged for commit." 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 :: FilePath -> Key -> CommandCleanup
cleanup file key = do cleanup file key = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ removeFile file liftIO $ removeFile file
liftIO $ Git.run g "rm" [Params "--quiet --", File file] liftIO $ Git.run g "rm" [Params "--quiet --", File file]

View file

@ -7,19 +7,14 @@
module Command.Uninit where module Command.Uninit where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Directory
import System.Exit
import Command import Command
import Utility.SafeCommand
import qualified Git import qualified Git
import qualified Annex import qualified Annex
import qualified Command.Unannex import qualified Command.Unannex
import Init import Init
import qualified Branch import qualified Branch
import Content import Content
import Locations
command :: [Command] command :: [Command]
command = [repoCommand "uninit" paramPaths seek command = [repoCommand "uninit" paramPaths seek
@ -44,7 +39,7 @@ perform = next cleanup
cleanup :: CommandCleanup cleanup :: CommandCleanup
cleanup = do cleanup = do
g <- Annex.gitRepo g <- gitRepo
uninitialize uninitialize
mapM_ removeAnnex =<< getKeysPresent mapM_ removeAnnex =<< getKeysPresent
liftIO $ removeDirectoryRecursive (gitAnnexDir g) liftIO $ removeDirectoryRecursive (gitAnnexDir g)

View file

@ -7,18 +7,10 @@
module Command.Unlock where module Command.Unlock where
import Control.Monad.State (liftIO) import AnnexCommon
import System.Directory hiding (copyFile)
import Command import Command
import qualified Annex
import Types
import Messages
import Locations
import Content import Content
import Utility.Conditional
import Utility.CopyFile import Utility.CopyFile
import Utility.Path
import Utility.FileMode import Utility.FileMode
command :: [Command] command :: [Command]
@ -43,12 +35,12 @@ perform dest key = do
checkDiskSpace key checkDiskSpace key
g <- Annex.gitRepo g <- gitRepo
let src = gitAnnexLocation g key let src = gitAnnexLocation g key
let tmpdest = gitAnnexTmpLocation g key let tmpdest = gitAnnexTmpLocation g key
liftIO $ createDirectoryIfMissing True (parentDir tmpdest) liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
showAction "copying" showAction "copying"
ok <- liftIO $ copyFile src tmpdest ok <- liftIO $ copyFileExternal src tmpdest
if ok if ok
then do then do
liftIO $ do liftIO $ do

View file

@ -7,11 +7,11 @@
module Command.Untrust where module Command.Untrust where
import AnnexCommon
import Command import Command
import qualified Remote import qualified Remote
import UUID import UUID
import Trust import Trust
import Messages
command :: [Command] command :: [Command]
command = [repoCommand "untrust" (paramRepeating paramRemote) seek command = [repoCommand "untrust" (paramRepeating paramRemote) seek

View file

@ -9,23 +9,13 @@
module Command.Unused where module Command.Unused where
import Control.Monad (filterM, unless, forM_)
import Control.Monad.State (liftIO)
import qualified Data.Set as S 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 qualified Data.ByteString.Lazy.Char8 as L
import AnnexCommon
import Command import Command
import Types
import Content import Content
import Messages
import Locations
import Utility
import Utility.FileMode import Utility.FileMode
import Utility.SafeCommand
import LocationLog import LocationLog
import qualified Annex import qualified Annex
import qualified Git import qualified Git
@ -92,7 +82,7 @@ checkRemoteUnused' r = do
writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex () writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()
writeUnusedFile prefix l = do writeUnusedFile prefix l = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $ liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $
unlines $ map (\(n, k) -> show n ++ " " ++ show k) l unlines $ map (\(n, k) -> show n ++ " " ++ show k) l
@ -164,7 +154,7 @@ unusedKeys = do
excludeReferenced :: [Key] -> Annex [Key] excludeReferenced :: [Key] -> Annex [Key]
excludeReferenced [] = return [] -- optimisation excludeReferenced [] = return [] -- optimisation
excludeReferenced l = do excludeReferenced l = do
g <- Annex.gitRepo g <- gitRepo
c <- liftIO $ Git.pipeRead g [Param "show-ref"] c <- liftIO $ Git.pipeRead g [Param "show-ref"]
removewith (getKeysReferenced : map getKeysReferencedInGit (refs c)) removewith (getKeysReferenced : map getKeysReferencedInGit (refs c))
(S.fromList l) (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. -} {- List of keys referenced by symlinks in the git repo. -}
getKeysReferenced :: Annex [Key] getKeysReferenced :: Annex [Key]
getKeysReferenced = do getKeysReferenced = do
g <- Annex.gitRepo g <- gitRepo
files <- liftIO $ LsFiles.inRepo g [Git.workTree g] files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
keypairs <- mapM Backend.lookupFile files keypairs <- mapM Backend.lookupFile files
return $ map fst $ catMaybes keypairs return $ map fst $ catMaybes keypairs
@ -209,7 +199,7 @@ getKeysReferenced = do
getKeysReferencedInGit :: String -> Annex [Key] getKeysReferencedInGit :: String -> Annex [Key]
getKeysReferencedInGit ref = do getKeysReferencedInGit ref = do
showAction $ "checking " ++ Git.refDescribe ref showAction $ "checking " ++ Git.refDescribe ref
g <- Annex.gitRepo g <- gitRepo
findkeys [] =<< liftIO (LsTree.lsTree g ref) findkeys [] =<< liftIO (LsTree.lsTree g ref)
where where
findkeys c [] = return c findkeys c [] = return c
@ -232,17 +222,17 @@ staleKeysPrune dirspec present = do
contents <- staleKeys dirspec contents <- staleKeys dirspec
let stale = contents `exclude` present let stale = contents `exclude` present
let dup = contents `exclude` stale let dups = contents `exclude` stale
g <- Annex.gitRepo g <- gitRepo
let dir = dirspec g let dir = dirspec g
liftIO $ forM_ dup $ \t -> removeFile $ dir </> keyFile t liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t
return stale return stale
staleKeys :: (Git.Repo -> FilePath) -> Annex [Key] staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
staleKeys dirspec = do staleKeys dirspec = do
g <- Annex.gitRepo g <- gitRepo
let dir = dirspec g let dir = dirspec g
exists <- liftIO $ doesDirectoryExist dir exists <- liftIO $ doesDirectoryExist dir
if not exists if not exists

View file

@ -7,10 +7,10 @@
module Command.Upgrade where module Command.Upgrade where
import AnnexCommon
import Command import Command
import Upgrade import Upgrade
import Version import Version
import Messages
command :: [Command] command :: [Command]
command = [standaloneCommand "upgrade" paramNothing seek command = [standaloneCommand "upgrade" paramNothing seek

View file

@ -7,10 +7,7 @@
module Command.Version where module Command.Version where
import Control.Monad.State (liftIO) import AnnexCommon
import Data.String.Utils
import Data.Maybe
import Command import Command
import qualified Build.SysConfig as SysConfig import qualified Build.SysConfig as SysConfig
import Version import Version

View file

@ -7,13 +7,10 @@
module Command.Whereis where module Command.Whereis where
import Control.Monad import AnnexCommon
import LocationLog import LocationLog
import Command import Command
import Messages
import Remote import Remote
import Types
import Trust import Trust
command :: [Command] command :: [Command]

46
Common.hs Normal file
View file

@ -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

View file

@ -7,23 +7,16 @@
module Config where module Config where
import Data.Maybe import AnnexCommon
import Control.Monad.State (liftIO)
import Control.Applicative
import System.Cmd.Utils
import qualified Git import qualified Git
import qualified Annex import qualified Annex
import Types
import Utility
import Utility.SafeCommand
type ConfigKey = String type ConfigKey = String
{- Changes a git config setting in both internal state and .git/config -} {- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex () setConfig :: ConfigKey -> String -> Annex ()
setConfig k value = do setConfig k value = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ Git.run g "config" [Param k, Param value] liftIO $ Git.run g "config" [Param k, Param value]
-- re-read git config and update the repo's state -- re-read git config and update the repo's state
g' <- liftIO $ Git.configRead g g' <- liftIO $ Git.configRead g
@ -33,7 +26,7 @@ setConfig k value = do
- Failing that, tries looking for a global config option. -} - Failing that, tries looking for a global config option. -}
getConfig :: Git.Repo -> ConfigKey -> String -> Annex String getConfig :: Git.Repo -> ConfigKey -> String -> Annex String
getConfig r key def = do getConfig r key def = do
g <- Annex.gitRepo g <- gitRepo
let def' = Git.configGet g ("annex." ++ key) def let def' = Git.configGet g ("annex." ++ key) def
return $ Git.configGet g (remoteConfig r key) def' return $ Git.configGet g (remoteConfig r key) def'
@ -95,7 +88,7 @@ getNumCopies v =
where where
use (Just n) = return n use (Just n) = return n
use Nothing = do use Nothing = do
g <- Annex.gitRepo g <- gitRepo
return $ read $ Git.configGet g config "1" return $ read $ Git.configGet g config "1"
config = "annex.numcopies" config = "annex.numcopies"

View file

@ -21,26 +21,14 @@ module Content (
saveState saveState
) where ) where
import System.Directory import AnnexCommon
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 LocationLog import LocationLog
import UUID import UUID
import qualified Git import qualified Git
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import qualified Branch import qualified Branch
import Utility
import Utility.Conditional
import Utility.StatFS import Utility.StatFS
import Utility.Path
import Utility.FileMode import Utility.FileMode
import Types.Key import Types.Key
import Utility.DataUnits import Utility.DataUnits
@ -49,14 +37,14 @@ import Config
{- Checks if a given key is currently present in the gitAnnexLocation. -} {- Checks if a given key is currently present in the gitAnnexLocation. -}
inAnnex :: Key -> Annex Bool inAnnex :: Key -> Annex Bool
inAnnex key = do inAnnex key = do
g <- Annex.gitRepo g <- gitRepo
when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo" when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
liftIO $ doesFileExist $ gitAnnexLocation g key liftIO $ doesFileExist $ gitAnnexLocation g key
{- Calculates the relative path to use to link a file to a key. -} {- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do calcGitLink file key = do
g <- Annex.gitRepo g <- gitRepo
cwd <- liftIO getCurrentDirectory cwd <- liftIO getCurrentDirectory
let absfile = fromMaybe whoops $ absNormPath cwd file let absfile = fromMaybe whoops $ absNormPath cwd file
return $ relPathDirToFile (parentDir absfile) return $ relPathDirToFile (parentDir absfile)
@ -68,7 +56,7 @@ calcGitLink file key = do
- repository. -} - repository. -}
logStatus :: Key -> LogStatus -> Annex () logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do logStatus key status = do
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
logChange g key u status logChange g key u status
@ -77,7 +65,7 @@ logStatus key status = do
- the annex as a key's content. -} - the annex as a key's content. -}
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp key action = do getViaTmp key action = do
g <- Annex.gitRepo g <- gitRepo
let tmp = gitAnnexTmpLocation g key let tmp = gitAnnexTmpLocation g key
-- Check that there is enough free disk space. -- Check that there is enough free disk space.
@ -96,7 +84,7 @@ getViaTmp key action = do
prepTmp :: Key -> Annex FilePath prepTmp :: Key -> Annex FilePath
prepTmp key = do prepTmp key = do
g <- Annex.gitRepo g <- gitRepo
let tmp = gitAnnexTmpLocation g key let tmp = gitAnnexTmpLocation g key
liftIO $ createDirectoryIfMissing True (parentDir tmp) liftIO $ createDirectoryIfMissing True (parentDir tmp)
return tmp return tmp
@ -133,7 +121,7 @@ checkDiskSpace = checkDiskSpace' 0
checkDiskSpace' :: Integer -> Key -> Annex () checkDiskSpace' :: Integer -> Key -> Annex ()
checkDiskSpace' adjustment key = do checkDiskSpace' adjustment key = do
g <- Annex.gitRepo g <- gitRepo
r <- getConfig g "diskreserve" "" r <- getConfig g "diskreserve" ""
let reserve = fromMaybe megabyte $ readSize dataUnits r let reserve = fromMaybe megabyte $ readSize dataUnits r
stats <- liftIO $ getFileSystemStats (gitAnnexDir g) stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
@ -174,7 +162,7 @@ checkDiskSpace' adjustment key = do
-} -}
moveAnnex :: Key -> FilePath -> Annex () moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = do moveAnnex key src = do
g <- Annex.gitRepo g <- gitRepo
let dest = gitAnnexLocation g key let dest = gitAnnexLocation g key
let dir = parentDir dest let dir = parentDir dest
e <- liftIO $ doesFileExist dest e <- liftIO $ doesFileExist dest
@ -189,7 +177,7 @@ moveAnnex key src = do
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
withObjectLoc key a = do withObjectLoc key a = do
g <- Annex.gitRepo g <- gitRepo
let file = gitAnnexLocation g key let file = gitAnnexLocation g key
let dir = parentDir file let dir = parentDir file
a (dir, file) a (dir, file)
@ -213,7 +201,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
- returns the file it was moved to. -} - returns the file it was moved to. -}
moveBad :: Key -> Annex FilePath moveBad :: Key -> Annex FilePath
moveBad key = do moveBad key = do
g <- Annex.gitRepo g <- gitRepo
let src = gitAnnexLocation g key let src = gitAnnexLocation g key
let dest = gitAnnexBadDir g </> takeFileName src let dest = gitAnnexBadDir g </> takeFileName src
liftIO $ do liftIO $ do
@ -227,7 +215,7 @@ moveBad key = do
{- List of keys whose content exists in .git/annex/objects/ -} {- List of keys whose content exists in .git/annex/objects/ -}
getKeysPresent :: Annex [Key] getKeysPresent :: Annex [Key]
getKeysPresent = do getKeysPresent = do
g <- Annex.gitRepo g <- gitRepo
getKeysPresent' $ gitAnnexObjectDir g getKeysPresent' $ gitAnnexObjectDir g
getKeysPresent' :: FilePath -> Annex [Key] getKeysPresent' :: FilePath -> Annex [Key]
getKeysPresent' dir = do getKeysPresent' dir = do

View file

@ -30,26 +30,17 @@ import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M import qualified Data.Map as M
import Data.ByteString.Lazy.UTF8 (fromString) import Data.ByteString.Lazy.UTF8 (fromString)
import Data.Digest.Pure.SHA 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.Types
import System.Posix.Process
import Control.Applicative import Control.Applicative
import Control.Concurrent import Control.Concurrent
import Control.Exception (finally) import Control.Exception (finally)
import System.Exit import System.Exit
import System.Environment import System.Environment
import Types import AnnexCommon
import Types.Key import Types.Key
import Types.Remote import Types.Remote
import Utility
import Utility.Base64 import Utility.Base64
import Utility.SafeCommand
import Types.Crypto import Types.Crypto
{- The first half of a Cipher is used for HMAC; the remainder {- 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 updateCipher c encipher@(EncryptedCipher _ ks) = do
ks' <- configKeyIds c ks' <- configKeyIds c
cipher <- decryptCipher c encipher cipher <- decryptCipher c encipher
encryptCipher cipher (combine ks ks') encryptCipher cipher (merge ks ks')
where where
combine (KeyIds a) (KeyIds b) = KeyIds $ a ++ b merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
describeCipher :: EncryptedCipher -> String describeCipher :: EncryptedCipher -> String
describeCipher (EncryptedCipher _ (KeyIds ks)) = describeCipher (EncryptedCipher _ (KeyIds ks)) =

16
Git.hs
View file

@ -64,34 +64,20 @@ module Git (
prop_idempotent_deencode prop_idempotent_deencode
) where ) where
import Control.Monad (unless, when, liftM2)
import Control.Applicative
import System.Directory
import System.FilePath
import System.Posix.Directory import System.Posix.Directory
import System.Posix.User import System.Posix.User
import System.Posix.Process
import System.Path
import System.Cmd.Utils
import IO (bracket_, try) import IO (bracket_, try)
import Data.String.Utils
import System.IO
import qualified Data.Map as M hiding (map, split) import qualified Data.Map as M hiding (map, split)
import Network.URI import Network.URI
import Data.Maybe
import Data.Char import Data.Char
import Data.Word (Word8) import Data.Word (Word8)
import Codec.Binary.UTF8.String (encode) import Codec.Binary.UTF8.String (encode)
import Text.Printf import Text.Printf
import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
import System.Exit import System.Exit
import System.Posix.Env (setEnv, unsetEnv, getEnv) import System.Posix.Env (setEnv, unsetEnv, getEnv)
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Utility import Common
import Utility.Path
import Utility.Conditional
import Utility.SafeCommand
{- There are two types of repositories; those on local disk and those {- There are two types of repositories; those on local disk and those
- accessed via an URL. -} - accessed via an URL. -}

View file

@ -8,14 +8,12 @@
module GitAnnex where module GitAnnex where
import System.Console.GetOpt import System.Console.GetOpt
import Control.Monad.State (liftIO)
import AnnexCommon
import qualified Git import qualified Git
import CmdLine import CmdLine
import Command import Command
import Options import Options
import Utility
import Types
import Types.TrustLevel import Types.TrustLevel
import qualified Annex import qualified Annex
import qualified Remote import qualified Remote
@ -122,7 +120,7 @@ options = commonOptions ++
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v } setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
setgitconfig :: String -> Annex () setgitconfig :: String -> Annex ()
setgitconfig v = do setgitconfig v = do
g <- Annex.gitRepo g <- gitRepo
g' <- liftIO $ Git.configStore g v g' <- liftIO $ Git.configStore g v
Annex.changeState $ \s -> s { Annex.repo = g' } Annex.changeState $ \s -> s { Annex.repo = g' }

14
Init.hs
View file

@ -11,18 +11,10 @@ module Init (
uninitialize uninitialize
) where ) where
import Control.Monad.State (liftIO) import AnnexCommon
import Control.Monad (unless)
import System.Directory
import qualified Annex
import qualified Git import qualified Git
import qualified Branch import qualified Branch
import Version import Version
import Messages
import Types
import Utility
import Utility.Conditional
import UUID import UUID
initialize :: Annex () initialize :: Annex ()
@ -73,12 +65,12 @@ gitPreCommitHookUnWrite = unlessBare $ do
unlessBare :: Annex () -> Annex () unlessBare :: Annex () -> Annex ()
unlessBare a = do unlessBare a = do
g <- Annex.gitRepo g <- gitRepo
unless (Git.repoIsLocalBare g) a unless (Git.repoIsLocalBare g) a
preCommitHook :: Annex FilePath preCommitHook :: Annex FilePath
preCommitHook = do preCommitHook = do
g <- Annex.gitRepo g <- gitRepo
return $ Git.gitDir g ++ "/hooks/pre-commit" return $ Git.gitDir g ++ "/hooks/pre-commit"
preCommitScript :: String preCommitScript :: String

View file

@ -9,15 +9,13 @@ module Limit where
import Text.Regex.PCRE.Light.Char8 import Text.Regex.PCRE.Light.Char8
import System.Path.WildMatch import System.Path.WildMatch
import Control.Applicative
import Data.Maybe
import Annex import AnnexCommon
import qualified Annex
import qualified Utility.Matcher import qualified Utility.Matcher
import qualified Remote import qualified Remote
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Utility
import Content import Content
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)

View file

@ -21,15 +21,10 @@ module LocationLog (
logFileKey logFileKey
) where ) where
import System.FilePath import AnnexCommon
import Control.Applicative
import Data.Maybe
import qualified Git import qualified Git
import qualified Branch import qualified Branch
import UUID import UUID
import Types
import Locations
import PresenceLog import PresenceLog
{- Log a change in the presence of a key's value in a repository. -} {- Log a change in the presence of a key's value in a repository. -}

View file

@ -26,13 +26,11 @@ module Locations (
prop_idempotent_fileKey prop_idempotent_fileKey
) where ) where
import System.FilePath
import Data.String.Utils
import Data.List
import Bits import Bits
import Word import Word
import Data.Hash.MD5 import Data.Hash.MD5
import Common
import Types import Types
import Types.Key import Types.Key
import qualified Git import qualified Git

View file

@ -23,11 +23,9 @@ module Messages (
setupConsole setupConsole
) where ) where
import Control.Monad.State (liftIO)
import System.IO
import Data.String.Utils
import Text.JSON import Text.JSON
import Common
import Types import Types
import qualified Annex import qualified Annex
import qualified Messages.JSON as JSON import qualified Messages.JSON as JSON

View file

@ -9,10 +9,9 @@ module Options where
import System.Console.GetOpt import System.Console.GetOpt
import System.Log.Logger import System.Log.Logger
import Control.Monad.State (liftIO)
import AnnexCommon
import qualified Annex import qualified Annex
import Types
import Command import Command
import Limit import Limit

View file

@ -26,11 +26,9 @@ import Data.Time.Clock.POSIX
import Data.Time import Data.Time
import System.Locale import System.Locale
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad.State (liftIO)
import Control.Applicative
import AnnexCommon
import qualified Branch import qualified Branch
import Types
data LogLine = LogLine { data LogLine = LogLine {
date :: POSIXTime, date :: POSIXTime,

View file

@ -28,23 +28,17 @@ module Remote (
forceTrust forceTrust
) where ) where
import Control.Monad.State (filterM)
import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.String.Utils
import Data.Maybe
import Control.Applicative
import Text.JSON import Text.JSON
import Text.JSON.Generic import Text.JSON.Generic
import Types import AnnexCommon
import Types.Remote import Types.Remote
import UUID import UUID
import qualified Annex import qualified Annex
import Config import Config
import Trust import Trust
import LocationLog import LocationLog
import Messages
import RemoteLog import RemoteLog
import qualified Remote.Git import qualified Remote.Git
@ -110,7 +104,7 @@ byName' n = do
- and returns its UUID. Finds even remotes that are not configured in - and returns its UUID. Finds even remotes that are not configured in
- .git/config. -} - .git/config. -}
nameToUUID :: String -> Annex UUID nameToUUID :: String -> Annex UUID
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo nameToUUID "." = getUUID =<< gitRepo -- special case for current repo
nameToUUID n = do nameToUUID n = do
res <- byName' n res <- byName' n
case res of case res of
@ -135,7 +129,7 @@ nameToUUID n = do
- of the UUIDs. -} - of the UUIDs. -}
prettyPrintUUIDs :: String -> [UUID] -> Annex String prettyPrintUUIDs :: String -> [UUID] -> Annex String
prettyPrintUUIDs desc uuids = do prettyPrintUUIDs desc uuids = do
here <- getUUID =<< Annex.gitRepo here <- getUUID =<< gitRepo
m <- M.unionWith addname <$> uuidMap <*> remoteMap m <- M.unionWith addname <$> uuidMap <*> remoteMap
maybeShowJSON [(desc, map (jsonify m here) uuids)] maybeShowJSON [(desc, map (jsonify m here) uuids)]
return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") 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' :: Bool -> Key -> Annex ([Remote Annex], [UUID])
keyPossibilities' withtrusted key = do keyPossibilities' withtrusted key = do
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
trusted <- if withtrusted then trustGet Trusted else return [] trusted <- if withtrusted then trustGet Trusted else return []
@ -204,7 +198,7 @@ keyPossibilities' withtrusted key = do
{- Displays known locations of a key. -} {- Displays known locations of a key. -}
showLocations :: Key -> [UUID] -> Annex () showLocations :: Key -> [UUID] -> Annex ()
showLocations key exclude = do showLocations key exclude = do
g <- Annex.gitRepo g <- gitRepo
u <- getUUID g u <- getUUID g
uuids <- keyLocations key uuids <- keyLocations key
untrusteduuids <- trustGet UnTrusted untrusteduuids <- trustGet UnTrusted

View file

@ -8,30 +8,15 @@
module Remote.Bup (remote) where module Remote.Bup (remote) where
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import System.IO
import System.IO.Error import System.IO.Error
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Process 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 Types.Remote
import qualified Git import qualified Git
import qualified Annex
import UUID import UUID
import Locations
import Config import Config
import Utility
import Utility.Conditional
import Utility.SafeCommand
import Messages
import Utility.Ssh import Utility.Ssh
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable import Remote.Helper.Encryptable
@ -118,14 +103,14 @@ bupSplitParams r buprepo k src = do
store :: Git.Repo -> BupRepo -> Key -> Annex Bool store :: Git.Repo -> BupRepo -> Key -> Annex Bool
store r buprepo k = do store r buprepo k = do
g <- Annex.gitRepo g <- gitRepo
let src = gitAnnexLocation g k let src = gitAnnexLocation g k
params <- bupSplitParams r buprepo k (File src) params <- bupSplitParams r buprepo k (File src)
liftIO $ boolSystem "bup" params liftIO $ boolSystem "bup" params
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted r buprepo (cipher, enck) k = do storeEncrypted r buprepo (cipher, enck) k = do
g <- Annex.gitRepo g <- gitRepo
let src = gitAnnexLocation g k let src = gitAnnexLocation g k
params <- bupSplitParams r buprepo enck (Param "-") params <- bupSplitParams r buprepo enck (Param "-")
liftIO $ catchBool $ liftIO $ catchBool $

View file

@ -9,25 +9,14 @@ module Remote.Directory (remote) where
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import System.IO.Error import System.IO.Error
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M 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 Types.Remote
import qualified Git import qualified Git
import qualified Annex
import UUID import UUID
import Locations
import Utility.CopyFile
import Config import Config
import Utility
import Utility.Conditional
import Utility.Path
import Utility.FileMode import Utility.FileMode
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable import Remote.Helper.Encryptable
@ -82,14 +71,14 @@ dirKey d k = d </> hashDirMixed k </> f </> f
store :: FilePath -> Key -> Annex Bool store :: FilePath -> Key -> Annex Bool
store d k = do store d k = do
g <- Annex.gitRepo g <- gitRepo
let src = gitAnnexLocation g k let src = gitAnnexLocation g k
let dest = dirKey d 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 :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted d (cipher, enck) k = do storeEncrypted d (cipher, enck) k = do
g <- Annex.gitRepo g <- gitRepo
let src = gitAnnexLocation g k let src = gitAnnexLocation g k
let dest = dirKey d enck let dest = dirKey d enck
liftIO $ catchBool $ storeHelper dest $ encrypt src dest liftIO $ catchBool $ storeHelper dest $ encrypt src dest
@ -110,7 +99,7 @@ storeHelper dest a = do
return ok return ok
retrieve :: FilePath -> Key -> FilePath -> Annex Bool 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 :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted d (cipher, enck) f = retrieveEncrypted d (cipher, enck) f =

View file

@ -8,26 +8,17 @@
module Remote.Git (remote) where module Remote.Git (remote) where
import Control.Exception.Extensible import Control.Exception.Extensible
import Control.Monad.State (liftIO)
import qualified Data.Map as M import qualified Data.Map as M
import System.Cmd.Utils
import System.Posix.Files
import System.IO
import Types import AnnexCommon
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.CopyFile
import Utility.RsyncFile import Utility.RsyncFile
import Utility.Ssh import Utility.Ssh
import Utility.SafeCommand import Types.Remote
import Utility.Path import qualified Git
import qualified Annex
import UUID
import qualified Content
import qualified Utility.Url as Url import qualified Utility.Url as Url
import Config import Config
import Init import Init
@ -42,7 +33,7 @@ remote = RemoteType {
list :: Annex [Git.Repo] list :: Annex [Git.Repo]
list = do list = do
g <- Annex.gitRepo g <- gitRepo
return $ Git.remotes g return $ Git.remotes g
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
@ -109,7 +100,7 @@ tryGitConfigRead r
store a = do store a = do
r' <- a r' <- a
g <- Annex.gitRepo g <- gitRepo
let l = Git.remotes g let l = Git.remotes g
let g' = Git.remotesAdd g $ exchange l r' let g' = Git.remotesAdd g $ exchange l r'
Annex.changeState $ \s -> s { Annex.repo = g' } Annex.changeState $ \s -> s { Annex.repo = g' }
@ -169,7 +160,7 @@ copyFromRemote r key file
copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key copyToRemote r key
| not $ Git.repoIsUrl r = do | not $ Git.repoIsUrl r = do
g <- Annex.gitRepo g <- gitRepo
let keysrc = gitAnnexLocation g key let keysrc = gitAnnexLocation g key
-- run copy from perspective of remote -- run copy from perspective of remote
liftIO $ onLocal r $ do liftIO $ onLocal r $ do
@ -178,7 +169,7 @@ copyToRemote r key
Content.saveState Content.saveState
return ok return ok
| Git.repoIsSsh r = do | Git.repoIsSsh r = do
g <- Annex.gitRepo g <- gitRepo
let keysrc = gitAnnexLocation g key let keysrc = gitAnnexLocation g key
rsyncHelper =<< rsyncParamsRemote r False key keysrc rsyncHelper =<< rsyncParamsRemote r False key keysrc
| otherwise = error "copying to non-ssh repo not supported" | otherwise = error "copying to non-ssh repo not supported"
@ -200,7 +191,7 @@ rsyncOrCopyFile r src dest = do
ss <- liftIO $ getFileStatus $ parentDir src ss <- liftIO $ getFileStatus $ parentDir src
ds <- liftIO $ getFileStatus $ parentDir dest ds <- liftIO $ getFileStatus $ parentDir dest
if deviceID ss == deviceID ds if deviceID ss == deviceID ds
then liftIO $ copyFile src dest then liftIO $ copyFileExternal src dest
else do else do
params <- rsyncParams r params <- rsyncParams r
rsyncHelper $ params ++ [Param src, Param dest] rsyncHelper $ params ++ [Param src, Param dest]

View file

@ -8,13 +8,11 @@
module Remote.Helper.Encryptable where module Remote.Helper.Encryptable where
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad.State (liftIO)
import Types import AnnexCommon
import Types.Remote import Types.Remote
import Crypto import Crypto
import qualified Annex import qualified Annex
import Messages
import Config import Config
{- Encryption setup for a remote. The user must specify whether to use {- Encryption setup for a remote. The user must specify whether to use

View file

@ -8,16 +8,11 @@
module Remote.Helper.Special where module Remote.Helper.Special where
import qualified Data.Map as M 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 Types.Remote
import qualified Git import qualified Git
import qualified Annex
import UUID import UUID
import Utility.SafeCommand
{- Special remotes don't have a configured url, so Git.Repo does not {- Special remotes don't have a configured url, so Git.Repo does not
- automatically generate remotes for them. This looks for a different - automatically generate remotes for them. This looks for a different
@ -25,7 +20,7 @@ import Utility.SafeCommand
-} -}
findSpecialRemotes :: String -> Annex [Git.Repo] findSpecialRemotes :: String -> Annex [Git.Repo]
findSpecialRemotes s = do findSpecialRemotes s = do
g <- Annex.gitRepo g <- gitRepo
return $ map construct $ remotepairs g return $ map construct $ remotepairs g
where where
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r 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. -} {- Sets up configuration for a special remote in .git/config. -}
gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex () gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
gitConfigSpecialRemote u c k v = do gitConfigSpecialRemote u c k v = do
g <- Annex.gitRepo g <- gitRepo
liftIO $ do liftIO $ do
Git.run g "config" [Param (configsetting $ "annex-"++k), Param v] Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
Git.run g "config" [Param (configsetting "annex-uuid"), Param u] Git.run g "config" [Param (configsetting "annex-uuid"), Param u]

View file

@ -8,31 +8,19 @@
module Remote.Hook (remote) where module Remote.Hook (remote) where
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M 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.IO.Error (try)
import System.Exit import System.Exit
import Data.Maybe
import Types import AnnexCommon
import Types.Remote import Types.Remote
import qualified Git import qualified Git
import qualified Annex
import UUID import UUID
import Locations
import Config import Config
import Content import Content
import Utility
import Utility.SafeCommand
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable import Remote.Helper.Encryptable
import Crypto import Crypto
import Messages
remote :: RemoteType Annex remote :: RemoteType Annex
remote = RemoteType { remote = RemoteType {
@ -86,7 +74,7 @@ hookEnv k f = Just $ fileenv f ++ keyenv
lookupHook :: String -> String -> Annex (Maybe String) lookupHook :: String -> String -> Annex (Maybe String)
lookupHook hooktype hook =do lookupHook hooktype hook =do
g <- Annex.gitRepo g <- gitRepo
command <- getConfig g hookname "" command <- getConfig g hookname ""
if null command if null command
then do 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 :: String -> Key -> Annex Bool
store h k = do store h k = do
g <- Annex.gitRepo g <- gitRepo
runHook h "store" k (Just $ gitAnnexLocation g k) $ return True runHook h "store" k (Just $ gitAnnexLocation g k) $ return True
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
g <- Annex.gitRepo g <- gitRepo
let f = gitAnnexLocation g k let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
runHook h "store" enck (Just tmp) $ return True runHook h "store" enck (Just tmp) $ return True

View file

@ -8,32 +8,18 @@
module Remote.Rsync (remote) where module Remote.Rsync (remote) where
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M 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 Types.Remote
import qualified Git import qualified Git
import qualified Annex
import UUID import UUID
import Locations
import Config import Config
import Content import Content
import Utility
import Utility.Conditional
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable import Remote.Helper.Encryptable
import Crypto import Crypto
import Messages
import Utility.RsyncFile import Utility.RsyncFile
import Utility.SafeCommand
import Utility.Path
type RsyncUrl = String type RsyncUrl = String
@ -106,12 +92,12 @@ rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> shellEscape (keyFile k)
store :: RsyncOpts -> Key -> Annex Bool store :: RsyncOpts -> Key -> Annex Bool
store o k = do store o k = do
g <- Annex.gitRepo g <- gitRepo
rsyncSend o k (gitAnnexLocation g k) rsyncSend o k (gitAnnexLocation g k)
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
g <- Annex.gitRepo g <- gitRepo
let f = gitAnnexLocation g k let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
rsyncSend o enck tmp rsyncSend o enck tmp
@ -166,7 +152,7 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial"
- up trees for rsync. -} - up trees for rsync. -}
withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool
withRsyncScratchDir a = do withRsyncScratchDir a = do
g <- Annex.gitRepo g <- gitRepo
pid <- liftIO getProcessID pid <- liftIO getProcessID
let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid
nuke tmp nuke tmp

View file

@ -7,31 +7,21 @@
module Remote.S3 (remote) where module Remote.S3 (remote) where
import Control.Exception.Extensible (IOException)
import Network.AWS.AWSConnection import Network.AWS.AWSConnection
import Network.AWS.S3Object import Network.AWS.S3Object
import Network.AWS.S3Bucket hiding (size) import Network.AWS.S3Bucket hiding (size)
import Network.AWS.AWSResult import Network.AWS.AWSResult
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe
import Data.List
import Data.Char import Data.Char
import Data.String.Utils
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Environment import System.Environment
import System.Posix.Files
import System.Posix.Env (setEnv) import System.Posix.Env (setEnv)
import Types import AnnexCommon
import Types.Remote import Types.Remote
import Types.Key import Types.Key
import qualified Git import qualified Git
import qualified Annex
import UUID import UUID
import Messages
import Locations
import Config import Config
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable import Remote.Helper.Encryptable
@ -123,7 +113,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
store :: Remote Annex -> Key -> Annex Bool store :: Remote Annex -> Key -> Annex Bool
store r k = s3Action r False $ \(conn, bucket) -> do store r k = s3Action r False $ \(conn, bucket) -> do
g <- Annex.gitRepo g <- gitRepo
res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k
s3Bool res 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. -- To get file size of the encrypted content, have to use a temp file.
-- (An alternative would be chunking to to a constant size.) -- (An alternative would be chunking to to a constant size.)
withTmp enck $ \tmp -> do withTmp enck $ \tmp -> do
g <- Annex.gitRepo g <- gitRepo
let f = gitAnnexLocation g k let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
res <- liftIO $ storeHelper (conn, bucket) r enck tmp res <- liftIO $ storeHelper (conn, bucket) r enck tmp

View file

@ -10,21 +10,13 @@ module Remote.Web (
setUrl setUrl
) where ) where
import Control.Monad.State (liftIO) import AnnexCommon
import Control.Exception
import System.FilePath
import Types
import Types.Remote import Types.Remote
import qualified Git import qualified Git
import qualified Annex
import Messages
import UUID import UUID
import Config import Config
import PresenceLog import PresenceLog
import LocationLog import LocationLog
import Locations
import Utility
import qualified Utility.Url as Url import qualified Utility.Url as Url
type URLString = String type URLString = String
@ -80,7 +72,7 @@ getUrls key = do
{- Records a change in an url for a key. -} {- Records a change in an url for a key. -}
setUrl :: Key -> URLString -> LogStatus -> Annex () setUrl :: Key -> URLString -> LogStatus -> Annex ()
setUrl key url status = do setUrl key url status = do
g <- Annex.gitRepo g <- gitRepo
addLog (urlLog key) =<< logNow status url addLog (urlLog key) =<< logNow status url
-- update location log to indicate that the web has the key, or not -- update location log to indicate that the web has the key, or not

View file

@ -15,14 +15,11 @@ module RemoteLog (
prop_idempotent_configEscape prop_idempotent_configEscape
) where ) where
import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe
import Data.Char import Data.Char
import Control.Applicative
import AnnexCommon
import qualified Branch import qualified Branch
import Types
import Types.Remote import Types.Remote
import UUID import UUID

View file

@ -13,13 +13,11 @@ module Trust (
trustPartition trustPartition
) where ) where
import Control.Monad.State
import qualified Data.Map as M import qualified Data.Map as M
import Data.List
import AnnexCommon
import Types.TrustLevel import Types.TrustLevel
import qualified Branch import qualified Branch
import Types
import UUID import UUID
import qualified Annex import qualified Annex

View file

@ -15,9 +15,10 @@ module Types.Key (
prop_idempotent_key_read_show prop_idempotent_key_read_show
) where ) where
import Utility
import System.Posix.Types import System.Posix.Types
import Common
{- A Key has a unique name, is associated with a key/value backend, {- A Key has a unique name, is associated with a key/value backend,
- and may contain other optional metadata. -} - and may contain other optional metadata. -}
data Key = Key { data Key = Key {

12
UUID.hs
View file

@ -22,18 +22,12 @@ module UUID (
uuidLog uuidLog
) where ) where
import Control.Monad.State
import Control.Applicative
import System.Cmd.Utils
import System.IO
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe
import AnnexCommon
import qualified Git import qualified Git
import qualified Branch import qualified Branch
import Types
import Types.UUID import Types.UUID
import qualified Annex
import qualified Build.SysConfig as SysConfig import qualified Build.SysConfig as SysConfig
import Config import Config
@ -60,7 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h
-} -}
getUUID :: Git.Repo -> Annex UUID getUUID :: Git.Repo -> Annex UUID
getUUID r = do getUUID r = do
g <- Annex.gitRepo g <- gitRepo
let c = cached g let c = cached g
let u = getUncachedUUID r let u = getUncachedUUID r
@ -81,7 +75,7 @@ getUncachedUUID r = Git.configGet r configkey ""
{- Make sure that the repo has an annex.uuid setting. -} {- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex () prepUUID :: Annex ()
prepUUID = do prepUUID = do
u <- getUUID =<< Annex.gitRepo u <- getUUID =<< gitRepo
when ("" == u) $ do when ("" == u) $ do
uuid <- liftIO genUUID uuid <- liftIO genUUID
setConfig configkey uuid setConfig configkey uuid

View file

@ -7,7 +7,7 @@
module Upgrade where module Upgrade where
import Types import AnnexCommon
import Version import Version
import qualified Upgrade.V0 import qualified Upgrade.V0
import qualified Upgrade.V1 import qualified Upgrade.V1

View file

@ -8,23 +8,15 @@
module Upgrade.V0 where module Upgrade.V0 where
import System.IO.Error (try) 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 Content
import Types
import Locations
import qualified Annex
import Messages
import qualified Upgrade.V1 import qualified Upgrade.V1
upgrade :: Annex Bool upgrade :: Annex Bool
upgrade = do upgrade = do
showAction "v0 to v1" showAction "v0 to v1"
g <- Annex.gitRepo g <- gitRepo
-- do the reorganisation of the key files -- do the reorganisation of the key files
let olddir = gitAnnexDir g let olddir = gitAnnexDir g

View file

@ -8,33 +8,19 @@
module Upgrade.V1 where module Upgrade.V1 where
import System.IO.Error (try) 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 System.Posix.Types
import Data.Maybe
import Data.Char import Data.Char
import AnnexCommon
import Types.Key import Types.Key
import Content import Content
import Types
import Locations
import PresenceLog import PresenceLog
import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import qualified Git import qualified Git
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import Backend import Backend
import Messages
import Version import Version
import Utility
import Utility.FileMode import Utility.FileMode
import Utility.SafeCommand
import Utility.Path
import qualified Upgrade.V2 import qualified Upgrade.V2
-- v2 adds hashing of filenames of content and location log files. -- v2 adds hashing of filenames of content and location log files.
@ -64,7 +50,7 @@ upgrade :: Annex Bool
upgrade = do upgrade = do
showAction "v1 to v2" showAction "v1 to v2"
g <- Annex.gitRepo g <- gitRepo
if Git.repoIsLocalBare g if Git.repoIsLocalBare g
then do then do
moveContent moveContent
@ -96,7 +82,7 @@ moveContent = do
updateSymlinks :: Annex () updateSymlinks :: Annex ()
updateSymlinks = do updateSymlinks = do
showAction "updating symlinks" showAction "updating symlinks"
g <- Annex.gitRepo g <- gitRepo
files <- liftIO $ LsFiles.inRepo g [Git.workTree g] files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
forM_ files fixlink forM_ files fixlink
where where
@ -117,7 +103,7 @@ moveLocationLogs = do
forM_ logkeys move forM_ logkeys move
where where
oldlocationlogs = do oldlocationlogs = do
g <- Annex.gitRepo g <- gitRepo
let dir = Upgrade.V2.gitStateDir g let dir = Upgrade.V2.gitStateDir g
exists <- liftIO $ doesDirectoryExist dir exists <- liftIO $ doesDirectoryExist dir
if exists if exists
@ -126,7 +112,7 @@ moveLocationLogs = do
return $ mapMaybe oldlog2key contents return $ mapMaybe oldlog2key contents
else return [] else return []
move (l, k) = do move (l, k) = do
g <- Annex.gitRepo g <- gitRepo
let dest = logFile2 g k let dest = logFile2 g k
let dir = Upgrade.V2.gitStateDir g let dir = Upgrade.V2.gitStateDir g
let f = dir </> l let f = dir </> l
@ -220,7 +206,7 @@ lookupFile1 file = do
getKeyFilesPresent1 :: Annex [FilePath] getKeyFilesPresent1 :: Annex [FilePath]
getKeyFilesPresent1 = do getKeyFilesPresent1 = do
g <- Annex.gitRepo g <- gitRepo
getKeyFilesPresent1' $ gitAnnexObjectDir g getKeyFilesPresent1' $ gitAnnexObjectDir g
getKeyFilesPresent1' :: FilePath -> Annex [FilePath] getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
getKeyFilesPresent1' dir = do getKeyFilesPresent1' dir = do

View file

@ -7,21 +7,9 @@
module Upgrade.V2 where module Upgrade.V2 where
import System.Directory import AnnexCommon
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 qualified Git import qualified Git
import qualified Branch import qualified Branch
import Messages
import Utility
import Utility.Conditional
import Utility.SafeCommand
import LocationLog import LocationLog
import Content import Content
@ -48,7 +36,7 @@ olddir g
upgrade :: Annex Bool upgrade :: Annex Bool
upgrade = do upgrade = do
showAction "v2 to v3" showAction "v2 to v3"
g <- Annex.gitRepo g <- gitRepo
let bare = Git.repoIsLocalBare g let bare = Git.repoIsLocalBare g
Branch.create Branch.create
@ -85,7 +73,7 @@ locationLogs repo = liftIO $ do
inject :: FilePath -> FilePath -> Annex () inject :: FilePath -> FilePath -> Annex ()
inject source dest = do inject source dest = do
g <- Annex.gitRepo g <- gitRepo
new <- liftIO (readFile $ olddir g </> source) new <- liftIO (readFile $ olddir g </> source)
Branch.change dest $ \prev -> Branch.change dest $ \prev ->
unlines $ nub $ lines prev ++ lines new unlines $ nub $ lines prev ++ lines new
@ -114,7 +102,7 @@ push = do
Branch.update -- just in case Branch.update -- just in case
showAction "pushing new git-annex branch to origin" showAction "pushing new git-annex branch to origin"
showOutput showOutput
g <- Annex.gitRepo g <- gitRepo
liftIO $ Git.run g "push" [Param "origin", Param Branch.name] liftIO $ Git.run g "push" [Param "origin", Param Branch.name]
_ -> do _ -> do
-- no origin exists, so just let the user -- no origin exists, so just let the user

View file

@ -11,7 +11,6 @@ module Utility (
readMaybe, readMaybe,
viaTmp, viaTmp,
withTempFile, withTempFile,
dirContains,
dirContents, dirContents,
myHomeDir, myHomeDir,
catchBool, catchBool,

View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Utility.CopyFile (copyFile) where module Utility.CopyFile (copyFileExternal) where
import System.Directory (doesFileExist, removeFile) 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, {- The cp command is used, because I hate reinventing the wheel,
- and because this allows easy access to features like cp --reflink. -} - and because this allows easy access to features like cp --reflink. -}
copyFile :: FilePath -> FilePath -> IO Bool copyFileExternal :: FilePath -> FilePath -> IO Bool
copyFile src dest = do copyFileExternal src dest = do
whenM (doesFileExist dest) $ whenM (doesFileExist dest) $
removeFile dest removeFile dest
boolSystem "cp" [params, File src, File dest] boolSystem "cp" [params, File src, File dest]

View file

@ -7,8 +7,7 @@
module Version where module Version where
import Types import AnnexCommon
import qualified Annex
import qualified Git import qualified Git
import Config import Config
@ -28,7 +27,7 @@ versionField = "annex.version"
getVersion :: Annex (Maybe Version) getVersion :: Annex (Maybe Version)
getVersion = do getVersion = do
g <- Annex.gitRepo g <- gitRepo
let v = Git.configGet g versionField "" let v = Git.configGet g versionField ""
if not $ null v if not $ null v
then return $ Just v then return $ Just v

View file

@ -6,13 +6,11 @@
-} -}
import System.Environment import System.Environment
import Data.List
import AnnexCommon
import qualified Git import qualified Git
import CmdLine import CmdLine
import Command import Command
import Utility.Conditional
import Utility.SafeCommand
import Options import Options
import qualified Command.ConfigList import qualified Command.ConfigList

View file

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

View file

@ -6,10 +6,8 @@
-} -}
import System.Environment import System.Environment
import System.FilePath
import System.Directory
import Control.Monad (when)
import Common
import qualified Git.UnionMerge import qualified Git.UnionMerge
import qualified Git import qualified Git

View file

@ -9,23 +9,19 @@ import Test.HUnit
import Test.HUnit.Tools import Test.HUnit.Tools
import Test.QuickCheck import Test.QuickCheck
import System.Directory
import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Files import System.Posix.Files
import IO (bracket_, bracket) import IO (bracket_, bracket)
import Control.Monad (unless, when, filterM)
import Data.List
import System.IO.Error import System.IO.Error
import System.Posix.Env import System.Posix.Env
import qualified Control.Exception.Extensible as E import qualified Control.Exception.Extensible as E
import Control.Exception (throw) import Control.Exception (throw)
import Data.Maybe
import qualified Data.Map as M import qualified Data.Map as M
import System.Path (recurseDir)
import System.IO.HVFS (SystemFS(..)) import System.IO.HVFS (SystemFS(..))
import Utility.SafeCommand import Common
import qualified Utility.SafeCommand
import qualified Annex import qualified Annex
import qualified Backend import qualified Backend
import qualified Git import qualified Git