<commit_before>(*
 * Copyright (c) 2013 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Lwt

let debug fmt =
  IrminLog.debug "JSON" fmt

(* From http://erratique.ch/software/jsonm/doc/Jsonm.html#datamodel *)
type t =
  [ `Null
  | `Bool of bool
  | `Float of float
  | `String of string
  | `A of t list
  | `O of (string * t) list ]

exception Escape of ((int * int) * (int * int)) * Jsonm.error

let json_of_src ?encoding src =
  let dec d = match Jsonm.decode d with
    | `Lexeme l -> l
    | `Error e  -> raise (Escape (Jsonm.decoded_range d, e))
    | `End
    | `Await    -> assert false
  in
  let rec value v k d = match v with
    | `Os -> obj [] k d
    | `As -> arr [] k d
    | `Null
    | `Bool _
    | `String _
    | `Float _ as v -> k v d
    | _ -> assert false
  and arr vs k d = match dec d with
    | `Ae -> k (`A (List.rev vs)) d
    | v   -> value v (fun v -> arr (v :: vs) k) d
  and obj ms k d = match dec d with
    | `Oe     -> k (`O (List.rev ms)) d
    | `Name n -> value (dec d) (fun v -> obj ((n, v) :: ms) k) d
    | _       -> assert false
  in
  let d = Jsonm.decoder ?encoding src in
  try `JSON (value (dec d) (fun v _ -> v) d) with
  | Escape (r, e) -> `Error (r, e)

let of_stream (stream: string Lwt_stream.t): t Lwt_stream.t =
  let rec dec d = match Jsonm.decode d with
    | `Lexeme l -> return l
    | `Error e  -> fail (Escape (Jsonm.decoded_range d, e))
    | `Await    ->
      begin
        Lwt_stream.get stream >>= function
        | None    -> fail (Escape (Jsonm.decoded_range d, (`Expected `Value)))
        | Some str ->
          Jsonm.Manual.src d str 0 (String.length str);
          dec d
      end;
    | `End      -> assert false
  in
  let rec value v k d = match v with
    | `Os -> obj [] k d
    | `As -> arr [] k d
    | `Null
    | `Bool _
    | `String _
    | `Float _ as v -> k v d
    | _ -> assert false
  and arr vs k d =
    dec d >>= function
    | `Ae -> k (`A (List.rev vs)) d
    | v   -> value v (fun v -> arr (v :: vs) k) d
  and obj ms k d =
    dec d >>= function
    | `Oe     -> k (`O (List.rev ms)) d
    | `Name n ->
      dec d >>= fun l ->
      value l (fun v -> obj ((n, v) :: ms) k) d
    | _       -> assert false
  in
  let d = Jsonm.decoder `Manual in
  let get () =
    try
      dec d
      >>= fun l ->
      value l (fun v _ -> return v) d
      >>= fun json ->
      return (Some json)
    with
    | Escape _ -> return_none
  in
  Lwt_stream.from get

let json_to_dst ~minify dst (json:t) =
  let enc e l = ignore (Jsonm.encode e (`Lexeme l)) in
  let rec value v k e = match v with
    | `A vs -> arr vs k e
    | `O ms -> obj ms k e
    | `Null | `Bool _ | `Float _ | `String _ as v -> enc e v; k e
  and arr vs k e = enc e `As; arr_vs vs k e<commit_msg>Fix the JSON stream converter<commit_after>(*
 * Copyright (c) 2013 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Lwt

let debug fmt =
  IrminLog.debug "JSON" fmt

(* From http://erratique.ch/software/jsonm/doc/Jsonm.html#datamodel *)
type t =
  [ `Null
  | `Bool of bool
  | `Float of float
  | `String of string
  | `A of t list
  | `O of (string * t) list ]

exception Escape of ((int * int) * (int * int)) * Jsonm.error

let json_of_src ?encoding src =
  let dec d = match Jsonm.decode d with
    | `Lexeme l -> l
    | `Error e  -> raise (Escape (Jsonm.decoded_range d, e))
    | `End
    | `Await    -> assert false
  in
  let rec value v k d = match v with
    | `Os -> obj [] k d
    | `As -> arr [] k d
    | `Null
    | `Bool _
    | `String _
    | `Float _ as v -> k v d
    | _ -> assert false
  and arr vs k d = match dec d with
    | `Ae -> k (`A (List.rev vs)) d
    | v   -> value v (fun v -> arr (v :: vs) k) d
  and obj ms k d = match dec d with
    | `Oe     -> k (`O (List.rev ms)) d
    | `Name n -> value (dec d) (fun v -> obj ((n, v) :: ms) k) d
    | _       -> assert false
  in
  let d = Jsonm.decoder ?encoding src in
  try `JSON (value (dec d) (fun v _ -> v) d) with
  | Escape (r, e) -> `Error (r, e)

let of_stream (stream: string Lwt_stream.t): t Lwt_stream.t =
  let rec dec d = match Jsonm.decode d with
    | `Lexeme l -> return l
    | `Error e  -> fail (Escape (Jsonm.decoded_range d, e))
    | `Await    ->
      begin
        Lwt_stream.get stream >>= function
        | None    -> fail (Escape (Jsonm.decoded_range d, (`Expected `Value)))
        | Some str ->
          Jsonm.Manual.src d str 0 (String.length str);
          dec d
      end;
    | `End      -> assert false
  in
  let rec value v k d = match v with
    | `Os -> obj [] k d
    | `As -> arr [] k d
    | `Null
    | `Bool _
    | `String _
    | `Float _ as v -> k v d
    | _ -> assert false
  and arr vs k d =
    dec d >>= function
    | `Ae -> k (`A (List.rev vs)) d
    | v   -> value v (fun v -> arr (v :: vs) k) d
  and obj ms k d =
    dec d >>= function
    | `Oe     -> k (`O (List.rev ms)) d
    | `Name n -> dec d >>= fun l -> value l (fun v -> obj ((n, v) :: ms) k) d
    | _       -> assert false
  in
  let get () =
    let d = Jsonm.decoder `Manual in
    try
      dec d >>= fun l ->
      value l (fun v _ ->
          Jsonm.Manual.src d "" 0 0;
          return v
        ) d >>= fun json ->
      return (Some json)
    with
    | Escape _ -> return_none
  in
  Lwt_stream.from get

let json_to_dst ~minify dst (json:t) =
  let enc e l = ignore (Jsonm.encode e (`Lexeme l)) in
  let rec value v k e = match v with
    | `A vs -> arr vs k e
    | `O ms -> obj ms k e
    | `Null | `Bool _ | `Float _ | `String _ as v -> enc e v; k e
  and arr vs k e = enc e `As; arr_vs vs k e
{'fraction_non_alphanumeric': 0.12170298165137615, 'fraction_numerical': 0.0017201834862385322, 'mean_word_length': 2.0749228735125604, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 115, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '474469', 'n_tokens_mistral': 2482, 'n_tokens_neox': 2404, 'n_words': 1037}