Removed dependency on json library; all JSON is now handled by aeson.

I've eyeballed all --json commands, and the only difference should be
that some fields are re-ordered.

CHANGELOG

@@ -12,6 +12,7 @@ git-annex (6.20160726) UNRELEASED; urgency=medium
     since aws 0.14.0 is not compatible with the newer version.
   * git-annex.cabal: Temporarily limit to persistent <2.5
     since esqueleto 2.4.3 is not compatible with the newer version.
+  * Removed dependency on json library; all JSON is now handled by aeson.
 
  -- Joey Hess <id@joeyh.name>  Wed, 20 Jul 2016 12:03:15 -0400
 

Command/Add.hs

@@ -146,7 +146,7 @@ perform file = do
 
 cleanup :: Key -> Bool -> CommandCleanup
 cleanup key hascontent = do
-	maybeShowJSON $ JSONObject [("key", key2file key)]
+	maybeShowJSON $ JSONChunk [("key", key2file key)]
 	when hascontent $
 		logStatus key InfoPresent
 	return True

Command/AddUrl.hs

@@ -356,7 +356,7 @@ cleanup u url file key mtmp = case mtmp of
 			)
   where
 	go = do
-		maybeShowJSON $ JSONObject [("key", key2file key)]
+		maybeShowJSON $ JSONChunk [("key", key2file key)]
 		when (isJust mtmp) $
 			logStatus key InfoPresent
 		setUrlPresent u key url

Command/Find.hs

@@ -66,7 +66,7 @@ start o file key = ifM (limited <||> inAnnex key)
 
 showFormatted :: Maybe Utility.Format.Format -> String -> [(String, String)] -> Annex ()
 showFormatted format unformatted vars =
-	unlessM (showFullJSON $ JSONObject vars) $
+	unlessM (showFullJSON $ JSONChunk vars) $
 		case format of
 			Nothing -> liftIO $ putStrLn unformatted
 			Just formatter -> liftIO $ putStr $

Command/Info.hs

@@ -11,8 +11,9 @@ module Command.Info where
 
 import "mtl" Control.Monad.State.Strict
 import qualified Data.Map.Strict as M
-import Text.JSON
+import qualified Data.Text as T
 import Data.Ord
+import Data.Aeson hiding (json)
 
 import Command
 import qualified Git
@@ -34,7 +35,7 @@ import Logs.Transfer
 import Types.TrustLevel
 import Types.FileMatcher
 import qualified Limit
-import Messages.JSON (DualDisp(..))
+import Messages.JSON (DualDisp(..), ObjectMap(..))
 import Annex.BloomFilter
 import qualified Command.Unused
 
@@ -247,10 +248,10 @@ simpleStat desc getval = stat desc $ json id getval
 nostat :: Stat
 nostat = return Nothing
 
-json :: JSON j => (j -> String) -> StatState j -> String -> StatState String
+json :: ToJSON j => (j -> String) -> StatState j -> String -> StatState String
 json fmt a desc = do
 	j <- a
-	lift $ maybeShowJSON $ JSONObject [(desc, j)]
+	lift $ maybeShowJSON $ JSONChunk [(desc, j)]
 	return $ fmt j
 
 nojson :: StatState String -> String -> StatState String
@@ -374,7 +375,7 @@ transfer_list :: Stat
 transfer_list = stat desc $ nojson $ lift $ do
 	uuidmap <- Remote.remoteMap id
 	ts <- getTransfers
-	maybeShowJSON $ JSONObject [(desc, map (uncurry jsonify) ts)]
+	maybeShowJSON $ JSONChunk [(desc, map (uncurry jsonify) ts)]
 	return $ if null ts
 		then "none"
 		else multiLine $
@@ -388,11 +389,11 @@ transfer_list = stat desc $ nojson $ lift $ do
 		, maybe (fromUUID $ transferUUID t) Remote.name $
 			M.lookup (transferUUID t) uuidmap
 		]
