Simplify ast

src/ast.ml

@@ -1,172 +1,119 @@
-type attribute =
-  string * string
+type attributes =
+  (string * string) list
 
 type 'a link_def =
   {
     label: 'a;
     destination: string;
     title: string option;
-    attributes: attribute list;
   }
 
-type block_list_kind =
+type list_type =
   | Ordered of int * char
-  | Unordered of char
+  | Bullet of char
+
+type list_spacing =
+  | Loose
+  | Tight
 
 let same_block_list_kind k1 k2 =
   match k1, k2 with
   | Ordered (_, c1), Ordered (_, c2)
-  | Unordered c1, Unordered c2 -> c1 = c2
+  | Bullet c1, Bullet c2 -> c1 = c2
   | _ -> false
 
-type block_list_style =
-  | Loose
-  | Tight
-
-type code_block_kind =
-  | Tilde
-  | Backtick
-
 module type T = sig
   type t
 end
 
-module MakeBlock (Inline : T) = struct
-  type block_list =
-    {
-      kind: block_list_kind;
-      style: block_list_style;
-      blocks: t list list;
-    }
-
-  and code_block =
+module MakeBlock (I : T) = struct
+  type def_elt =
     {
-      kind: code_block_kind option;
-      label: string option;
-      other: string option;
-      code: string option;
-      attributes: attribute list;
+      term: I.t;
+      defs: I.t list;
     }
 
-  and heading =
+  and block =
     {
-      level: int;
-      text: Inline.t;
-      attributes: attribute list;
+      bl_desc: block_desc;
+      bl_attributes: attributes;
     }
 
-  and def_elt =
-    {
-      term: Inline.t;
-      defs: Inline.t list;
-    }
-
-  and def_list =
-    {
-      content: def_elt list
-    }
-
-  and t =
-    | Paragraph of Inline.t
-    | List of block_list
-    | Blockquote of t list
+  and block_desc =
+    | Paragraph of I.t
+    | List of list_type * list_spacing * block list list
+    | Blockquote of block list
     | Thematic_break
-    | Heading of heading
-    | Code_block of code_block
+    | Heading of int * I.t
+    | Code_block of string * string
     | Html_block of string
     | Link_def of string link_def
-    | Def_list of def_list
+    | Definition_list of def_elt list
 
   let defs ast =
-    let rec loop acc = function
-      | List l -> List.fold_left (List.fold_left loop) acc l.blocks
+    let rec loop acc {bl_desc; bl_attributes} =
+      match bl_desc with
+      | List (_, _, bls) -> List.fold_left (List.fold_left loop) acc bls
       | Blockquote l -> List.fold_left loop acc l
       | Paragraph _ | Thematic_break | Heading _
-      | Def_list _ | Code_block _ | Html_block _ -> acc
-      | Link_def def -> def :: acc
+      | Definition_list _ | Code_block _ | Html_block _ -> acc
+      | Link_def def -> (def, bl_attributes) :: acc
     in
     List.rev (List.fold_left loop [] ast)
 end
 
-type link_kind =
-  | Img
-  | Url
-
-type emph_kind =
-  | Normal
-  | Strong
-
-type emph_style =
-  | Star
-  | Underscore
-
-module Inline = struct
-  type emph =
-    {
-      style: emph_style;
-      kind: emph_kind;
-      content: t;
-    }
-
-  and code =
-    {
-      level: int;
-      content: string;
-      attributes: attribute list;
-    }
-
-  and link =
-    {
-      kind: link_kind;
-      def: t link_def;
-    }
-
-  and ref =
-    {
-      kind: link_kind;
-      label: t;
-      def: string link_def;
-    }
+type inline =
+  {
+    il_desc: inline_desc;
+    il_attributes: attributes;
+  }
 
-  and t =
-    | Concat of t list
-    | Text of string
-    | Emph of emph
-    | Code of code
-    | Hard_break
-    | Soft_break
-    | Link of link
-    | Ref of ref
-    | Html of string
-end
+and inline_desc =
+  | Concat of inline list
+  | Text of string
+  | Emph of inline
+  | Strong of inline
+  | Code of string
+  | Hard_break
+  | Soft_break
+  | Link of inline link_def
+  | Image of inline link_def
+  | Html of string
 
 module Raw = MakeBlock (String)
 
