Support multi-line default values in yaml schemas, fixes #8

.hlint.yaml

@@ -1,4 +1,5 @@
 - ignore: { name: "Eta reduce" }
+- ignore: { name: "Use newtype instead of data" }
 - ignore: { name: "Use unless" }
 - ignore: { name: "Use fmap" }
 - ignore: { name: "Use tuple-section" }

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

@@ -414,3 +414,29 @@ instance HasCodec War where
       g = \case
         WorldWar w -> Left w
         OtherWar t -> Right t
+
+data MultilineDefault = MultilineDefault
+  { multilineDefaultValue :: !Via -- See above
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving
+    ( FromJSON,
+      ToJSON,
+      Swagger.ToSchema,
+      OpenAPI.ToSchema
+    )
+    via (Autodocodec MultilineDefault)
+
+instance Validity MultilineDefault
+
+instance NFData MultilineDefault
+
+instance GenValid MultilineDefault where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+instance HasCodec MultilineDefault where
+  codec =
+    object "MultilineDefault" $
+      MultilineDefault
+        <$> optionalFieldWithDefault "value" (Via "foo" "bar") "a field with a multi-line default value" .= multilineDefaultValue

autodocodec-api-usage/test/Autodocodec/Yaml/SchemaSpec.hs

@@ -74,6 +74,7 @@ spec = do
   yamlSchemaSpec @LegacyObject "legacy-object"
   yamlSchemaSpec @Ainur "ainur"
   yamlSchemaSpec @War "war"
+  yamlSchemaSpec @MultilineDefault "multiline-default"
 
 yamlSchemaSpec :: forall a. (Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 yamlSchemaSpec filePath = do

autodocodec-api-usage/test_resources/yaml-schema/multiline-default.txt

@@ -0,0 +1,13 @@
+# MultilineDefault
+value: # optional
+  # default: 
+  #   two: bar
+  #   one: foo
+  # a field with a multi-line default value
+  # Via
+  one: # required
+    # first field
+    <string>
+  two: # required
+    # second field
+    <string>

autodocodec-yaml/autodocodec-yaml.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           autodocodec-yaml
-version:        0.1.0.0
+version:        0.1.0.1
 synopsis:       Autodocodec interpreters for yaml
 homepage:       https://github.com/NorfairKing/autodocodec#readme
 bug-reports:    https://github.com/NorfairKing/autodocodec/issues

autodocodec-yaml/package.yaml

@@ -1,5 +1,5 @@
 name: autodocodec-yaml
-version: 0.1.0.0
+version: 0.1.0.1
 github: "NorfairKing/autodocodec"
 license: MIT
 author: "Tom Sydney Kerckhove"

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

@@ -57,8 +57,8 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
       [] -> [cs] -- Shouldn't happen, but fine if it doesn't
       (l : ls) -> (cs ++ l) : indent ls
 
-    jsonValueChunk :: Yaml.Value -> Chunk
-    jsonValueChunk v = chunk $ T.strip $ TE.decodeUtf8With TE.lenientDecode (Yaml.encode v)
+    jsonValueChunks :: Yaml.Value -> [[Chunk]]
+    jsonValueChunks v = map ((: []) . chunk) $ T.lines $ T.strip $ TE.decodeUtf8With TE.lenientDecode (Yaml.encode v)
 
     docToLines :: Text -> [[Chunk]]
     docToLines doc = map (\line -> [chunk "# ", chunk line]) (T.lines doc)
@@ -106,7 +106,7 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
       MapSchema s ->
         addInFrontOfFirstInList [fore white "<key>", ": "] $ [] : go s
       ObjectSchema os -> goObject os
-      ValueSchema v -> [[jsonValueChunk v]]
+      ValueSchema v -> jsonValueChunks v
       AnyOfSchema ne -> case ne of
         (NullSchema :| [s]) -> orNullChunks s
         (s :| [NullSchema]) -> orNullChunks s
@@ -133,7 +133,10 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
          in let keySchemaChunks = go ks
                 defaultValueLine = case mDefaultValue kr of
                   Nothing -> []
-                  Just defaultValue -> [[chunk "# default: ", fore magenta $ jsonValueChunk defaultValue]]
+                  Just defaultValue ->
+                    case jsonValueChunks defaultValue of
+                      [c] -> [chunk "# default: " : map (fore magenta) c]
+                      cs -> [chunk "# default: "] : map ((chunk "#   " :) . map (fore magenta)) cs
                 prefixLines = ["# ", requirementComment kr] : defaultValueLine ++ maybe [] docToLines mdoc
              in addInFrontOfFirstInList [fore white $ chunk k, ": "] (prefixLines ++ keySchemaChunks)
       ObjectAllOfSchema ne -> concatMap goObject $ NE.toList ne