Support aeson 2

autodocodec/autodocodec.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.5.
+-- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
 
@@ -27,6 +27,7 @@ library
   exposed-modules:
       Autodocodec
       Autodocodec.Aeson
+      Autodocodec.Aeson.Compat
       Autodocodec.Aeson.Decode
       Autodocodec.Aeson.Encode
       Autodocodec.Class

autodocodec/src/Autodocodec/Aeson/Compat.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE CPP #-}
+
+module Autodocodec.Aeson.Compat where
+
+#if MIN_VERSION_aeson(2,0,0)
+import Data.Aeson.Key (Key)
+import qualified Data.Aeson.Key as K
+import qualified Data.Aeson.KeyMap as KM
+#else
+import qualified Data.HashMap.Strict as HM
+#endif
+import Data.Text (Text)
+
+#if MIN_VERSION_aeson(2,0,0)
+toKey :: Text -> Key
+toKey = K.fromText
+#else
+toKey :: Text -> Text
+toKey = id
+#endif
+
+#if MIN_VERSION_aeson(2,0,0)
+fromKey :: Key -> Text
+fromKey = K.toText
+#else
+fromKey :: Text -> Text
+fromKey = id
+#endif
+
+#if MIN_VERSION_aeson(2,0,0)
+lookupKey :: Key -> KM.KeyMap v -> Maybe v
+lookupKey = KM.lookup
+#else
+lookupKey :: Text -> HM.HashMap Text v -> Maybe v
+lookupKey = HM.lookup
+#endif
+
+#if MIN_VERSION_aeson(2,0,0)
+fromList :: [(Key, v)] -> KM.KeyMap v
+fromList = KM.fromList
+#else
+fromList :: [(Text, v)] -> HM.HashMap Text v
+fromList = HM.fromList
+#endif

autodocodec/src/Autodocodec/Aeson/Decode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -6,14 +7,17 @@
 
 module Autodocodec.Aeson.Decode where
 
+import qualified Autodocodec.Aeson.Compat as Compat
 import Autodocodec.Class
 import Autodocodec.Codec
 import Autodocodec.DerivingVia
 import Control.Monad
 import Data.Aeson as JSON
+#if MIN_VERSION_aeson(2,0,0)
+import Data.Aeson.KeyMap (KeyMap)
+#endif
 import Data.Aeson.Types as JSON
 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HM
 import Data.Map (Map)
 import qualified Data.Text as T
 import Data.Vector (Vector)
@@ -77,6 +81,9 @@ parseJSONContextVia codec_ context_ =
           (\object_ -> (`go` c) (object_ :: JSON.Object))
       HashMapCodec c -> liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (HashMap _ _)
       MapCodec c -> liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (Map _ _)
+#if MIN_VERSION_aeson(2,0,0)
+      KeyMapCodec c -> liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (KeyMap _)
+#endif
       ValueCodec -> pure (value :: JSON.Value)
       EqCodec expected c -> do
         actual <- go value c
@@ -111,16 +118,18 @@ parseJSONContextVia codec_ context_ =
       CommentCodec _ c -> go value c
       ReferenceCodec _ c -> go value c
       RequiredKeyCodec k c _ -> do
-        valueAtKey <- (value :: JSON.Object) JSON..: k
-        go valueAtKey c JSON.<?> Key k
+        valueAtKey <- (value :: JSON.Object) JSON..: Compat.toKey k
+        go valueAtKey c JSON.<?> Key (Compat.toKey k)
       OptionalKeyCodec k c _ -> do
-        let mValueAtKey = HM.lookup k (value :: JSON.Object)
-        forM mValueAtKey $ \valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key k
+        let key = Compat.toKey k
+            mValueAtKey = Compat.lookupKey key (value :: JSON.Object)
+        forM mValueAtKey $ \valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key key
       OptionalKeyWithDefaultCodec k c defaultValue _ -> do
-        let mValueAtKey = HM.lookup k (value :: JSON.Object)
+        let key = Compat.toKey k
+            mValueAtKey = Compat.lookupKey key (value :: JSON.Object)
         case mValueAtKey of
           Nothing -> pure defaultValue
