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.

diff --git a/Command/Info.hs b/Command/Info.hs
index d273c4a5b4c7b4be48d6b6bc441f71f04b47a765..5ef3ffbb97dd9411dfd8c26f1399804de608281a 100644 (file)
--- 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 1f8a332f7ae0ae1a875f3add7ef32b2f58713f1b..7d9704e503de98f1b025e6f779c77dd96048dfb9 100644 (file)
--- 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 b3207bd6d135e71989294e3d34d3a62829ca3444..5e6658690f9ac22d2904c369316260ac54b5de66 100644 (file)
--- 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 100adbed057433bf99425fe69e241ff66d0fda7c..7199763d739a4d892f24e1e5b5082fe2b88a3857 100644 (file)
--- 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 c872bd14fcc6b23ed21e297ea28e7fbb7d3b5b48..c82bf3583330097948bc938531df0f95747a61ce 100644 (file)
--- 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