diff options
| -rw-r--r-- | Annex.hs | 2 | ||||
| -rw-r--r-- | Messages.hs | 61 | ||||
| -rw-r--r-- | Messages/JSON.hs | 23 | ||||
| -rw-r--r-- | Options.hs | 2 | ||||
| -rw-r--r-- | Utility/JSONStream.hs | 44 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | debian/control | 1 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 10 | ||||
| -rw-r--r-- | doc/install.mdwn | 1 |
9 files changed, 123 insertions, 22 deletions
@@ -64,7 +64,7 @@ data AnnexState = AnnexState , cipher :: Maybe Cipher } -data OutputType = NormalOutput | QuietOutput +data OutputType = NormalOutput | QuietOutput | JSONOutput newState :: Git.Repo -> AnnexState newState gitrepo = AnnexState diff --git a/Messages.hs b/Messages.hs index b2c871ede..87d414f17 100644 --- a/Messages.hs +++ b/Messages.hs @@ -5,7 +5,22 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Messages where +module Messages ( + showStart, + showNote, + showAction, + showProgress, + showSideAction, + showOutput, + showLongNote, + showEndOk, + showEndFail, + showEndResult, + showErr, + warning, + indent, + setupConsole +) where import Control.Monad.State (liftIO) import System.IO @@ -13,21 +28,15 @@ import Data.String.Utils import Types import qualified Annex - -verbose :: Annex () -> Annex () -verbose a = do - output <- Annex.getState Annex.output - case output of - Annex.NormalOutput -> a - _ -> return () +import qualified Messages.JSON as JSON showStart :: String -> String -> Annex () -showStart command file = verbose $ liftIO $ do +showStart command file = handle (JSON.start command file) $ do putStr $ command ++ " " ++ file ++ " " hFlush stdout showNote :: String -> Annex () -showNote s = verbose $ liftIO $ do +showNote s = handle (JSON.note s) $ do putStr $ "(" ++ s ++ ") " hFlush stdout @@ -35,28 +44,31 @@ showAction :: String -> Annex () showAction s = showNote $ s ++ "..." showProgress :: Annex () -showProgress = verbose $ liftIO $ do +showProgress = handle q $ do putStr "." hFlush stdout showSideAction :: String -> Annex () -showSideAction s = verbose $ liftIO $ putStrLn $ "(" ++ s ++ "...)" +showSideAction s = handle q $ putStrLn $ "(" ++ s ++ "...)" showOutput :: Annex () -showOutput = verbose $ liftIO $ putStr "\n" +showOutput = handle q $ putStr "\n" showLongNote :: String -> Annex () -showLongNote s = verbose $ liftIO $ putStr $ '\n' : indent s +showLongNote s = handle (JSON.note s) $ putStr $ '\n' : indent s showEndOk :: Annex () -showEndOk = verbose $ liftIO $ putStrLn "ok" +showEndOk = showEndResult True showEndFail :: Annex () -showEndFail = verbose $ liftIO $ putStrLn "failed" +showEndFail = showEndResult False showEndResult :: Bool -> Annex () -showEndResult True = showEndOk -showEndResult False = showEndFail +showEndResult b = handle (JSON.end b) $ putStrLn msg + where + msg + | b = "ok" + | otherwise = "failed" showErr :: (Show a) => a -> Annex () showErr e = liftIO $ do @@ -65,7 +77,7 @@ showErr e = liftIO $ do warning :: String -> Annex () warning w = do - verbose $ liftIO $ putStr "\n" + handle q $ putStr "\n" liftIO $ do hFlush stdout hPutStrLn stderr $ indent w @@ -85,3 +97,14 @@ setupConsole :: IO () setupConsole = do hSetBinaryMode stdout True hSetBinaryMode stderr True + +handle :: IO () -> IO () -> Annex () +handle json normal = do + output <- Annex.getState Annex.output + case output of + Annex.NormalOutput -> liftIO normal + Annex.QuietOutput -> q + Annex.JSONOutput -> liftIO json + +q :: Monad m => m () +q = return () diff --git a/Messages/JSON.hs b/Messages/JSON.hs new file mode 100644 index 000000000..ee6ea34a3 --- /dev/null +++ b/Messages/JSON.hs @@ -0,0 +1,23 @@ +{- git-annex JSON output + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Messages.JSON ( + start, + end, + note +) where + +import qualified Utility.JSONStream as Stream + +start :: String -> String -> IO () +start command file = putStr $ Stream.start [("command", command), ("file", file)] + +end :: Bool -> IO () +end b = putStr $ Stream.add [("success", b)] ++ Stream.end + +note :: String -> IO () +note s = putStr $ Stream.add [("note", s)] diff --git a/Options.hs b/Options.hs index 768a1c289..e0ca48c01 100644 --- a/Options.hs +++ b/Options.hs @@ -30,6 +30,8 @@ commonOptions = "avoid verbose output" , Option ['v'] ["verbose"] (NoArg (setoutput Annex.NormalOutput)) "allow verbose output (default)" + , Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput)) + "enable JSON output" , Option ['d'] ["debug"] (NoArg (setdebug)) "show debug messages" , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) diff --git a/Utility/JSONStream.hs b/Utility/JSONStream.hs new file mode 100644 index 000000000..af3766948 --- /dev/null +++ b/Utility/JSONStream.hs @@ -0,0 +1,44 @@ +{- Streaming JSON output. + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.JSONStream ( + start, + add, + end +) where + +import Text.JSON + +{- Text.JSON does not support building up a larger JSON document piece by + piece as a stream. To support streaming, a hack. The JSObject is converted + to a string with its final "}" is left off, allowing it to be added to + later. -} +start :: JSON a => [(String, a)] -> String +start l + | last s == endchar = take (length s - 1) s + | otherwise = bad s + where + s = encodeStrict $ toJSObject l + +add :: JSON a => [(String, a)] -> String +add l + | head s == startchar = ',' : drop 1 s + | otherwise = bad s + where + s = start l + +end :: String +end = [endchar, '\n'] + +startchar :: Char +startchar = '{' + +endchar :: Char +endchar = '}' + +bad :: String -> a +bad s = error $ "Text.JSON returned unexpected string: " ++ s diff --git a/debian/changelog b/debian/changelog index 4ee0b80f2..ca23ab473 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,7 @@ git-annex (3.20110820) UNRELEASED; urgency=low * init: Make description an optional parameter. * unused, status: Sped up by avoiding unnecessary stats of annexed files. * unused --remote: Reduced memory use to 1/4th what was used before. + * Add --json switch, to produce machine-consumable output. -- Joey Hess <joeyh@debian.org> Tue, 23 Aug 2011 13:41:01 -0400 diff --git a/debian/control b/debian/control index 63488dc68..cb5a8212a 100644 --- a/debian/control +++ b/debian/control @@ -14,6 +14,7 @@ Build-Depends: libghc-hs3-dev (>= 0.5.6), libghc-testpack-dev [any-i386 any-amd64], libghc-monad-control-dev, + libghc-json-dev, ikiwiki, perlmagick, git | git-core, diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index e7ac9adf7..0a484a384 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -337,12 +337,18 @@ Many git-annex commands will stage changes for later `git commit` by you. * --quiet - Avoid the default verbose logging of what is done; only show errors + Avoid the default verbose display of what is done; only show errors and progress displays. * --verbose - Enable verbose logging. + Enable verbose display. + +* --json + + Rather than the normal output, generate JSON. This is intended to be + parsed by programs that use git-annex. Each line of output is a JSON + object. * --debug diff --git a/doc/install.mdwn b/doc/install.mdwn index ac521da18..cd51b96d2 100644 --- a/doc/install.mdwn +++ b/doc/install.mdwn @@ -28,6 +28,7 @@ To build and use git-annex, you will need: * [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck) * [HTTP](http://hackage.haskell.org/package/HTTP) * [hS3](http://hackage.haskell.org/package/hS3) (optional, but recommended) + * [json](http://hackage.haskell.org/package/json) * Shell commands * [git](http://git-scm.com/) * [uuid](http://www.ossp.org/pkg/lib/uuid/) |