autodocodec 0.0.1.0 → 0.0.1.1
raw patch · 7 files changed
+153/−24 lines, 7 files
Files
- CHANGELOG.md +6/−0
- autodocodec.cabal +3/−2
- src/Autodocodec/Aeson/Compat.hs +60/−0
- src/Autodocodec/Aeson/Decode.hs +9/−7
- src/Autodocodec/Aeson/Encode.hs +5/−4
- src/Autodocodec/Class.hs +9/−0
- src/Autodocodec/Codec.hs +61/−11
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## [0.0.1.1] - 2022-04-26++### Added++* Compatibility with `aeson >= 2.0.0.0`+ ## [0.0.1.0] - 2021-12-23 ### Changed
autodocodec.cabal view
@@ -1,11 +1,11 @@ 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.7. -- -- see: https://github.com/sol/hpack name: autodocodec-version: 0.0.1.0+version: 0.0.1.1 synopsis: Self-documenting encoder and decoder homepage: https://github.com/NorfairKing/autodocodec#readme bug-reports: https://github.com/NorfairKing/autodocodec/issues@@ -27,6 +27,7 @@ exposed-modules: Autodocodec Autodocodec.Aeson+ Autodocodec.Aeson.Compat Autodocodec.Aeson.Decode Autodocodec.Aeson.Encode Autodocodec.Class
+ src/Autodocodec/Aeson/Compat.hs view
@@ -0,0 +1,60 @@+{-# 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++#if MIN_VERSION_aeson(2,0,0)+toList :: KM.KeyMap v -> [(Key, v)]+toList = KM.toList+#else+toList ::HM.HashMap Text v -> [(Text, v)]+toList = HM.toList+#endif++#if MIN_VERSION_aeson(2,0,0)+map :: (v1 -> v2) -> KM.KeyMap v1 -> KM.KeyMap v2+map = KM.map+#else+map :: (v1 -> v2) -> HM.HashMap Text v1 -> HM.HashMap Text v2+map = HM.map+#endif
src/Autodocodec/Aeson/Decode.hs view
@@ -6,6 +6,7 @@ module Autodocodec.Aeson.Decode where +import qualified Autodocodec.Aeson.Compat as Compat import Autodocodec.Class import Autodocodec.Codec import Autodocodec.DerivingVia@@ -13,7 +14,6 @@ import Data.Aeson as JSON 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)@@ -111,16 +111,18 @@ 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
src/Autodocodec/Aeson/Encode.hs view
@@ -5,6 +5,7 @@ module Autodocodec.Aeson.Encode where +import qualified Autodocodec.Aeson.Compat as Compat import Autodocodec.Class import Autodocodec.Codec import Autodocodec.DerivingVia@@ -49,10 +50,10 @@ 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@@ -93,10 +94,10 @@ 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
src/Autodocodec/Class.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-}@@ -9,6 +10,9 @@ 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@@ -121,6 +125,11 @@ 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
src/Autodocodec/Codec.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -15,6 +16,10 @@ 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)+import qualified Data.Aeson.KeyMap as KM+#endif import qualified Data.Aeson.Types as JSON import Data.HashMap.Strict (HashMap) import Data.Hashable@@ -34,6 +39,7 @@ -- $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@@ -66,7 +72,7 @@ -- | Encode a 'Bool' to a @boolean@ value, and decode a @boolean@ value as a 'Bool'. BoolCodec :: -- | Name of the @bool@, for error messages and documentation.- (Maybe Text) ->+ Maybe Text -> -- | JSONCodec Bool -- | Encode 'Text' to a @string@ value, and decode a @string@ value as a 'Text'.@@ -74,7 +80,7 @@ -- This is named after the primitive type "String" in json, not after the haskell type string. StringCodec :: -- | Name of the @string@, for error messages and documentation.- (Maybe Text) ->+ Maybe Text -> -- | JSONCodec Text -- | Encode 'Scientific' to a @number@ value, and decode a @number@ value as a 'Scientific'.@@ -85,7 +91,7 @@ -- NOTE: We use 'Scientific' here because that is what aeson uses. NumberCodec :: -- | Name of the @number@, for error messages and documentation.- (Maybe Text) ->+ Maybe Text -> -- | Bounds for the number, these are checked and documented Maybe NumberBounds -> -- |@@ -111,17 +117,17 @@ -- | Encode a 'Vector' of values as an @array@ value, and decode an @array@ value as a 'Vector' of values. ArrayOfCodec :: -- | Name of the @array@, for error messages and documentation.- (Maybe Text) ->+ Maybe Text -> -- |- (ValueCodec input output) ->+ ValueCodec input output -> -- | ValueCodec (Vector input) (Vector output) -- | Encode a value as a an @object@ value using the given 'ObjectCodec', and decode an @object@ value as a value using the given 'ObjectCodec'. ObjectOfCodec :: -- | Name of the @object@, for error messages and documentation.- (Maybe Text) ->+ Maybe Text -> -- |- (ObjectCodec input output) ->+ ObjectCodec input output -> -- | ValueCodec input output -- | Match a given value using its 'Eq' instance during decoding, and encode exactly that value during encoding.@@ -144,7 +150,7 @@ -- | (newInput -> oldInput) -> -- |- (Codec context oldInput oldOutput) ->+ Codec context oldInput oldOutput -> Codec context newInput newOutput -- | Encode/Decode an 'Either' value --@@ -163,9 +169,9 @@ -- | What type of union we encode and decode !Union -> -- | Codec for the 'Left' side- (Codec context input1 output1) ->+ Codec context input1 output1 -> -- | Codec for the 'Right' side- (Codec context input2 output2) ->+ Codec context input2 output2 -> -- | Codec context (Either input1 input2) (Either output1 output2) -- | A comment codec@@ -328,6 +334,8 @@ 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)+#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 +548,7 @@ -- 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@@ -931,6 +939,48 @@ [Text] -> ValueCodec input output (<??>) c ls = CommentCodec (T.unlines ls) c++-- | Encode a 'HashMap', and decode any 'HashMap'.+--+-- Forward-compatible version of 'HashMapCodec'+--+-- > hashMapCodec = HashMapCodec+hashMapCodec ::+ (Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>+ -- |+ JSONCodec v ->+ -- |+ JSONCodec (HashMap k v)+hashMapCodec = HashMapCodec++-- | Encode a 'Map', and decode any 'Map'.+--+-- Forward-compatible version of 'MapCodec'+--+-- > mapCodec = MapCodec+mapCodec ::+ (Ord k, FromJSONKey k, ToJSONKey k) =>+ -- |+ JSONCodec v ->+ -- |+ JSONCodec (Map k v)+mapCodec = MapCodec++#if MIN_VERSION_aeson(2,0,0)+-- | Encode a 'KeyMap', and decode any 'KeyMap'.+--+-- This chooses 'hashMapCodec' or 'mapCodec' based on @ordered-keymap@ flag in aeson.+keyMapCodec ::+ -- |+ JSONCodec v ->+ -- |+ JSONCodec (KeyMap v)+keyMapCodec = case KM.coercionToMap of+ -- Can coerce to Map, use+ Just _ -> dimapCodec KM.fromMap KM.toMap . mapCodec+ -- Cannot coerce to Map, use HashMap instead.+ Nothing -> dimapCodec KM.fromHashMap KM.toHashMap . hashMapCodec+#endif -- | Forward-compatible version of 'ValueCodec' --