package csvfields

  1. Overview
  2. Docs
Runtime support for ppx_xml_conv and ppx_csv_conv

Install

Dune Dependency

Authors

Maintainers

Sources

v0.15.1.tar.gz
sha256=17095c85af6d0cbc18de46f60a28a29016675d273e9c89f38c2f4c10d0d08fc7

doc/src/csvfields.csvlib/csv.ml.html

Source file csv.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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
(* csv.ml - comma separated values parser
 *
 * $Id: csv.ml,v 1.5 2005/02/17 15:51:47 rich Exp $
*)

(* The format of CSV files:
 *
 * Each field starts with either a double quote char or some other
 * char. For the some other char case things are simple: just read up
 * to the next comma (,) which marks the end of the field.
 *
 * In the case where a field begins with a double quote char the
 * parsing rules are different. Any double quotes are doubled ("") and
 * we finish reading when we reach an undoubled quote. eg: "The
 * following is a quote: "", and that's all" is the CSV equivalent of
 * the following literal field: The following is a quote: ", and that's
 * all
 *
 * "0 is the quoted form of ASCII NUL.
 *
 * CSV fields can also contain literal carriage return characters, if
 * they are quoted, eg: "This field
 * is split over lines" represents a
 * single field containing a \n.
 *
 * Excel will only use the quoting format if a field contains a double
 * quote or comma, although there's no reason why Excel couldn't always
 * use the quoted format.
 *
 * The practical upshot of this is that you can't split a line in a CSV
 * file just by looking at the commas. You need to parse each field
 * separately.
 *
 * How we represent CSV files:
 *
 * We load in the whole CSV file at once, and store it internally as a
 * 'string list list' type (note that each line in the CSV file can,
 * and often will, have different lengths). We then provide simple
 * functions to read the CSV file line-by-line, copy it out, or copy a
 * subset of it into a matrix.
*)

(* namespace redirection: (mostly to get tail-recursive List functions) *)
open Core
open Poly

include struct
  module List = struct
    open List

    let length = length
    let rev = rev
    let zip_exn = zip_exn
    let map f t = map t ~f
    let iter f t = iter t ~f
    let fold_left f init t = fold_left t ~f ~init
  end

  module String = struct
    open String

    let make = make
    let length = length
    let contains = contains
    let get = get
    let escaped = escaped
    let concat sep xs = concat xs ~sep
  end
end

type t = string list list

include Bad_csv

let rec dropwhile f = function
  | [] -> []
  | x :: xs when f x -> dropwhile f xs
  | xs -> xs
;;

let lines = List.length
let columns csv = List.fold_left max 0 (List.map List.length csv)

open State

let load_rows_inchar ?(separator = ',') f inchar =
  let row = ref [] in
  (* Current row. *)
  let field = ref [] in
  (* Current field. *)
  let state = ref StartField in
  (* Current state. *)
  let end_of_field () =
    let field_list = List.rev !field in
    let field_len = List.length field_list in
    let field_str = Bytes.create field_len in
    let rec loop i = function
      | [] -> ()
      | x :: xs ->
        Bytes.set field_str i x;
        loop (i + 1) xs
    in
    loop 0 field_list;
    row := Bytes.unsafe_to_string ~no_mutation_while_string_reachable:field_str :: !row;
    field := [];
    state := StartField
  in
  let empty_field () =
    row := "" :: !row;
    field := [];
    state := StartField
  in
  let end_of_row () =
    let row_list = List.rev !row in
    f row_list;
    row := [];
    state := StartField
  in
  let rec loop () =
    let c = inchar () in
    if c <> '\r'
    then (
      (* Always ignore \r characters. *)
      match !state with
      | StartField ->
        (* Expecting quote or other char. *)
        if c = '\"'
        then (
          state := InQuotedField;
          field := [])
        else if c = separator
        then (* Empty field. *)
          empty_field ()
        else if c = '\n'
        then (
          (* Empty field, end of row. *)
          empty_field ();
          end_of_row ())
        else (
          state := InUnquotedField;
          field := [ c ])
      | InUnquotedField ->
        (* Reading chars to end of field. *)
        if c = separator
        then (* End of field. *)
          end_of_field ()
        else if c = '\n'
        then (
          (* End of field and end of row. *)
          end_of_field ();
          end_of_row ())
        else field := c :: !field
      | InQuotedField ->
        (* Reading chars to end of field. *)
        if c = '\"' then state := InQuotedFieldAfterQuote else field := c :: !field
      | InQuotedFieldAfterQuote ->
        if c = '\"'
        then (
          (* Doubled quote. *)
          field := c :: !field;
          state := InQuotedField)
        else if c = '0'
        then (
          (* Quote-0 is ASCII NUL. *)
          field := '\000' :: !field;
          state := InQuotedField)
        else if c = separator
        then (* End of field. *)
          end_of_field ()
        else if c = '\n'
        then (
          (* End of field and end of row. *)
          end_of_field ();
          end_of_row ())
        else if Char.is_whitespace c
        then ()
        else raise (Bad_CSV_file "Extra data after end quote"));
    (* end of match *)
    loop ()
  in
  try loop () with
  | End_of_file ->
    (* Any part left to write out? *)
    (match !state with
     | StartField ->
       if !row <> []
       then (
         empty_field ();
         end_of_row ())
     | InUnquotedField | InQuotedFieldAfterQuote ->
       end_of_field ();
       end_of_row ()
     | InQuotedField -> () (*raise (Bad_CSV_file "Missing end quote after quoted field.")*))
