diff options
| -rw-r--r-- | Messages.hs | 6 | ||||
| -rw-r--r-- | Messages/JSON.hs | 10 | ||||
| -rw-r--r-- | Remote.hs | 5 |
3 files changed, 15 insertions, 6 deletions
diff --git a/Messages.hs b/Messages.hs index 87d414f17..faa4dbcde 100644 --- a/Messages.hs +++ b/Messages.hs @@ -19,12 +19,14 @@ module Messages ( showErr, warning, indent, + maybeShowJSON, setupConsole ) where import Control.Monad.State (liftIO) import System.IO import Data.String.Utils +import Text.JSON import Types import qualified Annex @@ -106,5 +108,9 @@ handle json normal = do Annex.QuietOutput -> q Annex.JSONOutput -> liftIO json +{- Shows a JSON value only when in json mode. -} +maybeShowJSON :: JSON a => [(String, a)] -> Annex () +maybeShowJSON v = handle (JSON.add v) q + q :: Monad m => m () q = return () diff --git a/Messages/JSON.hs b/Messages/JSON.hs index ee6ea34a3..fb95f550e 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -8,9 +8,12 @@ module Messages.JSON ( start, end, - note + note, + add ) where +import Text.JSON + import qualified Utility.JSONStream as Stream start :: String -> String -> IO () @@ -20,4 +23,7 @@ end :: Bool -> IO () end b = putStr $ Stream.add [("success", b)] ++ Stream.end note :: String -> IO () -note s = putStr $ Stream.add [("note", s)] +note s = add [("note", s)] + +add :: JSON a => [(String, a)] -> IO () +add v = putStr $ Stream.add v @@ -30,7 +30,6 @@ module Remote ( ) where import Control.Monad (filterM) -import Control.Monad.State (liftIO) import Data.List import qualified Data.Map as M import Data.String.Utils @@ -47,7 +46,6 @@ import Config import Trust import LocationLog import Messages -import qualified Utility.JSONStream import RemoteLog import qualified Remote.Git @@ -134,8 +132,7 @@ prettyPrintUUIDs :: String -> [UUID] -> Annex String prettyPrintUUIDs desc uuids = do here <- getUUID =<< Annex.gitRepo m <- M.union <$> uuidMap <*> availMap - liftIO . putStr $ Utility.JSONStream.add - [(desc, map (jsonify m here) uuids)] + maybeShowJSON [(desc, map (jsonify m here) uuids)] return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids where availMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList |