From ca596e7c54ed08e2bec3b6b3e669ccf5ded9aff8 Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Wed, 2 Mar 2022 21:16:10 +0100 Subject: [PATCH] allow building with aeson >= 2.0 In aeson 2.0, Text has been replaced by the Key type and HashMap by the KeyMap interface. Accomodating this required adding some CPP in order to still be able to compile with aeson < 2.0. The required changes were: * Prevent Key from being re-exported by Utilities.Aeson, as it clashes with git-annex's own Key type. * Fix up convertion from String/Text to Key (or Text in aeson 1.*) in a couple of places * Import Data.Aeson.KeyMap instead of Data.HashMap.Strict, as they are mostly API-compatible. insertWith needs to be replaced by unionWith, however, as KeyMap lacks the former function. --- Command/Info.hs | 4 ++-- Messages/JSON.hs | 27 ++++++++++++++++++++++----- Remote.hs | 19 ++++++++++++++----- Types/MetaData.hs | 12 +++++++++++- Utility/Aeson.hs | 4 ++-- 5 files changed, 51 insertions(+), 15 deletions(-) diff --git a/Command/Info.hs b/Command/Info.hs index d273c4a5b4..5ef3ffbb97 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns, DeriveDataTypeable, PackageImports #-} +{-# LANGUAGE BangPatterns, DeriveDataTypeable, PackageImports, OverloadedStrings #-} module Command.Info where @@ -446,7 +446,7 @@ transfer_list = stat desc $ nojson $ lift $ do , maybe (fromUUID $ transferUUID t) Remote.name $ M.lookup (transferUUID t) uuidmap ] - jsonify t i = object $ map (\(k, v) -> (packString k, v)) $ + jsonify t i = object $ [ ("transfer", toJSON' (formatDirection (transferDirection t))) , ("key", toJSON' (transferKey t)) , ("file", toJSON' (fromRawFilePath <$> afile)) diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 1f8a332f7a..7d9704e503 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE OverloadedStrings, GADTs #-} +{-# LANGUAGE OverloadedStrings, GADTs, CPP #-} module Messages.JSON ( JSONBuilder, @@ -33,7 +33,12 @@ import Control.Applicative import qualified Data.Map as M import qualified Data.Vector as V import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.Key as AK +import qualified Data.Aeson.KeyMap as HM +#else import qualified Data.HashMap.Strict as HM +#endif import System.IO import System.IO.Unsafe (unsafePerformIO) import Control.Concurrent @@ -94,7 +99,7 @@ finalize o = addErrorMessage [] o addErrorMessage :: [String] -> Object -> Object addErrorMessage msg o = - HM.insertWith combinearray "error-messages" v o + HM.unionWith combinearray (HM.singleton "error-messages" v) o where combinearray (Array new) (Array old) = Array (old <> new) combinearray new _old = new @@ -102,7 +107,7 @@ addErrorMessage msg o = note :: String -> JSONBuilder note _ Nothing = Nothing -note s (Just (o, e)) = Just (HM.insertWith combinelines "note" (toJSON' s) o, e) +note s (Just (o, e)) = Just (HM.unionWith combinelines (HM.singleton "note" (toJSON' s)) o, e) where combinelines (String new) (String old) = String (old <> "\n" <> new) @@ -127,7 +132,13 @@ add v (Just (o, e)) = case j of j = case v of AesonObject ao -> Object ao JSONChunk l -> object $ map mkPair l - mkPair (s, d) = (packString s, toJSON' d) + mkPair (s, d) = + ( +#if MIN_VERSION_aeson(2,0,0) + AK.fromText $ +#endif + packString s + , toJSON' d) add _ Nothing = Nothing complete :: JSONChunk v -> JSONBuilder @@ -173,7 +184,13 @@ 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) = (packString k, toJSON' v) + go (k, v) = + ( +#if MIN_VERSION_aeson(2,0,0) + AK.fromText $ +#endif + packString k + , toJSON' v) -- An item that a git-annex command acts on, and displays a JSON object about. data JSONActionItem a = JSONActionItem diff --git a/Remote.hs b/Remote.hs index b3207bd6d1..5e6658690f 100644 --- a/Remote.hs +++ b/Remote.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} module Remote ( Remote, @@ -63,6 +63,9 @@ module Remote ( import Data.Ord import Data.String +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.Key as AK +#endif import qualified Data.Map as M import qualified Data.Vector as V @@ -239,11 +242,17 @@ prettyPrintUUIDsWith optfield header descm showval uuidvals = do Nothing -> s Just val -> val ++ ": " ++ s jsonify hereu (u, optval) = object $ catMaybes - [ Just (packString "uuid", toJSON' (fromUUID u :: String)) - , Just (packString "description", toJSON' $ finddescription u) - , Just (packString "here", toJSON' $ hereu == u) + [ Just ("uuid", toJSON' (fromUUID u :: String)) + , Just ("description", toJSON' $ finddescription u) + , Just ("here", toJSON' $ hereu == u) , case (optfield, optval) of - (Just field, Just val) -> Just (packString field, toJSON' val) + (Just field, Just val) -> Just + ( +#if MIN_VERSION_aeson(2,0,0) + AK.fromText $ +#endif + packString field + , toJSON' val) _ -> Nothing ] diff --git a/Types/MetaData.hs b/Types/MetaData.hs index 100adbed05..7199763d73 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -7,6 +7,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Types.MetaData ( MetaData(..), @@ -51,6 +52,9 @@ import Utility.QuickCheck import Utility.Aeson import Types.UUID +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.Key as AK +#endif import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified Data.Set as S @@ -67,7 +71,13 @@ newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue)) instance ToJSON' MetaData where toJSON' (MetaData m) = object $ map go (M.toList m) where - go (MetaField f, s) = (CI.original f, toJSON' s) + go (MetaField f, s) = + ( +#if MIN_VERSION_aeson(2,0,0) + AK.fromText $ +#endif + CI.original f + , toJSON' s) instance FromJSON MetaData where parseJSON (Object o) = do diff --git a/Utility/Aeson.hs b/Utility/Aeson.hs index c872bd14fc..c82bf35833 100644 --- a/Utility/Aeson.hs +++ b/Utility/Aeson.hs @@ -7,7 +7,7 @@ - License: BSD-2-clause -} -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, CPP #-} module Utility.Aeson ( module X, @@ -17,7 +17,7 @@ module Utility.Aeson ( packByteString, ) where -import Data.Aeson as X hiding (ToJSON, toJSON, encode) +import Data.Aeson as X hiding (ToJSON, toJSON, encode, Key) import Data.Aeson hiding (encode) import qualified Data.Aeson import qualified Data.Text as T -- 2.39.5