;;

let load_rows ?separator f chan =
  let inchar () =
    match In_channel.input_char chan with
    | None -> raise End_of_file
    | Some c -> c
  in
  load_rows_inchar ?separator f inchar
;;

let load_inchar ?separator inchar =
  let csv = ref [] in
  let f row = csv := row :: !csv in
  load_rows_inchar ?separator f inchar;
  List.rev !csv
;;

let load_string ?separator s =
  let pos = ref 0 in
  let len = String.length s in
  let inchar () =
    if !pos = len then raise End_of_file;
    let c = s.[!pos] in
    incr pos;
    c
  in
  load_inchar ?separator inchar
;;

let load_in ?separator chan =
  let csv = ref [] in
  let f row = csv := row :: !csv in
  load_rows ?separator f chan;
  List.rev !csv
;;

let load ?separator filename =
  let chan = In_channel.create filename in
  let csv = load_in ?separator chan in
  In_channel.close chan;
  csv
;;

let trim ?(top = true) ?(left = true) ?(right = true) ?(bottom = true) csv =
  let rec empty_row = function
    | [] -> true
    | x :: _ when x <> "" -> false
    | _ :: xs -> empty_row xs
  in
  let csv = if top then dropwhile empty_row csv else csv in
  let csv =
    if right
    then
      List.map
        (fun row ->
           let row = List.rev row in
           let row = dropwhile (( = ) "") row in
           let row = List.rev row in
           row)
        csv
    else csv
  in
  let csv =
    if bottom
    then (
      let csv = List.rev csv in
      let csv = dropwhile empty_row csv in
      let csv = List.rev csv in
      csv)
    else csv
  in
  let empty_left_cell = function
    | [] -> true
    | x :: _ when x = "" -> true
    | _ -> false
  in
  let empty_left_col = List.fold_left (fun a row -> a && empty_left_cell row) true in
  let remove_left_col =
    List.map (function
      | [] -> []
      | _ :: xs -> xs)
  in
  let rec loop csv =
    if empty_left_col csv
    then (
      let csv = remove_left_col csv in
      loop csv)
    else csv
  in
  let csv = if left then loop csv else csv in
  csv
;;

let square csv =
  let columns = columns csv in
  List.map
    (fun row ->
       let n = List.length row in
       let row = List.rev row in
       let rec loop acc = function
         | 0 -> acc
         | i -> "" :: loop acc (i - 1)
       in
       let row = loop row (columns - n) in
       List.rev row)
    csv
;;

let associate header data =
  let nr_cols = List.length header in
  let rec trunc = function
    | 0, _ -> []
    | n, [] -> "" :: trunc (n - 1, [])
    | n, x :: xs -> x :: trunc (n - 1, xs)
  in
  List.map
    (fun row ->
       let row = trunc (nr_cols, row) in
       List.zip_exn header row)
    data
;;

let save_fn ?(separator = ',') put_string csv =
  (* Quote a single CSV field. *)
  let quote_field field =
    if String.contains field separator
    || String.contains field '\"'
    || String.contains field '\n'
    then (
      let buffer = Buffer.create 100 in
      Buffer.add_char buffer '\"';
      for i = 0 to String.length field - 1 do
        match field.[i] with
        | '\"' -> Buffer.add_string buffer "\"\""
        | c -> Buffer.add_char buffer c
      done;
      Buffer.add_char buffer '\"';
      Buffer.contents buffer)
    else field
  in
  let separator = String.make 1 separator in
  List.iter
    (fun line ->
       put_string (String.concat separator (List.map quote_field line));
       put_string "\n")
    csv
;;

let save_out ?separator chan csv = save_fn ?separator (Out_channel.output_string chan) csv

let print ?separator csv =
  save_out ?separator Out_channel.stdout csv;
  Out_channel.flush Out_channel.stdout
;;

let save ?separator file csv =
  let chan = Out_channel.create file in
  save_out ?separator chan csv;
  Out_channel.close chan
;;

let save_fn_readable output_string csv =
  (* Escape all the strings in the CSV file first. *)
  let csv = List.map (List.map String.escaped) csv in
  let csv = square csv in
  (* Find the width of each column. *)
  let widths =
    match csv with
    | [] -> []
    | r :: _ ->
      let n = List.length r in
      let lengths = List.map (List.map String.length) csv in
      let max2rows r1 r2 =
        let rp = List.zip_exn r1 r2 in
        List.map (fun ((a : int), (b : int)) -> max a b) rp
      in
      let rec repeat x = function
        | 0 -> []
        | i -> x :: repeat x (i - 1)
      in
      List.fold_left max2rows (repeat 0 n) lengths
  in
  (* Print out each cell at the correct width. *)
  let rec repeat f = function
    | 0 -> ()
    | i ->
      f ();
      repeat f (i - 1)
  in
  List.iter
    (fun row ->
       let row = List.zip_exn widths row in
       List.iter
         (fun (width, cell) ->
            output_string cell;
            let n = String.length cell in
            repeat (fun () -> output_string " ") (width - n + 1))
         row;
       output_string "\n")
    csv
;;

let save_out_readable oc = save_fn_readable (Out_channel.output_string oc)
let print_readable = save_out_readable stdout
OCaml

Innovation. Community. Security.