Google Slides API client for OCaml
ocaml-gslides: add read-only Google Slides client with Marp/Typst output
Mirrors the [ocaml-gdocs] / [ocaml-gsheets] shape: lib/bin/test layout,
[Gauth]-backed auth, XDG-stored client/token (atomic write via tmp +
rename), [Cmdliner] CLI. Implements a small slice of the Google Slides
v1 REST API: [presentations.get] -> a typed [Presentation.t] containing
slides, page elements, paragraphs, runs, and speaker notes.
Two renderers consume the same parsed structure:
- [Gslides.Marp.of_presentation ?comments p] emits Marp-flavored
markdown. YAML frontmatter for the deck title; [---] between slides;
level-1 headings as slide titles; native bullet/numbered lists;
inline style as [**bold**], [*italic*], [~~strike~~], plus HTML
escape hatches ([<u>], [<sup>], [<span style="color: ...">]) for
features without a CommonMark form. Speaker notes via Marp's
[<!-- _notes -->] pragma; hidden slides via [<!-- _hide: true -->].
Best for "review the deck in a PR diff".
- [Gslides.Typst.of_presentation ?comments p] emits Typst source using
[polylux] (version-pinned to 0.4.0; the value is exposed as
[Typst.polylux_version]). [#slide[...]] per slide, [#strong]/[#emph]/
[#strike]/[#underline]/[#link] for inline style, [#text(fill: rgb...)]
for color, [#table(...)] for tables, [#image("url", alt: ...)] for
images, [#speaker-note[...]] for notes. Best for "compile to a
typeset PDF".
Comments support:
- [Gslides.Comments] is a Drive-API fetch (drive.readonly scope).
Slides comments live on the underlying Drive file, not the Slides
surface itself.
- Both renderers take an optional [?comments] argument. When supplied,
each comment is anchored to its slide via the [pageObjectId]
embedded in the Drive [anchor] field, and rendered as a footnote
(Marp: GFM [[^slcN]] inline + definitions at the bottom; Typst:
[#footnote[...]] inside the slide block).
- Comments whose anchor doesn't reference a slide land in a trailing
[## Comments] section.
What's deliberately not exported: spatial information (positions,
transforms, rotations), shape-as-decoration (callout/flowchart shape
types, connector lines), animations (which the Slides API doesn't
expose anyway), and image bytes (the API gives short-lived
[contentUrl]s; stable references are a follow-up).
CLI:
- [gslides install] -- one-time OAuth client setup.
- [gslides login] -- OAuth flow with both Slides and
Drive comments scopes preauthorized.
- [gslides get <id>] -- print presentation JSON.
- [gslides md <id> [-c]] -- emit Marp markdown.
- [gslides typst <id> [-c]] -- emit polylux Typst.
85 alcotest cases covering the parser (paragraph/run extraction,
inline style decoding for bold/italic/strike/link/color/sup-sub/
monospace, bullet nesting, alignment), Marp rendering (frontmatter,
title -> h1, all inline-style emitters, bullets/nested/numbered, slide
separators, speaker notes, hidden slides, image refs, video/line/etc
placeholders, anchored and unanchored comments), Typst rendering (the
matching set against polylux primitives), Comments (parsing, anchor
extraction, drive scope), and Store (XDG roundtrips, 0600 perms,
atomic-write tightening).
Add the [llms.txt] entry between [gsheets] and [nox-git].
Note on duplication: [Comments] is structurally identical across
[ocaml-gdocs], [ocaml-gsheets] (pending), and [ocaml-gslides], and
each package has its own [Store] keyed off its own XDG dir
(~/.config/gdocs, /gsheets, /gslides). A follow-up will lift these
into a shared [Google_store] (likely in [gauth] or a small new
package) so all three Google tools share one client + one token
covering the union of scopes.
+3582
+158
README.md
+158
README.md
···
1
+
# gslides
2
+
3
+
Google Slides API client for OCaml.
4
+
5
+
`gslides` implements a small, opinionated read-only slice of the
6
+
[Google Slides v1 REST API][slides-api]: fetching a presentation's
7
+
structure (slides, text, bullets, speaker notes, images) and
8
+
rendering it to either [Marp][marp]-flavored markdown or
9
+
[polylux][polylux]-flavored Typst, both intended for
10
+
version-control. Authentication is delegated to [`gauth`][gauth];
11
+
reading requires the `.../auth/presentations.readonly` OAuth scope
12
+
(plus `drive.readonly` if you want comments).
13
+
14
+
[slides-api]: https://developers.google.com/slides/api/reference/rest
15
+
[marp]: https://marp.app/
16
+
[polylux]: https://github.com/polylux-typst/polylux
17
+
[gauth]: https://tangled.org/gazagnaire.org/ocaml-gauth
18
+
19
+
## Installation
20
+
21
+
Install with opam:
22
+
23
+
<!-- $MDX skip -->
24
+
```sh
25
+
$ opam install gslides
26
+
```
27
+
28
+
If opam cannot find the package, it may not yet be released in the
29
+
public `opam-repository`. Add the overlay repository, then install
30
+
it:
31
+
32
+
<!-- $MDX skip -->
33
+
```sh
34
+
$ opam repo add samoht https://tangled.org/gazagnaire.org/opam-overlay.git
35
+
$ opam update
36
+
$ opam install gslides
37
+
```
38
+
39
+
## Usage
40
+
41
+
The main entry points are `Gslides.get`, `Gslides.Marp.of_presentation`,
42
+
and `Gslides.Typst.of_presentation`:
43
+
44
+
```ocaml
45
+
let fetch_md http ~token ~presentation_id =
46
+
match Gslides.get http ~token presentation_id with
47
+
| Error (`Msg m) -> Error m
48
+
| Ok p -> Ok (Gslides.Marp.of_presentation p)
49
+
```
50
+
51
+
Wire it up with `gauth` and Eio for a full flow:
52
+
53
+
```ocaml
54
+
let run env ~key_path ~presentation_id =
55
+
Eio.Switch.run @@ fun sw ->
56
+
let http = Requests.v ~sw env in
57
+
let clock = Eio.Stdenv.clock env in
58
+
match Gauth.Service_account.of_file key_path with
59
+
| Error (`Msg m) -> failwith m
60
+
| Ok key ->
61
+
match
62
+
Gauth.Service_account.token http ~clock
63
+
~scopes:[ Gslides.scope_readonly ] key
64
+
with
65
+
| Error (`Msg m) -> failwith m
66
+
| Ok token ->
67
+
match Gslides.get http ~token presentation_id with
68
+
| Ok p -> Fmt.pr "%s" (Gslides.Marp.of_presentation p)
69
+
| Error (`Msg m) -> Fmt.pr "fetch failed: %s@." m
70
+
```
71
+
72
+
### Markdown vs Typst
73
+
74
+
Two renderers consume the same parsed `Presentation.t`:
75
+
76
+
- **Marp** (`Gslides.Marp.of_presentation`) emits markdown with a
77
+
YAML frontmatter, `---` between slides, level-1 headings as
78
+
slide titles, native bullet/numbered lists, and HTML escape
79
+
hatches (`<u>`, `<sup>`, `<span style="color: ...">`) for
80
+
features without a CommonMark form. Best for "review the deck
81
+
in a PR diff".
82
+
- **Typst** (`Gslides.Typst.of_presentation`) emits Typst source
83
+
using polylux: `#slide[...]`, `#text(weight: "bold")[...]`,
84
+
`#table(...)`, `#image("url")`, `#speaker-note[...]`. Best for
85
+
"compile to a typeset PDF".
86
+
87
+
```ocaml
88
+
let to_typst http ~token ~presentation_id =
89
+
match Gslides.get http ~token presentation_id with
90
+
| Error (`Msg m) -> Error m
91
+
| Ok p -> Ok (Gslides.Typst.of_presentation p)
92
+
```
93
+
94
+
The polylux import is version-pinned (currently `0.4.0`); the value
95
+
is exposed as `Gslides.Typst.polylux_version` so callers can
96
+
confirm the dependency they emit.
97
+
98
+
### Comments
99
+
100
+
Slides comments live on the underlying Drive file, so fetching them
101
+
needs the `drive.readonly` scope in addition to the Slides scope.
102
+
Both renderers accept an optional `~comments` argument and emit them
103
+
as footnotes, anchored to the slide they reference:
104
+
105
+
```ocaml
106
+
let to_md_with_comments http ~token ~presentation_id =
107
+
match Gslides.get http ~token presentation_id with
108
+
| Error (`Msg m) -> Error m
109
+
| Ok p ->
110
+
match Gslides.Comments.list http ~token presentation_id with
111
+
| Error (`Msg m) -> Error m
112
+
| Ok cs -> Ok (Gslides.Marp.of_presentation ~comments:cs p)
113
+
```
114
+
115
+
Comments whose anchor doesn't reference any slide land in a trailing
116
+
`## Comments` section.
117
+
118
+
### Scopes
119
+
120
+
```ocaml
121
+
let readonly = Gslides.scope_readonly
122
+
let readwrite = Gslides.scope_readwrite
123
+
let comments_scope = Gslides.Comments.scope
124
+
```
125
+
126
+
HTTP errors surface with the response status in the `Msg` payload:
127
+
`401` for invalid/expired tokens, `403` for missing scopes or no
128
+
access, `404` for unknown presentation IDs. Oversized error bodies
129
+
(e.g. a CDN's 502 HTML) are truncated before being included.
130
+
131
+
## CLI
132
+
133
+
The package installs a `gslides` binary mirroring the gdocs/gsheets
134
+
CLI shape:
135
+
136
+
<!-- $MDX skip -->
137
+
```sh
138
+
$ gslides install # one-time OAuth client setup
139
+
$ gslides login # authorize your Google account
140
+
$ gslides get <presentation-id>
141
+
$ gslides md <presentation-id> [--comments]
142
+
$ gslides typst <presentation-id> [--comments]
143
+
```
144
+
145
+
## What's not exported
146
+
147
+
Slides is a layout engine; markdown and Typst are text engines. The
148
+
renderer captures structure (slides, titles, bullets, speaker notes),
149
+
inline style (bold/italic/strike/link/color/sup/sub), and image
150
+
references. It drops spatial information (positions, sizes,
151
+
rotations), shape-as-decoration (callouts, flowchart shapes,
152
+
connector lines), and animations (which the Slides API doesn't
153
+
expose anyway). Image bytes are not exported -- the Slides API gives
154
+
short-lived `contentUrl`s; stable image references are a follow-up.
155
+
156
+
## Licence
157
+
158
+
MIT
+16
bin/dune
+16
bin/dune
+28
bin/get.ml
+28
bin/get.ml
···
1
+
let run presentation_id =
2
+
Eio_main.run @@ fun env ->
3
+
Eio.Switch.run @@ fun sw ->
4
+
let http = Requests.v ~sw env in
5
+
let clock = Eio.Stdenv.clock env in
6
+
let fs = Eio.Stdenv.fs env in
7
+
let token =
8
+
match Gslides.Store.acquire http ~clock ~fs with
9
+
| Ok t -> t
10
+
| Error (`Msg m) -> Ui.die "%s" m
11
+
in
12
+
let result = Gslides.get http ~token presentation_id in
13
+
Gslides.Store.persist fs token;
14
+
match result with
15
+
| Error (`Msg m) -> Ui.die "%s" m
16
+
| Ok p -> print_endline (Gslides.Presentation.to_json p)
17
+
18
+
open Cmdliner
19
+
20
+
let presentation_id =
21
+
let doc = "Google Slides presentation ID (the long string in the URL)." in
22
+
Arg.(
23
+
required & pos 0 (some string) None & info [] ~docv:"PRESENTATION_ID" ~doc)
24
+
25
+
let cmd =
26
+
let doc = "Fetch a presentation and print its raw JSON." in
27
+
let info = Cmd.info "get" ~doc in
28
+
Cmd.v info Term.(const run $ presentation_id)
+1
bin/get.mli
+1
bin/get.mli
···
1
+
val cmd : unit Cmdliner.Cmd.t
+68
bin/install.ml
+68
bin/install.ml
···
1
+
let instructions =
2
+
{|
3
+
One-time setup to register gslides with your Google account.
4
+
5
+
Step 1. Open the Google Cloud Console in your browser. If you don't
6
+
already have a Cloud project, create one (free).
7
+
8
+
Step 2. On "APIs & Services -> Credentials", click "Create
9
+
Credentials -> OAuth client ID". Application type: Desktop app.
10
+
Copy the Client ID and Client secret.
11
+
12
+
Step 3. Enable the Google Slides API for the project: APIs & Services
13
+
-> Library -> search "Google Slides API" -> Enable.
14
+
15
+
Step 4. If you plan to use --comments, also enable the Google Drive
16
+
API the same way (comments live on Drive, not Slides).
17
+
18
+
Step 5. If the OAuth consent screen isn't configured yet: APIs &
19
+
Services -> OAuth consent screen, User type External, add
20
+
your Google email under Test users.
21
+
22
+
Step 6. Come back here and paste the two strings.
23
+
24
+
|}
25
+
26
+
let credentials_url = "https://console.cloud.google.com/apis/credentials"
27
+
28
+
let run () =
29
+
Eio_main.run @@ fun env ->
30
+
let fs = Eio.Stdenv.fs env in
31
+
let overwriting = Option.is_some (Gslides.Store.load_client fs) in
32
+
if overwriting then
33
+
if
34
+
not
35
+
(Ui.confirm
36
+
(Fmt.str "Existing client credentials at %a -- overwrite them?"
37
+
Eio.Path.pp
38
+
(Gslides.Store.client_path fs)))
39
+
then begin
40
+
Fmt.pr "Aborted.@.";
41
+
exit 0
42
+
end;
43
+
Fmt.pr "%s" instructions;
44
+
Ui.pause_for
45
+
(Fmt.str "Press Enter to open %s in your browser..." credentials_url);
46
+
Ui.open_in_browser credentials_url;
47
+
Fmt.pr "@.";
48
+
let client_id = Ui.prompt "Client ID" in
49
+
let client_secret = Ui.prompt "Client secret" in
50
+
if client_id = "" || client_secret = "" then
51
+
Ui.die "both Client ID and Client secret are required";
52
+
Gslides.Store.save_client fs { client_id; client_secret };
53
+
if overwriting then Gslides.Store.clear_token fs;
54
+
Fmt.pr "@.Saved client credentials to %a@." Eio.Path.pp
55
+
(Gslides.Store.client_path fs);
56
+
if overwriting then
57
+
Fmt.pr "Cleared the previous login token (tied to the old client).@.";
58
+
Fmt.pr "Next: run `gslides login` to authorize your Google account.@."
59
+
60
+
open Cmdliner
61
+
62
+
let cmd =
63
+
let doc =
64
+
"One-time setup: register gslides with your Google account (creates an \
65
+
OAuth client in the Google Cloud Console)."
66
+
in
67
+
let info = Cmd.info "install" ~doc in
68
+
Cmd.v info Term.(const run $ const ())
+1
bin/install.mli
+1
bin/install.mli
···
1
+
val cmd : unit Cmdliner.Cmd.t
+37
bin/login.ml
+37
bin/login.ml
···
1
+
let require_client fs =
2
+
match Gslides.Store.load_client fs with
3
+
| Some c -> c
4
+
| None -> Ui.die "no client credentials. Run `gslides install` first."
5
+
6
+
let run () =
7
+
Eio_main.run @@ fun env ->
8
+
Eio.Switch.run @@ fun sw ->
9
+
let http = Requests.v ~sw env in
10
+
let clock = Eio.Stdenv.clock env in
11
+
let net = Eio.Stdenv.net env in
12
+
let fs = Eio.Stdenv.fs env in
13
+
let { Gslides.Store.client_id; client_secret } = require_client fs in
14
+
(* Request the Drive comments scope alongside the Slides scope so
15
+
`gslides md --comments` works without a separate login. *)
16
+
let scopes = [ Gslides.scope_readonly; Gslides.Comments.scope ] in
17
+
let on_url url =
18
+
Fmt.pr "Opening your browser to authorize...@.";
19
+
Ui.open_in_browser url;
20
+
Fmt.pr "If it didn't open, paste this URL manually:@.@. %s@." url
21
+
in
22
+
match
23
+
Gauth.Local_flow.run http ~clock ~net ~sw ~client_id ~client_secret ~scopes
24
+
~on_url ()
25
+
with
26
+
| Error (`Msg m) -> Ui.die "login failed: %s" m
27
+
| Ok token ->
28
+
Gslides.Store.save_token fs (Gauth.to_json token);
29
+
Fmt.pr "@.Logged in. Token saved to %a@." Eio.Path.pp
30
+
(Gslides.Store.token_path fs)
31
+
32
+
open Cmdliner
33
+
34
+
let cmd =
35
+
let doc = "Authorize your Google account in the browser." in
36
+
let info = Cmd.info "login" ~doc in
37
+
Cmd.v info Term.(const run $ const ())
+1
bin/login.mli
+1
bin/login.mli
···
1
+
val cmd : unit Cmdliner.Cmd.t
+11
bin/main.ml
+11
bin/main.ml
···
1
+
let () =
2
+
Crypto_rng_unix.use_default ();
3
+
let doc =
4
+
"Google Slides CLI. Run `gslides install` first, then `gslides login`."
5
+
in
6
+
let info = Cmdliner.Cmd.info "gslides" ~version:"%%VERSION%%" ~doc in
7
+
let group =
8
+
Cmdliner.Cmd.group info
9
+
[ Install.cmd; Login.cmd; Get.cmd; Md.cmd; Typst.cmd ]
10
+
in
11
+
exit (Cmdliner.Cmd.eval group)
+51
bin/md.ml
+51
bin/md.ml
···
1
+
let run ~comments presentation_id =
2
+
Eio_main.run @@ fun env ->
3
+
Eio.Switch.run @@ fun sw ->
4
+
let http = Requests.v ~sw env in
5
+
let clock = Eio.Stdenv.clock env in
6
+
let fs = Eio.Stdenv.fs env in
7
+
let token =
8
+
match Gslides.Store.acquire http ~clock ~fs with
9
+
| Ok t -> t
10
+
| Error (`Msg m) -> Ui.die "%s" m
11
+
in
12
+
let result =
13
+
match Gslides.get http ~token presentation_id with
14
+
| Error _ as e -> e
15
+
| Ok p ->
16
+
let comments_list =
17
+
if comments then (
18
+
match Gslides.Comments.list http ~token presentation_id with
19
+
| Ok cs -> cs
20
+
| Error (`Msg m) ->
21
+
Fmt.epr "warning: could not fetch comments: %s@." m;
22
+
[])
23
+
else []
24
+
in
25
+
Ok (Gslides.Marp.of_presentation ~comments:comments_list p)
26
+
in
27
+
Gslides.Store.persist fs token;
28
+
match result with Error (`Msg m) -> Ui.die "%s" m | Ok md -> print_string md
29
+
30
+
open Cmdliner
31
+
32
+
let presentation_id =
33
+
let doc = "Google Slides presentation ID (the long string in the URL)." in
34
+
Arg.(
35
+
required & pos 0 (some string) None & info [] ~docv:"PRESENTATION_ID" ~doc)
36
+
37
+
let comments_flag =
38
+
let doc =
39
+
"Include presentation comments as GFM footnotes anchored to their slide \
40
+
(requires the drive.readonly scope -- re-run `gslides login` if you \
41
+
haven't granted it)."
42
+
in
43
+
Arg.(value & flag & info [ "comments"; "c" ] ~doc)
44
+
45
+
let cmd =
46
+
let doc = "Fetch a presentation and print it as Marp-flavored markdown." in
47
+
let info = Cmd.info "md" ~doc in
48
+
Cmd.v info
49
+
Term.(
50
+
const (fun comments id -> run ~comments id)
51
+
$ comments_flag $ presentation_id)
+1
bin/md.mli
+1
bin/md.mli
···
1
+
val cmd : unit Cmdliner.Cmd.t
+52
bin/typst.ml
+52
bin/typst.ml
···
1
+
let run ~comments presentation_id =
2
+
Eio_main.run @@ fun env ->
3
+
Eio.Switch.run @@ fun sw ->
4
+
let http = Requests.v ~sw env in
5
+
let clock = Eio.Stdenv.clock env in
6
+
let fs = Eio.Stdenv.fs env in
7
+
let token =
8
+
match Gslides.Store.acquire http ~clock ~fs with
9
+
| Ok t -> t
10
+
| Error (`Msg m) -> Ui.die "%s" m
11
+
in
12
+
let result =
13
+
match Gslides.get http ~token presentation_id with
14
+
| Error _ as e -> e
15
+
| Ok p ->
16
+
let comments_list =
17
+
if comments then (
18
+
match Gslides.Comments.list http ~token presentation_id with
19
+
| Ok cs -> cs
20
+
| Error (`Msg m) ->
21
+
Fmt.epr "warning: could not fetch comments: %s@." m;
22
+
[])
23
+
else []
24
+
in
25
+
Ok (Gslides.Typst.of_presentation ~comments:comments_list p)
26
+
in
27
+
Gslides.Store.persist fs token;
28
+
match result with
29
+
| Error (`Msg m) -> Ui.die "%s" m
30
+
| Ok typ -> print_string typ
31
+
32
+
open Cmdliner
33
+
34
+
let presentation_id =
35
+
let doc = "Google Slides presentation ID (the long string in the URL)." in
36
+
Arg.(
37
+
required & pos 0 (some string) None & info [] ~docv:"PRESENTATION_ID" ~doc)
38
+
39
+
let comments_flag =
40
+
let doc =
41
+
"Include presentation comments as Typst footnotes anchored to their slide \
42
+
(requires the drive.readonly scope)."
43
+
in
44
+
Arg.(value & flag & info [ "comments"; "c" ] ~doc)
45
+
46
+
let cmd =
47
+
let doc = "Fetch a presentation and print it as polylux-flavored Typst." in
48
+
let info = Cmd.info "typst" ~doc in
49
+
Cmd.v info
50
+
Term.(
51
+
const (fun comments id -> run ~comments id)
52
+
$ comments_flag $ presentation_id)
+1
bin/typst.mli
+1
bin/typst.mli
···
1
+
val cmd : unit Cmdliner.Cmd.t
+36
bin/ui.ml
+36
bin/ui.ml
···
1
+
let open_in_browser url =
2
+
let cmd =
3
+
match Sys.os_type with
4
+
| "Win32" -> Fmt.str "start %s" (Filename.quote url)
5
+
| _ ->
6
+
if
7
+
Sys.file_exists "/usr/bin/open"
8
+
|| Sys.file_exists "/usr/local/bin/open"
9
+
then Fmt.str "open %s" (Filename.quote url)
10
+
else Fmt.str "xdg-open %s >/dev/null 2>&1" (Filename.quote url)
11
+
in
12
+
ignore (Sys.command cmd)
13
+
14
+
let prompt label =
15
+
Fmt.pr "%s: @?" label;
16
+
match In_channel.input_line In_channel.stdin with
17
+
| Some s -> String.trim s
18
+
| None -> ""
19
+
20
+
let confirm label =
21
+
Fmt.pr "%s [y/N] @?" label;
22
+
match In_channel.input_line In_channel.stdin with
23
+
| Some s -> String.lowercase_ascii (String.trim s) = "y"
24
+
| None -> false
25
+
26
+
let pause_for label =
27
+
Fmt.pr "%s @?" label;
28
+
let _ = In_channel.input_line In_channel.stdin in
29
+
()
30
+
31
+
let die fmt =
32
+
Fmt.kstr
33
+
(fun m ->
34
+
Fmt.epr "error: %s@." m;
35
+
exit 1)
36
+
fmt
+7
bin/ui.mli
+7
bin/ui.mli
+7
dune
+7
dune
+40
dune-project
+40
dune-project
···
1
+
(lang dune 3.21)
2
+
(using mdx 0.4)
3
+
4
+
(name gslides)
5
+
6
+
(generate_opam_files true)
7
+
8
+
(source (tangled gazagnaire.org/ocaml-gslides))
9
+
(license MIT)
10
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
11
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
12
+
13
+
(package
14
+
(name gslides)
15
+
(synopsis "Google Slides API client for OCaml")
16
+
(tags (org:blacksun google network http))
17
+
(description
18
+
"OCaml client for the Google Slides v1 REST API. Fetches presentation
19
+
structure -- slides, text, bullets, speaker notes -- and renders to
20
+
Marp-flavored markdown or polylux-flavored Typst for version control.
21
+
Uses ocaml-gauth for authentication and ocaml-requests for HTTP.")
22
+
(depends
23
+
(ocaml (>= 5.1))
24
+
(dune (>= 3.21))
25
+
(cmdliner (>= 1.2))
26
+
(eio (>= 1.0))
27
+
(eio_main (>= 1.0))
28
+
(fmt (>= 0.9))
29
+
(gauth (>= 0.1))
30
+
(nox-http (>= 0.1))
31
+
(nox-json (>= 0.2))
32
+
(logs (>= 0.7))
33
+
(oauth (>= 0.1))
34
+
(requests (>= 0.1))
35
+
(nox-xdge (>= 0.1))
36
+
(alcotest :with-test)
37
+
(nox-crypto-rng :with-test)
38
+
(odoc :with-doc)
39
+
uri
40
+
(mdx :with-test)))
+52
gslides.opam
+52
gslides.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Google Slides API client for OCaml"
4
+
description: """
5
+
OCaml client for the Google Slides v1 REST API. Fetches presentation
6
+
structure -- slides, text, bullets, speaker notes -- and renders to
7
+
Marp-flavored markdown or polylux-flavored Typst for version control.
8
+
Uses ocaml-gauth for authentication and ocaml-requests for HTTP."""
9
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
11
+
license: "MIT"
12
+
tags: ["org:blacksun" "google" "network" "http"]
13
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-gslides"
14
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-gslides/issues"
15
+
depends: [
16
+
"ocaml" {>= "5.1"}
17
+
"dune" {>= "3.21" & >= "3.21"}
18
+
"cmdliner" {>= "1.2"}
19
+
"eio" {>= "1.0"}
20
+
"eio_main" {>= "1.0"}
21
+
"fmt" {>= "0.9"}
22
+
"gauth" {>= "0.1"}
23
+
"nox-http" {>= "0.1"}
24
+
"nox-json" {>= "0.2"}
25
+
"logs" {>= "0.7"}
26
+
"oauth" {>= "0.1"}
27
+
"requests" {>= "0.1"}
28
+
"nox-xdge" {>= "0.1"}
29
+
"alcotest" {with-test}
30
+
"nox-crypto-rng" {with-test}
31
+
"odoc" {with-doc}
32
+
"uri"
33
+
"mdx" {with-test}
34
+
]
35
+
build: [
36
+
["dune" "subst"] {dev}
37
+
[
38
+
"dune"
39
+
"build"
40
+
"-p"
41
+
name
42
+
"-j"
43
+
jobs
44
+
"@install"
45
+
"@runtest" {with-test}
46
+
"@doc" {with-doc}
47
+
]
48
+
]
49
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-gslides"
50
+
x-maintenance-intent: ["(latest)"]
51
+
x-quality-build: "2026-04-30"
52
+
x-quality-test: "2026-04-30"
+142
lib/comments.ml
+142
lib/comments.ml
···
1
+
let src = Logs.Src.create "gslides.comments" ~doc:"Drive comments API client"
2
+
3
+
module Log = (val Logs.src_log src : Logs.LOG)
4
+
5
+
let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt
6
+
7
+
let err_json_decode e =
8
+
err_msg "comments JSON decode: %s" (Json.Error.to_string e)
9
+
10
+
let max_body_chars = 256
11
+
12
+
let truncate_body s =
13
+
let n = String.length s in
14
+
if n <= max_body_chars then s
15
+
else
16
+
Fmt.str "%s... [truncated; %d bytes total]"
17
+
(String.sub s 0 max_body_chars)
18
+
n
19
+
20
+
let err_http status body =
21
+
err_msg "Drive comments HTTP %d: %s" status (truncate_body body)
22
+
23
+
let scope = "https://www.googleapis.com/auth/drive.readonly"
24
+
25
+
type t = {
26
+
id : string;
27
+
author : string;
28
+
content : string;
29
+
quoted_text : string;
30
+
anchor : string option;
31
+
resolved : bool;
32
+
}
33
+
34
+
let id (t : t) = t.id
35
+
36
+
let pp ppf c =
37
+
let author = if c.author = "" then "(unknown)" else c.author in
38
+
Fmt.pf ppf "%s: %s" author c.content
39
+
40
+
(* -- JSON parsing ------------------------------------------------ *)
41
+
42
+
type raw_author = { display_name : string }
43
+
44
+
let author_jsont =
45
+
let open Json.Codec in
46
+
Object.map ~kind:"author" (fun display_name -> { display_name })
47
+
|> Object.member "displayName" string ~dec_absent:"" ~enc:(fun a ->
48
+
a.display_name)
49
+
|> Object.skip_unknown |> Object.seal
50
+
51
+
type raw_quoted = { value : string }
52
+
53
+
let quoted_jsont =
54
+
let open Json.Codec in
55
+
Object.map ~kind:"quotedFileContent" (fun value -> { value })
56
+
|> Object.member "value" string ~dec_absent:"" ~enc:(fun q -> q.value)
57
+
|> Object.skip_unknown |> Object.seal
58
+
59
+
let comment_jsont =
60
+
let open Json.Codec in
61
+
Object.map ~kind:"comment" (fun id author content quoted anchor resolved ->
62
+
{
63
+
id;
64
+
author = (match author with Some a -> a.display_name | None -> "");
65
+
content;
66
+
quoted_text = (match quoted with Some q -> q.value | None -> "");
67
+
anchor;
68
+
resolved;
69
+
})
70
+
|> Object.member "id" string ~enc:id
71
+
|> Object.opt_member "author" author_jsont ~enc:(fun _ -> None)
72
+
|> Object.member "content" string ~dec_absent:"" ~enc:(fun c -> c.content)
73
+
|> Object.opt_member "quotedFileContent" quoted_jsont ~enc:(fun _ -> None)
74
+
|> Object.opt_member "anchor" string ~enc:(fun c -> c.anchor)
75
+
|> Object.member "resolved" bool ~dec_absent:false ~enc:(fun c -> c.resolved)
76
+
|> Object.skip_unknown |> Object.seal
77
+
78
+
type raw_list = { comments : t list }
79
+
80
+
let list_jsont =
81
+
let open Json.Codec in
82
+
Object.map ~kind:"comment_list" (fun comments -> { comments })
83
+
|> Object.member "comments" (list comment_jsont) ~dec_absent:[] ~enc:(fun r ->
84
+
r.comments)
85
+
|> Object.skip_unknown |> Object.seal
86
+
87
+
let of_json_string body =
88
+
match Json.of_string list_jsont body with
89
+
| Error e -> err_json_decode e
90
+
| Ok r -> Ok r.comments
91
+
92
+
(* Slides anchors are JSON-encoded references like:
93
+
{"r":"some-region","a":[{"pageObjectId":"p1","textRange":{...}}]}
94
+
The exact shape isn't documented; the [pageObjectId] is what we need. *)
95
+
let anchor_slide_id c =
96
+
match c.anchor with
97
+
| None -> None
98
+
| Some s -> (
99
+
match Json.Value.of_string s with
100
+
| Error _ -> None
101
+
| Ok json ->
102
+
let mem_name ((n, _) : Json.Value.name) = n in
103
+
let rec find_page_id = function
104
+
| Json.Value.Object (members, _) -> (
105
+
match
106
+
List.find_opt
107
+
(fun (n, _) -> mem_name n = "pageObjectId")
108
+
members
109
+
with
110
+
| Some (_, Json.Value.String (id, _)) when id <> "" -> Some id
111
+
| _ -> List.find_map (fun (_, v) -> find_page_id v) members)
112
+
| Json.Value.Array (items, _) -> List.find_map find_page_id items
113
+
| _ -> None
114
+
in
115
+
find_page_id json)
116
+
117
+
(* -- HTTP -------------------------------------------------------- *)
118
+
119
+
let api_root = "https://www.googleapis.com/drive/v3/files/"
120
+
121
+
let url file_id =
122
+
let base = api_root ^ Uri.pct_encode ~component:`Path file_id in
123
+
base
124
+
^ "/comments?fields=comments(id,author/displayName,content,quotedFileContent,anchor,resolved)"
125
+
126
+
let auth_header token =
127
+
match Gauth.try_access token with
128
+
| Ok s -> Ok ("Authorization", "Bearer " ^ s)
129
+
| Error (`Msg m) -> err_msg "authentication: %s" m
130
+
131
+
let list http ~token presentation_id =
132
+
match auth_header token with
133
+
| Error _ as e -> e
134
+
| Ok hdr ->
135
+
let u = url presentation_id in
136
+
Log.debug (fun m -> m "GET %s" u);
137
+
let headers = Http.Headers.of_list [ hdr ] in
138
+
let resp = Requests.get http u ~headers in
139
+
let status = Requests.Response.status_code resp in
140
+
let body = Requests.Response.text resp in
141
+
if status < 200 || status >= 300 then err_http status body
142
+
else of_json_string body
+45
lib/comments.mli
+45
lib/comments.mli
···
1
+
(** Google Slides comments, via the Drive API.
2
+
3
+
Slides comments aren't part of the Slides API surface itself; they live on
4
+
the underlying Drive file. Fetching them requires the [drive.readonly] scope
5
+
(or broader) in addition to the Slides scope. *)
6
+
7
+
type t = {
8
+
id : string;
9
+
author : string; (** Display name of the author, or [""] if unknown. *)
10
+
content : string; (** Comment body, plain text. *)
11
+
quoted_text : string;
12
+
(** Slides anchors comments to objects on the page rather than to a text
13
+
range, so [quoted_text] is usually empty. Kept in the API shape for
14
+
parity with Drive's other consumers. *)
15
+
anchor : string option;
16
+
(** Drive's [anchor] field. For Slides this is a JSON-encoded reference to
17
+
a slide region; the renderer parses it to associate the comment with a
18
+
slide. *)
19
+
resolved : bool;
20
+
}
21
+
22
+
val id : t -> string
23
+
24
+
val pp : Format.formatter -> t -> unit
25
+
(** [pp ppf c] prints [author: content]. *)
26
+
27
+
val scope : string
28
+
(** [scope] is [https://www.googleapis.com/auth/drive.readonly]. *)
29
+
30
+
val list :
31
+
Requests.t ->
32
+
token:Gauth.token ->
33
+
string ->
34
+
(t list, [ `Msg of string ]) result
35
+
(** [list http ~token presentation_id] fetches all comments on the underlying
36
+
Drive file. Errors are the same shape as {!Gslides.get}. *)
37
+
38
+
val of_json_string : string -> (t list, [ `Msg of string ]) result
39
+
(** [of_json_string body] parses a Drive [comments.list] response. Useful for
40
+
testing with fixtures. *)
41
+
42
+
val anchor_slide_id : t -> string option
43
+
(** [anchor_slide_id c] tries to extract the [pageObjectId] of the slide that
44
+
[c.anchor] points to. Returns [None] if the anchor is missing or doesn't
45
+
reference a slide. *)
+8
lib/dune
+8
lib/dune
+49
lib/gslides.ml
+49
lib/gslides.ml
···
1
+
module Store = Store
2
+
module Text = Text
3
+
module Page_element = Page_element
4
+
module Slide = Slide
5
+
module Presentation = Presentation
6
+
module Comments = Comments
7
+
module Marp = Marp
8
+
module Typst = Typst
9
+
10
+
let src = Logs.Src.create "gslides" ~doc:"Google Slides API client"
11
+
12
+
module Log = (val Logs.src_log src : Logs.LOG)
13
+
14
+
let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt
15
+
let max_body_chars = 256
16
+
17
+
let truncate_body s =
18
+
let n = String.length s in
19
+
if n <= max_body_chars then s
20
+
else
21
+
Fmt.str "%s... [truncated; %d bytes total]"
22
+
(String.sub s 0 max_body_chars)
23
+
n
24
+
25
+
let err_http status body = err_msg "HTTP %d: %s" status (truncate_body body)
26
+
let scope_readonly = "https://www.googleapis.com/auth/presentations.readonly"
27
+
let scope_readwrite = "https://www.googleapis.com/auth/presentations"
28
+
let api_root = "https://slides.googleapis.com/v1/presentations/"
29
+
30
+
let auth_header token =
31
+
match Gauth.try_access token with
32
+
| Ok s -> Ok ("Authorization", "Bearer " ^ s)
33
+
| Error (`Msg m) -> err_msg "authentication: %s" m
34
+
35
+
let presentation_url presentation_id =
36
+
api_root ^ Uri.pct_encode ~component:`Path presentation_id
37
+
38
+
let get http ~token presentation_id =
39
+
match auth_header token with
40
+
| Error _ as e -> e
41
+
| Ok hdr ->
42
+
let url = presentation_url presentation_id in
43
+
Log.debug (fun m -> m "GET %s" url);
44
+
let headers = Http.Headers.of_list [ hdr ] in
45
+
let resp = Requests.get http url ~headers in
46
+
let status = Requests.Response.status_code resp in
47
+
let body = Requests.Response.text resp in
48
+
if status < 200 || status >= 300 then err_http status body
49
+
else Presentation.of_json_string body
+65
lib/gslides.mli
+65
lib/gslides.mli
···
1
+
(** Google Slides API client.
2
+
3
+
Implements a small, opinionated read-only slice of the
4
+
{{:https://developers.google.com/slides/api/reference/rest} Google Slides v1
5
+
REST API}: fetching a presentation's structure and rendering it to
6
+
Marp-flavored markdown or polylux-flavored Typst for version-controlled
7
+
text. Uses {!Gauth} for authentication.
8
+
9
+
Reading requires the {!scope_readonly} OAuth scope (or the broader
10
+
{!scope_readwrite}).
11
+
12
+
{1 Example}
13
+
14
+
{[
15
+
let run ~(token : Gauth.token) ~presentation_id =
16
+
Eio_main.run @@ fun env ->
17
+
Eio.Switch.run @@ fun sw ->
18
+
let http = Requests.v ~sw env in
19
+
match Gslides.get http ~token presentation_id with
20
+
| Error (`Msg e) -> Fmt.epr "fetch failed: %s@." e
21
+
| Ok p -> print_string (Gslides.Marp.of_presentation p)
22
+
]} *)
23
+
24
+
module Store = Store
25
+
module Text = Text
26
+
module Page_element = Page_element
27
+
module Slide = Slide
28
+
module Presentation = Presentation
29
+
module Comments = Comments
30
+
module Marp = Marp
31
+
module Typst = Typst
32
+
33
+
(** {1 Scopes} *)
34
+
35
+
val scope_readonly : string
36
+
(** [scope_readonly] is the OAuth scope for read-only presentation access,
37
+
[https://www.googleapis.com/auth/presentations.readonly]. *)
38
+
39
+
val scope_readwrite : string
40
+
(** [scope_readwrite] is the OAuth scope for read-write presentation access,
41
+
[https://www.googleapis.com/auth/presentations]. *)
42
+
43
+
(** {1 API calls} *)
44
+
45
+
val get :
46
+
Requests.t ->
47
+
token:Gauth.token ->
48
+
string ->
49
+
(Presentation.t, [ `Msg of string ]) result
50
+
(** [get http ~token presentation_id] fetches the presentation with the given
51
+
ID.
52
+
53
+
Errors:
54
+
- [`Msg "HTTP 401: ..."] if the access token is invalid or expired.
55
+
- [`Msg "HTTP 403: ..."] if the token lacks the presentations scope or the
56
+
user does not have access.
57
+
- [`Msg "HTTP 404: ..."] if the presentation does not exist. *)
58
+
59
+
(**/**)
60
+
61
+
(** {1 Internal} *)
62
+
63
+
val truncate_body : string -> string
64
+
(** Caps oversized upstream error bodies. See the equivalent in [Gsheets] /
65
+
[Gdocs]. *)
+271
lib/marp.ml
+271
lib/marp.ml
···
1
+
(* Markdown chars that would otherwise re-interpret as syntax inside a run
2
+
of plain text. We escape conservatively: chars that, if left raw, would
3
+
either break the surrounding wrappers (e.g. an unbalanced [*] confusing
4
+
the bold/italic emitter) or get re-rendered as HTML ([<]). *)
5
+
let needs_escape c =
6
+
match c with '\\' | '`' | '*' | '_' | '[' | ']' | '<' -> true | _ -> false
7
+
8
+
let escape_text s =
9
+
let buf = Buffer.create (String.length s) in
10
+
String.iter
11
+
(fun c ->
12
+
if needs_escape c then Buffer.add_char buf '\\';
13
+
Buffer.add_char buf c)
14
+
s;
15
+
Buffer.contents buf
16
+
17
+
(* Render one styled run. Order of wrappers (innermost outward):
18
+
monospace -> baseline -> bold/italic -> strike -> underline -> color ->
19
+
link. The link is outermost so any inline style sits inside the link
20
+
text. *)
21
+
let render_run (r : Text.Run.t) =
22
+
let s = escape_text r.text in
23
+
let s = if r.style.monospace then Fmt.str "`%s`" r.text else s in
24
+
let s =
25
+
match r.style.baseline with
26
+
| Text.Style.Superscript -> Fmt.str "<sup>%s</sup>" s
27
+
| Text.Style.Subscript -> Fmt.str "<sub>%s</sub>" s
28
+
| Text.Style.Normal -> s
29
+
in
30
+
let s =
31
+
match (r.style.bold, r.style.italic) with
32
+
| true, true -> Fmt.str "***%s***" s
33
+
| true, false -> Fmt.str "**%s**" s
34
+
| false, true -> Fmt.str "*%s*" s
35
+
| false, false -> s
36
+
in
37
+
let s = if r.style.strikethrough then Fmt.str "~~%s~~" s else s in
38
+
let s = if r.style.underline then Fmt.str "<u>%s</u>" s else s in
39
+
let s =
40
+
match r.style.color with
41
+
| Some c -> Fmt.str "<span style=\"color: %s\">%s</span>" c s
42
+
| None -> s
43
+
in
44
+
let s =
45
+
match r.style.link with Some url -> Fmt.str "[%s](%s)" s url | None -> s
46
+
in
47
+
s
48
+
49
+
let render_runs runs = String.concat "" (List.map render_run runs)
50
+
51
+
(* A paragraph's body, without bullet/alignment wrapping. *)
52
+
let render_paragraph_body (p : Text.Paragraph.t) =
53
+
let body = render_runs p.runs in
54
+
match p.alignment with
55
+
| Text.Paragraph.Center -> Fmt.str "<p align=\"center\">%s</p>" body
56
+
| Text.Paragraph.End -> Fmt.str "<p align=\"right\">%s</p>" body
57
+
| Text.Paragraph.Justified -> Fmt.str "<p align=\"justify\">%s</p>" body
58
+
| Text.Paragraph.Start -> body
59
+
60
+
(* Paragraph as a markdown line, including bullet/numbered prefix and
61
+
indentation by nesting level. *)
62
+
let render_paragraph p =
63
+
let body = render_paragraph_body p in
64
+
match p.bullet with
65
+
| None -> body
66
+
| Some level ->
67
+
let indent = String.make (level * 2) ' ' in
68
+
let prefix = if p.numbered then "1. " else "- " in
69
+
Fmt.str "%s%s%s" indent prefix body
70
+
71
+
(* Blank line between paragraphs except inside a contiguous list block --
72
+
adjacent bulleted paragraphs need to stay on consecutive lines for
73
+
markdown to render them as one list. *)
74
+
let join_paragraphs paragraphs =
75
+
let buf = Buffer.create 256 in
76
+
let prev_was_list = ref false in
77
+
List.iter
78
+
(fun (p : Text.Paragraph.t) ->
79
+
let is_list = Option.is_some p.bullet in
80
+
if Buffer.length buf > 0 then
81
+
begin if !prev_was_list && is_list then Buffer.add_char buf '\n'
82
+
else Buffer.add_string buf "\n\n"
83
+
end;
84
+
Buffer.add_string buf (render_paragraph p);
85
+
prev_was_list := is_list)
86
+
paragraphs;
87
+
Buffer.contents buf
88
+
89
+
(* Slide title: pulled from the first Title placeholder element. Empty if
90
+
none. We also exclude that element from the body so it doesn't get
91
+
rendered twice. *)
92
+
let split_title_and_body (s : Slide.t) =
93
+
let rec loop acc = function
94
+
| [] -> ("", List.rev acc)
95
+
| ({ Page_element.kind = Text { placeholder = Title; paragraphs }; _ } as e)
96
+
:: rest ->
97
+
let title =
98
+
String.concat " " (List.map Text.Paragraph.plain_text paragraphs)
99
+
|> String.trim
100
+
in
101
+
ignore e;
102
+
(title, List.rev_append acc rest)
103
+
| e :: rest -> loop (e :: acc) rest
104
+
in
105
+
loop [] s.elements
106
+
107
+
let render_image (alt, url) =
108
+
if url = "" then Fmt.str "" (escape_text alt)
109
+
else Fmt.str "" (escape_text alt) url
110
+
111
+
let render_table_cell paragraphs =
112
+
let lines =
113
+
List.map (fun p -> render_runs p.Text.Paragraph.runs) paragraphs
114
+
in
115
+
(* Pipe tables can't contain raw newlines in cells; collapse with <br>. *)
116
+
String.concat "<br>" lines
117
+
118
+
let render_table rows =
119
+
match rows with
120
+
| [] -> ""
121
+
| header :: body ->
122
+
let buf = Buffer.create 256 in
123
+
let render_row row =
124
+
Buffer.add_char buf '|';
125
+
List.iter
126
+
(fun cell ->
127
+
Buffer.add_char buf ' ';
128
+
Buffer.add_string buf (render_table_cell cell);
129
+
Buffer.add_string buf " |")
130
+
row;
131
+
Buffer.add_char buf '\n'
132
+
in
133
+
let width = List.length header in
134
+
render_row header;
135
+
Buffer.add_char buf '|';
136
+
for _ = 1 to width do
137
+
Buffer.add_string buf " --- |"
138
+
done;
139
+
Buffer.add_char buf '\n';
140
+
List.iter render_row body;
141
+
Buffer.contents buf
142
+
143
+
let render_element (e : Page_element.t) =
144
+
match e.kind with
145
+
| Page_element.Text { paragraphs; _ } -> join_paragraphs paragraphs
146
+
| Page_element.Image { alt; url; _ } -> render_image (alt, url)
147
+
| Page_element.Table { rows } -> render_table rows
148
+
| Page_element.Other label -> Fmt.str "<!-- [%s] -->" label
149
+
150
+
let render_body elements =
151
+
elements |> List.map render_element
152
+
|> List.filter (fun s -> s <> "")
153
+
|> String.concat "\n\n"
154
+
155
+
let render_notes_block notes =
156
+
if notes = [] then ""
157
+
else
158
+
let body = join_paragraphs notes in
159
+
Fmt.str "<!-- _notes:\n%s\n-->" body
160
+
161
+
(* Comments association --------------------------------------------- *)
162
+
163
+
(* Group comments by their anchor's slide objectId. Comments without a
164
+
resolvable anchor go into the "unanchored" bucket. *)
165
+
let bucket_comments comments =
166
+
let by_slide = Hashtbl.create 8 in
167
+
let unanchored = ref [] in
168
+
List.iter
169
+
(fun c ->
170
+
match Comments.anchor_slide_id c with
171
+
| Some id ->
172
+
let prev = try Hashtbl.find by_slide id with Not_found -> [] in
173
+
Hashtbl.replace by_slide id (c :: prev)
174
+
| None -> unanchored := c :: !unanchored)
175
+
comments;
176
+
Hashtbl.iter (fun k v -> Hashtbl.replace by_slide k (List.rev v)) by_slide;
177
+
(by_slide, List.rev !unanchored)
178
+
179
+
let footnote_label index = Fmt.str "slc%d" (index + 1)
180
+
181
+
(* Render a slide's body with appended footnote refs for its comments. *)
182
+
let render_slide_with_footnotes ?slide_comments ~comment_index s =
183
+
let title, body_elements = split_title_and_body s in
184
+
let buf = Buffer.create 512 in
185
+
if s.skipped then Buffer.add_string buf "<!-- _hide: true -->\n\n";
186
+
if title <> "" then begin
187
+
Buffer.add_string buf "# ";
188
+
Buffer.add_string buf (escape_text title);
189
+
Buffer.add_string buf "\n\n"
190
+
end;
191
+
let body = render_body body_elements in
192
+
if body <> "" then begin
193
+
Buffer.add_string buf body;
194
+
Buffer.add_char buf '\n'
195
+
end;
196
+
(match slide_comments with
197
+
| None | Some [] -> ()
198
+
| Some cs ->
199
+
if Buffer.length buf > 0 && Buffer.nth buf (Buffer.length buf - 1) <> '\n'
200
+
then Buffer.add_char buf '\n';
201
+
Buffer.add_char buf '\n';
202
+
List.iter
203
+
(fun c ->
204
+
let i = comment_index c in
205
+
Buffer.add_string buf (Fmt.str "[^%s]\n" (footnote_label i)))
206
+
cs);
207
+
let notes = render_notes_block s.notes in
208
+
if notes <> "" then begin
209
+
if Buffer.length buf > 0 && Buffer.nth buf (Buffer.length buf - 1) <> '\n'
210
+
then Buffer.add_char buf '\n';
211
+
Buffer.add_char buf '\n';
212
+
Buffer.add_string buf notes;
213
+
Buffer.add_char buf '\n'
214
+
end;
215
+
Buffer.contents buf
216
+
217
+
let frontmatter (p : Presentation.t) =
218
+
let title = Presentation.title p in
219
+
if title = "" then "---\nmarp: true\n---\n\n"
220
+
else Fmt.str "---\nmarp: true\ntitle: %s\n---\n\n" title
221
+
222
+
let render_footnote_definitions comments comment_index =
223
+
if comments = [] then ""
224
+
else
225
+
let buf = Buffer.create 256 in
226
+
Buffer.add_string buf "\n";
227
+
List.iter
228
+
(fun (c : Comments.t) ->
229
+
let i = comment_index c in
230
+
let author = if c.author = "" then "(unknown)" else c.author in
231
+
Buffer.add_string buf
232
+
(Fmt.str "[^%s]: **%s**: %s\n" (footnote_label i) author c.content))
233
+
comments;
234
+
Buffer.contents buf
235
+
236
+
let render_unanchored_section comments =
237
+
if comments = [] then ""
238
+
else
239
+
let buf = Buffer.create 256 in
240
+
Buffer.add_string buf "\n---\n\n## Comments\n\n";
241
+
List.iter
242
+
(fun (c : Comments.t) ->
243
+
let author = if c.author = "" then "(unknown)" else c.author in
244
+
Buffer.add_string buf (Fmt.str "> **%s**: %s\n>\n" author c.content))
245
+
comments;
246
+
Buffer.contents buf
247
+
248
+
(* Public API --------------------------------------------------------- *)
249
+
250
+
let of_presentation ?(comments = []) (p : Presentation.t) =
251
+
let by_slide, unanchored = bucket_comments comments in
252
+
let comment_index =
253
+
let table = Hashtbl.create 16 in
254
+
List.iteri (fun i c -> Hashtbl.add table c.Comments.id i) comments;
255
+
fun c -> Hashtbl.find table c.Comments.id
256
+
in
257
+
let buf = Buffer.create 1024 in
258
+
Buffer.add_string buf (frontmatter p);
259
+
let slides = Presentation.slides p in
260
+
List.iteri
261
+
(fun i (s : Slide.t) ->
262
+
if i > 0 then Buffer.add_string buf "\n---\n\n";
263
+
let slide_comments =
264
+
try Some (Hashtbl.find by_slide s.object_id) with Not_found -> None
265
+
in
266
+
Buffer.add_string buf
267
+
(render_slide_with_footnotes ?slide_comments ~comment_index s))
268
+
slides;
269
+
Buffer.add_string buf (render_unanchored_section unanchored);
270
+
Buffer.add_string buf (render_footnote_definitions comments comment_index);
271
+
Buffer.contents buf
+32
lib/marp.mli
+32
lib/marp.mli
···
1
+
(** Render a {!Presentation.t} as {{:https://marp.app/} Marp}-flavored markdown.
2
+
3
+
The output is a single markdown file with:
4
+
5
+
- YAML frontmatter for the deck title and Marp directives.
6
+
- Slides separated by horizontal rules ([---]).
7
+
- Slide titles as level-1 headings ([# Title]).
8
+
- Body text as paragraphs and bullet/numbered lists.
9
+
- Inline style as standard markdown ([**bold**], [*italic*],
10
+
[~~strikethrough~~]) plus HTML escape hatches for features that have no
11
+
CommonMark form (underline, sub/superscript, color).
12
+
- Images as [] references (the [url] is the short-lived
13
+
[contentUrl] from the Slides API; v1 does not export image bytes).
14
+
- Tables as GFM pipe tables for simple cases.
15
+
- Speaker notes as Marp [<!-- _notes -->] comment blocks.
16
+
- Hidden slides via [<!-- _hide: true -->].
17
+
18
+
The output is what Marp's [marp-cli] consumes; it can also be piped through
19
+
[pandoc] for further conversion. *)
20
+
21
+
val of_presentation : ?comments:Comments.t list -> Presentation.t -> string
22
+
(** [of_presentation ?comments p] renders [p] as a Marp markdown document.
23
+
24
+
When [comments] is supplied, Drive comments are spliced in as GFM-style
25
+
footnotes. The renderer parses each comment's [anchor] to extract the
26
+
[pageObjectId] of the slide it points to and emits a footnote reference
27
+
[[^slcN]] at the end of that slide's body. Comments whose anchor does not
28
+
parse or doesn't match any slide are appended in a trailing [## Comments]
29
+
section. Footnote definitions ([[^slcN]: **author**: content]) are emitted
30
+
after the body of the entire deck.
31
+
32
+
[comments] defaults to [[]] -- no comments rendered. *)
+123
lib/page_element.ml
+123
lib/page_element.ml
···
1
+
type placeholder = Title | Subtitle | Body | Other_placeholder | None_
2
+
3
+
type kind =
4
+
| Text of { placeholder : placeholder; paragraphs : Text.Paragraph.t list }
5
+
| Image of { alt : string; url : string; source_url : string option }
6
+
| Table of { rows : Text.Paragraph.t list list list }
7
+
| Other of string
8
+
9
+
type t = { object_id : string; kind : kind }
10
+
11
+
let mem_name ((n, _) : Json.Value.name) = n
12
+
13
+
let object_member json key =
14
+
match json with
15
+
| Json.Value.Object (members, _) ->
16
+
List.find_map
17
+
(fun (n, v) -> if mem_name n = key then Some v else None)
18
+
members
19
+
| _ -> None
20
+
21
+
let string_member json key =
22
+
match object_member json key with
23
+
| Some (Json.Value.String (s, _)) -> s
24
+
| _ -> ""
25
+
26
+
let opt_string_member json key =
27
+
match object_member json key with
28
+
| Some (Json.Value.String (s, _)) when s <> "" -> Some s
29
+
| _ -> None
30
+
31
+
(* Map the Slides API placeholder type strings down to our coarse categories.
32
+
The full list (DOC, TITLE, BODY, CHART, ...) is in the Slides reference;
33
+
we only care about title vs body vs neither. *)
34
+
let parse_placeholder json =
35
+
match object_member json "placeholder" with
36
+
| None -> None_
37
+
| Some p -> (
38
+
match string_member p "type" with
39
+
| "TITLE" | "CENTERED_TITLE" -> Title
40
+
| "SUBTITLE" -> Subtitle
41
+
| "BODY" -> Body
42
+
| "" -> None_
43
+
| _ -> Other_placeholder)
44
+
45
+
let parse_shape object_id shape_json =
46
+
let placeholder = parse_placeholder shape_json in
47
+
let paragraphs =
48
+
match object_member shape_json "text" with
49
+
| Some t -> Text.of_text_content t
50
+
| None -> []
51
+
in
52
+
{ object_id; kind = Text { placeholder; paragraphs } }
53
+
54
+
let parse_image object_id alt image_json =
55
+
let url = string_member image_json "contentUrl" in
56
+
let source_url = opt_string_member image_json "sourceUrl" in
57
+
{ object_id; kind = Image { alt; url; source_url } }
58
+
59
+
let parse_table_cell cell_json =
60
+
match object_member cell_json "text" with
61
+
| Some t -> Text.of_text_content t
62
+
| None -> []
63
+
64
+
let parse_table_row row_json =
65
+
match object_member row_json "tableCells" with
66
+
| Some (Json.Value.Array (cells, _)) -> List.map parse_table_cell cells
67
+
| _ -> []
68
+
69
+
let parse_table object_id table_json =
70
+
let rows =
71
+
match object_member table_json "tableRows" with
72
+
| Some (Json.Value.Array (rows, _)) -> List.map parse_table_row rows
73
+
| _ -> []
74
+
in
75
+
{ object_id; kind = Table { rows } }
76
+
77
+
(* Identify which top-level kind discriminator is present in the page-element.
78
+
Returns the kind label (for Other) plus the JSON sub-object if it's one
79
+
we model. *)
80
+
let kind_of element =
81
+
match object_member element "shape" with
82
+
| Some shape -> `Shape shape
83
+
| None -> (
84
+
match object_member element "image" with
85
+
| Some image -> `Image image
86
+
| None -> (
87
+
match object_member element "table" with
88
+
| Some table -> `Table table
89
+
| None -> (
90
+
match object_member element "video" with
91
+
| Some _ -> `Other "video"
92
+
| None -> (
93
+
match object_member element "line" with
94
+
| Some _ -> `Other "line"
95
+
| None -> (
96
+
match object_member element "wordArt" with
97
+
| Some _ -> `Other "wordArt"
98
+
| None -> (
99
+
match object_member element "sheetsChart" with
100
+
| Some _ -> `Other "chart"
101
+
| None -> (
102
+
match object_member element "elementGroup" with
103
+
| Some _ -> `Other "group"
104
+
| None -> (
105
+
match
106
+
object_member element "speakerSpotlight"
107
+
with
108
+
| Some _ -> `Other "speakerSpotlight"
109
+
| None -> `Unknown))))))))
110
+
111
+
let of_json element =
112
+
match element with
113
+
| Json.Value.Object _ ->
114
+
let object_id = string_member element "objectId" in
115
+
let alt = string_member element "title" in
116
+
Some
117
+
(match kind_of element with
118
+
| `Shape shape -> parse_shape object_id shape
119
+
| `Image image -> parse_image object_id alt image
120
+
| `Table table -> parse_table object_id table
121
+
| `Other label -> { object_id; kind = Other label }
122
+
| `Unknown -> { object_id; kind = Other "unknown" })
123
+
| _ -> None
+43
lib/page_element.mli
+43
lib/page_element.mli
···
1
+
(** A page element: one item placed on a slide.
2
+
3
+
Slides has many element types ([shape], [image], [video], [table], [line],
4
+
[wordArt], [sheetsChart], [elementGroup], [speakerSpotlight]). This module
5
+
keeps the ones that carry meaningful text or content, and reduces the rest
6
+
to an {!Other} placeholder so the renderer can emit a marker without losing
7
+
the slide's overall structure. *)
8
+
9
+
type placeholder =
10
+
| Title
11
+
| Subtitle
12
+
| Body
13
+
| Other_placeholder
14
+
| None_
15
+
(** The Slides API encodes [shape.placeholder.type] as one of TITLE,
16
+
SUBTITLE, BODY, CENTERED_TITLE, etc. We collapse the title-ish forms
17
+
into [Title], body forms into [Body], everything else
18
+
placeholder-typed into [Other_placeholder], and non-placeholder shapes
19
+
into [None_]. *)
20
+
21
+
type kind =
22
+
| Text of { placeholder : placeholder; paragraphs : Text.Paragraph.t list }
23
+
(** A text-bearing shape (or text box). *)
24
+
| Image of { alt : string; url : string; source_url : string option }
25
+
(** An embedded image. [url] is the API-supplied [contentUrl] (a
26
+
short-lived authenticated URL); [source_url] is the original web
27
+
source if the image was embedded by URL. [alt] is taken from
28
+
[PageElement.title] (Slides' alt-text field, despite the name). *)
29
+
| Table of { rows : Text.Paragraph.t list list list }
30
+
(** A table: outer list is rows, middle list is cells per row, inner list
31
+
is paragraphs per cell. *)
32
+
| Other of string
33
+
(** Any element type we don't model -- video, line, wordArt, sheetsChart,
34
+
elementGroup, speakerSpotlight. The string is a short kind label
35
+
([video], [line], [chart], etc.) for the renderer to surface as a
36
+
placeholder. *)
37
+
38
+
type t = { object_id : string; kind : kind }
39
+
40
+
val of_json : Json.Value.t -> t option
41
+
(** [of_json e] parses one [pageElements[]] entry. Returns [None] if [e] is not
42
+
an object. Always returns [Some _] for valid entries -- shapes/images/tables
43
+
map to their kind, anything else maps to {!Other}. *)
+122
lib/presentation.ml
+122
lib/presentation.ml
···
1
+
let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt
2
+
3
+
let err_json_decode e =
4
+
err_msg "presentation JSON decode: %s" (Json.Error.to_string e)
5
+
6
+
let mem_name ((n, _) : Json.Value.name) = n
7
+
8
+
let object_member json key =
9
+
match json with
10
+
| Json.Value.Object (members, _) ->
11
+
List.find_map
12
+
(fun (n, v) -> if mem_name n = key then Some v else None)
13
+
members
14
+
| _ -> None
15
+
16
+
let string_member json key =
17
+
match object_member json key with
18
+
| Some (Json.Value.String (s, _)) -> s
19
+
| _ -> ""
20
+
21
+
let bool_member json key =
22
+
match object_member json key with
23
+
| Some (Json.Value.Bool (b, _)) -> b
24
+
| _ -> false
25
+
26
+
(* Build a lookup table from layout objectId -> layout displayName, by walking
27
+
the [layouts] array at the top level. The slides reference each layout via
28
+
[slideProperties.layoutObjectId]; resolving it lets the renderer pick the
29
+
right Marp class / Typst slide constructor. *)
30
+
let parse_layout_table json =
31
+
match object_member json "layouts" with
32
+
| Some (Json.Value.Array (layouts, _)) ->
33
+
List.filter_map
34
+
(fun layout ->
35
+
let object_id = string_member layout "objectId" in
36
+
let layout_props =
37
+
match object_member layout "layoutProperties" with
38
+
| Some j -> j
39
+
| None -> Json.Value.empty_object
40
+
in
41
+
let display_name =
42
+
match string_member layout_props "displayName" with
43
+
| "" -> string_member layout_props "name"
44
+
| s -> s
45
+
in
46
+
if object_id = "" then None else Some (object_id, display_name))
47
+
layouts
48
+
| _ -> []
49
+
50
+
let resolve_layout table layout_id =
51
+
match List.assoc_opt layout_id table with Some s -> s | None -> ""
52
+
53
+
let parse_slide_elements slide_json =
54
+
match object_member slide_json "pageElements" with
55
+
| Some (Json.Value.Array (elements, _)) ->
56
+
List.filter_map Page_element.of_json elements
57
+
| _ -> []
58
+
59
+
(* Speaker notes: nested at [slideProperties.notesPage.pageElements[*]] -- the
60
+
notes are themselves a page with a single text shape (the "speaker notes"
61
+
shape). We concatenate paragraphs from every text element on the notes
62
+
page. *)
63
+
let parse_notes slide_json =
64
+
match object_member slide_json "slideProperties" with
65
+
| None -> []
66
+
| Some props -> (
67
+
match object_member props "notesPage" with
68
+
| None -> []
69
+
| Some notes_page ->
70
+
let elements = parse_slide_elements notes_page in
71
+
List.concat_map
72
+
(fun (e : Page_element.t) ->
73
+
match e.kind with
74
+
| Page_element.Text { paragraphs; _ } -> paragraphs
75
+
| _ -> [])
76
+
elements)
77
+
78
+
let parse_skipped slide_json =
79
+
match object_member slide_json "slideProperties" with
80
+
| None -> false
81
+
| Some props -> bool_member props "isSkipped"
82
+
83
+
let parse_layout_id slide_json =
84
+
match object_member slide_json "slideProperties" with
85
+
| None -> ""
86
+
| Some props -> string_member props "layoutObjectId"
87
+
88
+
let parse_slide layout_table slide_json : Slide.t =
89
+
{
90
+
object_id = string_member slide_json "objectId";
91
+
layout = resolve_layout layout_table (parse_layout_id slide_json);
92
+
elements = parse_slide_elements slide_json;
93
+
notes = parse_notes slide_json;
94
+
skipped = parse_skipped slide_json;
95
+
}
96
+
97
+
type t = {
98
+
presentation_id : string;
99
+
title : string;
100
+
slides : Slide.t list;
101
+
raw : string;
102
+
}
103
+
104
+
let id p = p.presentation_id
105
+
let title p = p.title
106
+
let slides p = p.slides
107
+
let to_json p = p.raw
108
+
109
+
let of_json_string body =
110
+
match Json.Value.of_string body with
111
+
| Error e -> err_json_decode e
112
+
| Ok json ->
113
+
let presentation_id = string_member json "presentationId" in
114
+
let title = string_member json "title" in
115
+
let layout_table = parse_layout_table json in
116
+
let slides =
117
+
match object_member json "slides" with
118
+
| Some (Json.Value.Array (slides, _)) ->
119
+
List.map (parse_slide layout_table) slides
120
+
| _ -> []
121
+
in
122
+
Ok { presentation_id; title; slides; raw = body }
+20
lib/presentation.mli
+20
lib/presentation.mli
···
1
+
(** A parsed Google Slides presentation. *)
2
+
3
+
type t
4
+
5
+
val id : t -> string
6
+
(** [id p] is the [presentationId] from the API response. *)
7
+
8
+
val title : t -> string
9
+
(** [title p] is the deck title. *)
10
+
11
+
val slides : t -> Slide.t list
12
+
(** [slides p] is the slides in display order. *)
13
+
14
+
val to_json : t -> string
15
+
(** [to_json p] is the raw JSON body as returned by the API. *)
16
+
17
+
val of_json_string : string -> (t, [ `Msg of string ]) result
18
+
(** [of_json_string body] parses a presentation from a raw API JSON response.
19
+
Primarily useful for testing with fixtures; production callers should use
20
+
{!Gslides.get}. *)
+24
lib/slide.ml
+24
lib/slide.ml
···
1
+
type t = {
2
+
object_id : string;
3
+
layout : string;
4
+
elements : Page_element.t list;
5
+
notes : Text.Paragraph.t list;
6
+
skipped : bool;
7
+
}
8
+
9
+
let title s =
10
+
let rec loop = function
11
+
| [] -> ""
12
+
| { Page_element.kind = Text { placeholder = Title; paragraphs }; _ } :: _
13
+
->
14
+
String.concat " " (List.map Text.Paragraph.plain_text paragraphs)
15
+
|> String.trim
16
+
| _ :: rest -> loop rest
17
+
in
18
+
loop s.elements
19
+
20
+
let text_elements s =
21
+
List.filter
22
+
(fun (e : Page_element.t) ->
23
+
match e.kind with Page_element.Text _ -> true | _ -> false)
24
+
s.elements
+25
lib/slide.mli
+25
lib/slide.mli
···
1
+
(** A single slide within a presentation. *)
2
+
3
+
type t = {
4
+
object_id : string;
5
+
layout : string;
6
+
(** The layout name inferred from the slide's [layoutObjectId] reference
7
+
(TITLE, TITLE_AND_BODY, SECTION_HEADER, BLANK, ...). Empty string if
8
+
the layout cannot be resolved. *)
9
+
elements : Page_element.t list;
10
+
(** Page elements in document order (which is the API's insertion order,
11
+
not z-order). *)
12
+
notes : Text.Paragraph.t list;
13
+
(** Speaker notes, parsed from [slideProperties.notesPage]. *)
14
+
skipped : bool; (** Whether the slide is hidden in the presentation. *)
15
+
}
16
+
17
+
val title : t -> string
18
+
(** [title s] is the text content of the first {!Page_element.Text} element
19
+
whose placeholder is {!Page_element.Title}, or the empty string if no such
20
+
element exists. Convenience for renderers that need the slide title. *)
21
+
22
+
val text_elements : t -> Page_element.t list
23
+
(** [text_elements s] returns only the elements whose kind is
24
+
{!Page_element.Text}, in order. Convenience for renderers that emit text
25
+
bodies in a single pass. *)
+55
lib/store.ml
+55
lib/store.ml
···
1
+
let app_name = "gslides"
2
+
let context fs = Xdge.v (fs :> Eio.Fs.dir_ty Eio.Path.t) app_name
3
+
let config_dir fs = Xdge.config_dir (context fs)
4
+
let client_path fs = Eio.Path.(config_dir fs / "client.json")
5
+
let token_path fs = Eio.Path.(config_dir fs / "token.json")
6
+
7
+
type client = { client_id : string; client_secret : string }
8
+
9
+
let client_jsont =
10
+
let open Json.Codec in
11
+
Object.map ~kind:"gslides_client" (fun client_id client_secret ->
12
+
{ client_id; client_secret })
13
+
|> Object.member "client_id" string ~enc:(fun c -> c.client_id)
14
+
|> Object.member "client_secret" string ~enc:(fun c -> c.client_secret)
15
+
|> Object.skip_unknown |> Object.seal
16
+
17
+
(* Atomic write: create a sibling tmp file with O_CREAT|O_EXCL at 0600,
18
+
write the body, then atomically rename it over the target. *)
19
+
let save_file path data =
20
+
let dir, base = path in
21
+
let tmp = (dir, Fmt.str "%s.tmp.%d" base (Unix.getpid ())) in
22
+
(try Eio.Path.unlink tmp with Eio.Io _ -> ());
23
+
Eio.Path.save ~create:(`Exclusive 0o600) tmp data;
24
+
Eio.Path.rename tmp path
25
+
26
+
let load_file path =
27
+
if Eio.Path.is_file path then Some (Eio.Path.load path) else None
28
+
29
+
let save_client fs c =
30
+
save_file (client_path fs) (Json.to_string client_jsont c)
31
+
32
+
let load_client fs =
33
+
match load_file (client_path fs) with
34
+
| None -> None
35
+
| Some body -> (
36
+
match Json.of_string client_jsont body with
37
+
| Ok c -> Some c
38
+
| Error _ -> None)
39
+
40
+
let save_token fs data = save_file (token_path fs) data
41
+
let load_token fs = load_file (token_path fs)
42
+
43
+
let clear_token fs =
44
+
let path = token_path fs in
45
+
if Eio.Path.is_file path then try Eio.Path.unlink path with Eio.Io _ -> ()
46
+
47
+
let persist fs token = save_token fs (Gauth.to_json token)
48
+
49
+
let acquire http ~clock ~fs =
50
+
match load_client fs with
51
+
| None -> Error (`Msg "no client credentials. Run `gslides install` first.")
52
+
| Some { client_id; client_secret } -> (
53
+
match load_token fs with
54
+
| None -> Error (`Msg "not logged in. Run `gslides login` first.")
55
+
| Some json -> Gauth.of_json http ~clock ~client_id ~client_secret json)
+39
lib/store.mli
+39
lib/store.mli
···
1
+
(** On-disk storage of gslides client credentials and user token.
2
+
3
+
Files live under the XDG config directory, typically
4
+
[$HOME/.config/gslides/]:
5
+
- [client.json] -- OAuth client ID/secret (shared across users of this
6
+
install).
7
+
- [token.json] -- per-user OAuth access/refresh token. *)
8
+
9
+
val config_dir : _ Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
10
+
val client_path : _ Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
11
+
val token_path : _ Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
12
+
13
+
type client = { client_id : string; client_secret : string }
14
+
15
+
val save_client : _ Eio.Path.t -> client -> unit
16
+
(** [save_client fs c] writes [c] to {!client_path} atomically: the new content
17
+
is written to a sibling tmp file at mode [0o600] then renamed over the
18
+
target, so the file is never observable at a wider mode. *)
19
+
20
+
val load_client : _ Eio.Path.t -> client option
21
+
val save_token : _ Eio.Path.t -> string -> unit
22
+
val load_token : _ Eio.Path.t -> string option
23
+
24
+
val clear_token : _ Eio.Path.t -> unit
25
+
(** [clear_token fs] removes the saved token file if it exists. Used by
26
+
[gslides install] when the OAuth client is reinstalled, since tokens issued
27
+
against the old client cannot be refreshed against the new one. *)
28
+
29
+
val acquire :
30
+
Requests.t ->
31
+
clock:_ Eio.Time.clock ->
32
+
fs:_ Eio.Path.t ->
33
+
(Gauth.token, [ `Msg of string ]) result
34
+
(** [acquire http ~clock ~fs] loads the saved client and token and returns a
35
+
refreshable {!Gauth.token}. *)
36
+
37
+
val persist : _ Eio.Path.t -> Gauth.token -> unit
38
+
(** [persist fs token] serializes [token]'s current state to disk so a refresh
39
+
performed in-memory survives to the next invocation. *)
+303
lib/text.ml
+303
lib/text.ml
···
1
+
module Style = struct
2
+
type baseline = Normal | Superscript | Subscript
3
+
4
+
type t = {
5
+
bold : bool;
6
+
italic : bool;
7
+
underline : bool;
8
+
strikethrough : bool;
9
+
monospace : bool;
10
+
link : string option;
11
+
color : string option;
12
+
baseline : baseline;
13
+
}
14
+
15
+
let plain =
16
+
{
17
+
bold = false;
18
+
italic = false;
19
+
underline = false;
20
+
strikethrough = false;
21
+
monospace = false;
22
+
link = None;
23
+
color = None;
24
+
baseline = Normal;
25
+
}
26
+
end
27
+
28
+
module Run = struct
29
+
type t = { text : string; style : Style.t }
30
+
end
31
+
32
+
module Paragraph = struct
33
+
type alignment = Start | Center | End | Justified
34
+
35
+
type t = {
36
+
runs : Run.t list;
37
+
bullet : int option;
38
+
numbered : bool;
39
+
alignment : alignment;
40
+
}
41
+
42
+
let empty = { runs = []; bullet = None; numbered = false; alignment = Start }
43
+
44
+
let plain_text p =
45
+
String.concat "" (List.map (fun (r : Run.t) -> r.text) p.runs)
46
+
end
47
+
48
+
(* -- JSON helpers ------------------------------------------------- *)
49
+
50
+
let mem_name ((n, _) : Json.Value.name) = n
51
+
52
+
let object_member json key =
53
+
match json with
54
+
| Json.Value.Object (members, _) ->
55
+
List.find_map
56
+
(fun (n, v) -> if mem_name n = key then Some v else None)
57
+
members
58
+
| _ -> None
59
+
60
+
let bool_member json key =
61
+
match object_member json key with
62
+
| Some (Json.Value.Bool (b, _)) -> b
63
+
| _ -> false
64
+
65
+
let string_member json key =
66
+
match object_member json key with
67
+
| Some (Json.Value.String (s, _)) -> s
68
+
| _ -> ""
69
+
70
+
(* Decode an [OptColor] -> [Color] -> [RgbColor] chain into a hex string.
71
+
Themed colors (ColorScheme references) are returned as None -- we don't
72
+
have the theme palette in scope. *)
73
+
let parse_rgb_color json =
74
+
let r =
75
+
match object_member json "red" with
76
+
| Some (Json.Value.Number (f, _)) -> f
77
+
| _ -> 0.0
78
+
in
79
+
let g =
80
+
match object_member json "green" with
81
+
| Some (Json.Value.Number (f, _)) -> f
82
+
| _ -> 0.0
83
+
in
84
+
let b =
85
+
match object_member json "blue" with
86
+
| Some (Json.Value.Number (f, _)) -> f
87
+
| _ -> 0.0
88
+
in
89
+
let to_byte f =
90
+
let n = int_of_float ((f *. 255.0) +. 0.5) in
91
+
max 0 (min 255 n)
92
+
in
93
+
Some (Fmt.str "#%02x%02x%02x" (to_byte r) (to_byte g) (to_byte b))
94
+
95
+
let parse_color_optional json =
96
+
match object_member json "opaqueColor" with
97
+
| None -> None
98
+
| Some opaque -> (
99
+
match object_member opaque "rgbColor" with
100
+
| Some rgb -> parse_rgb_color rgb
101
+
| None -> None)
102
+
103
+
(* The Slides API encodes monospace family detection by the [fontFamily]
104
+
string. There is no flag. We consult a small set of well-known monospace
105
+
names; everything else is treated as proportional. *)
106
+
let monospace_families =
107
+
[
108
+
"consolas";
109
+
"courier new";
110
+
"courier";
111
+
"roboto mono";
112
+
"source code pro";
113
+
"menlo";
114
+
"monaco";
115
+
"ubuntu mono";
116
+
"dejavu sans mono";
117
+
"fira code";
118
+
"fira mono";
119
+
"jetbrains mono";
120
+
"ibm plex mono";
121
+
"inconsolata";
122
+
"lucida console";
123
+
]
124
+
125
+
let is_monospace_font family =
126
+
let f = String.lowercase_ascii family in
127
+
List.exists (fun m -> f = m) monospace_families
128
+
129
+
(* -- TextStyle decoding ----------------------------------------- *)
130
+
131
+
let parse_baseline = function
132
+
| "SUPERSCRIPT" -> Style.Superscript
133
+
| "SUBSCRIPT" -> Style.Subscript
134
+
| _ -> Style.Normal
135
+
136
+
let parse_link json =
137
+
match object_member json "url" with
138
+
| Some (Json.Value.String (s, _)) when s <> "" -> Some s
139
+
| _ -> None
140
+
141
+
let parse_text_style json =
142
+
if json = Json.Value.empty_object then Style.plain
143
+
else
144
+
let bold = bool_member json "bold" in
145
+
let italic = bool_member json "italic" in
146
+
let underline = bool_member json "underline" in
147
+
let strikethrough = bool_member json "strikethrough" in
148
+
let baseline = parse_baseline (string_member json "baselineOffset") in
149
+
let link =
150
+
match object_member json "link" with
151
+
| Some j -> parse_link j
152
+
| None -> None
153
+
in
154
+
let color =
155
+
match object_member json "foregroundColor" with
156
+
| Some j -> parse_color_optional j
157
+
| None -> None
158
+
in
159
+
let monospace =
160
+
let family = string_member json "fontFamily" in
161
+
family <> "" && is_monospace_font family
162
+
in
163
+
{
164
+
Style.bold;
165
+
italic;
166
+
underline;
167
+
strikethrough;
168
+
monospace;
169
+
link;
170
+
color;
171
+
baseline;
172
+
}
173
+
174
+
(* -- Paragraph decoding ----------------------------------------- *)
175
+
176
+
let parse_alignment = function
177
+
| "CENTER" -> Paragraph.Center
178
+
| "END" -> Paragraph.End
179
+
| "JUSTIFIED" -> Paragraph.Justified
180
+
| _ -> Paragraph.Start
181
+
182
+
(* The Slides API encodes numbered vs bulleted lists in the bullet glyph
183
+
string. Glyphs starting with a digit (1., 2., a., i., ...) are numbered;
184
+
everything else (bullets, dashes, arrows, ...) is unordered. *)
185
+
let glyph_is_numbered glyph =
186
+
let n = String.length glyph in
187
+
let is_digit c = c >= '0' && c <= '9' in
188
+
let is_alpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') in
189
+
n > 0
190
+
&& (is_digit glyph.[0] || (n > 1 && is_alpha glyph.[0] && glyph.[1] = '.'))
191
+
192
+
let parse_bullet json =
193
+
let nesting =
194
+
match object_member json "nestingLevel" with
195
+
| Some (Json.Value.Number (f, _)) -> int_of_float f
196
+
| _ -> 0
197
+
in
198
+
let glyph = string_member json "glyph" in
199
+
(Some nesting, glyph_is_numbered glyph)
200
+
201
+
(* Strip a single trailing newline from a textRun's content. The Slides API
202
+
places "\n" as the paragraph delimiter on the last run of each paragraph;
203
+
keeping it would double-space the rendered output. *)
204
+
let strip_trailing_newline s =
205
+
let n = String.length s in
206
+
if n > 0 && s.[n - 1] = '\n' then String.sub s 0 (n - 1) else s
207
+
208
+
(* -- Main walk -------------------------------------------------- *)
209
+
210
+
(* The textElements stream looks like:
211
+
212
+
[
213
+
{ startIndex, endIndex, paragraphMarker { style, bullet? } },
214
+
{ startIndex, endIndex, textRun { content, style } },
215
+
{ startIndex, endIndex, textRun { content, style } },
216
+
{ startIndex, endIndex, paragraphMarker { ... } },
217
+
...
218
+
]
219
+
220
+
A [paragraphMarker] opens a new paragraph; subsequent [textRun]s belong
221
+
to it until the next marker. We accumulate runs in [current_runs] and
222
+
flush on the next marker (or at end). *)
223
+
224
+
let parse_paragraph_marker json =
225
+
let style =
226
+
match object_member json "style" with
227
+
| Some j -> j
228
+
| None -> Json.Value.empty_object
229
+
in
230
+
let alignment = parse_alignment (string_member style "alignment") in
231
+
let bullet, numbered =
232
+
match object_member json "bullet" with
233
+
| Some j -> parse_bullet j
234
+
| None -> (None, false)
235
+
in
236
+
(bullet, numbered, alignment)
237
+
238
+
let parse_text_run json =
239
+
let content = strip_trailing_newline (string_member json "content") in
240
+
let style =
241
+
match object_member json "style" with
242
+
| Some j -> parse_text_style j
243
+
| None -> Style.plain
244
+
in
245
+
{ Run.text = content; style }
246
+
247
+
let of_text_content json =
248
+
match object_member json "textElements" with
249
+
| None -> []
250
+
| Some (Json.Value.Array (elements, _)) ->
251
+
let paragraphs = ref [] in
252
+
let current_bullet = ref None in
253
+
let current_numbered = ref false in
254
+
let current_alignment = ref Paragraph.Start in
255
+
let current_runs = ref [] in
256
+
let started = ref false in
257
+
let flush () =
258
+
if !started then begin
259
+
let p =
260
+
{
261
+
Paragraph.runs = List.rev !current_runs;
262
+
bullet = !current_bullet;
263
+
numbered = !current_numbered;
264
+
alignment = !current_alignment;
265
+
}
266
+
in
267
+
paragraphs := p :: !paragraphs;
268
+
current_runs := []
269
+
end
270
+
in
271
+
List.iter
272
+
(fun el ->
273
+
match object_member el "paragraphMarker" with
274
+
| Some pm ->
275
+
flush ();
276
+
let bullet, numbered, alignment = parse_paragraph_marker pm in
277
+
current_bullet := bullet;
278
+
current_numbered := numbered;
279
+
current_alignment := alignment;
280
+
started := true
281
+
| None -> (
282
+
match object_member el "textRun" with
283
+
| Some tr ->
284
+
if not !started then begin
285
+
(* Stray run before any paragraphMarker -- start a default
286
+
paragraph so we don't drop the text. *)
287
+
started := true;
288
+
current_bullet := None;
289
+
current_numbered := false;
290
+
current_alignment := Paragraph.Start
291
+
end;
292
+
current_runs := parse_text_run tr :: !current_runs
293
+
| None -> (
294
+
(* autoText, etc. -- treat as a styled run if it has content. *)
295
+
match object_member el "autoText" with
296
+
| Some at ->
297
+
if not !started then started := true;
298
+
current_runs := parse_text_run at :: !current_runs
299
+
| None -> ())))
300
+
elements;
301
+
flush ();
302
+
List.rev !paragraphs
303
+
| Some _ -> []
+73
lib/text.mli
+73
lib/text.mli
···
1
+
(** Text content extracted from a Slides shape or table cell.
2
+
3
+
The Slides API delivers text as a flat stream of [textElements]:
4
+
[paragraphMarker] events open a new paragraph (carrying any bullet/
5
+
alignment metadata), and [textRun] events carry styled chunks of characters.
6
+
This module re-shapes that stream into nested {!Paragraph.t} values, each
7
+
with a list of {!Run.t}s. *)
8
+
9
+
(** Inline style on a run of text. *)
10
+
module Style : sig
11
+
type baseline = Normal | Superscript | Subscript
12
+
13
+
type t = {
14
+
bold : bool;
15
+
italic : bool;
16
+
underline : bool;
17
+
strikethrough : bool;
18
+
monospace : bool;
19
+
(** Heuristic: [true] iff [fontFamily] is one of the common monospace
20
+
faces (e.g. [Consolas], [Courier New], [Roboto Mono]). *)
21
+
link : string option;
22
+
(** [Some url] if the run carries a [textStyle.link.url]. *)
23
+
color : string option;
24
+
(** [Some "#rrggbb"] if the run carries a non-default [foregroundColor].
25
+
*)
26
+
baseline : baseline;
27
+
}
28
+
29
+
val plain : t
30
+
(** All-default style: no bold, italic, etc. *)
31
+
end
32
+
33
+
(** A run of text with uniform style. *)
34
+
module Run : sig
35
+
type t = { text : string; style : Style.t }
36
+
end
37
+
38
+
(** A paragraph: a list of runs plus paragraph-level metadata. *)
39
+
module Paragraph : sig
40
+
type alignment = Start | Center | End | Justified
41
+
42
+
type t = {
43
+
runs : Run.t list;
44
+
bullet : int option;
45
+
(** [Some n] if the paragraph is part of a bulleted/numbered list, with
46
+
[n] the zero-based nesting level (0..8). [None] for plain
47
+
paragraphs. *)
48
+
numbered : bool;
49
+
(** [true] iff the bullet glyph is a number (the Slides API encodes this
50
+
in the bullet glyph string). *)
51
+
alignment : alignment;
52
+
}
53
+
54
+
val empty : t
55
+
(** Paragraph with no runs, no bullet, [Start] alignment. *)
56
+
57
+
val plain_text : t -> string
58
+
(** [plain_text p] is the concatenation of every run's text, with style
59
+
stripped. *)
60
+
end
61
+
62
+
(** {1 Parsing} *)
63
+
64
+
val of_text_content : Json.Value.t -> Paragraph.t list
65
+
(** [of_text_content json] parses a [shape.text] (or [tableCell.text]) JSON
66
+
object into a list of paragraphs. Returns [[]] if [json] is not an object or
67
+
has no [textElements].
68
+
69
+
The Slides API's text-element stream is interpreted as follows:
70
+
[paragraphMarker] opens a new paragraph; subsequent [textRun]s become its
71
+
runs until the next [paragraphMarker]. A trailing newline at the end of each
72
+
[textRun] (the API delimiter between paragraphs in flat text) is stripped
73
+
from the run text. *)
+259
lib/typst.ml
+259
lib/typst.ml
···
1
+
let polylux_version = "0.4.0"
2
+
3
+
(* Typst markup chars to escape in plain text. The literal-text escape is a
4
+
single backslash; we prepend it before anything that would otherwise be
5
+
parsed as syntax. *)
6
+
let needs_escape c =
7
+
match c with
8
+
| '\\' | '#' | '$' | '*' | '_' | '`' | '[' | ']' | '<' | '>' | '@' | '~' ->
9
+
true
10
+
| _ -> false
11
+
12
+
let escape_text s =
13
+
let buf = Buffer.create (String.length s) in
14
+
String.iter
15
+
(fun c ->
16
+
if needs_escape c then Buffer.add_char buf '\\';
17
+
Buffer.add_char buf c)
18
+
s;
19
+
Buffer.contents buf
20
+
21
+
(* Escape for the inside of a Typst string literal: only backslash and the
22
+
double-quote terminator need handling. *)
23
+
let escape_string s =
24
+
let buf = Buffer.create (String.length s) in
25
+
String.iter
26
+
(fun c ->
27
+
(match c with '\\' | '"' -> Buffer.add_char buf '\\' | _ -> ());
28
+
Buffer.add_char buf c)
29
+
s;
30
+
Buffer.contents buf
31
+
32
+
(* Render one styled run. Composition order (innermost outward) matches the
33
+
Marp renderer so the two stay in lockstep:
34
+
monospace -> baseline -> bold -> italic -> strike -> underline ->
35
+
color -> link. *)
36
+
let render_run (r : Text.Run.t) =
37
+
let s =
38
+
if r.style.monospace then Fmt.str "#raw(\"%s\")" (escape_string r.text)
39
+
else escape_text r.text
40
+
in
41
+
let s =
42
+
match r.style.baseline with
43
+
| Text.Style.Superscript -> Fmt.str "#super[%s]" s
44
+
| Text.Style.Subscript -> Fmt.str "#sub[%s]" s
45
+
| Text.Style.Normal -> s
46
+
in
47
+
let s = if r.style.bold then Fmt.str "#strong[%s]" s else s in
48
+
let s = if r.style.italic then Fmt.str "#emph[%s]" s else s in
49
+
let s = if r.style.strikethrough then Fmt.str "#strike[%s]" s else s in
50
+
let s = if r.style.underline then Fmt.str "#underline[%s]" s else s in
51
+
let s =
52
+
match r.style.color with
53
+
| Some c -> Fmt.str "#text(fill: rgb(\"%s\"))[%s]" (escape_string c) s
54
+
| None -> s
55
+
in
56
+
let s =
57
+
match r.style.link with
58
+
| Some url -> Fmt.str "#link(\"%s\")[%s]" (escape_string url) s
59
+
| None -> s
60
+
in
61
+
s
62
+
63
+
let render_runs runs = String.concat "" (List.map render_run runs)
64
+
65
+
let render_paragraph_body (p : Text.Paragraph.t) =
66
+
let body = render_runs p.runs in
67
+
match p.alignment with
68
+
| Text.Paragraph.Center -> Fmt.str "#align(center)[%s]" body
69
+
| Text.Paragraph.End -> Fmt.str "#align(right)[%s]" body
70
+
| Text.Paragraph.Justified -> Fmt.str "#par(justify: true)[%s]" body
71
+
| Text.Paragraph.Start -> body
72
+
73
+
let render_paragraph p =
74
+
let body = render_paragraph_body p in
75
+
match p.bullet with
76
+
| None -> body
77
+
| Some level ->
78
+
let indent = String.make (level * 2) ' ' in
79
+
let prefix = if p.numbered then "+ " else "- " in
80
+
Fmt.str "%s%s%s" indent prefix body
81
+
82
+
let join_paragraphs paragraphs =
83
+
let buf = Buffer.create 256 in
84
+
let prev_was_list = ref false in
85
+
List.iter
86
+
(fun (p : Text.Paragraph.t) ->
87
+
let is_list = Option.is_some p.bullet in
88
+
if Buffer.length buf > 0 then
89
+
begin if !prev_was_list && is_list then Buffer.add_char buf '\n'
90
+
else Buffer.add_string buf "\n\n"
91
+
end;
92
+
Buffer.add_string buf (render_paragraph p);
93
+
prev_was_list := is_list)
94
+
paragraphs;
95
+
Buffer.contents buf
96
+
97
+
let split_title_and_body (s : Slide.t) =
98
+
let rec loop acc = function
99
+
| [] -> ("", List.rev acc)
100
+
| { Page_element.kind = Text { placeholder = Title; paragraphs }; _ }
101
+
:: rest ->
102
+
let title =
103
+
String.concat " " (List.map Text.Paragraph.plain_text paragraphs)
104
+
|> String.trim
105
+
in
106
+
(title, List.rev_append acc rest)
107
+
| e :: rest -> loop (e :: acc) rest
108
+
in
109
+
loop [] s.elements
110
+
111
+
let render_image (alt, url) =
112
+
if url = "" then "// image: (no url)"
113
+
else
114
+
Fmt.str "#image(\"%s\", alt: \"%s\")" (escape_string url)
115
+
(escape_string alt)
116
+
117
+
let render_table_cell paragraphs =
118
+
let inner =
119
+
paragraphs
120
+
|> List.map (fun p -> render_runs p.Text.Paragraph.runs)
121
+
|> String.concat "\n\n"
122
+
in
123
+
Fmt.str "[%s]" inner
124
+
125
+
let render_table rows =
126
+
match rows with
127
+
| [] -> ""
128
+
| first :: _ ->
129
+
let columns = List.length first in
130
+
let buf = Buffer.create 256 in
131
+
Buffer.add_string buf (Fmt.str "#table(\n columns: %d,\n" columns);
132
+
List.iter
133
+
(fun row ->
134
+
List.iter
135
+
(fun cell ->
136
+
Buffer.add_string buf " ";
137
+
Buffer.add_string buf (render_table_cell cell);
138
+
Buffer.add_string buf ",\n")
139
+
row)
140
+
rows;
141
+
Buffer.add_string buf ")";
142
+
Buffer.contents buf
143
+
144
+
let render_element (e : Page_element.t) =
145
+
match e.kind with
146
+
| Page_element.Text { paragraphs; _ } -> join_paragraphs paragraphs
147
+
| Page_element.Image { alt; url; _ } -> render_image (alt, url)
148
+
| Page_element.Table { rows } -> render_table rows
149
+
| Page_element.Other label -> Fmt.str "// [%s]" label
150
+
151
+
let render_body elements =
152
+
elements |> List.map render_element
153
+
|> List.filter (fun s -> s <> "")
154
+
|> String.concat "\n\n"
155
+
156
+
let render_notes notes =
157
+
if notes = [] then ""
158
+
else
159
+
let body = join_paragraphs notes in
160
+
Fmt.str "#speaker-note[\n%s\n]" body
161
+
162
+
(* Comments association: identical bucketing to Marp. *)
163
+
let bucket_comments comments =
164
+
let by_slide = Hashtbl.create 8 in
165
+
let unanchored = ref [] in
166
+
List.iter
167
+
(fun c ->
168
+
match Comments.anchor_slide_id c with
169
+
| Some id ->
170
+
let prev = try Hashtbl.find by_slide id with Not_found -> [] in
171
+
Hashtbl.replace by_slide id (c :: prev)
172
+
| None -> unanchored := c :: !unanchored)
173
+
comments;
174
+
Hashtbl.iter (fun k v -> Hashtbl.replace by_slide k (List.rev v)) by_slide;
175
+
(by_slide, List.rev !unanchored)
176
+
177
+
let render_comment_footnote (c : Comments.t) =
178
+
let author = if c.author = "" then "(unknown)" else c.author in
179
+
Fmt.str "#footnote[*%s*: %s]" (escape_text author) (escape_text c.content)
180
+
181
+
let render_slide ?slide_comments (s : Slide.t) =
182
+
let title, body_elements = split_title_and_body s in
183
+
let buf = Buffer.create 512 in
184
+
if s.skipped then Buffer.add_string buf "// hidden slide\n";
185
+
Buffer.add_string buf "#slide[\n";
186
+
if title <> "" then begin
187
+
Buffer.add_string buf " = ";
188
+
Buffer.add_string buf (escape_text title);
189
+
Buffer.add_string buf "\n\n"
190
+
end;
191
+
let body = render_body body_elements in
192
+
if body <> "" then begin
193
+
Buffer.add_string buf " ";
194
+
let indented = String.concat "\n " (String.split_on_char '\n' body) in
195
+
Buffer.add_string buf indented;
196
+
Buffer.add_char buf '\n'
197
+
end;
198
+
(match slide_comments with
199
+
| None | Some [] -> ()
200
+
| Some cs ->
201
+
Buffer.add_char buf '\n';
202
+
List.iter
203
+
(fun c ->
204
+
Buffer.add_string buf " ";
205
+
Buffer.add_string buf (render_comment_footnote c);
206
+
Buffer.add_char buf '\n')
207
+
cs);
208
+
let notes = render_notes s.notes in
209
+
if notes <> "" then begin
210
+
Buffer.add_char buf '\n';
211
+
Buffer.add_string buf " ";
212
+
let indented = String.concat "\n " (String.split_on_char '\n' notes) in
213
+
Buffer.add_string buf indented;
214
+
Buffer.add_char buf '\n'
215
+
end;
216
+
Buffer.add_string buf "]\n";
217
+
Buffer.contents buf
218
+
219
+
let header (p : Presentation.t) =
220
+
let title = Presentation.title p in
221
+
let buf = Buffer.create 256 in
222
+
Buffer.add_string buf
223
+
(Fmt.str "#import \"@preview/polylux:%s\": *\n" polylux_version);
224
+
Buffer.add_string buf "#set page(paper: \"presentation-16-9\")\n";
225
+
Buffer.add_string buf "#set text(size: 25pt)\n\n";
226
+
if title <> "" then begin
227
+
Buffer.add_string buf
228
+
(Fmt.str "#title-slide[\n = %s\n]\n\n" (escape_text title))
229
+
end;
230
+
Buffer.contents buf
231
+
232
+
let render_unanchored_section comments =
233
+
if comments = [] then ""
234
+
else
235
+
let buf = Buffer.create 256 in
236
+
Buffer.add_string buf "\n#slide[\n = Comments\n\n";
237
+
List.iter
238
+
(fun c ->
239
+
Buffer.add_string buf " ";
240
+
Buffer.add_string buf (render_comment_footnote c);
241
+
Buffer.add_char buf '\n')
242
+
comments;
243
+
Buffer.add_string buf "]\n";
244
+
Buffer.contents buf
245
+
246
+
let of_presentation ?(comments = []) (p : Presentation.t) =
247
+
let by_slide, unanchored = bucket_comments comments in
248
+
let buf = Buffer.create 1024 in
249
+
Buffer.add_string buf (header p);
250
+
List.iter
251
+
(fun (s : Slide.t) ->
252
+
let slide_comments =
253
+
try Some (Hashtbl.find by_slide s.object_id) with Not_found -> None
254
+
in
255
+
Buffer.add_string buf (render_slide ?slide_comments s);
256
+
Buffer.add_char buf '\n')
257
+
(Presentation.slides p);
258
+
Buffer.add_string buf (render_unanchored_section unanchored);
259
+
Buffer.contents buf
+37
lib/typst.mli
+37
lib/typst.mli
···
1
+
(** Render a {!Presentation.t} as {{:https://typst.app/} Typst} source using
2
+
{{:https://github.com/polylux-typst/polylux} polylux}.
3
+
4
+
The output is a single [.typ] file with:
5
+
6
+
- [#import "@preview/polylux:0.4.0": *] header (version-pinned).
7
+
- [#set page(paper: "presentation-16-9")] and a default text size.
8
+
- One [#slide[ ... ]] block per slide; section-header layouts use
9
+
[#new-section-slide[ ... ]] instead.
10
+
- Slide titles as [= Title] (level-1 heading inside the slide block).
11
+
- Body text as paragraphs and native bullet/numbered lists.
12
+
- Inline style via [#text(weight: "bold")[...]],
13
+
[#text(style: "italic") [...]], [#strike[...]], [#underline[...]],
14
+
[#text(fill: rgb("#...")) [...]], [#super[...]], [#sub[...]],
15
+
[#link("url")[label]], [#raw("...")] for monospace.
16
+
- Images via [#image("url", alt: "...")]. Like Marp, v1 does not export
17
+
image bytes -- the URL is the short-lived [contentUrl] from the Slides
18
+
API.
19
+
- Tables via [#table(columns: N, ...)].
20
+
- Speaker notes via polylux's [#speaker-note[ ... ]].
21
+
22
+
Compile with [typst compile deck.typ]. *)
23
+
24
+
val of_presentation : ?comments:Comments.t list -> Presentation.t -> string
25
+
(** [of_presentation ?comments p] renders [p] as a polylux-flavored Typst
26
+
document.
27
+
28
+
When [comments] is supplied, each Drive comment is rendered as a Typst
29
+
[#footnote[...]] at the end of its anchored slide (or at the deck level if
30
+
its anchor doesn't resolve). The footnote body is [*author*: content].
31
+
32
+
[comments] defaults to [[]] -- no comments rendered. *)
33
+
34
+
val polylux_version : string
35
+
(** [polylux_version] is the polylux package version pinned in the generated
36
+
[#import] line. Exposed so callers (or tests) can confirm the dependency
37
+
they emit. *)
+3
test/dune
+3
test/dune
+11
test/test.ml
+11
test/test.ml
+145
test/test_comments.ml
+145
test/test_comments.ml
···
1
+
(* Drive Comments fixture follows
2
+
https://developers.google.com/drive/api/reference/rest/v3/comments *)
3
+
4
+
let parse body =
5
+
match Gslides.Comments.of_json_string body with
6
+
| Ok cs -> cs
7
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
8
+
9
+
let basic_parse () =
10
+
let body =
11
+
{|{"comments":[
12
+
{"id":"c1","author":{"displayName":"Alice"},
13
+
"content":"first comment","resolved":false},
14
+
{"id":"c2","author":{"displayName":"Bob"},
15
+
"content":"second","anchor":"raw","resolved":true}
16
+
]}|}
17
+
in
18
+
let cs = parse body in
19
+
Alcotest.(check int) "two comments" 2 (List.length cs);
20
+
let c1 = List.hd cs in
21
+
Alcotest.(check string) "id" "c1" c1.id;
22
+
Alcotest.(check string) "author" "Alice" c1.author;
23
+
Alcotest.(check string) "content" "first comment" c1.content;
24
+
Alcotest.(check bool) "unresolved" false c1.resolved
25
+
26
+
let empty_comments () =
27
+
let body = {|{"comments":[]}|} in
28
+
Alcotest.(check int) "no comments" 0 (List.length (parse body))
29
+
30
+
let missing_author () =
31
+
let body = {|{"comments":[{"id":"c","content":"x","resolved":false}]}|} in
32
+
let c = List.hd (parse body) in
33
+
Alcotest.(check string) "empty author" "" c.author
34
+
35
+
let pp_includes_author_and_content () =
36
+
let c : Gslides.Comments.t =
37
+
{
38
+
id = "c";
39
+
author = "Carol";
40
+
content = "ok";
41
+
quoted_text = "";
42
+
anchor = None;
43
+
resolved = false;
44
+
}
45
+
in
46
+
let s = Fmt.str "%a" Gslides.Comments.pp c in
47
+
Alcotest.(check string) "Carol: ok" "Carol: ok" s
48
+
49
+
let pp_unknown_author () =
50
+
let c : Gslides.Comments.t =
51
+
{
52
+
id = "c";
53
+
author = "";
54
+
content = "ok";
55
+
quoted_text = "";
56
+
anchor = None;
57
+
resolved = false;
58
+
}
59
+
in
60
+
let s = Fmt.str "%a" Gslides.Comments.pp c in
61
+
Alcotest.(check string) "(unknown): ok" "(unknown): ok" s
62
+
63
+
let anchor_extracts_page_id () =
64
+
let c : Gslides.Comments.t =
65
+
{
66
+
id = "c";
67
+
author = "";
68
+
content = "";
69
+
quoted_text = "";
70
+
anchor = Some {|{"r":"x","a":[{"pageObjectId":"S1","textRange":{}}]}|};
71
+
resolved = false;
72
+
}
73
+
in
74
+
Alcotest.(check (option string))
75
+
"extracted" (Some "S1")
76
+
(Gslides.Comments.anchor_slide_id c)
77
+
78
+
let anchor_missing () =
79
+
let c : Gslides.Comments.t =
80
+
{
81
+
id = "c";
82
+
author = "";
83
+
content = "";
84
+
quoted_text = "";
85
+
anchor = None;
86
+
resolved = false;
87
+
}
88
+
in
89
+
Alcotest.(check (option string))
90
+
"none" None
91
+
(Gslides.Comments.anchor_slide_id c)
92
+
93
+
let anchor_malformed () =
94
+
let c : Gslides.Comments.t =
95
+
{
96
+
id = "c";
97
+
author = "";
98
+
content = "";
99
+
quoted_text = "";
100
+
anchor = Some "not-json";
101
+
resolved = false;
102
+
}
103
+
in
104
+
Alcotest.(check (option string))
105
+
"none on bad json" None
106
+
(Gslides.Comments.anchor_slide_id c)
107
+
108
+
let anchor_no_page_id () =
109
+
let c : Gslides.Comments.t =
110
+
{
111
+
id = "c";
112
+
author = "";
113
+
content = "";
114
+
quoted_text = "";
115
+
anchor = Some {|{"r":"x","a":[{"otherField":"y"}]}|};
116
+
resolved = false;
117
+
}
118
+
in
119
+
Alcotest.(check (option string))
120
+
"none when missing" None
121
+
(Gslides.Comments.anchor_slide_id c)
122
+
123
+
let scope_is_drive_readonly () =
124
+
Alcotest.(check string)
125
+
"drive.readonly" "https://www.googleapis.com/auth/drive.readonly"
126
+
Gslides.Comments.scope
127
+
128
+
let suite =
129
+
( "comments",
130
+
[
131
+
Alcotest.test_case "basic parse" `Quick basic_parse;
132
+
Alcotest.test_case "empty comments" `Quick empty_comments;
133
+
Alcotest.test_case "missing author -> empty" `Quick missing_author;
134
+
Alcotest.test_case "pp includes author and content" `Quick
135
+
pp_includes_author_and_content;
136
+
Alcotest.test_case "pp unknown author" `Quick pp_unknown_author;
137
+
Alcotest.test_case "anchor extracts pageObjectId" `Quick
138
+
anchor_extracts_page_id;
139
+
Alcotest.test_case "anchor missing -> None" `Quick anchor_missing;
140
+
Alcotest.test_case "anchor malformed -> None" `Quick anchor_malformed;
141
+
Alcotest.test_case "anchor without pageObjectId -> None" `Quick
142
+
anchor_no_page_id;
143
+
Alcotest.test_case "scope is drive.readonly" `Quick
144
+
scope_is_drive_readonly;
145
+
] )
+1
test/test_comments.mli
+1
test/test_comments.mli
···
1
+
val suite : string * unit Alcotest.test_case list
+50
test/test_gslides.ml
+50
test/test_gslides.ml
···
1
+
let scope_readonly_path () =
2
+
Alcotest.(check string)
3
+
"readonly scope" "https://www.googleapis.com/auth/presentations.readonly"
4
+
Gslides.scope_readonly
5
+
6
+
let scope_readwrite_path () =
7
+
Alcotest.(check string)
8
+
"readwrite scope" "https://www.googleapis.com/auth/presentations"
9
+
Gslides.scope_readwrite
10
+
11
+
let scopes_distinct () =
12
+
Alcotest.(check bool)
13
+
"distinct" true
14
+
(Gslides.scope_readonly <> Gslides.scope_readwrite)
15
+
16
+
let truncate_short () =
17
+
Alcotest.(check string) "passthrough" "hi" (Gslides.truncate_body "hi")
18
+
19
+
let truncate_long () =
20
+
let s = String.make 1000 'x' in
21
+
let out = Gslides.truncate_body s in
22
+
Alcotest.(check bool) "shorter" true (String.length out < 1000);
23
+
let n = String.length out in
24
+
let needle = "truncated" in
25
+
let k = String.length needle in
26
+
let rec scan i =
27
+
if i + k > n then false
28
+
else if String.sub out i k = needle then true
29
+
else scan (i + 1)
30
+
in
31
+
Alcotest.(check bool) "mentions truncated" true (scan 0)
32
+
33
+
let module_aliases () =
34
+
let _ : string -> _ = Gslides.Presentation.of_json_string in
35
+
let _ : Gslides.Presentation.t -> string = Gslides.Marp.of_presentation in
36
+
let _ : Gslides.Presentation.t -> string = Gslides.Typst.of_presentation in
37
+
let _ : string -> _ = Gslides.Comments.of_json_string in
38
+
let _ : _ Eio.Path.t -> _ = Gslides.Store.client_path in
39
+
Alcotest.(check pass) "all aliases compile" () ()
40
+
41
+
let suite =
42
+
( "gslides",
43
+
[
44
+
Alcotest.test_case "readonly scope" `Quick scope_readonly_path;
45
+
Alcotest.test_case "readwrite scope" `Quick scope_readwrite_path;
46
+
Alcotest.test_case "scopes distinct" `Quick scopes_distinct;
47
+
Alcotest.test_case "truncate short" `Quick truncate_short;
48
+
Alcotest.test_case "truncate long" `Quick truncate_long;
49
+
Alcotest.test_case "module aliases resolve" `Quick module_aliases;
50
+
] )
+1
test/test_gslides.mli
+1
test/test_gslides.mli
···
1
+
val suite : string * unit Alcotest.test_case list
+293
test/test_marp.ml
+293
test/test_marp.ml
···
1
+
let parse body =
2
+
match Gslides.Presentation.of_json_string body with
3
+
| Ok p -> p
4
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
5
+
6
+
let contains ~sub s =
7
+
let sub_len = String.length sub in
8
+
let s_len = String.length s in
9
+
let rec loop i =
10
+
if i + sub_len > s_len then false
11
+
else if String.sub s i sub_len = sub then true
12
+
else loop (i + 1)
13
+
in
14
+
loop 0
15
+
16
+
let render body = Gslides.Marp.of_presentation (parse body)
17
+
18
+
let render_with_comments comments body =
19
+
Gslides.Marp.of_presentation ~comments (parse body)
20
+
21
+
let frontmatter_present () =
22
+
let out = render {|{"presentationId":"x","title":"Hello","slides":[]}|} in
23
+
Alcotest.(check bool) "marp directive" true (contains ~sub:"marp: true" out);
24
+
Alcotest.(check bool)
25
+
"title in frontmatter" true
26
+
(contains ~sub:"title: Hello" out)
27
+
28
+
let title_becomes_h1 () =
29
+
let out =
30
+
render
31
+
{|{"presentationId":"x","title":"D","slides":[
32
+
{"objectId":"S","pageElements":[
33
+
{"objectId":"T","shape":{"placeholder":{"type":"TITLE"},
34
+
"text":{"textElements":[
35
+
{"paragraphMarker":{"style":{}}},
36
+
{"textRun":{"content":"My Title\n","style":{}}}]}}}]}]}|}
37
+
in
38
+
Alcotest.(check bool) "# heading" true (contains ~sub:"# My Title" out)
39
+
40
+
let body_paragraph_rendered () =
41
+
let out =
42
+
render
43
+
{|{"presentationId":"x","slides":[
44
+
{"objectId":"S","pageElements":[
45
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
46
+
"text":{"textElements":[
47
+
{"paragraphMarker":{"style":{}}},
48
+
{"textRun":{"content":"plain body\n","style":{}}}]}}}]}]}|}
49
+
in
50
+
Alcotest.(check bool) "body text" true (contains ~sub:"plain body" out)
51
+
52
+
let bold_renders_with_stars () =
53
+
let out =
54
+
render
55
+
{|{"presentationId":"x","slides":[
56
+
{"objectId":"S","pageElements":[
57
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
58
+
"text":{"textElements":[
59
+
{"paragraphMarker":{"style":{}}},
60
+
{"textRun":{"content":"hi","style":{"bold":true}}}]}}}]}]}|}
61
+
in
62
+
Alcotest.(check bool) "**hi**" true (contains ~sub:"**hi**" out)
63
+
64
+
let italic_renders_with_one_star () =
65
+
let out =
66
+
render
67
+
{|{"presentationId":"x","slides":[
68
+
{"objectId":"S","pageElements":[
69
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
70
+
"text":{"textElements":[
71
+
{"paragraphMarker":{"style":{}}},
72
+
{"textRun":{"content":"hi","style":{"italic":true}}}]}}}]}]}|}
73
+
in
74
+
Alcotest.(check bool) "*hi*" true (contains ~sub:"*hi*" out)
75
+
76
+
let strike_renders_with_tildes () =
77
+
let out =
78
+
render
79
+
{|{"presentationId":"x","slides":[
80
+
{"objectId":"S","pageElements":[
81
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
82
+
"text":{"textElements":[
83
+
{"paragraphMarker":{"style":{}}},
84
+
{"textRun":{"content":"hi","style":{"strikethrough":true}}}]}}}]}]}|}
85
+
in
86
+
Alcotest.(check bool) "~~hi~~" true (contains ~sub:"~~hi~~" out)
87
+
88
+
let underline_uses_html () =
89
+
let out =
90
+
render
91
+
{|{"presentationId":"x","slides":[
92
+
{"objectId":"S","pageElements":[
93
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
94
+
"text":{"textElements":[
95
+
{"paragraphMarker":{"style":{}}},
96
+
{"textRun":{"content":"hi","style":{"underline":true}}}]}}}]}]}|}
97
+
in
98
+
Alcotest.(check bool) "<u>hi</u>" true (contains ~sub:"<u>hi</u>" out)
99
+
100
+
let link_renders () =
101
+
let out =
102
+
render
103
+
{|{"presentationId":"x","slides":[
104
+
{"objectId":"S","pageElements":[
105
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
106
+
"text":{"textElements":[
107
+
{"paragraphMarker":{"style":{}}},
108
+
{"textRun":{"content":"go","style":{"link":{"url":"https://x"}}}}]}}}]}]}|}
109
+
in
110
+
Alcotest.(check bool)
111
+
"[go](https://x)" true
112
+
(contains ~sub:"[go](https://x)" out)
113
+
114
+
let bullets_render () =
115
+
let out =
116
+
render
117
+
{|{"presentationId":"x","slides":[
118
+
{"objectId":"S","pageElements":[
119
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
120
+
"text":{"textElements":[
121
+
{"paragraphMarker":{"style":{},"bullet":{"nestingLevel":0,"glyph":"●"}}},
122
+
{"textRun":{"content":"first\n","style":{}}},
123
+
{"paragraphMarker":{"style":{},"bullet":{"nestingLevel":0,"glyph":"●"}}},
124
+
{"textRun":{"content":"second\n","style":{}}}]}}}]}]}|}
125
+
in
126
+
Alcotest.(check bool) "- first" true (contains ~sub:"- first" out);
127
+
Alcotest.(check bool) "- second" true (contains ~sub:"- second" out)
128
+
129
+
let numbered_bullets () =
130
+
let out =
131
+
render
132
+
{|{"presentationId":"x","slides":[
133
+
{"objectId":"S","pageElements":[
134
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
135
+
"text":{"textElements":[
136
+
{"paragraphMarker":{"style":{},"bullet":{"nestingLevel":0,"glyph":"1."}}},
137
+
{"textRun":{"content":"item\n","style":{}}}]}}}]}]}|}
138
+
in
139
+
Alcotest.(check bool) "1. item" true (contains ~sub:"1. item" out)
140
+
141
+
let nested_bullets () =
142
+
let out =
143
+
render
144
+
{|{"presentationId":"x","slides":[
145
+
{"objectId":"S","pageElements":[
146
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
147
+
"text":{"textElements":[
148
+
{"paragraphMarker":{"style":{},"bullet":{"nestingLevel":2,"glyph":"●"}}},
149
+
{"textRun":{"content":"deep\n","style":{}}}]}}}]}]}|}
150
+
in
151
+
Alcotest.(check bool) " - deep" true (contains ~sub:" - deep" out)
152
+
153
+
let slides_separated_by_hr () =
154
+
let out =
155
+
render
156
+
{|{"presentationId":"x","slides":[
157
+
{"objectId":"A","pageElements":[]},
158
+
{"objectId":"B","pageElements":[]}]}|}
159
+
in
160
+
(* Expect at least one [---] separator between the two slide sections,
161
+
beyond the one in the frontmatter close. *)
162
+
let count = ref 0 in
163
+
String.iter (fun _ -> ()) out;
164
+
let n = String.length out in
165
+
for i = 0 to n - 3 do
166
+
if String.sub out i 3 = "---" then incr count
167
+
done;
168
+
Alcotest.(check bool)
169
+
"at least 3 (front start + close + slide sep)" true (!count >= 3)
170
+
171
+
let speaker_notes_emitted () =
172
+
let out =
173
+
render
174
+
{|{"presentationId":"x","slides":[
175
+
{"objectId":"S",
176
+
"slideProperties":{"notesPage":{"pageElements":[
177
+
{"objectId":"N","shape":{"text":{"textElements":[
178
+
{"paragraphMarker":{"style":{}}},
179
+
{"textRun":{"content":"speaker note\n","style":{}}}]}}}]}},
180
+
"pageElements":[]}]}|}
181
+
in
182
+
Alcotest.(check bool) "_notes pragma" true (contains ~sub:"<!-- _notes:" out);
183
+
Alcotest.(check bool) "note text" true (contains ~sub:"speaker note" out)
184
+
185
+
let skipped_slide_pragma () =
186
+
let out =
187
+
render
188
+
{|{"presentationId":"x","slides":[
189
+
{"objectId":"S","slideProperties":{"isSkipped":true},
190
+
"pageElements":[]}]}|}
191
+
in
192
+
Alcotest.(check bool) "_hide pragma" true (contains ~sub:"_hide: true" out)
193
+
194
+
let image_emitted () =
195
+
let out =
196
+
render
197
+
{|{"presentationId":"x","slides":[
198
+
{"objectId":"S","pageElements":[
199
+
{"objectId":"I","title":"Logo",
200
+
"image":{"contentUrl":"https://x/img.png"}}]}]}|}
201
+
in
202
+
Alcotest.(check bool)
203
+
"image alt+url" true
204
+
(contains ~sub:"" out)
205
+
206
+
let unknown_kind_becomes_html_comment () =
207
+
let out =
208
+
render
209
+
{|{"presentationId":"x","slides":[
210
+
{"objectId":"S","pageElements":[
211
+
{"objectId":"V","video":{"url":"https://y/v"}}]}]}|}
212
+
in
213
+
Alcotest.(check bool)
214
+
"video placeholder" true
215
+
(contains ~sub:"<!-- [video] -->" out)
216
+
217
+
(* Comments rendering ------------------------------------------------- *)
218
+
219
+
let comments_present () =
220
+
let body =
221
+
{|{"presentationId":"P","slides":[
222
+
{"objectId":"S1","pageElements":[
223
+
{"objectId":"T","shape":{"placeholder":{"type":"TITLE"},
224
+
"text":{"textElements":[
225
+
{"paragraphMarker":{"style":{}}},
226
+
{"textRun":{"content":"Title\n","style":{}}}]}}}]}]}|}
227
+
in
228
+
let comments : Gslides.Comments.t list =
229
+
[
230
+
{
231
+
id = "c1";
232
+
author = "Reviewer";
233
+
content = "looks good";
234
+
quoted_text = "";
235
+
anchor = Some {|{"a":[{"pageObjectId":"S1"}]}|};
236
+
resolved = false;
237
+
};
238
+
]
239
+
in
240
+
let out = render_with_comments comments body in
241
+
Alcotest.(check bool) "footnote ref" true (contains ~sub:"[^slc1]" out);
242
+
Alcotest.(check bool)
243
+
"footnote def" true
244
+
(contains ~sub:"[^slc1]: **Reviewer**: looks good" out)
245
+
246
+
let unanchored_comment_in_section () =
247
+
let body =
248
+
{|{"presentationId":"P","slides":[
249
+
{"objectId":"S1","pageElements":[]}]}|}
250
+
in
251
+
let comments : Gslides.Comments.t list =
252
+
[
253
+
{
254
+
id = "c1";
255
+
author = "Bob";
256
+
content = "general remark";
257
+
quoted_text = "";
258
+
anchor = None;
259
+
resolved = false;
260
+
};
261
+
]
262
+
in
263
+
let out = render_with_comments comments body in
264
+
Alcotest.(check bool)
265
+
"Comments section" true
266
+
(contains ~sub:"## Comments" out);
267
+
Alcotest.(check bool) "Bob remark" true (contains ~sub:"general remark" out)
268
+
269
+
let suite =
270
+
( "marp",
271
+
[
272
+
Alcotest.test_case "frontmatter present" `Quick frontmatter_present;
273
+
Alcotest.test_case "title -> h1" `Quick title_becomes_h1;
274
+
Alcotest.test_case "body paragraph rendered" `Quick
275
+
body_paragraph_rendered;
276
+
Alcotest.test_case "bold -> **" `Quick bold_renders_with_stars;
277
+
Alcotest.test_case "italic -> *" `Quick italic_renders_with_one_star;
278
+
Alcotest.test_case "strike -> ~~" `Quick strike_renders_with_tildes;
279
+
Alcotest.test_case "underline -> <u>" `Quick underline_uses_html;
280
+
Alcotest.test_case "link -> [text](url)" `Quick link_renders;
281
+
Alcotest.test_case "bullets" `Quick bullets_render;
282
+
Alcotest.test_case "numbered bullets" `Quick numbered_bullets;
283
+
Alcotest.test_case "nested bullets indent" `Quick nested_bullets;
284
+
Alcotest.test_case "slides separated by ---" `Quick slides_separated_by_hr;
285
+
Alcotest.test_case "speaker notes" `Quick speaker_notes_emitted;
286
+
Alcotest.test_case "_hide for skipped" `Quick skipped_slide_pragma;
287
+
Alcotest.test_case "image alt + url" `Quick image_emitted;
288
+
Alcotest.test_case "video -> placeholder comment" `Quick
289
+
unknown_kind_becomes_html_comment;
290
+
Alcotest.test_case "anchored comment as footnote" `Quick comments_present;
291
+
Alcotest.test_case "unanchored comment in trailing section" `Quick
292
+
unanchored_comment_in_section;
293
+
] )
+1
test/test_marp.mli
+1
test/test_marp.mli
···
1
+
val suite : string * unit Alcotest.test_case list
+180
test/test_presentation.ml
+180
test/test_presentation.ml
···
1
+
(* Fixture shapes follow
2
+
https://developers.google.com/slides/api/reference/rest/v1/presentations *)
3
+
4
+
let sample =
5
+
{|{
6
+
"presentationId": "1abc",
7
+
"title": "Quarterly Review",
8
+
"layouts": [
9
+
{"objectId": "L1",
10
+
"layoutProperties": {"name": "TITLE", "displayName": "Title slide"}},
11
+
{"objectId": "L2",
12
+
"layoutProperties": {"name": "TITLE_AND_BODY", "displayName": "Title and body"}}
13
+
],
14
+
"slides": [
15
+
{"objectId": "S1",
16
+
"slideProperties": {"layoutObjectId": "L1"},
17
+
"pageElements": [
18
+
{"objectId": "T1",
19
+
"shape": {
20
+
"placeholder": {"type": "TITLE"},
21
+
"text": {"textElements": [
22
+
{"paragraphMarker": {"style": {}}},
23
+
{"textRun": {"content": "Q3 Revenue\n", "style": {}}}
24
+
]}}}
25
+
]},
26
+
{"objectId": "S2",
27
+
"slideProperties": {"layoutObjectId": "L2",
28
+
"notesPage": {"pageElements": [
29
+
{"objectId": "N1", "shape": {"text": {"textElements": [
30
+
{"paragraphMarker": {"style": {}}},
31
+
{"textRun": {"content": "Mention Q3 acceleration\n", "style": {}}}
32
+
]}}}]}},
33
+
"pageElements": [
34
+
{"objectId": "T2",
35
+
"shape": {
36
+
"placeholder": {"type": "TITLE"},
37
+
"text": {"textElements": [
38
+
{"paragraphMarker": {"style": {}}},
39
+
{"textRun": {"content": "Highlights\n", "style": {}}}
40
+
]}}},
41
+
{"objectId": "B1",
42
+
"shape": {
43
+
"placeholder": {"type": "BODY"},
44
+
"text": {"textElements": [
45
+
{"paragraphMarker": {"style": {},
46
+
"bullet": {"nestingLevel": 0, "glyph": "●"}}},
47
+
{"textRun": {"content": "$1.2M revenue\n", "style": {}}},
48
+
{"paragraphMarker": {"style": {},
49
+
"bullet": {"nestingLevel": 0, "glyph": "●"}}},
50
+
{"textRun": {"content": "15% QoQ\n", "style": {}}}
51
+
]}}}
52
+
]}
53
+
]
54
+
}|}
55
+
56
+
let parse () =
57
+
match Gslides.Presentation.of_json_string sample with
58
+
| Ok p -> p
59
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
60
+
61
+
let id_basic () =
62
+
Alcotest.(check string) "id" "1abc" (Gslides.Presentation.id (parse ()))
63
+
64
+
let title_basic () =
65
+
Alcotest.(check string)
66
+
"title" "Quarterly Review"
67
+
(Gslides.Presentation.title (parse ()))
68
+
69
+
let to_json_preserves_body () =
70
+
Alcotest.(check string)
71
+
"raw body preserved" sample
72
+
(Gslides.Presentation.to_json (parse ()))
73
+
74
+
let two_slides () =
75
+
Alcotest.(check int)
76
+
"two slides" 2
77
+
(List.length (Gslides.Presentation.slides (parse ())))
78
+
79
+
let slide_object_ids () =
80
+
let p = parse () in
81
+
let ids =
82
+
List.map
83
+
(fun (s : Gslides.Slide.t) -> s.object_id)
84
+
(Gslides.Presentation.slides p)
85
+
in
86
+
Alcotest.(check (list string)) "ids" [ "S1"; "S2" ] ids
87
+
88
+
let slide_layout_resolved () =
89
+
let p = parse () in
90
+
let s2 = List.nth (Gslides.Presentation.slides p) 1 in
91
+
Alcotest.(check string) "layout name" "Title and body" s2.layout
92
+
93
+
let slide_title_extracted () =
94
+
let p = parse () in
95
+
let s1 = List.hd (Gslides.Presentation.slides p) in
96
+
Alcotest.(check string) "title text" "Q3 Revenue" (Gslides.Slide.title s1)
97
+
98
+
let slide_notes_parsed () =
99
+
let p = parse () in
100
+
let s2 = List.nth (Gslides.Presentation.slides p) 1 in
101
+
match s2.notes with
102
+
| [ n ] ->
103
+
Alcotest.(check string)
104
+
"notes text" "Mention Q3 acceleration"
105
+
(Gslides.Text.Paragraph.plain_text n)
106
+
| _ ->
107
+
Alcotest.failf "expected one notes paragraph, got %d"
108
+
(List.length s2.notes)
109
+
110
+
let body_bullets_present () =
111
+
let p = parse () in
112
+
let s2 = List.nth (Gslides.Presentation.slides p) 1 in
113
+
let body =
114
+
List.find_map
115
+
(fun (e : Gslides.Page_element.t) ->
116
+
match e.kind with
117
+
| Gslides.Page_element.Text { placeholder = Body; paragraphs } ->
118
+
Some paragraphs
119
+
| _ -> None)
120
+
s2.elements
121
+
in
122
+
match body with
123
+
| None -> Alcotest.fail "expected a body element"
124
+
| Some ps ->
125
+
Alcotest.(check int) "two bullets" 2 (List.length ps);
126
+
let p0 = List.hd ps in
127
+
Alcotest.(check (option int)) "bullet 0 level" (Some 0) p0.bullet
128
+
129
+
let no_slides_field () =
130
+
let body = {|{"presentationId":"x","title":"t"}|} in
131
+
match Gslides.Presentation.of_json_string body with
132
+
| Ok p ->
133
+
Alcotest.(check int)
134
+
"no slides" 0
135
+
(List.length (Gslides.Presentation.slides p))
136
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
137
+
138
+
let unknown_fields_ignored () =
139
+
let body =
140
+
{|{"presentationId":"x","title":"t","slides":[],
141
+
"masters":[],"notesMaster":{},"locale":"en","revisionId":"abc"}|}
142
+
in
143
+
match Gslides.Presentation.of_json_string body with
144
+
| Error (`Msg m) -> Alcotest.failf "rejected: %s" m
145
+
| Ok _ -> ()
146
+
147
+
let rejects_junk () =
148
+
match Gslides.Presentation.of_json_string "not json" with
149
+
| Ok _ -> Alcotest.fail "expected Error"
150
+
| Error _ -> ()
151
+
152
+
let skipped_slide () =
153
+
let body =
154
+
{|{"presentationId":"x","slides":[
155
+
{"objectId":"S","slideProperties":{"isSkipped":true},
156
+
"pageElements":[]}]}|}
157
+
in
158
+
match Gslides.Presentation.of_json_string body with
159
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
160
+
| Ok p ->
161
+
let s = List.hd (Gslides.Presentation.slides p) in
162
+
Alcotest.(check bool) "skipped" true s.skipped
163
+
164
+
let suite =
165
+
( "presentation",
166
+
[
167
+
Alcotest.test_case "id" `Quick id_basic;
168
+
Alcotest.test_case "title" `Quick title_basic;
169
+
Alcotest.test_case "to_json preserves body" `Quick to_json_preserves_body;
170
+
Alcotest.test_case "two slides" `Quick two_slides;
171
+
Alcotest.test_case "slide object ids" `Quick slide_object_ids;
172
+
Alcotest.test_case "slide layout resolved" `Quick slide_layout_resolved;
173
+
Alcotest.test_case "slide title extracted" `Quick slide_title_extracted;
174
+
Alcotest.test_case "slide notes parsed" `Quick slide_notes_parsed;
175
+
Alcotest.test_case "body bullets present" `Quick body_bullets_present;
176
+
Alcotest.test_case "no slides field -> empty" `Quick no_slides_field;
177
+
Alcotest.test_case "unknown fields ignored" `Quick unknown_fields_ignored;
178
+
Alcotest.test_case "rejects junk" `Quick rejects_junk;
179
+
Alcotest.test_case "skipped slide" `Quick skipped_slide;
180
+
] )
+1
test/test_presentation.mli
+1
test/test_presentation.mli
···
1
+
val suite : string * unit Alcotest.test_case list
+152
test/test_store.ml
+152
test/test_store.ml
···
1
+
(* Mirrors the gsheets store tests: redirect XDG_CONFIG_HOME into a per-test
2
+
temp dir for hermetic save/load. *)
3
+
4
+
let contains ~sub s =
5
+
let sub_len = String.length sub in
6
+
let s_len = String.length s in
7
+
let rec loop i =
8
+
if i + sub_len > s_len then false
9
+
else if String.sub s i sub_len = sub then true
10
+
else loop (i + 1)
11
+
in
12
+
loop 0
13
+
14
+
let rec rm_rf path =
15
+
match Unix.lstat path with
16
+
| { st_kind = S_DIR; _ } -> (
17
+
let entries = try Sys.readdir path with Sys_error _ -> [||] in
18
+
Array.iter (fun e -> rm_rf (Filename.concat path e)) entries;
19
+
try Unix.rmdir path with Unix.Unix_error _ -> ())
20
+
| _ -> ( try Unix.unlink path with Unix.Unix_error _ -> ())
21
+
| exception _ -> ()
22
+
23
+
let fresh_tmp () =
24
+
let root = Filename.get_temp_dir_name () in
25
+
let unique =
26
+
Fmt.str "gslides-test-%d-%d" (Unix.getpid ()) (int_of_float (Unix.time ()))
27
+
in
28
+
let path = Filename.concat root unique in
29
+
Unix.mkdir path 0o700;
30
+
path
31
+
32
+
let restore_env prev =
33
+
match prev with
34
+
| Some v -> Unix.putenv "XDG_CONFIG_HOME" v
35
+
| None -> Unix.putenv "XDG_CONFIG_HOME" ""
36
+
37
+
let with_tmp_env f =
38
+
Eio_main.run @@ fun env ->
39
+
Eio.Switch.run @@ fun sw ->
40
+
let fs = Eio.Stdenv.fs env in
41
+
let http = Requests.v ~sw env in
42
+
let clock = Eio.Stdenv.clock env in
43
+
let tmp = fresh_tmp () in
44
+
let prev = Sys.getenv_opt "XDG_CONFIG_HOME" in
45
+
Unix.putenv "XDG_CONFIG_HOME" tmp;
46
+
let cleanup () =
47
+
restore_env prev;
48
+
rm_rf tmp
49
+
in
50
+
Fun.protect ~finally:cleanup (fun () -> f ~fs ~http ~clock)
51
+
52
+
let sample : Gslides.Store.client =
53
+
{ client_id = "123.apps.googleusercontent.com"; client_secret = "sek-REt" }
54
+
55
+
let save_load_roundtrip () =
56
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
57
+
Gslides.Store.save_client fs sample;
58
+
match Gslides.Store.load_client fs with
59
+
| None -> Alcotest.fail "expected Some client after save"
60
+
| Some c ->
61
+
Alcotest.(check string) "client_id" sample.client_id c.client_id;
62
+
Alcotest.(check string)
63
+
"client_secret" sample.client_secret c.client_secret
64
+
65
+
let load_absent_returns_none () =
66
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
67
+
Alcotest.(check bool)
68
+
"no client file" true
69
+
(Option.is_none (Gslides.Store.load_client fs))
70
+
71
+
let client_file_permissions () =
72
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
73
+
Gslides.Store.save_client fs sample;
74
+
let path = Gslides.Store.client_path fs in
75
+
let st = Unix.stat (snd path) in
76
+
Alcotest.(check int) "client file is 0600" 0o600 (st.st_perm land 0o777)
77
+
78
+
let token_save_load () =
79
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
80
+
let body = {|{"access_token":"A","refresh_token":"R","expires_at":1.0}|} in
81
+
Gslides.Store.save_token fs body;
82
+
match Gslides.Store.load_token fs with
83
+
| Some s -> Alcotest.(check string) "token body preserved" body s
84
+
| None -> Alcotest.fail "expected Some token"
85
+
86
+
let acquire_without_client () =
87
+
with_tmp_env @@ fun ~fs ~http ~clock ->
88
+
match Gslides.Store.acquire http ~clock ~fs with
89
+
| Error (`Msg m) ->
90
+
Alcotest.(check bool)
91
+
"error mentions install" true
92
+
(contains ~sub:"install" m)
93
+
| Ok _ -> Alcotest.fail "expected Error when no client"
94
+
95
+
let acquire_without_token () =
96
+
with_tmp_env @@ fun ~fs ~http ~clock ->
97
+
Gslides.Store.save_client fs sample;
98
+
match Gslides.Store.acquire http ~clock ~fs with
99
+
| Error (`Msg m) ->
100
+
Alcotest.(check bool)
101
+
"error mentions login" true (contains ~sub:"login" m)
102
+
| Ok _ -> Alcotest.fail "expected Error when no token"
103
+
104
+
let acquire_ok () =
105
+
with_tmp_env @@ fun ~fs ~http ~clock ->
106
+
Gslides.Store.save_client fs sample;
107
+
let future = Eio.Time.now clock +. 3600. in
108
+
Gslides.Store.save_token fs
109
+
(Fmt.str {|{"access_token":"ACCESS","refresh_token":"R","expires_at":%f}|}
110
+
future);
111
+
match Gslides.Store.acquire http ~clock ~fs with
112
+
| Error (`Msg m) -> Alcotest.failf "acquire failed: %s" m
113
+
| Ok t -> (
114
+
match Gauth.try_access t with
115
+
| Ok s -> Alcotest.(check string) "access_token" "ACCESS" s
116
+
| Error (`Msg m) -> Alcotest.failf "try_access: %s" m)
117
+
118
+
let save_over_wider_mode_file () =
119
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
120
+
Gslides.Store.save_client fs sample;
121
+
let path = snd (Gslides.Store.client_path fs) in
122
+
Unix.chmod path 0o644;
123
+
Gslides.Store.save_client fs sample;
124
+
let st = Unix.stat path in
125
+
Alcotest.(check int) "rewrite tightens to 0600" 0o600 (st.st_perm land 0o777)
126
+
127
+
let config_dir_app_named () =
128
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
129
+
let cp = snd (Gslides.Store.client_path fs) in
130
+
Alcotest.(check bool)
131
+
"path includes 'gslides'" true
132
+
(contains ~sub:"gslides" cp)
133
+
134
+
let suite =
135
+
( "store",
136
+
[
137
+
Alcotest.test_case "client save/load roundtrip" `Quick save_load_roundtrip;
138
+
Alcotest.test_case "load_client absent -> None" `Quick
139
+
load_absent_returns_none;
140
+
Alcotest.test_case "client file is 0600" `Quick client_file_permissions;
141
+
Alcotest.test_case "token save/load roundtrip" `Quick token_save_load;
142
+
Alcotest.test_case "acquire without client errors" `Quick
143
+
acquire_without_client;
144
+
Alcotest.test_case "acquire without token errors" `Quick
145
+
acquire_without_token;
146
+
Alcotest.test_case "acquire with client+token returns token" `Quick
147
+
acquire_ok;
148
+
Alcotest.test_case "rewrite over 0644 yields 0600" `Quick
149
+
save_over_wider_mode_file;
150
+
Alcotest.test_case "config dir contains 'gslides'" `Quick
151
+
config_dir_app_named;
152
+
] )
+1
test/test_store.mli
+1
test/test_store.mli
···
1
+
val suite : string * unit Alcotest.test_case list
+226
test/test_text.ml
+226
test/test_text.ml
···
1
+
(* Fixture shapes follow
2
+
https://developers.google.com/slides/api/reference/rest/v1/presentations.pages.elements#TextContent *)
3
+
4
+
let parse body =
5
+
match Json.Value.of_string body with
6
+
| Ok j -> j
7
+
| Error e -> Alcotest.failf "json: %s" (Json.Error.to_string e)
8
+
9
+
let single_paragraph () =
10
+
let json =
11
+
parse
12
+
{|{"textElements":[
13
+
{"paragraphMarker":{"style":{}}},
14
+
{"textRun":{"content":"Hello world\n","style":{}}}
15
+
]}|}
16
+
in
17
+
let ps = Gslides.Text.of_text_content json in
18
+
Alcotest.(check int) "one paragraph" 1 (List.length ps);
19
+
let p = List.hd ps in
20
+
Alcotest.(check string)
21
+
"plain text" "Hello world"
22
+
(Gslides.Text.Paragraph.plain_text p)
23
+
24
+
let trailing_newline_stripped () =
25
+
let json =
26
+
parse
27
+
{|{"textElements":[
28
+
{"paragraphMarker":{"style":{}}},
29
+
{"textRun":{"content":"line\n","style":{}}}
30
+
]}|}
31
+
in
32
+
let ps = Gslides.Text.of_text_content json in
33
+
let p = List.hd ps in
34
+
Alcotest.(check string)
35
+
"no trailing newline" "line"
36
+
(Gslides.Text.Paragraph.plain_text p)
37
+
38
+
let multiple_paragraphs () =
39
+
let json =
40
+
parse
41
+
{|{"textElements":[
42
+
{"paragraphMarker":{"style":{}}},
43
+
{"textRun":{"content":"first\n","style":{}}},
44
+
{"paragraphMarker":{"style":{}}},
45
+
{"textRun":{"content":"second\n","style":{}}}
46
+
]}|}
47
+
in
48
+
let ps = Gslides.Text.of_text_content json in
49
+
Alcotest.(check int) "two paragraphs" 2 (List.length ps);
50
+
Alcotest.(check string)
51
+
"first" "first"
52
+
(Gslides.Text.Paragraph.plain_text (List.nth ps 0));
53
+
Alcotest.(check string)
54
+
"second" "second"
55
+
(Gslides.Text.Paragraph.plain_text (List.nth ps 1))
56
+
57
+
let bold_run () =
58
+
let json =
59
+
parse
60
+
{|{"textElements":[
61
+
{"paragraphMarker":{"style":{}}},
62
+
{"textRun":{"content":"hi","style":{"bold":true}}}
63
+
]}|}
64
+
in
65
+
let p = List.hd (Gslides.Text.of_text_content json) in
66
+
match p.runs with
67
+
| [ r ] ->
68
+
Alcotest.(check bool) "bold" true r.style.bold;
69
+
Alcotest.(check bool) "italic" false r.style.italic
70
+
| _ -> Alcotest.fail "expected one run"
71
+
72
+
let italic_run () =
73
+
let json =
74
+
parse
75
+
{|{"textElements":[
76
+
{"paragraphMarker":{"style":{}}},
77
+
{"textRun":{"content":"hi","style":{"italic":true}}}
78
+
]}|}
79
+
in
80
+
let p = List.hd (Gslides.Text.of_text_content json) in
81
+
let r = List.hd p.runs in
82
+
Alcotest.(check bool) "italic" true r.style.italic
83
+
84
+
let strikethrough_run () =
85
+
let json =
86
+
parse
87
+
{|{"textElements":[
88
+
{"paragraphMarker":{"style":{}}},
89
+
{"textRun":{"content":"hi","style":{"strikethrough":true}}}
90
+
]}|}
91
+
in
92
+
let p = List.hd (Gslides.Text.of_text_content json) in
93
+
let r = List.hd p.runs in
94
+
Alcotest.(check bool) "strikethrough" true r.style.strikethrough
95
+
96
+
let link_run () =
97
+
let json =
98
+
parse
99
+
{|{"textElements":[
100
+
{"paragraphMarker":{"style":{}}},
101
+
{"textRun":{"content":"go","style":{"link":{"url":"https://x"}}}}
102
+
]}|}
103
+
in
104
+
let p = List.hd (Gslides.Text.of_text_content json) in
105
+
let r = List.hd p.runs in
106
+
Alcotest.(check (option string)) "link" (Some "https://x") r.style.link
107
+
108
+
let color_run () =
109
+
(* foregroundColor.opaqueColor.rgbColor.{red,green,blue} are 0..1 floats. *)
110
+
let json =
111
+
parse
112
+
{|{"textElements":[
113
+
{"paragraphMarker":{"style":{}}},
114
+
{"textRun":{"content":"red","style":{
115
+
"foregroundColor":{"opaqueColor":{
116
+
"rgbColor":{"red":1.0,"green":0.0,"blue":0.0}}}}}}
117
+
]}|}
118
+
in
119
+
let p = List.hd (Gslides.Text.of_text_content json) in
120
+
let r = List.hd p.runs in
121
+
Alcotest.(check (option string)) "red" (Some "#ff0000") r.style.color
122
+
123
+
let baseline_superscript () =
124
+
let json =
125
+
parse
126
+
{|{"textElements":[
127
+
{"paragraphMarker":{"style":{}}},
128
+
{"textRun":{"content":"x","style":{"baselineOffset":"SUPERSCRIPT"}}}
129
+
]}|}
130
+
in
131
+
let p = List.hd (Gslides.Text.of_text_content json) in
132
+
let r = List.hd p.runs in
133
+
match r.style.baseline with
134
+
| Gslides.Text.Style.Superscript -> ()
135
+
| _ -> Alcotest.fail "expected Superscript"
136
+
137
+
let monospace_detected () =
138
+
let json =
139
+
parse
140
+
{|{"textElements":[
141
+
{"paragraphMarker":{"style":{}}},
142
+
{"textRun":{"content":"code","style":{"fontFamily":"Roboto Mono"}}}
143
+
]}|}
144
+
in
145
+
let p = List.hd (Gslides.Text.of_text_content json) in
146
+
let r = List.hd p.runs in
147
+
Alcotest.(check bool) "monospace" true r.style.monospace
148
+
149
+
let monospace_not_detected_on_proportional () =
150
+
let json =
151
+
parse
152
+
{|{"textElements":[
153
+
{"paragraphMarker":{"style":{}}},
154
+
{"textRun":{"content":"x","style":{"fontFamily":"Arial"}}}
155
+
]}|}
156
+
in
157
+
let p = List.hd (Gslides.Text.of_text_content json) in
158
+
let r = List.hd p.runs in
159
+
Alcotest.(check bool) "not monospace" false r.style.monospace
160
+
161
+
let bullet_nesting () =
162
+
let json =
163
+
parse
164
+
{|{"textElements":[
165
+
{"paragraphMarker":{"style":{},
166
+
"bullet":{"nestingLevel":2,"glyph":"●"}}},
167
+
{"textRun":{"content":"deep\n","style":{}}}
168
+
]}|}
169
+
in
170
+
let p = List.hd (Gslides.Text.of_text_content json) in
171
+
Alcotest.(check (option int)) "nesting 2" (Some 2) p.bullet;
172
+
Alcotest.(check bool) "not numbered" false p.numbered
173
+
174
+
let bullet_numbered () =
175
+
let json =
176
+
parse
177
+
{|{"textElements":[
178
+
{"paragraphMarker":{"style":{},
179
+
"bullet":{"nestingLevel":0,"glyph":"1."}}},
180
+
{"textRun":{"content":"first\n","style":{}}}
181
+
]}|}
182
+
in
183
+
let p = List.hd (Gslides.Text.of_text_content json) in
184
+
Alcotest.(check bool) "numbered" true p.numbered
185
+
186
+
let alignment_center () =
187
+
let json =
188
+
parse
189
+
{|{"textElements":[
190
+
{"paragraphMarker":{"style":{"alignment":"CENTER"}}},
191
+
{"textRun":{"content":"x","style":{}}}
192
+
]}|}
193
+
in
194
+
let p = List.hd (Gslides.Text.of_text_content json) in
195
+
match p.alignment with
196
+
| Gslides.Text.Paragraph.Center -> ()
197
+
| _ -> Alcotest.fail "expected Center"
198
+
199
+
let empty_text_content () =
200
+
let json = parse "{}" in
201
+
Alcotest.(check int)
202
+
"no paragraphs" 0
203
+
(List.length (Gslides.Text.of_text_content json))
204
+
205
+
let suite =
206
+
( "text",
207
+
[
208
+
Alcotest.test_case "single paragraph" `Quick single_paragraph;
209
+
Alcotest.test_case "trailing newline stripped" `Quick
210
+
trailing_newline_stripped;
211
+
Alcotest.test_case "multiple paragraphs" `Quick multiple_paragraphs;
212
+
Alcotest.test_case "bold run" `Quick bold_run;
213
+
Alcotest.test_case "italic run" `Quick italic_run;
214
+
Alcotest.test_case "strikethrough run" `Quick strikethrough_run;
215
+
Alcotest.test_case "link run" `Quick link_run;
216
+
Alcotest.test_case "color run" `Quick color_run;
217
+
Alcotest.test_case "baseline superscript" `Quick baseline_superscript;
218
+
Alcotest.test_case "monospace detected on Roboto Mono" `Quick
219
+
monospace_detected;
220
+
Alcotest.test_case "monospace not detected on Arial" `Quick
221
+
monospace_not_detected_on_proportional;
222
+
Alcotest.test_case "bullet nesting" `Quick bullet_nesting;
223
+
Alcotest.test_case "numbered bullet" `Quick bullet_numbered;
224
+
Alcotest.test_case "center alignment" `Quick alignment_center;
225
+
Alcotest.test_case "empty text content" `Quick empty_text_content;
226
+
] )
+1
test/test_text.mli
+1
test/test_text.mli
···
1
+
val suite : string * unit Alcotest.test_case list
+210
test/test_typst.ml
+210
test/test_typst.ml
···
1
+
let parse body =
2
+
match Gslides.Presentation.of_json_string body with
3
+
| Ok p -> p
4
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
5
+
6
+
let contains ~sub s =
7
+
let sub_len = String.length sub in
8
+
let s_len = String.length s in
9
+
let rec loop i =
10
+
if i + sub_len > s_len then false
11
+
else if String.sub s i sub_len = sub then true
12
+
else loop (i + 1)
13
+
in
14
+
loop 0
15
+
16
+
let render body = Gslides.Typst.of_presentation (parse body)
17
+
18
+
let render_with_comments comments body =
19
+
Gslides.Typst.of_presentation ~comments (parse body)
20
+
21
+
let polylux_pin_present () =
22
+
let v = Gslides.Typst.polylux_version in
23
+
let out = render {|{"presentationId":"x","title":"","slides":[]}|} in
24
+
let needle = Fmt.str "polylux:%s" v in
25
+
Alcotest.(check bool) "version-pinned import" true (contains ~sub:needle out)
26
+
27
+
let presentation_paper_set () =
28
+
let out = render {|{"presentationId":"x","slides":[]}|} in
29
+
Alcotest.(check bool)
30
+
"page paper" true
31
+
(contains ~sub:"presentation-16-9" out)
32
+
33
+
let title_slide_when_title_present () =
34
+
let out = render {|{"presentationId":"x","title":"D","slides":[]}|} in
35
+
Alcotest.(check bool)
36
+
"title-slide block" true
37
+
(contains ~sub:"#title-slide" out);
38
+
Alcotest.(check bool) "deck title" true (contains ~sub:"= D" out)
39
+
40
+
let slide_block () =
41
+
let out =
42
+
render
43
+
{|{"presentationId":"x","slides":[
44
+
{"objectId":"S","pageElements":[
45
+
{"objectId":"T","shape":{"placeholder":{"type":"TITLE"},
46
+
"text":{"textElements":[
47
+
{"paragraphMarker":{"style":{}}},
48
+
{"textRun":{"content":"Title\n","style":{}}}]}}}]}]}|}
49
+
in
50
+
Alcotest.(check bool) "#slide[" true (contains ~sub:"#slide[" out);
51
+
Alcotest.(check bool) "= Title in slide" true (contains ~sub:"= Title" out)
52
+
53
+
let bold_uses_strong () =
54
+
let out =
55
+
render
56
+
{|{"presentationId":"x","slides":[
57
+
{"objectId":"S","pageElements":[
58
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
59
+
"text":{"textElements":[
60
+
{"paragraphMarker":{"style":{}}},
61
+
{"textRun":{"content":"hi","style":{"bold":true}}}]}}}]}]}|}
62
+
in
63
+
Alcotest.(check bool) "#strong" true (contains ~sub:"#strong[hi]" out)
64
+
65
+
let italic_uses_emph () =
66
+
let out =
67
+
render
68
+
{|{"presentationId":"x","slides":[
69
+
{"objectId":"S","pageElements":[
70
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
71
+
"text":{"textElements":[
72
+
{"paragraphMarker":{"style":{}}},
73
+
{"textRun":{"content":"hi","style":{"italic":true}}}]}}}]}]}|}
74
+
in
75
+
Alcotest.(check bool) "#emph" true (contains ~sub:"#emph[hi]" out)
76
+
77
+
let strike_uses_strike () =
78
+
let out =
79
+
render
80
+
{|{"presentationId":"x","slides":[
81
+
{"objectId":"S","pageElements":[
82
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
83
+
"text":{"textElements":[
84
+
{"paragraphMarker":{"style":{}}},
85
+
{"textRun":{"content":"hi","style":{"strikethrough":true}}}]}}}]}]}|}
86
+
in
87
+
Alcotest.(check bool) "#strike" true (contains ~sub:"#strike[hi]" out)
88
+
89
+
let underline_uses_underline () =
90
+
let out =
91
+
render
92
+
{|{"presentationId":"x","slides":[
93
+
{"objectId":"S","pageElements":[
94
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
95
+
"text":{"textElements":[
96
+
{"paragraphMarker":{"style":{}}},
97
+
{"textRun":{"content":"hi","style":{"underline":true}}}]}}}]}]}|}
98
+
in
99
+
Alcotest.(check bool) "#underline" true (contains ~sub:"#underline[hi]" out)
100
+
101
+
let link_uses_link () =
102
+
let out =
103
+
render
104
+
{|{"presentationId":"x","slides":[
105
+
{"objectId":"S","pageElements":[
106
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
107
+
"text":{"textElements":[
108
+
{"paragraphMarker":{"style":{}}},
109
+
{"textRun":{"content":"go","style":{"link":{"url":"https://x"}}}}]}}}]}]}|}
110
+
in
111
+
Alcotest.(check bool)
112
+
"#link" true
113
+
(contains ~sub:"#link(\"https://x\")[go]" out)
114
+
115
+
let bullets_native () =
116
+
let out =
117
+
render
118
+
{|{"presentationId":"x","slides":[
119
+
{"objectId":"S","pageElements":[
120
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
121
+
"text":{"textElements":[
122
+
{"paragraphMarker":{"style":{},"bullet":{"nestingLevel":0,"glyph":"●"}}},
123
+
{"textRun":{"content":"item\n","style":{}}}]}}}]}]}|}
124
+
in
125
+
Alcotest.(check bool) "- item" true (contains ~sub:"- item" out)
126
+
127
+
let numbered_native () =
128
+
let out =
129
+
render
130
+
{|{"presentationId":"x","slides":[
131
+
{"objectId":"S","pageElements":[
132
+
{"objectId":"B","shape":{"placeholder":{"type":"BODY"},
133
+
"text":{"textElements":[
134
+
{"paragraphMarker":{"style":{},"bullet":{"nestingLevel":0,"glyph":"1."}}},
135
+
{"textRun":{"content":"item\n","style":{}}}]}}}]}]}|}
136
+
in
137
+
Alcotest.(check bool) "+ item" true (contains ~sub:"+ item" out)
138
+
139
+
let speaker_note_block () =
140
+
let out =
141
+
render
142
+
{|{"presentationId":"x","slides":[
143
+
{"objectId":"S",
144
+
"slideProperties":{"notesPage":{"pageElements":[
145
+
{"objectId":"N","shape":{"text":{"textElements":[
146
+
{"paragraphMarker":{"style":{}}},
147
+
{"textRun":{"content":"note\n","style":{}}}]}}}]}},
148
+
"pageElements":[]}]}|}
149
+
in
150
+
Alcotest.(check bool) "#speaker-note" true (contains ~sub:"#speaker-note" out)
151
+
152
+
let image_emitted () =
153
+
let out =
154
+
render
155
+
{|{"presentationId":"x","slides":[
156
+
{"objectId":"S","pageElements":[
157
+
{"objectId":"I","title":"Logo",
158
+
"image":{"contentUrl":"https://x/img.png"}}]}]}|}
159
+
in
160
+
Alcotest.(check bool)
161
+
"#image" true
162
+
(contains ~sub:"#image(\"https://x/img.png\"" out)
163
+
164
+
let comment_as_footnote () =
165
+
let body =
166
+
{|{"presentationId":"P","slides":[
167
+
{"objectId":"S1","pageElements":[
168
+
{"objectId":"T","shape":{"placeholder":{"type":"TITLE"},
169
+
"text":{"textElements":[
170
+
{"paragraphMarker":{"style":{}}},
171
+
{"textRun":{"content":"Title\n","style":{}}}]}}}]}]}|}
172
+
in
173
+
let comments : Gslides.Comments.t list =
174
+
[
175
+
{
176
+
id = "c1";
177
+
author = "Reviewer";
178
+
content = "looks good";
179
+
quoted_text = "";
180
+
anchor = Some {|{"a":[{"pageObjectId":"S1"}]}|};
181
+
resolved = false;
182
+
};
183
+
]
184
+
in
185
+
let out = render_with_comments comments body in
186
+
Alcotest.(check bool)
187
+
"#footnote in slide" true
188
+
(contains ~sub:"#footnote[" out);
189
+
Alcotest.(check bool) "Reviewer name" true (contains ~sub:"*Reviewer*" out)
190
+
191
+
let suite =
192
+
( "typst",
193
+
[
194
+
Alcotest.test_case "polylux version pinned" `Quick polylux_pin_present;
195
+
Alcotest.test_case "page paper set" `Quick presentation_paper_set;
196
+
Alcotest.test_case "title-slide for deck title" `Quick
197
+
title_slide_when_title_present;
198
+
Alcotest.test_case "slide block" `Quick slide_block;
199
+
Alcotest.test_case "bold -> #strong" `Quick bold_uses_strong;
200
+
Alcotest.test_case "italic -> #emph" `Quick italic_uses_emph;
201
+
Alcotest.test_case "strike -> #strike" `Quick strike_uses_strike;
202
+
Alcotest.test_case "underline -> #underline" `Quick
203
+
underline_uses_underline;
204
+
Alcotest.test_case "link -> #link" `Quick link_uses_link;
205
+
Alcotest.test_case "bullets" `Quick bullets_native;
206
+
Alcotest.test_case "numbered" `Quick numbered_native;
207
+
Alcotest.test_case "speaker note" `Quick speaker_note_block;
208
+
Alcotest.test_case "image" `Quick image_emitted;
209
+
Alcotest.test_case "comment as footnote" `Quick comment_as_footnote;
210
+
] )
+1
test/test_typst.mli
+1
test/test_typst.mli
···
1
+
val suite : string * unit Alcotest.test_case list