remove command type definitions
These were a mistake, they make the type signatures harder to read and less flexible. The CommandSeek, CommandStart, CommandPerform, and CommandCleanup types were a good idea, but composing them with the parameters expected is going too far.
This commit is contained in:
parent
456b45b9b3
commit
35145202d2
33 changed files with 55 additions and 63 deletions
39
Command.hs
39
Command.hs
|
@ -48,19 +48,8 @@ type CommandPerform = Annex (Maybe CommandCleanup)
|
||||||
{- 3. The cleanup stage is run only if the perform stage succeeds, and it
|
{- 3. The cleanup stage is run only if the perform stage succeeds, and it
|
||||||
- returns the overall success/fail of the command. -}
|
- returns the overall success/fail of the command. -}
|
||||||
type CommandCleanup = Annex Bool
|
type CommandCleanup = Annex Bool
|
||||||
{- Some helper functions are used to build up CommandSeek and CommandStart
|
|
||||||
- functions. -}
|
|
||||||
type CommandSeekStrings = CommandStartString -> CommandSeek
|
|
||||||
type CommandStartString = String -> CommandStart
|
|
||||||
type CommandSeekWords = CommandStartWords -> CommandSeek
|
|
||||||
type CommandStartWords = [String] -> CommandStart
|
|
||||||
type CommandSeekKeys = CommandStartKey -> CommandSeek
|
|
||||||
type CommandStartKey = Key -> CommandStart
|
|
||||||
type BackendFile = (FilePath, Maybe (Backend Annex))
|
type BackendFile = (FilePath, Maybe (Backend Annex))
|
||||||
type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek
|
|
||||||
type CommandStartBackendFile = BackendFile -> CommandStart
|
|
||||||
type CommandSeekNothing = CommandStart -> CommandSeek
|
|
||||||
type CommandStartNothing = CommandStart
|
|
||||||
|
|
||||||
data Command = Command {
|
data Command = Command {
|
||||||
cmdusesrepo :: Bool,
|
cmdusesrepo :: Bool,
|
||||||
|
@ -121,7 +110,7 @@ notBareRepo a = do
|
||||||
|
|
||||||
{- These functions find appropriate files or other things based on a
|
{- These functions find appropriate files or other things based on a
|
||||||
user's parameters, and run a specified action on them. -}
|
user's parameters, and run a specified action on them. -}
|
||||||
withFilesInGit :: CommandSeekStrings
|
withFilesInGit :: (String -> CommandStart) -> CommandSeek
|
||||||
withFilesInGit a params = do
|
withFilesInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- Annex.gitRepo
|
||||||
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
||||||
|
@ -138,13 +127,13 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
|
||||||
go (file, v) = do
|
go (file, v) = do
|
||||||
let numcopies = readMaybe v
|
let numcopies = readMaybe v
|
||||||
a file numcopies
|
a file numcopies
|
||||||
withBackendFilesInGit :: CommandSeekBackendFiles
|
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withBackendFilesInGit a params = do
|
withBackendFilesInGit 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
|
||||||
backendPairs a files'
|
backendPairs a files'
|
||||||
withFilesMissing :: CommandSeekStrings
|
withFilesMissing :: (String -> CommandStart) -> CommandSeek
|
||||||
withFilesMissing a params = do
|
withFilesMissing a params = do
|
||||||
files <- liftIO $ filterM missing params
|
files <- liftIO $ filterM missing params
|
||||||
liftM (map a) $ filterFiles files
|
liftM (map a) $ filterFiles files
|
||||||
|
@ -152,27 +141,27 @@ withFilesMissing a params = do
|
||||||
missing f = do
|
missing f = do
|
||||||
e <- doesFileExist f
|
e <- doesFileExist f
|
||||||
return $ not e
|
return $ not e
|
||||||
withFilesNotInGit :: CommandSeekBackendFiles
|
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withFilesNotInGit a params = do
|
withFilesNotInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- Annex.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
|
||||||
newfiles' <- filterFiles newfiles
|
newfiles' <- filterFiles newfiles
|
||||||
backendPairs a newfiles'
|
backendPairs a newfiles'
|
||||||
withWords :: CommandSeekWords
|
withWords :: ([String] -> CommandStart) -> CommandSeek
|
||||||
withWords a params = return [a params]
|
withWords a params = return [a params]
|
||||||
withStrings :: CommandSeekStrings
|
withStrings :: (String -> CommandStart) -> CommandSeek
|
||||||
withStrings a params = return $ map a params
|
withStrings a params = return $ map a params
|
||||||
withFilesToBeCommitted :: CommandSeekStrings
|
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
|
||||||
withFilesToBeCommitted a params = do
|
withFilesToBeCommitted a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- Annex.gitRepo
|
||||||
tocommit <- liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
|
tocommit <- liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
|
||||||
liftM (map a) $ filterFiles tocommit
|
liftM (map a) $ filterFiles tocommit
|
||||||
withFilesUnlocked :: CommandSeekBackendFiles
|
withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
|
withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
|
||||||
withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles
|
withFilesUnlockedToBeCommitted :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
|
withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
|
||||||
withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles
|
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 <- Annex.gitRepo
|
||||||
|
@ -181,15 +170,15 @@ withFilesUnlocked' typechanged a params = do
|
||||||
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
|
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
|
||||||
unlockedfiles' <- filterFiles unlockedfiles
|
unlockedfiles' <- filterFiles unlockedfiles
|
||||||
backendPairs a unlockedfiles'
|
backendPairs a unlockedfiles'
|
||||||
withKeys :: CommandSeekKeys
|
withKeys :: (Key -> CommandStart) -> CommandSeek
|
||||||
withKeys a params = return $ map (a . parse) params
|
withKeys a params = return $ map (a . parse) params
|
||||||
where
|
where
|
||||||
parse p = fromMaybe (error "bad key") $ readKey p
|
parse p = fromMaybe (error "bad key") $ readKey p
|
||||||
withNothing :: CommandSeekNothing
|
withNothing :: CommandStart -> CommandSeek
|
||||||
withNothing a [] = return [a]
|
withNothing a [] = return [a]
|
||||||
withNothing _ _ = error "This command takes no parameters."
|
withNothing _ _ = error "This command takes no parameters."
|
||||||
|
|
||||||
backendPairs :: CommandSeekBackendFiles
|
backendPairs :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
backendPairs a files = map a <$> Backend.chooseBackends files
|
backendPairs a files = map a <$> Backend.chooseBackends files
|
||||||
|
|
||||||
{- Filter out files those matching the exclude glob pattern,
|
{- Filter out files those matching the exclude glob pattern,
|
||||||
|
|
|
@ -38,14 +38,14 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
|
||||||
{- The add subcommand annexes a file, storing it in a backend, and then
|
{- The add subcommand annexes a file, storing it in a backend, and then
|
||||||
- moving it into the annex directory and setting up the symlink pointing
|
- moving it into the annex directory and setting up the symlink pointing
|
||||||
- to its content. -}
|
- to its content. -}
|
||||||
start :: CommandStartBackendFile
|
start :: BackendFile -> CommandStart
|
||||||
start pair@(file, _) = notAnnexed file $ do
|
start p@(file, _) = notAnnexed file $ do
|
||||||
s <- liftIO $ getSymbolicLinkStatus file
|
s <- liftIO $ getSymbolicLinkStatus file
|
||||||
if isSymbolicLink s || not (isRegularFile s)
|
if isSymbolicLink s || not (isRegularFile s)
|
||||||
then stop
|
then stop
|
||||||
else do
|
else do
|
||||||
showStart "add" file
|
showStart "add" file
|
||||||
next $ perform pair
|
next $ perform p
|
||||||
|
|
||||||
perform :: BackendFile -> CommandPerform
|
perform :: BackendFile -> CommandPerform
|
||||||
perform (file, backend) = do
|
perform (file, backend) = do
|
||||||
|
|
|
@ -34,7 +34,7 @@ command = [repoCommand "addurl" (paramRepeating $ paramUrl) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withStrings start]
|
seek = [withStrings start]
|
||||||
|
|
||||||
start :: CommandStartString
|
start :: String -> CommandStart
|
||||||
start s = do
|
start s = do
|
||||||
let u = parseURI s
|
let u = parseURI s
|
||||||
case u of
|
case u of
|
||||||
|
|
|
@ -20,7 +20,7 @@ command = [repoCommand "configlist" paramNothing seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
|
|
|
@ -19,7 +19,7 @@ command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withWords start]
|
seek = [withWords start]
|
||||||
|
|
||||||
start :: CommandStartWords
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
let (name, description) =
|
let (name, description) =
|
||||||
case ws of
|
case ws of
|
||||||
|
|
|
@ -21,7 +21,7 @@ command = [repoCommand "dropkey" (paramRepeating paramKey) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withKeys start]
|
seek = [withKeys start]
|
||||||
|
|
||||||
start :: CommandStartKey
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
present <- inAnnex key
|
present <- inAnnex key
|
||||||
force <- Annex.getState Annex.force
|
force <- Annex.getState Annex.force
|
||||||
|
|
|
@ -41,7 +41,7 @@ withUnusedMaps params = do
|
||||||
unusedtmp <- readUnusedLog "tmp"
|
unusedtmp <- readUnusedLog "tmp"
|
||||||
return $ map (start (unused, unusedbad, unusedtmp)) params
|
return $ map (start (unused, unusedbad, unusedtmp)) params
|
||||||
|
|
||||||
start :: (UnusedMap, UnusedMap, UnusedMap) -> CommandStartString
|
start :: (UnusedMap, UnusedMap, UnusedMap) -> FilePath -> CommandStart
|
||||||
start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
|
start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
|
||||||
[ (unused, perform)
|
[ (unused, perform)
|
||||||
, (unusedbad, performOther gitAnnexBadLocation)
|
, (unusedbad, performOther gitAnnexBadLocation)
|
||||||
|
|
|
@ -20,7 +20,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit start]
|
||||||
|
|
||||||
{- Output a list of files. -}
|
{- Output a list of files. -}
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file = isAnnexed file $ \(key, _) -> do
|
||||||
whenM (inAnnex key) $ liftIO $ putStrLn file
|
whenM (inAnnex key) $ liftIO $ putStrLn file
|
||||||
stop
|
stop
|
||||||
|
|
|
@ -26,7 +26,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit start]
|
||||||
|
|
||||||
{- Fixes the symlink to an annexed file. -}
|
{- Fixes the symlink to an annexed file. -}
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file = isAnnexed file $ \(key, _) -> do
|
||||||
link <- calcGitLink file key
|
link <- calcGitLink file key
|
||||||
l <- liftIO $ readSymbolicLink file
|
l <- liftIO $ readSymbolicLink file
|
||||||
|
|
|
@ -27,7 +27,7 @@ command = [repoCommand "fromkey" paramPath seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesMissing start]
|
seek = [withFilesMissing start]
|
||||||
|
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = notBareRepo $ do
|
start file = notBareRepo $ do
|
||||||
key <- cmdlineKey
|
key <- cmdlineKey
|
||||||
inbackend <- inAnnex key
|
inbackend <- inAnnex key
|
||||||
|
|
|
@ -12,6 +12,7 @@ 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
|
||||||
|
@ -20,7 +21,7 @@ command = [repoCommand "inannex" (paramRepeating paramKey) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withKeys start]
|
seek = [withKeys start]
|
||||||
|
|
||||||
start :: CommandStartKey
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
present <- inAnnex key
|
present <- inAnnex key
|
||||||
if present
|
if present
|
||||||
|
|
|
@ -20,7 +20,7 @@ command = [standaloneCommand "init" paramDesc seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withWords start]
|
seek = [withWords start]
|
||||||
|
|
||||||
start :: CommandStartWords
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
showStart "init" description
|
showStart "init" description
|
||||||
next $ perform description
|
next $ perform description
|
||||||
|
|
|
@ -30,7 +30,7 @@ command = [repoCommand "initremote"
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withWords start]
|
seek = [withWords start]
|
||||||
|
|
||||||
start :: CommandStartWords
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
when (null ws) needname
|
when (null ws) needname
|
||||||
|
|
||||||
|
|
|
@ -22,7 +22,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]
|
seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]
|
||||||
|
|
||||||
{- Undo unlock -}
|
{- Undo unlock -}
|
||||||
start :: CommandStartBackendFile
|
start :: BackendFile -> CommandStart
|
||||||
start (file, _) = do
|
start (file, _) = do
|
||||||
showStart "lock" file
|
showStart "lock" file
|
||||||
next $ perform file
|
next $ perform file
|
||||||
|
|
|
@ -34,7 +34,7 @@ command = [repoCommand "map" paramNothing seek "generate map of repositories"]
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
rs <- spider g
|
rs <- spider g
|
||||||
|
|
|
@ -18,7 +18,7 @@ command = [repoCommand "merge" paramNothing seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
showStart "merge" "."
|
showStart "merge" "."
|
||||||
next perform
|
next perform
|
||||||
|
|
|
@ -31,7 +31,7 @@ command = [repoCommand "migrate" paramPaths seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withBackendFilesInGit start]
|
seek = [withBackendFilesInGit start]
|
||||||
|
|
||||||
start :: CommandStartBackendFile
|
start :: BackendFile -> CommandStart
|
||||||
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
|
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
|
||||||
exists <- inAnnex key
|
exists <- inAnnex key
|
||||||
newbackend <- choosebackend b
|
newbackend <- choosebackend b
|
||||||
|
|
|
@ -31,7 +31,7 @@ seek = [withFilesInGit $ start True]
|
||||||
-
|
-
|
||||||
- This only operates on the cached file content; it does not involve
|
- This only operates on the cached file content; it does not involve
|
||||||
- moving data in the key-value backend. -}
|
- moving data in the key-value backend. -}
|
||||||
start :: Bool -> CommandStartString
|
start :: Bool -> FilePath -> CommandStart
|
||||||
start move file = do
|
start move file = do
|
||||||
noAuto
|
noAuto
|
||||||
to <- Annex.getState Annex.toremote
|
to <- Annex.getState Annex.toremote
|
||||||
|
@ -74,7 +74,7 @@ remoteHasKey remote key present = do
|
||||||
- A file's content can be moved even if there are insufficient copies to
|
- A file's content can be moved even if there are insufficient copies to
|
||||||
- allow it to be dropped.
|
- allow it to be dropped.
|
||||||
-}
|
-}
|
||||||
toStart :: Remote.Remote Annex -> Bool -> CommandStartString
|
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 <- Annex.gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
|
@ -124,7 +124,7 @@ toCleanup dest move key = do
|
||||||
- If the current repository already has the content, it is still removed
|
- If the current repository already has the content, it is still removed
|
||||||
- from the remote.
|
- from the remote.
|
||||||
-}
|
-}
|
||||||
fromStart :: Remote.Remote Annex -> Bool -> CommandStartString
|
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 <- Annex.gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
|
|
|
@ -20,8 +20,8 @@ seek :: [CommandSeek]
|
||||||
seek = [withFilesToBeCommitted Command.Fix.start,
|
seek = [withFilesToBeCommitted Command.Fix.start,
|
||||||
withFilesUnlockedToBeCommitted start]
|
withFilesUnlockedToBeCommitted start]
|
||||||
|
|
||||||
start :: CommandStartBackendFile
|
start :: BackendFile -> CommandStart
|
||||||
start pair = next $ perform pair
|
start p = next $ perform p
|
||||||
|
|
||||||
perform :: BackendFile -> CommandPerform
|
perform :: BackendFile -> CommandPerform
|
||||||
perform pair@(file, _) = do
|
perform pair@(file, _) = do
|
||||||
|
|
|
@ -15,6 +15,7 @@ import CmdLine
|
||||||
import Content
|
import Content
|
||||||
import Utility.RsyncFile
|
import Utility.RsyncFile
|
||||||
import Utility.Conditional
|
import Utility.Conditional
|
||||||
|
import Types
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "recvkey" paramKey seek
|
command = [repoCommand "recvkey" paramKey seek
|
||||||
|
@ -23,7 +24,7 @@ command = [repoCommand "recvkey" paramKey seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withKeys start]
|
seek = [withKeys start]
|
||||||
|
|
||||||
start :: CommandStartKey
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
whenM (inAnnex key) $ error "key is already present in annex"
|
whenM (inAnnex key) $ error "key is already present in annex"
|
||||||
|
|
||||||
|
|
|
@ -20,7 +20,7 @@ command = [repoCommand "semitrust" (paramRepeating paramRemote) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withWords start]
|
seek = [withWords start]
|
||||||
|
|
||||||
start :: CommandStartWords
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
let name = unwords ws
|
let name = unwords ws
|
||||||
showStart "semitrust" name
|
showStart "semitrust" name
|
||||||
|
|
|
@ -17,6 +17,7 @@ import Content
|
||||||
import Utility.RsyncFile
|
import Utility.RsyncFile
|
||||||
import Utility.Conditional
|
import Utility.Conditional
|
||||||
import Messages
|
import Messages
|
||||||
|
import Types
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "sendkey" paramKey seek
|
command = [repoCommand "sendkey" paramKey seek
|
||||||
|
@ -25,7 +26,7 @@ command = [repoCommand "sendkey" paramKey seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withKeys start]
|
seek = [withKeys start]
|
||||||
|
|
||||||
start :: CommandStartKey
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
let file = gitAnnexLocation g key
|
let file = gitAnnexLocation g key
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withStrings start]
|
seek = [withStrings start]
|
||||||
|
|
||||||
{- Sets cached content for a key. -}
|
{- Sets cached content for a key. -}
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = do
|
start file = do
|
||||||
showStart "setkey" file
|
showStart "setkey" file
|
||||||
next $ perform file
|
next $ perform file
|
||||||
|
|
|
@ -74,7 +74,7 @@ slowstats =
|
||||||
, backend_usage
|
, backend_usage
|
||||||
]
|
]
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
fast <- Annex.getState Annex.fast
|
fast <- Annex.getState Annex.fast
|
||||||
let todo = if fast then faststats else faststats ++ slowstats
|
let todo = if fast then faststats else faststats ++ slowstats
|
||||||
|
|
|
@ -20,7 +20,7 @@ command = [repoCommand "trust" (paramRepeating paramRemote) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withWords start]
|
seek = [withWords start]
|
||||||
|
|
||||||
start :: CommandStartWords
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
let name = unwords ws
|
let name = unwords ws
|
||||||
showStart "trust" name
|
showStart "trust" name
|
||||||
|
|
|
@ -33,7 +33,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit start]
|
||||||
|
|
||||||
{- The unannex subcommand undoes an add. -}
|
{- The unannex subcommand undoes an add. -}
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file = isAnnexed file $ \(key, _) -> do
|
||||||
ishere <- inAnnex key
|
ishere <- inAnnex key
|
||||||
if ishere
|
if ishere
|
||||||
|
|
|
@ -28,7 +28,7 @@ command = [repoCommand "uninit" paramPaths seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit startUnannex, withNothing start]
|
seek = [withFilesInGit startUnannex, withNothing start]
|
||||||
|
|
||||||
startUnannex :: CommandStartString
|
startUnannex :: FilePath -> CommandStart
|
||||||
startUnannex file = do
|
startUnannex file = do
|
||||||
-- Force fast mode before running unannex. This way, if multiple
|
-- Force fast mode before running unannex. This way, if multiple
|
||||||
-- files link to a key, it will be left in the annex and hardlinked
|
-- files link to a key, it will be left in the annex and hardlinked
|
||||||
|
@ -36,7 +36,7 @@ startUnannex file = do
|
||||||
Annex.changeState $ \s -> s { Annex.fast = True }
|
Annex.changeState $ \s -> s { Annex.fast = True }
|
||||||
Command.Unannex.start file
|
Command.Unannex.start file
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = next perform
|
start = next perform
|
||||||
|
|
||||||
perform :: CommandPerform
|
perform :: CommandPerform
|
||||||
|
|
|
@ -31,7 +31,7 @@ seek = [withFilesInGit start]
|
||||||
|
|
||||||
{- The unlock subcommand replaces the symlink with a copy of the file's
|
{- The unlock subcommand replaces the symlink with a copy of the file's
|
||||||
- content. -}
|
- content. -}
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file = isAnnexed file $ \(key, _) -> do
|
||||||
showStart "unlock" file
|
showStart "unlock" file
|
||||||
next $ perform file key
|
next $ perform file key
|
||||||
|
|
|
@ -20,7 +20,7 @@ command = [repoCommand "untrust" (paramRepeating paramRemote) seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withWords start]
|
seek = [withWords start]
|
||||||
|
|
||||||
start :: CommandStartWords
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
let name = unwords ws
|
let name = unwords ws
|
||||||
showStart "untrust" name
|
showStart "untrust" name
|
||||||
|
|
|
@ -37,7 +37,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withNothing start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
{- Finds unused content in the annex. -}
|
{- Finds unused content in the annex. -}
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = notBareRepo $ do
|
start = notBareRepo $ do
|
||||||
from <- Annex.getState Annex.fromremote
|
from <- Annex.getState Annex.fromremote
|
||||||
let (name, action) = case from of
|
let (name, action) = case from of
|
||||||
|
|
|
@ -19,7 +19,7 @@ command = [standaloneCommand "upgrade" paramNothing seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
showStart "upgrade" "."
|
showStart "upgrade" "."
|
||||||
r <- upgrade
|
r <- upgrade
|
||||||
|
|
|
@ -21,7 +21,7 @@ command = [standaloneCommand "version" paramNothing seek "show version info"]
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStartNothing
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
liftIO $ putStrLn $ "git-annex version: " ++ SysConfig.packageversion
|
liftIO $ putStrLn $ "git-annex version: " ++ SysConfig.packageversion
|
||||||
v <- getVersion
|
v <- getVersion
|
||||||
|
|
|
@ -23,7 +23,7 @@ command = [repoCommand "whereis" paramPaths seek
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit start]
|
||||||
|
|
||||||
start :: CommandStartString
|
start :: FilePath -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file = isAnnexed file $ \(key, _) -> do
|
||||||
showStart "whereis" file
|
showStart "whereis" file
|
||||||
next $ perform key
|
next $ perform key
|
||||||
|
|
Loading…
Reference in a new issue