json object for FileNotFound

When a nonexistant file is passed to a command and  --json-error-messages
is enabled, output a JSON object indicating the problem.

(But git ls-files --error-unmatch still displays errors about such files in
some situations.)

I don't like the duplication of the name of the command introduced by this,
but I can't see a great way around it. One way would be to pass the Command
instead.

When json is not enabled, the stderr is unchanged. This is necessary
because some commands like find have custom output. So dislaying
"find foo not found" would be wrong. So had to complicate things with
toplevelFileProblem having different output with and without json.

When not using --json-error-messages but still using --json, it displays
the error to stderr, but does display a json object without the error. It
does have an errorid though. Unsure how useful that behavior is.

Sponsored-by: Dartmouth College's Datalad project

diff --git a/CHANGELOG b/CHANGELOG
index 1dd4b21053c40ee4ece08e27b6622532d42745c3..5bd772ff73c1b5d110da80d7f99c37f747638259 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -25,6 +25,10 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
   * assistant --autostop: Avoid crashing when ~/.config/git-annex/autostart
     lists a directory that it cannot chdir to.
   * Honor --force option when operating on a local git remote.
+  * When a nonexistant file is passed to a command and 
+    --json-error-messages is enabled, output a JSON object indicating the
+    problem. (But git ls-files --error-unmatch still displays errors about
+    such files in some situations.)
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index d2815383a57f6487868b3b2b941481d70da0660e..18be0a44f7410c127517863d74c8a20b1984751d 100644 (file)
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -147,9 +147,9 @@ withPairs a params = sequence_ $
        pairs c (x:y:xs) = pairs ((x,y):c) xs
        pairs _ _ = giveup "expected pairs"
 
-withFilesToBeCommitted :: ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
-withFilesToBeCommitted a l = seekFiltered (const (pure True)) a $
-       seekHelper id WarnUnmatchWorkTreeItems (const LsFiles.stagedNotDeleted) l
+withFilesToBeCommitted :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
+withFilesToBeCommitted ww a l = seekFiltered (const (pure True)) a $
+       seekHelper id ww (const LsFiles.stagedNotDeleted) l
 
 {- unlocked pointer files that are staged, and whose content has not been
  - modified-}
@@ -512,15 +512,15 @@ seekHelper c ww a (WorkTreeItems l) = do
                and <$> sequence cleanups
 seekHelper _ _ _ NoWorkTreeItems = return ([], pure True)
 
-data WarnUnmatchWhen = WarnUnmatchLsFiles | WarnUnmatchWorkTreeItems
+data WarnUnmatchWhen = WarnUnmatchLsFiles String | WarnUnmatchWorkTreeItems String
 
 seekOptions :: WarnUnmatchWhen -> Annex [LsFiles.Options]
-seekOptions WarnUnmatchLsFiles =
+seekOptions (WarnUnmatchLsFiles _) =
        ifM (annexSkipUnknown <$> Annex.getGitConfig)
                ( return [] 
                , return [LsFiles.ErrorUnmatch]
                )
-seekOptions WarnUnmatchWorkTreeItems = return []
+seekOptions (WarnUnmatchWorkTreeItems _) = return []
 
 -- Items in the work tree, which may be files or directories.
 data WorkTreeItems
@@ -554,23 +554,23 @@ workTreeItems = workTreeItems' (AllowHidden False)
 
 workTreeItems' :: AllowHidden -> WarnUnmatchWhen -> CmdParams -> Annex WorkTreeItems
 workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
-       WarnUnmatchWorkTreeItems -> runcheck
-       WarnUnmatchLsFiles -> 
+       (WarnUnmatchWorkTreeItems action) -> runcheck action
+       (WarnUnmatchLsFiles action) -> 
                ifM (annexSkipUnknown <$> Annex.getGitConfig)
