Make definitions block-level

src/ast.ml

@@ -22,22 +22,22 @@ end
 module MakeBlock (I : T) = struct
   type 'attr def_elt =
     { term : 'attr I.t
-    ; defs : 'attr I.t list
+    ; defs : 'attr block list list
     }
 
   (* A value of type 'attr is present in all variants of this type. We use it to associate
      extra information to each node in the AST. In the common case, the attributes type defined
      above is used. We might eventually have an alternative function to parse blocks while keeping
      concrete information such as source location and we'll use it for that as well. *)
-  type 'attr block =
+  and 'attr block =
     | Paragraph of 'attr * 'attr I.t
     | List of 'attr * list_type * list_spacing * 'attr block list list
     | Blockquote of 'attr * 'attr block list
     | Thematic_break of 'attr
     | Heading of 'attr * int * 'attr I.t
     | Code_block of 'attr * string * string
     | Html_block of 'attr * string
-    | Definition_list of 'attr * 'attr def_elt list
+    | Definition_list of 'attr * list_spacing * 'attr def_elt list
 end
 
 type 'attr link =
@@ -83,11 +83,11 @@ module MakeMapper (Src : T) (Dst : T) = struct
     | Blockquote (attr, xs) -> Blockquote (attr, List.map (map f) xs)
     | Thematic_break attr -> Thematic_break attr
     | Heading (attr, level, text) -> Heading (attr, level, f text)
-    | Definition_list (attr, l) ->
+    | Definition_list (attr, sp, l) ->
         let f { SrcBlock.term; defs } =
-          { DstBlock.term = f term; defs = List.map f defs }
+          { DstBlock.term = f term; defs = List.map (List.map (map f)) defs }
         in
-        Definition_list (attr, List.map f l)
+        Definition_list (attr, sp, List.map f l)
     | Code_block (attr, label, code) -> Code_block (attr, label, code)
     | Html_block (attr, x) -> Html_block (attr, x)
 end

src/block.ml

@@ -21,7 +21,12 @@ module Pre = struct
         * attributes
     | Rindented_code of string list
     | Rhtml of Parser.html_kind * string list
-    | Rdef_list of string * string list
+    | Rdef_list of
+        string
+        * int
+        * bool  (* true if we've seen a blank line - disables lazy mode) *)
+        * attributes Raw.block list list
+        * t
     | Rempty
 
   and t =
@@ -69,13 +74,25 @@ module Pre = struct
         Code_block (attr, label, "") :: blocks
     | Rfenced_code (_, _, _kind, (label, _other), l, attr) ->
         Code_block (attr, label, concat l) :: blocks
-    | Rdef_list (term, defs) ->
-        let l, blocks =
+    | Rdef_list (term, _, _, defs, state) ->
+        let def = finish state in
+        let defs = def :: defs in
+        let this_sp =
+          match def with
+          | [Paragraph _] -> Tight
+          | _ -> Loose
+        in
+        let l, sp, blocks =
           match blocks with
-          | Definition_list (_, l) :: b -> (l, b)
-          | b -> ([], b)
+          | Definition_list (_, sp, l) :: b ->
+              let sp = match sp, this_sp with
+                | Tight, Tight -> Tight
+                | Loose, _ | _, Loose -> Loose
+              in
+              (l, sp, b)
+          | b -> ([], this_sp, b)
         in
-        Definition_list ([], l @ [ { term; defs = List.rev defs } ]) :: blocks
+        Definition_list ([], sp, l @ [ { term; defs = List.rev defs } ]) :: blocks
     | Rindented_code l ->
         (* TODO: trim from the right *)
         let rec loop = function
@@ -116,10 +133,10 @@ module Pre = struct
         }
     | Rempty, (Lsetext_heading _ | Lparagraph | Ldef_list _) ->
         { blocks; next = Rparagraph [ Sub.to_string s ] }
-    | Rparagraph [ h ], Ldef_list def ->
-        { blocks; next = Rdef_list (h, [ def ]) }
-    | Rdef_list (term, defs), Ldef_list def ->
-        { blocks; next = Rdef_list (term, def :: defs) }
+    | Rparagraph [ h ], Ldef_list (indent, def) ->
+        { blocks; next = Rdef_list (h, indent, false, [], process empty (Sub.of_string def)) }
+    | Rdef_list (term, _, false, defs, state), Ldef_list (indent, def) ->
+        { blocks; next = Rdef_list (term, indent, false, finish state :: defs, process empty (Sub.of_string def)) }
     | Rparagraph _, Llist_item ((Ordered (1, _) | Bullet _), _, s1)
       when not (Parser.is_empty (Parser.P.of_string (Sub.to_string s1))) ->
         process { blocks = close { blocks; next }; next = Rempty } s
@@ -147,9 +164,21 @@ module Pre = struct
         { blocks
         ; next = Rfenced_code (ind, num, q, info, Sub.to_string s :: lines, a)
         }
-    | Rdef_list (term, d :: defs), Lparagraph ->
+    | Rdef_list (term, ind, _, defs, state), Lempty ->
+        { blocks
+        ; next = Rdef_list (term, ind, true, defs, process state s)
+        }
+    | Rdef_list (term, ind, seen_empty, defs, state), _
+      when Parser.indent s >= ind ->
+        let s = Sub.offset ind s in
+        let state = process state s in
+        { blocks
+        ; next = Rdef_list (term, ind, seen_empty, defs, state)
+        }
+    | Rdef_list (term, ind, false, defs, state), Lparagraph ->     (* Lazy wrapping *)
+        let state = process state s in
         { blocks
-        ; next = Rdef_list (term, (d ^ "\n" ^ Sub.to_string s) :: defs)
+        ; next = Rdef_list (term, ind, false, defs, state)
         }
     | Rdef_list _, _ ->
         process { blocks = close { blocks; next }; next = Rempty } s

src/html.ml

@@ -196,11 +196,16 @@ let rec block = function
         | _ -> "p"
       in
       elt Block name attr (Some (inline text))
-  | Definition_list (attr, l) ->
+  | Definition_list (attr, sp, l) ->
+      let block' t =
+        match (t, sp) with
+        | Paragraph (_, t), Tight -> concat (inline t) nl
+        | _ -> block t
+      in
       let f { term; defs } =
         concat
           (elt Block "dt" [] (Some (inline term)))
-          (concat_map (fun s -> elt Block "dd" [] (Some (inline s))) defs)
+          (concat_map (fun s -> elt Block "dd" [] (Some (concat nl (concat_map block' s)))) defs)
       in
       elt Block "dl" attr (Some (concat_map f l))
 

src/omd.mli

@@ -30,18 +30,18 @@ and 'attr inline =
 
 type 'attr def_elt =
   { term : 'attr inline
-  ; defs : 'attr inline list
+  ; defs : 'attr block list list
   }
 
-type 'attr block =
+and 'attr block =
   | Paragraph of 'attr * 'attr inline
   | List of 'attr * list_type * list_spacing * 'attr block list list
   | Blockquote of 'attr * 'attr block list
   | Thematic_break of 'attr
   | Heading of 'attr * int * 'attr inline
   | Code_block of 'attr * string * string
   | Html_block of 'attr * string
-  | Definition_list of 'attr * 'attr def_elt list
+  | Definition_list of 'attr * list_spacing * 'attr def_elt list
 
 type doc = attributes block list
 (** A markdown document *)

src/parser.ml

@@ -311,7 +311,7 @@ type t =
   | Lhtml of bool * html_kind
   | Llist_item of list_type * int * Sub.t
   | Lparagraph
-  | Ldef_list of string
+  | Ldef_list of int * string
 
 let sp3 s =
   match Sub.head s with
@@ -959,11 +959,11 @@ let tag_string s =
   in
   loop (ws s)
 
-let def_list s =
+let def_list ind s =
   let s = Sub.tail s in
   match Sub.head s with
   | Some (' ' | '\t' | '\010' .. '\013') ->
-      Ldef_list (String.trim (Sub.to_string s))
+      Ldef_list (ind + 2, String.trim (Sub.to_string s))
   | _ -> raise Fail
 
 let indented_code ind s =
@@ -992,7 +992,7 @@ let parse s0 =
   | Some '*' -> (thematic_break ||| unordered_list_item ind) s
   | Some '+' -> unordered_list_item ind s
   | Some '0' .. '9' -> ordered_list_item ind s
-  | Some ':' -> def_list s
+  | Some ':' -> def_list ind s
   | Some _ -> (blank ||| indented_code ind) s
   | None -> Lempty
 

src/sexp.ml

@@ -39,13 +39,13 @@ let rec block = function
       List [ Atom "heading"; Atom (string_of_int level); inline text ]
   | Code_block (_, info, _) -> List [ Atom "code-block"; Atom info ]
   | Html_block (_, s) -> List [ Atom "html"; Atom s ]
-  | Definition_list (_, l) ->
+  | Definition_list (_, _, l) ->
       List
         [ Atom "def-list"
         ; List
             (List.map
                (fun elt ->
-                 List [ inline elt.term; List (List.map inline elt.defs) ])
+                  List [ inline elt.term; List (List.map (fun def -> List (List.map block def)) elt.defs) ])
                l)
         ]
 

tests/def_list.md

@@ -10,13 +10,80 @@ Second Term
 which is multiline
 
 : This is not a correct definition list
+
+# With multiple paragraphs
+
+First Term
+: This is the definition of the first term.
+
+Second Term
+: This is one paragraph of the second term.
+
+  This is another paragraph of the second term.
+
+# Nesting
+
+Root
+: Level one
+
+  Nested
+  : Level two
+    ```
+    code
+    ```
+
+    More
+    : Level three
+
+Root again
+: Level one again
+
 .
 <dl><dt>First Term</dt>
-<dd>This is the definition of the first term.</dd>
+<dd>
+This is the definition of the first term.
+</dd>
 <dt>Second Term</dt>
-<dd>This is one definition of the second term.</dd>
-<dd>This is another definition of the second term.
-which is multiline</dd>
+<dd>
+This is one definition of the second term.
+</dd>
+<dd>
+This is another definition of the second term.
+which is multiline
+</dd>
 </dl>
 <p>: This is not a correct definition list</p>
+<h1>With multiple paragraphs</h1>
+<dl><dt>First Term</dt>
+<dd>
+<p>This is the definition of the first term.</p>
+</dd>
+<dt>Second Term</dt>
+<dd>
+<p>This is one paragraph of the second term.</p>
+<p>This is another paragraph of the second term.</p>
+</dd>
+</dl>
+<h1>Nesting</h1>
+<dl><dt>Root</dt>
+<dd>
+<p>Level one</p>
+<dl><dt>Nested</dt>
+<dd>
+<p>Level two</p>
+<pre><code>code
+</code></pre>
+<dl><dt>More</dt>
+<dd>
+Level three
+</dd>
+</dl>
+</dd>
+</dl>
+</dd>
+<dt>Root again</dt>
+<dd>
+<p>Level one again</p>
+</dd>
+</dl>
 ````````````````````````````````