summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Messages.hs6
-rw-r--r--Messages/JSON.hs10
-rw-r--r--Remote.hs5
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
diff --git a/Remote.hs b/Remote.hs
index ad1768da6..e54d2e233 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -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