-                       ( runcheck
+                       ( runcheck action
                        , return $ WorkTreeItems ps
                        )
   where
-       runcheck = do
+       runcheck action = do
                currbranch <- getCurrentBranch
                stopattop <- prepviasymlink
                ps' <- flip filterM ps $ \p -> do
                        let p' = toRawFilePath p
                        relf <- liftIO $ relPathCwdToFile p'
                        ifM (not <$> (exists p' <||> hidden currbranch relf))
-                               ( prob (QuotedPath (toRawFilePath p) <> " not found")
+                               ( prob action FileNotFound p' "not found"
                                , ifM (viasymlink stopattop (upFrom relf))
-                                       ( prob (QuotedPath (toRawFilePath p) <> " is beyond a symbolic link")
+                                       ( prob action FileBeyondSymbolicLink p' "is beyond a symbolic link"
                                        , return True
                                        )
                                )
@@ -605,8 +605,8 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
                        <$> catObjectMetaDataHidden f currbranch
                | otherwise = return False
 
-       prob msg = do
-               toplevelWarning False msg
+       prob action errorid p msg = do
+               toplevelFileProblem False errorid msg action p Nothing (SeekInput [fromRawFilePath p])
                Annex.incError
                return False
        

diff --git a/Command/Add.hs b/Command/Add.hs
index e1e2c32e79518391c85b9272fc39ae03a0704632..3a00aaa637ca00c711d8462e25ba8fc7ee2ad7d2 100644 (file)
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -119,7 +119,7 @@ seek o = startConcurrency commandStages $ do
                        -- are not known to git yet, since this will add
                        -- them. Instead, have workTreeItems warn about other
                        -- problems, like files that don't exist.
-                       let ww = WarnUnmatchWorkTreeItems
+                       let ww = WarnUnmatchWorkTreeItems "add"
                        l <- workTreeItems ww (addThese o)
                        let go b a = a ww (commandAction . gofile b) l
                        unless (updateOnly o) $

diff --git a/Command/Copy.hs b/Command/Copy.hs
index 5c9e97dceff5eca066450d00f9e278db2ae72580..0034bb26cba2e9ca5d2d7707259ab7d8ad2506d0 100644 (file)
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -60,7 +60,7 @@ seek' o fto = startConcurrency (Command.Move.stages fto) $ do
                Batch fmt -> batchOnly (keyOptions o) (copyFiles o) $
                        batchAnnexed fmt seeker keyaction
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "copy"
        
        seeker = AnnexedFileSeeker
                { startAction = start o fto

diff --git a/Command/Drop.hs b/Command/Drop.hs
index 0a55b4937a75712a7a1149bdd5bcba5c2fd68dc2..bf0671dde871a7890f8c1c26a9187e6b6a3c285a 100644 (file)
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -74,7 +74,7 @@ seek o = startConcurrency commandStages $ do
                Batch fmt -> batchOnly (keyOptions o) (dropFiles o) $
                        batchAnnexed fmt seeker (startKeys o from)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "drop"
 
 start :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
 start o from si file key = start' o from key afile ai si

diff --git a/Command/FilterBranch.hs b/Command/FilterBranch.hs
index f552e0f4c774b720cdaeff30d75006fa6f24ce3d..0e1b0a75140d9cbf064788a845bb813d36d94e79 100644 (file)
--- a/Command/FilterBranch.hs
+++ b/Command/FilterBranch.hs
@@ -192,4 +192,4 @@ seek o = withOtherTmp $ \tmpdir -> do
        c <- inRepo $ Git.commitTree cmode cmessage [] t
        liftIO $ putStrLn (fromRef c)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "filter-branch"

diff --git a/Command/Find.hs b/Command/Find.hs
index 5dd6a4aac81a70235ce1fc0cbf4d4b84a299b5df..21e2a56bd2efcfc1135b2927f5464990d73b6447 100644 (file)
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -75,7 +75,7 @@ seek o = do
                Batch fmt -> batchOnly (keyOptions o) (findThese o) $
                        batchAnnexedFiles fmt seeker
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "find"
 
 -- Default to needing content to be present, but if the user specified a
 -- limit, content does not need to be present.

diff --git a/Command/Fix.hs b/Command/Fix.hs
index 3cfa0d8f3901799f9605ed55c2140ad2040093b5..a7aba56de2037242185fb101e47dc11cf0d80d67 100644 (file)
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -35,7 +35,7 @@ seek :: CmdParams -> CommandSeek
 seek ps = unlessM crippledFileSystem $
        withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "fix"
        seeker = AnnexedFileSeeker
                { startAction = start FixAll
                , checkContentPresent = Nothing

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index f3b18144662deec7a367745da62b74e4c4c9e523..b25e49b73e96fc326eff4057036b46e1cd751e98 100644 (file)
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -113,7 +113,7 @@ seek o = startConcurrency commandStages $ do
        cleanupIncremental i
        void $ tryIO $ recordActivity Fsck u
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "fsck"
 
 checkDeadRepo :: UUID -> Annex ()
 checkDeadRepo u =

diff --git a/Command/Get.hs b/Command/Get.hs
index f11296c76fdeaa6611869d11d65ab94e068db8f0..7d3d4a2ef14d8989787b6a8e7e34b62b77ef8c29 100644 (file)
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -53,7 +53,7 @@ seek o = startConcurrency transferStages $ do
                Batch fmt -> batchOnly (keyOptions o) (getFiles o) $
                        batchAnnexed fmt seeker (startKeys from)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "get"
 
 start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
 start o from si file key = start' expensivecheck from key afile ai si

diff --git a/Command/Inprogress.hs b/Command/Inprogress.hs
index 58c5bcfd774686344a5ad27bb6b2502a28f37b6c..8ab920242feae40a448f3b36dec130421d796237 100644 (file)
--- a/Command/Inprogress.hs
+++ b/Command/Inprogress.hs
@@ -49,7 +49,7 @@ seek o = do
                        withFilesInGitAnnex ww seeker
                                =<< workTreeItems ww (inprogressFiles o)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "inprogress"
 
 start :: IsTerminal -> S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
 start isterminal s _si _file k

diff --git a/Command/List.hs b/Command/List.hs
index 1de9d74983cdd93621e39072404cdad505f83cdc..b14c55d7078850890b162a4d0970dbd8c072612d 100644 (file)
--- a/Command/List.hs
+++ b/Command/List.hs
@@ -56,7 +56,7 @@ seek o = do
                }
        withFilesInGitAnnex ww seeker =<< workTreeItems ww (listThese o)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "list"
 
 getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]
 getList o

diff --git a/Command/Lock.hs b/Command/Lock.hs
index 352abb374503b5a30ab1bdee4393264de64268a0..d547a07f9310c2a33e8fe7e2052b8da01033cfc8 100644 (file)
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -32,7 +32,7 @@ cmd = withAnnexOptions [jsonOptions, annexedMatchingOptions] $
 seek :: CmdParams -> CommandSeek
 seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "lock"
        seeker = AnnexedFileSeeker
                { startAction = start
                , checkContentPresent = Nothing

diff --git a/Command/Log.hs b/Command/Log.hs
index 645e982675bfbd10cca41ed46812f365be016d58..cbfe0edc82d6127f1d53cc46a72f652be1343b87 100644 (file)
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -105,7 +105,7 @@ seek o = ifM (null <$> Annex.Branch.getUnmergedRefs)
        , giveup "This repository is read-only, and there are unmerged git-annex branches, which prevents displaying location log changes. (Set annex.merge-annex-branches to false to ignore the unmerged git-annex branches.)"
        )
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "log"
 
 start :: LogOptions -> (FilePath -> Outputter) -> SeekInput -> RawFilePath -> Key -> CommandStart
 start o outputter _ file key = do

diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index b0bb982793cff5eaa383a64905276e7b5fdef2bc..b01b751641480010e9fb4950939c61988dc4c0ef 100644 (file)
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -76,7 +76,7 @@ seek :: MetaDataOptions -> CommandSeek
 seek o = case batchOption o of
        NoBatch -> do
                c <- currentVectorClock
-               let ww = WarnUnmatchLsFiles
+               let ww = WarnUnmatchLsFiles "metadata"
                let seeker = AnnexedFileSeeker
                        { startAction = start c o
                        , checkContentPresent = Nothing

diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index f4fb63235342f24325a0b6a41dc4e1759381d805..42f119fffa0959000493fb026a485b97b7588cb9 100644 (file)
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -41,7 +41,7 @@ optParser desc = MigrateOptions
 seek :: MigrateOptions -> CommandSeek
 seek o = withFilesInGitAnnex ww seeker =<< workTreeItems ww (migrateThese o)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "migrate"
        seeker = AnnexedFileSeeker
                { startAction = start o
                , checkContentPresent = Nothing

diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index f169aae9283eddd0479b2691452f33d1fa7dfed9..8ec97e467f3f0e6ada21d758dba0ea280bab85c7 100644 (file)
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -50,7 +50,7 @@ seek o = startConcurrency stages $
        stages = case fromToOptions o of
                FromRemote _ -> transferStages
                ToRemote _ -> commandStages
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "mirror"
        seeker = AnnexedFileSeeker
                { startAction = start o
                , checkContentPresent = Nothing

diff --git a/Command/Move.hs b/Command/Move.hs
index fb3cd03ffaefba284c2aafab790ec4e939135b1b..77f7d6d3f17c89b6f165be3f412cab0c181ab4cf 100644 (file)
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -84,7 +84,7 @@ seek' o fto = startConcurrency (stages fto) $ do
                , usesLocationLog = True
                }
        keyaction = startKey fto (removeWhen o)
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "move"
 
 stages :: FromToHereOptions -> UsedStages
 stages (FromOrToRemote (FromRemote _)) = transferStages

diff --git a/Command/Multicast.hs b/Command/Multicast.hs
index faa0a09aa1fb1b6b6cd0c0a5db04e28892147ba7..112a36404693fad99cb3fe9b5900a9ab94612def 100644 (file)
--- a/Command/Multicast.hs
+++ b/Command/Multicast.hs
@@ -131,7 +131,7 @@ send ups fs = do
        -- expensive.
        starting "sending files" (ActionItemOther Nothing) (SeekInput []) $
                withTmpFile "send" $ \t h -> do
-                       let ww = WarnUnmatchLsFiles
+                       let ww = WarnUnmatchLsFiles "multicast"
                        (fs', cleanup) <- seekHelper id ww LsFiles.inRepo
                                =<< workTreeItems ww fs
                        matcher <- Limit.getMatcher

diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index dbb2ce3e2568a120046b8acac5ae687d0fb9c283..d8fdeea197c888a6e4b0bb9eedea68c9be5ccd7c 100644 (file)
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -32,10 +32,10 @@ cmd = command "pre-commit" SectionPlumbing
 
 seek :: CmdParams -> CommandSeek
 seek ps = do
-       let ww = WarnUnmatchWorkTreeItems
+       let ww = WarnUnmatchWorkTreeItems "pre-commit"
        l <- workTreeItems ww ps
        -- fix symlinks to files being committed
-       flip withFilesToBeCommitted l $ \(si, f) -> commandAction $
+       flip (withFilesToBeCommitted ww) l $ \(si, f) -> commandAction $
                maybe stop (Command.Fix.start Command.Fix.FixSymlinks si f)
                        =<< isAnnexLink f
        -- after a merge conflict or git cherry-pick or stash, pointer

diff --git a/Command/Sync.hs b/Command/Sync.hs
index 3806184a9e4988982f22101bb8277cc001b33885..def4d81c547dd378986b9a741bda46d4ff29dbf3 100644 (file)
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -794,7 +794,7 @@ seekSyncContent o rs currbranch = do
                in seekFiltered (const (pure True)) filterer $
                        seekHelper id ww (LsFiles.inRepoOrBranch origbranch) l 
 
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "sync"
 
        gofile bloom mvar _ f k = 
                go (Right bloom) mvar (AssociatedFile (Just f)) k

diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index d876f79b0631b15c60967fc80fb33041693be65b..799a31ef8dd76ac94da5dd97ad732e1605c8b790 100644 (file)
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -30,7 +30,7 @@ cmd = withAnnexOptions [annexedMatchingOptions] $
 seek :: CmdParams -> CommandSeek
 seek ps = withFilesInGitAnnex ww (seeker False) =<< workTreeItems ww ps
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "unannex"
 
 seeker :: Bool -> AnnexedFileSeeker
 seeker fast = AnnexedFileSeeker

diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 57057e58f4a0b898b41c8decb693da56de374b88..aee530e796698be0d59adcc625cd0694f2baee18 100644 (file)
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -53,13 +53,13 @@ seek ps = do
        l <- workTreeItems ww ps
        withFilesNotInGit
                (CheckGitIgnore False)
-               WarnUnmatchWorkTreeItems
+               (WarnUnmatchWorkTreeItems "uninit")
                checksymlinks
                l
        withFilesInGitAnnex ww (Command.Unannex.seeker True) l
        finish
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "uninit"
        checksymlinks (_, f) = 
                commandAction $ lookupKey f >>= \case
                        Nothing -> stop

diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index d338c00dcd4df153563e3fa861419f56ead13a18..c0c79a7a6ad0b687a115481de50e1bc01d715afa 100644 (file)
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -33,7 +33,7 @@ mkcmd n d = withAnnexOptions [jsonOptions, annexedMatchingOptions] $
 seek :: CmdParams -> CommandSeek
 seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "unlock"
        seeker = AnnexedFileSeeker
                { startAction = start
                , checkContentPresent = Nothing

diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index 9052147249e965ed00491651dc17bf9614353549..c8ca119ed6d8a223f20bd868ea379529c4a78df2 100644 (file)
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -64,7 +64,7 @@ seek o = do
                Batch fmt -> batchOnly (keyOptions o) (whereisFiles o) $
                        batchAnnexed fmt seeker (startKeys o m)
   where
-       ww = WarnUnmatchLsFiles
+       ww = WarnUnmatchLsFiles "whereis"
 
 start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
 start o remotemap si file key = 

diff --git a/Messages.hs b/Messages.hs
index 565822365c71eb787233ef8adbde28a545dbbdf5..78efd4873f39f93fa1268bc1acfff3805eb355e6 100644 (file)
--- a/Messages.hs
+++ b/Messages.hs
@@ -27,6 +27,8 @@ module Messages (
        showEndFail,
        showEndResult,
        endResult,
+       ErrorId(..),
+       toplevelFileProblem,
        toplevelWarning,
        warning,
        earlyWarning,
@@ -34,6 +36,7 @@ module Messages (
        indent,
        JSON.JSONChunk(..),
        maybeShowJSON,
+       maybeShowJSON',
        showFullJSON,
        showCustom,
        showHeader,
@@ -197,8 +200,18 @@ endResult :: Bool -> S.ByteString
 endResult True = "ok"
 endResult False = "failed"
 
+toplevelMsg :: StringContainingQuotedPath -> StringContainingQuotedPath
+toplevelMsg = ("git-annex: " <>)
+
+toplevelFileProblem :: Bool -> ErrorId -> StringContainingQuotedPath -> String -> RawFilePath -> Maybe Key -> SeekInput -> Annex ()
+toplevelFileProblem makeway errorid msg action file mkey si = do
+       maybeShowJSON' $ JSON.start action (Just file) mkey si
+       maybeShowJSON' $ JSON.errorid errorid
+       warning' makeway id (toplevelMsg (QuotedPath file <> " " <> msg))
+       maybeShowJSON' $ JSON.end False
+
 toplevelWarning :: Bool -> StringContainingQuotedPath -> Annex ()
-toplevelWarning makeway s = warning' makeway id ("git-annex: " <> s)
+toplevelWarning makeway s = warning' makeway id (toplevelMsg s)
 
 warning :: StringContainingQuotedPath -> Annex ()
 warning = warning' True indent
@@ -207,10 +220,10 @@ earlyWarning :: StringContainingQuotedPath -> Annex ()
 earlyWarning = warning' False id
 
 warning' :: Bool -> (S.ByteString -> S.ByteString) -> StringContainingQuotedPath -> Annex ()
-warning' makeway consolewhitespacef w = do
+warning' makeway consolewhitespacef msg = do
        when makeway $
                outputMessage JSON.none id "\n"
-       outputError (\s -> consolewhitespacef s <> "\n") w
+       outputError (\s -> consolewhitespacef s <> "\n") msg
 
 {- Not concurrent output safe. -}
 warningIO :: String -> IO ()
@@ -226,6 +239,9 @@ indent = S.intercalate "\n" . map ("  " <>) . S8.lines
 maybeShowJSON :: JSON.JSONChunk v -> Annex ()
 maybeShowJSON v = void $ withMessageState $ bufferJSON (JSON.add v)
 
+maybeShowJSON' :: JSON.JSONBuilder -> Annex ()
+maybeShowJSON' v = void $ withMessageState $ bufferJSON v
+
 {- Shows a complete JSON value, only when in json mode. -}
 showFullJSON :: JSON.JSONChunk v -> Annex Bool
 showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)

diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index 8960dd04a24905adb973cde92d00958dc93d166b..9f569c09ea2f98b201c8734a2f15e4295a5fd6c4 100644 (file)
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -20,6 +20,7 @@ module Messages.JSON (
        addErrorMessage,
        note,
        info,
+       errorid,
        add,
        complete,
        progress,
@@ -51,6 +52,7 @@ import Utility.Metered
 import Utility.Percentage
 import Utility.Aeson
 import Utility.FileSystemEncoding
+import Types.Messages
 
 -- A global lock to avoid concurrent threads emitting json at the same time.
 {-# NOINLINE emitLock #-}
@@ -68,7 +70,8 @@ emit' b = do
        putMVar emitLock ()
 
 -- Building up a JSON object can be done by first using start,
--- then add and note any number of times, and finally complete.
+-- then add and note and errorid any number of times, and finally
+-- complete.
 type JSONBuilder = Maybe (Object, Bool) -> Maybe (Object, Bool)
 
 none :: JSONBuilder
@@ -112,6 +115,12 @@ note s (Just (o, e)) = Just (HM.unionWith combinelines (HM.singleton "note" (toJ
                String (old <> "\n" <> new)
        combinelines new _old = new
 
+errorid :: ErrorId -> JSONBuilder
+errorid _ Nothing = Nothing
+errorid eid (Just (o, e)) = Just (HM.unionWith replaceold (HM.singleton "errorid" (toJSON' (show eid))) o, e)
+  where
+       replaceold new _old = new
+
 info :: String -> JSONBuilder
 info s _ = case j of
        Object o -> Just (o, True)

diff --git a/Types/Messages.hs b/Types/Messages.hs
index e80dc86d63f09b69657a586f286622a6d0ab116b..15cbfc2a7488d7034e0cb50771d63e9e1fa9eb87 100644 (file)
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -84,3 +84,9 @@ data SerializedOutput
 data SerializedOutputResponse
        = ReadyPrompt
        deriving (Eq, Show)
+
+-- | Error identifiers. Avoid changing these.
+data ErrorId
+       = FileNotFound
+       | FileBeyondSymbolicLink
+       deriving (Show)

diff --git a/doc/todo/api_for_telling_when_nonexistant_or_non_git_files_passed/comment_8_2550e1760dcfb90c9c2ca1ee145adcf1._comment b/doc/todo/api_for_telling_when_nonexistant_or_non_git_files_passed/comment_8_2550e1760dcfb90c9c2ca1ee145adcf1._comment
new file mode 100644 (file)
index 0000000..a72b9b3
--- /dev/null
+++ b/doc/todo/api_for_telling_when_nonexistant_or_non_git_files_passed/comment_8_2550e1760dcfb90c9c2ca1ee145adcf1._comment
@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2023-04-25T22:45:24Z"
+ content="""
+Ok, implemented the simple alternative. Here's how it looks:
+
+       joey@darkstar:~/tmp/xxx>git-annex add 'dne' --json --json-error-messages
+       {"command":"add","error-messages":["git-annex: dne not found"],"errorid":"FileNotFound","file":"dne","input":["dne"],"success":false}
+       add: 1 failed
+
+The errorid will remain stable. I can add those to other error messages
+now, on request BTW.
+
+Note that when git-annex relies on `git ls-files --error-unmatch` to
+complain about nonexistant or non-git files, the error messages from
+git will still be displayed to stderr, not this nice json. So
+datalad will need to keep its parser for that part.
+"""]]