From 39ea1f9b330b8660815937917b3bd957e244f099 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 24 Apr 2026 18:54:51 +0200 Subject: [PATCH 01/15] Split local and global frontmatter This is to later allow local frontmatter in included files Has the side effect of removing cli options, which is I think better: a file is more self-contained this way! --- src/cli/main.ml | 180 +------------------------ src/cli/run.ml | 91 +++++-------- src/cli/run.mli | 8 +- src/compiler/compile.ml | 8 +- src/compiler/compile.mli | 4 +- src/compiler/frontmatter.ml | 207 ++++++++++++++--------------- src/compiler/frontmatter.mli | 76 ++++++----- src/compiler/slipshow.ml | 49 +++---- src/compiler/slipshow.mli | 2 - src/engine/previewer/previewer.ml | 6 +- src/engine/previewer/previewer.mli | 1 - test/compiler/dimension.t/run.t | 80 +++++++---- test/compiler/simple.t/run.t | 38 ------ test/compiler/theme.t/run.t | 28 ++-- 14 files changed, 282 insertions(+), 496 deletions(-) diff --git a/src/cli/main.ml b/src/cli/main.ml index 4cb48f1b..5ce045cc 100644 --- a/src/cli/main.ml +++ b/src/cli/main.ml @@ -16,32 +16,6 @@ let setup_log = let handle_error = function Ok _ as x -> x | Error (`Msg msg) -> Error msg module Custom_conv = struct - let toplevel_attributes = - let parser s = - Slipshow.Frontmatter.Toplevel_attributes.of_string - (s, Cmarkit.Textloc.none) - |> Result.map @@ fun s -> Some s - in - let printer fmt attrs = - let attrs = - Option.value ~default:Slipshow.Frontmatter.Toplevel_attributes.default - attrs - in - let doc = - Cmarkit.Doc.make - (Cmarkit.Block.Ext_standalone_attributes (attrs, Cmarkit.Meta.none)) - in - let s = - let renderer = - Cmarkit_commonmark.renderer ~include_attributes:true () - in - Cmarkit_renderer.doc_to_string renderer doc - in - let s = String.trim s in - Format.fprintf fmt "%s" s - in - Arg.conv (parser, printer) - let io std = let parser_ s = match s with "-" -> Ok std | s -> Ok (`File (Fpath.v s)) @@ -54,109 +28,9 @@ module Custom_conv = struct let input = io `Stdin let output = io `Stdout - - let theme = - let parser_ s = - Result.map Option.some - (Slipshow.Frontmatter.Theme.of_string (s, Cmarkit.Textloc.none)) - in - let rec printer fmt = function - | Some (`Builtin s) -> Format.fprintf fmt "%s" (Themes.to_string s) - | Some (`External s) -> Format.fprintf fmt "%s" s - | None -> printer fmt (Some Slipshow.Frontmatter.Theme.default) - in - Arg.conv (parser_, printer) - - let math_mode = - let parser_ s = - Result.map (fun x -> Some x) - @@ Slipshow.Frontmatter.Math_mode.of_string (s, Cmarkit.Textloc.none) - in - let rec printer fmt = function - | Some `Mathjax -> Format.fprintf fmt "mathjax" - | Some `Katex -> Format.fprintf fmt "katex" - | None -> printer fmt (Some Slipshow.Frontmatter.Math_mode.default) - in - Arg.conv (parser_, printer) - - let dimension = - let int_printer = Cmdliner.Arg.(conv_printer int) in - let parser_ s = - Result.map (fun x -> Some x) - @@ Slipshow.Frontmatter.Dimension.of_string (s, Cmarkit.Textloc.none) - in - let rec printer fmt x = - match x with - | Some (1440, 1080) -> Format.fprintf fmt "4:3" - | Some (1920, 1080) -> Format.fprintf fmt "16:9" - | Some (w, h) -> Format.fprintf fmt "%ax%a" int_printer w int_printer h - | None -> printer fmt (Some Slipshow.Frontmatter.Dimension.default) - in - Cmdliner.Arg.conv ~docv:"WIDTHxHEIGHT" (parser_, printer) end module Compile_args = struct - let css_links = - let doc = - "CSS files to add to the presentation. Can be a local file or a remote \ - URL" - in - Arg.(value & opt_all string [] & info ~docv:"URL" ~doc [ "css" ]) - - let js_links = - let doc = - "JS files to add to the presentation. Can be a local file or a remote URL" - in - Arg.(value & opt_all string [] & info ~docv:"URL" ~doc [ "js" ]) - - let theme = - let doc = - "Slipshow theme to use in the presentation. Can be \"default\" for the \ - default theme, \"none\" for no theme, a local file or a remote URL." - in - Arg.(value & opt Custom_conv.theme None & info ~docv:"URL" ~doc [ "theme" ]) - - let highlightjs_theme = - let doc = "Highlightjs theme to use when highlighting code blocks." in - Arg.( - value - & opt (some string) None - & info ~docv:"THEME_NAME" ~doc [ "highlightjs-theme" ]) - - let math_link = - let doc = - "Where to find the javascript file for rendering math. Optional. When \ - absent, uses mathjax.3.2.2 or katex.0.16.28, depending on the value of \ - math-mode. If URL is an absolute URL, links to it, otherwise the \ - content is embedded in the html file." - in - Arg.( - value - & opt (some string) None - & info ~docv:"URL" ~doc [ "m"; "math-script" ]) - - let dim = - let doc = - "The fixed dimension (in pixels) for your presentation. Can be either \ - WIDTHxHEIGHT where both are integers, or 4:3 (which corresponds to \ - 1440x1080), or 16:9 (which corresponds to 1920x1080)." - in - Arg.( - value - & opt Custom_conv.dimension None - & info ~docv:"WIDTHxHEIGHT" ~doc [ "d"; "dimension"; "dim" ]) - - let toplevel_attributes = - let doc = - "The attributes given to the toplevel element containing all the \ - presentation. Can be enclosed in '{ ... }' or not. Same syntax as \ - attributes in the source file. For experts!" - in - Arg.( - value - & opt Custom_conv.toplevel_attributes None - & info ~docv:"ATTRIBUTES" ~doc [ "toplevel-attributes" ]) - let output = let doc = "Output file path. When absent, generate a filename based on the input \ @@ -174,51 +48,15 @@ module Compile_args = struct in Arg.(value & pos 0 Custom_conv.input `Stdin & info [] ~doc ~docv:"FILE.md") - let math_mode = - let doc = - "Whether to use KaTeX or MathJax to render mathematics. Can be \ - $(b,mathjax) or $(b,katex)." - in - Arg.( - value - & opt Custom_conv.math_mode None - & info [ "math-mode" ] ~doc ~docv:"MODE") - type compile_args = { - cli_frontmatter : Slipshow.Frontmatter.unresolved Slipshow.Frontmatter.t; input : [ `File of Fpath.t | `Stdin ]; output : [ `File of Fpath.t | `Stdout ] option; } let term = let open Term.Syntax in - let+ math_link = math_link - and+ math_mode = math_mode - and+ theme = theme - and+ highlightjs_theme = highlightjs_theme - and+ css_links = css_links - and+ js_links = js_links - and+ input = input - and+ output = output - and+ dimension = dim - and+ toplevel_attributes = toplevel_attributes in - { - cli_frontmatter = - Slipshow.Frontmatter.Unresolved - { - math_link; - theme; - css_links; - dimension; - toplevel_attributes; - js_links; - highlightjs_theme; - math_mode; - external_ids = []; - }; - input; - output; - } + let+ input = input and+ output = output in + { input; output } end module Utils = struct @@ -249,15 +87,12 @@ module Compile = struct | `File o -> Ok (input, o) | `Stdout -> Error "Standard output cannot be used in serve nor watch mode" - let compile ~watch - ~compile_args:{ Compile_args.input; output; cli_frontmatter } = + let compile ~watch ~compile_args:{ Compile_args.input; output } = let output = Utils.output_of_input ~ext:"html" output input in if watch then let* input, output = force_file_io input output in - Run.watch ~cli_frontmatter ~input ~output |> handle_error - else - Run.compile ~input ~output ~cli_frontmatter - |> Result.map ignore |> handle_error + Run.watch ~input ~output |> handle_error + else Run.compile ~input ~output |> Result.map ignore |> handle_error let term = let open Term.Syntax in @@ -278,11 +113,10 @@ end module Serve = struct let ( let* ) = Result.bind - let serve ~port ~compile_args:{ Compile_args.input; output; cli_frontmatter } - = + let serve ~port ~compile_args:{ Compile_args.input; output } = let output = Utils.output_of_input ~ext:"html" output input in let* input, output = Compile.force_file_io input output in - Run.serve ~input ~output ~cli_frontmatter ~port |> handle_error + Run.serve ~input ~output ~port |> handle_error let port = let doc = "Which port to use." in diff --git a/src/cli/run.ml b/src/cli/run.ml index 07ad2013..74f7ae86 100644 --- a/src/cli/run.ml +++ b/src/cli/run.ml @@ -23,39 +23,31 @@ module Io = struct with exn -> Error (`Msg (Printexc.to_string exn)) end -let read_file parent () = +let with_read_file parent f = let l = ref Fpath.Set.empty in - ( l, - fun s -> - let ( // ) = Fpath.( // ) in - let fp = Fpath.normalize @@ (parent // s) in - let normalized = Fpath.normalize @@ (Fpath.v (Sys.getcwd ()) // fp) in - l := Fpath.Set.add normalized !l; - let+ res = Io.read (`File fp) in - Some res ) - -let compile ~input ~output ~cli_frontmatter = - let asset_files, to_asset = - let used_files, read_file = read_file (Fpath.v "./") () in - (used_files, Slipshow.Asset.of_string ~read_file) - in - let cli_frontmatter, warnings = - Diagnosis.with_ @@ fun () -> - Slipshow.Frontmatter.resolve cli_frontmatter ~to_asset + let read_file = + fun s -> + let ( // ) = Fpath.( // ) in + let fp = Fpath.normalize @@ (parent // s) in + let normalized = Fpath.normalize @@ (Fpath.v (Sys.getcwd ()) // fp) in + l := Fpath.Set.add normalized !l; + let+ res = Io.read (`File fp) in + Some res in - List.iter (Format.printf "%a" Diagnosis.report_no_src) warnings; + let res = f read_file in + (res, !l) + +let compile ~input ~output = let* content = Io.read input in - let used_files, read_file = - read_file - (match input with `Stdin -> Fpath.v "./" | `File f -> Fpath.parent f) - () - in - let html, warnings = + let (html, warnings), used_files = + let parent = + match input with `Stdin -> Fpath.v "./" | `File f -> Fpath.parent f + in let file = match input with `File f -> Some (Fpath.to_string f) | _ -> None in - Slipshow.convert ~has_speaker_view:true ~frontmatter:cli_frontmatter ?file - ~read_file content + with_read_file parent @@ fun read_file -> + Slipshow.convert ~has_speaker_view:true ?file ~read_file content in let () = List.iter @@ -64,47 +56,37 @@ let compile ~input ~output ~cli_frontmatter = ~code_to_string:Diagnosis.to_code)) warnings in - let all_used_files = Fpath.Set.union !asset_files !used_files in match output with | `Stdout -> print_string html; - Ok all_used_files + Ok used_files | `File output -> ( let+ () = Io.write output html in match input with - | `Stdin -> !used_files + | `Stdin -> used_files | `File f -> Fpath.Set.add (Fpath.normalize (Fpath.( // ) (Fpath.v (Sys.getcwd ())) f)) - all_used_files) + used_files) -let watch ~input ~output ~cli_frontmatter = +let watch ~input ~output = let input_fpath = input in let input = `File input and output = `File output in let compile () = Logs.app (fun m -> m "Compiling..."); - compile ~input ~output ~cli_frontmatter + compile ~input ~output in let () = Slipshow_server.do_watch input_fpath compile in (* [do_watch] never ends! *) Ok () -let serve ~input ~output ~cli_frontmatter ~port = +let serve ~input ~output ~port = let compile () = - let asset_files, to_asset = - let used_files, read_file = read_file (Fpath.v "./") () in - (used_files, Slipshow.Asset.of_string ~read_file) - in - let cli_frontmatter, warnings_cli_frontmatter = - Diagnosis.with_ @@ fun () -> - Slipshow.Frontmatter.resolve cli_frontmatter ~to_asset - in let* content = Io.read (`File input) in - let used_files, read_file = read_file (Fpath.parent input) () in - let result, warnings = + let (result, warnings), used_files = let file = Fpath.to_string input in - Slipshow.delayed ~has_speaker_view:true ~frontmatter:cli_frontmatter - ~read_file ~file content + with_read_file (Fpath.parent input) @@ fun read_file -> + Slipshow.delayed ~has_speaker_view:true ~read_file ~file content in let warnings = List.map @@ -114,19 +96,13 @@ let serve ~input ~output ~cli_frontmatter ~port = warnings in let warnings = List.map (Ansi.process (Ansi.create ())) warnings in - let cli_warnings = - List.map - (Format.asprintf "%a" Diagnosis.report_no_src) - warnings_cli_frontmatter - in - let warnings = cli_warnings @ warnings |> String.concat "" in - let all_used_files = Fpath.Set.union !asset_files !used_files in + let warnings = warnings |> String.concat "" in let html = Slipshow.add_starting_state result None in let+ () = Io.write output html in ( (result, warnings), Fpath.Set.add (Fpath.normalize (Fpath.( // ) (Fpath.v (Sys.getcwd ())) input)) - all_used_files ) + used_files ) in let () = Slipshow_server.do_serve ~port input compile in (* [do_serve] never ends! *) @@ -134,12 +110,11 @@ let serve ~input ~output ~cli_frontmatter ~port = let markdown_compile ~input ~output = let* content = Io.read input in - let _used_files, read_file = - read_file + let md, _used_files = + with_read_file (match input with `Stdin -> Fpath.v "./" | `File f -> Fpath.parent f) - () + @@ fun read_file -> Slipshow.convert_to_md ~read_file content in - let md = Slipshow.convert_to_md ~read_file content in match output with | `Stdout -> print_string md; diff --git a/src/cli/run.mli b/src/cli/run.mli index b0caf596..daf9b19e 100644 --- a/src/cli/run.mli +++ b/src/cli/run.mli @@ -1,19 +1,13 @@ val compile : input:[ `File of Fpath.t | `Stdin ] -> output:[ `File of Fpath.t | `Stdout ] -> - cli_frontmatter:Slipshow.Frontmatter.unresolved Slipshow.Frontmatter.t -> (Fpath.Set.t, [ `Msg of string ]) result -val watch : - input:Fpath.t -> - output:Fpath.t -> - cli_frontmatter:Slipshow.Frontmatter.unresolved Slipshow.Frontmatter.t -> - (unit, [ `Msg of string ]) result +val watch : input:Fpath.t -> output:Fpath.t -> (unit, [ `Msg of string ]) result val serve : input:Fpath.t -> output:Fpath.t -> - cli_frontmatter:Slipshow.Frontmatter.unresolved Slipshow.Frontmatter.t -> port:int -> (unit, [ `Msg of string ]) result diff --git a/src/compiler/compile.ml b/src/compiler/compile.ml index 7a217c7e..62236aa0 100644 --- a/src/compiler/compile.ml +++ b/src/compiler/compile.ml @@ -514,10 +514,10 @@ module Stage4 = struct in Ast.Folder.make ~block ~inline () - let execute ~(fm : Frontmatter.resolved Frontmatter.t) ~read_file md = - let (Frontmatter.Resolved fm) = fm in + let execute ~(fm : Frontmatter.t) ~read_file md = + let fm = fm in let external_ids = - fm.external_ids + fm.local.external_ids |> List.map (fun x -> ((x, Meta.none), `External, Meta.none)) in let asset_map, id_list = @@ -602,7 +602,7 @@ module Stage5 = struct ast end -let of_cmarkit ~read_file ~(fm : Frontmatter.resolved Frontmatter.t) md = +let of_cmarkit ~read_file ~(fm : Frontmatter.t) md = let defs = Cmarkit.Doc.defs md in let md1, htbl_include = Stage1.execute defs read_file md in let md2 = Stage2.execute md1 in diff --git a/src/compiler/compile.mli b/src/compiler/compile.mli index 6ecb58a7..ba12093f 100644 --- a/src/compiler/compile.mli +++ b/src/compiler/compile.mli @@ -2,7 +2,7 @@ type file_reader = Fpath.t -> (string option, [ `Msg of string ]) result val of_cmarkit : read_file:file_reader -> - fm:Frontmatter.resolved Frontmatter.t -> + fm:Frontmatter.t -> Cmarkit.Doc.t -> Ast.t * (string, string) Hashtbl.t @@ -12,7 +12,7 @@ val compile : ?file:string -> ?loc_offset:int * int -> attrs:Cmarkit.Attributes.t -> - fm:Frontmatter.resolved Frontmatter.t -> + fm:Frontmatter.t -> ?read_file:file_reader -> string -> (Ast.t * (string, string) Hashtbl.t) * Diagnosis.t list diff --git a/src/compiler/frontmatter.ml b/src/compiler/frontmatter.ml index ce9c4f36..92021857 100644 --- a/src/compiler/frontmatter.ml +++ b/src/compiler/frontmatter.ml @@ -1,19 +1,51 @@ -type resolved = [ `Resolved ] -type unresolved = [ `Unresolved ] - -type 'a fm = { - toplevel_attributes : Cmarkit.Attributes.t option; - math_link : 'a option; - theme : [ `Builtin of Themes.t | `External of string ] option; - css_links : 'a list; - js_links : 'a list; - dimension : (int * int) option; - highlightjs_theme : string option; - math_mode : [ `Mathjax | `Katex ] option; - external_ids : string list; -} -(** We keep an option even though there are default value to be able to merge - two frontmatter. None and default value represent different things. *) +module Local = struct + type t = { + toplevel_attributes : Cmarkit.Attributes.t option; + css_links : Asset.t list; + js_links : Asset.t list; + external_ids : string list; + } + + type 'a with_ = { x : 'a; fm : t } + + let empty = + { + toplevel_attributes = None; + css_links = []; + js_links = []; + external_ids = []; + } + + let with_empty x = { x; fm = empty } +end + +module Global = struct + type t = { + math_link : Asset.t option; + theme : [ `Builtin of Themes.t | `External of string ] option; + dimension : (int * int) option; + highlightjs_theme : string option; + math_mode : [ `Mathjax | `Katex ] option; + } + (** We keep an option even though there are default value to be able to merge + two frontmatter. None and default value represent different things. *) + + type 'a with_ = { x : 'a; fm : t } + + let empty = + { + math_link = None; + theme = None; + dimension = None; + highlightjs_theme = None; + math_mode = None; + } + + let with_empty x = { x; fm = empty } +end + +type t = { local : Local.t; global : Global.t } +type fm = t module Toplevel_attributes = struct type t = Cmarkit.Attributes.t @@ -30,7 +62,7 @@ module Toplevel_attributes = struct ] () - let of_string (s, loc) = + let of_string ~to_asset:_ (s, loc) = let s = String.trim s in let s = if String.length s > 0 && s.[0] = '{' then @@ -50,16 +82,18 @@ module Toplevel_attributes = struct | Cmarkit.Block.Ext_standalone_attributes (attrs, _) -> Ok attrs | _ -> Error (`Msg "Failed to parse the attributes") - let update_frontmatter (fm : _ fm) v = - { fm with toplevel_attributes = Some v } + let update_frontmatter (fm : fm) v = + { fm with local = { fm.local with toplevel_attributes = Some v } } end module Math_link = struct - type t = string + type t = Asset.t let key = "math-link" - let of_string (s, _) = Ok s - let update_frontmatter (fm : _ fm) v = { fm with math_link = Some v } + let of_string ~to_asset (s, _) = Ok (to_asset s) + + let update_frontmatter (fm : fm) v = + { fm with global = { fm.global with math_link = Some v } } end module Theme = struct @@ -68,39 +102,41 @@ module Theme = struct let key = "theme" let default = `Builtin Themes.Default - let of_string (s, _) = + let of_string ~to_asset:_ (s, _) = match Themes.of_string s with | Some theme -> Ok (`Builtin theme) | None -> Ok (`External s) - let update_frontmatter (fm : _ fm) v = { fm with theme = Some v } + let update_frontmatter (fm : fm) v = + { fm with global = { fm.global with theme = Some v } } end module Css_links = struct - type t = string list + type t = Asset.t list let key = "css" - let of_string (s, _) = + let of_string ~to_asset (s, _) = s |> String.split_on_char ' ' - |> List.filter (fun x -> not (String.equal "" x)) + |> List.filter_map (function "" -> None | x -> Some (to_asset x)) |> Result.ok - let update_frontmatter (fm : _ fm) v = - { fm with css_links = v @ fm.css_links } + let update_frontmatter (fm : fm) v = + { fm with local = { fm.local with css_links = v @ fm.local.css_links } } end module Js_links = struct - type t = string list + type t = Asset.t list let key = "js" - let of_string (s, _) = + let of_string ~to_asset (s, _) = s |> String.split_on_char ' ' - |> List.filter (fun x -> not (String.equal "" x)) + |> List.filter_map (function "" -> None | x -> Some (to_asset x)) |> Result.ok - let update_frontmatter (fm : _ fm) v = { fm with js_links = v @ fm.js_links } + let update_frontmatter (fm : fm) v = + { fm with local = { fm.local with js_links = v @ fm.local.js_links } } end module Dimension = struct @@ -109,7 +145,7 @@ module Dimension = struct let key = "dimension" let default = (1440, 1080) - let of_string (s, _) = + let of_string ~to_asset:_ (s, _) = let ( let* ) = Result.bind in let error = Error @@ -127,16 +163,19 @@ module Dimension = struct Ok (width, height) | _ -> error - let update_frontmatter (fm : _ fm) v = { fm with dimension = Some v } + let update_frontmatter (fm : fm) v = + { fm with global = { fm.global with dimension = Some v } } end module Hljs_theme = struct type t = string let key = "highlightjs-theme" - let of_string = fun (x, _) -> Ok x + let of_string ~to_asset:_ = fun (x, _) -> Ok x let default = "default" - let update_frontmatter (fm : _ fm) v = { fm with highlightjs_theme = Some v } + + let update_frontmatter (fm : fm) v = + { fm with global = { fm.global with highlightjs_theme = Some v } } end module Math_mode = struct @@ -144,21 +183,28 @@ module Math_mode = struct let key = "math-mode" - let of_string = function + let of_string ~to_asset:_ = function | "mathjax", _ -> Ok `Mathjax | "katex", _ -> Ok `Katex | _ -> Error (`Msg "Expected \"mathjax\" or \"katex\"") let default = `Mathjax - let update_frontmatter (fm : _ fm) v = { fm with math_mode = Some v } + + let update_frontmatter (fm : fm) v = + { fm with global = { fm.global with math_mode = Some v } } end module type Field = sig type t val key : string - val of_string : string * Cmarkit.Textloc.t -> (t, [ `Msg of string ]) result - val update_frontmatter : string fm -> t -> string fm + + val of_string : + to_asset:(string -> Asset.t) -> + string * Cmarkit.Textloc.t -> + (t, [ `Msg of string ]) result + + val update_frontmatter : fm -> t -> fm end module External_ids = struct @@ -166,13 +212,16 @@ module External_ids = struct let key = "external-ids" - let of_string (s, _) = + let of_string ~to_asset:_ (s, _) = String.split_on_char ' ' s |> List.filter (fun x -> not @@ String.equal String.empty x) |> Result.ok - let update_frontmatter (fm : _ fm) v = - { fm with external_ids = v @ fm.external_ids } + let update_frontmatter (fm : fm) v = + { + fm with + local = { fm.local with external_ids = v @ fm.local.external_ids }; + } end let all_fields = @@ -201,38 +250,7 @@ let fields_map = |> SMap.of_list let fields_names = all_fields |> List.map (fun (module X : Field) -> X.key) - -type 'a t = - | Unresolved : string fm -> unresolved t - | Resolved : Asset.t fm -> resolved t - -let resolve (Unresolved fm) ~to_asset = - Resolved - { - fm with - math_link = Option.map to_asset fm.math_link; - css_links = List.map to_asset fm.css_links; - js_links = List.map to_asset fm.js_links; - } - -let empty_fm = - { - dimension = None; - toplevel_attributes = None; - math_link = None; - theme = None; - css_links = []; - js_links = []; - highlightjs_theme = None; - math_mode = None; - external_ids = []; - } - -let empty = Resolved empty_fm - -(* let get (field_name, convert) kv = *) -(* List.assoc_opt field_name kv |> Option.map convert *) - +let empty = { local = Local.empty; global = Global.empty } let string_sub s idx idx' = (String.sub s idx idx', (idx, idx + idx' - 1)) let split_in_lines s = @@ -285,7 +303,7 @@ let send_general_error ~key ~msg ~vloc = code = "Frontmatter"; }) -let of_string file offset s = +let of_string ~to_asset file offset s = let raise_warning line = let loc = let i, _, (byte_start, byte_end) = line in @@ -318,14 +336,13 @@ let of_string file offset s = send_unrecognized_field ~key ~kloc; fm | Some (module F) -> ( - match F.of_string value with + match F.of_string ~to_asset value with | Ok x -> F.update_frontmatter fm x | Error (`Msg msg) -> send_general_error ~key ~msg ~vloc; fm) in - let fm = List.fold_left handle_line empty_fm assoc in - Unresolved fm + List.fold_left handle_line empty assoc let ( let* ) x f = Option.bind x f let ( let+ ) x f = Option.map f x @@ -378,33 +395,3 @@ let extract s = (after, n_lines 0 (after - 1)) in { frontmatter; rest; rest_offset = offset; fm_offset = start } - -let combine (Resolved cli_frontmatter) (Resolved frontmatter) = - let combine_opt cli f = match cli with Some _ as x -> x | None -> f in - (* TODO: warn on cli erasing frontmatter *) - let toplevel_attributes = - combine_opt cli_frontmatter.toplevel_attributes - frontmatter.toplevel_attributes - in - let math_link = combine_opt cli_frontmatter.math_link frontmatter.math_link in - let math_mode = combine_opt cli_frontmatter.math_mode frontmatter.math_mode in - let theme = combine_opt cli_frontmatter.theme frontmatter.theme in - let dimension = combine_opt cli_frontmatter.dimension frontmatter.dimension in - let css_links = cli_frontmatter.css_links @ frontmatter.css_links in - let js_links = cli_frontmatter.js_links @ frontmatter.js_links in - let highlightjs_theme = - combine_opt cli_frontmatter.highlightjs_theme frontmatter.highlightjs_theme - in - let external_ids = cli_frontmatter.external_ids @ frontmatter.external_ids in - Resolved - { - toplevel_attributes; - math_link; - theme; - css_links; - dimension; - js_links; - highlightjs_theme; - math_mode; - external_ids; - } diff --git a/src/compiler/frontmatter.mli b/src/compiler/frontmatter.mli index 7668f492..df4e62c9 100644 --- a/src/compiler/frontmatter.mli +++ b/src/compiler/frontmatter.mli @@ -1,31 +1,49 @@ -type resolved = [ `Resolved ] -type unresolved = [ `Unresolved ] - -type 'a fm = { - toplevel_attributes : Cmarkit.Attributes.t option; - math_link : 'a option; - theme : [ `Builtin of Themes.t | `External of string ] option; - css_links : 'a list; - js_links : 'a list; - dimension : (int * int) option; - highlightjs_theme : string option; - math_mode : [ `Mathjax | `Katex ] option; - external_ids : string list; -} +module Local : sig + type t = { + toplevel_attributes : Cmarkit.Attributes.t option; + css_links : Asset.t list; + js_links : Asset.t list; + external_ids : string list; + } + + type 'a with_ = { x : 'a; fm : t } + + val empty : t + val with_empty : 'a -> 'a with_ +end -(** We use this trick to only allow [string fm] and [Asset.t fm], but it is - completely unnecessary and a flagrant example of useless over-engineering. -*) -type 'a t = - | Unresolved : string fm -> unresolved t - | Resolved : Asset.t fm -> resolved t +module Global : sig + type t = { + math_link : Asset.t option; + theme : [ `Builtin of Themes.t | `External of string ] option; + dimension : (int * int) option; + highlightjs_theme : string option; + math_mode : [ `Mathjax | `Katex ] option; + } + + type 'a with_ = { x : 'a; fm : t } + + val empty : t + val with_empty : 'a -> 'a with_ +end -module type Field = sig +type t = { local : Local.t; global : Global.t } + +val empty : t + +type fm := t + +module type Field := sig type t val key : string - val of_string : string * Cmarkit.Textloc.t -> (t, [ `Msg of string ]) result - val update_frontmatter : string fm -> t -> string fm + + val of_string : + to_asset:(string -> Asset.t) -> + string * Cmarkit.Textloc.t -> + (t, [ `Msg of string ]) result + + val update_frontmatter : fm -> t -> fm end module type Field_with_default := sig @@ -37,19 +55,18 @@ end module Toplevel_attributes : Field_with_default with type t = Cmarkit.Attributes.t -module Math_link : Field with type t = string +module Math_link : Field with type t = Asset.t module Theme : Field_with_default with type t = [ `Builtin of Themes.t | `External of string ] -module Css_links : Field with type t = string list -module Js_links : Field with type t = string list +module Css_links : Field with type t = Asset.t list +module Js_links : Field with type t = Asset.t list module Dimension : Field_with_default with type t = int * int module Hljs_theme : Field_with_default with type t = string module Math_mode : Field_with_default with type t = [ `Mathjax | `Katex ] -val empty : resolved t -val of_string : string -> int -> string -> unresolved t +val of_string : to_asset:(string -> Asset.t) -> string -> int -> string -> t type extraction = { frontmatter : string; @@ -61,6 +78,3 @@ type extraction = { val extract : string -> extraction option (** Split the frontmatter and the rest of the input string, still computing offsets *) - -val combine : resolved t -> resolved t -> resolved t -val resolve : unresolved t -> to_asset:(string -> Asset.t) -> resolved t diff --git a/src/compiler/slipshow.ml b/src/compiler/slipshow.ml index 2ca0db25..e6b9f196 100644 --- a/src/compiler/slipshow.ml +++ b/src/compiler/slipshow.ml @@ -247,9 +247,10 @@ let convert_to_md ~read_file content = | None -> (Frontmatter.empty, content, (0, 0)) | Some { frontmatter; rest; rest_offset; fm_offset } -> let file = "-" in - let frontmatter = Frontmatter.of_string file fm_offset frontmatter in let to_asset = Asset.of_string ~read_file in - let frontmatter = Frontmatter.resolve frontmatter ~to_asset in + let frontmatter = + Frontmatter.of_string ~to_asset file fm_offset frontmatter + in (frontmatter, rest, rest_offset) in let md = @@ -272,32 +273,34 @@ let to_grace file whole_content htbl_include er = Grace.Source.(`String { name = file; content = whole_content })) er -let delayed ?slipshow_js ?(frontmatter = Frontmatter.empty) ?file - ?(read_file = fun _ -> Ok None) ~has_speaker_view s = +let delayed ?slipshow_js ?file ?(read_file = fun _ -> Ok None) ~has_speaker_view + s = let whole_content = s in - let (Frontmatter.Resolved frontmatter, s, loc_offset), warnings = + let (frontmatter, s, loc_offset), warnings = Diagnosis.with_ @@ fun () -> match Frontmatter.extract s with - | None -> (frontmatter, s, (0, 0)) + | None -> (Frontmatter.empty, s, (0, 0)) | Some { frontmatter = txt_fm; rest; rest_offset; fm_offset } -> let file = Option.value ~default:"-" file in - let txt_fm = Frontmatter.of_string file fm_offset txt_fm in let to_asset = Asset.of_string ~read_file in - let txt_frontmatter = Frontmatter.resolve txt_fm ~to_asset in - let frontmatter = Frontmatter.combine txt_frontmatter frontmatter in + let frontmatter = + Frontmatter.of_string ~to_asset file fm_offset txt_fm + in (frontmatter, rest, rest_offset) in let toplevel_attributes = - frontmatter.toplevel_attributes + frontmatter.local.toplevel_attributes |> Option.value ~default:Frontmatter.Toplevel_attributes.default in let dimension = - frontmatter.dimension |> Option.value ~default:Frontmatter.Dimension.default + frontmatter.global.dimension + |> Option.value ~default:Frontmatter.Dimension.default in - let css_links = frontmatter.css_links in - let js_links = frontmatter.js_links in + let css_links = frontmatter.local.css_links in + let js_links = frontmatter.local.js_links in let math_mode = - Option.value ~default:Frontmatter.Math_mode.default frontmatter.math_mode + Option.value ~default:Frontmatter.Math_mode.default + frontmatter.global.math_mode in let resolve_theme = function | `Builtin _ as x -> x @@ -306,18 +309,18 @@ let delayed ?slipshow_js ?(frontmatter = Frontmatter.empty) ?file `External asset in let theme = - match frontmatter.theme with + match frontmatter.global.theme with | None -> resolve_theme Frontmatter.Theme.default | Some t -> resolve_theme t in let highlightjs_theme = Option.value ~default:Frontmatter.Hljs_theme.default - frontmatter.highlightjs_theme + frontmatter.global.highlightjs_theme in - let math_link = frontmatter.math_link in + let math_link = frontmatter.global.math_link in let (md, htbl_include), errors = - Compile.compile ~loc_offset ?file ~attrs:toplevel_attributes - ~fm:(Frontmatter.Resolved frontmatter) ~read_file s + Compile.compile ~loc_offset ?file ~attrs:toplevel_attributes ~fm:frontmatter + ~read_file s in let warnings = List.filter_map @@ -392,10 +395,8 @@ let add_starting_state ?(autofocus = true) (start, end_, has_speaker_view) in if has_speaker_view then html else orig_html -let convert ~has_speaker_view ?autofocus ?slipshow_js ?frontmatter ?file - ?starting_state ?read_file s = - let delayed, w = - delayed ~has_speaker_view ?slipshow_js ?frontmatter ?file ?read_file s - in +let convert ~has_speaker_view ?autofocus ?slipshow_js ?file ?starting_state + ?read_file s = + let delayed, w = delayed ~has_speaker_view ?slipshow_js ?file ?read_file s in let res = add_starting_state ?autofocus delayed starting_state in (res, w) diff --git a/src/compiler/slipshow.mli b/src/compiler/slipshow.mli index 98931cc4..de924dc5 100644 --- a/src/compiler/slipshow.mli +++ b/src/compiler/slipshow.mli @@ -22,7 +22,6 @@ type file_reader = Fpath.t -> (string option, [ `Msg of string ]) result val delayed : ?slipshow_js:Asset.t -> - ?frontmatter:Frontmatter.resolved Frontmatter.t -> ?file:string -> ?read_file:file_reader -> has_speaker_view:bool -> @@ -39,7 +38,6 @@ val convert : has_speaker_view:bool -> ?autofocus:bool -> ?slipshow_js:Asset.t -> - ?frontmatter:Frontmatter.resolved Frontmatter.t -> ?file:string -> ?starting_state:starting_state -> ?read_file:file_reader -> diff --git a/src/engine/previewer/previewer.ml b/src/engine/previewer/previewer.ml index b86b5a24..1f540263 100644 --- a/src/engine/previewer/previewer.ml +++ b/src/engine/previewer/previewer.ml @@ -177,13 +177,13 @@ let set_srcdoc { index; panels; errors_el; preview_status; _ } El.set_class preview_status_class true preview_status; Console.(log [ "exception"; Printexc.to_string exn ]) -let preview ?slipshow_js ?frontmatter ?read_file previewer source = +let preview ?slipshow_js ?read_file previewer source = let () = El.set_class preview_status_class false previewer.preview_status in let starting_state = !(previewer.stage) in let has_speaker_view = previewer.include_speaker_view in let slipshow, warnings = - Slipshow.convert ~file:"-" ~has_speaker_view ?slipshow_js ?frontmatter - ?read_file ~autofocus:false ~starting_state source + Slipshow.convert ~file:"-" ~has_speaker_view ?slipshow_js ?read_file + ~autofocus:false ~starting_state source in let warnings = List.map diff --git a/src/engine/previewer/previewer.mli b/src/engine/previewer/previewer.mli index 87b1e8ef..205a8fe8 100644 --- a/src/engine/previewer/previewer.mli +++ b/src/engine/previewer/previewer.mli @@ -20,7 +20,6 @@ val create_previewer : val preview : ?slipshow_js:Slipshow.Asset.t -> - ?frontmatter:Slipshow.Frontmatter.resolved Slipshow.Frontmatter.t -> ?read_file:Slipshow.file_reader -> previewer -> string -> diff --git a/test/compiler/dimension.t/run.t b/test/compiler/dimension.t/run.t index abc223f6..c658d8ee 100644 --- a/test/compiler/dimension.t/run.t +++ b/test/compiler/dimension.t/run.t @@ -1,32 +1,58 @@ -Let's start with an empty file +We can provide the dimension with dimension - $ touch file.md + $ cat > file.md << EOF + > --- + > dimension: qfdesfesf + > --- + > EOF + $ slipshow compile file.md + warning: Error while parsing frontmatter field 'dimension' + ┌─ file.md:2:11 + 2 │ dimension: qfdesfesf + │ ^^^^^^^^^^ Expected "4:3", "16:9", or two integers separated by a 'x' + -We can provide the dimension with --dimension + $ cat > file.md << EOF + > --- + > dimension: wrongxefzefezf + > --- + > EOF + $ slipshow compile file.md + warning: Error while parsing frontmatter field 'dimension' + ┌─ file.md:2:11 + 2 │ dimension: wrongxefzefezf + │ ^^^^^^^^^^^^^^^ Expected "4:3", "16:9", or two integers separated by a 'x' + - $ slipshow compile --dimension qfdesfesf file.md - slipshow: option '--dimension': Expected "4:3", "16:9", or two integers - separated by a 'x' - Usage: slipshow compile [OPTION]… [FILE.md] - Try 'slipshow compile --help' or 'slipshow --help' for more information. - [124] - $ slipshow compile --dimension wrongxefzefezf file.md - slipshow: option '--dimension': Expected "4:3", "16:9", or two integers - separated by a 'x' - Usage: slipshow compile [OPTION]… [FILE.md] - Try 'slipshow compile --help' or 'slipshow --help' for more information. - [124] - $ slipshow compile --dimension 1920xwrong file.md - slipshow: option '--dimension': Expected "4:3", "16:9", or two integers - separated by a 'x' - Usage: slipshow compile [OPTION]… [FILE.md] - Try 'slipshow compile --help' or 'slipshow --help' for more information. - [124] - $ slipshow compile --dimension 16:9 file.md - $ slipshow compile --dimension 4:3 file.md - $ slipshow compile --dimension 1920x1080 file.md + $ cat > file.md << EOF + > --- + > dimension: 1920xwrong + > --- + > EOF + $ slipshow compile file.md + warning: Error while parsing frontmatter field 'dimension' + ┌─ file.md:2:11 + 2 │ dimension: 1920xwrong + │ ^^^^^^^^^^^ Expected "4:3", "16:9", or two integers separated by a 'x' + --d and --dim work too + $ cat > file.md << EOF + > --- + > dimension: 16:9 + > --- + > EOF + $ slipshow compile file.md - $ slipshow compile --dim 16:9 file.md - $ slipshow compile -d 16:9 file.md + $ cat > file.md << EOF + > --- + > dimension: 4:3 + > --- + > EOF + $ slipshow compile file.md + + $ cat > file.md << EOF + > --- + > dimension: 1920x1080 + > --- + > EOF + $ slipshow compile file.md diff --git a/test/compiler/simple.t/run.t b/test/compiler/simple.t/run.t index 4621a59e..e9f4757e 100644 --- a/test/compiler/simple.t/run.t +++ b/test/compiler/simple.t/run.t @@ -68,41 +68,3 @@ If we do not pass an input file, it gets its value from stdin $ ls stdout.html stdout.html - -If we pass a mathjax value, with a remote url: - - $ echo "#title \$1+1=0\$" > with_inline_math.md - $ cat > with_block_math.md << EOF - > \`\`\`math - > 1 + 1 = 0 - > \`\`\` - > EOF - $ echo "#title 1+1=0" > without_math.md - - $ slipshow compile -o m1.html --math-script https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js with_inline_math.md - $ slipshow compile -o m2.html --math-script https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js with_block_math.md - $ slipshow compile -o m3.html --math-script https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js without_math.md - - $ show_source m1.html | grep mathjax -