-module Block = MakeBlock (Inline)
+module Inline = struct type t = inline end
+
+include MakeBlock (Inline)
 
 module MakeMapper (Src : T) (Dst : T) = struct
   module SrcBlock = MakeBlock(Src)
   module DstBlock = MakeBlock(Dst)
 
-  let rec map (f : Src.t -> Dst.t) : SrcBlock.t -> DstBlock.t = function
-    | SrcBlock.Paragraph x -> DstBlock.Paragraph (f x)
-    | List {kind; style; blocks} ->
-        List  {kind; style; blocks = List.map (List.map (map f)) blocks}
-    | Blockquote xs ->
-        Blockquote (List.map (map f) xs)
-    | Thematic_break ->
-        Thematic_break
-    | Heading {level; text; attributes} ->
-        Heading {level; text = f text; attributes}
-    | Def_list {content} ->
-        let f {SrcBlock.term; defs} = {DstBlock.term = f term; defs = List.map f defs} in
-        Def_list {content = List.map f content}
-    | Code_block {kind; label; other; code; attributes} ->
-        Code_block {kind; label; other; code; attributes}
-    | Html_block x ->
-        Html_block x
-    | Link_def x ->
-        Link_def x
+  let rec map (f : Src.t -> Dst.t) : SrcBlock.block -> DstBlock.block =
+    fun {bl_desc; bl_attributes} ->
+    let bl_desc =
+      match bl_desc with
+      | SrcBlock.Paragraph x -> DstBlock.Paragraph (f x)
+      | List (ty, sp, bl) ->
+          List (ty, sp, List.map (List.map (map f)) bl)
+      | Blockquote xs ->
+          Blockquote (List.map (map f) xs)
+      | Thematic_break ->
+          Thematic_break
+      | Heading (level, text) ->
+          Heading (level, f text)
+      | Definition_list l ->
+          let f {SrcBlock.term; defs} = {DstBlock.term = f term; defs = List.map f defs} in
+          Definition_list (List.map f l)
+      | Code_block (label, code) ->
+          Code_block (label, code)
+      | Html_block x ->
+          Html_block x
+      | Link_def x ->
+          Link_def x
+    in
+    {bl_desc; bl_attributes}
 end
 
 module Mapper = MakeMapper (String) (Inline)

src/block.ml

@@ -2,20 +2,23 @@ open Ast
 
 module Sub = Parser.Sub
 
+let mk ?(attr = []) desc =
+  {Ast.Raw.bl_desc = desc; bl_attributes = attr}
+
 module Pre = struct
   type container =
     | Rblockquote of t
-    | Rlist of block_list_kind * block_list_style * bool * int * Raw.t list list * t
+    | Rlist of list_type * list_spacing * bool * int * Raw.block list list * t
     | Rparagraph of string list
-    | Rfenced_code of int * int * code_block_kind * (string * string) * string list * attribute list
+    | Rfenced_code of int * int * Parser.code_block_kind * (string * string) * string list * attributes
     | Rindented_code of string list
     | Rhtml of Parser.html_kind * string list
     | Rdef_list of string * string list
     | Rempty
 
   and t =
     {
-      blocks: Raw.t list;
+      blocks: Raw.block list;
       next: container;
     }
 
@@ -39,31 +42,34 @@ module Pre = struct
   let rec close {blocks; next} =
     match next with
     | Rblockquote state ->
-        Raw.Blockquote (finish state) :: blocks
-    | Rlist (kind, style, _, _, closed_items, state) ->
-        List {kind; style; blocks = List.rev (finish state :: closed_items)} :: blocks
+        mk (Raw.Blockquote (finish state)) :: blocks
+    | Rlist (ty, sp, _, _, closed_items, state) ->
+        mk (List (ty, sp, List.rev (finish state :: closed_items))) :: blocks
     | Rparagraph l ->
         let s = concat (List.map trim_left l) in
         let defs, off = Parser.link_reference_definitions (Parser.P.of_string s) in
         let s = String.sub s off (String.length s - off) |> String.trim in
