feat: add many functions to accept strings with newlines (#59)

src/Diagnostic.ml

@@ -2,10 +2,21 @@ include DiagnosticData
 
 let ktextf = Format.kdprintf
 
+let text_of_string s fmt =
+  List.iteri
+    (fun i s ->
+       if i > 0 then Format.pp_force_newline fmt ();
+       Format.pp_print_string fmt s
+    ) @@
+  String.split_on_char '\n' s
+
 let textf = Format.dprintf
 
 let kmessagef k ?loc = ktextf @@ fun message -> k Span.{ loc; value = message }
 
+let message_of_string ?loc s =
+  Span.{ loc; value = text_of_string s }
+
 let messagef ?loc = kmessagef Fun.id ?loc
 
 let string_of_severity =

src/Diagnostic.mli

@@ -5,13 +5,21 @@ include module type of DiagnosticData
 
 (** {1 Constructions} *)
 
-(** [textf format ...] constructs a text. It is an alias of {!val:Format.dprintf}. *)
+(** [text_of_string str] converts the string [str] into a text, turning each ['\n'] into a call to {!val:Format.pp_force_newline}. *)
+val text_of_string : string -> text
+
+(** [textf format ...] constructs a text. It is an alias of {!val:Format.dprintf}. Note that there should not be any literal control characters (e.g., literal newline characters). *)
 val textf : ('a, Format.formatter, unit, text) format4 -> 'a
 
 (** [ktextf kont format ...] is [kont (textf code format ...)]. It is an alias of {!val:Format.kdprintf}. *)
 val ktextf : (text -> 'b) -> ('a, Format.formatter, unit, 'b) format4 -> 'a
 
-(** [messagef format ...] constructs a message.
+(** [message_of_string str] converts the string [str] into a message.
+
+    @param loc The location of the message (usually the code) to highlight. *)
+val message_of_string : ?loc:Span.t -> string -> message
+
+(** [messagef format ...] constructs a message. Note that there should not be any literal control characters (e.g., literal newline characters).
 
     @param loc The location of the message (usually the code) to highlight.
 *)
@@ -28,7 +36,7 @@ val kmessagef : (message -> 'b) -> ?loc:Span.t -> ('a, Format.formatter, unit, '
 (** A convenience function that turns a {!type:severity} into a string. *)
 val string_of_severity : severity -> string
 
-(** A convenience function that turns a {!type:text} into a string by formatting it with the maximum admissible margin. Note that the resulting string may contain control characters and might not be suitable for constructing another instance of {!type:text} or {!type:message}. *)
+(** A convenience function that turns a {!type:text} into a string by formatting it with the maximum admissible margin. Note that the resulting string may contain newline characters. *)
 val string_of_text : text -> string
 
 (** A convenience function that maps the message code. This is helpful when using {!val:Logger.S.adopt}. *)

src/DiagnosticData.ml

@@ -26,7 +26,7 @@ end
 
     When we render a diagnostic, the layout engine of the rendering backend should be the one making layout choices. Therefore, we cannot pass already formatted strings. Instead, a text is defined to be a function that takes a formatter and uses it to render the content. Please make sure the following two conditions are satisfied:
     + {b All string and character literals should be encoded using UTF-8.}
-    + {b All string and character literals should not contain control characters (such as newlines).} It is okay to have break hints (such as [@,]) but not literal control characters. This means you should not use pre-formatted strings; consider using {!val:Format.pp_print_text} for pre-formatted strings. Control characters include `U+0000-001F` (C0 controls), `U+007F` (backspace), and `U+0080-009F` (C1 controls); in particular, `U+000A` (newline) is a C0 control character. These characters are banned because they would mess up the cursor position. *)
+    + {b All string and character literals should not contain control characters (such as newlines).} It is okay to have break hints (such as [@,]) but not literal control characters. This means you should not use pre-formatted strings; consider using {!val:text_of_string} if you must. Control characters include `U+0000-001F` (C0 controls), `U+007F` (backspace), and `U+0080-009F` (C1 controls); in particular, `U+000A` (newline) is a C0 control character. These characters are banned because they would mess up the cursor position. *)
 type text = Format.formatter -> unit
 
 (** A message is a located {!type:text}. *)

src/Logger.ml

@@ -16,20 +16,28 @@ struct
 
   let trace fr f = Traces.scope (fun bt -> bt <: fr) f
 
+  let trace_string ?loc str f = trace (Diagnostic.message_of_string ?loc str) f
+
   let tracef ?loc = Diagnostic.kmessagef trace ?loc
 
   (* Building messages *)
 
-  let kdiagnosticf k ?severity ?loc ?(backtrace=get_backtrace()) ?(additional_messages=[]) code =
-    Diagnostic.ktextf @@ fun message -> k @@
+  let diagnostic_of_message ?severity ?(backtrace=get_backtrace()) ?(additional_messages=[]) code message =
     Diagnostic.{
       severity = Option.value ~default:(Code.default_severity code) severity;
       code;
-      message = {loc; value = message};
+      message;
       backtrace;
       additional_messages;
     }
 
+  let kdiagnosticf k ?severity ?loc ?backtrace ?additional_messages code =
+    Diagnostic.kmessagef ?loc (fun msg -> k (diagnostic_of_message ?severity ?backtrace ?additional_messages code msg))
+
+  let diagnostic_of_string ?severity ?loc ?backtrace ?additional_messages code str =
+    diagnostic_of_message ?severity ?backtrace ?additional_messages code @@
+    Diagnostic.message_of_string ?loc str
+
   let diagnosticf ?severity ?loc ?backtrace ?additional_messages code =
     kdiagnosticf Fun.id ?severity ?loc ?backtrace ?additional_messages code
 
@@ -61,9 +69,15 @@ struct
 
   (* Convenience functions *)
 
+  let emit_string ?severity ?loc ?backtrace ?additional_messages code str =
+    emit @@ diagnostic_of_string ?severity ?loc ?backtrace ?additional_messages code str
+
   let emitf ?severity ?loc ?backtrace ?additional_messages code =
     kdiagnosticf emit ?severity ?loc ?backtrace ?additional_messages code
 
+  let fatal_string ?severity ?loc ?backtrace ?additional_messages code str =
+    fatal @@ diagnostic_of_string ?severity ?loc ?backtrace ?additional_messages code str
+
   let fatalf ?severity ?loc ?backtrace ?additional_messages code =
     kdiagnosticf fatal ?severity ?loc ?backtrace ?additional_messages code
 

src/LoggerSigs.ml

@@ -4,14 +4,26 @@ sig
 
   (** {2 Constructing Diagnostics} *)
 
-  (** [diagnosticf code format ...] constructs a diagnostic along with the backtrace frames recorded via [tracef].
+  (** [diagnostic_of_string code str] constructs a diagnostic with the message [str] along with the backtrace frames recorded via {!val:tracef}.
 
       Example:
       {[
-        Logger.diagnosticf `TypeError "Term %a does not type check" Syntax.pp tm
+        Logger.diagnostic_of_string `TypeError "This\nis\ntoo\nmuch."
       ]}
 
-      Note that the format strings should not contain any control characters. See {!type:Diagnostic.text}.
+      @param severity The severity (to overwrite the default severity inferred from the message [code]).
+      @param loc The location of the text (usually the code) to highlight.
+      @param backtrace The backtrace (to overwrite the accumulative frames up to this point).
+      @param additional_messages Additional messages that part of the backtrace. For example, they can be bindings shadowed by the current one.
+  *)
+  val diagnostic_of_string : ?severity:Diagnostic.severity -> ?loc:Span.t -> ?backtrace:Diagnostic.backtrace -> ?additional_messages:Diagnostic.message list -> Code.t -> string -> Code.t Diagnostic.t
+
+  (** [diagnosticf code format ...] constructs a diagnostic along with the backtrace frames recorded via {!val:trace}. Note that there should not be any literal control characters. See {!type:Diagnostic.text}.
+
+      Example:
+      {[
+        Logger.diagnosticf `TypeError "Term %a does not type check, or does it?" Syntax.pp tm
+      ]}
 
       @param severity The severity (to overwrite the default severity inferred from the message [code]).
       @param loc The location of the text (usually the code) to highlight.
@@ -20,9 +32,7 @@ sig
   *)
   val diagnosticf : ?severity:Diagnostic.severity -> ?loc:Span.t -> ?backtrace:Diagnostic.backtrace -> ?additional_messages:Diagnostic.message list -> Code.t -> ('a, Format.formatter, unit, Code.t Diagnostic.t) format4 -> 'a
 
-  (** [kdiagnosticf kont code format ...] is [kont (diagnosticf code format ...)].
-
-      Note that the format strings should not contain any control characters. See {!type:Diagnostic.text}.
+  (** [kdiagnosticf kont code format ...] is [kont (diagnosticf code format ...)]. Note that there should not be any literal control characters. See {!type:Diagnostic.text}.
 
       @param severity The severity (to overwrite the default severity inferred from the message [code]).
       @param loc The location of the text (usually the code) to highlight.
@@ -36,11 +46,25 @@ sig
   (** Emit a diagnostic and continue the computation. *)
   val emit : Code.t Diagnostic.t -> unit
 
-  (** [emitf code format ...] constructs and emits a diagnostic.
+  (** [emit_string code str] emits a string and continue the computation.
 
       Example:
       {[
-        Logger.emitf `TypeError "Term %a does not type check" Syntax.pp tm
+        Logger.emit_string `TypeError "This type is extremely unnatural:\nNat"
+      ]}
+
+      @param severity The severity (to overwrite the default severity inferred from the message [code]).
+      @param loc The location of the text (usually the code) to highlight.
+      @param backtrace The backtrace (to overwrite the accumulative frames up to this point).
+      @param additional_messages Additional messages that part of the backtrace. For example, they can be bindings shadowed by the current one.
+  *)
+  val emit_string : ?severity:Diagnostic.severity -> ?loc:Span.t -> ?backtrace:Diagnostic.backtrace -> ?additional_messages:Diagnostic.message list -> Code.t -> string -> unit
+
+  (** [emitf code format ...] constructs and emits a diagnostic. Note that there should not be any literal control characters. See {!type:Diagnostic.text}.
+
+      Example:
+      {[
+        Logger.emitf `TypeError "Type %a is too ugly" Syntax.pp tp
       ]}
 
       @param severity The severity (to overwrite the default severity inferred from the message [code]).
@@ -53,13 +77,25 @@ sig
   (** Abort the computation with a diagnostic. *)
   val fatal: Code.t Diagnostic.t -> 'a
 
-  (** [fatalf code format ...] constructs a diagnostic and aborts the current computation with the diagnostic.
+  (** [fatal_string code str] aborts the current computation with the string [str].
 
-      Note that the format strings should not contain any control characters. See {!type:Diagnostic.text}.
+      Example:
+      {[
+        Logger.fatal_string `FileError "Forgot to feed the cat"
+      ]}
+
+      @param severity The severity (to overwrite the default severity inferred from the message [code]).
+      @param loc The location of the text (usually the code) to highlight.
+      @param backtrace The backtrace (to overwrite the accumulative frames up to this point).
+      @param additional_messages Additional messages that part of the backtrace. For example, they can be bindings shadowed by the current one.
+  *)
+  val fatal_string : ?severity:Diagnostic.severity -> ?loc:Span.t -> ?backtrace:Diagnostic.backtrace -> ?additional_messages:Diagnostic.message list -> Code.t -> string -> 'a
+
+  (** [fatalf code format ...] constructs a diagnostic and aborts the current computation with the diagnostic. Note that there should not be any literal control characters. See {!type:Diagnostic.text}.
 
       Example:
       {[
-        Logger.fatalf `FileError "Failed to read %s" filepath
+        Logger.fatalf `FileError "Failed to write the password to %s" file_path
       ]}
 
       @param severity The severity (to overwrite the default severity inferred from the message [code]).
@@ -84,12 +120,16 @@ sig
   *)
   val retrace : Diagnostic.backtrace -> (unit -> 'a) -> 'a
 
-  (** [tracef frame f] records the [frame] and runs the thunk [f] with the new backtrace. It is [retrace (get_backtrace() <: fr) f] *)
+  (** [trace msg f] records the message [msg] and runs the thunk [f] with the new backtrace. It is [retrace (get_backtrace() <: fr) f]. *)
   val trace : Diagnostic.message -> (unit -> 'a) -> 'a
 
-  (** [tracef format ... f] constructs and records a frame, and runs the thunk [f] with the new backtrace.
+  (** [trace_string str f] records the string [str] and runs the thunk [f] with the new backtrace. It is [trace (Diagnostic.message_of_string str) f].
+
+      @param loc The location of the text (usually the code) to highlight.
+  *)
+  val trace_string : ?loc:Span.t -> string -> (unit -> 'a) -> 'a
 
-      Note that the format strings should not contain any control characters. See {!type:Diagnostic.text}.
+  (** [tracef format ... f] constructs and records a frame, and runs the thunk [f] with the new backtrace. Note that there should not be any literal control characters. See {!type:Diagnostic.text}.
 
       @param loc The location of the text (usually the code) to highlight.
   *)
@@ -135,7 +175,7 @@ sig
   val try_with : ?emit:(Code.t Diagnostic.t -> unit) -> ?fatal:(Code.t Diagnostic.t -> 'a) -> (unit -> 'a) -> 'a
 
   val register_printer : ([ `Emit of Code.t Diagnostic.t | `Fatal of Code.t Diagnostic.t ] -> string option) -> unit
-  (** [register_printer f] registers a printer [p] via {!val:Printexc.register_printer} to convert unhandled internal effects and exceptions into strings for the OCaml runtime system to display. Ideally, all internal effects and exceptions should have been handled by {!val:run} and there is no need to use this function, but when it is not the case, this function can be helpful for debugging. The functor {!module:Logger.Make} always registers a simple printer to suggest using {!val:run}, but you can register new ones to override it. The return type of the printer [p] should return [Some s] where [s] is the resulting string, or [None] if it chooses not to convert a particular effect or exception. The registered printers are tried in reverse order until one of them returns [Some s] for some [s]; that is, the last registered printer is tried first. Note that this function is a wrapper of {!val:Printexc.register_printer} and all the registered printers (via this function or {!val:Printexc.register_printer}) are put into the same list.
+  (** [register_printer p] registers a printer [p] via {!val:Printexc.register_printer} to convert unhandled internal effects and exceptions into strings for the OCaml runtime system to display. Ideally, all internal effects and exceptions should have been handled by {!val:run} and there is no need to use this function, but when it is not the case, this function can be helpful for debugging. The functor {!module:Logger.Make} always registers a simple printer to suggest using {!val:run}, but you can register new ones to override it. The return type of the printer [p] should return [Some s] where [s] is the resulting string, or [None] if it chooses not to convert a particular effect or exception. The registered printers are tried in reverse order until one of them returns [Some s] for some [s]; that is, the last registered printer is tried first. Note that this function is a wrapper of {!val:Printexc.register_printer} and all the registered printers (via this function or {!val:Printexc.register_printer}) are put into the same list.
 
       The input type of the printer [p] is a variant representation of all internal effects and exceptions used in this module:
       - [`Emit diag] corresponds to the effect triggered by {!val:emit}; and