├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── CONTRIBUTING.md ├── LICENSE.md ├── Makefile ├── README.md ├── dune ├── dune-project ├── example ├── dune ├── example.ml ├── example.mli ├── ppx_csv_conv_deprecated_test.ml └── test.csv ├── ppx_csv_conv.opam ├── src ├── dune ├── ppx_csv_conv_deprecated.ml └── ppx_csv_conv_deprecated.mli └── test ├── dune └── type_name_other_than_t.mlt /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | *.merlin 4 | _opam 5 | 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile=janestreet 2 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.11 2 | 3 | Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver, 4 | ppx\_metaquot and ppx\_type\_conv. 5 | 6 | ## 113.24.00 7 | 8 | - Update to follow `type_conv` and `ppx_core` evolution 9 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This repository contains open source software that is developed and 2 | maintained by [Jane Street][js]. 3 | 4 | Contributions to this project are welcome and should be submitted via 5 | GitHub pull requests. 6 | 7 | Signing contributions 8 | --------------------- 9 | 10 | We require that you sign your contributions. Your signature certifies 11 | that you wrote the patch or otherwise have the right to pass it on as 12 | an open-source patch. The rules are pretty simple: if you can certify 13 | the below (from [developercertificate.org][dco]): 14 | 15 | ``` 16 | Developer Certificate of Origin 17 | Version 1.1 18 | 19 | Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 20 | 1 Letterman Drive 21 | Suite D4700 22 | San Francisco, CA, 94129 23 | 24 | Everyone is permitted to copy and distribute verbatim copies of this 25 | license document, but changing it is not allowed. 26 | 27 | 28 | Developer's Certificate of Origin 1.1 29 | 30 | By making a contribution to this project, I certify that: 31 | 32 | (a) The contribution was created in whole or in part by me and I 33 | have the right to submit it under the open source license 34 | indicated in the file; or 35 | 36 | (b) The contribution is based upon previous work that, to the best 37 | of my knowledge, is covered under an appropriate open source 38 | license and I have the right under that license to submit that 39 | work with modifications, whether created in whole or in part 40 | by me, under the same open source license (unless I am 41 | permitted to submit under a different license), as indicated 42 | in the file; or 43 | 44 | (c) The contribution was provided directly to me by some other 45 | person who certified (a), (b) or (c) and I have not modified 46 | it. 47 | 48 | (d) I understand and agree that this project and the contribution 49 | are public and that a record of the contribution (including all 50 | personal information I submit with it, including my sign-off) is 51 | maintained indefinitely and may be redistributed consistent with 52 | this project or the open source license(s) involved. 53 | ``` 54 | 55 | Then you just add a line to every git commit message: 56 | 57 | ``` 58 | Signed-off-by: Joe Smith 59 | ``` 60 | 61 | Use your real name (sorry, no pseudonyms or anonymous contributions.) 62 | 63 | If you set your `user.name` and `user.email` git configs, you can sign 64 | your commit automatically with git commit -s. 65 | 66 | [dco]: http://developercertificate.org/ 67 | [js]: https://opensource.janestreet.com/ 68 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2015--2025 Jane Street Group, LLC 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) 2 | 3 | default: 4 | dune build 5 | 6 | install: 7 | dune install $(INSTALL_ARGS) 8 | 9 | uninstall: 10 | dune uninstall $(INSTALL_ARGS) 11 | 12 | reinstall: uninstall install 13 | 14 | clean: 15 | dune clean 16 | 17 | .PHONY: default install uninstall reinstall clean 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ppx_csv_conv 2 | ============ 3 | 4 | Generate functions to read/write records in csv format. 5 | 6 | `ppx_csv_conv` generates functions to output some records as a csv 7 | file, and read the records back from a list of strings coming from a 8 | csv file or a database query. 9 | 10 | Usage 11 | ----- 12 | 13 | Annotate the type: [@@deriving fields, csv] 14 | 15 | ```ocaml 16 | type t = { 17 | field : ... 18 | .... 19 | } [@@deriving fields, csv] 20 | ``` 21 | 22 | Csv uses fields so fields is also required. Now the functions listed 23 | in `Csvfields.Csv.Csvable` are included in the module, including 24 | conversion to and from string lists, dumping to files, and loading 25 | files. 26 | 27 | The `Csvfields.Csv` module provides the `Atom` functor, which accepts a 28 | Stringable module to produce the necessary functions for recursive 29 | calls: 30 | 31 | ```ocaml 32 | module Date = struct 33 | include Date 34 | include (Csvfields.Csv.Atom (Date) : Csvfields.Csv.Csvable with type t := t) 35 | end 36 | 37 | type t = { 38 | a : float; 39 | b : string; 40 | c : int; 41 | e : Date.t; 42 | } [@@deriving fields, csv] 43 | ``` 44 | 45 | Generate code/functions with types: 46 | 47 | ```ocaml 48 | include (Csvfields.Csv.Csvable with type t := t) 49 | ``` 50 | 51 | (Known) limitations: 52 | -------------------- 53 | 54 | - No `option`, `ref`, or `lazy_t` types allowed. 55 | - No variant types ... nothing other than primitive types and 56 | records. You should create your own stringable version of those 57 | types and use the `Atom` functor. 58 | - The name of the type must be `t`. 59 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/ppx_csv_conv/f3f23ed2856eeaa140f44901e6a2b1216a294c0e/dune -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.17) 2 | -------------------------------------------------------------------------------- /example/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_csv_conv_deprecated_test) 3 | (libraries core csvfields) 4 | (preprocess 5 | (pps ppx_jane ppx_csv_conv_deprecated))) 6 | 7 | (alias 8 | (name DEFAULT) 9 | (deps example.ml.pp example.mli.pp)) 10 | -------------------------------------------------------------------------------- /example/example.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module Date = struct 4 | include Date 5 | include (Csvfields.Csv.Atom (Date) : Csvfields.Csv.Csvable with type t := t) 6 | end 7 | 8 | type t = 9 | { a : float 10 | ; b : string 11 | ; c : int 12 | ; d : Date.t 13 | } 14 | [@@deriving 15 | fields ~iterators:(make_creator, fold) ~direct_iterators:iter, csv, compare, sexp] 16 | 17 | let%test_unit _ = 18 | let actual = csv_load "test.csv" in 19 | let expect = 20 | [ { a = 3.14; b = "first"; c = 1; d = Date.of_string "2012-12-01" } 21 | ; { a = 6.28; b = "second"; c = 2; d = Date.of_string "2012-12-02" } 22 | ; { a = 9.42; b = "third"; c = 3; d = Date.of_string "2012-12-03" } 23 | ] 24 | in 25 | [%test_result: t list] actual ~expect 26 | ;; 27 | -------------------------------------------------------------------------------- /example/example.mli: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | type t = 4 | { a : float 5 | ; b : string 6 | ; c : int 7 | ; d : Date.t 8 | } 9 | [@@deriving csv] 10 | -------------------------------------------------------------------------------- /example/ppx_csv_conv_deprecated_test.ml: -------------------------------------------------------------------------------- 1 | module Example = Example 2 | -------------------------------------------------------------------------------- /example/test.csv: -------------------------------------------------------------------------------- 1 | 3.14,first,1,2012-12-01 2 | 6.28,second,2,2012-12-02 3 | 9.42,third,3,2012-12-03 4 | -------------------------------------------------------------------------------- /ppx_csv_conv.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jane Street developers" 3 | authors: ["Jane Street Group, LLC"] 4 | homepage: "https://github.com/janestreet/ppx_csv_conv" 5 | bug-reports: "https://github.com/janestreet/ppx_csv_conv/issues" 6 | dev-repo: "git+https://github.com/janestreet/ppx_csv_conv.git" 7 | doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_csv_conv/index.html" 8 | license: "MIT" 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ] 12 | depends: [ 13 | "ocaml" {>= "5.1.0"} 14 | "base" 15 | "csvfields" 16 | "ppx_conv_func" 17 | "ppx_fields_conv" 18 | "dune" {>= "3.17.0"} 19 | "ppxlib" {>= "0.33.0" & < "0.36.0"} 20 | ] 21 | available: arch != "arm32" & arch != "x86_32" 22 | synopsis: "Generate functions to read/write records in csv format" 23 | description: " 24 | Part of the Jane Street's PPX rewriters collection. 25 | " 26 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_csv_conv_deprecated) 3 | (public_name ppx_csv_conv) 4 | (kind ppx_deriver) 5 | (ppx_runtime_libraries csvfields) 6 | (libraries base ppx_conv_func ppx_fields_conv ppxlib) 7 | (preprocess 8 | (pps ppxlib.metaquot))) 9 | -------------------------------------------------------------------------------- /src/ppx_csv_conv_deprecated.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Ppxlib 3 | open Ast_builder.Default 4 | 5 | let extension_name = "csv" 6 | 7 | let unsupported_type_error_msg ~name = 8 | Printf.sprintf "The type %s is not natively supported in the csv camlp4 extension" name 9 | ;; 10 | 11 | let useless_merge_recursive _log ~field_name:_ ~tp:_ ast = ast 12 | 13 | let edot ~loc path_opt id = 14 | pexp_ident 15 | ~loc 16 | (Located.mk 17 | ~loc 18 | (match path_opt with 19 | | None -> Longident.Lident id 20 | | Some p -> Longident.Ldot (p, id))) 21 | ;; 22 | 23 | (** Generate the list of fields contained in a flattened record type *) 24 | module Rev_headers = Ppx_conv_func.Of_simple (struct 25 | let unsupported_type_error_msg = unsupported_type_error_msg 26 | let conversion_name = extension_name 27 | 28 | let function_name = function 29 | | None -> "rev_csv_header'" 30 | | Some param -> Printf.sprintf "rev_csv_header_of_%s'" param 31 | ;; 32 | 33 | let atoms loc ~field_name = [%expr fun acc _ -> [%e estring ~loc field_name] :: acc] 34 | let merge_recursive = useless_merge_recursive 35 | 36 | let recursive loc ~field_name ~type_name:_ ~path = 37 | let tns = function_name None in 38 | let recursive = edot ~loc path tns in 39 | let is_csv_atom = edot ~loc path "is_csv_atom" in 40 | [%expr 41 | fun acc _ -> 42 | if [%e is_csv_atom] 43 | then [%e estring ~loc field_name] :: acc 44 | else [%e recursive] acc () ()] 45 | ;; 46 | end) 47 | 48 | (* Generate the specification of the headers as a tree. This is useful to generate headers 49 | consisting of multiple rows, each field grouping those below. *) 50 | module Spec_of_headers = Ppx_conv_func.Of_simple (struct 51 | let unsupported_type_error_msg = unsupported_type_error_msg 52 | let conversion_name = extension_name 53 | 54 | let function_name = function 55 | | None -> "rev_csv_header_spec'" 56 | | Some param -> Printf.sprintf "rev_csv_header_spec_of_%s'" param 57 | ;; 58 | 59 | let atoms loc ~field_name = 60 | [%expr fun acc _ -> Csvfields.Csv.Spec.Leaf [%e estring ~loc field_name] :: acc] 61 | ;; 62 | 63 | let merge_recursive = useless_merge_recursive 64 | 65 | let recursive loc ~field_name ~type_name:_ ~path = 66 | let tns = function_name None in 67 | let recursive = edot ~loc path tns in 68 | let is_csv_atom = edot ~loc path "is_csv_atom" in 69 | [%expr 70 | fun acc _ -> 71 | if [%e is_csv_atom] 72 | then Csvfields.Csv.Spec.Leaf [%e estring ~loc field_name] :: acc 73 | else 74 | Csvfields.Csv.Spec.Tree ([%e estring ~loc field_name], [%e recursive] [] () ()) 75 | :: acc] 76 | ;; 77 | end) 78 | 79 | (** Generate the some type using a csv row (a list of strings) *) 80 | module Type_of_csv_row = Ppx_conv_func.Of_complete (struct 81 | let unsupported_type_error_msg = unsupported_type_error_msg 82 | let conversion_name = extension_name 83 | 84 | let function_name = function 85 | | None -> failwith "Csv conversion of_row requires some name" 86 | | Some param -> Printf.sprintf "%s_of_row'" param 87 | ;; 88 | 89 | let unit loc ~field_name:_ = [%expr Csvfields.Csv.unit_of_row] 90 | let bool loc ~field_name:_ = [%expr Csvfields.Csv.bool_of_row] 91 | let string loc ~field_name:_ = [%expr Csvfields.Csv.string_of_row] 92 | let char loc ~field_name:_ = [%expr Csvfields.Csv.char_of_row] 93 | let int loc ~field_name:_ = [%expr Csvfields.Csv.int_of_row] 94 | let float loc ~field_name:_ = [%expr Csvfields.Csv.float_of_row] 95 | let int32 loc ~field_name:_ = [%expr Csvfields.Csv.int32_of_row] 96 | let int64 loc ~field_name:_ = [%expr Csvfields.Csv.int64_of_row] 97 | let nativeint loc ~field_name:_ = [%expr Csvfields.Csv.nativeint_of_row] 98 | let big_int loc ~field_name:_ = [%expr Csvfields.Csv.big_int_of_row] 99 | let nat loc ~field_name:_ = [%expr Csvfields.Csv.nat_of_row] 100 | let num loc ~field_name:_ = [%expr Csvfields.Csv.num_of_row] 101 | let ratio loc ~field_name:_ = [%expr Csvfields.Csv.ratio_of_row] 102 | let list loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "list" 103 | let array loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "list" 104 | let option loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "option" 105 | let lazy_t loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "lazy_t" 106 | let ref loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "ref" 107 | let merge_recursive = useless_merge_recursive 108 | 109 | let recursive loc ~field_name:_ ~type_name ~path = 110 | let tns = function_name (Some type_name) in 111 | edot ~loc path tns 112 | ;; 113 | end) 114 | 115 | module type B = sig 116 | val writer : Location.t -> arg_label * expression 117 | val is_first : Location.t -> arg_label * expression 118 | val is_last : Location.t -> arg_label * expression 119 | end 120 | 121 | module Make_row_of (S : B) = struct 122 | let unsupported_type_error_msg = unsupported_type_error_msg 123 | let conversion_name = extension_name 124 | 125 | let function_name = function 126 | | None -> failwith "Csv conversion write_row_of_ requires some name" 127 | | Some param -> Printf.sprintf "write_row_of_%s'" param 128 | ;; 129 | 130 | let add_arguments expr loc = 131 | pexp_apply ~loc expr [ S.is_first loc; S.is_last loc; S.writer loc ] 132 | ;; 133 | 134 | let unit loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_unit] loc 135 | let bool loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_bool] loc 136 | let string loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_string] loc 137 | let char loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_char] loc 138 | let int loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_int] loc 139 | let float loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_float] loc 140 | let int32 loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_int32] loc 141 | let int64 loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_int64] loc 142 | 143 | let nativeint loc ~field_name:_ = 144 | add_arguments [%expr Csvfields.Csv.row_of_nativeint] loc 145 | ;; 146 | 147 | let big_int loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_big_int] loc 148 | let nat loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_nat] loc 149 | let num loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_num] loc 150 | let ratio loc ~field_name:_ = add_arguments [%expr Csvfields.Csv.row_of_ratio] loc 151 | let merge_recursive = useless_merge_recursive 152 | 153 | let recursive loc ~field_name:_ ~type_name ~path = 154 | let tns = function_name (Some type_name) in 155 | add_arguments (edot ~loc path tns) loc 156 | ;; 157 | 158 | let list loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "list" 159 | let array loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "array" 160 | let option loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "option" 161 | let lazy_t loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "lazy_t" 162 | let ref loc ~field_name:_ = Ppx_conv_func.raise_unsupported ~loc "ref" 163 | end 164 | 165 | let falseexpr loc = [%expr false] 166 | 167 | module Unique_row_of = Ppx_conv_func.Of_complete (Make_row_of (struct 168 | let writer loc = Labelled "writer", [%expr writer] 169 | let is_first loc = Labelled "is_first", [%expr is_first] 170 | let is_last loc = Labelled "is_last", [%expr is_last] 171 | end)) 172 | 173 | module First_row_of = Ppx_conv_func.Of_complete (Make_row_of (struct 174 | let writer loc = Labelled "writer", [%expr writer] 175 | let is_first loc = Labelled "is_first", [%expr is_first] 176 | let is_last loc = Labelled "is_last", falseexpr loc 177 | end)) 178 | 179 | module Middle_row_of = Ppx_conv_func.Of_complete (Make_row_of (struct 180 | let writer loc = Labelled "writer", [%expr writer] 181 | let is_first loc = Labelled "is_first", falseexpr loc 182 | let is_last loc = Labelled "is_last", falseexpr loc 183 | end)) 184 | 185 | module Last_row_of = Ppx_conv_func.Of_complete (Make_row_of (struct 186 | let writer loc = Labelled "writer", [%expr writer] 187 | let is_first loc = Labelled "is_first", falseexpr loc 188 | let is_last loc = Labelled "is_last", [%expr is_last] 189 | end)) 190 | 191 | let csv_record_sig loc ~record_name = 192 | let st = 193 | psig_include 194 | ~loc 195 | (include_infos 196 | ~loc 197 | (pmty_with 198 | ~loc 199 | (pmty_ident ~loc (Located.lident ~loc "Csvfields.Csv.Csvable")) 200 | [ Pwith_typesubst 201 | ( Located.lident ~loc "t" 202 | , type_declaration 203 | ~loc 204 | ~name:(Located.mk ~loc "t") 205 | ~params:[] 206 | ~manifest: 207 | (Some (ptyp_constr ~loc (Located.lident ~loc record_name) [])) 208 | ~cstrs:[] 209 | ~kind:Ptype_abstract 210 | ~private_:Public ) 211 | ])) 212 | in 213 | [ st ] 214 | ;; 215 | 216 | let rev_csv_header' ~record_name ~lds loc = 217 | let name = [%pat? rev_csv_header'] in 218 | let conversion_of_type = Rev_headers.conversion_of_type in 219 | Ppx_conv_func.Gen_struct.generate_using_fold 220 | ~record_name 221 | ~pass_acc:true 222 | ~pass_anonymous:true 223 | ~conversion_of_type 224 | ~name 225 | ~lds 226 | loc 227 | ;; 228 | 229 | let rev_csv_header_spec' ~record_name ~lds loc = 230 | let name = [%pat? rev_csv_header_spec'] in 231 | let conversion_of_type = Spec_of_headers.conversion_of_type in 232 | Ppx_conv_func.Gen_struct.generate_using_fold 233 | ~record_name 234 | ~pass_acc:true 235 | ~pass_anonymous:true 236 | ~conversion_of_type 237 | ~name 238 | ~lds 239 | loc 240 | ;; 241 | 242 | let fields_module ~record_name ~loc ~suffix = 243 | Ast_helper.Exp.ident 244 | { loc 245 | ; txt = 246 | Longident.parse 247 | (Printf.sprintf 248 | "%s.%s" 249 | (match String.equal record_name "t" with 250 | | true -> "Fields" 251 | | false -> Printf.sprintf "Fields_of_%s" record_name) 252 | suffix) 253 | } 254 | ;; 255 | 256 | let row_of_t' ~record_name ~lds loc = 257 | let init = [%expr [%e fields_module ~record_name ~loc ~suffix:"Direct.iter"] t] in 258 | let body = 259 | Ppx_conv_func.Gen_struct.make_body 260 | ~lds 261 | ~init 262 | loc 263 | ~unique_f:Unique_row_of.conversion_of_type 264 | ~first_f:First_row_of.conversion_of_type 265 | ~last_f:Last_row_of.conversion_of_type 266 | Middle_row_of.conversion_of_type 267 | in 268 | let anonymous = Ppx_conv_func.Gen_struct.anonymous loc in 269 | let func = 270 | [%expr fun ~is_first ~is_last ~writer [%p anonymous] [%p anonymous] t -> [%e body]] 271 | in 272 | [%stri let write_row_of_t' = [%e func]] 273 | ;; 274 | 275 | let t_of_row' ~record_name ~lds loc = 276 | let init = 277 | [%expr [%e fields_module ~record_name ~loc ~suffix:"make_creator"] strings] 278 | in 279 | let body = 280 | let f = Type_of_csv_row.conversion_of_type in 281 | Ppx_conv_func.Gen_struct.make_body ~lds ~init loc f 282 | in 283 | let func = 284 | Ppx_conv_func.lambda 285 | loc 286 | [ Ppx_conv_func.Gen_struct.anonymous loc; [%pat? strings] ] 287 | body 288 | in 289 | [%stri let t_of_row' = [%e func]] 290 | ;; 291 | 292 | let csv_record ~tps:_ ~record_name loc lds = 293 | let t_of_row' = t_of_row' ~record_name ~lds loc in 294 | let is_csv_atom = [%stri let is_csv_atom = false] in 295 | let row_of_t' = row_of_t' ~record_name ~lds loc in 296 | let rev_csv_header' = rev_csv_header' ~record_name ~lds loc in 297 | let rev_csv_header_spec' = rev_csv_header_spec' ~record_name ~lds loc in 298 | let t = 299 | if String.( <> ) record_name "t" 300 | then [%str type t = [%t ptyp_constr ~loc (Located.lident ~loc record_name) []]] 301 | else 302 | [%str 303 | type _t = t 304 | type t = _t] 305 | in 306 | let with_constraints = 307 | [ Pwith_typesubst 308 | ( Located.lident ~loc "t" 309 | , type_declaration 310 | ~loc 311 | ~name:(Located.mk ~loc "t") 312 | ~manifest:(Some (ptyp_constr ~loc (Located.lident ~loc record_name) [])) 313 | ~kind:Ptype_abstract 314 | ~private_:Public 315 | ~params:[] 316 | ~cstrs:[] ) 317 | ] 318 | in 319 | let applied_functor = 320 | pmod_apply 321 | ~loc 322 | (pmod_ident ~loc (Located.lident ~loc "Csvfields.Csv.Record")) 323 | (pmod_structure 324 | ~loc 325 | (t @ [ is_csv_atom; rev_csv_header'; rev_csv_header_spec'; t_of_row'; row_of_t' ])) 326 | in 327 | let st = 328 | pstr_include 329 | ~loc 330 | (include_infos 331 | ~loc 332 | (pmod_constraint 333 | ~loc 334 | applied_functor 335 | (pmty_with 336 | ~loc 337 | (pmty_ident ~loc (Located.lident ~loc "Csvfields.Csv.Csvable")) 338 | with_constraints))) 339 | in 340 | [ st 341 | ; [%stri let [%p pvar ~loc (record_name ^ "_of_row")] = t_of_row] 342 | ; [%stri let [%p pvar ~loc ("row_of_" ^ record_name)] = row_of_t] 343 | ; [%stri let [%p pvar ~loc (record_name ^ "_of_row'")] = t_of_row'] 344 | ; [%stri let [%p pvar ~loc ("write_row_of_" ^ record_name ^ "'")] = write_row_of_t'] 345 | ] 346 | ;; 347 | 348 | let csv = 349 | let str_type_decl = 350 | Deriving.Generator.make 351 | Deriving.Args.empty 352 | (Ppx_conv_func.Gen_struct.generate ~extension_name ~record:csv_record) 353 | ~deps:[ Ppx_fields_conv.fields ] 354 | in 355 | let sig_type_decl = 356 | Deriving.Generator.make 357 | Deriving.Args.empty 358 | (Ppx_conv_func.Gen_sig.generate 359 | ~extension_name 360 | ~nil:(fun ~tps:_ ~record_name loc -> csv_record_sig loc ~record_name) 361 | ~record:(fun ~tps:_ ~record_name loc _ -> csv_record_sig loc ~record_name)) 362 | in 363 | Deriving.add extension_name ~str_type_decl ~sig_type_decl 364 | ;; 365 | -------------------------------------------------------------------------------- /src/ppx_csv_conv_deprecated.mli: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | val csv : Deriving.t 4 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/ppx_csv_conv/f3f23ed2856eeaa140f44901e6a2b1216a294c0e/test/dune -------------------------------------------------------------------------------- /test/type_name_other_than_t.mlt: -------------------------------------------------------------------------------- 1 | #verbose true 2 | 3 | open! Core 4 | 5 | (* From issue described by pveber, Mar 13th 2018: 6 | https://github.com/janestreet/ppx_csv_conv/issues/1#issuecomment-372721080 7 | *) 8 | 9 | module M_t = struct 10 | type t = 11 | { id : string 12 | ; count : int 13 | } 14 | [@@deriving 15 | fields 16 | ~getters 17 | ~setters 18 | ~names 19 | ~fields 20 | ~iterators: 21 | ( create 22 | , make_creator 23 | , exists 24 | , fold 25 | , fold_right 26 | , for_all 27 | , iter 28 | , map 29 | , to_list 30 | , map_poly ) 31 | ~direct_iterators: 32 | (exists, fold, fold_right, for_all, iter, map, to_list, set_all_mutable_fields) 33 | , csv] 34 | end 35 | 36 | [%%expect 37 | {| 38 | module M_t : 39 | sig 40 | type t = { id : string; count : int; } 41 | val count : t -> int 42 | [@@zero_alloc custom_error_message "Hint: add [@@fields.no_zero_alloc] to disable the zero-alloc guarantees that [@@deriving fields] tries to make by default."] 43 | val id : t -> string 44 | [@@zero_alloc custom_error_message "Hint: add [@@fields.no_zero_alloc] to disable the zero-alloc guarantees that [@@deriving fields] tries to make by default."] 45 | module Fields : 46 | sig 47 | val names : string list 48 | val count : ([< `Read | `Set_and_create ], t, int) Field.t_with_perm 49 | val id : ([< `Read | `Set_and_create ], t, string) Field.t_with_perm 50 | val make_creator : 51 | id:(([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 52 | 'a -> ('b -> string) * 'c) -> 53 | count:(([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 54 | 'c -> ('b -> int) * 'd) -> 55 | 'a -> ('b -> t) * 'd 56 | val create : id:string -> count:int -> t 57 | val map : 58 | id:local_ 59 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 60 | string) -> 61 | count:local_ 62 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> int) -> 63 | t 64 | val iter : 65 | id:local_ 66 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 67 | unit) -> 68 | count:local_ 69 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> unit) -> 70 | unit 71 | val fold : 72 | init:'a -> 73 | id:local_ 74 | ('a -> 75 | ([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 'b) -> 76 | count:local_ 77 | ('b -> 78 | ([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 'c) -> 79 | 'c 80 | val map_poly : 81 | local_ ([< `Read | `Set_and_create ], t, 'a) Field.user -> 'a list 82 | val for_all : 83 | id:local_ 84 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 85 | bool) -> 86 | count:local_ 87 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> bool) -> 88 | bool 89 | val exists : 90 | id:local_ 91 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 92 | bool) -> 93 | count:local_ 94 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> bool) -> 95 | bool 96 | val to_list : 97 | id:local_ 98 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 'a) -> 99 | count:local_ 100 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 'a) -> 101 | 'a list 102 | val fold_right : 103 | id:local_ 104 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 105 | 'a -> 'b) -> 106 | count:local_ 107 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 108 | 'c -> 'a) -> 109 | init:'c -> 'b 110 | module Direct : 111 | sig 112 | val iter : 113 | t -> 114 | id:local_ 115 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 116 | t -> string -> unit) -> 117 | count:local_ 118 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 119 | t -> int -> 'a) -> 120 | 'a 121 | val fold : 122 | t -> 123 | init:'a -> 124 | id:local_ 125 | ('a -> 126 | ([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 127 | t -> string -> 'b) -> 128 | count:local_ 129 | ('b -> 130 | ([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 131 | t -> int -> 'c) -> 132 | 'c 133 | val for_all : 134 | t -> 135 | id:local_ 136 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 137 | t -> string -> bool) -> 138 | count:local_ 139 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 140 | t -> int -> bool) -> 141 | bool 142 | val exists : 143 | t -> 144 | id:local_ 145 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 146 | t -> string -> bool) -> 147 | count:local_ 148 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 149 | t -> int -> bool) -> 150 | bool 151 | val to_list : 152 | t -> 153 | id:local_ 154 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 155 | t -> string -> 'a) -> 156 | count:local_ 157 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 158 | t -> int -> 'a) -> 159 | 'a list 160 | val fold_right : 161 | t -> 162 | id:local_ 163 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 164 | t -> string -> 'a -> 'b) -> 165 | count:local_ 166 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 167 | t -> int -> 'c -> 'a) -> 168 | init:'c -> 'b 169 | val map : 170 | t -> 171 | id:local_ 172 | (([< `Read | `Set_and_create ], t, string) Field.t_with_perm -> 173 | t -> string -> string) -> 174 | count:local_ 175 | (([< `Read | `Set_and_create ], t, int) Field.t_with_perm -> 176 | t -> int -> int) -> 177 | t 178 | val set_all_mutable_fields : local_ 'a -> unit 179 | [@@zero_alloc custom_error_message "Hint: add [@@fields.no_zero_alloc] to disable the zero-alloc guarantees that [@@deriving fields] tries to make by default."] 180 | end 181 | end 182 | val is_csv_atom : bool 183 | val rev_csv_header' : string list -> 'a -> 'b -> string list 184 | val rev_csv_header_spec' : 185 | Csvfields.Csv.Spec.t list -> 'a -> 'b -> Csvfields.Csv.Spec.t list 186 | val csv_header : string list 187 | val csv_header_spec : Csvfields.Csv.Spec.t list 188 | val csv_load : ?separator:char -> string -> t list 189 | val csv_load_in : ?separator:char -> in_channel -> t list 190 | val csv_save_fn : ?separator:char -> (string -> unit) -> t list -> unit 191 | val csv_save_out : ?separator:char -> out_channel -> t list -> unit 192 | val csv_save : ?separator:char -> string -> t list -> unit 193 | val t_of_row : string list -> t 194 | val row_of_t : t -> string list 195 | val t_of_row' : 'a -> string list -> (unit -> t) * string list 196 | val write_row_of_t' : 197 | is_first:bool -> 198 | is_last:bool -> writer:(string -> unit) -> 'a -> 'b -> t -> unit 199 | end 200 | |}] 201 | 202 | module M_u = struct 203 | type u = 204 | { id : string 205 | ; count : int 206 | } 207 | [@@deriving 208 | fields 209 | ~getters 210 | ~setters 211 | ~names 212 | ~fields 213 | ~iterators: 214 | ( create 215 | , make_creator 216 | , exists 217 | , fold 218 | , fold_right 219 | , for_all 220 | , iter 221 | , map 222 | , to_list 223 | , map_poly ) 224 | ~direct_iterators: 225 | (exists, fold, fold_right, for_all, iter, map, to_list, set_all_mutable_fields) 226 | , csv] 227 | end 228 | 229 | [%%expect 230 | {| 231 | module M_u : 232 | sig 233 | type u = { id : string; count : int; } 234 | val count : u -> int 235 | [@@zero_alloc custom_error_message "Hint: add [@@fields.no_zero_alloc] to disable the zero-alloc guarantees that [@@deriving fields] tries to make by default."] 236 | val id : u -> string 237 | [@@zero_alloc custom_error_message "Hint: add [@@fields.no_zero_alloc] to disable the zero-alloc guarantees that [@@deriving fields] tries to make by default."] 238 | module Fields_of_u : 239 | sig 240 | val names : string list 241 | val count : ([< `Read | `Set_and_create ], u, int) Field.t_with_perm 242 | val id : ([< `Read | `Set_and_create ], u, string) Field.t_with_perm 243 | val make_creator : 244 | id:(([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 245 | 'a -> ('b -> string) * 'c) -> 246 | count:(([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 247 | 'c -> ('b -> int) * 'd) -> 248 | 'a -> ('b -> u) * 'd 249 | val create : id:string -> count:int -> u 250 | val map : 251 | id:local_ 252 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 253 | string) -> 254 | count:local_ 255 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> int) -> 256 | u 257 | val iter : 258 | id:local_ 259 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 260 | unit) -> 261 | count:local_ 262 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> unit) -> 263 | unit 264 | val fold : 265 | init:'a -> 266 | id:local_ 267 | ('a -> 268 | ([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 'b) -> 269 | count:local_ 270 | ('b -> 271 | ([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 'c) -> 272 | 'c 273 | val map_poly : 274 | local_ ([< `Read | `Set_and_create ], u, 'a) Field.user -> 'a list 275 | val for_all : 276 | id:local_ 277 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 278 | bool) -> 279 | count:local_ 280 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> bool) -> 281 | bool 282 | val exists : 283 | id:local_ 284 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 285 | bool) -> 286 | count:local_ 287 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> bool) -> 288 | bool 289 | val to_list : 290 | id:local_ 291 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 'a) -> 292 | count:local_ 293 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 'a) -> 294 | 'a list 295 | val fold_right : 296 | id:local_ 297 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 298 | 'a -> 'b) -> 299 | count:local_ 300 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 301 | 'c -> 'a) -> 302 | init:'c -> 'b 303 | module Direct : 304 | sig 305 | val iter : 306 | u -> 307 | id:local_ 308 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 309 | u -> string -> unit) -> 310 | count:local_ 311 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 312 | u -> int -> 'a) -> 313 | 'a 314 | val fold : 315 | u -> 316 | init:'a -> 317 | id:local_ 318 | ('a -> 319 | ([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 320 | u -> string -> 'b) -> 321 | count:local_ 322 | ('b -> 323 | ([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 324 | u -> int -> 'c) -> 325 | 'c 326 | val for_all : 327 | u -> 328 | id:local_ 329 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 330 | u -> string -> bool) -> 331 | count:local_ 332 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 333 | u -> int -> bool) -> 334 | bool 335 | val exists : 336 | u -> 337 | id:local_ 338 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 339 | u -> string -> bool) -> 340 | count:local_ 341 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 342 | u -> int -> bool) -> 343 | bool 344 | val to_list : 345 | u -> 346 | id:local_ 347 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 348 | u -> string -> 'a) -> 349 | count:local_ 350 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 351 | u -> int -> 'a) -> 352 | 'a list 353 | val fold_right : 354 | u -> 355 | id:local_ 356 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 357 | u -> string -> 'a -> 'b) -> 358 | count:local_ 359 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 360 | u -> int -> 'c -> 'a) -> 361 | init:'c -> 'b 362 | val map : 363 | u -> 364 | id:local_ 365 | (([< `Read | `Set_and_create ], u, string) Field.t_with_perm -> 366 | u -> string -> string) -> 367 | count:local_ 368 | (([< `Read | `Set_and_create ], u, int) Field.t_with_perm -> 369 | u -> int -> int) -> 370 | u 371 | val set_all_mutable_fields : local_ 'a -> unit 372 | [@@zero_alloc custom_error_message "Hint: add [@@fields.no_zero_alloc] to disable the zero-alloc guarantees that [@@deriving fields] tries to make by default."] 373 | end 374 | end 375 | val is_csv_atom : bool 376 | val rev_csv_header' : string list -> 'a -> 'b -> string list 377 | val rev_csv_header_spec' : 378 | Csvfields.Csv.Spec.t list -> 'a -> 'b -> Csvfields.Csv.Spec.t list 379 | val t_of_row' : 'a -> string list -> (unit -> u) * string list 380 | val write_row_of_t' : 381 | is_first:bool -> 382 | is_last:bool -> writer:(string -> unit) -> 'a -> 'b -> u -> unit 383 | val csv_header : string list 384 | val csv_header_spec : Csvfields.Csv.Spec.t list 385 | val t_of_row : string list -> u 386 | val row_of_t : u -> string list 387 | val csv_load : ?separator:char -> string -> u list 388 | val csv_load_in : ?separator:char -> in_channel -> u list 389 | val csv_save_fn : ?separator:char -> (string -> unit) -> u list -> unit 390 | val csv_save_out : ?separator:char -> out_channel -> u list -> unit 391 | val csv_save : ?separator:char -> string -> u list -> unit 392 | val u_of_row : string list -> u 393 | val row_of_u : u -> string list 394 | val u_of_row' : 'a -> string list -> (unit -> u) * string list 395 | val write_row_of_u' : 396 | is_first:bool -> 397 | is_last:bool -> writer:(string -> unit) -> 'a -> 'b -> u -> unit 398 | end 399 | |}] 400 | --------------------------------------------------------------------------------