put the default value in the key schema directly

autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs

@@ -10,7 +10,6 @@ import Control.Monad
 import Data.Aeson as JSON
 import Data.Aeson.Types as JSON
 import qualified Data.HashMap.Strict as HM
-import Data.Maybe
 import qualified Data.Text as T
 
 parseJSONViaCodec :: HasCodec a => JSON.Value -> JSON.Parser a
@@ -66,6 +65,10 @@ parseContextVia = flip go
       OptionalKeyCodec k c _ -> do
         let mValueAtKey = HM.lookup k value
         forM mValueAtKey $ \valueAtKey -> go valueAtKey c
-      DefaultCodec defaultValue _ c -> fromMaybe defaultValue <$> go value c
+      OptionalKeyWithDefaultCodec k c _ defaultValue _ -> do
+        let mValueAtKey = HM.lookup k value
+        case mValueAtKey of
+          Nothing -> pure defaultValue
+          Just valueAtKey -> go valueAtKey c
       PureCodec a -> pure a
       ApCodec ocf oca -> go value ocf <*> go value oca

autodocodec-aeson/src/Autodocodec/Aeson/Document.hs

@@ -10,7 +10,6 @@ module Autodocodec.Aeson.Document where
 
 import Autodocodec
 import Autodocodec.Aeson.Encode
-import Control.Arrow (second)
 import Control.Monad.State
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as JSON
@@ -124,7 +123,9 @@ validateAccordingTo = go
                 Just (_, ks, _) -> go value' ks
               goKeySchema :: Text -> (KeyRequirement, JSONSchema, Maybe Text) -> Bool
               goKeySchema key (kr, ks, _) = case HM.lookup key hm of
-                Nothing -> kr == Optional
+                Nothing -> case kr of
+                  Required -> False
+                  Optional _ -> True
                 Just value' -> go value' ks
               actualKeys = HM.toList hm
            in all (uncurry goKey) actualKeys && all (uncurry goKeySchema) kss
@@ -151,7 +152,9 @@ instance Validity JSONSchema where
           _ -> valid
       ]
 
-data KeyRequirement = Required | Optional
+data KeyRequirement
+  = Required
+  | Optional (Maybe (Text, JSON.Value)) -- Default value, human readable and machine readible
   deriving (Show, Eq, Generic)
 
 instance Validity KeyRequirement
@@ -183,7 +186,7 @@ instance ToJSON JSONSchema where
                 ( (k, s) : ps,
                   case r of
                     Required -> S.insert k rps
-                    Optional -> rps
+                    Optional _ -> rps
                 )
               (props, requiredProps) = foldl' combine ([], S.empty) os
           propVals <- mapM (fmap JSON.object . go) $ HM.fromList props
