add: Display progress meter when hashing files.

* add: Display progress meter when hashing files.
* add: Support --json-progress option.

CHANGELOG

@@ -14,6 +14,8 @@ git-annex (7.20190616) UNRELEASED; urgency=medium
     output the feed content that was downloaded.
   * init: Fix a reversion in the last release that prevented automatically
     generating and setting a description for the repository.
+  * add: Display progress meter when hashing files.
+  * add: Support --json-progress option.
 
  -- Joey Hess <id@joeyh.name>  Sat, 15 Jun 2019 12:38:25 -0400
 

Command/Add.hs

@@ -20,12 +20,12 @@ import Annex.FileMatcher
 import Annex.Link
 import Annex.Version
 import Annex.Tmp
+import Messages.Progress
 import Git.FilePath
-import Utility.Metered
 
 cmd :: Command
 cmd = notBareRepo $ 
-	withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $
+	withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, fileMatchingOptions] $
 		command "add" SectionCommon "add files to annex"
 			paramPaths (seek <$$> optParser)
 
@@ -142,7 +142,11 @@ perform file = withOtherTmp $ \tmpdir -> do
 		{ lockingFile = lockingfile
 		, hardlinkFileTmpDir = Just tmpdir
 		}
-	lockDown cfg file >>= ingestAdd nullMeterUpdate >>= finish
+	ld <- lockDown cfg file
+	let sizer = keySource <$> ld
+	v <- metered Nothing sizer $ \_meter meterupdate ->
+		ingestAdd meterupdate ld
+	finish v
   where
 	finish (Just key) = next $ cleanup key True
 	finish Nothing = stop

Messages/Progress.hs

@@ -15,6 +15,8 @@ import Utility.Metered
 import Types
 import Types.Messages
 import Types.Key
+import Types.KeySource
+import Utility.InodeCache
 import qualified Messages.JSON as JSON
 import Messages.Concurrent
 
@@ -24,14 +26,24 @@ import qualified System.Console.Concurrent as Console
 {- Class of things from which a size can be gotten to display a progress
  - meter. -}
 class MeterSize t where
-	getMeterSize :: t -> Annex (Maybe Integer)
+	getMeterSize :: t -> Annex (Maybe FileSize)
 
-instance MeterSize (Maybe Integer) where
+instance MeterSize t => MeterSize (Maybe t) where
-	getMeterSize = pure
+	getMeterSize Nothing = pure Nothing
+	getMeterSize (Just t) = getMeterSize t
+
+instance MeterSize FileSize where
+	getMeterSize = pure . Just
 
 instance MeterSize Key where
 	getMeterSize = pure . keySize
 
+instance MeterSize InodeCache where
+	getMeterSize = pure . Just . inodeCacheFileSize
+
+instance MeterSize KeySource where
+	getMeterSize = maybe (pure Nothing) getMeterSize . inodeCache
+
 {- When the key's size is not known, the file is statted to get the size.
  - This allows uploads of keys without size to still have progress
  - displayed.

Utility/InodeCache.hs

@@ -13,6 +13,7 @@
 module Utility.InodeCache (
 	InodeCache,
 	InodeComparisonType(..),
+	inodeCacheFileSize,
 
 	compareStrong,
 	compareWeak,
@@ -58,6 +59,9 @@ data InodeCachePrim = InodeCachePrim FileID FileSize MTime
 newtype InodeCache = InodeCache InodeCachePrim
 	deriving (Show)
 
+inodeCacheFileSize :: InodeCache -> FileSize
+inodeCacheFileSize (InodeCache (InodeCachePrim _ sz _)) = sz
+
 {- Inode caches can be compared in two different ways, either weakly
  - or strongly. -}
 data InodeComparisonType = Weakly | Strongly

debian/control

@@ -12,6 +12,7 @@ Build-Depends:
 	libghc-pcre-light-dev,
 	libghc-cryptonite-dev,
 	libghc-memory-dev,
+	libghc-deepseq-dev,
 	libghc-attoparsec-dev,
 	libghc-sandi-dev,
 	libghc-utf8-string-dev,

doc/git-annex-add.mdwn

@@ -68,6 +68,10 @@ annexed content, and other symlinks.
   Enable JSON output. This is intended to be parsed by programs that use
   git-annex. Each line of output is a JSON object.
 
+* `--json-progress`
+
+  Include progress objects in JSON output.
+
 * `--json-error-messages`
 
   Messages that would normally be output to standard error are included in

doc/todo/add_--json-progress_to___96__git_annex_add__96__.mdwn

@@ -3,3 +3,5 @@ ATM there is no `--json-progress` in `git annex add` (only `--json`), so no feed
 Cheers!
 
 [[!meta author=yoh]]
+
+> [[done]] --[[Joey]]