Google Docs API client for OCaml
prune cram fixtures: declare fmt dep missed in Printf→Fmt migration
Commit 5fbed21c switched every cram test fixture from Printf to Fmt
without updating the dune stanzas to depend on fmt, so `dune build`
inside the fixtures fails and the cram expected output stopped
matching reality. Add fmt to each executable/library and refresh the
one stale expected block (cascade_cleanup) still showing Printf.
+2088
+18
bin/dune
+18
bin/dune
+31
bin/fetch.ml
+31
bin/fetch.ml
···
1
+
(** [gdocs get <id>] — fetch a document and print its JSON. *)
2
+
3
+
let run doc_id =
4
+
Eio_main.run @@ fun env ->
5
+
Eio.Switch.run @@ fun sw ->
6
+
let http = Requests.v ~sw env in
7
+
let clock = Eio.Stdenv.clock env in
8
+
let fs = Eio.Stdenv.fs env in
9
+
let token =
10
+
match Gdocs.Store.acquire http ~clock ~fs with
11
+
| Ok t -> t
12
+
| Error (`Msg m) -> Ui.die "%s" m
13
+
in
14
+
let result = Gdocs.get http ~token doc_id in
15
+
(* Write any refreshed token state back to disk so the next
16
+
invocation doesn't start from a stale snapshot. *)
17
+
Gdocs.Store.persist fs token;
18
+
match result with
19
+
| Error (`Msg m) -> Ui.die "%s" m
20
+
| Ok doc -> print_endline (Gdocs.Document.to_json doc)
21
+
22
+
open Cmdliner
23
+
24
+
let doc_id =
25
+
let doc = "Google Docs document ID (the long string in the URL)." in
26
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"DOCUMENT_ID" ~doc)
27
+
28
+
let cmd =
29
+
let doc = "Fetch a document and print its raw JSON." in
30
+
let info = Cmd.info "get" ~doc in
31
+
Cmd.v info Term.(const run $ doc_id)
+4
bin/fetch.mli
+4
bin/fetch.mli
+70
bin/install.ml
+70
bin/install.ml
···
1
+
(** [gdocs install] — one-time OAuth client registration. *)
2
+
3
+
let instructions =
4
+
{|
5
+
One-time setup to register gdocs with your Google account.
6
+
7
+
Step 1. Open the Google Cloud Console in your browser (the next prompt
8
+
opens it for you). If you don't already have a Cloud project,
9
+
create one (free — just pick any name).
10
+
11
+
Step 2. On the "APIs & Services → Credentials" page, click
12
+
"Create Credentials → OAuth client ID".
13
+
- Application type: Desktop app
14
+
- Name: anything, e.g. "gdocs CLI"
15
+
Click Create, then copy the Client ID and Client secret.
16
+
17
+
Step 3. Enable the Google Docs API for the project:
18
+
APIs & Services → Library → search "Google Docs API" → Enable.
19
+
20
+
Step 4. If the OAuth consent screen isn't configured yet, do that too:
21
+
APIs & Services → OAuth consent screen. User type: External.
22
+
Under Test users, add your own Google email.
23
+
24
+
Step 5. Come back here and paste the two strings.
25
+
26
+
|}
27
+
28
+
let credentials_url = "https://console.cloud.google.com/apis/credentials"
29
+
30
+
let run () =
31
+
Eio_main.run @@ fun env ->
32
+
let fs = Eio.Stdenv.fs env in
33
+
let overwriting = Option.is_some (Gdocs.Store.load_client fs) in
34
+
if overwriting then
35
+
if
36
+
not
37
+
(Ui.confirm
38
+
(Fmt.str "Existing client credentials at %a — overwrite them?"
39
+
Eio.Path.pp
40
+
(Gdocs.Store.client_path fs)))
41
+
then begin
42
+
Fmt.pr "Aborted.@.";
43
+
exit 0
44
+
end;
45
+
Fmt.pr "%s" instructions;
46
+
Ui.pause_for
47
+
(Fmt.str "Press Enter to open %s in your browser..." credentials_url);
48
+
Ui.open_in_browser credentials_url;
49
+
Fmt.pr "@.";
50
+
let client_id = Ui.prompt "Client ID" in
51
+
let client_secret = Ui.prompt "Client secret" in
52
+
if client_id = "" || client_secret = "" then
53
+
Ui.die "both Client ID and Client secret are required";
54
+
Gdocs.Store.save_client fs { client_id; client_secret };
55
+
if overwriting then Gdocs.Store.clear_token fs;
56
+
Fmt.pr "@.Saved client credentials to %a@." Eio.Path.pp
57
+
(Gdocs.Store.client_path fs);
58
+
if overwriting then
59
+
Fmt.pr "Cleared the previous login token (tied to the old client).@.";
60
+
Fmt.pr "Next: run `gdocs login` to authorize your Google account.@."
61
+
62
+
open Cmdliner
63
+
64
+
let cmd =
65
+
let doc =
66
+
"One-time setup: register gdocs with your Google account (creates an OAuth \
67
+
client in the Google Cloud Console)."
68
+
in
69
+
let info = Cmd.info "install" ~doc in
70
+
Cmd.v info Term.(const run $ const ())
+4
bin/install.mli
+4
bin/install.mli
+39
bin/login.ml
+39
bin/login.ml
···
1
+
(** [gdocs login] — per-user OAuth flow. *)
2
+
3
+
let require_client fs =
4
+
match Gdocs.Store.load_client fs with
5
+
| Some c -> c
6
+
| None -> Ui.die "no client credentials. Run `gdocs install` first."
7
+
8
+
let run () =
9
+
Eio_main.run @@ fun env ->
10
+
Eio.Switch.run @@ fun sw ->
11
+
let http = Requests.v ~sw env in
12
+
let clock = Eio.Stdenv.clock env in
13
+
let net = Eio.Stdenv.net env in
14
+
let fs = Eio.Stdenv.fs env in
15
+
let { Gdocs.Store.client_id; client_secret } = require_client fs in
16
+
(* [Gdocs.Comments.scope] is requested alongside the Docs scope so
17
+
`gdocs md --comments` works without a separate login. *)
18
+
let scopes = [ Gdocs.scope_readonly; Gdocs.Comments.scope ] in
19
+
let on_url url =
20
+
Fmt.pr "Opening your browser to authorize...@.";
21
+
Ui.open_in_browser url;
22
+
Fmt.pr "If it didn't open, paste this URL manually:@.@. %s@." url
23
+
in
24
+
match
25
+
Gauth.Local_flow.run http ~clock ~net ~sw ~client_id ~client_secret ~scopes
26
+
~on_url ()
27
+
with
28
+
| Error (`Msg m) -> Ui.die "login failed: %s" m
29
+
| Ok token ->
30
+
Gdocs.Store.save_token fs (Gauth.to_json token);
31
+
Fmt.pr "@.Logged in. Token saved to %a@." Eio.Path.pp
32
+
(Gdocs.Store.token_path fs)
33
+
34
+
open Cmdliner
35
+
36
+
let cmd =
37
+
let doc = "Authorize your Google account in the browser." in
38
+
let info = Cmd.info "login" ~doc in
39
+
Cmd.v info Term.(const run $ const ())
+4
bin/login.mli
+4
bin/login.mli
+11
bin/main.ml
+11
bin/main.ml
···
1
+
(** gdocs — CLI dispatcher. *)
2
+
3
+
let () =
4
+
Crypto_rng_unix.use_default ();
5
+
let doc = "Google Docs CLI. Run `gdocs install` first, then `gdocs login`." in
6
+
let info = Cmdliner.Cmd.info "gdocs" ~version:"%%VERSION%%" ~doc in
7
+
let group =
8
+
Cmdliner.Cmd.group info
9
+
[ Install.cmd; Login.cmd; Fetch.cmd; Text.cmd; Md.cmd ]
10
+
in
11
+
exit (Cmdliner.Cmd.eval group)
+47
bin/md.ml
+47
bin/md.ml
···
1
+
(** [gdocs md <id>] — fetch a document and print it as Markdown. *)
2
+
3
+
let run ~comments doc_id =
4
+
Eio_main.run @@ fun env ->
5
+
Eio.Switch.run @@ fun sw ->
6
+
let http = Requests.v ~sw env in
7
+
let clock = Eio.Stdenv.clock env in
8
+
let fs = Eio.Stdenv.fs env in
9
+
let token =
10
+
match Gdocs.Store.acquire http ~clock ~fs with
11
+
| Ok t -> t
12
+
| Error (`Msg m) -> Ui.die "%s" m
13
+
in
14
+
let result =
15
+
match Gdocs.get http ~token doc_id with
16
+
| Error _ as e -> e
17
+
| Ok doc ->
18
+
if comments then
19
+
match Gdocs.Comments.list http ~token doc_id with
20
+
| Error (`Msg m) ->
21
+
Fmt.epr "warning: could not fetch comments: %s@." m;
22
+
Ok (Gdocs.Markdown.of_document doc)
23
+
| Ok cs ->
24
+
Ok (Gdocs.Markdown.of_document_with_comments ~comments:cs doc)
25
+
else Ok (Gdocs.Markdown.of_document doc)
26
+
in
27
+
Gdocs.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 doc_id =
33
+
let doc = "Google Docs document ID (the long string in the URL)." in
34
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"DOCUMENT_ID" ~doc)
35
+
36
+
let comments_flag =
37
+
let doc =
38
+
"Append a Comments section listing document comments (requires the \
39
+
drive.readonly scope — re-run `gdocs login` if you haven't granted it)."
40
+
in
41
+
Arg.(value & flag & info [ "comments"; "c" ] ~doc)
42
+
43
+
let cmd =
44
+
let doc = "Fetch a document and print it as Markdown." in
45
+
let info = Cmd.info "md" ~doc in
46
+
Cmd.v info
47
+
Term.(const (fun comments id -> run ~comments id) $ comments_flag $ doc_id)
+4
bin/md.mli
+4
bin/md.mli
+33
bin/text.ml
+33
bin/text.ml
···
1
+
(** [gdocs text <id>] — fetch a document and print its plain text. *)
2
+
3
+
let run doc_id =
4
+
Eio_main.run @@ fun env ->
5
+
Eio.Switch.run @@ fun sw ->
6
+
let http = Requests.v ~sw env in
7
+
let clock = Eio.Stdenv.clock env in
8
+
let fs = Eio.Stdenv.fs env in
9
+
let token =
10
+
match Gdocs.Store.acquire http ~clock ~fs with
11
+
| Ok t -> t
12
+
| Error (`Msg m) -> Ui.die "%s" m
13
+
in
14
+
let result = Gdocs.get http ~token doc_id in
15
+
Gdocs.Store.persist fs token;
16
+
match result with
17
+
| Error (`Msg m) -> Ui.die "%s" m
18
+
| Ok doc ->
19
+
let title = Gdocs.Document.title doc in
20
+
print_endline title;
21
+
print_endline (String.make (String.length title) '=');
22
+
print_string (Gdocs.Document.to_text doc)
23
+
24
+
open Cmdliner
25
+
26
+
let doc_id =
27
+
let doc = "Google Docs document ID (the long string in the URL)." in
28
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"DOCUMENT_ID" ~doc)
29
+
30
+
let cmd =
31
+
let doc = "Fetch a document and print its plain-text content." in
32
+
let info = Cmd.info "text" ~doc in
33
+
Cmd.v info Term.(const run $ doc_id)
+4
bin/text.mli
+4
bin/text.mli
+38
bin/ui.ml
+38
bin/ui.ml
···
1
+
(** Small terminal UI helpers: browser opener, prompt, die. *)
2
+
3
+
let open_in_browser url =
4
+
let cmd =
5
+
match Sys.os_type with
6
+
| "Win32" -> Fmt.str "start %s" (Filename.quote url)
7
+
| _ ->
8
+
if
9
+
Sys.file_exists "/usr/bin/open"
10
+
|| Sys.file_exists "/usr/local/bin/open"
11
+
then Fmt.str "open %s" (Filename.quote url)
12
+
else Fmt.str "xdg-open %s >/dev/null 2>&1" (Filename.quote url)
13
+
in
14
+
ignore (Sys.command cmd)
15
+
16
+
let prompt label =
17
+
Fmt.pr "%s: @?" label;
18
+
match In_channel.input_line In_channel.stdin with
19
+
| Some s -> String.trim s
20
+
| None -> ""
21
+
22
+
let confirm label =
23
+
Fmt.pr "%s [y/N] @?" label;
24
+
match In_channel.input_line In_channel.stdin with
25
+
| Some s -> String.lowercase_ascii (String.trim s) = "y"
26
+
| None -> false
27
+
28
+
let pause_for label =
29
+
Fmt.pr "%s @?" label;
30
+
let _ = In_channel.input_line In_channel.stdin in
31
+
()
32
+
33
+
let die fmt =
34
+
Fmt.kstr
35
+
(fun m ->
36
+
Fmt.epr "error: %s@." m;
37
+
exit 1)
38
+
fmt
+19
bin/ui.mli
+19
bin/ui.mli
···
1
+
(** Small terminal helpers for interactive CLI flows. *)
2
+
3
+
val open_in_browser : string -> unit
4
+
(** [open_in_browser url] best-effort opens [url] in the user's default browser.
5
+
Silent on failure — callers should also print the URL. *)
6
+
7
+
val prompt : string -> string
8
+
(** [prompt label] writes [label: ] to stdout and returns the trimmed line read
9
+
from stdin (or [""] on EOF). *)
10
+
11
+
val confirm : string -> bool
12
+
(** [confirm label] writes [label [y/N] ] to stdout and returns [true] iff the
13
+
user answers [y] (case-insensitive). *)
14
+
15
+
val pause_for : string -> unit
16
+
(** [pause_for label] prints [label] and waits for the user to press Enter. *)
17
+
18
+
val die : ('a, Format.formatter, unit, 'b) format4 -> 'a
19
+
(** [die fmt] prints [fmt]-formatted text to stderr and exits with code 1. *)
+38
dune-project
+38
dune-project
···
1
+
(lang dune 3.21)
2
+
3
+
(name gdocs)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(source (tangled gazagnaire.org/ocaml-gdocs))
8
+
(license MIT)
9
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
11
+
12
+
(package
13
+
(name gdocs)
14
+
(synopsis "Google Docs API client for OCaml")
15
+
(tags (org:blacksun google network http))
16
+
(description
17
+
"OCaml client for the Google Docs REST API. Fetches documents by ID and
18
+
extracts plain text. Uses ocaml-gauth for authentication and
19
+
ocaml-requests for HTTP.")
20
+
(depends
21
+
(ocaml (>= 5.1))
22
+
(dune (>= 3.21))
23
+
(cmarkit (>= 0.3))
24
+
(cmdliner (>= 1.2))
25
+
(eio (>= 1.0))
26
+
(eio_main (>= 1.0))
27
+
(fmt (>= 0.9))
28
+
(gauth (>= 0.1))
29
+
(http (>= 0.1))
30
+
(jsont (>= 0.2))
31
+
(bytesrw (>= 0.1))
32
+
(logs (>= 0.7))
33
+
(oauth (>= 0.1))
34
+
(requests (>= 0.1))
35
+
(xdge (>= 0.1))
36
+
(alcotest :with-test)
37
+
(crypto-rng :with-test)
38
+
(odoc :with-doc)))
+51
gdocs.opam
+51
gdocs.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Google Docs API client for OCaml"
4
+
description: """
5
+
OCaml client for the Google Docs REST API. Fetches documents by ID and
6
+
extracts plain text. Uses ocaml-gauth for authentication and
7
+
ocaml-requests for HTTP."""
8
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
+
license: "MIT"
11
+
tags: ["org:blacksun" "google" "network" "http"]
12
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-gdocs"
13
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-gdocs/issues"
14
+
depends: [
15
+
"ocaml" {>= "5.1"}
16
+
"dune" {>= "3.21" & >= "3.21"}
17
+
"cmarkit" {>= "0.3"}
18
+
"cmdliner" {>= "1.2"}
19
+
"eio" {>= "1.0"}
20
+
"eio_main" {>= "1.0"}
21
+
"fmt" {>= "0.9"}
22
+
"gauth" {>= "0.1"}
23
+
"http" {>= "0.1"}
24
+
"jsont" {>= "0.2"}
25
+
"bytesrw" {>= "0.1"}
26
+
"logs" {>= "0.7"}
27
+
"oauth" {>= "0.1"}
28
+
"requests" {>= "0.1"}
29
+
"xdge" {>= "0.1"}
30
+
"alcotest" {with-test}
31
+
"crypto-rng" {with-test}
32
+
"odoc" {with-doc}
33
+
]
34
+
build: [
35
+
["dune" "subst"] {dev}
36
+
[
37
+
"dune"
38
+
"build"
39
+
"-p"
40
+
name
41
+
"-j"
42
+
jobs
43
+
"@install"
44
+
"@runtest" {with-test}
45
+
"@doc" {with-doc}
46
+
]
47
+
]
48
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-gdocs"
49
+
x-maintenance-intent: ["(latest)"]
50
+
x-quality-build: "2026-04-16"
51
+
x-quality-test: "2026-04-16"
+112
lib/comments.ml
+112
lib/comments.ml
···
1
+
(** Google Docs comments, via the Drive API. *)
2
+
3
+
let src = Logs.Src.create "gdocs.comments" ~doc:"Drive comments API client"
4
+
5
+
module Log = (val Logs.src_log src : Logs.LOG)
6
+
7
+
let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt
8
+
let err_json_decode e = err_msg "comments JSON decode: %s" e
9
+
let err_http status body = err_msg "Drive comments HTTP %d: %s" status body
10
+
let scope = "https://www.googleapis.com/auth/drive.readonly"
11
+
12
+
type t = {
13
+
id : string;
14
+
author : string;
15
+
content : string;
16
+
quoted_text : string;
17
+
anchor : string option;
18
+
resolved : bool;
19
+
}
20
+
21
+
let pp ppf c =
22
+
let author = if c.author = "" then "(unknown)" else c.author in
23
+
Fmt.pf ppf "%s: %s" author c.content
24
+
25
+
(* ── JSON parsing ────────────────────────────────────────────── *)
26
+
27
+
(* Drive API v3 comment shape:
28
+
{
29
+
"id":"...",
30
+
"author": { "displayName":"...", "kind":"drive#user" },
31
+
"content":"...",
32
+
"quotedFileContent": { "mimeType":"...", "value":"..." },
33
+
"anchor":"kix.abc",
34
+
"resolved": false
35
+
} *)
36
+
37
+
type raw_author = { display_name : string }
38
+
39
+
let author_jsont =
40
+
Jsont.Object.map ~kind:"author" (fun display_name -> { display_name })
41
+
|> Jsont.Object.mem "displayName" Jsont.string ~dec_absent:"" ~enc:(fun a ->
42
+
a.display_name)
43
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
44
+
45
+
type raw_quoted = { value : string }
46
+
47
+
let quoted_jsont =
48
+
Jsont.Object.map ~kind:"quotedFileContent" (fun value -> { value })
49
+
|> Jsont.Object.mem "value" Jsont.string ~dec_absent:"" ~enc:(fun q ->
50
+
q.value)
51
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
52
+
53
+
let comment_jsont =
54
+
Jsont.Object.map ~kind:"comment"
55
+
(fun id author content quoted anchor resolved ->
56
+
{
57
+
id;
58
+
author = (match author with Some a -> a.display_name | None -> "");
59
+
content;
60
+
quoted_text = (match quoted with Some q -> q.value | None -> "");
61
+
anchor;
62
+
resolved;
63
+
})
64
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
65
+
|> Jsont.Object.opt_mem "author" author_jsont ~enc:(fun _ -> None)
66
+
|> Jsont.Object.mem "content" Jsont.string ~dec_absent:"" ~enc:(fun c ->
67
+
c.content)
68
+
|> Jsont.Object.opt_mem "quotedFileContent" quoted_jsont ~enc:(fun _ -> None)
69
+
|> Jsont.Object.opt_mem "anchor" Jsont.string ~enc:(fun c -> c.anchor)
70
+
|> Jsont.Object.mem "resolved" Jsont.bool ~dec_absent:false ~enc:(fun c ->
71
+
c.resolved)
72
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
73
+
74
+
type raw_list = { comments : t list }
75
+
76
+
let list_jsont =
77
+
Jsont.Object.map ~kind:"comment_list" (fun comments -> { comments })
78
+
|> Jsont.Object.mem "comments" (Jsont.list comment_jsont) ~dec_absent:[]
79
+
~enc:(fun r -> r.comments)
80
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
81
+
82
+
let of_json_string body =
83
+
match Jsont_bytesrw.decode_string list_jsont body with
84
+
| Error e -> err_json_decode e
85
+
| Ok r -> Ok r.comments
86
+
87
+
(* ── HTTP ────────────────────────────────────────────────────── *)
88
+
89
+
let api_root = "https://www.googleapis.com/drive/v3/files/"
90
+
91
+
let url document_id =
92
+
let base = api_root ^ Uri.pct_encode ~component:`Path document_id in
93
+
base
94
+
^ "/comments?fields=comments(id,author/displayName,content,quotedFileContent,anchor,resolved)"
95
+
96
+
let auth_header token =
97
+
match Gauth.try_access token with
98
+
| Ok s -> Ok ("Authorization", "Bearer " ^ s)
99
+
| Error (`Msg m) -> err_msg "authentication: %s" m
100
+
101
+
let list http ~token document_id =
102
+
match auth_header token with
103
+
| Error _ as e -> e
104
+
| Ok hdr ->
105
+
let u = url document_id in
106
+
Log.debug (fun m -> m "GET %s" u);
107
+
let headers = Http.Headers.of_list [ hdr ] in
108
+
let resp = Requests.get http u ~headers in
109
+
let status = Requests.Response.status_code resp in
110
+
let body = Requests.Response.text resp in
111
+
if status < 200 || status >= 300 then err_http status body
112
+
else of_json_string body
+44
lib/comments.mli
+44
lib/comments.mli
···
1
+
(** Google Docs comments.
2
+
3
+
Comments live in the {b Drive API}, not the Docs API. Fetching them requires
4
+
the [drive.readonly] scope in addition to the document scope. *)
5
+
6
+
val scope : string
7
+
(** [scope] is the OAuth scope required to list comments,
8
+
[https://www.googleapis.com/auth/drive.readonly]. *)
9
+
10
+
type t = {
11
+
id : string;
12
+
author : string;
13
+
(** Display name of the author, or [""] if the API didn't return one. *)
14
+
content : string; (** Plain-text body of the comment. *)
15
+
quoted_text : string;
16
+
(** The text the comment is anchored to, from [quotedFileContent.value].
17
+
*)
18
+
anchor : string option;
19
+
(** Google's opaque anchor string (JSON blob). Present for anchored
20
+
comments; absent for document-level comments. *)
21
+
resolved : bool;
22
+
}
23
+
(** A comment on a document. *)
24
+
25
+
val pp : Format.formatter -> t -> unit
26
+
(** [pp ppf c] renders a compact one-line representation of [c] —
27
+
[author: content] — suitable for logging and [Fmt.str] use. *)
28
+
29
+
val list :
30
+
Requests.t ->
31
+
token:Gauth.token ->
32
+
string ->
33
+
(t list, [ `Msg of string ]) result
34
+
(** [list http ~token document_id] fetches comments for the document via the
35
+
Drive API.
36
+
37
+
Only top-level comments are returned — replies are currently flattened away.
38
+
Uses
39
+
[fields=comments(id,author/displayName,content,quotedFileContent,anchor,resolved)]
40
+
to minimize response size. *)
41
+
42
+
val of_json_string : string -> (t list, [ `Msg of string ]) result
43
+
(** [of_json_string body] parses a Drive API [comments.list] response. Exposed
44
+
for testing with fixtures. *)
+121
lib/document.ml
+121
lib/document.ml
···
1
+
(** A parsed Google Docs document. *)
2
+
3
+
let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt
4
+
let err_json_decode e = err_msg "JSON decode: %s" e
5
+
6
+
type t = { document_id : string; title : string; raw : string }
7
+
8
+
let id d = d.document_id
9
+
let title d = d.title
10
+
let to_json d = d.raw
11
+
let mem_name ((n, _) : Jsont.name) = n
12
+
13
+
(* Walk the document JSON and extract plain text.
14
+
15
+
Two top-level shapes are handled:
16
+
- Single-body documents: [body.content = [StructuralElement]].
17
+
- Tabbed documents (requires [?includeTabsContent=true]): the top
18
+
level has [tabs = [Tab]] where each [Tab.documentTab.body.content]
19
+
is a StructuralElement list. Child tabs nest under [Tab.childTabs].
20
+
21
+
StructuralElement has at most one of [sectionBreak], [paragraph],
22
+
[table], [tableOfContents]. ParagraphElement has at most one of
23
+
[textRun], [autoText], [pageBreak], [columnBreak], etc.
24
+
25
+
We follow [paragraph.elements[*].textRun.content]. The Docs API
26
+
guarantees the last [textRun] of every paragraph ends with ["\n"],
27
+
so we just concatenate — no manual newline insertion (which would
28
+
double-space the output). *)
29
+
let extract_text value =
30
+
let open Jsont in
31
+
let buf = Buffer.create 1024 in
32
+
let rec walk_root = function
33
+
| Object (members, _) ->
34
+
List.iter
35
+
(fun (name, v) ->
36
+
match (mem_name name, v) with
37
+
| "body", Object _ -> walk_body v
38
+
| "tabs", Array (tabs, _) -> List.iter walk_tab tabs
39
+
| _ -> ())
40
+
members
41
+
| _ -> ()
42
+
and walk_tab = function
43
+
| Object (members, _) ->
44
+
List.iter
45
+
(fun (name, v) ->
46
+
match (mem_name name, v) with
47
+
| "documentTab", Object _ -> walk_document_tab v
48
+
| "childTabs", Array (children, _) -> List.iter walk_tab children
49
+
| _ -> ())
50
+
members
51
+
| _ -> ()
52
+
and walk_document_tab = function
53
+
| Object (members, _) ->
54
+
List.iter
55
+
(fun (name, v) -> if mem_name name = "body" then walk_body v)
56
+
members
57
+
| _ -> ()
58
+
and walk_body = function
59
+
| Object (members, _) ->
60
+
List.iter
61
+
(fun (name, v) ->
62
+
match (mem_name name, v) with
63
+
| "content", Array (lst, _) -> List.iter walk_content lst
64
+
| _ -> ())
65
+
members
66
+
| _ -> ()
67
+
and walk_content = function
68
+
| Object (members, _) ->
69
+
List.iter
70
+
(fun (name, v) ->
71
+
if mem_name name = "paragraph" then walk_paragraph v)
72
+
members
73
+
| _ -> ()
74
+
and walk_paragraph = function
75
+
| Object (members, _) ->
76
+
List.iter
77
+
(fun (name, v) ->
78
+
match (mem_name name, v) with
79
+
| "elements", Array (lst, _) -> List.iter walk_paragraph_element lst
80
+
| _ -> ())
81
+
members
82
+
| _ -> ()
83
+
and walk_paragraph_element = function
84
+
| Object (members, _) ->
85
+
List.iter
86
+
(fun (name, v) -> if mem_name name = "textRun" then walk_text_run v)
87
+
members
88
+
| _ -> ()
89
+
and walk_text_run = function
90
+
| Object (members, _) ->
91
+
List.iter
92
+
(fun (name, v) ->
93
+
match (mem_name name, v) with
94
+
| "content", String (s, _) -> Buffer.add_string buf s
95
+
| _ -> ())
96
+
members
97
+
| _ -> ()
98
+
in
99
+
walk_root value;
100
+
Buffer.contents buf
101
+
102
+
let top_string json field =
103
+
match json with
104
+
| Jsont.Object (members, _) -> (
105
+
match List.find_opt (fun (name, _) -> mem_name name = field) members with
106
+
| Some (_, Jsont.String (s, _)) -> s
107
+
| _ -> "")
108
+
| _ -> ""
109
+
110
+
let of_json_string body =
111
+
match Jsont_bytesrw.decode_string Jsont.json body with
112
+
| Error e -> err_json_decode e
113
+
| Ok json ->
114
+
let document_id = top_string json "documentId" in
115
+
let title = top_string json "title" in
116
+
Ok { document_id; title; raw = body }
117
+
118
+
let to_text d =
119
+
match Jsont_bytesrw.decode_string Jsont.json d.raw with
120
+
| Error _ -> ""
121
+
| Ok json -> extract_text json
+29
lib/document.mli
+29
lib/document.mli
···
1
+
(** A parsed Google Docs document.
2
+
3
+
Wraps the raw API JSON along with parsed [documentId] and [title]
4
+
convenience fields. Full structure access is via {!to_json}. *)
5
+
6
+
type t
7
+
(** A Google Docs document. *)
8
+
9
+
val id : t -> string
10
+
(** [id doc] is the unique document identifier from Google's [documentId] field.
11
+
*)
12
+
13
+
val title : t -> string
14
+
(** [title doc] is the document title (may be empty). *)
15
+
16
+
val to_json : t -> string
17
+
(** [to_json doc] is the raw JSON as returned by the API. *)
18
+
19
+
val to_text : t -> string
20
+
(** [to_text doc] extracts the plain-text content by walking the document body
21
+
(and tabs, if present), concatenating [textRun] elements.
22
+
23
+
The Docs API emits a trailing newline on the last [textRun] of each
24
+
paragraph, so the result is already paragraph-terminated. *)
25
+
26
+
val of_json_string : string -> (t, [ `Msg of string ]) result
27
+
(** [of_json_string body] parses a document from a raw API JSON response.
28
+
Primarily useful for testing with fixtures; production callers should use
29
+
{!Gdocs.get}. *)
+17
lib/dune
+17
lib/dune
+44
lib/gdocs.ml
+44
lib/gdocs.ml
···
1
+
(** Google Docs API client. *)
2
+
3
+
module Store = Store
4
+
module Document = Document
5
+
module Comments = Comments
6
+
module Markdown = Markdown
7
+
8
+
let src = Logs.Src.create "gdocs" ~doc:"Google Docs API client"
9
+
10
+
module Log = (val Logs.src_log src : Logs.LOG)
11
+
12
+
(* Error helpers — keep all [`Msg] shapes in one place. *)
13
+
let err_msg fmt = Fmt.kstr (fun m -> Error (`Msg m)) fmt
14
+
let err_http status body = err_msg "HTTP %d: %s" status body
15
+
let scope_readonly = "https://www.googleapis.com/auth/documents.readonly"
16
+
let scope_readwrite = "https://www.googleapis.com/auth/documents"
17
+
let api_root = "https://docs.googleapis.com/v1/documents/"
18
+
19
+
(* ── HTTP ────────────────────────────────────────────────────────── *)
20
+
21
+
let auth_header token =
22
+
match Gauth.try_access token with
23
+
| Ok s -> Ok ("Authorization", "Bearer " ^ s)
24
+
| Error (`Msg m) -> err_msg "authentication: %s" m
25
+
26
+
(* Request tabs content so multi-tab documents aren't silently truncated.
27
+
See https://developers.google.com/docs/api/how-tos/tabs. Without this
28
+
parameter the API returns only the first tab's body at the top level. *)
29
+
let document_url document_id =
30
+
let base = api_root ^ Uri.pct_encode ~component:`Path document_id in
31
+
base ^ "?includeTabsContent=true"
32
+
33
+
let get http ~token document_id =
34
+
match auth_header token with
35
+
| Error _ as e -> e
36
+
| Ok hdr ->
37
+
let url = document_url document_id in
38
+
Log.debug (fun m -> m "GET %s" url);
39
+
let headers = Http.Headers.of_list [ hdr ] in
40
+
let resp = Requests.get http url ~headers in
41
+
let status = Requests.Response.status_code resp in
42
+
let body = Requests.Response.text resp in
43
+
if status < 200 || status >= 300 then err_http status body
44
+
else Document.of_json_string body
+52
lib/gdocs.mli
+52
lib/gdocs.mli
···
1
+
(** Google Docs API client.
2
+
3
+
Implements a small, opinionated slice of the
4
+
{{:https://developers.google.com/docs/api/reference/rest} Google Docs REST
5
+
API}: fetching documents by ID and extracting their content as plain text
6
+
or Markdown. Uses {!Gauth} for authentication.
7
+
8
+
Reading documents requires the {!scope_readonly} OAuth scope (or the broader
9
+
{!scope_readwrite} scope).
10
+
11
+
{1 Example}
12
+
13
+
{[
14
+
Eio_main.run @@ fun env ->
15
+
Eio.Switch.run @@ fun sw ->
16
+
let http = Requests.v ~sw env in
17
+
let clock = Eio.Stdenv.clock env in
18
+
let token : Gauth.token = (* ... *) in
19
+
let doc = Gdocs.get http ~token "1abcDEF...xyz" |> Result.get_ok in
20
+
print_endline (Gdocs.Document.title doc);
21
+
print_endline (Gdocs.Markdown.of_document doc)
22
+
]} *)
23
+
24
+
module Store = Store
25
+
module Document = Document
26
+
module Comments = Comments
27
+
module Markdown = Markdown
28
+
29
+
(** {1 Scopes} *)
30
+
31
+
val scope_readonly : string
32
+
(** [scope_readonly] is the OAuth scope for read-only document access,
33
+
[https://www.googleapis.com/auth/documents.readonly]. *)
34
+
35
+
val scope_readwrite : string
36
+
(** [scope_readwrite] is the OAuth scope for read-write document access,
37
+
[https://www.googleapis.com/auth/documents]. *)
38
+
39
+
(** {1 API calls} *)
40
+
41
+
val get :
42
+
Requests.t ->
43
+
token:Gauth.token ->
44
+
string ->
45
+
(Document.t, [ `Msg of string ]) result
46
+
(** [get http ~token document_id] fetches the document with the given ID.
47
+
48
+
Errors:
49
+
- [`Msg "401 ..."] if the access token is invalid or expired.
50
+
- [`Msg "403 ..."] if the token lacks the documents scope or the user does
51
+
not have access to the document.
52
+
- [`Msg "404 ..."] if the document does not exist. *)
+275
lib/markdown.ml
+275
lib/markdown.ml
···
1
+
(** Render a Google Docs document as Markdown. *)
2
+
3
+
(* We emit CommonMark strings directly rather than building a
4
+
Cmarkit AST. The AST constructors are verbose (open variants with
5
+
Meta values per node) and we don't need source-location fidelity —
6
+
we only generate. Tests round-trip the output through
7
+
Cmarkit.Doc.of_string to confirm it parses cleanly. *)
8
+
9
+
let mem_name ((n, _) : Jsont.name) = n
10
+
11
+
(* Find a named member on an Object node. *)
12
+
let member json field =
13
+
match json with
14
+
| Jsont.Object (members, _) ->
15
+
List.find_map
16
+
(fun (name, v) -> if mem_name name = field then Some v else None)
17
+
members
18
+
| _ -> None
19
+
20
+
let as_string = function Jsont.String (s, _) -> Some s | _ -> None
21
+
let as_bool = function Jsont.Bool (b, _) -> Some b | _ -> None
22
+
let as_array = function Jsont.Array (l, _) -> Some l | _ -> None
23
+
let string_or = function Some (Jsont.String (s, _)) -> s | _ -> ""
24
+
25
+
(* ── Inline escaping ────────────────────────────────────────── *)
26
+
27
+
(* Escape only the CommonMark characters that are always dangerous
28
+
inside an inline text span: backslash, backtick, emphasis markers,
29
+
link brackets, autolink markers. Position-sensitive characters (like
30
+
[.], [-], [#], [!]) aren't escaped globally — they're only special
31
+
at the start of a line and would give visually cluttered output if
32
+
escaped everywhere. *)
33
+
let escape_inline s =
34
+
let buf = Buffer.create (String.length s) in
35
+
String.iter
36
+
(fun c ->
37
+
match c with
38
+
| '\\' | '`' | '*' | '_' | '[' | ']' | '<' | '>' ->
39
+
Buffer.add_char buf '\\';
40
+
Buffer.add_char buf c
41
+
| _ -> Buffer.add_char buf c)
42
+
s;
43
+
Buffer.contents buf
44
+
45
+
(* Escape a URL for a Markdown link destination. CommonMark allows
46
+
the destination to contain any character except unescaped parens
47
+
(unless balanced) and control chars. Backslash escape the parens
48
+
and whitespace to be safe. *)
49
+
let escape_link_url s =
50
+
let buf = Buffer.create (String.length s) in
51
+
String.iter
52
+
(fun c ->
53
+
match c with
54
+
| '(' | ')' | '\\' ->
55
+
Buffer.add_char buf '\\';
56
+
Buffer.add_char buf c
57
+
| _ -> Buffer.add_char buf c)
58
+
s;
59
+
Buffer.contents buf
60
+
61
+
(* ── Paragraph-level classification ─────────────────────────── *)
62
+
63
+
(* The heading level for a [namedStyleType] string. Returns [0] for
64
+
body text, -1 for TITLE/SUBTITLE which we treat as H1/H2 respectively. *)
65
+
let heading_level = function
66
+
| "TITLE" -> 1
67
+
| "SUBTITLE" -> 2
68
+
| "HEADING_1" -> 1
69
+
| "HEADING_2" -> 2
70
+
| "HEADING_3" -> 3
71
+
| "HEADING_4" -> 4
72
+
| "HEADING_5" -> 5
73
+
| "HEADING_6" -> 6
74
+
| _ -> 0
75
+
76
+
let named_style paragraph =
77
+
match member paragraph "paragraphStyle" with
78
+
| None -> "NORMAL_TEXT"
79
+
| Some style -> string_or (member style "namedStyleType")
80
+
81
+
let is_bullet paragraph = Option.is_some (member paragraph "bullet")
82
+
83
+
(* ── textRun rendering ──────────────────────────────────────── *)
84
+
85
+
type style = { bold : bool; italic : bool; code : bool; link : string option }
86
+
87
+
let empty_style = { bold = false; italic = false; code = false; link = None }
88
+
89
+
let parse_text_style ts =
90
+
match ts with
91
+
| None -> empty_style
92
+
| Some ts ->
93
+
let bold =
94
+
Option.bind (member ts "bold") as_bool |> Option.value ~default:false
95
+
in
96
+
let italic =
97
+
Option.bind (member ts "italic") as_bool |> Option.value ~default:false
98
+
in
99
+
let code =
100
+
match
101
+
Option.bind (member ts "weightedFontFamily") (fun j ->
102
+
Option.bind (member j "fontFamily") as_string)
103
+
with
104
+
| Some ff
105
+
when String.length ff >= 5
106
+
&&
107
+
let s = String.lowercase_ascii ff in
108
+
let has prefix =
109
+
String.length s >= String.length prefix
110
+
&& String.sub s 0 (String.length prefix) = prefix
111
+
in
112
+
has "courier" || has "consolas" || has "mono" ->
113
+
true
114
+
| _ -> false
115
+
in
116
+
let link =
117
+
Option.bind (member ts "link") (fun lk ->
118
+
Option.bind (member lk "url") as_string)
119
+
in
120
+
{ bold; italic; code; link }
121
+
122
+
let render_text_run buf element =
123
+
let text_run = member element "textRun" in
124
+
match text_run with
125
+
| None -> ()
126
+
| Some tr -> (
127
+
match Option.bind (member tr "content") as_string with
128
+
| None -> ()
129
+
| Some content ->
130
+
let style = parse_text_style (member tr "textStyle") in
131
+
(* Strip the trailing newline if present — we add the
132
+
paragraph terminator ourselves. *)
133
+
let content, trailing_nl =
134
+
let n = String.length content in
135
+
if n > 0 && content.[n - 1] = '\n' then
136
+
(String.sub content 0 (n - 1), true)
137
+
else (content, false)
138
+
in
139
+
let inner =
140
+
if style.code then "`" ^ content ^ "`" else escape_inline content
141
+
in
142
+
let inner = if style.bold then "**" ^ inner ^ "**" else inner in
143
+
let inner = if style.italic then "*" ^ inner ^ "*" else inner in
144
+
let inner =
145
+
match style.link with
146
+
| Some url -> Fmt.str "[%s](%s)" inner (escape_link_url url)
147
+
| None -> inner
148
+
in
149
+
Buffer.add_string buf inner;
150
+
if trailing_nl then Buffer.add_char buf '\n')
151
+
152
+
(* ── Paragraph rendering ────────────────────────────────────── *)
153
+
154
+
let render_paragraph buf paragraph =
155
+
let style = named_style paragraph in
156
+
let level = heading_level style in
157
+
let bullet = is_bullet paragraph in
158
+
let prefix =
159
+
if level > 0 then String.make level '#' ^ " "
160
+
else if bullet then "- "
161
+
else ""
162
+
in
163
+
Buffer.add_string buf prefix;
164
+
let elements =
165
+
Option.bind (member paragraph "elements") as_array
166
+
|> Option.value ~default:[]
167
+
in
168
+
(* Capture the paragraph text into a side buffer so we can trim the
169
+
trailing newline it may already contain and replace it with our
170
+
own paragraph break. *)
171
+
let inner = Buffer.create 256 in
172
+
List.iter (render_text_run inner) elements;
173
+
let s = Buffer.contents inner in
174
+
let trimmed =
175
+
let n = String.length s in
176
+
if n > 0 && s.[n - 1] = '\n' then String.sub s 0 (n - 1) else s
177
+
in
178
+
Buffer.add_string buf trimmed;
179
+
Buffer.add_string buf "\n\n"
180
+
181
+
let render_body buf body =
182
+
let content =
183
+
Option.bind (member body "content") as_array |> Option.value ~default:[]
184
+
in
185
+
List.iter
186
+
(fun el ->
187
+
match member el "paragraph" with
188
+
| Some p -> render_paragraph buf p
189
+
| None -> ())
190
+
content
191
+
192
+
let render_tabs buf tabs =
193
+
let rec walk_tab tab =
194
+
(match member tab "documentTab" with
195
+
| Some dtab -> (
196
+
match member dtab "body" with
197
+
| Some body -> render_body buf body
198
+
| None -> ())
199
+
| None -> ());
200
+
match Option.bind (member tab "childTabs") as_array with
201
+
| Some children -> List.iter walk_tab children
202
+
| None -> ()
203
+
in
204
+
List.iter walk_tab tabs
205
+
206
+
(* ── Top-level entry point ──────────────────────────────────── *)
207
+
208
+
let render_document buf doc_json =
209
+
(* A leading level-1 heading is added from the document's [title]
210
+
field UNLESS the body already starts with a TITLE paragraph. *)
211
+
let title =
212
+
match member doc_json "title" with
213
+
| Some (Jsont.String (s, _)) -> s
214
+
| _ -> ""
215
+
in
216
+
let starts_with_title =
217
+
match
218
+
Option.bind (member doc_json "body") (fun b -> member b "content")
219
+
|> fun o -> Option.bind o as_array
220
+
with
221
+
| Some (first :: _) -> (
222
+
match member first "paragraph" with
223
+
| Some p -> named_style p = "TITLE"
224
+
| None -> false)
225
+
| _ -> false
226
+
in
227
+
if title <> "" && not starts_with_title then begin
228
+
Buffer.add_string buf "# ";
229
+
Buffer.add_string buf (escape_inline title);
230
+
Buffer.add_string buf "\n\n"
231
+
end;
232
+
(match member doc_json "body" with
233
+
| Some body -> render_body buf body
234
+
| None -> ());
235
+
match Option.bind (member doc_json "tabs") as_array with
236
+
| Some tabs -> render_tabs buf tabs
237
+
| None -> ()
238
+
239
+
let of_document doc =
240
+
match Jsont_bytesrw.decode_string Jsont.json (Document.to_json doc) with
241
+
| Error _ -> ""
242
+
| Ok json ->
243
+
let buf = Buffer.create 4096 in
244
+
render_document buf json;
245
+
Buffer.contents buf
246
+
247
+
(* ── Comments footer ────────────────────────────────────────── *)
248
+
249
+
let render_comment buf (c : Comments.t) =
250
+
Buffer.add_string buf "### ";
251
+
if c.author <> "" then Buffer.add_string buf (escape_inline c.author)
252
+
else Buffer.add_string buf "(unknown)";
253
+
if c.resolved then Buffer.add_string buf " (resolved)";
254
+
Buffer.add_string buf "\n\n";
255
+
if c.quoted_text <> "" then begin
256
+
Buffer.add_string buf "> ";
257
+
String.iter
258
+
(fun ch ->
259
+
Buffer.add_char buf ch;
260
+
if ch = '\n' then Buffer.add_string buf "> ")
261
+
c.quoted_text;
262
+
Buffer.add_string buf "\n\n"
263
+
end;
264
+
Buffer.add_string buf (escape_inline c.content);
265
+
Buffer.add_string buf "\n\n"
266
+
267
+
let of_document_with_comments ~comments doc =
268
+
let md = of_document doc in
269
+
if comments = [] then md
270
+
else
271
+
let buf = Buffer.create (String.length md + 512) in
272
+
Buffer.add_string buf md;
273
+
Buffer.add_string buf "## Comments\n\n";
274
+
List.iter (render_comment buf) comments;
275
+
Buffer.contents buf
+26
lib/markdown.mli
+26
lib/markdown.mli
···
1
+
(** Render a Google Docs document as CommonMark-compatible Markdown.
2
+
3
+
The rendering covers the common cases found in typical business documents:
4
+
5
+
- Headings (HEADING_1 … HEADING_6, TITLE, SUBTITLE)
6
+
- Paragraphs
7
+
- Bullet and numbered lists (one nesting level)
8
+
- Bold, italic, inline code via [textStyle]
9
+
- Links via [textStyle.link.url]
10
+
11
+
Tables, images, drawings, embedded objects, and footnotes are currently
12
+
rendered as plain-text placeholders or skipped.
13
+
14
+
The output passes {!Cmarkit.Doc.of_string} round-tripping — tests verify
15
+
that. *)
16
+
17
+
val of_document : Document.t -> string
18
+
(** [of_document doc] renders [doc] as a Markdown string. The document title
19
+
becomes a level-1 heading at the top of the output unless the document
20
+
itself opens with a TITLE paragraph. *)
21
+
22
+
val of_document_with_comments : comments:Comments.t list -> Document.t -> string
23
+
(** [of_document_with_comments ~comments doc] renders [doc] as Markdown and
24
+
appends a {b Comments} section listing each comment. Inline anchor splicing
25
+
is not yet implemented — comments are appended as a footer section for now.
26
+
*)
+59
lib/store.ml
+59
lib/store.ml
···
1
+
(** Config-directory storage for gdocs: client credentials and token.
2
+
3
+
Uses {!Xdge} for Eio-aware XDG Base Directory resolution, so the config
4
+
directory honors [XDG_CONFIG_HOME] and platform conventions. *)
5
+
6
+
let app_name = "gdocs"
7
+
let context fs = Xdge.v (fs :> Eio.Fs.dir_ty Eio.Path.t) app_name
8
+
let config_dir fs = Xdge.config_dir (context fs)
9
+
let client_path fs = Eio.Path.(config_dir fs / "client.json")
10
+
let token_path fs = Eio.Path.(config_dir fs / "token.json")
11
+
12
+
type client = { client_id : string; client_secret : string }
13
+
14
+
let client_jsont =
15
+
Jsont.Object.map ~kind:"gdocs_client" (fun client_id client_secret ->
16
+
{ client_id; client_secret })
17
+
|> Jsont.Object.mem "client_id" Jsont.string ~enc:(fun c -> c.client_id)
18
+
|> Jsont.Object.mem "client_secret" Jsont.string ~enc:(fun c ->
19
+
c.client_secret)
20
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
21
+
22
+
let save_file path data =
23
+
Eio.Path.save ~create:(`Or_truncate 0o600) path data;
24
+
(* Tighten permissions on a pre-existing file — [Or_truncate] only
25
+
applies [0o600] on create, not on reuse. *)
26
+
try Unix.chmod (snd path) 0o600 with Unix.Unix_error _ -> ()
27
+
28
+
let load_file path =
29
+
if Eio.Path.is_file path then Some (Eio.Path.load path) else None
30
+
31
+
let save_client fs c =
32
+
match Jsont_bytesrw.encode_string client_jsont c with
33
+
| Ok s -> save_file (client_path fs) s
34
+
| Error e -> Fmt.failwith "encode client: %s" e
35
+
36
+
let load_client fs =
37
+
match load_file (client_path fs) with
38
+
| None -> None
39
+
| Some body -> (
40
+
match Jsont_bytesrw.decode_string client_jsont body with
41
+
| Ok c -> Some c
42
+
| Error _ -> None)
43
+
44
+
let save_token fs data = save_file (token_path fs) data
45
+
let load_token fs = load_file (token_path fs)
46
+
47
+
let clear_token fs =
48
+
let path = token_path fs in
49
+
if Eio.Path.is_file path then try Eio.Path.unlink path with Eio.Io _ -> ()
50
+
51
+
let persist fs token = save_token fs (Gauth.to_json token)
52
+
53
+
let acquire http ~clock ~fs =
54
+
match load_client fs with
55
+
| None -> Error (`Msg "no client credentials. Run `gdocs install` first.")
56
+
| Some { client_id; client_secret } -> (
57
+
match load_token fs with
58
+
| None -> Error (`Msg "not logged in. Run `gdocs login` first.")
59
+
| Some json -> Gauth.of_json http ~clock ~client_id ~client_secret json)
+56
lib/store.mli
+56
lib/store.mli
···
1
+
(** On-disk storage of gdocs client credentials and user token.
2
+
3
+
Files live under the XDG config directory, typically [$HOME/.config/gdocs/]:
4
+
- [client.json] — OAuth client ID/secret (shared across users of this
5
+
install).
6
+
- [token.json] — per-user OAuth access/refresh token. *)
7
+
8
+
val config_dir : _ Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
9
+
(** [config_dir fs] is the gdocs config directory as an Eio path. *)
10
+
11
+
val client_path : _ Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
12
+
(** [client_path fs] is the path to the saved OAuth client file. *)
13
+
14
+
val token_path : _ Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
15
+
(** [token_path fs] is the path to the saved user-token file. *)
16
+
17
+
type client = { client_id : string; client_secret : string }
18
+
(** OAuth client credentials, as produced by [gdocs install]. *)
19
+
20
+
val save_client : _ Eio.Path.t -> client -> unit
21
+
(** [save_client fs c] writes [c] to {!client_path}. The file is created with
22
+
mode 0600; if it already exists the mode is tightened to 0600. The parent
23
+
directory is created by {!Xdge} with the permissions {!Xdge.v} assigns (0755
24
+
on Unix). *)
25
+
26
+
val load_client : _ Eio.Path.t -> client option
27
+
(** [load_client fs] reads the client file, or [None] if absent or malformed. *)
28
+
29
+
val save_token : _ Eio.Path.t -> string -> unit
30
+
(** [save_token fs body] writes the token JSON produced by {!Gauth.to_json},
31
+
with the same permission handling as {!save_client}. *)
32
+
33
+
val load_token : _ Eio.Path.t -> string option
34
+
(** [load_token fs] reads the saved token JSON, or [None] if absent. *)
35
+
36
+
val clear_token : _ Eio.Path.t -> unit
37
+
(** [clear_token fs] removes the saved token file if it exists. Used by
38
+
[gdocs install] when the OAuth client is reinstalled, since tokens issued
39
+
against the old client cannot be refreshed against the new one. *)
40
+
41
+
val acquire :
42
+
Requests.t ->
43
+
clock:_ Eio.Time.clock ->
44
+
fs:_ Eio.Path.t ->
45
+
(Gauth.token, [ `Msg of string ]) result
46
+
(** [acquire http ~clock ~fs] loads the saved client and token and returns a
47
+
refreshable {!Gauth.token}. Returns an error describing the missing
48
+
prerequisite (client or token) if either is absent. *)
49
+
50
+
val persist : _ Eio.Path.t -> Gauth.token -> unit
51
+
(** [persist fs token] serializes [token]'s current state to disk via
52
+
{!save_token}. Call this at the end of a command so that any refresh
53
+
performed in-memory during the run survives to the next invocation —
54
+
otherwise the next run reloads the stale pre-refresh token from disk and
55
+
refreshes unnecessarily (or fails once the stale access token expires past
56
+
the refresh_token's own lifetime). *)
+3
test/dune
+3
test/dune
+9
test/test.ml
+9
test/test.ml
+91
test/test_comments.ml
+91
test/test_comments.ml
···
1
+
(** Tests for Gdocs.Comments parsing. *)
2
+
3
+
let parse_ok body =
4
+
match Gdocs.Comments.of_json_string body with
5
+
| Ok cs -> cs
6
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
7
+
8
+
let parses_comment_list () =
9
+
let body =
10
+
{|{
11
+
"kind":"drive#commentList",
12
+
"comments":[
13
+
{
14
+
"id":"c1",
15
+
"author":{"displayName":"Alice","kind":"drive#user"},
16
+
"content":"Check this out",
17
+
"quotedFileContent":{"mimeType":"text/plain","value":"some text"},
18
+
"anchor":"kix.abc",
19
+
"resolved":false
20
+
},
21
+
{
22
+
"id":"c2",
23
+
"author":{"displayName":"Bob"},
24
+
"content":"Replied",
25
+
"resolved":true
26
+
}
27
+
]
28
+
}|}
29
+
in
30
+
let cs = parse_ok body in
31
+
Alcotest.(check int) "two comments" 2 (List.length cs);
32
+
let c1 = List.hd cs and c2 = List.nth cs 1 in
33
+
Alcotest.(check string) "c1 id" "c1" c1.id;
34
+
Alcotest.(check string) "c1 author" "Alice" c1.author;
35
+
Alcotest.(check string) "c1 content" "Check this out" c1.content;
36
+
Alcotest.(check string) "c1 quoted" "some text" c1.quoted_text;
37
+
Alcotest.(check (option string)) "c1 anchor" (Some "kix.abc") c1.anchor;
38
+
Alcotest.(check bool) "c1 resolved" false c1.resolved;
39
+
Alcotest.(check string) "c2 author" "Bob" c2.author;
40
+
Alcotest.(check (option string)) "c2 anchor absent" None c2.anchor;
41
+
Alcotest.(check bool) "c2 resolved" true c2.resolved
42
+
43
+
let empty_list () =
44
+
let body = {|{"kind":"drive#commentList","comments":[]}|} in
45
+
let cs = parse_ok body in
46
+
Alcotest.(check int) "zero comments" 0 (List.length cs)
47
+
48
+
let missing_comments_field () =
49
+
let body = {|{"kind":"drive#commentList"}|} in
50
+
let cs = parse_ok body in
51
+
Alcotest.(check int) "zero comments when field absent" 0 (List.length cs)
52
+
53
+
let missing_author () =
54
+
let body = {|{"comments":[{"id":"x","content":"body","resolved":false}]}|} in
55
+
let cs = parse_ok body in
56
+
let c = List.hd cs in
57
+
Alcotest.(check string) "author is empty string" "" c.author
58
+
59
+
let missing_quoted_content () =
60
+
let body =
61
+
{|{"comments":[{"id":"x","author":{"displayName":"A"},"content":"body","resolved":false}]}|}
62
+
in
63
+
let cs = parse_ok body in
64
+
let c = List.hd cs in
65
+
Alcotest.(check string) "quoted_text empty" "" c.quoted_text
66
+
67
+
let malformed_json () =
68
+
match Gdocs.Comments.of_json_string "not json" with
69
+
| Ok _ -> Alcotest.fail "expected Error"
70
+
| Error (`Msg _) -> ()
71
+
72
+
let scope_is_drive_url () =
73
+
let prefix = "https://www.googleapis.com/auth/drive" in
74
+
let p = String.length prefix in
75
+
Alcotest.(check bool)
76
+
"drive.readonly scope" true
77
+
(String.length Gdocs.Comments.scope >= p
78
+
&& String.sub Gdocs.Comments.scope 0 p = prefix)
79
+
80
+
let suite =
81
+
( "comments",
82
+
[
83
+
Alcotest.test_case "parses a comment list" `Quick parses_comment_list;
84
+
Alcotest.test_case "empty comments array" `Quick empty_list;
85
+
Alcotest.test_case "missing comments field" `Quick missing_comments_field;
86
+
Alcotest.test_case "missing author" `Quick missing_author;
87
+
Alcotest.test_case "missing quotedFileContent" `Quick
88
+
missing_quoted_content;
89
+
Alcotest.test_case "malformed JSON" `Quick malformed_json;
90
+
Alcotest.test_case "scope is drive URL" `Quick scope_is_drive_url;
91
+
] )
+2
test/test_comments.mli
+2
test/test_comments.mli
+218
test/test_document.ml
+218
test/test_document.ml
···
1
+
(** Tests for Gdocs.Document parsing and text extraction. *)
2
+
3
+
let sample =
4
+
{|{
5
+
"documentId": "1abc",
6
+
"title": "Hello World",
7
+
"body": {
8
+
"content": [
9
+
{ "sectionBreak": { "sectionStyle": {} } },
10
+
{ "paragraph": {
11
+
"elements": [
12
+
{ "textRun": { "content": "Hello, " } },
13
+
{ "textRun": { "content": "world!\n" } }
14
+
]
15
+
}
16
+
},
17
+
{ "paragraph": {
18
+
"elements": [
19
+
{ "textRun": { "content": "Second paragraph.\n" } }
20
+
]
21
+
}
22
+
}
23
+
]
24
+
}
25
+
}|}
26
+
27
+
let parse () =
28
+
match Gdocs.Document.of_json_string sample with
29
+
| Ok d -> d
30
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
31
+
32
+
let title_basic () =
33
+
let d = parse () in
34
+
Alcotest.(check string) "title" "Hello World" (Gdocs.Document.title d)
35
+
36
+
let document_id_basic () =
37
+
let d = parse () in
38
+
Alcotest.(check string) "documentId" "1abc" (Gdocs.Document.id d)
39
+
40
+
let to_json_preserves_body () =
41
+
let d = parse () in
42
+
Alcotest.(check string) "raw body preserved" sample (Gdocs.Document.to_json d)
43
+
44
+
let text_concatenates_runs () =
45
+
let d = parse () in
46
+
Alcotest.(check string)
47
+
"plain text" "Hello, world!\nSecond paragraph.\n" (Gdocs.Document.to_text d)
48
+
49
+
let text_no_double_newlines () =
50
+
let d = parse () in
51
+
let t = Gdocs.Document.to_text d in
52
+
let has_blank =
53
+
let n = String.length t in
54
+
let rec scan i =
55
+
if i + 1 >= n then false
56
+
else if t.[i] = '\n' && t.[i + 1] = '\n' then true
57
+
else scan (i + 1)
58
+
in
59
+
scan 0
60
+
in
61
+
Alcotest.(check bool) "no consecutive blank lines" false has_blank
62
+
63
+
let text_empty_body () =
64
+
let body = {|{"documentId":"x","title":"","body":{"content":[]}}|} in
65
+
match Gdocs.Document.of_json_string body with
66
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
67
+
| Ok d -> Alcotest.(check string) "empty text" "" (Gdocs.Document.to_text d)
68
+
69
+
let text_no_body_field () =
70
+
let body = {|{"documentId":"x","title":"T"}|} in
71
+
match Gdocs.Document.of_json_string body with
72
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
73
+
| Ok d -> Alcotest.(check string) "no body" "" (Gdocs.Document.to_text d)
74
+
75
+
let text_ignores_non_paragraph_elements () =
76
+
let body =
77
+
{|{
78
+
"documentId":"x","title":"T",
79
+
"body":{"content":[
80
+
{ "table": { "rows": 2, "columns": 2 } },
81
+
{ "paragraph": { "elements": [ { "textRun": { "content": "Real.\n" } } ] } },
82
+
{ "tableOfContents": {} }
83
+
]}
84
+
}|}
85
+
in
86
+
match Gdocs.Document.of_json_string body with
87
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
88
+
| Ok d ->
89
+
Alcotest.(check string)
90
+
"only paragraph text" "Real.\n" (Gdocs.Document.to_text d)
91
+
92
+
let text_ignores_non_textrun_elements () =
93
+
let body =
94
+
{|{
95
+
"documentId":"x","title":"T",
96
+
"body":{"content":[
97
+
{ "paragraph": { "elements": [
98
+
{ "pageBreak": {} },
99
+
{ "textRun": { "content": "Visible\n" } },
100
+
{ "footnoteReference": { "id": "f1" } }
101
+
] } }
102
+
]}
103
+
}|}
104
+
in
105
+
match Gdocs.Document.of_json_string body with
106
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
107
+
| Ok d ->
108
+
Alcotest.(check string)
109
+
"only textRun" "Visible\n" (Gdocs.Document.to_text d)
110
+
111
+
let text_handles_unicode () =
112
+
let body =
113
+
{|{
114
+
"documentId":"x","title":"T",
115
+
"body":{"content":[
116
+
{ "paragraph": { "elements": [
117
+
{ "textRun": { "content": "café — 日本語\n" } }
118
+
] } }
119
+
]}
120
+
}|}
121
+
in
122
+
match Gdocs.Document.of_json_string body with
123
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
124
+
| Ok d ->
125
+
Alcotest.(check string)
126
+
"unicode preserved" "café — 日本語\n" (Gdocs.Document.to_text d)
127
+
128
+
let text_walks_tabs () =
129
+
let body =
130
+
{|{
131
+
"documentId":"x","title":"T",
132
+
"tabs":[
133
+
{ "documentTab": { "body": { "content": [
134
+
{ "paragraph": { "elements": [ { "textRun": { "content": "Tab 1.\n" } } ] } }
135
+
] } } },
136
+
{ "documentTab": { "body": { "content": [
137
+
{ "paragraph": { "elements": [ { "textRun": { "content": "Tab 2.\n" } } ] } }
138
+
] } } }
139
+
]
140
+
}|}
141
+
in
142
+
match Gdocs.Document.of_json_string body with
143
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
144
+
| Ok d ->
145
+
Alcotest.(check string)
146
+
"both tabs" "Tab 1.\nTab 2.\n" (Gdocs.Document.to_text d)
147
+
148
+
let text_walks_child_tabs () =
149
+
let body =
150
+
{|{
151
+
"documentId":"x","title":"T",
152
+
"tabs":[
153
+
{ "documentTab": { "body": { "content": [
154
+
{ "paragraph": { "elements": [ { "textRun": { "content": "Parent.\n" } } ] } }
155
+
] } },
156
+
"childTabs": [
157
+
{ "documentTab": { "body": { "content": [
158
+
{ "paragraph": { "elements": [ { "textRun": { "content": "Child.\n" } } ] } }
159
+
] } } }
160
+
]
161
+
}
162
+
]
163
+
}|}
164
+
in
165
+
match Gdocs.Document.of_json_string body with
166
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
167
+
| Ok d ->
168
+
Alcotest.(check string)
169
+
"parent + child tab" "Parent.\nChild.\n" (Gdocs.Document.to_text d)
170
+
171
+
let title_absent () =
172
+
let body = {|{"documentId":"x"}|} in
173
+
match Gdocs.Document.of_json_string body with
174
+
| Ok d -> Alcotest.(check string) "empty title" "" (Gdocs.Document.title d)
175
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
176
+
177
+
let id_absent () =
178
+
let body = {|{"title":"t"}|} in
179
+
match Gdocs.Document.of_json_string body with
180
+
| Ok d -> Alcotest.(check string) "empty id" "" (Gdocs.Document.id d)
181
+
| Error (`Msg m) -> Alcotest.failf "parse: %s" m
182
+
183
+
let of_json_string_rejects_junk () =
184
+
match Gdocs.Document.of_json_string "not json" with
185
+
| Ok _ -> Alcotest.fail "expected Error"
186
+
| Error (`Msg _) -> ()
187
+
188
+
let of_json_string_rejects_truncated () =
189
+
match Gdocs.Document.of_json_string "{" with
190
+
| Ok _ -> Alcotest.fail "expected Error for truncated JSON"
191
+
| Error (`Msg _) -> ()
192
+
193
+
let suite =
194
+
( "document",
195
+
[
196
+
Alcotest.test_case "title" `Quick title_basic;
197
+
Alcotest.test_case "id" `Quick document_id_basic;
198
+
Alcotest.test_case "to_json preserves body" `Quick to_json_preserves_body;
199
+
Alcotest.test_case "to_text concatenates runs" `Quick
200
+
text_concatenates_runs;
201
+
Alcotest.test_case "to_text produces no double newlines" `Quick
202
+
text_no_double_newlines;
203
+
Alcotest.test_case "to_text empty body" `Quick text_empty_body;
204
+
Alcotest.test_case "to_text with no body field" `Quick text_no_body_field;
205
+
Alcotest.test_case "to_text ignores tables/toc" `Quick
206
+
text_ignores_non_paragraph_elements;
207
+
Alcotest.test_case "to_text ignores non-textRun elements" `Quick
208
+
text_ignores_non_textrun_elements;
209
+
Alcotest.test_case "to_text preserves unicode" `Quick text_handles_unicode;
210
+
Alcotest.test_case "to_text walks top-level tabs" `Quick text_walks_tabs;
211
+
Alcotest.test_case "to_text walks child tabs" `Quick text_walks_child_tabs;
212
+
Alcotest.test_case "title absent → empty" `Quick title_absent;
213
+
Alcotest.test_case "id absent → empty" `Quick id_absent;
214
+
Alcotest.test_case "of_json_string rejects junk" `Quick
215
+
of_json_string_rejects_junk;
216
+
Alcotest.test_case "of_json_string rejects truncated" `Quick
217
+
of_json_string_rejects_truncated;
218
+
] )
+2
test/test_document.mli
+2
test/test_document.mli
+28
test/test_gdocs.ml
+28
test/test_gdocs.ml
···
1
+
let has_prefix ~prefix s =
2
+
String.length s >= String.length prefix
3
+
&& String.sub s 0 (String.length prefix) = prefix
4
+
5
+
let scope_readonly_url () =
6
+
Alcotest.(check bool)
7
+
"readonly scope begins with googleapis URL" true
8
+
(has_prefix ~prefix:"https://www.googleapis.com/" Gdocs.scope_readonly)
9
+
10
+
let scope_readwrite_url () =
11
+
Alcotest.(check bool)
12
+
"readwrite scope begins with googleapis URL" true
13
+
(has_prefix ~prefix:"https://www.googleapis.com/" Gdocs.scope_readwrite)
14
+
15
+
let scopes_differ () =
16
+
Alcotest.(check bool)
17
+
"readonly ≠ readwrite" true
18
+
(Gdocs.scope_readonly <> Gdocs.scope_readwrite)
19
+
20
+
let suite =
21
+
( "gdocs",
22
+
[
23
+
Alcotest.test_case "readonly scope is googleapis URL" `Quick
24
+
scope_readonly_url;
25
+
Alcotest.test_case "readwrite scope is googleapis URL" `Quick
26
+
scope_readwrite_url;
27
+
Alcotest.test_case "scopes are distinct" `Quick scopes_differ;
28
+
] )
+2
test/test_gdocs.mli
+2
test/test_gdocs.mli
+305
test/test_markdown.ml
+305
test/test_markdown.ml
···
1
+
(** Tests for Gdocs.Markdown rendering. *)
2
+
3
+
let parse_doc json =
4
+
match Gdocs.Document.of_json_string json with
5
+
| Ok d -> d
6
+
| Error (`Msg m) -> Alcotest.failf "parse doc: %s" m
7
+
8
+
let render json = Gdocs.Markdown.of_document (parse_doc json)
9
+
10
+
(* Helper: assert that the rendered markdown parses back cleanly through
11
+
Cmarkit without raising. *)
12
+
let assert_parses md =
13
+
let _ = Cmarkit.Doc.of_string md in
14
+
()
15
+
16
+
(* ── Title → leading H1 ───────────────────────────────────── *)
17
+
18
+
let title_becomes_h1 () =
19
+
let md =
20
+
render
21
+
{|{"documentId":"x","title":"My Doc","body":{"content":[
22
+
{ "paragraph": { "elements": [ { "textRun": { "content": "body\n" } } ] } }
23
+
]}}|}
24
+
in
25
+
Alcotest.(check bool)
26
+
"starts with '# My Doc'" true
27
+
(String.length md >= 9 && String.sub md 0 9 = "# My Doc\n");
28
+
assert_parses md
29
+
30
+
let title_body_title_not_duplicated () =
31
+
(* If the body itself starts with a TITLE paragraph, skip the auto H1. *)
32
+
let md =
33
+
render
34
+
{|{"documentId":"x","title":"Doc",
35
+
"body":{"content":[
36
+
{ "paragraph": {
37
+
"paragraphStyle": { "namedStyleType": "TITLE" },
38
+
"elements": [ { "textRun": { "content": "Real Title\n" } } ]
39
+
} }
40
+
]}}|}
41
+
in
42
+
(* Output should have exactly one '# Real Title' heading, not a
43
+
duplicate '# Doc' from the title field. *)
44
+
let count_lines_starting prefix s =
45
+
let n = String.length s and p = String.length prefix in
46
+
let rec loop i acc =
47
+
if i >= n then acc
48
+
else if
49
+
(i = 0 || s.[i - 1] = '\n') && i + p <= n && String.sub s i p = prefix
50
+
then loop (i + 1) (acc + 1)
51
+
else loop (i + 1) acc
52
+
in
53
+
loop 0 0
54
+
in
55
+
Alcotest.(check int) "one H1" 1 (count_lines_starting "# " md);
56
+
assert_parses md
57
+
58
+
(* ── Headings ─────────────────────────────────────────────── *)
59
+
60
+
let heading_levels () =
61
+
let mk style text =
62
+
Fmt.str
63
+
{|{"paragraph":{"paragraphStyle":{"namedStyleType":"%s"},"elements":[{"textRun":{"content":"%s\n"}}]}}|}
64
+
style text
65
+
in
66
+
let body =
67
+
Fmt.str {|{"documentId":"x","title":"","body":{"content":[%s,%s,%s,%s]}}|}
68
+
(mk "HEADING_1" "One") (mk "HEADING_2" "Two") (mk "HEADING_3" "Three")
69
+
(mk "NORMAL_TEXT" "body")
70
+
in
71
+
let md = render body in
72
+
let has_line line =
73
+
let n = String.length md and l = String.length line in
74
+
let rec loop i =
75
+
if i + l > n then false
76
+
else if
77
+
(i = 0 || md.[i - 1] = '\n')
78
+
&& String.sub md i l = line
79
+
&& (i + l = n || md.[i + l] = '\n')
80
+
then true
81
+
else loop (i + 1)
82
+
in
83
+
loop 0
84
+
in
85
+
Alcotest.(check bool) "# One" true (has_line "# One");
86
+
Alcotest.(check bool) "## Two" true (has_line "## Two");
87
+
Alcotest.(check bool) "### Three" true (has_line "### Three");
88
+
Alcotest.(check bool) "body paragraph" true (has_line "body");
89
+
assert_parses md
90
+
91
+
(* ── Bold / italic / link ─────────────────────────────────── *)
92
+
93
+
let bold_italic () =
94
+
let body =
95
+
{|{"documentId":"x","title":"",
96
+
"body":{"content":[
97
+
{ "paragraph": { "elements": [
98
+
{ "textRun": { "content": "normal " } },
99
+
{ "textRun": { "content": "bold", "textStyle": { "bold": true } } },
100
+
{ "textRun": { "content": " and " } },
101
+
{ "textRun": { "content": "italic", "textStyle": { "italic": true } } },
102
+
{ "textRun": { "content": ".\n" } }
103
+
] } }
104
+
]}}|}
105
+
in
106
+
let md = render body in
107
+
let contains sub =
108
+
let n = String.length md and l = String.length sub in
109
+
let rec loop i =
110
+
if i + l > n then false
111
+
else if String.sub md i l = sub then true
112
+
else loop (i + 1)
113
+
in
114
+
loop 0
115
+
in
116
+
Alcotest.(check bool) "has **bold**" true (contains "**bold**");
117
+
Alcotest.(check bool) "has *italic*" true (contains "*italic*");
118
+
assert_parses md
119
+
120
+
let links_render () =
121
+
let body =
122
+
{|{"documentId":"x","title":"",
123
+
"body":{"content":[
124
+
{ "paragraph": { "elements": [
125
+
{ "textRun": { "content": "Visit ", "textStyle": {} } },
126
+
{ "textRun": { "content": "Google",
127
+
"textStyle": { "link": { "url": "https://google.com" } } } },
128
+
{ "textRun": { "content": ".\n" } }
129
+
] } }
130
+
]}}|}
131
+
in
132
+
let md = render body in
133
+
let contains sub =
134
+
let n = String.length md and l = String.length sub in
135
+
let rec loop i =
136
+
if i + l > n then false
137
+
else if String.sub md i l = sub then true
138
+
else loop (i + 1)
139
+
in
140
+
loop 0
141
+
in
142
+
Alcotest.(check bool)
143
+
"has link" true
144
+
(contains "[Google](https://google.com)");
145
+
assert_parses md
146
+
147
+
(* ── Bullet lists ─────────────────────────────────────────── *)
148
+
149
+
let bullet_list () =
150
+
let body =
151
+
{|{"documentId":"x","title":"",
152
+
"body":{"content":[
153
+
{ "paragraph": {
154
+
"bullet": { "listId": "L1" },
155
+
"elements": [ { "textRun": { "content": "first\n" } } ]
156
+
} },
157
+
{ "paragraph": {
158
+
"bullet": { "listId": "L1" },
159
+
"elements": [ { "textRun": { "content": "second\n" } } ]
160
+
} }
161
+
]}}|}
162
+
in
163
+
let md = render body in
164
+
let has_line line =
165
+
let n = String.length md and l = String.length line in
166
+
let rec loop i =
167
+
if i + l > n then false
168
+
else if
169
+
(i = 0 || md.[i - 1] = '\n')
170
+
&& String.sub md i l = line
171
+
&& (i + l = n || md.[i + l] = '\n')
172
+
then true
173
+
else loop (i + 1)
174
+
in
175
+
loop 0
176
+
in
177
+
Alcotest.(check bool) "- first" true (has_line "- first");
178
+
Alcotest.(check bool) "- second" true (has_line "- second");
179
+
assert_parses md
180
+
181
+
(* ── Escaping ─────────────────────────────────────────────── *)
182
+
183
+
let escapes_markdown_metacharacters () =
184
+
let body =
185
+
{|{"documentId":"x","title":"",
186
+
"body":{"content":[
187
+
{ "paragraph": { "elements": [
188
+
{ "textRun": { "content": "A * B _ C [ D ]\n" } }
189
+
] } }
190
+
]}}|}
191
+
in
192
+
let md = render body in
193
+
let contains sub =
194
+
let n = String.length md and l = String.length sub in
195
+
let rec loop i =
196
+
if i + l > n then false
197
+
else if String.sub md i l = sub then true
198
+
else loop (i + 1)
199
+
in
200
+
loop 0
201
+
in
202
+
Alcotest.(check bool) "backslash-escaped *" true (contains "\\*");
203
+
Alcotest.(check bool) "backslash-escaped _" true (contains "\\_");
204
+
Alcotest.(check bool) "backslash-escaped [" true (contains "\\[");
205
+
assert_parses md
206
+
207
+
(* ── Tabs ─────────────────────────────────────────────────── *)
208
+
209
+
let walks_tabs () =
210
+
let body =
211
+
{|{"documentId":"x","title":"",
212
+
"tabs":[
213
+
{ "documentTab": { "body": { "content": [
214
+
{ "paragraph": { "elements": [ { "textRun": { "content": "Tab1\n" } } ] } }
215
+
] } } }
216
+
]}|}
217
+
in
218
+
let md = render body in
219
+
let contains sub =
220
+
let n = String.length md and l = String.length sub in
221
+
let rec loop i =
222
+
if i + l > n then false
223
+
else if String.sub md i l = sub then true
224
+
else loop (i + 1)
225
+
in
226
+
loop 0
227
+
in
228
+
Alcotest.(check bool) "tab content rendered" true (contains "Tab1");
229
+
assert_parses md
230
+
231
+
(* ── Comments footer ─────────────────────────────────────── *)
232
+
233
+
let comments_appended () =
234
+
let doc =
235
+
parse_doc
236
+
{|{"documentId":"x","title":"D","body":{"content":[
237
+
{ "paragraph": { "elements": [ { "textRun": { "content": "body\n" } } ] } }
238
+
]}}|}
239
+
in
240
+
let comments : Gdocs.Comments.t list =
241
+
[
242
+
{
243
+
id = "c1";
244
+
author = "Alice";
245
+
content = "Looks good";
246
+
quoted_text = "body";
247
+
anchor = Some "kix.abc";
248
+
resolved = false;
249
+
};
250
+
]
251
+
in
252
+
let md = Gdocs.Markdown.of_document_with_comments ~comments doc in
253
+
let contains sub =
254
+
let n = String.length md and l = String.length sub in
255
+
let rec loop i =
256
+
if i + l > n then false
257
+
else if String.sub md i l = sub then true
258
+
else loop (i + 1)
259
+
in
260
+
loop 0
261
+
in
262
+
Alcotest.(check bool) "comments heading" true (contains "## Comments");
263
+
Alcotest.(check bool) "author" true (contains "Alice");
264
+
Alcotest.(check bool) "content" true (contains "Looks good");
265
+
Alcotest.(check bool) "quoted in blockquote" true (contains "> body");
266
+
assert_parses md
267
+
268
+
let no_comments_no_footer () =
269
+
let doc =
270
+
parse_doc
271
+
{|{"documentId":"x","title":"D","body":{"content":[
272
+
{ "paragraph": { "elements": [ { "textRun": { "content": "body\n" } } ] } }
273
+
]}}|}
274
+
in
275
+
let md = Gdocs.Markdown.of_document_with_comments ~comments:[] doc in
276
+
let contains sub =
277
+
let n = String.length md and l = String.length sub in
278
+
let rec loop i =
279
+
if i + l > n then false
280
+
else if String.sub md i l = sub then true
281
+
else loop (i + 1)
282
+
in
283
+
loop 0
284
+
in
285
+
Alcotest.(check bool)
286
+
"no '## Comments' section" false (contains "## Comments")
287
+
288
+
(* ── Suite ───────────────────────────────────────────────── *)
289
+
290
+
let suite =
291
+
( "markdown",
292
+
[
293
+
Alcotest.test_case "title becomes leading H1" `Quick title_becomes_h1;
294
+
Alcotest.test_case "TITLE body paragraph not duplicated" `Quick
295
+
title_body_title_not_duplicated;
296
+
Alcotest.test_case "heading levels" `Quick heading_levels;
297
+
Alcotest.test_case "bold and italic" `Quick bold_italic;
298
+
Alcotest.test_case "links render" `Quick links_render;
299
+
Alcotest.test_case "bullet list" `Quick bullet_list;
300
+
Alcotest.test_case "escapes markdown metachars" `Quick
301
+
escapes_markdown_metacharacters;
302
+
Alcotest.test_case "walks tabs" `Quick walks_tabs;
303
+
Alcotest.test_case "comments appended as section" `Quick comments_appended;
304
+
Alcotest.test_case "no comments → no section" `Quick no_comments_no_footer;
305
+
] )
+2
test/test_markdown.mli
+2
test/test_markdown.mli
+172
test/test_store.ml
+172
test/test_store.ml
···
1
+
(* Tests for Gdocs.Store. Uses XDG_CONFIG_HOME to redirect the config
2
+
directory into a per-test temp dir so tests are hermetic. *)
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 "gdocs-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 : Gdocs.Store.client =
53
+
{ client_id = "123.apps.googleusercontent.com"; client_secret = "sek-REt" }
54
+
55
+
(* ── Client credentials ──────────────────────────────────────── *)
56
+
57
+
let save_load_roundtrip () =
58
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
59
+
Gdocs.Store.save_client fs sample;
60
+
match Gdocs.Store.load_client fs with
61
+
| None -> Alcotest.fail "expected Some client after save"
62
+
| Some c ->
63
+
Alcotest.(check string) "client_id" sample.client_id c.client_id;
64
+
Alcotest.(check string)
65
+
"client_secret" sample.client_secret c.client_secret
66
+
67
+
let load_absent_returns_none () =
68
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
69
+
Alcotest.(check bool)
70
+
"no client file" true
71
+
(Option.is_none (Gdocs.Store.load_client fs))
72
+
73
+
let load_malformed_returns_none () =
74
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
75
+
Gdocs.Store.save_client fs sample;
76
+
Eio.Path.save ~create:(`Or_truncate 0o600)
77
+
(Gdocs.Store.client_path fs)
78
+
"not json";
79
+
Alcotest.(check bool)
80
+
"malformed → None" true
81
+
(Option.is_none (Gdocs.Store.load_client fs))
82
+
83
+
let overwrite_client () =
84
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
85
+
Gdocs.Store.save_client fs sample;
86
+
let updated =
87
+
{ Gdocs.Store.client_id = "new-id"; client_secret = "new-sek" }
88
+
in
89
+
Gdocs.Store.save_client fs updated;
90
+
match Gdocs.Store.load_client fs with
91
+
| Some c -> Alcotest.(check string) "client_id updated" "new-id" c.client_id
92
+
| None -> Alcotest.fail "expected Some"
93
+
94
+
let client_file_permissions () =
95
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
96
+
Gdocs.Store.save_client fs sample;
97
+
let path = Gdocs.Store.client_path fs in
98
+
let st = Unix.stat (snd path) in
99
+
Alcotest.(check int) "client file is 0600" 0o600 (st.st_perm land 0o777)
100
+
101
+
(* ── Token persistence ───────────────────────────────────────── *)
102
+
103
+
let token_save_load () =
104
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
105
+
let body = {|{"access_token":"A","refresh_token":"R","expires_at":1.0}|} in
106
+
Gdocs.Store.save_token fs body;
107
+
match Gdocs.Store.load_token fs with
108
+
| Some s -> Alcotest.(check string) "token body preserved" body s
109
+
| None -> Alcotest.fail "expected Some token"
110
+
111
+
let token_absent_returns_none () =
112
+
with_tmp_env @@ fun ~fs ~http:_ ~clock:_ ->
113
+
Alcotest.(check bool)
114
+
"no token file" true
115
+
(Option.is_none (Gdocs.Store.load_token fs))
116
+
117
+
(* ── acquire ─────────────────────────────────────────────────── *)
118
+
119
+
let acquire_without_client () =
120
+
with_tmp_env @@ fun ~fs ~http ~clock ->
121
+
match Gdocs.Store.acquire http ~clock ~fs with
122
+
| Error (`Msg m) ->
123
+
Alcotest.(check bool)
124
+
"error mentions install" true
125
+
(contains ~sub:"install" m)
126
+
| Ok _ -> Alcotest.fail "expected Error when no client"
127
+
128
+
let acquire_without_token () =
129
+
with_tmp_env @@ fun ~fs ~http ~clock ->
130
+
Gdocs.Store.save_client fs sample;
131
+
match Gdocs.Store.acquire http ~clock ~fs with
132
+
| Error (`Msg m) ->
133
+
Alcotest.(check bool)
134
+
"error mentions login" true (contains ~sub:"login" m)
135
+
| Ok _ -> Alcotest.fail "expected Error when no token"
136
+
137
+
let acquire_ok () =
138
+
with_tmp_env @@ fun ~fs ~http ~clock ->
139
+
Gdocs.Store.save_client fs sample;
140
+
let future = Eio.Time.now clock +. 3600. in
141
+
Gdocs.Store.save_token fs
142
+
(Fmt.str {|{"access_token":"ACCESS","refresh_token":"R","expires_at":%f}|}
143
+
future);
144
+
match Gdocs.Store.acquire http ~clock ~fs with
145
+
| Error (`Msg m) -> Alcotest.failf "acquire failed: %s" m
146
+
| Ok t -> (
147
+
match Gauth.try_access t with
148
+
| Ok s -> Alcotest.(check string) "access_token" "ACCESS" s
149
+
| Error (`Msg m) -> Alcotest.failf "try_access: %s" m)
150
+
151
+
(* ── Suite ──────────────────────────────────────────────────── *)
152
+
153
+
let suite =
154
+
( "store",
155
+
[
156
+
Alcotest.test_case "client save/load roundtrip" `Quick save_load_roundtrip;
157
+
Alcotest.test_case "load_client absent → None" `Quick
158
+
load_absent_returns_none;
159
+
Alcotest.test_case "load_client malformed → None" `Quick
160
+
load_malformed_returns_none;
161
+
Alcotest.test_case "save_client overwrites" `Quick overwrite_client;
162
+
Alcotest.test_case "client file is 0600" `Quick client_file_permissions;
163
+
Alcotest.test_case "token save/load roundtrip" `Quick token_save_load;
164
+
Alcotest.test_case "load_token absent → None" `Quick
165
+
token_absent_returns_none;
166
+
Alcotest.test_case "acquire without client errors" `Quick
167
+
acquire_without_client;
168
+
Alcotest.test_case "acquire without token errors" `Quick
169
+
acquire_without_token;
170
+
Alcotest.test_case "acquire with client+token returns token" `Quick
171
+
acquire_ok;
172
+
] )