autodocodec 0.2.3.0 → 0.3.0.0

raw patch · 6 files changed

+232/−87 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• autodocodec.cabal +2/−2
• src/Autodocodec/Aeson/Decode.hs +28/−24
• src/Autodocodec/Aeson/Encode.hs +27/−26
• src/Autodocodec/Class.hs +31/−14
• src/Autodocodec/Codec.hs +124/−21

@@ -1,5 +1,25 @@ # Changelog +## [0.3.0.0] - 2024-07-19++### Added++* `HasCodec` instances for:+    * `Const`+    * `Dual`+    * `Semigroup.First`+    * `Semigroup.Last`+    * `Monoid.First`+    * `Monoid.Last`+++### Changed++* Refactored `Codec` so it's input and output parameters have a representative, not nominal role.+  This means one can now use `deriving newtype` with the `HasCodec` class.+* Fixed infinitely looping `Identity` instance+* Improve the documentation of `time`-related codecs to show `<string>` instead of `<any>`.+ ## [0.2.3.0] - 2024-06-23  ### Added

@@ -5,13 +5,13 @@ -- see: https://github.com/sol/hpack  name:           autodocodec-version:        0.2.3.0+version:        0.3.0.0 synopsis:       Self-documenting encoder and decoder homepage:       https://github.com/NorfairKing/autodocodec#readme bug-reports:    https://github.com/NorfairKing/autodocodec/issues author:         Tom Sydney Kerckhove maintainer:     syd@cs-syd.eu-copyright:      2021-2023 Tom Sydney Kerckhove+copyright:      2021-2024 Tom Sydney Kerckhove license:        MIT license-file:   LICENSE build-type:     Simple