@@ -245,7 +248,7 @@ instance FromJSON JSONSchema where
                   ( k,
                     ( if k `elem` requiredProps
                         then Required
-                        else Optional,
+                        else Optional Nothing, -- TODO
                       s,
                       Nothing -- TODO
                     )
@@ -265,10 +268,10 @@ instance FromJSON JSONSchema where
 jsonSchemaViaCodec :: forall a. HasCodec a => JSONSchema
 jsonSchemaViaCodec = jsonSchemaVia (codec @a)
 
-jsonSchemaVia :: Codec context input output -> JSONSchema
+jsonSchemaVia :: ValueCodec input output -> JSONSchema
 jsonSchemaVia = go
   where
-    go :: Codec context input output -> JSONSchema
+    go :: ValueCodec input output -> JSONSchema
     go = \case
       ValueCodec -> AnySchema
       NullCodec -> NullSchema
@@ -282,11 +285,6 @@ jsonSchemaVia = go
       MapCodec _ _ c -> go c
       CommentCodec t c -> CommentSchema t (go c)
       ReferenceCodec t c -> ReferenceSchema t (go c)
-      PureCodec _ -> AnySchema -- TODO is this right?
-      ApCodec oc1 oc2 -> ObjectSchema (goObject oc1 ++ goObject oc2)
-      DefaultCodec value shownValue c -> DefaultSchema shownValue (JSON.Object (toContextVia c (Just value))) (go c)
-      RequiredKeyCodec k c mdoc -> ObjectSchema [(k, (Required, go c, mdoc))]
-      OptionalKeyCodec k c mdoc -> ObjectSchema [(k, (Optional, go c, mdoc))]
 
     goChoice :: NonEmpty JSONSchema -> NonEmpty JSONSchema
     goChoice (s :| rest) = case NE.nonEmpty rest of
@@ -301,9 +299,9 @@ jsonSchemaVia = go
     goObject :: ObjectCodec input output -> [(Text, (KeyRequirement, JSONSchema, Maybe Text))]
     goObject = \case
       RequiredKeyCodec k c mdoc -> [(k, (Required, go c, mdoc))]
-      OptionalKeyCodec k c mdoc -> [(k, (Optional, go c, mdoc))]
+      OptionalKeyCodec k c mdoc -> [(k, (Optional Nothing, go c, mdoc))]
+      OptionalKeyWithDefaultCodec k c hr mr mdoc -> [(k, (Optional (Just (hr, toJSONVia c mr)), go c, mdoc))]
       MapCodec _ _ c -> goObject c
-      DefaultCodec value shownValue c -> map (second (\(kr, s, mt) -> (kr, DefaultSchema shownValue (JSON.Object (toContextVia c (Just value))) s, mt))) (goObject c) -- TODO This isn't exactly clean, is it?
       PureCodec _ -> [] -- TODO show something ?
       ApCodec oc1 oc2 -> goObject oc1 ++ goObject oc2
 

autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs

@@ -38,6 +38,6 @@ toContextVia = flip go
       OptionalKeyCodec k c _ -> case a of
         Nothing -> mempty
         Just b -> k JSON..= go b c
-      DefaultCodec _ _ c -> go (Just a) c -- Default value is ignored during encoding.
+      OptionalKeyWithDefaultCodec k c _ _ mdoc -> go (Just a) (OptionalKeyCodec k c mdoc)
       PureCodec _ -> error "Cannot toJSON a pure object codec."
       ApCodec oc1 oc2 -> go a oc1 <> go a oc2

autodocodec-api-usage/src/Autodocodec/Usage.hs

@@ -68,7 +68,7 @@ instance HasCodec Example where
         <*> requiredField "maybe" "a maybe text" .= exampleRequiredMaybe
         <*> optionalField "optional" "an optional text" .= exampleOptional
         <*> optionalFieldOrNull "optional-or-null" "an optional-or-null text" .= exampleOptionalOrNull
-        <*> optionalField "optional-with-default" "an optional text with a default" .!= "foobar" .= exampleOptionalWithDefault
+        <*> optionalFieldWithDefault "optional-with-default" "foobar" "an optional text with a default" .= exampleOptionalWithDefault
         <*> requiredField "fruit" "fruit!!" .= exampleFruit
 
 instance ToJSON Example where

autodocodec-api-usage/test/Autodocodec/Aeson/DocumentSpec.hs

@@ -109,9 +109,9 @@ instance GenValid JSONSchema where
               (CommentSchema <$> resize a genValid <*> resize b genValid) `suchThat` isValid
           ]
 
-instance GenUnchecked KeyRequirement
-
-instance GenValid KeyRequirement
+instance GenValid KeyRequirement where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
 
 jsonSchemaSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 jsonSchemaSpec filePath =

autodocodec-api-usage/test_resources/schema/example.json

@@ -38,9 +38,6 @@
             ]
         },
         "optional-with-default": {
-            "default": {
-                "optional-with-default": "foobar"
-            },
             "type": "string"
         },
         "optional-or-null": {

autodocodec-api-usage/test_resources/schema/example.txt

@@ -19,8 +19,8 @@
   , <string>
   ]
 optional-with-default: # optional
-  # an optional text with a default
   # default: "foobar"
+  # an optional text with a default
   <string>
 fruit: # required
   # fruit!!

autodocodec-yaml/src/Autodocodec/Yaml/Document.hs

@@ -22,7 +22,7 @@ import Text.Colour
 schemaChunksViaCodec :: forall a. HasCodec a => [Chunk]
 schemaChunksViaCodec = schemaChunksVia (codec @a)
 
