clean up check selection code
This new approach allows filtering out checks from the default set that are not appropriate for a command, rather than having to list every check that is appropriate. It also reduces some boilerplate. Haskell does not define Eq for functions, so I had to go a long way around with each check having a unique id. Meh.
This commit is contained in:
parent
0d92aca1aa
commit
f97c783283
40 changed files with 154 additions and 143 deletions
|
@ -18,8 +18,8 @@ import Annex.Content
|
|||
import Utility.Touch
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "add" paramPaths defaultChecks seek "add files to annex"]
|
||||
def :: [Command]
|
||||
def = [command "add" paramPaths seek "add files to annex"]
|
||||
|
||||
{- Add acts on both files not checked into git yet, and unlocked files. -}
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -19,9 +19,8 @@ import qualified Backend.URL
|
|||
import Annex.Content
|
||||
import Logs.Web
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "addurl" (paramRepeating paramUrl) defaultChecks seek
|
||||
"add urls to annex"]
|
||||
def :: [Command]
|
||||
def = [command "addurl" (paramRepeating paramUrl) seek "add urls to annex"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withStrings start]
|
||||
|
|
|
@ -11,9 +11,9 @@ import Common.Annex
|
|||
import Command
|
||||
import Annex.UUID
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "configlist" paramNothing defaultChecks seek
|
||||
"outputs relevant git configuration"]
|
||||
def :: [Command]
|
||||
def = [command "configlist" paramNothing seek
|
||||
"outputs relevant git configuration"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNothing start]
|
||||
|
|
|
@ -10,8 +10,9 @@ module Command.Copy where
|
|||
import Command
|
||||
import qualified Command.Move
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "copy" paramPaths needsRepo seek
|
||||
def :: [Command]
|
||||
def = [dontCheck toOpt $ dontCheck fromOpt $
|
||||
command "copy" paramPaths seek
|
||||
"copy content of files to/from another repository"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import qualified Remote
|
||||
import Logs.UUID
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "describe" (paramPair paramRemote paramDesc) defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "describe" (paramPair paramRemote paramDesc) seek
|
||||
"change description of a repository"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -17,8 +17,8 @@ import Logs.Trust
|
|||
import Annex.Content
|
||||
import Config
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "drop" paramPaths (noTo >> needsRepo) seek
|
||||
def :: [Command]
|
||||
def = [dontCheck fromOpt $ command "drop" paramPaths seek
|
||||
"indicate content of files not currently wanted"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -13,8 +13,8 @@ import qualified Annex
|
|||
import Logs.Location
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "dropkey" (paramRepeating paramKey) defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "dropkey" (paramRepeating paramKey) seek
|
||||
"drops annexed content for specified keys"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -19,8 +19,8 @@ import Types.Key
|
|||
|
||||
type UnusedMap = M.Map String Key
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "dropunused" (paramRepeating paramNumber) (noTo >> needsRepo)
|
||||
def :: [Command]
|
||||
def = [dontCheck fromOpt $ command "dropunused" (paramRepeating paramNumber)
|
||||
seek "drop unused file content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import Annex.Content
|
||||
import Limit
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "find" paramPaths defaultChecks seek "lists available files"]
|
||||
def :: [Command]
|
||||
def = [command "find" paramPaths seek "lists available files"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit start]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import qualified Annex.Queue
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "fix" paramPaths defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "fix" paramPaths seek
|
||||
"fix up symlinks to point to annexed content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -13,9 +13,8 @@ import qualified Annex.Queue
|
|||
import Annex.Content
|
||||
import Types.Key
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "fromkey" paramPath defaultChecks seek
|
||||
"adds a file using a specific key"]
|
||||
def :: [Command]
|
||||
def = [command "fromkey" paramPath seek "adds a file using a specific key"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withFilesMissing start]
|
||||
|
|
|
@ -20,8 +20,8 @@ import Utility.DataUnits
|
|||
import Utility.FileMode
|
||||
import Config
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "fsck" paramPaths defaultChecks seek "check for problems"]
|
||||
def :: [Command]
|
||||
def = [command "fsck" paramPaths seek "check for problems"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNumCopies start]
|
||||
|
|
|
@ -14,9 +14,9 @@ import qualified Remote
|
|||
import Annex.Content
|
||||
import qualified Command.Move
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "get" paramPaths (noTo >> needsRepo) seek
|
||||
"make content of annexed files available"]
|
||||
def :: [Command]
|
||||
def = [dontCheck fromOpt $ command "get" paramPaths seek
|
||||
"make content of annexed files available"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNumCopies start]
|
||||
|
|
|
@ -11,9 +11,9 @@ import Common.Annex
|
|||
import Command
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "inannex" (paramRepeating paramKey) defaultChecks seek
|
||||
"checks if keys are present in the annex"]
|
||||
def :: [Command]
|
||||
def = [command "inannex" (paramRepeating paramKey) seek
|
||||
"checks if keys are present in the annex"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withKeys start]
|
||||
|
|
|
@ -13,8 +13,9 @@ import Annex.UUID
|
|||
import Logs.UUID
|
||||
import Init
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "init" paramDesc noChecks seek "initialize git-annex"]
|
||||
def :: [Command]
|
||||
def = [dontCheck repoExists $
|
||||
command "init" paramDesc seek "initialize git-annex"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withWords start]
|
||||
|
|
|
@ -16,10 +16,10 @@ import qualified Logs.Remote
|
|||
import qualified Types.Remote as R
|
||||
import Annex.UUID
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "initremote"
|
||||
(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
|
||||
defaultChecks seek "sets up a special (non-git) remote"]
|
||||
def :: [Command]
|
||||
def = [command "initremote"
|
||||
(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
|
||||
seek "sets up a special (non-git) remote"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withWords start]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import qualified Annex.Queue
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "lock" paramPaths defaultChecks seek "undo unlock command"]
|
||||
def :: [Command]
|
||||
def = [command "lock" paramPaths seek "undo unlock command"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]
|
||||
|
|
|
@ -22,9 +22,9 @@ import qualified Utility.Dot as Dot
|
|||
-- a link from the first repository to the second (its remote)
|
||||
data Link = Link Git.Repo Git.Repo
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "map" paramNothing noChecks seek
|
||||
"generate map of repositories"]
|
||||
def :: [Command]
|
||||
def = [dontCheck repoExists $
|
||||
command "map" paramNothing seek "generate map of repositories"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNothing start]
|
||||
|
|
|
@ -11,8 +11,8 @@ import Common.Annex
|
|||
import Command
|
||||
import qualified Annex.Branch
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "merge" paramNothing defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "merge" paramNothing seek
|
||||
"auto-merge remote changes into git-annex branch"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -16,9 +16,8 @@ import qualified Command.Add
|
|||
import Backend
|
||||
import Logs.Web
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "migrate" paramPaths defaultChecks seek
|
||||
"switch data to different backend"]
|
||||
def :: [Command]
|
||||
def = [command "migrate" paramPaths seek "switch data to different backend"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withBackendFilesInGit start]
|
||||
|
|
|
@ -15,8 +15,9 @@ import Annex.Content
|
|||
import qualified Remote
|
||||
import Annex.UUID
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "move" paramPaths needsRepo seek
|
||||
def :: [Command]
|
||||
def = [dontCheck toOpt $ dontCheck fromOpt $
|
||||
command "move" paramPaths seek
|
||||
"move content of files to/from another repository"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,9 +12,8 @@ import qualified Command.Add
|
|||
import qualified Command.Fix
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "pre-commit" paramPaths defaultChecks seek
|
||||
"run by git pre-commit hook"]
|
||||
def :: [Command]
|
||||
def = [command "pre-commit" paramPaths seek "run by git pre-commit hook"]
|
||||
|
||||
{- The pre-commit hook needs to fix symlinks to all files being committed.
|
||||
- And, it needs to inject unlocked files into the annex. -}
|
||||
|
|
|
@ -13,8 +13,8 @@ import CmdLine
|
|||
import Annex.Content
|
||||
import Utility.RsyncFile
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "recvkey" paramKey defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "recvkey" paramKey seek
|
||||
"runs rsync in server mode to receive content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import qualified Remote
|
||||
import Logs.Trust
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "semitrust" (paramRepeating paramRemote) defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "semitrust" (paramRepeating paramRemote) seek
|
||||
"return repository to default trust level"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import Annex.Content
|
||||
import Utility.RsyncFile
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "sendkey" paramKey defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "sendkey" paramKey seek
|
||||
"runs rsync in server mode to send content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import Logs.Location
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "setkey" paramPath defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "setkey" paramPath seek
|
||||
"sets annexed content for a key using a temp file"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -38,8 +38,8 @@ data StatInfo = StatInfo
|
|||
-- a state monad for running Stats in
|
||||
type StatState = StateT StatInfo Annex
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "status" paramNothing defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "status" paramNothing seek
|
||||
"shows status information about the annex"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,9 +12,8 @@ import Command
|
|||
import qualified Remote
|
||||
import Logs.Trust
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "trust" (paramRepeating paramRemote) defaultChecks seek
|
||||
"trust a repository"]
|
||||
def :: [Command]
|
||||
def = [command "trust" (paramRepeating paramRemote) seek "trust a repository"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withWords start]
|
||||
|
|
|
@ -17,9 +17,8 @@ import Annex.Content
|
|||
import qualified Git
|
||||
import qualified Git.LsFiles as LsFiles
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "unannex" paramPaths defaultChecks seek
|
||||
"undo accidential add command"]
|
||||
def :: [Command]
|
||||
def = [command "unannex" paramPaths seek "undo accidential add command"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit start]
|
||||
|
|
|
@ -18,8 +18,8 @@ import Init
|
|||
import qualified Annex.Branch
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "uninit" paramPaths (check >> defaultChecks) seek
|
||||
def :: [Command]
|
||||
def = [addCheck check $ command "uninit" paramPaths seek
|
||||
"de-initialize git-annex and clean out repository"]
|
||||
|
||||
check :: Annex ()
|
||||
|
|
|
@ -13,13 +13,13 @@ import Annex.Content
|
|||
import Utility.CopyFile
|
||||
import Utility.FileMode
|
||||
|
||||
command :: [Command]
|
||||
command =
|
||||
def :: [Command]
|
||||
def =
|
||||
[ c "unlock" "unlock files for modification"
|
||||
, c "edit" "same as unlock"
|
||||
]
|
||||
where
|
||||
c n = Command n paramPaths defaultChecks seek
|
||||
c n = command n paramPaths seek
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit start]
|
||||
|
|
|
@ -12,8 +12,8 @@ import Command
|
|||
import qualified Remote
|
||||
import Logs.Trust
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "untrust" (paramRepeating paramRemote) defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "untrust" (paramRepeating paramRemote) seek
|
||||
"do not trust a repository"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -27,8 +27,8 @@ import qualified Remote
|
|||
import qualified Annex.Branch
|
||||
import Annex.CatFile
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "unused" paramNothing (noTo >> needsRepo) seek
|
||||
def :: [Command]
|
||||
def = [dontCheck fromOpt $ command "unused" paramNothing seek
|
||||
"look for unused file content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
|
@ -12,9 +12,9 @@ import Command
|
|||
import Upgrade
|
||||
import Annex.Version
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "upgrade" paramNothing noChecks seek
|
||||
"upgrade repository layout"]
|
||||
def :: [Command]
|
||||
def = [dontCheck repoExists $ -- because an old version may not seem to exist
|
||||
command "upgrade" paramNothing seek "upgrade repository layout"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNothing start]
|
||||
|
|
|
@ -12,8 +12,9 @@ import Command
|
|||
import qualified Build.SysConfig as SysConfig
|
||||
import Annex.Version
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "version" paramNothing noChecks seek "show version info"]
|
||||
def :: [Command]
|
||||
def = [dontCheck repoExists $
|
||||
command "version" paramNothing seek "show version info"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNothing start]
|
||||
|
|
|
@ -13,8 +13,8 @@ import Command
|
|||
import Remote
|
||||
import Logs.Trust
|
||||
|
||||
command :: [Command]
|
||||
command = [Command "whereis" paramPaths defaultChecks seek
|
||||
def :: [Command]
|
||||
def = [command "whereis" paramPaths seek
|
||||
"lists repositories that have file content"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue