log: Support --json and --json-error-messages

Also in passing the --all display was fixed up to not quote keys like filenames.

Note that the check added to compareChanges was needed to avoid logging when
nothing changed.

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project

diff --git a/CHANGELOG b/CHANGELOG
index 5a8daf83a46fe82ffcd04ed771be4685329b9b54..2c07cca73daed55a07548f85c5fd1b945e136076 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -37,7 +37,7 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
     of core.sharedRepository and umask.
   * initremote: Avoid creating a remote that is not encrypted when gpg is
     broken.
-  * rmurl, unannex: Support --json and --json-error-messages.
+  * log, rmurl, unannex: Support --json and --json-error-messages.
   * log: When --raw-date is used, display only seconds from the epoch, as
     documented, omitting a trailing "s" that was included in the output
     before.

diff --git a/Command/Log.hs b/Command/Log.hs
index e7079b11fc0f6f14cad5aee9f7ff1f46046c5ce0..c6a53451d480f909b827c9115533462656abbbdc 100644 (file)
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -89,7 +89,7 @@ seek o = ifM (null <$> Annex.Branch.getUnmergedRefs)
        ( do
                m <- Remote.uuidDescriptions
                zone <- liftIO getCurrentTimeZone
-               let outputter = mkOutputter m zone o
+               outputter <- mkOutputter m zone o <$> jsonOutputEnabled
                let seeker = AnnexedFileSeeker
                        { startAction = start o outputter
                        , checkContentPresent = Nothing
@@ -107,17 +107,18 @@ seek o = ifM (null <$> Annex.Branch.getUnmergedRefs)
   where
        ww = WarnUnmatchLsFiles "log"
 
-start :: LogOptions -> (FilePath -> Outputter) -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o outputter _ file key = do
+start :: LogOptions -> (ActionItem -> SeekInput -> Outputter) -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o outputter si file key = do
        (changes, cleanup) <- getKeyLog key (passthruOptions o)
-       showLogIncremental (outputter (fromRawFilePath file)) changes
+       let ai = mkActionItem (file, key)
+       showLogIncremental (outputter ai si) changes
        void $ liftIO cleanup
        stop
 
-startAll :: LogOptions -> (String -> Outputter) -> CommandStart
+startAll :: LogOptions -> (ActionItem -> SeekInput -> Outputter) -> CommandStart
 startAll o outputter = do
        (changes, cleanup) <- getAllLog (passthruOptions o)
-       showLog outputter changes
+       showLog (\ai -> outputter ai (SeekInput [])) changes
        void $ liftIO cleanup
        stop
 
@@ -152,24 +153,25 @@ showLogIncremental outputter ps = do
 {- Displays changes made. Streams, and can display changes affecting
  - different keys, but does twice as much reading of logged values
  - as showLogIncremental. -}
-showLog :: (String -> Outputter) -> [RefChange] -> Annex ()
+showLog :: (ActionItem -> Outputter) -> [RefChange] -> Annex ()
 showLog outputter cs = forM_ cs $ \c -> do
-       let keyname = serializeKey (changekey c)
+       let ai = mkActionItem (changekey c)
        new <- S.fromList <$> loggedLocationsRef (newref c)
        old <- S.fromList <$> loggedLocationsRef (oldref c)
-       sequence_ $ compareChanges (outputter keyname)
+       sequence_ $ compareChanges (outputter ai)
                [(changetime c, new, old)]
 
-mkOutputter :: UUIDDescMap -> TimeZone -> LogOptions -> FilePath -> Outputter
-mkOutputter m zone o file
-       | rawDateOption o = normalOutput lookupdescription file rawTimeStamp
-       | gourceOption o = gourceOutput lookupdescription file
-       | otherwise = normalOutput lookupdescription file (showTimeStamp zone)
+mkOutputter :: UUIDDescMap -> TimeZone -> LogOptions -> Bool -> ActionItem -> SeekInput -> Outputter
+mkOutputter m zone o jsonenabled ai si
+       | jsonenabled = jsonOutput m ai si
+       | rawDateOption o = normalOutput lookupdescription ai rawTimeStamp
+       | gourceOption o = gourceOutput lookupdescription ai 
+       | otherwise = normalOutput lookupdescription ai (showTimeStamp zone)
   where
        lookupdescription u = maybe (fromUUID u) (fromUUIDDesc) (M.lookup u m)
 
-normalOutput :: (UUID -> String) -> FilePath -> (POSIXTime -> String) -> Outputter
-normalOutput lookupdescription file formattime logchange ts us = do
+normalOutput :: (UUID -> String) -> ActionItem -> (POSIXTime -> String) -> Outputter
+normalOutput lookupdescription ai formattime logchange ts us = do
        qp <- coreQuotePath <$> Annex.getGitConfig
        liftIO $ mapM_ (B8.putStrLn . quote qp . format) us
   where
@@ -177,19 +179,38 @@ normalOutput lookupdescription file formattime logchange ts us = do
        addel = case logchange of
                Added -> "+"
                Removed -> "-"
-       format u = UnquotedString addel <> " " <> UnquotedString time <> " " 
-               <> QuotedPath (toRawFilePath file) <> " | " <> UnquotedByteString (fromUUID u)
-               <> " -- " <> UnquotedString (lookupdescription u)
+       format u = UnquotedString addel <> " " 
+               <> UnquotedString time <> " " 
+               <> actionItemDesc ai <> " | " 
+               <> UnquotedByteString (fromUUID u) <> " -- "
+               <> UnquotedString (lookupdescription u)
 
-gourceOutput :: (UUID -> String) -> FilePath -> Outputter
-gourceOutput lookupdescription file logchange ts us =
+jsonOutput :: UUIDDescMap -> ActionItem -> SeekInput -> Outputter
+jsonOutput m ai si logchange ts us = do
+       showStartMessage $ StartMessage "log" ai si
+       maybeShowJSON $ JSONChunk
+               [ ("logged", case logchange of
+                       Added -> "addition"
+                       Removed -> "removal")
+               , ("date", rawTimeStamp ts)
+               ]
+       void $ Remote.prettyPrintUUIDsDescs "locations" m us
+       showEndOk
+
+gourceOutput :: (UUID -> String) -> ActionItem -> Outputter
+gourceOutput lookupdescription ai logchange ts us =
        liftIO $ mapM_ (putStrLn . intercalate "|" . format) us
   where
        time = takeWhile isDigit $ show ts
        addel = case logchange of
                Added -> "A" 
                Removed -> "M"
-       format u = [ time, lookupdescription u, addel, file ]
+       format u =
+               [ time
+               , lookupdescription u
+               , addel
+               , decodeBS (noquote (actionItemDesc ai))
+               ]
 
 {- Generates a display of the changes.
  - Uses a formatter to generate a display of items that are added and
@@ -197,10 +218,12 @@ gourceOutput lookupdescription file logchange ts us =
 compareChanges :: Ord a => (LogChange -> POSIXTime -> [a] -> b) -> [(POSIXTime, S.Set a, S.Set a)] -> [b]
 compareChanges format changes = concatMap diff changes
   where
-       diff (ts, new, old) =
-               [ format Added ts   $ S.toList $ S.difference new old
-               , format Removed ts $ S.toList $ S.difference old new
-               ]
+       diff (ts, new, old)
+               | new == old = []
+               | otherwise = 
+                       [ format Added ts   $ S.toList $ S.difference new old
+                       , format Removed ts $ S.toList $ S.difference old new
+                       ]
 
 {- Streams the git log for a given key's location log file.
  -

diff --git a/doc/git-annex-log.mdwn b/doc/git-annex-log.mdwn
index 5aeee9b08b86d0413b7b182f5c3d41b108fa8c58..0361dac30662bf5e007228c74e14f32edde284dd 100644 (file)
--- a/doc/git-annex-log.mdwn
+++ b/doc/git-annex-log.mdwn
@@ -39,6 +39,16 @@ false, information may not have been committed to the branch yet.
 
   Generates output suitable for the `gource` visualization program.
 
+* `--json`
+
+  Enable JSON output. This is intended to be parsed by programs that use
+  git-annex. Each line of output is a JSON object.
+
+* `--json-error-messages`
+
+  Messages that would normally be output to standard error are included in
+  the JSON instead.
+
 * matching options
   
   The [[git-annex-matching-options]](1)

diff --git a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
index c05fe4df8bb8b8445d8137701ebd85f29b854094..9d4c8edd7324f24e3a3957e8a43c71c0545e0899 100644 (file)
--- a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
+++ b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
@@ -6,13 +6,13 @@ While looking for various spots where `core.quotepath=true` is now treated by gi
 These commands have been updated to support --json:
 
 * git-annex-unannex
+* git-annex-rmurl 
+* git-annex-log
 
 Provisional list of commands that don't support --json and maybe should:
 
 (Feel free to reorder things to the top)
 
-* git-annex-log
-* git-annex-rmurl 
 * git-annex-addunused
 * git-annex-adjust
 * git-annex-assistant