-schemaChunksVia :: Codec context input output -> [Chunk]
+schemaChunksVia :: ValueCodec input output -> [Chunk]
 schemaChunksVia = jsonSchemaChunks . jsonSchemaVia
 
 jsonSchemaChunks :: JSONSchema -> [Chunk]
@@ -49,12 +49,18 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . (`evalState` S.empty) . go
       ObjectSchema s ->
         let requirementComment = \case
               Required -> fore red "required"
-              Optional -> fore blue "optional"
+              Optional _ -> fore blue "optional"
+            mDefaultValue = \case
+              Required -> Nothing
+              Optional mdv -> fst <$> mdv
             keySchemaFor k (kr, ks, mdoc) = do
               keySchemaChunks <- go ks
               let docToLines :: Text -> [[Chunk]]
                   docToLines doc = map (\line -> [chunk "# ", chunk line]) (T.lines doc)
-              let prefixLines = ["# ", requirementComment kr] : maybe [] docToLines mdoc
+                  defaultValueLine = case mDefaultValue kr of
+                    Nothing -> []
+                    Just defaultValue -> [[chunk "# default: ", fore magenta $ chunk defaultValue]]
+              let prefixLines = ["# ", requirementComment kr] : defaultValueLine ++ maybe [] docToLines mdoc
               pure $ addInFrontOfFirstInList [fore white $ chunk k, ":", " "] (prefixLines ++ keySchemaChunks)
          in if null s
               then pure [["<object>"]]

autodocodec/src/Autodocodec/Class.hs

@@ -150,6 +150,36 @@ optionalField' ::
   ObjectCodec (Maybe output) (Maybe output)
 optionalField' key = optionalFieldWith' key codec
 
+-- | An optional field with a default value
+--
+-- During decoding, the field may be in the object. The default value will be parsed otherwise.
+--
+-- During encoding, the field will be in the object. The default value is ignored.
+--
+-- The shown version of the default value will appear in the documentation.
+optionalFieldWithDefault ::
+  (Show output, HasCodec output) =>
+  -- | Key
+  Text ->
+  -- | Default value
+  output ->
+  -- | Documentation
+  Text ->
+  -- |
+  ObjectCodec output output
+optionalFieldWithDefault key defaultValue doc = optionalFieldWithDefaultWith key codec defaultValue doc
+
+-- | Like 'optionalFieldWithDefault', but without documentation
+optionalFieldWithDefault' ::
+  (Show output, HasCodec output) =>
+  -- | Key
+  Text ->
+  -- | Default value
+  output ->
+  -- |
+  ObjectCodec output output
+optionalFieldWithDefault' key defaultValue = optionalFieldWithDefaultWith' key codec defaultValue
+
 -- | An optional, or null, field
 --
 -- During decoding, the field may be in the object. 'Nothing' will be parsed if it is not.

autodocodec/src/Autodocodec/Codec.hs

@@ -134,30 +134,34 @@ data Codec context input output where
     -- |
     ValueCodec input output
   RequiredKeyCodec ::
-    -- | The key
+    -- | Key
     Text ->
-    -- |
+    -- | Codec for the value
     ValueCodec input output ->
     -- | Documentation
     Maybe Text ->
     -- |
     ObjectCodec input output
   OptionalKeyCodec ::
-    -- | The key
+    -- | Key
     Text ->
-    -- |
+    -- | Codec for the value
     ValueCodec input output ->
     -- | Documentation
     Maybe Text ->
     -- |
-    Codec JSON.Object (Maybe input) (Maybe output)
-  DefaultCodec ::
+    ObjectCodec (Maybe input) (Maybe output)
+  OptionalKeyWithDefaultCodec ::
+    -- | Key
+    Text ->
+    -- | Codec for the value
+    ValueCodec value value ->
+    -- | Human-readible version of the default value
+    Text ->
     -- | Default value
     value ->
-    -- | Shown version of the default value
-    Text ->
-    -- |
-    ObjectCodec (Maybe value) (Maybe value) ->
+    -- | Documentation
+    Maybe Text ->
     -- |
     ObjectCodec value value
   -- Pure is not available for non-object codecs