@@ -25,9 +25,11 @@ import Control.Monad import Data.Aeson as JSON import Data.Aeson.Types as JSON+import Data.Coerce (coerce) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Map (Map)+import Data.Text (Text) import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V@@ -59,34 +61,36 @@     go :: context -> Codec context void a -> JSON.Parser a     go value = \case       NullCodec -> case (value :: JSON.Value) of-        Null -> pure ()+        Null -> coerce (pure () :: JSON.Parser ())         _ -> typeMismatch "Null" value       BoolCodec mname -> case mname of-        Nothing -> parseJSON value-        Just name -> withBool (T.unpack name) pure value+        Nothing -> coerce (parseJSON value :: JSON.Parser Bool)+        Just name -> coerce $ withBool (T.unpack name) pure value       StringCodec mname -> case mname of-        Nothing -> parseJSON value-        Just name -> withText (T.unpack name) pure value+        Nothing -> coerce (parseJSON value :: JSON.Parser Text)+        Just name -> coerce $ withText (T.unpack name) pure value       NumberCodec mname mBounds ->-        ( \f -> case mname of-            Nothing -> parseJSON value >>= f-            Just name -> withScientific (T.unpack name) f value-        )-          ( \s -> case maybe Right checkNumberBounds mBounds s of-              Left err -> fail err-              Right s' -> pure s'+        coerce $+          ( \f -> case mname of+              Nothing -> parseJSON value >>= f+              Just name -> withScientific (T.unpack name) f value           )+            ( \s -> case maybe Right checkNumberBounds mBounds s of+                Left err -> fail err+                Right s' -> pure s'+            )       ArrayOfCodec mname c ->         ( \f -> case mname of             Nothing -> parseJSON value >>= f             Just name -> withArray (T.unpack name) f value         )           ( \vector ->-              forM-                (V.indexed (vector :: Vector JSON.Value))-                ( \(ix, v) ->-                    go v c JSON.<?> Index ix-                )+              coerce $+                forM+                  (V.indexed (vector :: Vector JSON.Value))+                  ( \(ix, v) ->+                      go v c JSON.<?> Index ix+                  )           )       ObjectOfCodec mname c ->         ( \f -> case mname of@@ -94,13 +98,13 @@             Just name -> withObject (T.unpack name) f value         )           (\object_ -> (`go` c) (object_ :: JSON.Object))-      HashMapCodec c -> Compat.liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (HashMap _ _)-      MapCodec c -> Compat.liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (Map _ _)-      ValueCodec -> pure (value :: JSON.Value)+      HashMapCodec c -> coerce (Compat.liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (HashMap _ _))+      MapCodec c -> coerce (Compat.liftParseJSON (`go` c) (`go` listCodec c) value :: JSON.Parser (Map _ _))+      ValueCodec -> pure $ coerce value       EqCodec expected c -> do         actual <- go value c         if expected == actual-          then pure actual+          then pure (coerce actual)           else fail $ unwords ["Expected", show expected, "but got", show actual]       BimapCodec f _ c -> do         old <- go value c@@ -110,7 +114,7 @@       EitherCodec u c1 c2 ->         let leftParser v = Left <$> go v c1             rightParser v = Right <$> go v c2-         in case u of+         in coerce $ case u of               PossiblyJointUnion ->                 case parseEither leftParser value of                   Right l -> pure l@@ -141,11 +145,11 @@       OptionalKeyCodec k c _ -> do         let key = Compat.toKey k             mValueAtKey = Compat.lookupKey key (value :: JSON.Object)-        forM mValueAtKey $ \valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key key+        coerce $ forM mValueAtKey $ \valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key key       OptionalKeyWithDefaultCodec k c defaultValue _ -> do         let key = Compat.toKey k             mValueAtKey = Compat.lookupKey key (value :: JSON.Object)-        case mValueAtKey of+        coerce $ case mValueAtKey of           Nothing -> pure defaultValue           Just valueAtKey -> go (valueAtKey :: JSON.Value) c JSON.<?> Key key       OptionalKeyWithOmittedDefaultCodec k c defaultValue mDoc -> go value $ OptionalKeyWithDefaultCodec k c defaultValue mDoc

@@ -25,6 +25,7 @@ import Data.Aeson (toJSON) import qualified Data.Aeson as JSON import qualified Data.Aeson.Encoding as JSON+import Data.Coerce (coerce) import Data.HashMap.Strict (HashMap) import Data.Map (Map) import Data.Scientific@@ -45,17 +46,17 @@     go :: a -> ObjectCodec a void -> JSON.Object     go a = \case       RequiredKeyCodec k c _ -> Compat.toKey k JSON..= toJSONVia c a-      OptionalKeyCodec k c _ -> case (a :: Maybe _) of+      OptionalKeyCodec k c _ -> case (coerce a :: Maybe _) of         Nothing -> mempty         Just b -> Compat.toKey k JSON..= toJSONVia c b-      OptionalKeyWithDefaultCodec k c _ mdoc -> go (Just a) (OptionalKeyCodec k c mdoc)+      OptionalKeyWithDefaultCodec k c _ mdoc -> go (Just a) (optionalKeyCodec k c mdoc)       OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->-        if a == defaultValue+        if coerce a == defaultValue           then mempty-          else go a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)+          else go a (optionalKeyWithDefaultCodec k (coerce c) (coerce defaultValue) mdoc)       BimapCodec _ g c -> go (g a) c       PureCodec _ -> mempty-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+      EitherCodec _ c1 c2 -> case (coerce a :: Either _ _) of         Left a1 -> go a1 c1         Right a2 -> go a2 c2       DiscriminatedUnionCodec propertyName mapping _ ->@@ -73,17 +74,17 @@     go :: a -> ValueCodec a void -> JSON.Value     go a = \case       NullCodec -> JSON.Null-      BoolCodec _ -> toJSON (a :: Bool)-      StringCodec _ -> toJSON (a :: Text)-      NumberCodec _ _ -> toJSON (a :: Scientific)-      ArrayOfCodec _ c -> toJSON (fmap (`go` c) (a :: Vector _))+      BoolCodec _ -> toJSON (coerce a :: Bool)+      StringCodec _ -> toJSON (coerce a :: Text)+      NumberCodec _ _ -> toJSON (coerce a :: Scientific)+      ArrayOfCodec _ c -> toJSON (fmap (`go` c) (coerce a :: Vector _))       ObjectOfCodec _ oc -> JSON.Object (toJSONObjectVia oc a)-      HashMapCodec c -> Compat.liftToJSON (`go` c) (`go` listCodec c) (a :: HashMap _ _)-      MapCodec c -> Compat.liftToJSON (`go` c) (`go` listCodec c) (a :: Map _ _)-      ValueCodec -> (a :: JSON.Value)+      HashMapCodec c -> Compat.liftToJSON (`go` c) (`go` listCodec c) (coerce a :: HashMap _ _)+      MapCodec c -> Compat.liftToJSON (`go` c) (`go` listCodec c) (coerce a :: Map _ _)+      ValueCodec -> (coerce a :: JSON.Value)       EqCodec value c -> go value c       BimapCodec _ g c -> go (g a) c-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+      EitherCodec _ c1 c2 -> case (coerce a :: Either _ _) of         Left a1 -> go a1 c1         Right a2 -> go a2 c2       CommentCodec _ c -> go a c@@ -102,17 +103,17 @@     goObject :: a -> ObjectCodec a void -> JSON.Series     goObject a = \case       RequiredKeyCodec k c _ -> JSON.pair (Compat.toKey k) (toEncodingVia c a)-      OptionalKeyCodec k c _ -> case (a :: Maybe _) of+      OptionalKeyCodec k c _ -> case (coerce a :: Maybe _) of         Nothing -> mempty :: JSON.Series         Just b -> JSON.pair (Compat.toKey k) (toEncodingVia c b)-      OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (OptionalKeyCodec k c mdoc)+      OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (optionalKeyCodec k c mdoc)       OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->-        if a == defaultValue+        if coerce a == defaultValue           then mempty-          else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)+          else goObject a (optionalKeyWithDefaultCodec k (coerce c) (coerce defaultValue) mdoc)       PureCodec _ -> mempty :: JSON.Series       BimapCodec _ g c -> goObject (g a) c-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+      EitherCodec _ c1 c2 -> case (coerce a :: Either _ _) of         Left a1 -> goObject a1 c1         Right a2 -> goObject a2 c2       DiscriminatedUnionCodec propertyName mapping _ ->@@ -128,17 +129,17 @@     go :: a -> ValueCodec a void -> JSON.Encoding     go a = \case       NullCodec -> JSON.null_-      BoolCodec _ -> JSON.bool (a :: Bool)-      StringCodec _ -> JSON.text (a :: Text)-      NumberCodec _ _ -> JSON.scientific (a :: Scientific)-      ArrayOfCodec _ c -> JSON.list (`go` c) (V.toList (a :: Vector _))+      BoolCodec _ -> JSON.bool (coerce a :: Bool)+      StringCodec _ -> JSON.text (coerce a :: Text)+      NumberCodec _ _ -> JSON.scientific (coerce a :: Scientific)+      ArrayOfCodec _ c -> JSON.list (`go` c) (V.toList (coerce a :: Vector _))       ObjectOfCodec _ oc -> JSON.pairs (toSeriesVia oc a)-      HashMapCodec c -> Compat.liftToEncoding (`go` c) (`go` listCodec c) (a :: HashMap _ _)-      MapCodec c -> Compat.liftToEncoding (`go` c) (`go` listCodec c) (a :: Map _ _)-      ValueCodec -> JSON.value (a :: JSON.Value)+      HashMapCodec c -> Compat.liftToEncoding (`go` c) (`go` listCodec c) (coerce a :: HashMap _ _)+      MapCodec c -> Compat.liftToEncoding (`go` c) (`go` listCodec c) (coerce a :: Map _ _)+      ValueCodec -> JSON.value (coerce a :: JSON.Value)       EqCodec value c -> go value c       BimapCodec _ g c -> go (g a) c-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+      EitherCodec _ c1 c2 -> case (coerce a :: Either _ _) of         Left a1 -> go a1 c1         Right a2 -> go a2 c2       CommentCodec _ c -> go a c

