a showcase of ppx_deriving https://github.com/whitequark/ppx_deriving and ppx_import https://github.com/whitequark/ppx_import

1.source.ml

type json = [%import: Yojson.Safe.json] [@@deriving Show]

2.result.ml

type json =
  [ `Tuple of json list | `Bool of bool | `Intlit of string | `Null
  | `Variant of (string* json option) | `Assoc of (string* json) list
  | `List of json list | `Float of float | `String of string | `Int of int]
[@@deriving Show]
let rec pp_json fmt =
  function
  | `Tuple x ->
      (Format.fprintf fmt "`Tuple (@[<hov>";
       ((fun x  ->
           Format.fprintf fmt "[@[<hov>";
           ignore
             (List.fold_left
                (fun sep  ->
                   fun x  ->
                     if sep then Format.fprintf fmt ";@ ";
                     (pp_json fmt) x;
                     true) false x);
           Format.fprintf fmt "@]]")) x;
       Format.fprintf fmt "@])")
  | `Bool x ->
      (Format.fprintf fmt "`Bool (@[<hov>";
       (Format.fprintf fmt "%B") x;
       Format.fprintf fmt "@])")
  | `Intlit x ->
      (Format.fprintf fmt "`Intlit (@[<hov>";
       (Format.fprintf fmt "%S") x;
       Format.fprintf fmt "@])")
  | `Null -> Format.pp_print_string fmt "`Null"
  | `Variant x ->
      (Format.fprintf fmt "`Variant (@[<hov>";
       ((fun (a0,a1)  ->
           Format.fprintf fmt "(@[<hov>";
           ((Format.fprintf fmt "%S") a0;
            Format.fprintf fmt ",@ ";
            ((function
              | None  -> Format.pp_print_string fmt "None"
              | Some x ->
                  (Format.pp_print_string fmt "Some (";
                   (pp_json fmt) x;
                   Format.pp_print_string fmt ")"))) a1);
           Format.fprintf fmt "@])")) x;
       Format.fprintf fmt "@])")
  | `Assoc x ->
      (Format.fprintf fmt "`Assoc (@[<hov>";
       ((fun x  ->
           Format.fprintf fmt "[@[<hov>";
           ignore
             (List.fold_left
                (fun sep  ->
                   fun x  ->
                     if sep then Format.fprintf fmt ";@ ";
                     ((fun (a0,a1)  ->
                         Format.fprintf fmt "(@[<hov>";
                         ((Format.fprintf fmt "%S") a0;
                          Format.fprintf fmt ",@ ";
                          (pp_json fmt) a1);
                         Format.fprintf fmt "@])")) x;
                     true) false x);
           Format.fprintf fmt "@]]")) x;
       Format.fprintf fmt "@])")
  | `List x ->
      (Format.fprintf fmt "`List (@[<hov>";
       ((fun x  ->
           Format.fprintf fmt "[@[<hov>";
           ignore
             (List.fold_left
                (fun sep  ->
                   fun x  ->
                     if sep then Format.fprintf fmt ";@ ";
                     (pp_json fmt) x;
                     true) false x);
           Format.fprintf fmt "@]]")) x;
       Format.fprintf fmt "@])")
  | `Float x ->
      (Format.fprintf fmt "`Float (@[<hov>";
       (Format.fprintf fmt "%F") x;
       Format.fprintf fmt "@])")
  | `String x ->
      (Format.fprintf fmt "`String (@[<hov>";
       (Format.fprintf fmt "%S") x;
       Format.fprintf fmt "@])")
  | `Int x ->
      (Format.fprintf fmt "`Int (@[<hov>";
       (Format.fprintf fmt "%d") x;
       Format.fprintf fmt "@])")