diff options
| author |  Joey Hess <joey@kitenet.net> | 2014-10-22 17:14:38 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-10-22 17:14:38 -0400 |
| commit | 33e7dd2e0b756270cb51d1ed574cbe4b8173c7cd (patch) | |
| tree | 0e9ff04c04c33cd1ba45171983d1b9f4d92cac60 /Command | |
| parent | 2d7b57270e628994483495159d2be715c8f9531b (diff) | |
| parent | 49475bb89542e92c6f466425f29cd0640a8e80f4 (diff) | |
Merge branch 'master' into s3-aws
Conflicts:
Remote/S3.hs
Diffstat (limited to 'Command')
84 files changed, 389 insertions, 292 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index e2b6d04fe..519dad6e4 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -34,8 +34,8 @@ import Utility.Tmp import Control.Exception (IOException) -def :: [Command] -def = [notBareRepo $ withOptions [includeDotFilesOption] $ +cmd :: [Command] +cmd = [notBareRepo $ withOptions [includeDotFilesOption] $ command "add" paramPaths seek SectionCommon "add files to annex"] @@ -125,7 +125,7 @@ lockDown' file = ifM crippledFileSystem - This is not done in direct mode, because files there need to - remain writable at all times. -} - go tmp = do + go tmp = do unlessM isDirect $ freezeContent file withTSDelta $ \delta -> liftIO $ do @@ -134,7 +134,7 @@ lockDown' file = ifM crippledFileSystem hClose h nukeFile tmpfile withhardlink delta tmpfile `catchIO` const (nohardlink delta) - nohardlink delta = do + nohardlink delta = do cache <- genInodeCache file delta return KeySource { keyFilename = file @@ -177,14 +177,14 @@ ingest (Just source) = withTSDelta $ \delta -> do (undo (keyFilename source) key) maybe noop (genMetaData key (keyFilename source)) ms liftIO $ nukeFile $ keyFilename source - return $ (Just key, mcache) + return (Just key, mcache) goindirect _ _ _ = failure "failed to generate a key" godirect (Just (key, _)) (Just cache) ms = do addInodeCache key cache maybe noop (genMetaData key (keyFilename source)) ms finishIngestDirect key source - return $ (Just key, Just cache) + return (Just key, Just cache) godirect _ _ _ = failure "failed to generate a key" failure msg = do @@ -207,7 +207,7 @@ finishIngestDirect key source = do perform :: FilePath -> CommandPerform perform file = lockDown file >>= ingest >>= go where - go (Just key, cache) = next $ cleanup file key cache True + go (Just key, cache) = next $ cleanup file key cache True go (Nothing, _) = stop {- On error, put the file back so it doesn't seem to have vanished. diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 91427e819..69dbefc17 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -14,8 +14,8 @@ import qualified Command.Add import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Types.Key -def :: [Command] -def = [notDirect $ command "addunused" (paramRepeating paramNumRange) +cmd :: [Command] +cmd = [notDirect $ command "addunused" (paramRepeating paramNumRange) seek SectionMaintenance "add back unused files"] seek :: CommandSeek diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index c21ce928f..81da67639 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -32,8 +32,8 @@ import Annex.Quvi import qualified Utility.Quvi as Quvi #endif -def :: [Command] -def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ +cmd :: [Command] +cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ command "addurl" (paramRepeating paramUrl) seek SectionCommon "add urls to annex"] @@ -56,7 +56,7 @@ seek ps = do start :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s where - (s', downloader) = getDownloader s + (s', downloader) = getDownloader s bad = fromMaybe (error $ "bad url " ++ s') $ parseURI $ escapeURIString isUnescapedInURI s' choosefile = flip fromMaybe optfile @@ -95,8 +95,8 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl where - quviurl = setDownloader pageurl QuviDownloader - addurl key = next $ cleanup quviurl file key Nothing + quviurl = setDownloader pageurl QuviDownloader + addurl key = next $ cleanup quviurl file key Nothing geturl = next $ isJust <$> addUrlFileQuvi relaxed quviurl videourl file #endif @@ -189,7 +189,7 @@ download url file = do , return Nothing ) where - runtransfer dummykey tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ + runtransfer dummykey tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [url] tmp diff --git a/Command/Assistant.hs b/Command/Assistant.hs index 8316a9948..8341a5694 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -18,8 +18,8 @@ import Assistant.Install import System.Environment -def :: [Command] -def = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $ +cmd :: [Command] +cmd = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $ notBareRepo $ command "assistant" paramNothing seek SectionCommon "automatically handle changes"] diff --git a/Command/Commit.hs b/Command/Commit.hs index f5f13d248..1f2478ee5 100644 --- a/Command/Commit.hs +++ b/Command/Commit.hs @@ -12,8 +12,8 @@ import Command import qualified Annex.Branch import qualified Git -def :: [Command] -def = [command "commit" paramNothing seek +cmd :: [Command] +cmd = [command "commit" paramNothing seek SectionPlumbing "commits any staged changes to the git-annex branch"] seek :: CommandSeek diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 219685c21..7d8f1ea70 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -15,8 +15,8 @@ import qualified Annex.Branch import qualified Git.Config import Remote.GCrypt (coreGCryptId) -def :: [Command] -def = [noCommit $ command "configlist" paramNothing seek +cmd :: [Command] +cmd = [noCommit $ command "configlist" paramNothing seek SectionPlumbing "outputs relevant git configuration"] seek :: CommandSeek @@ -29,7 +29,7 @@ start = do showConfig coreGCryptId =<< fromRepo (Git.Config.get coreGCryptId "") stop where - showConfig k v = liftIO $ putStrLn $ k ++ "=" ++ v + showConfig k v = liftIO $ putStrLn $ k ++ "=" ++ v {- The repository may not yet have a UUID; automatically initialize it - when there's a git-annex branch available. -} diff --git a/Command/Copy.hs b/Command/Copy.hs index ae254aae2..23fa83a35 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -14,8 +14,8 @@ import qualified Remote import Annex.Wanted import Config.NumCopies -def :: [Command] -def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek +cmd :: [Command] +cmd = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek SectionCommon "copy content of files to/from another repository"] seek :: CommandSeek @@ -23,7 +23,7 @@ seek ps = do to <- getOptionField toOption Remote.byNameWithUUID from <- getOptionField fromOption Remote.byNameWithUUID withKeyOptions - (Command.Move.startKey to from False) + (Command.Move.startKey to from False) (withFilesInGit $ whenAnnexed $ start to from) ps diff --git a/Command/Dead.hs b/Command/Dead.hs index f9e5c2e27..c19812b73 100644 --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -11,8 +11,8 @@ import Command import Types.TrustLevel import Command.Trust (trustCommand) -def :: [Command] -def = [command "dead" (paramRepeating paramRemote) seek +cmd :: [Command] +cmd = [command "dead" (paramRepeating paramRemote) seek SectionSetup "hide a lost repository"] seek :: CommandSeek diff --git a/Command/Describe.hs b/Command/Describe.hs index 601b3fcc9..39a762c06 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -12,8 +12,8 @@ import Command import qualified Remote import Logs.UUID -def :: [Command] -def = [command "describe" (paramPair paramRemote paramDesc) seek +cmd :: [Command] +cmd = [command "describe" (paramPair paramRemote paramDesc) seek SectionSetup "change description of a repository"] seek :: CommandSeek diff --git a/Command/Direct.hs b/Command/Direct.hs index c64ef6e56..3493e103d 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -15,8 +15,8 @@ import qualified Git.Branch import Config import Annex.Direct -def :: [Command] -def = [notBareRepo $ noDaemonRunning $ +cmd :: [Command] +cmd = [notBareRepo $ noDaemonRunning $ command "direct" paramNothing seek SectionSetup "switch repository to direct mode"] diff --git a/Command/Drop.hs b/Command/Drop.hs index cf63d2bc7..9460c47b4 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -22,8 +22,8 @@ import Annex.Notification import qualified Data.Set as S -def :: [Command] -def = [withOptions [dropFromOption] $ command "drop" paramPaths seek +cmd :: [Command] +cmd = [withOptions [dropFromOption] $ command "drop" paramPaths seek SectionCommon "indicate content of files not currently wanted"] dropFromOption :: Option diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 8ca41bdb6..ca20a1a64 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -13,8 +13,8 @@ import qualified Annex import Logs.Location import Annex.Content -def :: [Command] -def = [noCommit $ command "dropkey" (paramRepeating paramKey) seek +cmd :: [Command] +cmd = [noCommit $ command "dropkey" (paramRepeating paramKey) seek SectionPlumbing "drops annexed content for specified keys"] seek :: CommandSeek diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index ce49795c9..b9bc2bef6 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -16,8 +16,8 @@ import qualified Git import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Config.NumCopies -def :: [Command] -def = [withOptions [Command.Drop.dropFromOption] $ +cmd :: [Command] +cmd = [withOptions [Command.Drop.dropFromOption] $ command "dropunused" (paramRepeating paramNumRange) seek SectionMaintenance "drop unused file content"] diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index 42ab43374..909f1ea2f 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -15,8 +15,8 @@ import qualified Command.InitRemote as InitRemote import qualified Data.Map as M -def :: [Command] -def = [command "enableremote" +cmd :: [Command] +cmd = [command "enableremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) seek SectionSetup "enables use of an existing special remote"] @@ -29,7 +29,7 @@ start (name:ws) = go =<< InitRemote.findExisting name where config = Logs.Remote.keyValToConfig ws - go Nothing = unknownNameError "Unknown special remote name." + go Nothing = unknownNameError "Unknown special remote name." go (Just (u, c)) = do let fullconfig = config `M.union` c t <- InitRemote.findType fullconfig diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index dd2bec507..94f84c5b5 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -13,8 +13,8 @@ import qualified Utility.Format import Command.Find (formatOption, getFormat, showFormatted, keyVars) import Types.Key -def :: [Command] -def = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $ +cmd :: [Command] +cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $ command "examinekey" (paramRepeating paramKey) seek SectionPlumbing "prints information from a key"] diff --git a/Command/Find.hs b/Command/Find.hs index c800933f9..5ca2191db 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -18,8 +18,8 @@ import qualified Utility.Format import Utility.DataUnits import Types.Key -def :: [Command] -def = [mkCommand $ command "find" paramPaths seek SectionQuery "lists available files"] +cmd :: [Command] +cmd = [mkCommand $ command "find" paramPaths seek SectionQuery "lists available files"] mkCommand :: Command -> Command mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption] diff --git a/Command/FindRef.hs b/Command/FindRef.hs index 26007f7c0..a552e64e4 100644 --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -10,8 +10,8 @@ module Command.FindRef where import Command import qualified Command.Find as Find -def :: [Command] -def = [Find.mkCommand $ command "findref" paramRef seek SectionPlumbing +cmd :: [Command] +cmd = [Find.mkCommand $ command "findref" paramRef seek SectionPlumbing "lists files in a git ref"] seek :: CommandSeek diff --git a/Command/Fix.hs b/Command/Fix.hs index 0c2bf5942..774ef8583 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -18,8 +18,8 @@ import Utility.Touch #endif #endif -def :: [Command] -def = [notDirect $ noCommit $ command "fix" paramPaths seek +cmd :: [Command] +cmd = [notDirect $ noCommit $ command "fix" paramPaths seek SectionMaintenance "fix up symlinks to point to annexed content"] seek :: CommandSeek diff --git a/Command/Forget.hs b/Command/Forget.hs index dbcce6cc3..3ea64d5c9 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -15,8 +15,8 @@ import qualified Annex import Data.Time.Clock.POSIX -def :: [Command] -def = [withOptions forgetOptions $ command "forget" paramNothing seek +cmd :: [Command] +cmd = [withOptions forgetOptions $ command "forget" paramNothing seek SectionMaintenance "prune git-annex branch history"] forgetOptions :: [Option] diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 7eb62fa4e..3b20749fe 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -13,8 +13,8 @@ import qualified Annex.Queue import Annex.Content import Types.Key -def :: [Command] -def = [notDirect $ notBareRepo $ +cmd :: [Command] +cmd = [notDirect $ notBareRepo $ command "fromkey" (paramPair paramKey paramPath) seek SectionPlumbing "adds a file using a specific key"] diff --git a/Command/Fsck.hs b/Command/Fsck.hs index a17662d62..46c1620f1 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -39,8 +39,8 @@ import Data.Time import System.Posix.Types (EpochTime) import System.Locale -def :: [Command] -def = [withOptions fsckOptions $ command "fsck" paramPaths seek +cmd :: [Command] +cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek SectionMaintenance "check for problems"] fsckFromOption :: Option @@ -282,7 +282,7 @@ verifyDirectMode key file = do - the key's metadata, if available. - - Not checked in direct mode, because files can be changed directly. - -} + -} checkKeySize :: Key -> Annex Bool checkKeySize key = ifM isDirect ( return True @@ -329,7 +329,7 @@ checkKeySizeOr bad key file = case Types.Key.keySize key of checkBackend :: Backend -> Key -> Maybe FilePath -> Annex Bool checkBackend backend key mfile = go =<< isDirect where - go False = do + go False = do content <- calcRepo $ gitAnnexLocation key checkBackendOr badContent backend key content go True = maybe nocheck checkdirect mfile diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index 7075aeddc..87bee963f 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -20,8 +20,8 @@ import System.Random (getStdRandom, random, randomR) import Test.QuickCheck import Control.Concurrent -def :: [Command] -def = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting +cmd :: [Command] +cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting "generates fuzz test files"] seek :: CommandSeek @@ -47,7 +47,7 @@ guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $ , "Refusing to run fuzz tests, since " ++ keyname ++ " is not set!" ] where - key = annexConfig "eat-my-repository" + key = annexConfig "eat-my-repository" (ConfigKey keyname) = key @@ -257,7 +257,7 @@ existingDir = do newFile :: IO (Maybe FuzzFile) newFile = go (100 :: Int) where - go 0 = return Nothing + go 0 = return Nothing go n = do f <- genFuzzFile ifM (doesnotexist (toFilePath f)) @@ -268,7 +268,7 @@ newFile = go (100 :: Int) newDir :: FilePath -> IO (Maybe FuzzDir) newDir parent = go (100 :: Int) where - go 0 = return Nothing + go 0 = return Nothing go n = do (FuzzDir d) <- genFuzzDir ifM (doesnotexist (parent </> d)) diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs index 2448467fd..77aadb22d 100644 --- a/Command/GCryptSetup.hs +++ b/Command/GCryptSetup.hs @@ -13,8 +13,8 @@ import Annex.UUID import qualified Remote.GCrypt import qualified Git -def :: [Command] -def = [dontCheck repoExists $ noCommit $ +cmd :: [Command] +cmd = [dontCheck repoExists $ noCommit $ command "gcryptsetup" paramValue seek SectionPlumbing "sets up gcrypt repository"] @@ -30,7 +30,7 @@ start gcryptid = next $ next $ do g <- gitRepo gu <- Remote.GCrypt.getGCryptUUID True g let newgu = genUUIDInNameSpace gCryptNameSpace gcryptid - if gu == Nothing || gu == Just newgu + if isNothing gu || gu == Just newgu then if Git.repoIsLocalBare g then do void $ Remote.GCrypt.setupRepo gcryptid g diff --git a/Command/Get.hs b/Command/Get.hs index d0be20018..a49c7c409 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -16,8 +16,8 @@ import Config.NumCopies import Annex.Wanted import qualified Command.Move -def :: [Command] -def = [withOptions getOptions $ command "get" paramPaths seek +cmd :: [Command] +cmd = [withOptions getOptions $ command "get" paramPaths seek SectionCommon "make content of annexed files available"] getOptions :: [Option] @@ -48,7 +48,7 @@ start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $ stopUnless (Command.Move.fromOk src key) $ go $ Command.Move.fromPerform src False key afile where - go a = do + go a = do showStart' "get" key afile next a diff --git a/Command/Group.hs b/Command/Group.hs index 2b5cd2ec4..e1420be88 100644 --- a/Command/Group.hs +++ b/Command/Group.hs @@ -15,8 +15,8 @@ import Types.Group import qualified Data.Set as S -def :: [Command] -def = [command "group" (paramPair paramRemote paramDesc) seek +cmd :: [Command] +cmd = [command "group" (paramPair paramRemote paramDesc) seek SectionSetup "add a repository to a group"] seek :: CommandSeek diff --git a/Command/Help.hs b/Command/Help.hs index 7998ed796..fc1206e03 100644 --- a/Command/Help.hs +++ b/Command/Help.hs @@ -21,8 +21,8 @@ import qualified Command.Fsck import System.Console.GetOpt -def :: [Command] -def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ +cmd :: [Command] +cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "help" paramNothing seek SectionQuery "display help"] seek :: CommandSeek @@ -47,15 +47,15 @@ showGeneralHelp :: IO () showGeneralHelp = putStrLn $ unlines [ "The most frequently used git-annex commands are:" , unlines $ map cmdline $ concat - [ Command.Init.def - , Command.Add.def - , Command.Drop.def - , Command.Get.def - , Command.Move.def - , Command.Copy.def - , Command.Sync.def - , Command.Whereis.def - , Command.Fsck.def + [ Command.Init.cmd + , Command.Add.cmd + , Command.Drop.cmd + , Command.Get.cmd + , Command.Move.cmd + , Command.Copy.cmd + , Command.Sync.cmd + , Command.Whereis.cmd + , Command.Fsck.cmd ] , "Run 'git-annex' for a complete command list." , "Run 'git-annex command --help' for help on a specific command." diff --git a/Command/Import.hs b/Command/Import.hs index 97e3f7652..b20e63853 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -16,8 +16,8 @@ import Backend import Remote import Types.KeySource -def :: [Command] -def = [withOptions opts $ notBareRepo $ command "import" paramPaths seek +cmd :: [Command] +cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek SectionCommon "move and add files from outside git working copy"] opts :: [Option] @@ -50,8 +50,8 @@ getDuplicateMode = gen <*> getflag cleanDuplicatesOption <*> getflag skipDuplicatesOption where - getflag = Annex.getFlag . optionName - gen False False False False = Default + getflag = Annex.getFlag . optionName + gen False False False False = Default gen True False False False = Duplicate gen False True False False = DeDuplicate gen False False True False = CleanDuplicates @@ -96,7 +96,7 @@ start mode (srcfile, destfile) = handleexisting Nothing = noop handleexisting (Just s) | isDirectory s = notoverwriting "(is a directory)" - | otherwise = ifM (Annex.getState Annex.force) $ + | otherwise = ifM (Annex.getState Annex.force) ( liftIO $ nukeFile destfile , notoverwriting "(use --force to override)" ) diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 1fdba46a1..ecfee1db8 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -37,8 +37,8 @@ import Types.MetaData import Logs.MetaData import Annex.MetaData -def :: [Command] -def = [notBareRepo $ withOptions [templateOption, relaxedOption] $ +cmd :: [Command] +cmd = [notBareRepo $ withOptions [templateOption, relaxedOption] $ command "importfeed" (paramRepeating paramUrl) seek SectionCommon "import files from podcast feeds"] @@ -153,7 +153,7 @@ performDownload relaxed cache todownload = case location todownload of rundownload videourl ("." ++ Quvi.linkSuffix link) $ addUrlFileQuvi relaxed quviurl videourl where - forced = Annex.getState Annex.force + forced = Annex.getState Annex.force {- Avoids downloading any urls that are already known to be - associated with a file in the annex, unless forced. -} @@ -192,7 +192,7 @@ performDownload relaxed cache todownload = case location todownload of , return $ Just f ) where - f = if n < 2 + f = if n < 2 then file else let (d, base) = splitFileName file diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index 11cbdb73d..db48a1422 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -11,8 +11,8 @@ import Common.Annex import Command import Annex.Content -def :: [Command] -def = [noCommit $ command "inannex" (paramRepeating paramKey) seek +cmd :: [Command] +cmd = [noCommit $ command "inannex" (paramRepeating paramKey) seek SectionPlumbing "checks if keys are present in the annex"] seek :: CommandSeek diff --git a/Command/Indirect.hs b/Command/Indirect.hs index e146f13b7..a363981be 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -22,8 +22,8 @@ import Annex.CatFile import Annex.Init import qualified Command.Add -def :: [Command] -def = [notBareRepo $ noDaemonRunning $ +cmd :: [Command] +cmd = [notBareRepo $ noDaemonRunning $ command "indirect" paramNothing seek SectionSetup "switch repository to indirect mode"] @@ -94,7 +94,7 @@ perform = do warnlocked showEndOk - warnlocked :: SomeException -> Annex () + warnlocked :: SomeException -> Annex () warnlocked e = do warning $ show e warning "leaving this file as-is; correct this problem and run git annex add on it" diff --git a/Command/Info.hs b/Command/Info.hs index 63bc92bbe..96b7eb6d7 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011 Joey Hess <joey@kitenet.net> + - Copyright 2011-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,14 +16,16 @@ import Data.Tuple import Data.Ord import Common.Annex -import qualified Remote import qualified Command.Unused import qualified Git import qualified Annex +import qualified Remote +import qualified Types.Remote as Remote import Command import Utility.DataUnits import Utility.DiskFree import Annex.Content +import Annex.Link import Types.Key import Logs.UUID import Logs.Trust @@ -65,42 +67,67 @@ data StatInfo = StatInfo , referencedData :: Maybe KeyData , numCopiesStats :: Maybe NumCopiesStats } + +emptyStatInfo :: StatInfo +emptyStatInfo = StatInfo Nothing Nothing Nothing -- a state monad for running Stats in type StatState = StateT StatInfo Annex -def :: [Command] -def = [noCommit $ dontCheck repoExists $ withOptions [jsonOption] $ - command "info" paramPaths seek SectionQuery - "shows general information about the annex"] +cmd :: [Command] +cmd = [noCommit $ dontCheck repoExists $ withOptions [jsonOption] $ + command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery + "shows information about the specified item or the repository as a whole"] seek :: CommandSeek seek = withWords start -start :: [FilePath] -> CommandStart +start :: [String] -> CommandStart start [] = do globalInfo stop start ps = do - mapM_ localInfo =<< filterM isdir ps + mapM_ itemInfo ps stop - where - isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) globalInfo :: Annex () globalInfo = do stats <- selStats global_fast_stats global_slow_stats showCustom "info" $ do - evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) + evalStateT (mapM_ showStat stats) emptyStatInfo return True -localInfo :: FilePath -> Annex () -localInfo dir = showCustom (unwords ["info", dir]) $ do - stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) - evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir +itemInfo :: String -> Annex () +itemInfo p = ifM (isdir p) + ( dirInfo p + , do + v <- Remote.byName' p + case v of + Right r -> remoteInfo r + Left _ -> maybe noinfo (fileInfo p) =<< isAnnexLink p + ) + where + isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) + noinfo = error $ p ++ " is not a directory or an annexed file or a remote" + +dirInfo :: FilePath -> Annex () +dirInfo dir = showCustom (unwords ["info", dir]) $ do + stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats) + evalStateT (mapM_ showStat stats) =<< getDirStatInfo dir return True where - tostats = map (\s -> s dir) + tostats = map (\s -> s dir) + +fileInfo :: FilePath -> Key -> Annex () +fileInfo file k = showCustom (unwords ["info", file]) $ do + evalStateT (mapM_ showStat (file_stats file k)) emptyStatInfo + return True + +remoteInfo :: Remote -> Annex () +remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do + info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r + evalStateT (mapM_ showStat (remote_stats r ++ info)) emptyStatInfo + return True selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats fast_stats slow_stats = do @@ -132,22 +159,42 @@ global_slow_stats = , bloom_info , backend_usage ] -local_fast_stats :: [FilePath -> Stat] -local_fast_stats = - [ local_dir +dir_fast_stats :: [FilePath -> Stat] +dir_fast_stats = + [ dir_name , const local_annex_keys , const local_annex_size , const known_annex_files , const known_annex_size ] -local_slow_stats :: [FilePath -> Stat] -local_slow_stats = +dir_slow_stats :: [FilePath -> Stat] +dir_slow_stats = [ const numcopies_stats ] +file_stats :: FilePath -> Key -> [Stat] +file_stats f k = + [ file_name f + , key_size k + , key_name k + ] + +remote_stats :: Remote -> [Stat] +remote_stats r = map (\s -> s r) + [ remote_name + , remote_description + , remote_uuid + , remote_cost + , remote_type + ] + stat :: String -> (String -> StatState String) -> Stat stat desc a = return $ Just (desc, a desc) +-- The json simply contains the same string that is displayed. +simpleStat :: String -> StatState String -> Stat +simpleStat desc getval = stat desc $ json id getval + nostat :: Stat nostat = return Nothing @@ -168,7 +215,7 @@ showStat s = maybe noop calc =<< s lift . showRaw =<< a repository_mode :: Stat -repository_mode = stat "repository mode" $ json id $ lift $ +repository_mode = simpleStat "repository mode" $ lift $ ifM isDirect ( return "direct", return "indirect" ) @@ -181,15 +228,37 @@ remote_list level = stat n $ nojson $ lift $ do where n = showTrustLevel level ++ " repositories" -local_dir :: FilePath -> Stat -local_dir dir = stat "directory" $ json id $ return dir +dir_name :: FilePath -> Stat +dir_name dir = simpleStat "directory" $ pure dir + +file_name :: FilePath -> Stat +file_name file = simpleStat "file" $ pure file + +remote_name :: Remote -> Stat +remote_name r = simpleStat "remote" $ pure (Remote.name r) + +remote_description :: Remote -> Stat +remote_description r = simpleStat "description" $ lift $ + Remote.prettyUUID (Remote.uuid r) + +remote_uuid :: Remote -> Stat +remote_uuid r = simpleStat "uuid" $ pure $ + fromUUID $ Remote.uuid r + +remote_cost :: Remote -> Stat +remote_cost r = simpleStat "cost" $ pure $ + show $ Remote.cost r + +remote_type :: Remote -> Stat +remote_type r = simpleStat "type" $ pure $ + Remote.typename $ Remote.remotetype r local_annex_keys :: Stat local_annex_keys = stat "local annex keys" $ json show $ countKeys <$> cachedPresentData local_annex_size :: Stat -local_annex_size = stat "local annex size" $ json id $ +local_annex_size = simpleStat "local annex size" $ showSizeKeys <$> cachedPresentData known_annex_files :: Stat @@ -197,7 +266,7 @@ known_annex_files = stat "annexed files in working tree" $ json show $ countKeys <$> cachedReferencedData known_annex_size :: Stat -known_annex_size = stat "size of annexed files in working tree" $ json id $ +known_annex_size = simpleStat "size of annexed files in working tree" $ showSizeKeys <$> cachedReferencedData tmp_size :: Stat @@ -206,8 +275,14 @@ tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir bad_data_size :: Stat bad_data_size = staleSize "bad keys size" gitAnnexBadDir +key_size :: Key -> Stat +key_size k = simpleStat "size" $ pure $ showSizeKeys $ foldKeys [k] + +key_name :: Key -> Stat +key_name k = simpleStat "key" $ pure $ key2file k + bloom_info :: Stat -bloom_info = stat "bloom filter size" $ json id $ do +bloom_info = simpleStat "bloom filter size" $ do localkeys <- countKeys <$> cachedPresentData capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity let note = aside $ @@ -240,7 +315,7 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do ] disk_size :: Stat -disk_size = stat "available local disk space" $ json id $ lift $ +disk_size = simpleStat "available local disk space" $ lift $ calcfree <$> (annexDiskReserve <$> Annex.getGitConfig) <*> inRepo (getDiskFree . gitAnnexDir) @@ -264,7 +339,7 @@ backend_usage = stat "backend usage" $ nojson $ where calc x y = multiLine $ map (\(n, b) -> b ++ ": " ++ show n) $ - reverse $ sort $ map swap $ M.toList $ + sortBy (flip compare) $ map swap $ M.toList $ M.unionWith (+) x y numcopies_stats :: Stat @@ -273,7 +348,7 @@ numcopies_stats = stat "numcopies stats" $ nojson $ where calc = multiLine . map (\(variance, count) -> show variance ++ ": " ++ show count) - . reverse . sortBy (comparing snd) . M.toList + . sortBy (flip (comparing snd)) . M.toList cachedPresentData :: StatState KeyData cachedPresentData = do @@ -296,12 +371,12 @@ cachedReferencedData = do put s { referencedData = Just v } return v --- currently only available for local info +-- currently only available for directory info cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) cachedNumCopiesStats = numCopiesStats <$> get -getLocalStatInfo :: FilePath -> Annex StatInfo -getLocalStatInfo dir = do +getDirStatInfo :: FilePath -> Annex StatInfo +getDirStatInfo dir = do fast <- Annex.getState Annex.fast matcher <- Limit.getMatcher (presentdata, referenceddata, numcopiesstats) <- diff --git a/Command/Init.hs b/Command/Init.hs index e8d9af167..b921c0657 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -11,8 +11,8 @@ import Common.Annex import Command import Annex.Init -def :: [Command] -def = [dontCheck repoExists $ +cmd :: [Command] +cmd = [dontCheck repoExists $ command "init" paramDesc seek SectionSetup "initialize git-annex"] seek :: CommandSeek diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index dc54023cc..51ea15373 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -19,8 +19,8 @@ import Logs.Trust import Data.Ord -def :: [Command] -def = [command "initremote" +cmd :: [Command] +cmd = [command "initremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) seek SectionSetup "creates a special (non-git) remote"] @@ -33,11 +33,15 @@ start (name:ws) = ifM (isJust <$> findExisting name) ( error $ "There is already a special remote named \"" ++ name ++ "\". (Use enableremote to enable an existing special remote.)" , do - let c = newConfig name - t <- findType config - - showStart "initremote" name - next $ perform t name $ M.union config c + ifM (isJust <$> Remote.byNameOnly name) + ( error $ "There is already a remote named \"" ++ name ++ "\"" + , do + let c = newConfig name + t <- findType config + + showStart "initremote" name + next $ perform t name $ M.union config c + ) ) where config = Logs.Remote.keyValToConfig ws @@ -63,7 +67,7 @@ findExisting name = do return $ headMaybe matches newConfig :: String -> R.RemoteConfig -newConfig name = M.singleton nameKey name +newConfig = M.singleton nameKey findByName :: String -> M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)] findByName n = filter (matching . snd) . M.toList diff --git a/Command/List.hs b/Command/List.hs index d038d6deb..98cb82311 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -23,8 +23,8 @@ import Annex.UUID import qualified Annex import Git.Types (RemoteName) -def :: [Command] -def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek +cmd :: [Command] +cmd = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek SectionQuery "show which remotes contain files"] allrepos :: Option @@ -71,15 +71,15 @@ type Present = Bool header :: [(RemoteName, TrustLevel)] -> String header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes) where - formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel - pipes = flip replicate '|' - trust UnTrusted = " (untrusted)" - trust _ = "" + formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel + pipes = flip replicate '|' + trust UnTrusted = " (untrusted)" + trust _ = "" format :: [(TrustLevel, Present)] -> FilePath -> String format remotes file = thereMap ++ " " ++ file where - thereMap = concatMap there remotes - there (UnTrusted, True) = "x" - there (_, True) = "X" - there (_, False) = "_" + thereMap = concatMap there remotes + there (UnTrusted, True) = "x" + there (_, True) = "X" + there (_, False) = "_" diff --git a/Command/Lock.hs b/Command/Lock.hs index e6733dcb1..f227ab380 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -12,8 +12,8 @@ import Command import qualified Annex.Queue import qualified Annex -def :: [Command] -def = [notDirect $ command "lock" paramPaths seek SectionCommon +cmd :: [Command] +cmd = [notDirect $ command "lock" paramPaths seek SectionCommon "undo unlock command"] seek :: CommandSeek diff --git a/Command/Log.hs b/Command/Log.hs index b0109f117..11fd51eb8 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -34,8 +34,8 @@ data RefChange = RefChange type Outputter = Bool -> POSIXTime -> [UUID] -> Annex () -def :: [Command] -def = [withOptions options $ +cmd :: [Command] +cmd = [withOptions options $ command "log" paramPaths seek SectionQuery "shows location log"] options :: [Option] diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 814c5d2d7..202233233 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -12,8 +12,8 @@ import Command import Annex.CatFile import Types.Key -def :: [Command] -def = [notBareRepo $ noCommit $ noMessages $ +cmd :: [Command] +cmd = [notBareRepo $ noCommit $ noMessages $ command "lookupkey" (paramRepeating paramFile) seek SectionPlumbing "looks up key used for file"] diff --git a/Command/Map.hs b/Command/Map.hs index b1d28113b..e15fd9c33 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -25,8 +25,8 @@ import qualified Utility.Dot as Dot -- a link from the first repository to the second (its remote) data Link = Link Git.Repo Git.Repo -def :: [Command] -def = [dontCheck repoExists $ +cmd :: [Command] +cmd = [dontCheck repoExists $ command "map" paramNothing seek SectionQuery "generate map of repositories"] @@ -194,11 +194,11 @@ tryScan r | Git.repoIsUrl r = return Nothing | otherwise = liftIO $ safely $ Git.Config.read r where - pipedconfig cmd params = liftIO $ safely $ + pipedconfig pcmd params = liftIO $ safely $ withHandle StdoutHandle createProcessSuccess p $ Git.Config.hRead r where - p = proc cmd $ toCommand params + p = proc pcmd $ toCommand params configlist = Ssh.onRemote r (pipedconfig, return Nothing) "configlist" [] [] manualconfiglist = do @@ -206,14 +206,15 @@ tryScan r sshparams <- Ssh.toRepo r gc [Param sshcmd] liftIO $ pipedconfig "ssh" sshparams where - sshcmd = cddir ++ " && " ++ - "git config --null --list" + sshcmd = "sh -c " ++ shellEscape + (cddir ++ " && " ++ "git config --null --list") dir = Git.repoPath r cddir | "/~" `isPrefixOf` dir = let (userhome, reldir) = span (/= '/') (drop 1 dir) - in "cd " ++ userhome ++ " && cd " ++ shellEscape (drop 1 reldir) - | otherwise = "cd " ++ shellEscape dir + in "cd " ++ userhome ++ " && " ++ cdto (drop 1 reldir) + | otherwise = cdto dir + cdto p = "if ! cd " ++ shellEscape p ++ " 2>/dev/null; then cd " ++ shellEscape p ++ ".git; fi" -- First, try sshing and running git config manually, -- only fall back to git-annex-shell configlist if that diff --git a/Command/Merge.hs b/Command/Merge.hs index 51a8b9c52..eeb151c27 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -13,8 +13,8 @@ import qualified Annex.Branch import qualified Git.Branch import Command.Sync (prepMerge, mergeLocal) -def :: [Command] -def = [command "merge" paramNothing seek SectionMaintenance +cmd :: [Command] +cmd = [command "merge" paramNothing seek SectionMaintenance "automatically merge changes from remotes"] seek :: CommandSeek diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 38f9b8522..50b9b1f9a 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -16,8 +16,8 @@ import Logs.MetaData import qualified Data.Set as S import Data.Time.Clock.POSIX -def :: [Command] -def = [withOptions metaDataOptions $ +cmd :: [Command] +cmd = [withOptions metaDataOptions $ command "metadata" paramPaths seek SectionMetaData "sets metadata of a file"] diff --git a/Command/Migrate.hs b/Command/Migrate.hs index cea9e9426..19fd89c7a 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -17,8 +17,8 @@ import Annex.Content import qualified Command.ReKey import qualified Command.Fsck -def :: [Command] -def = [notDirect $ +cmd :: [Command] +cmd = [notDirect $ command "migrate" paramPaths seek SectionUtility "switch data to different backend"] @@ -65,7 +65,7 @@ upgradableKey backend key = isNothing (Types.Key.keySize key) || backendupgradab perform :: FilePath -> Key -> Backend -> Backend -> CommandPerform perform file oldkey oldbackend newbackend = go =<< genkey where - go Nothing = stop + go Nothing = stop go (Just (newkey, knowngoodcontent)) | knowngoodcontent = finish newkey | otherwise = stopUnless checkcontent $ finish newkey diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 4e9a85009..ec9ef92c3 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -17,8 +17,8 @@ import Annex.Content import qualified Annex import Config.NumCopies -def :: [Command] -def = [withOptions (fromToOptions ++ keyOptions) $ +cmd :: [Command] +cmd = [withOptions (fromToOptions ++ keyOptions) $ command "mirror" paramPaths seek SectionCommon "mirror content of files to/from another repository"] @@ -32,7 +32,7 @@ seek ps = do ps start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart -start to from file key = startKey to from (Just file) key +start to from file = startKey to from (Just file) startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart startKey to from afile key = do diff --git a/Command/Move.hs b/Command/Move.hs index c3d641edd..edb7ede7b 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -17,8 +17,8 @@ import Annex.UUID import Annex.Transfer import Logs.Presence -def :: [Command] -def = [withOptions moveOptions $ command "move" paramPaths seek +cmd :: [Command] +cmd = [withOptions moveOptions $ command "move" paramPaths seek SectionCommon "move content of files to/from another repository"] moveOptions :: [Option] @@ -34,7 +34,7 @@ seek ps = do ps start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart -start to from move file key = start' to from move (Just file) key +start to from move = start' to from move . Just startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart startKey to from move = start' to from move Nothing @@ -91,7 +91,7 @@ expectedPresent dest key = do return $ dest `elem` remotes toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform -toPerform dest move key afile fastcheck isthere = do +toPerform dest move key afile fastcheck isthere = case isthere of Left err -> do showNote err diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs index d0df05551..36997666d 100644 --- a/Command/NotifyChanges.hs +++ b/Command/NotifyChanges.hs @@ -19,8 +19,8 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM -def :: [Command] -def = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing +cmd :: [Command] +cmd = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing "sends notification when git refs are changed"] seek :: CommandSeek @@ -51,7 +51,7 @@ start = do -- No messages need to be received from the caller, -- but when it closes the connection, notice and terminate. - let receiver = forever $ void $ getLine + let receiver = forever $ void getLine void $ liftIO $ concurrently sender receiver stop diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs index b7323ae35..773e10b6a 100644 --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -13,8 +13,8 @@ import Command import Config.NumCopies import Types.Messages -def :: [Command] -def = [command "numcopies" paramNumber seek +cmd :: [Command] +cmd = [command "numcopies" paramNumber seek SectionSetup "configure desired number of copies"] seek :: CommandSeek @@ -22,16 +22,15 @@ seek = withWords start start :: [String] -> CommandStart start [] = startGet -start [s] = do - case readish s of - Nothing -> error $ "Bad number: " ++ s - Just n - | n > 0 -> startSet n - | n == 0 -> ifM (Annex.getState Annex.force) - ( startSet n - , error "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force." - ) - | otherwise -> error "Number cannot be negative!" +start [s] = case readish s of + Nothing -> error $ "Bad number: " ++ s + Just n + | n > 0 -> startSet n + | n == 0 -> ifM (Annex.getState Annex.force) + ( startSet n + , error "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force." + ) + | otherwise -> error "Number cannot be negative!" start _ = error "Specify a single number." startGet :: CommandStart @@ -39,9 +38,9 @@ startGet = next $ next $ do Annex.setOutput QuietOutput v <- getGlobalNumCopies case v of - Just n -> liftIO $ putStrLn $ show $ fromNumCopies n + Just n -> liftIO $ print $ fromNumCopies n Nothing -> do - liftIO $ putStrLn $ "global numcopies is not set" + liftIO $ putStrLn "global numcopies is not set" old <- deprecatedNumCopies case old of Nothing -> liftIO $ putStrLn "(default is 1)" diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 355e2766e..aaaa51fbd 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -26,8 +26,8 @@ import Types.MetaData import qualified Data.Set as S -def :: [Command] -def = [command "pre-commit" paramPaths seek SectionPlumbing +cmd :: [Command] +cmd = [command "pre-commit" paramPaths seek SectionPlumbing "run by git pre-commit hook"] seek :: CommandSeek @@ -59,7 +59,7 @@ startIndirect f = next $ do next $ return True startDirect :: [String] -> CommandStart -startDirect _ = next $ next $ preCommitDirect +startDirect _ = next $ next preCommitDirect addViewMetaData :: View -> ViewedFile -> Key -> CommandStart addViewMetaData v f k = do diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 2919a09e9..a203ab8d5 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -17,8 +17,8 @@ import Logs.Web import Logs.Location import Utility.CopyFile -def :: [Command] -def = [notDirect $ command "rekey" +cmd :: [Command] +cmd = [notDirect $ command "rekey" (paramOptional $ paramRepeating $ paramPair paramPath paramKey) seek SectionPlumbing "change keys used for files"] diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index d5971d6cf..8a806875b 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -20,8 +20,8 @@ import qualified Types.Key import qualified Types.Backend import qualified Backend -def :: [Command] -def = [noCommit $ command "recvkey" paramKey seek +cmd :: [Command] +cmd = [noCommit $ command "recvkey" paramKey seek SectionPlumbing "runs rsync in server mode to receive content"] seek :: CommandSeek @@ -63,7 +63,7 @@ start key = fieldTransfer Download key $ \_p -> Nothing -> return True Just size -> do size' <- fromIntegral . fileSize - <$> liftIO (getFileStatus tmp) + <$> liftIO (getFileStatus tmp) return $ size == size' if oksize then case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of @@ -76,7 +76,7 @@ start key = fieldTransfer Download key $ \_p -> warning "recvkey: received key with wrong size; discarding" return False where - runfsck check = ifM (check key tmp) + runfsck check = ifM (check key tmp) ( return True , do warning "recvkey: received key from direct mode repository seems to have changed as it was transferred; discarding" diff --git a/Command/Reinit.hs b/Command/Reinit.hs index 0fc1e8314..6de7b9932 100644 --- a/Command/Reinit.hs +++ b/Command/Reinit.hs @@ -14,8 +14,8 @@ import Annex.UUID import Types.UUID import qualified Remote -def :: [Command] -def = [dontCheck repoExists $ +cmd :: [Command] +cmd = [dontCheck repoExists $ command "reinit" (paramUUID ++ " or " ++ paramDesc) seek SectionUtility ""] seek :: CommandSeek diff --git a/Command/Reinject.hs b/Command/Reinject.hs index a516fe93c..a968f6f56 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -14,8 +14,8 @@ import Annex.Content import qualified Command.Fsck import qualified Backend -def :: [Command] -def = [command "reinject" (paramPair "SRC" "DEST") seek +cmd :: [Command] +cmd = [command "reinject" (paramPair "SRC" "DEST") seek SectionUtility "sets content of annexed file"] seek :: CommandSeek diff --git a/Command/RemoteDaemon.hs b/Command/RemoteDaemon.hs index 61c3a7d84..9f4cc884d 100644 --- a/Command/RemoteDaemon.hs +++ b/Command/RemoteDaemon.hs @@ -11,8 +11,8 @@ import Common.Annex import Command import RemoteDaemon.Core -def :: [Command] -def = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing +cmd :: [Command] +cmd = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing "detects when remotes have changed, and fetches from them"] seek :: CommandSeek diff --git a/Command/Repair.hs b/Command/Repair.hs index 56925d83d..8eb937ce5 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -16,8 +16,8 @@ import qualified Git.Ref import Git.Types import Annex.Version -def :: [Command] -def = [noCommit $ dontCheck repoExists $ +cmd :: [Command] +cmd = [noCommit $ dontCheck repoExists $ command "repair" paramNothing seek SectionMaintenance "recover broken git repository"] seek :: CommandSeek @@ -68,7 +68,7 @@ repairAnnexBranch modifiedbranches ) ) where - okindex = Annex.Branch.withIndex $ inRepo $ Git.Repair.checkIndex + okindex = Annex.Branch.withIndex $ inRepo Git.Repair.checkIndex commitindex = do Annex.Branch.forceCommit "committing index after git repository repair" liftIO $ putStrLn "Successfully recovered the git-annex branch using .git/annex/index" diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index a50e2aa9d..145db37df 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -14,12 +14,12 @@ import Git.Sha import qualified Git.Branch import Annex.AutoMerge -def :: [Command] -def = [command "resolvemerge" paramNothing seek SectionPlumbing +cmd :: [Command] +cmd = [command "resolvemerge" paramNothing seek SectionPlumbing "resolve merge conflicts"] seek :: CommandSeek -seek ps = withNothing start ps +seek = withNothing start start :: CommandStart start = do diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index e961575a3..1582d0f3f 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -11,8 +11,8 @@ import Common.Annex import Command import Logs.Web -def :: [Command] -def = [notBareRepo $ +cmd :: [Command] +cmd = [notBareRepo $ command "rmurl" (paramPair paramFile paramUrl) seek SectionCommon "record file is not available at url"] diff --git a/Command/Schedule.hs b/Command/Schedule.hs index a088dbef8..ce8b67da0 100644 --- a/Command/Schedule.hs +++ b/Command/Schedule.hs @@ -17,8 +17,8 @@ import Types.Messages import qualified Data.Set as S -def :: [Command] -def = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek +cmd :: [Command] +cmd = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek SectionSetup "get or set scheduled jobs"] seek :: CommandSeek @@ -27,7 +27,7 @@ seek = withWords start start :: [String] -> CommandStart start = parse where - parse (name:[]) = go name performGet + parse (name:[]) = go name performGet parse (name:expr:[]) = go name $ \uuid -> do showStart "schedile" name performSet expr uuid diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index edba27346..146ec2192 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -11,8 +11,8 @@ import Command import Types.TrustLevel import Command.Trust (trustCommand) -def :: [Command] -def = [command "semitrust" (paramRepeating paramRemote) seek +cmd :: [Command] +cmd = [command "semitrust" (paramRepeating paramRemote) seek SectionSetup "return repository to default trust level"] seek :: CommandSeek diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 13e585fc6..90eca20bb 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -16,8 +16,8 @@ import Annex.Transfer import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -def :: [Command] -def = [noCommit $ command "sendkey" paramKey seek +cmd :: [Command] +cmd = [noCommit $ command "sendkey" paramKey seek SectionPlumbing "runs rsync in server mode to send content"] seek :: CommandSeek diff --git a/Command/Status.hs b/Command/Status.hs index 9d184c33b..0d3efa840 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -16,8 +16,8 @@ import qualified Git.LsFiles as LsFiles import qualified Git.Ref import qualified Git -def :: [Command] -def = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ +cmd :: [Command] +cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ command "status" paramPaths seek SectionCommon "show the working tree status"] diff --git a/Command/Sync.hs b/Command/Sync.hs index 6a6a254b3..a89737647 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -35,8 +35,8 @@ import Annex.Ssh import Control.Concurrent.MVar -def :: [Command] -def = [withOptions syncOptions $ +cmd :: [Command] +cmd = [withOptions syncOptions $ command "sync" (paramOptional (paramRepeating paramRemote)) seek SectionCommon "synchronize local repository with remotes"] @@ -356,7 +356,7 @@ syncFile rs f k = do handleDropsFrom locs' rs "unwanted" True k (Just f) Nothing callCommandAction where - wantget have = allM id + wantget have = allM id [ pure (not $ null have) , not <$> inAnnex k , wantGet True (Just k) (Just f) diff --git a/Command/Test.hs b/Command/Test.hs index 08e9d1b6e..4d481369d 100644 --- a/Command/Test.hs +++ b/Command/Test.hs @@ -11,8 +11,8 @@ import Common import Command import Messages -def :: [Command] -def = [ noRepo startIO $ dontCheck repoExists $ +cmd :: [Command] +cmd = [ noRepo startIO $ dontCheck repoExists $ command "test" paramNothing seek SectionTesting "run built-in test suite"] diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 247a243e4..f0735e087 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -36,8 +36,8 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Map as M -def :: [Command] -def = [ withOptions [sizeOption] $ +cmd :: [Command] +cmd = [ withOptions [sizeOption] $ command "testremote" paramRemote seek SectionTesting "test transfers to/from a remote"] diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index 8ab577a81..ae7fbf033 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -15,8 +15,8 @@ import Types.Key import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -def :: [Command] -def = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing +cmd :: [Command] +cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing "updates sender on number of bytes of content received"] seek :: CommandSeek diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 13bfd825e..469e01322 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -15,8 +15,8 @@ import Annex.Transfer import qualified Remote import Types.Remote -def :: [Command] -def = [withOptions transferKeyOptions $ +cmd :: [Command] +cmd = [withOptions transferKeyOptions $ noCommit $ command "transferkey" paramKey seek SectionPlumbing "transfers a key from or to a remote"] diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index fba0e6593..346e413e6 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -21,8 +21,8 @@ import Git.Types (RemoteName) data TransferRequest = TransferRequest Direction Remote Key AssociatedFile -def :: [Command] -def = [command "transferkeys" paramNothing seek +cmd :: [Command] +cmd = [command "transferkeys" paramNothing seek SectionPlumbing "transfers keys"] seek :: CommandSeek @@ -57,7 +57,7 @@ runRequests readh writeh a = do fileEncoding writeh go =<< readrequests where - go (d:rn:k:f:rest) = do + go (d:rn:k:f:rest) = do case (deserialize d, deserialize rn, deserialize k, deserialize f) of (Just direction, Just remotename, Just key, Just file) -> do mremote <- Remote.byName' remotename diff --git a/Command/Trust.hs b/Command/Trust.hs index c0f013699..f02fcf617 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -16,19 +16,19 @@ import Logs.Group import qualified Data.Set as S -def :: [Command] -def = [command "trust" (paramRepeating paramRemote) seek +cmd :: [Command] +cmd = [command "trust" (paramRepeating paramRemote) seek SectionSetup "trust a repository"] seek :: CommandSeek seek = trustCommand "trust" Trusted trustCommand :: String -> TrustLevel -> CommandSeek -trustCommand cmd level = withWords start +trustCommand c level = withWords start where start ws = do let name = unwords ws - showStart cmd name + showStart c name u <- Remote.nameToUUID name next $ perform u perform uuid = do diff --git a/Command/Unannex.hs b/Command/Unannex.hs index c105eb9ce..e8cf70f51 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -22,8 +22,8 @@ import qualified Git.DiffTree as DiffTree import Utility.CopyFile import Command.PreCommit (lockPreCommitHook) -def :: [Command] -def = [command "unannex" paramPaths seek SectionUtility +cmd :: [Command] +cmd = [command "unannex" paramPaths seek SectionUtility "undo accidential add command"] seek :: CommandSeek diff --git a/Command/Ungroup.hs b/Command/Ungroup.hs index a88e3f7c8..a26bd34a9 100644 --- a/Command/Ungroup.hs +++ b/Command/Ungroup.hs @@ -15,8 +15,8 @@ import Types.Group import qualified Data.Set as S -def :: [Command] -def = [command "ungroup" (paramPair paramRemote paramDesc) seek +cmd :: [Command] +cmd = [command "ungroup" (paramPair paramRemote paramDesc) seek SectionSetup "remove a repository from a group"] seek :: CommandSeek diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 3f57782fc..ea4a3a9f6 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -21,8 +21,8 @@ import Utility.FileMode import System.IO.HVFS import System.IO.HVFS.Utils -def :: [Command] -def = [addCheck check $ command "uninit" paramPaths seek +cmd :: [Command] +cmd = [addCheck check $ command "uninit" paramPaths seek SectionUtility "de-initialize git-annex and clean out repository"] check :: Annex () @@ -100,7 +100,7 @@ prepareRemoveAnnexDir annexdir = removeUnannexed :: [Key] -> Annex [Key] removeUnannexed = go [] where - go c [] = return c + go c [] = return c go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks) ( do lockContent k removeAnnex diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 02704e805..bed618104 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -12,8 +12,8 @@ import Command import Annex.Content import Utility.CopyFile -def :: [Command] -def = +cmd :: [Command] +cmd = [ c "unlock" "unlock files for modification" , c "edit" "same as unlock" ] diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 4c1035dcd..ecd0ae4cf 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -11,8 +11,8 @@ import Command import Types.TrustLevel import Command.Trust (trustCommand) -def :: [Command] -def = [command "untrust" (paramRepeating paramRemote) seek +cmd :: [Command] +cmd = [command "untrust" (paramRepeating paramRemote) seek SectionSetup "do not trust a repository"] seek :: CommandSeek diff --git a/Command/Unused.hs b/Command/Unused.hs index c2179447d..1859856af 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -35,8 +35,8 @@ import Git.FilePath import Logs.View (is_branchView) import Utility.Bloom -def :: [Command] -def = [withOptions [unusedFromOption] $ command "unused" paramNothing seek +cmd :: [Command] +cmd = [withOptions [unusedFromOption] $ command "unused" paramNothing seek SectionMaintenance "look for unused file content"] unusedFromOption :: Option diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 80876290a..7e03ec3ee 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -11,8 +11,8 @@ import Common.Annex import Command import Upgrade -def :: [Command] -def = [dontCheck repoExists $ -- because an old version may not seem to exist +cmd :: [Command] +cmd = [dontCheck repoExists $ -- because an old version may not seem to exist command "upgrade" paramNothing seek SectionMaintenance "upgrade repository layout"] diff --git a/Command/VAdd.hs b/Command/VAdd.hs index e3726a051..33614ae59 100644 --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -12,8 +12,8 @@ import Command import Annex.View import Command.View (checkoutViewBranch) -def :: [Command] -def = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB") +cmd :: [Command] +cmd = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB") seek SectionMetaData "add subdirs to current view"] seek :: CommandSeek diff --git a/Command/VCycle.hs b/Command/VCycle.hs index f7da47fa2..eead9e022 100644 --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -14,8 +14,8 @@ import Types.View import Logs.View import Command.View (checkoutViewBranch) -def :: [Command] -def = [notBareRepo $ notDirect $ +cmd :: [Command] +cmd = [notBareRepo $ notDirect $ command "vcycle" paramNothing seek SectionUtility "switch view to next layout"] diff --git a/Command/VFilter.hs b/Command/VFilter.hs index bd17aca45..320f28568 100644 --- a/Command/VFilter.hs +++ b/Command/VFilter.hs @@ -12,8 +12,8 @@ import Command import Annex.View import Command.View (paramView, checkoutViewBranch) -def :: [Command] -def = [notBareRepo $ notDirect $ +cmd :: [Command] +cmd = [notBareRepo $ notDirect $ command "vfilter" paramView seek SectionMetaData "filter current view"] seek :: CommandSeek diff --git a/Command/VPop.hs b/Command/VPop.hs index 706a522f8..5046b54b5 100644 --- a/Command/VPop.hs +++ b/Command/VPop.hs @@ -16,8 +16,8 @@ import Types.View import Logs.View import Command.View (checkoutViewBranch) -def :: [Command] -def = [notBareRepo $ notDirect $ +cmd :: [Command] +cmd = [notBareRepo $ notDirect $ command "vpop" (paramOptional paramNumber) seek SectionMetaData "switch back to previous view"] diff --git a/Command/Version.hs b/Command/Version.hs index 526b752f0..255fd8188 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -17,8 +17,8 @@ import qualified Types.Remote as R import qualified Remote import qualified Backend -def :: [Command] -def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ +cmd :: [Command] +cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "version" paramNothing seek SectionQuery "show version info"] seek :: CommandSeek diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 1f1695536..faa2d3f05 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE RankNTypes #-} + module Command.Vicfg where import qualified Data.Map as M @@ -12,6 +14,7 @@ import qualified Data.Set as S import System.Environment (getEnv) import Data.Tuple (swap) import Data.Char (isSpace) +import Data.Default import Common.Annex import Command @@ -26,8 +29,8 @@ import Types.StandardGroups import Types.ScheduledActivity import Remote -def :: [Command] -def = [command "vicfg" paramNothing seek +cmd :: [Command] +cmd = [command "vicfg" paramNothing seek SectionSetup "edit git-annex's configuration"] seek :: CommandSeek @@ -49,7 +52,7 @@ vicfg curcfg f = do -- Allow EDITOR to be processed by the shell, so it can contain options. unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ error $ vi ++ " exited nonzero; aborting" - r <- parseCfg curcfg <$> liftIO (readFileStrict f) + r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) liftIO $ nukeFile f case r of Left s -> do @@ -85,6 +88,21 @@ setCfg curcfg newcfg = do mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff +{- Default config has all the keys from the input config, but with their + - default values. -} +defCfg :: Cfg -> Cfg +defCfg curcfg = Cfg + { cfgTrustMap = mapdef $ cfgTrustMap curcfg + , cfgGroupMap = mapdef $ cfgGroupMap curcfg + , cfgPreferredContentMap = mapdef $ cfgPreferredContentMap curcfg + , cfgRequiredContentMap = mapdef $ cfgRequiredContentMap curcfg + , cfgGroupPreferredContentMap = mapdef $ cfgGroupPreferredContentMap curcfg + , cfgScheduleMap = mapdef $ cfgScheduleMap curcfg + } + where + mapdef :: forall k v. Default v => M.Map k v -> M.Map k v + mapdef = M.map (const def) + diffCfg :: Cfg -> Cfg -> Cfg diffCfg curcfg newcfg = Cfg { cfgTrustMap = diff cfgTrustMap @@ -124,7 +142,7 @@ genCfg cfg descs = unlines $ intercalate [""] , com "(Valid trust levels: " ++ trustlevels ++ ")" ] (\(t, u) -> line "trust" u $ showTrustLevel t) - (\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted) + (\u -> lcom $ line "trust" u $ showTrustLevel def) where trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted] @@ -136,7 +154,7 @@ genCfg cfg descs = unlines $ intercalate [""] (\(s, u) -> line "group" u $ unwords $ S.toList s) (\u -> lcom $ line "group" u "") where - grouplist = unwords $ map fromStandardGroup [minBound..] + grouplist = unwords $ map fromStandardGroup [minBound..] preferredcontent = settings cfg descs cfgPreferredContentMap [ com "Repository preferred contents" @@ -157,7 +175,7 @@ genCfg cfg descs = unlines $ intercalate [""] (\(s, g) -> gline g s) (\g -> gline g "") where - gline g value = [ unwords ["groupwanted", g, "=", value] ] + gline g value = [ unwords ["groupwanted", g, "=", value] ] allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg) stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound] @@ -203,7 +221,7 @@ lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l) {- If there's a parse error, returns a new version of the file, - with the problem lines noted. -} parseCfg :: Cfg -> String -> Either String Cfg -parseCfg curcfg = go [] curcfg . lines +parseCfg defcfg = go [] defcfg . lines where go c cfg [] | null (mapMaybe fst c) = Right cfg diff --git a/Command/View.hs b/Command/View.hs index 93b045c39..bfe030e23 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -17,8 +17,8 @@ import Types.View import Annex.View import Logs.View -def :: [Command] -def = [notBareRepo $ notDirect $ +cmd :: [Command] +cmd = [notBareRepo $ notDirect $ command "view" paramView seek SectionMetaData "enter a view branch"] seek :: CommandSeek @@ -42,7 +42,7 @@ perform view = do next $ checkoutViewBranch view applyView paramView :: String -paramView = paramPair (paramRepeating "TAG") (paramRepeating "FIELD=VALUE") +paramView = paramRepeating "FIELD=VALUE" mkView :: [String] -> Annex View mkView params = go =<< inRepo Git.Branch.current diff --git a/Command/Wanted.hs b/Command/Wanted.hs index bae450d26..3f721e368 100644 --- a/Command/Wanted.hs +++ b/Command/Wanted.hs @@ -16,8 +16,8 @@ import Types.Messages import qualified Data.Map as M -def :: [Command] -def = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek +cmd :: [Command] +cmd = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek SectionSetup "get or set preferred content expression"] seek :: CommandSeek @@ -26,7 +26,7 @@ seek = withWords start start :: [String] -> CommandStart start = parse where - parse (name:[]) = go name performGet + parse (name:[]) = go name performGet parse (name:expr:[]) = go name $ \uuid -> do showStart "wanted" name performSet expr uuid diff --git a/Command/Watch.hs b/Command/Watch.hs index 79079337c..2d25b54c3 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -12,8 +12,8 @@ import Assistant import Command import Utility.HumanTime -def :: [Command] -def = [notBareRepo $ withOptions [foregroundOption, stopOption] $ +cmd :: [Command] +cmd = [notBareRepo $ withOptions [foregroundOption, stopOption] $ command "watch" paramNothing seek SectionCommon "watch for changes"] seek :: CommandSeek diff --git a/Command/WebApp.hs b/Command/WebApp.hs index e329582e3..3a074218f 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -37,8 +37,8 @@ import Control.Concurrent.STM import Network.Socket (HostName) import System.Environment (getArgs) -def :: [Command] -def = [ withOptions [listenOption] $ +cmd :: [Command] +cmd = [ withOptions [listenOption] $ noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $ command "webapp" paramNothing seek SectionCommon "launch webapp"] @@ -213,7 +213,7 @@ openBrowser mcmd htmlshim realurl outh errh = do #endif where p = case mcmd of - Just cmd -> proc cmd [htmlshim] + Just c -> proc c [htmlshim] Nothing -> #ifndef mingw32_HOST_OS browserProc url diff --git a/Command/Whereis.hs b/Command/Whereis.hs index d2c27eb9b..582aaffc2 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -14,8 +14,8 @@ import Command import Remote import Logs.Trust -def :: [Command] -def = [noCommit $ withOptions (jsonOption : keyOptions) $ +cmd :: [Command] +cmd = [noCommit $ withOptions (jsonOption : keyOptions) $ command "whereis" paramPaths seek SectionQuery "lists repositories that have file content"] diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs index 47c2d7ff2..ab238c85e 100644 --- a/Command/XMPPGit.hs +++ b/Command/XMPPGit.hs @@ -11,8 +11,8 @@ import Common.Annex import Command import Assistant.XMPP.Git -def :: [Command] -def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ +cmd :: [Command] +cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "xmppgit" paramNothing seek SectionPlumbing "git to XMPP relay"] @@ -37,9 +37,9 @@ gitRemoteHelper = do respond [] where expect s = do - cmd <- getLine - unless (cmd == s) $ - error $ "git-remote-helpers protocol error: expected: " ++ s ++ ", but got: " ++ cmd + gitcmd <- getLine + unless (gitcmd == s) $ + error $ "git-remote-helpers protocol error: expected: " ++ s ++ ", but got: " ++ gitcmd respond l = do mapM_ putStrLn l putStrLn "" |