package ortac-core

  1. Overview
  2. Docs

Source file warnings.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
open Ppxlib
module GW = Gospel.Warnings

type level = Warning | Error
type kind = ..
type kind += GospelError of Gospel.Warnings.kind | Unsupported of string

exception Unknown_kind

type t = kind * Location.t

let level = function
  | GospelError _ -> Error
  | Unsupported _ -> Warning
  | _ -> raise Unknown_kind

exception Error of t

open Fmt

let pp_level ppf = function
  | Warning -> GW.styled_list [ `Magenta; `Bold ] string ppf "Warning"
  | Error -> GW.styled_list [ `Red; `Bold ] string ppf "Error"

let pp_kind ppf = function
  | GospelError k -> pf ppf "Gospel error: %a" Gospel.Warnings.pp_kind k
  | Unsupported msg -> pf ppf "Skipping clause:@ unsupported %s" msg
  | _ -> raise Unknown_kind

let pp_param pp_kind level ppf (k, loc) =
  let pp_sort ppf k = pp_level ppf (level k) in
  GW.pp_gen pp_sort pp_kind ppf loc k

let pp = pp_param pp_kind level

let () =
  Printexc.register_printer (function
    | Error t -> Some (Fmt.str "%a" pp t)
    | _ -> None)