-          Just valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key k
+          Just valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key key
       OptionalKeyWithOmittedDefaultCodec k c defaultValue mDoc -> go value $ OptionalKeyWithDefaultCodec k c defaultValue mDoc
       PureCodec a -> pure a
       ApCodec ocf oca -> go (value :: JSON.Object) ocf <*> go (value :: JSON.Object) oca

autodocodec/src/Autodocodec/Aeson/Encode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PartialTypeSignatures #-}
@@ -5,11 +6,15 @@
 
 module Autodocodec.Aeson.Encode where
 
+import qualified Autodocodec.Aeson.Compat as Compat
 import Autodocodec.Class
 import Autodocodec.Codec
 import Autodocodec.DerivingVia
 import Data.Aeson (toJSON)
 import qualified Data.Aeson as JSON
+#if MIN_VERSION_aeson(2,0,0)
+import Data.Aeson.KeyMap (KeyMap)
+#endif
 import qualified Data.Aeson.Encoding as JSON
 import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
@@ -38,6 +43,9 @@ toJSONVia = flip go
       ObjectOfCodec _ oc -> JSON.Object (goObject a oc)
       HashMapCodec c -> JSON.liftToJSON (`go` c) (`go` listCodec c) (a :: HashMap _ _)
       MapCodec c -> JSON.liftToJSON (`go` c) (`go` listCodec c) (a :: Map _ _)
+#if MIN_VERSION_aeson(2,0,0)
+      KeyMapCodec c -> JSON.liftToJSON (`go` c) (`go` listCodec c) (a :: KeyMap _)
+#endif
       ValueCodec -> (a :: JSON.Value)
       EqCodec value c -> go value c
       BimapCodec _ g c -> go (g a) c
@@ -49,10 +57,10 @@ toJSONVia = flip go
 
     goObject :: a -> ObjectCodec a void -> JSON.Object
     goObject a = \case
-      RequiredKeyCodec k c _ -> k JSON..= go a c
+      RequiredKeyCodec k c _ -> Compat.toKey k JSON..= go a c
       OptionalKeyCodec k c _ -> case (a :: Maybe _) of
         Nothing -> mempty
-        Just b -> k JSON..= go b c
+        Just b -> Compat.toKey k JSON..= go b c
       OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (OptionalKeyCodec k c mdoc)
       OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->
         if a == defaultValue
@@ -83,6 +91,9 @@ toEncodingVia = flip go
       ObjectOfCodec _ oc -> JSON.pairs (goObject a oc)
       HashMapCodec c -> JSON.liftToEncoding (`go` c) (`go` listCodec c) (a :: HashMap _ _)
       MapCodec c -> JSON.liftToEncoding (`go` c) (`go` listCodec c) (a :: Map _ _)
+#if MIN_VERSION_aeson(2,0,0)
+      KeyMapCodec c -> JSON.liftToEncoding (`go` c) (`go` listCodec c) (a :: KeyMap _)
+#endif
       ValueCodec -> JSON.value (a :: JSON.Value)
       EqCodec value c -> go value c
       BimapCodec _ g c -> go (g a) c
@@ -93,10 +104,10 @@ toEncodingVia = flip go
       ReferenceCodec _ c -> go a c
     goObject :: a -> ObjectCodec a void -> JSON.Series
     goObject a = \case
-      RequiredKeyCodec k c _ -> JSON.pair k (go a c)
+      RequiredKeyCodec k c _ -> JSON.pair (Compat.toKey k) (go a c)
       OptionalKeyCodec k c _ -> case (a :: Maybe _) of
         Nothing -> mempty :: JSON.Series
-        Just b -> JSON.pair k (go b c)
+        Just b -> JSON.pair (Compat.toKey k) (go b c)
       OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (OptionalKeyCodec k c mdoc)
       OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->
         if a == defaultValue

autodocodec/src/Autodocodec/Class.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -9,6 +10,9 @@ module Autodocodec.Class where
 import Autodocodec.Codec
 import Data.Aeson (FromJSONKey, ToJSONKey)
 import qualified Data.Aeson as JSON