-	jsonify t i = toJSObject
-		[ ("transfer", showLcDirection (transferDirection t))
-		, ("key", key2file (transferKey t))
-		, ("file", fromMaybe "" (associatedFile i))
-		, ("remote", fromUUID (transferUUID t))
+	jsonify t i = object $ map (\(k, v) -> (T.pack k, v)) $
+		[ ("transfer", toJSON (showLcDirection (transferDirection t)))
+		, ("key", toJSON (key2file (transferKey t)))
+		, ("file", toJSON (associatedFile i))
+		, ("remote", toJSON (fromUUID (transferUUID t)))
 		]
 
 disk_size :: Stat
@@ -415,9 +416,9 @@ disk_size = simpleStat "available local disk space" $
 
 backend_usage :: Stat
 backend_usage = stat "backend usage" $ json fmt $
-	toJSObject . sort . M.toList . backendsKeys <$> cachedReferencedData
+	ObjectMap . backendsKeys <$> cachedReferencedData
   where
-	fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . fromJSObject
+	fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap
 
 numcopies_stats :: Stat
 numcopies_stats = stat "numcopies stats" $ json fmt $

Command/Status.hs

@@ -43,7 +43,7 @@ displayStatus s  = do
 	let c = statusChar s
 	absf <- fromRepo $ fromTopFilePath (statusFile s)
 	f <- liftIO $ relPathCwdToFile absf
-	unlessM (showFullJSON $ JSONObject [("status", [c]), ("file", f)]) $
+	unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", f)]) $
 		liftIO $ putStrLn $ [c] ++ " " ++ f
 
 -- Git thinks that present direct mode files are typechanged.

Messages/JSON.hs

@@ -14,19 +14,21 @@ module Messages.JSON (
 	add,
 	complete,
 	DualDisp(..),
+	ObjectMap(..),
 	ParsedJSON(..),
 ) where
 
-import qualified Text.JSON as JSON
 import Data.Aeson
 import Control.Applicative
+import qualified Data.Map as M
+import qualified Data.Text as T
 
 import qualified Utility.JSONStream as Stream
 import Types.Key
 import Data.Maybe
 
 start :: String -> Maybe FilePath -> Maybe Key -> IO ()
-start command file key = putStr $ Stream.start $ Stream.JSONObject $ catMaybes
+start command file key = putStr $ Stream.start $ Stream.JSONChunk $ catMaybes
 	[ part "command" (Just command)
 	, part "file" file
 	, part "key" (fmap key2file key)
@@ -36,10 +38,10 @@ start command file key = putStr $ Stream.start $ Stream.JSONObject $ catMaybes
 	part l (Just v) = Just (l, v)
 
 end :: Bool -> IO ()
-end b = putStr $ Stream.add (Stream.JSONObject [("success", b)]) ++ Stream.end
+end b = putStr $ Stream.add (Stream.JSONChunk [("success", b)]) ++ Stream.end
 
 note :: String -> IO ()
-note s = add (Stream.JSONObject [("note", s)])
+note s = add (Stream.JSONChunk [("note", s)])
 
 add :: Stream.JSONChunk a -> IO ()
 add = putStr . Stream.add
@@ -53,13 +55,22 @@ data DualDisp = DualDisp
 	, dispJson :: String
 	}
 
-instance JSON.JSON DualDisp where
-	showJSON = JSON.JSString . JSON.toJSString . dispJson
-	readJSON _ = JSON.Error "stub"
+instance ToJSON DualDisp where
+	toJSON = toJSON . dispJson
 
 instance Show DualDisp where
 	show = dispNormal
 
+-- A Map that is serialized to JSON as an object, with each key being a
+-- field of the object. This is different from Aeson's normal 
+-- serialization of Map, which uses "[key, value]".
+data ObjectMap a = ObjectMap { fromObjectMap :: M.Map String a }
+
+instance ToJSON a => ToJSON (ObjectMap a) where
+	toJSON (ObjectMap m) = object $ map go $ M.toList m
+	  where
+		go (k, v) = (T.pack k, toJSON v)
+
 -- An Aeson parser for the JSON output by this module, and 
 -- similar JSON input from users.
 data ParsedJSON a = ParsedJSON

Remote.hs

@@ -55,10 +55,10 @@ module Remote (
 	claimingUrl,
 ) where
 
-import qualified Data.Map as M
-import Text.JSON
-import Text.JSON.Generic
 import Data.Ord
+import Data.Aeson
+import qualified Data.Map as M
+import qualified Data.Text as T
 
 import Annex.Common
 import Types.Remote
@@ -194,7 +194,7 @@ prettyPrintUUIDsDescs header descm uuids =
 
 {- An optional field can be included in the list of UUIDs. -}
 prettyPrintUUIDsWith
-	:: JSON v
+	:: ToJSON v
 	=> Maybe String 
 	-> String 
 	-> M.Map UUID RemoteName
@@ -203,7 +203,7 @@ prettyPrintUUIDsWith
 	-> Annex String
 prettyPrintUUIDsWith optfield header descm showval uuidvals = do
 	hereu <- getUUID
-	maybeShowJSON $ JSONObject [(header, map (jsonify hereu) uuidvals)]
+	maybeShowJSON $ JSONChunk [(header, map (jsonify hereu) uuidvals)]
 	return $ unwords $ map (\u -> "\t" ++ prettify hereu u ++ "\n") uuidvals
   where
 	finddescription u = M.findWithDefault "" u descm
@@ -220,12 +220,12 @@ prettyPrintUUIDsWith optfield header descm showval uuidvals = do
 		addoptval s = case showval =<< optval of
 			Nothing -> s
 			Just val -> val ++ ": " ++ s
-	jsonify hereu (u, optval) = toJSObject $ catMaybes
-		[ Just ("uuid", toJSON $ fromUUID u)
-		, Just ("description", toJSON $ finddescription u)
-		, Just ("here", toJSON $ hereu == u)
+	jsonify hereu (u, optval) = object $ catMaybes
+		[ Just (T.pack "uuid", toJSON $ fromUUID u)
+		, Just (T.pack "description", toJSON $ finddescription u)
+		, Just (T.pack "here", toJSON $ hereu == u)
 		, case (optfield, optval) of
-			(Just field, Just val) -> Just (field, showJSON val)
+			(Just field, Just val) -> Just (T.pack field, toJSON val)
 			_ -> Nothing
 		]
 

Test.hs

@@ -32,7 +32,8 @@ import Test.Tasty.Ingredients.Rerun
 import Options.Applicative (switch, long, help)
 
 import qualified Data.Map as M
-import qualified Text.JSON
+import qualified Data.Aeson
+import qualified Data.ByteString.Lazy.UTF8 as BU8
 
 import Common
 
@@ -924,10 +925,10 @@ test_merge = intmpclonerepo $
 
 test_info :: Assertion
 test_info = intmpclonerepo $ do
-	json <- git_annex_output "info" ["--json"]
-	case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of
-		Text.JSON.Ok _ -> return ()
-		Text.JSON.Error e -> assertFailure e
+	json <- BU8.fromString <$> git_annex_output "info" ["--json"]
+	case Data.Aeson.eitherDecode json :: Either String Data.Aeson.Value of
+		Right _ -> return ()
+		Left e -> assertFailure e
 
 test_version :: Assertion
 test_version = intmpclonerepo $

Utility/JSONStream.hs

@@ -14,31 +14,30 @@ module Utility.JSONStream (
 	end
 ) where
 
-import qualified Text.JSON as JSON
-import qualified Data.Aeson as Aeson
+import Data.Aeson
+import qualified Data.Text as T
 import qualified Data.ByteString.Lazy.UTF8 as B
 
-{- Only JSON objects can be used as chunks in the stream, not
- - other values.
- -
- - Both Aeson and Text.Json objects are supported. -}
-data JSONChunk a where
-	JSONObject :: JSON.JSON a => [(String, a)] -> JSONChunk [(String, a)]
-	AesonObject :: Aeson.Object -> JSONChunk Aeson.Object
+data JSONChunk v where
+	JSONChunk :: ToJSON v => [(String, v)] -> JSONChunk [(String, v)]
+	AesonObject :: Object -> JSONChunk Object
 
-encodeJSONChunk :: JSONChunk a -> String
-encodeJSONChunk (JSONObject l) = JSON.encodeStrict $ JSON.toJSObject l
-encodeJSONChunk (AesonObject o) = B.toString (Aeson.encode o)
+encodeJSONChunk :: JSONChunk v -> B.ByteString
+encodeJSONChunk (JSONChunk l) = encode $ object $ map mkPair l
+  where
+	mkPair (s, v) = (T.pack s, toJSON v)
+encodeJSONChunk (AesonObject o) = encode o
 
-{- Text.JSON and Aeson do not support building up a larger JSON document
- - piece by piece as a stream. To support streaming, a hack. The final "}" 
- - is left off the object, allowing it to be added to later. -}
+{- Aeson does not support building up a larger JSON object piece by piece
+ - with streaming output. To support streaming, a hack:
+ - The final "}" is left off the JSON, allowing more chunks to be added
+ - to later. -}
 start :: JSONChunk a -> String
 start a
 	| last s == endchar = init s
 	| otherwise = bad s
   where
-	s = encodeJSONChunk a
+	s = B.toString $ encodeJSONChunk a
 
 add :: JSONChunk a -> String
 add a

debian/control

@@ -23,7 +23,6 @@ Build-Depends:
 	libghc-unix-compat-dev,
 	libghc-dlist-dev,
 	libghc-uuid-dev,
-	libghc-json-dev,
 	libghc-aeson-dev,
 	libghc-unordered-containers-dev,
 	libghc-ifelse-dev,

git-annex.cabal

@@ -331,7 +331,7 @@ Executable git-annex
    process, data-default, case-insensitive, uuid, random, dlist,
    unix-compat, SafeSemaphore, async, directory, filepath, IfElse,
    MissingH, hslogger, monad-logger,
-   utf8-string, bytestring, text, sandi, json,
+   utf8-string, bytestring, text, sandi,
    monad-control, transformers,
    bloomfilter, edit-distance,
    resourcet, http-conduit (<2.2.0), http-client, http-types,