autodocodec 0.5.0.0 → 0.7.0.0
raw patch · 6 files changed
Files
- CHANGELOG.md +35/−0
- Setup.hs +2/−0
- autodocodec.cabal +4/−3
- src/Autodocodec/Aeson/Decode.hs +10/−4
- src/Autodocodec/Aeson/Encode.hs +2/−2
- src/Autodocodec/Codec.hs +91/−19
CHANGELOG.md view
@@ -1,5 +1,40 @@ # Changelog +## [0.7.0.0] - 2026-10-07++### Fixed++* `optionalFieldOrNullWithOmittedDefault`, `optionalFieldOrNullWithOmittedDefault'`,+ `optionalFieldOrNullWithOmittedDefaultWith` and+ `optionalFieldOrNullWithOmittedDefaultWith'` now omit the key when the value+ is the default value, as they document, instead of encoding `null`.+ Both encodings parse back to the default value, so this changes the output+ rather than what can be read.++* `unsafeUnboundedNaturalCodec` no longer throws an arithmetic underflow when+ it is given a negative number. It fails to parse instead.++### Removed++* The `Result` newtype and its instances.+ Nothing used it: it was left over from the time codecs it was written for.++## [0.6.0.0] - 2026-07-14++This is technically a breaking change but it's unlikely that you'll need to+change any of your codecs.++Thanks to Andreas Ländle (@alaendle) for contributing this feature.++### Changed++* Changed `StringCodec` to include `StringBounds` to represent the minimal/maximal length of a string.++### Added++* `textWithBoundsCodec`+* `stringWithBoundsCodec`+ ## [0.5.0.0] - 2025-06-20 This is technically a breaking change but it's unlikely that you'll need to
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
autodocodec.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.1.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack name: autodocodec-version: 0.5.0.0+version: 0.7.0.0 synopsis: Self-documenting encoder and decoder homepage: https://github.com/NorfairKing/autodocodec#readme bug-reports: https://github.com/NorfairKing/autodocodec/issues@@ -37,6 +37,7 @@ Paths_autodocodec hs-source-dirs: src+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -Widentities -Wredundant-constraints -Wcpp-undef build-depends: aeson , base >=4.7 && <5@@ -61,7 +62,7 @@ Paths_autodocodec hs-source-dirs: doctest/- ghc-options: -main-is DocTest -threaded -rtsopts -with-rtsopts=-N -Wall+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -Widentities -Wredundant-constraints -Wcpp-undef -main-is DocTest -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: base >=4.7 && <5 , doctest
src/Autodocodec/Aeson/Decode.hs view
@@ -29,7 +29,6 @@ import qualified Data.HashMap.Strict as HashMap import Data.Map (Map) import Data.Scientific as Scientific-import Data.Text (Text) import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V@@ -66,9 +65,16 @@ BoolCodec mname -> case mname of Nothing -> coerce (parseJSON value :: JSON.Parser Bool) Just name -> coerce $ withBool (T.unpack name) pure value- StringCodec mname -> case mname of- Nothing -> coerce (parseJSON value :: JSON.Parser Text)- Just name -> coerce $ withText (T.unpack name) pure value+ StringCodec mname bounds ->+ coerce $+ ( \f -> case mname of+ Nothing -> parseJSON value >>= f+ Just name -> withText (T.unpack name) f value+ )+ ( \s -> case checkStringBounds bounds s of+ Left err -> fail err+ Right s' -> pure s'+ ) IntegerCodec mname bounds -> coerce $ ( \f -> do
src/Autodocodec/Aeson/Encode.hs view
@@ -74,7 +74,7 @@ go a = \case NullCodec -> JSON.Null BoolCodec _ -> toJSON (coerce a :: Bool)- StringCodec _ -> toJSON (coerce a :: Text)+ StringCodec _ _ -> toJSON (coerce a :: Text) IntegerCodec _ _ -> toJSON (coerce a :: Integer) NumberCodec _ _ -> toJSON (coerce a :: Scientific) ArrayOfCodec _ c -> toJSON (fmap (`go` c) (coerce a :: Vector _))@@ -130,7 +130,7 @@ go a = \case NullCodec -> JSON.null_ BoolCodec _ -> JSON.bool (coerce a :: Bool)- StringCodec _ -> JSON.text (coerce a :: Text)+ StringCodec _ _ -> JSON.text (coerce a :: Text) IntegerCodec _ _ -> JSON.scientific (fromInteger (coerce a :: Integer) :: Scientific) NumberCodec _ _ -> JSON.scientific (coerce a :: Scientific) ArrayOfCodec _ c -> JSON.list (`go` c) (V.toList (coerce a :: Vector _))
src/Autodocodec/Codec.hs view
@@ -6,7 +6,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-}@@ -98,6 +97,8 @@ (Coercible a Text, Coercible b Text) => -- | Name of the @string@, for error messages and documentation. Maybe Text ->+ -- | Bounds for the string, these are checked and documented+ StringBounds -> ValueCodec a b -- | Encode 'Integer' to a @number@ value, and decode a @number@ value as an 'Integer'. --@@ -296,6 +297,32 @@ ObjectCodec input output -> ObjectCodec input newOutput +data StringBounds = StringBounds+ { -- | Lower bound, inclusive. A string is valid if its length is greater than, or equal to, this value.+ stringBoundsMinLength :: !(Maybe Natural),+ -- | Upper bound, inclusive. A string is valid if its length is less than, or equal to, this value.+ stringBoundsMaxLength :: !(Maybe Natural)+ }+ deriving (Show, Eq, Ord, Generic)++instance Validity StringBounds where+ validate StringBounds {..} =+ mconcat+ [ validate stringBoundsMinLength,+ validate stringBoundsMaxLength+ ]++emptyStringBounds :: StringBounds+emptyStringBounds = StringBounds Nothing Nothing++checkStringBounds :: StringBounds -> Text -> Either String Text+checkStringBounds StringBounds {..} s =+ case stringBoundsMinLength of+ Just lo | T.length s < fromIntegral lo -> Left $ unwords ["String", show s, "is shorter than the lower bound", show lo]+ _ -> case stringBoundsMaxLength of+ Just hi | T.length s > fromIntegral hi -> Left $ unwords ["String", show s, "is longer than the upper bound", show hi]+ _ -> Right s+ data Bounds a = Bounds { -- | Lower bound, inclusive boundsLower :: !(Maybe a),@@ -378,7 +405,7 @@ -- | A codec within the 'JSON.Object' context. ----- An 'Object' can be used to turn a Haskell value into a 'JSON.Object' or to parse a 'JSON.Object' into a haskell value.+-- An 'ObjectCodec' can be used to turn a Haskell value into a 'JSON.Object' or to parse a 'JSON.Object' into a haskell value. -- -- This cannot be used in certain places where 'ValueCodec' could be used, and vice versa. type ObjectCodec = Codec JSON.Object@@ -410,7 +437,7 @@ go d = \case NullCodec -> pure $ showString "NullCodec" BoolCodec mName -> pure $ showParen (d > 10) $ showString "BoolCodec " . showsPrec 11 mName- StringCodec mName -> pure $ showParen (d > 10) $ showString "StringCodec " . showsPrec 11 mName+ StringCodec mName mbs -> pure $ showParen (d > 10) $ showString "StringCodec " . showsPrec 11 mName . showString " " . showsPrec 11 mbs IntegerCodec mName mbs -> pure $ showParen (d > 10) $ showString "IntegerCodec " . showsPrec 11 mName . showString " " . showsPrec 11 mbs NumberCodec mName mbs -> pure $ showParen (d > 10) $ showString "NumberCodec " . showsPrec 11 mName . showString " " . showsPrec 11 mbs ArrayOfCodec mName c -> (\s -> showParen (d > 10) $ showString "ArrayOfCodec " . showsPrec 11 mName . showString " " . s) <$> go 11 c@@ -1150,7 +1177,11 @@ f = \case Just v -> v Nothing -> defaultValue- g v = if v == defaultValue then Nothing else Just v+ -- Not 'if v == defaultValue then Nothing else Just v': the underlying+ -- codec omits the key when what it is given equals its own default, which+ -- is 'Just defaultValue', so answering 'Nothing' for the default value is+ -- what would write @null@ instead of omitting the key.+ g = Just -- | Like 'optionalFieldWithOmittedDefaultWith'', but the value may also be -- @null@ and that will be interpreted as the default value.@@ -1165,10 +1196,11 @@ ObjectCodec output output optionalFieldOrNullWithOmittedDefaultWith' key c defaultValue = dimapCodec f g $ optionalFieldWithOmittedDefaultWith' key (maybeCodec c) (Just defaultValue) where+ -- See the note on 'optionalFieldOrNullWithOmittedDefaultWith'. f = \case Just v -> v Nothing -> defaultValue- g v = if v == defaultValue then Nothing else Just v+ g = Just -- | An optional, or null, field --@@ -1328,8 +1360,24 @@ -- -- > textCodec = StringCodec Nothing textCodec :: JSONCodec Text-textCodec = StringCodec Nothing+textCodec = StringCodec Nothing emptyStringBounds +-- | Codec for 'Text' values with bounds+--+-- During parsing, only 'Text' values within the given boundaries are accepted.+--+-- During rendering, the value is not checked and is simply output as is.+--+-- === Example usage+--+-- >>> JSON.parseMaybe (parseJSONVia (textWithBoundsCodec StringBounds { stringBoundsMinLength = Just 1, stringBoundsMaxLength = Just 10})) (String "hello")+-- Just "hello"+--+-- >>> JSON.parseMaybe (parseJSONVia (textWithBoundsCodec StringBounds { stringBoundsMinLength = Just 1, stringBoundsMaxLength = Just 4})) (String "hello")+-- Nothing+textWithBoundsCodec :: StringBounds -> JSONCodec Text+textWithBoundsCodec bounds = StringCodec Nothing bounds+ -- | Codec for 'String' values -- --@@ -1353,6 +1401,35 @@ stringCodec :: JSONCodec String stringCodec = dimapCodec T.unpack T.pack textCodec +-- | Codec for 'String' values with bounds+--+-- During parsing, only 'String' values within the given boundaries are accepted.+--+-- During rendering, the value is not checked and is simply output as is.+--+-- === Example usage+--+-- >>> JSON.parseMaybe (parseJSONVia (stringWithBoundsCodec StringBounds { stringBoundsMinLength = Just 1, stringBoundsMaxLength = Just 10})) (String "hello")+-- Just "hello"+--+-- >>> JSON.parseMaybe (parseJSONVia (stringWithBoundsCodec StringBounds { stringBoundsMinLength = Just 1, stringBoundsMaxLength = Just 4})) (String "hello")+-- Nothing+--+--+-- === WARNING+--+-- This codec uses 'T.unpack' and 'T.pack' to dimap a 'textWithBoundsCodec', so it __does not roundtrip__.+--+-- >>> toJSONVia (stringWithBoundsCodec StringBounds { stringBoundsMinLength = Just 1, stringBoundsMaxLength = Just 10}) "\55296"+-- String "\65533"+--+--+-- ==== API Note+--+-- This is a 'String' version of 'textWithBoundsCodec'.+stringWithBoundsCodec :: StringBounds -> JSONCodec String+stringWithBoundsCodec bounds = dimapCodec T.unpack T.pack (textWithBoundsCodec bounds)+ -- | Codec for 'Scientific' values -- --@@ -1557,8 +1634,14 @@ unsafeUnboundedNaturalCodec = bimapCodec go fromIntegral scientificCodec where- go s = case Scientific.floatingOrInteger s :: Either Float Natural of- Right i -> Right i+ -- Via 'Integer' rather than straight to 'Natural': 'floatingOrInteger'+ -- reaches its result type through 'fromInteger', and 'fromInteger' into+ -- 'Natural' throws on a negative number, so asking it for a 'Natural'+ -- turns a number this codec should refuse into an arithmetic underflow.+ go s = case Scientific.floatingOrInteger s :: Either Float Integer of+ Right i+ | i < 0 -> Left ("Number is negative: " <> show s)+ | otherwise -> Right (fromInteger i) Left _ -> Left ("Number is not an integer: " <> show s) -- | A codec for a literal piece of 'Text'.@@ -2005,17 +2088,6 @@ Text -> JSONCodec a codecViaAeson doc = bimapCodec (JSON.parseEither JSON.parseJSON) JSON.toJSON valueCodec <?> doc---- Could get this from https://hackage.haskell.org/package/either-result-0.3.1.0/docs/Control-Monad-Result.html#t:Result--- but just reimplementing here to avoid a dependency, as it's not exported anyway--- (well it is actually, until we give this module an explicit export list).--- We need to do this because `Either String a` doesn't have a `MonadFail` instance,--- but `Time.iso8601ParseM` expects it's return value to have a `MonadFail` instance.-newtype Result a = Result {runResult :: Either String a}- deriving newtype (Functor, Applicative, Monad)--instance MonadFail Result where- fail = Result . Left -- TODO 'aeson' has it's own custom datetime serialising code in the module @Data.Aeson.Encoding.Builder@: -- The core function here is `Data.Aeson.Encoding.Builder.timeOfDay64`.