+#if MIN_VERSION_aeson(2,0,0)
+import Data.Aeson.KeyMap (KeyMap)
+#endif
 import Data.HashMap.Strict (HashMap)
 import Data.Hashable (Hashable)
 import Data.Int
@@ -122,6 +126,11 @@ instance (Ord k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (Map k v) w
 instance (Eq k, Hashable k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (HashMap k v) where
   codec = HashMapCodec codec
 
+#if MIN_VERSION_aeson(2,0,0)
+instance HasCodec v => HasCodec (KeyMap v) where
+  codec = KeyMapCodec codec
+#endif
+
 -- TODO make these instances better once aeson exposes its @Data.Aeson.Parser.Time@ or @Data.Attoparsec.Time@ modules.
 instance HasCodec Day where
   codec = codecViaAeson "Day"

autodocodec/src/Autodocodec/Codec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -15,6 +16,9 @@ module Autodocodec.Codec where
 import Control.Monad.State
 import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
 import qualified Data.Aeson as JSON
+#if MIN_VERSION_aeson(2,0,0)
+import Data.Aeson.KeyMap (KeyMap)
+#endif
 import qualified Data.Aeson.Types as JSON
 import Data.HashMap.Strict (HashMap)
 import Data.Hashable
@@ -34,6 +38,7 @@ import GHC.Generics (Generic)
 
 -- $setup
 -- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, parseJSONVia, parseJSONViaCodec)
+-- >>> import qualified Autodocodec.Aeson.Compat as Compat
 -- >>> import Autodocodec.Class (HasCodec(codec), requiredField)
 -- >>> import qualified Data.Aeson as JSON
 -- >>> import qualified Data.HashMap.Strict as HM
@@ -104,6 +109,14 @@ data Codec context input output where
     JSONCodec v ->
     -- |
     JSONCodec (Map k v)
+#if MIN_VERSION_aeson(2,0,0)
+  -- | Encode a 'KeyMap', and decode any 'KeyMap'.
+  KeyMapCodec ::
+    -- |
+    JSONCodec v ->
+    -- |
+    JSONCodec (KeyMap v)
+#endif
   -- | Encode a 'JSON.Value', and decode any 'JSON.Value'.
   ValueCodec ::
     -- |
@@ -328,6 +341,9 @@ showCodecABit = ($ "") . (`evalState` S.empty) . go 0
       ValueCodec -> pure $ showString "ValueCodec"
       MapCodec c -> (\s -> showParen (d > 10) $ showString "MapCodec" . s) <$> go 11 c
       HashMapCodec c -> (\s -> showParen (d > 10) $ showString "HashMapCodec" . s) <$> go 11 c
+#if MIN_VERSION_aeson(2,0,0)
+      KeyMapCodec c -> (\s -> showParen (d > 10) $ showString "KeyMapCodec" . s) <$> go 11 c
+#endif
       EqCodec value c -> (\s -> showParen (d > 10) $ showString "EqCodec " . showsPrec 11 value . showString " " . s) <$> go 11 c
       BimapCodec _ _ c -> (\s -> showParen (d > 10) $ showString "BimapCodec _ _ " . s) <$> go 11 c
       EitherCodec u c1 c2 -> (\s1 s2 -> showParen (d > 10) $ showString "EitherCodec " . showsPrec 11 u . showString " " . s1 . showString " " . s2) <$> go 11 c1 <*> go 11 c2
@@ -540,7 +556,7 @@ eitherCodec = possiblyJointEitherCodec
 -- Object (fromList [("domain",String "Stars"),("name",String "Varda")])
 -- >>> toJSONViaCodec (Maiar "Sauron")
 -- Object (fromList [("name",String "Sauron")])
--- >>> JSON.parseMaybe parseJSONViaCodec (Object (HM.fromList [("name",String "Olorin")])) :: Maybe Ainur
+-- >>> JSON.parseMaybe parseJSONViaCodec (Object (Compat.fromList [("name",String "Olorin")])) :: Maybe Ainur
 -- Just (Maiar "Olorin")
 --
 -- === WARNING