@@ -225,9 +229,9 @@ showCodecABit = ($ "") . (`evalState` S.empty) . go 0
             pure $ showParen (d > 10) $ showString "ReferenceCodec " . showsPrec d name . showString " " . s
       RequiredKeyCodec k c mdoc -> (\s -> showParen (d > 10) $ showString "RequiredKeyCodec " . showsPrec d k . showString " " . showsPrec d mdoc . showString " " . s) <$> go 11 c
       OptionalKeyCodec k c mdoc -> (\s -> showParen (d > 10) $ showString "OptionalKeyCodec " . showsPrec d k . showString " " . showsPrec d mdoc . showString " " . s) <$> go 11 c
+      OptionalKeyWithDefaultCodec k c shownDefault _ mdoc -> (\s -> showParen (d > 10) $ showString "OptionalKeyWithDefaultCodec " . showsPrec d k . showString " " . s . showString " " . showsPrec d shownDefault . showString " " . showsPrec d mdoc) <$> go 11 c
       PureCodec _ -> pure $ showString "PureCodec" -- TODO add show instance?
       ApCodec oc1 oc2 -> (\s1 s2 -> showParen (d > 10) $ showString "ApCodec " . s1 . showString " " . s2) <$> go 11 oc1 <*> go 11 oc2
-      DefaultCodec _ defaultShown c -> (\s -> showParen (d > 10) $ showString "DefaultCodec " . showsPrec d defaultShown . showString " " . s) <$> go 11 c
 
 -- | Map the output part of a codec
 --
@@ -375,46 +379,37 @@ optionalFieldWith' ::
   ObjectCodec (Maybe input) (Maybe output)
 optionalFieldWith' key c = OptionalKeyCodec key c Nothing
 
--- | Add a default value to a codec, documented using its show instance.
+-- | An optional field with default value
 --
--- During encoding, the default value is not used.
--- During decoding, the default value will be parsed if the underlying codec decodes 'Nothing'.
-withDefault ::
-  forall value.
-  Show value =>
-  -- | default value
-  value ->
-  -- |
-  ObjectCodec (Maybe value) (Maybe value) ->
-  -- |
-  ObjectCodec value value
-withDefault defaultValue = DefaultCodec defaultValue (T.pack (show defaultValue))
+-- During decoding, the field may be in the object. The default value will be parsed otherwise.
+--
+-- During encoding, the field will be in the object. The default value is ignored.
+--
+-- The shown version of the default value will appear in the documentation.
+optionalFieldWithDefaultWith ::
+  Show output =>
+  -- | The key
+  Text ->
+  -- | The codec for the value
+  ValueCodec output output ->
+  -- | Default value
+  output ->
+  -- | Documentation
+  Text ->
+  ObjectCodec output output
+optionalFieldWithDefaultWith key c defaultValue doc = OptionalKeyWithDefaultCodec key c (T.pack (show defaultValue)) defaultValue (Just doc)
 
--- | Infix version of 'withDefault'
---
--- Example usage:
---
--- > data Example = Example
--- >   { exampleText :: !Text,
--- >     exampleOptionalWithDefault :: !Text
--- >   }
--- >
--- > instance HasCodec Example where
--- >   codec =
--- >     object "Example" $
--- >       Example
--- >         <$> requiredField "text" .= exampleText
--- >         <*> optionalField "optional-with-default" .!= "default-value" .= exampleOptionalWithDefault
-(.!=) ::
-  forall value.
-  Show value =>
-  -- |
-  ObjectCodec (Maybe value) (Maybe value) ->
-  -- | default value
-  value ->
-  -- |
-  ObjectCodec value value
-(.!=) = flip withDefault
+-- | Like 'optionalFieldWithDefaultWith', but without documentation.
+optionalFieldWithDefaultWith' ::
+  Show output =>
+  -- | The key
+  Text ->
+  -- | The codec for the value
+  ValueCodec output output ->
+  -- | Default value
+  output ->
+  ObjectCodec output output
+optionalFieldWithDefaultWith' key c defaultValue = OptionalKeyWithDefaultCodec key c (T.pack (show defaultValue)) defaultValue Nothing
 
 -- | Infix version of 'CommentCodec'
 (<?>) ::