Render formatted code in quote blocks

Author: Julow

src/markdown/generator.ml

@@ -316,7 +316,7 @@ and item (l : Item.t list) args nesting_level =
               let code, _, content = source_take_until_punctuation code in
               let content =
                 if source_contains_text content then
-                  paragraph (source_code content args)
+                  quote_block (paragraph (source_code content args))
                 else noop
               in
               render_declaration ~anchor ~doc code content

src/markdown/markup.ml

@@ -20,6 +20,7 @@ and blocks =
   | List of list_type * blocks list
   | Raw_markup of string
   | Block_separator
+  | Prefixed_block of string * blocks  (** Prefix every lines of blocks. *)
 
 and list_type = Ordered | Unordered
 
@@ -64,11 +65,20 @@ let paragraph i = Block i
 
 let code_block s = CodeBlock s
 
+let quote_block b = Prefixed_block ("> ", b)
+
 let heading level i =
   let make_hashes n = String.make n '#' in
   let hashes = make_hashes level in
   Block (String hashes ++ i)
 
+(** Every lines that [f] formats are prefixed and written in [sink].
+    Inefficient. *)
+let with_prefixed_formatter prefix sink f =
+  let s = Format.asprintf "%t" f in
+  String.split_on_char '\n' s
+  |> List.iter (fun l -> Format.fprintf sink "%s%s@\n" prefix l)
+
 let pp_list_item fmt list_type (b : blocks) n pp_blocks =
   match list_type with
   | Unordered -> Format.fprintf fmt "- @[%a@]" pp_blocks b
@@ -109,3 +119,5 @@ let rec pp_blocks fmt b =
       in
       pp_list 0 l
   | Raw_markup s -> Format.fprintf fmt "%s" s
+  | Prefixed_block (p, b) ->
+      with_prefixed_formatter p fmt (fun fmt -> pp_blocks fmt b)

src/markdown/markup.mli

@@ -55,6 +55,8 @@ val paragraph : inlines -> blocks
 
 val code_block : string -> blocks
 
+val quote_block : blocks -> blocks
+
 val heading : int -> inlines -> blocks
 
 val pp_blocks : Format.formatter -> blocks -> unit

test/integration/markdown.t/run.t

@@ -34,15 +34,17 @@
 
   ###### val x :
 
-  [t](#type-t)
+  > [t](#type-t)
+  
 
   Doc for `val x`
 
   <a id="type-a"></a>
 
   ###### type a =
 
-  [t](#type-t)
+  > [t](#type-t)
+  
 
   Type alias
 
@@ -88,7 +90,8 @@
 
   ###### val y :
 
-  [ `One | `Two ]
+  > [ `One | `Two ]
+  
 
   Polymorphic variant.
 
@@ -98,7 +101,8 @@
 
   ###### val z :
 
-  [t](#type-t) -> ( [t](#type-t) -> [t](#type-t) ) -> foo : [t](#type-t) -> ? bar : [t](#type-t) -> [ `One of [t](#type-t) ] -> [t](#type-t) * [t](#type-t)
+  > [t](#type-t) -> ( [t](#type-t) -> [t](#type-t) ) -> foo : [t](#type-t) -> ? bar : [t](#type-t) -> [ `One of [t](#type-t) ] -> [t](#type-t) * [t](#type-t)
+  
 
   Type complicated enough to be rendered differently.