move annex.numcopies parsing into withNumCopies
This commit is contained in:
parent
d036cd590f
commit
456b45b9b3
5 changed files with 16 additions and 25 deletions
13
Command.hs
13
Command.hs
|
@ -59,9 +59,6 @@ type CommandStartKey = Key -> CommandStart
|
||||||
type BackendFile = (FilePath, Maybe (Backend Annex))
|
type BackendFile = (FilePath, Maybe (Backend Annex))
|
||||||
type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek
|
type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek
|
||||||
type CommandStartBackendFile = BackendFile -> CommandStart
|
type CommandStartBackendFile = BackendFile -> CommandStart
|
||||||
type AttrFile = (FilePath, String)
|
|
||||||
type CommandSeekAttrFiles = CommandStartAttrFile -> CommandSeek
|
|
||||||
type CommandStartAttrFile = AttrFile -> CommandStart
|
|
||||||
type CommandSeekNothing = CommandStart -> CommandSeek
|
type CommandSeekNothing = CommandStart -> CommandSeek
|
||||||
type CommandStartNothing = CommandStart
|
type CommandStartNothing = CommandStart
|
||||||
|
|
||||||
|
@ -129,14 +126,18 @@ withFilesInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- Annex.gitRepo
|
||||||
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
||||||
liftM (map a) $ filterFiles files
|
liftM (map a) $ filterFiles files
|
||||||
withAttrFilesInGit :: String -> CommandSeekAttrFiles
|
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
|
||||||
withAttrFilesInGit attr a params = do
|
withAttrFilesInGit attr a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- Annex.gitRepo
|
||||||
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
||||||
files' <- filterFiles files
|
files' <- filterFiles files
|
||||||
liftM (map a) $ liftIO $ Git.checkAttr repo attr files'
|
liftM (map a) $ liftIO $ Git.checkAttr repo attr files'
|
||||||
withNumCopies :: CommandSeekAttrFiles
|
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
|
||||||
withNumCopies = withAttrFilesInGit "annex.numcopies"
|
withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
|
||||||
|
where
|
||||||
|
go (file, v) = do
|
||||||
|
let numcopies = readMaybe v
|
||||||
|
a file numcopies
|
||||||
withBackendFilesInGit :: CommandSeekBackendFiles
|
withBackendFilesInGit :: CommandSeekBackendFiles
|
||||||
withBackendFilesInGit a params = do
|
withBackendFilesInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- Annex.gitRepo
|
||||||
|
|
|
@ -9,7 +9,6 @@ module Command.Copy where
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
import Utility
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "copy" paramPaths seek
|
command = [repoCommand "copy" paramPaths seek
|
||||||
|
@ -20,9 +19,7 @@ seek = [withNumCopies start]
|
||||||
|
|
||||||
-- A copy is just a move that does not delete the source file.
|
-- A copy is just a move that does not delete the source file.
|
||||||
-- However, --auto mode avoids unnecessary copies.
|
-- However, --auto mode avoids unnecessary copies.
|
||||||
start :: CommandStartAttrFile
|
start :: FilePath -> Maybe Int -> CommandStart
|
||||||
start (file, attr) = isAnnexed file $ \(key, _) ->
|
start file numcopies = isAnnexed file $ \(key, _) ->
|
||||||
autoCopies key (<) numcopies $
|
autoCopies key (<) numcopies $
|
||||||
Command.Move.start False file
|
Command.Move.start False file
|
||||||
where
|
|
||||||
numcopies = readMaybe attr
|
|
||||||
|
|
|
@ -14,7 +14,6 @@ import LocationLog
|
||||||
import Types
|
import Types
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
import Messages
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
import Utility.Conditional
|
||||||
import Trust
|
import Trust
|
||||||
import Config
|
import Config
|
||||||
|
@ -28,16 +27,14 @@ seek = [withNumCopies start]
|
||||||
|
|
||||||
{- Indicates a file's content is not wanted anymore, and should be removed
|
{- Indicates a file's content is not wanted anymore, and should be removed
|
||||||
- if it's safe to do so. -}
|
- if it's safe to do so. -}
|
||||||
start :: CommandStartAttrFile
|
start :: FilePath -> Maybe Int -> CommandStart
|
||||||
start (file, attr) = isAnnexed file $ \(key, _) -> do
|
start file numcopies = isAnnexed file $ \(key, _) -> do
|
||||||
present <- inAnnex key
|
present <- inAnnex key
|
||||||
if present
|
if present
|
||||||
then autoCopies key (>) numcopies $ do
|
then autoCopies key (>) numcopies $ do
|
||||||
showStart "drop" file
|
showStart "drop" file
|
||||||
next $ perform key numcopies
|
next $ perform key numcopies
|
||||||
else stop
|
else stop
|
||||||
where
|
|
||||||
numcopies = readMaybe attr
|
|
||||||
|
|
||||||
perform :: Key -> Maybe Int -> CommandPerform
|
perform :: Key -> Maybe Int -> CommandPerform
|
||||||
perform key numcopies = do
|
perform key numcopies = do
|
||||||
|
|
|
@ -20,7 +20,6 @@ import qualified Types.Key
|
||||||
import UUID
|
import UUID
|
||||||
import Types
|
import Types
|
||||||
import Messages
|
import Messages
|
||||||
import Utility
|
|
||||||
import Content
|
import Content
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Locations
|
import Locations
|
||||||
|
@ -35,10 +34,10 @@ command = [repoCommand "fsck" paramPaths seek "check for problems"]
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNumCopies start]
|
seek = [withNumCopies start]
|
||||||
|
|
||||||
start :: CommandStartAttrFile
|
start :: FilePath -> Maybe Int -> CommandStart
|
||||||
start (file, attr) = notBareRepo $ isAnnexed file $ \(key, backend) -> do
|
start file numcopies = notBareRepo $ isAnnexed file $ \(key, backend) -> do
|
||||||
showStart "fsck" file
|
showStart "fsck" file
|
||||||
next $ perform key file backend $ readMaybe attr
|
next $ perform key file backend numcopies
|
||||||
|
|
||||||
perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform
|
perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform
|
||||||
perform key file backend numcopies = do
|
perform key file backend numcopies = do
|
||||||
|
|
|
@ -13,7 +13,6 @@ import qualified Remote
|
||||||
import Types
|
import Types
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
import Messages
|
||||||
import Utility
|
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
@ -23,8 +22,8 @@ command = [repoCommand "get" paramPaths seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNumCopies start]
|
seek = [withNumCopies start]
|
||||||
|
|
||||||
start :: CommandStartAttrFile
|
start :: FilePath -> Maybe Int -> CommandStart
|
||||||
start (file, attr) = isAnnexed file $ \(key, _) -> do
|
start file numcopies = isAnnexed file $ \(key, _) -> do
|
||||||
inannex <- inAnnex key
|
inannex <- inAnnex key
|
||||||
if inannex
|
if inannex
|
||||||
then stop
|
then stop
|
||||||
|
@ -37,8 +36,6 @@ start (file, attr) = isAnnexed file $ \(key, _) -> do
|
||||||
-- get --from = copy --from
|
-- get --from = copy --from
|
||||||
src <- Remote.byName name
|
src <- Remote.byName name
|
||||||
next $ Command.Move.fromPerform src False key
|
next $ Command.Move.fromPerform src False key
|
||||||
where
|
|
||||||
numcopies = readMaybe attr
|
|
||||||
|
|
||||||
perform :: Key -> CommandPerform
|
perform :: Key -> CommandPerform
|
||||||
perform key = do
|
perform key = do
|
||||||
|
|
Loading…
Add table
Reference in a new issue