Source file `cmarkit_renderer.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
(*---------------------------------------------------------------------------
   Copyright (c) 2021 The cmarkit programmers. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

(* Renderers *)

module Dict = Cmarkit_base.Dict

type t =
  { init_context : context -> Cmarkit.Doc.t -> unit;
    inline : inline;
    block : block;
    doc : doc; }

and context =
  { renderer : t;
    mutable state : Dict.t;
    b : Buffer.t;
    mutable doc : Cmarkit.Doc.t }

and inline = context -> Cmarkit.Inline.t -> bool
and block = context -> Cmarkit.Block.t -> bool
and doc = context -> Cmarkit.Doc.t -> bool

let nop _ _ = ()
let none _ _ = false

let make
    ?(init_context = nop) ?(inline = none) ?(block = none) ?(doc = none) ()
  =
  { init_context; inline; block; doc }

let compose g f =
  let init_context c d = g.init_context c d; f.init_context c d in
  let block c b = f.block c b || g.block c b in
  let inline c i = f.inline c i || g.inline c i in
  let doc c d = f.doc c d || g.doc c d in
  { init_context; inline; block; doc }

let init_context r = r.init_context
let inline r = r.inline
let block r = r.block
let doc r = r.doc

module Context = struct
  type t = context
  let make renderer b =
    { renderer; b; state = Dict.empty; doc = Cmarkit.Doc.empty }

  let buffer c = c.b
  let renderer c = c.renderer
  let get_doc (c : context) = c.doc
  let get_defs (c : context) = Cmarkit.Doc.defs c.doc

  module State = struct
    type 'a t = 'a Dict.key
    let make = Dict.key
    let find c st = Dict.find st c.state
    let get c st = Option.get (Dict.find st c.state)
    let set c st = function
    | None -> c.state <- Dict.remove st c.state
    | Some s -> c.state <- Dict.add st s c.state
  end

  let init c d = c.renderer.init_context c d

  let invalid_inline _ = invalid_arg "Unknown Cmarkit.Inline.t case"
  let invalid_block _ = invalid_arg "Unknown Cmarkit.Block.t case"
  let unhandled_doc _ = invalid_arg "Unhandled Cmarkit.Doc.t"

  let byte r c = Buffer.add_char r.b c
  let utf_8_uchar r u = Buffer.add_utf_8_uchar r.b u
  let string c s = Buffer.add_string c.b s
  let inline c i = ignore (c.renderer.inline c i || invalid_inline i)
  let block c b = ignore (c.renderer.block c b || invalid_block b)
  let doc (c : context) d =
    c.doc <- d; init c d;
    ignore (c.renderer.doc c d || unhandled_doc d);
    c.doc <- Cmarkit.Doc.empty
end

let doc_to_string r d =
  let b = Buffer.create 1024 in
  let c = Context.make r b in
  Context.doc c d; Buffer.contents b

let buffer_add_doc r b d = Context.doc (Context.make r b) d