@@ -1,9 +1,12 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} -- Because Eq is a superclass of Hashable in newer versions. {-# OPTIONS_GHC -Wno-redundant-constraints #-} @@ -16,13 +19,17 @@ #if MIN_VERSION_aeson(2,0,0) import Data.Aeson.KeyMap (KeyMap) #endif+import Data.Functor.Const (Const (Const)) import Data.Functor.Identity import Data.HashMap.Strict (HashMap) import Data.Hashable (Hashable) import Data.Int import Data.List.NonEmpty (NonEmpty (..)) import Data.Map (Map)+import qualified Data.Monoid as Monoid import Data.Scientific+import Data.Semigroup (Dual (Dual))+import qualified Data.Semigroup as Semigroup import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text)@@ -52,7 +59,7 @@   {-# MINIMAL codec #-}  instance HasCodec Void where-  codec = bimapCodec (\_ -> Left "Cannot decode a Void.") absurd ValueCodec+  codec = bimapCodec (\_ -> Left "Cannot decode a Void.") absurd valueCodec  instance HasCodec Bool where   codec = boolCodec@@ -117,11 +124,22 @@   codec = naturalCodec  instance HasCodec JSON.Value where-  codec = ValueCodec+  codec = valueCodec -instance (HasCodec a) => HasCodec (Identity a) where-  codec = dimapCodec runIdentity Identity codec+deriving newtype instance (HasCodec a) => HasCodec (Identity a) +deriving newtype instance (HasCodec a) => HasCodec (Dual a)++deriving newtype instance (HasCodec a) => HasCodec (Semigroup.First a)++deriving newtype instance (HasCodec a) => HasCodec (Semigroup.Last a)++deriving newtype instance (HasCodec a) => HasCodec (Monoid.First a)++deriving newtype instance (HasCodec a) => HasCodec (Monoid.Last a)++deriving newtype instance (HasCodec a) => HasCodec (Const a b)+ instance (HasCodec a) => HasCodec (Maybe a) where   codec = maybeCodec codec @@ -144,31 +162,30 @@   codec = dimapCodec S.fromList S.toList codec  instance (Ord k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (Map k v) where-  codec = MapCodec codec+  codec = mapCodec codec  instance (Eq k, Hashable k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (HashMap k v) where-  codec = HashMapCodec codec+  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"+  codec = unsafeCodecViaAesonString "Day"  instance HasCodec LocalTime where-  codec = codecViaAeson "LocalTime"+  codec = unsafeCodecViaAesonString "LocalTime"  instance HasCodec UTCTime where-  codec = codecViaAeson "LocalTime"+  codec = unsafeCodecViaAesonString "UTCTime"  instance HasCodec TimeOfDay where-  codec = codecViaAeson "TimeOfDay"+  codec = unsafeCodecViaAesonString "TimeOfDay"  instance HasCodec ZonedTime where-  codec = codecViaAeson "ZonedTime"+  codec = unsafeCodecViaAesonString "ZonedTime"  instance HasCodec NominalDiffTime where   codec = dimapCodec realToFrac realToFrac (codec :: JSONCodec Scientific)@@ -276,7 +293,7 @@   -- | Documentation   Text ->   ObjectCodec (Maybe output) (Maybe output)-optionalFieldOrNull key doc = orNullHelper $ OptionalKeyCodec key (maybeCodec codec) (Just doc)+optionalFieldOrNull key doc = orNullHelper $ optionalKeyCodec key (maybeCodec codec) (Just doc)  -- | Like 'optionalFieldOrNull', but without documentation optionalFieldOrNull' ::@@ -285,7 +302,7 @@   -- | Key   Text ->   ObjectCodec (Maybe output) (Maybe output)-optionalFieldOrNull' key = orNullHelper $ OptionalKeyCodec key (maybeCodec codec) Nothing+optionalFieldOrNull' key = orNullHelper $ optionalKeyCodec key (maybeCodec codec) Nothing  optionalFieldWithOmittedDefault ::   (Eq output, HasCodec output) =>

@@ -1,9 +1,13 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RoleAnnotations #-}@@ -19,11 +23,8 @@ 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.Coerce (Coercible) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Hashable@@ -41,8 +42,13 @@ import Data.Vector (Vector) import qualified Data.Vector as V import Data.Void+import Data.Word import GHC.Generics (Generic) import Numeric.Natural+#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.KeyMap (KeyMap)+import qualified Data.Aeson.KeyMap as KM+#endif  -- $setup -- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, toJSONObjectVia, toJSONObjectViaCodec, parseJSONVia, parseJSONViaCodec, parseJSONObjectVia, parseJSONObjectViaCodec)@@ -71,22 +77,27 @@ -- * The @input@ parameter is used for the type that is used during encoding of a value, so it's the @input@ to the codec. -- * The @output@ parameter is used for the type that is used during decoding of a value, so it's the @output@ of the codec. -- * Both parameters are unused during documentation.+type role Codec _ representational representational+ data Codec context input output where   -- | Encode '()' to the @null@ value, and decode @null@ as '()'.   NullCodec ::-    ValueCodec () ()+    (Coercible a (), Coercible b ()) =>+    ValueCodec a b   -- | Encode a 'Bool' to a @boolean@ value, and decode a @boolean@ value as a 'Bool'.   BoolCodec ::+    (Coercible a Bool, Coercible b Bool) =>     -- | Name of the @bool@, for error messages and documentation.     Maybe Text ->-    JSONCodec Bool+    ValueCodec a b   -- | Encode 'Text' to a @string@ value, and decode a @string@ value as a 'Text'.   --   -- This is named after the primitive type "String" in json, not after the haskell type string.   StringCodec ::+    (Coercible a Text, Coercible b Text) =>     -- | Name of the @string@, for error messages and documentation.     Maybe Text ->-    JSONCodec Text+    ValueCodec a b   -- | Encode 'Scientific' to a @number@ value, and decode a @number@ value as a 'Scientific'.   --   -- The number has optional 'NumberBounds'.@@ -94,30 +105,33 @@   --   -- NOTE: We use 'Scientific' here because that is what aeson uses.   NumberCodec ::+    (Coercible a Scientific, Coercible b Scientific) =>     -- | Name of the @number@, for error messages and documentation.     Maybe Text ->     -- | Bounds for the number, these are checked and documented     Maybe NumberBounds ->-    JSONCodec Scientific+    ValueCodec a b   -- | Encode a 'HashMap', and decode any 'HashMap'.   HashMapCodec ::-    (Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>+    (Eq k, Hashable k, FromJSONKey k, ToJSONKey k, Coercible a (HashMap k v), Coercible b (HashMap k v)) =>     JSONCodec v ->-    JSONCodec (HashMap k v)+    ValueCodec a b   -- | Encode a 'Map', and decode any 'Map'.   MapCodec ::-    (Ord k, FromJSONKey k, ToJSONKey k) =>+    (Ord k, FromJSONKey k, ToJSONKey k, Coercible a (Map k v), Coercible b (Map k v)) =>     JSONCodec v ->-    JSONCodec (Map k v)+    ValueCodec a b   -- | Encode a 'JSON.Value', and decode any 'JSON.Value'.   ValueCodec ::-    JSONCodec JSON.Value+    (Coercible JSON.Value a, Coercible JSON.Value b) =>+    ValueCodec a b   -- | Encode a 'Vector' of values as an @array@ value, and decode an @array@ value as a 'Vector' of values.   ArrayOfCodec ::+    (Coercible a (Vector input), Coercible b (Vector output)) =>     -- | Name of the @array@, for error messages and documentation.     Maybe Text ->     ValueCodec input output ->-    ValueCodec (Vector input) (Vector output)+    ValueCodec a b   -- | 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.@@ -126,12 +140,12 @@     ValueCodec input output   -- | Match a given value using its 'Eq' instance during decoding, and encode exactly that value during encoding.   EqCodec ::-    (Show value, Eq value) =>+    (Show value, Eq value, Coercible a value, Coercible b value) =>     -- | Value to match     value ->     -- | Codec for the value     JSONCodec value ->-    JSONCodec value+    ValueCodec a b   -- | Map a codec in both directions.   --   -- This is not strictly dimap, because the decoding function is allowed to fail,@@ -156,13 +170,14 @@   -- In particular, you should prefer using it for values rather than objects,   -- because those docs are easier to generate.   EitherCodec ::+    (Coercible a (Either input1 input2), Coercible b (Either output1 output2)) =>     -- | What type of union we encode and decode     !Union ->     -- | Codec for the 'Left' side     Codec context input1 output1 ->     -- | Codec for the 'Right' side     Codec context input2 output2 ->-    Codec context (Either input1 input2) (Either output1 output2)+    Codec context a b   -- | Encode/decode a discriminated union of objects   --   -- The type of object being encoded/decoded is discriminated by@@ -217,14 +232,16 @@     Maybe Text ->     ObjectCodec input output   OptionalKeyCodec ::+    (Coercible a (Maybe input), Coercible b (Maybe output)) =>     -- | Key     Text ->     -- | Codec for the value     ValueCodec input output ->     -- | Documentation     Maybe Text ->-    ObjectCodec (Maybe input) (Maybe output)+    ObjectCodec a b   OptionalKeyWithDefaultCodec ::+    (Coercible b value) =>     -- | Key     Text ->     -- | Codec for the value@@ -233,9 +250,9 @@     value ->     -- | Documentation     Maybe Text ->-    ObjectCodec value value+    ObjectCodec value b   OptionalKeyWithOmittedDefaultCodec ::-    (Eq value) =>+    (Eq value, Coercible a value, Coercible b value) =>     -- | Key     Text ->     -- | Codec for the value@@ -244,7 +261,7 @@     value ->     -- | Documentation     Maybe Text ->-    ObjectCodec value value+    ObjectCodec a b   -- | To implement 'pure' from 'Applicative'.   --   -- Pure is not available for non-object codecs because there is no 'mempty' for 'JSON.Value', which we would need during encoding.@@ -270,6 +287,18 @@  instance Validity NumberBounds +optionalKeyWithDefaultCodec ::+  -- | Key+  Text ->+  -- | Codec for the value+  ValueCodec value value ->+  -- | Default value+  value ->+  -- | Documentation+  Maybe Text ->+  ObjectCodec value value+optionalKeyWithDefaultCodec = OptionalKeyWithDefaultCodec+ -- | Check if a number falls within given 'NumberBounds'. checkNumberBounds :: NumberBounds -> Scientific -> Either String Scientific checkNumberBounds NumberBounds {..} s =@@ -280,6 +309,43 @@         else Left $ unwords ["Number", show s, "is bigger than the upper bound", show numberBoundsUpper]     else Left $ unwords ["Number", show s, "is smaller than the lower bound", show numberBoundsUpper] +data NumberBoundsSymbolic+  = BitUInt !Word8 -- w bit unsigned int+  | BitSInt !Word8 -- w bit signed int+  | OtherNumberBounds !ScientificSymbolic !ScientificSymbolic++guessNumberBoundsSymbolic :: NumberBounds -> NumberBoundsSymbolic+guessNumberBoundsSymbolic NumberBounds {..} =+  case (guessScientificSymbolic numberBoundsLower, guessScientificSymbolic numberBoundsUpper) of+    (Zero, PowerOf2MinusOne w) -> BitUInt w+    (MinusPowerOf2 w1, PowerOf2MinusOne w2) | w1 == w2 -> BitSInt (succ w1)+    (l, u) -> OtherNumberBounds l u++data ScientificSymbolic+  = Zero+  | PowerOf2 !Word8 -- 2^w+  | PowerOf2MinusOne !Word8 -- 2^w -1+  | MinusPowerOf2 !Word8 -- - 2^w+  | MinusPowerOf2MinusOne !Word8 -- - (2^w -1)+  | OtherInteger !Integer+  | OtherDouble !Double++guessScientificSymbolic :: Scientific -> ScientificSymbolic+guessScientificSymbolic s = case floatingOrInteger s of+  Left d -> OtherDouble d+  Right i ->+    let log2Rounded :: Word8+        log2Rounded = round (logBase 2 (fromInteger (abs i)) :: Double)+        guess :: Integer+        guess = 2 ^ log2Rounded+     in if+          | i == 0 -> Zero+          | guess == i -> PowerOf2 log2Rounded+          | (guess - 1) == i -> PowerOf2MinusOne log2Rounded+          | -guess == i -> MinusPowerOf2 log2Rounded+          | -(guess - 1) == i -> MinusPowerOf2MinusOne log2Rounded+          | otherwise -> OtherInteger i+ -- | What type of union the encoding uses data Union   = -- | Not disjoint, see 'possiblyJointEitherCodec'.@@ -794,6 +860,10 @@ listCodec :: ValueCodec input output -> ValueCodec [input] [output] listCodec = dimapCodec V.toList V.fromList . vectorCodec +-- Some restricted constructors+optionalKeyCodec :: Text -> ValueCodec input output -> Maybe Text -> ObjectCodec (Maybe input) (Maybe output)+optionalKeyCodec = OptionalKeyCodec+ -- | Build a codec for nonempty lists of values from a codec for a single value. -- --@@ -1841,3 +1911,36 @@   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`.+-- However, this module is private.+-- There is @Data.Aeson.Encoding.Internal@, which interestingly isn't private, but it's only exposed functions+-- wrap the return bytestring in a quotes. Only for the quotes to be removed in `Data.Aeson.Types.ToJSON.stringEncoding`+-- This all seems a bit silly.+-- I think `aeson` should just expose @Data.Aeson.Encoding.Builder@ and it's datetime instances should just take those builders,+-- convert them to Text and be done with it.+-- I plan to submit a PR to 'aeson' to do this.+-- In the meantime, I think the best way to ensure we are exactly behaving as 'aeson' is just to _assume_ aeson is returning a string+-- This is a correct assumption for any of the datetime types, but using this function generally is unsafe.+unsafeCodecViaAesonString ::+  (FromJSON a, ToJSON a) =>+  -- | Name+  Text ->+  JSONCodec a+unsafeCodecViaAesonString doc = bimapCodec (JSON.parseEither JSON.parseJSON . JSON.String) (unsafeAesonValueToString . JSON.toJSON) textCodec <?> doc+  where+    unsafeAesonValueToString v = case v of+      JSON.String s -> s+      _ -> error $ "unsafeAesonValueToString failed.\n " ++ show v ++ "\n is not a JSON string."