basic pretty schema rendering without colour so far

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

@@ -16,6 +16,8 @@ import qualified Data.List.NonEmpty as NE
 import Data.Text (Text)
 import GHC.Generics (Generic)
 
+-- TODO think about putting this value in a separate package or directly in autodocodec
+--
 -- http://json-schema.org/understanding-json-schema/reference/index.html
 data JSONSchema
   = AnySchema

autodocodec-yaml/autodocodec-yaml.cabal

@@ -30,6 +30,7 @@ library
       src
   build-depends:
       autodocodec
+    , autodocodec-aeson
     , base >=4.7 && <5
     , safe-coloured-text
     , yaml

autodocodec-yaml/package.yaml

@@ -15,6 +15,7 @@ library:
   source-dirs: src
   dependencies:
   - autodocodec
+  - autodocodec-aeson
   - safe-coloured-text
   - yaml
 

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

@@ -1,14 +1,46 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Autodocodec.Yaml.Document where
 
 import Autodocodec
+import Autodocodec.Aeson
 import Text.Colour
 
 schemaChunksViaCodec :: forall a. HasCodec a => [Chunk]
 schemaChunksViaCodec = schemaChunksVia (codec @a)
 
 schemaChunksVia :: Codec input output -> [Chunk]
-schemaChunksVia _ = []
+schemaChunksVia = jsonSchemaChunks . jsonSchemaVia
+
+jsonSchemaChunks :: JSONSchema -> [Chunk]
+jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
+  where
+    indent :: [[Chunk]] -> [[Chunk]]
+    indent = map ("  " :)
+
+    addInFrontOfFirstInList :: [Chunk] -> [[Chunk]] -> [[Chunk]]
+    addInFrontOfFirstInList cs = \case
+      [] -> [cs] -- Shouldn't happen, but fine if it doesn't
+      (l : ls) -> (cs ++ l) : indent ls
+
+    go :: JSONSchema -> [[Chunk]]
+    go = \case
+      AnySchema -> [["<any>"]]
+      NullSchema -> [["null"]]
+      BoolSchema -> [["<boolean>"]]
+      StringSchema -> [["<string>"]]
+      NumberSchema -> [["<number>"]]
+      ArraySchema s ->
+        let addListMarker = addInFrontOfFirstInList ["- "]
+         in indent $ addListMarker $ go s -- TODO add the dash
+      ObjectSchema s -> goObject s
+      ChoiceSchema s -> concatMap go s -- TODO add the list
+    goObject :: JSONObjectSchema -> [[Chunk]]
+    goObject = \case
+      AnyObjectSchema -> [["<object>"]]
+      KeySchema k ss -> addInFrontOfFirstInList [chunk k, ":", " "] (go ss)
+      BothObjectSchema os1 os2 -> goObject os1 ++ goObject os2

autodocodec-yaml/test/Autodocodec/Yaml/DocumentSpec.hs

@@ -68,4 +68,4 @@ instance HasCodec Example where
 yamlSchemaSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 yamlSchemaSpec filePath = do
   it ("outputs the same schema as before for " <> nameOf @a) $
-    pureGoldenByteStringFile ("test_resources/schema/" <> filePath <> ".json") (renderChunksBS With24BitColours $ schemaChunksViaCodec @a)
+    pureGoldenByteStringFile ("test_resources/schema/" <> filePath <> ".txt") (renderChunksBS With24BitColours $ schemaChunksViaCodec @a)

autodocodec-yaml/test_resources/schema/bool.txt

@@ -0,0 +1 @@
+<boolean>

autodocodec-yaml/test_resources/schema/char.txt

@@ -0,0 +1 @@
+<string>

autodocodec-yaml/test_resources/schema/either-bool-text.txt

@@ -0,0 +1,2 @@
+Left: <boolean>
+Right: <string>

autodocodec-yaml/test_resources/schema/either-either-bool-scientific-text.txt

@@ -0,0 +1,3 @@
+Left: Left: <boolean>
+  Right: <number>
+Right: <string>

autodocodec-yaml/test_resources/schema/example.txt

@@ -0,0 +1,2 @@
+text: <string>
+bool: <boolean>

autodocodec-yaml/test_resources/schema/int.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/int16.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/int32.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/int64.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/int8.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/lazy-text.txt

@@ -0,0 +1 @@
+<string>

autodocodec-yaml/test_resources/schema/list-text.txt

@@ -0,0 +1 @@
+  - <string>

autodocodec-yaml/test_resources/schema/maybe-text.txt

@@ -0,0 +1,2 @@
+null
+<string>

autodocodec-yaml/test_resources/schema/scientific.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/string.txt

@@ -0,0 +1 @@
+<string>

autodocodec-yaml/test_resources/schema/text.txt

@@ -0,0 +1 @@
+<string>

autodocodec-yaml/test_resources/schema/word.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/word16.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/word32.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/word64.txt

@@ -0,0 +1 @@
+<number>

autodocodec-yaml/test_resources/schema/word8.txt

@@ -0,0 +1 @@
+<number>