-        let blocks = List.fold_right (fun def blocks -> Raw.Link_def def :: blocks) defs blocks in
-        if s = "" then blocks else Paragraph s :: blocks
-    | Rfenced_code (_, _, kind, (label, other), [], a) ->
-        Code_block {kind = Some kind; label = Some label; other = Some other; code = None; attributes = a} :: blocks
-    | Rfenced_code (_, _, kind, (label, other), l, a) ->
-        Code_block {kind = Some kind; label = Some label; other = Some other; code = Some (concat l); attributes = a} :: blocks
+        let blocks =
+          let f (def, attr) blocks = mk ~attr (Raw.Link_def def) :: blocks in
+          List.fold_right f defs blocks
+        in
+        if s = "" then blocks else mk (Paragraph s) :: blocks
+    | Rfenced_code (_, _, _kind, (label, _other), [], attr) ->
+        mk ~attr (Code_block (label, "")) :: blocks
+    | Rfenced_code (_, _, _kind, (label, _other), l, attr) ->
+        mk ~attr (Code_block (label, concat l)) :: blocks
     | Rdef_list (term, defs) ->
         let l, blocks =
           match blocks with
-          | Def_list l :: b -> l.content, b
+          | {Raw.bl_desc = Definition_list l; _} :: b -> l, b
           | b -> [], b
         in
-        Def_list {content = l @ [{ Raw.term; defs = List.rev defs}]} :: blocks
+        mk (Raw.Definition_list (l @ [{ Raw.term; defs = List.rev defs}])) :: blocks
     | Rindented_code l -> (* TODO: trim from the right *)
         let rec loop = function "" :: l -> loop l | _ as l -> l in
-        Code_block {kind = None; label = None; other = None; code = Some (concat (loop l)); attributes = []} :: blocks
+        mk (Code_block ("", concat (loop l))) :: blocks
     | Rhtml (_, l) ->
-        Html_block (concat l) :: blocks
+        mk (Html_block (concat l)) :: blocks
     | Rempty ->
         blocks
 
@@ -83,11 +89,11 @@ module Pre = struct
     | Rempty, Lblockquote s ->
         {blocks; next = Rblockquote (process empty s)}
     | Rempty, Lthematic_break ->
-        {blocks = Thematic_break :: blocks; next = Rempty}
+        {blocks = mk Thematic_break :: blocks; next = Rempty}
     | Rempty, Lsetext_heading (2, n) when n >= 3 ->
-        {blocks = Thematic_break :: blocks; next = Rempty}
-    | Rempty, Latx_heading (level, text, attributes) ->
-        {blocks = Heading {level; text; attributes} :: blocks; next = Rempty}
+        {blocks = mk Thematic_break :: blocks; next = Rempty}
+    | Rempty, Latx_heading (level, text, attr) ->
+        {blocks = mk ~attr (Heading (level, text)) :: blocks; next = Rempty}
     | Rempty, Lfenced_code (ind, num, q, info, a) ->
         {blocks; next = Rfenced_code (ind, num, q, info, [], a)}
     | Rempty, Lhtml (_, kind) ->
@@ -102,13 +108,15 @@ module Pre = struct
         {blocks; next = Rdef_list (h, [def])}
     | Rdef_list (term, defs), Ldef_list def ->
         {blocks; next = Rdef_list (term, def::defs)}
-    | Rparagraph _, Llist_item ((Ordered (1, _) | Unordered _), _, s1) when not (Parser.is_empty (Parser.P.of_string (Sub.to_string s1))) ->
+    | 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
     | Rparagraph _, (Lempty | Lblockquote _ | Lthematic_break
                     | Latx_heading _ | Lfenced_code _ | Lhtml (true, _)) ->
         process {blocks = close {blocks; next}; next = Rempty} s
     | Rparagraph (_ :: _ as lines), Lsetext_heading (level, _) ->
-        {blocks = Heading {level; text= String.trim (String.concat "\n" (List.rev lines)); attributes = []}:: blocks; next = Rempty}
+        let text = String.trim (String.concat "\n" (List.rev lines)) in
+        {blocks = mk (Heading (level, text)) :: blocks; next = Rempty}
     | Rparagraph lines, _ ->
         {blocks; next = Rparagraph (Sub.to_string s :: lines)}
     | Rfenced_code (_, num, q, _, _, _), Lfenced_code (_, num', q1, ("", _), _) when num' >= num && q = q1 ->

src/block.mli

@@ -3,8 +3,8 @@ module Pre : sig
 
   val empty: t
   val process: t -> string -> t
-  val finish: t -> Ast.Raw.t list
+  val finish: t -> Ast.Raw.block list
 
-  val of_channel: in_channel -> Ast.Raw.t list
-  val of_string: string -> Ast.Raw.t list
+  val of_channel: in_channel -> Ast.Raw.block list
+  val of_string: string -> Ast.Raw.block list
 end