├── .gitignore ├── .merlin ├── LICENSE.txt ├── META ├── Makefile ├── README.md ├── _tags ├── example ├── Makefile ├── OCamlMakefile └── example.ml ├── myocamlbuild.ml ├── opam ├── pkg ├── META ├── META.in ├── build.ml └── topkg.ml └── src └── ppx_netblob.ml /.gitignore: -------------------------------------------------------------------------------- 1 | ._d/ 2 | *.cache 3 | *.cmi 4 | *.cmo 5 | *.cmx 6 | *.log 7 | *.o 8 | *.swp 9 | ppx_netblob 10 | example/quine 11 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | SRC . 2 | PKG ppx_tools 3 | PKG cohttp.lwt 4 | PKG lwt 5 | PKG ppx_tools.metaquot 6 | PKG ppx_deriving.api 7 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | (This license applies to everything but the file OCamlMakefile) 3 | 4 | Anyone is free to copy, modify, publish, use, compile, sell, or 5 | distribute this software, either in source code form or as a compiled 6 | binary, for any purpose, commercial or non-commercial, and by any 7 | means. 8 | 9 | In jurisdictions that recognize copyright laws, the author or authors 10 | of this software dedicate any and all copyright interest in the 11 | software to the public domain. We make this dedication for the benefit 12 | of the public at large and to the detriment of our heirs and 13 | successors. We intend this dedication to be an overt act of 14 | relinquishment in perpetuity of all present and future rights to this 15 | software under copyright law. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 18 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 19 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 20 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 21 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 22 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 23 | OTHER DEALINGS IN THE SOFTWARE. 24 | 25 | For more information, please refer to 26 | -------------------------------------------------------------------------------- /META: -------------------------------------------------------------------------------- 1 | version = "%{version}%" 2 | description = "[@@deriving netblob]" 3 | requires(-ppx_driver) = "ppx_deriving" 4 | ppxopt(-ppx_driver,-custom_ppx) = "ppx_deriving,./ppx_netblob.cma" 5 | requires(ppx_driver) = "ppx_deriving.api" 6 | archive(ppx_driver, byte) = "ppx_netblob.cma" 7 | archive(ppx_driver, native) = "ppx_netblob.cmxa" 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | META: pkg/META.in 2 | cp pkg/META.in pkg/META 3 | 4 | native-code: META 5 | ocaml pkg/build.ml native=true native-dynlink=true 6 | 7 | byte-code: META 8 | ocaml pkg/build.ml native=false 9 | 10 | build: native-code 11 | 12 | derive = $(shell ocamlfind query ppx_deriving.show) 13 | dry_run: build 14 | ocamlfind ppx_tools/rewriter "ocamlfind ppx_deriving/ppx_deriving ${derive}/ppx_deriving_show.cma /home/chrismamo1/.opam/4.04.0/lib/ppx_deriving_yojson/ppx_deriving_yojson.cma _build/ppx_netblob.cma" example/quine.ml 15 | 16 | test: build example/example.ml 17 | rm -rf _build/src_test/ 18 | ocamlbuild -pkgs lwt,cohttp.lwt,ppx_deriving,ppx_deriving_yojson,ppx_netblob -j 0 -use-ocamlfind -classic-display \ 19 | example/example.native 20 | 21 | clean: 22 | ocamlbuild -clean 23 | 24 | .PHONY: build test doc clean 25 | 26 | install: build 27 | ocamlfind install ppx_netblob pkg/META _build/src/* 28 | 29 | uninstall: 30 | ocamlfind remove ppx_netblob 31 | 32 | reinstall: uninstall install 33 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ppx_netblob 2 | ======== 3 | 4 | OCaml ppx to include a binary blob from a URL as a string. Writing `[%netblob 5 | "url"]` will replace the string with the result of sending an HTTP GET 6 | request to `url` at compile time. This allows the inclusion of arbitary, 7 | possibly compressed, data, without the need to respect OCaml's lexical 8 | conventions. It should be noted that `ppx_netblob` will interpret HTTP 301 9 | responses, following the URL given in the response's `Location` header, which 10 | is a possible security vulnerability (and emitting a warning). I would advise 11 | against using this in production code, since I haven't done a huge amount of 12 | research into how well `cohttp` supports HTTPS, so I'm not sure if this is 13 | subject to security downgrading attacks. 14 | 15 | To build 16 | -------- 17 | 18 | Requires OCaml 4.02 or above. 19 | 20 | Run `make` in the top directory. Then run `make` in the `examples` directory. 21 | Now run the `quine` executable. 22 | 23 | To install 24 | ---------- 25 | 26 | Run `make install` in the top directory once `make` has been run. 27 | 28 | To use 29 | ------ 30 | 31 | The basic (ill-advised) usage of `ppx_netblob` involves loading a network 32 | resource into a string at compile-time, e.g. 33 | 34 | let () = 35 | print_endline [%netblob "https://goo.gl/nTD9Oc"] 36 | 37 | is transformed into: 38 | 39 | let () = 40 | print_endline "Hello, World!" 41 | 42 | It should be noted that this sort of usage presents a smorgasbord of potential 43 | problems for both security and basic usability, although superficial precautions 44 | have been taken to minimize such problems. For instance, compiling the example 45 | above would produce the following warning: 46 | 47 | WARNING: received response code 301 MOVED PERMANENTLY to "https://gist.githubusercontent.com/chrismamo1/ca3210b8f503ecc3ec5b154ff39fb2b3/raw/0fb8245d996f93a0df1e20f94e7df6403c094f62/hello_world.txt" when requesting resource "https://goo.gl/nTD9Oc", this is probably a security vulnerability. 48 | 49 | The more useful feature of `ppx_netblob` involves building custom HTTP request 50 | functions at compile time, e.g. 51 | 52 | open Lwt 53 | 54 | let () = 55 | let get_message = [%netblob { runtime = "https://goo.gl/nTD9Oc" }] in 56 | Lwt_main.run ( 57 | get_message () 58 | >>= fun s -> 59 | Lwt_io.printl s) 60 | 61 | in this example, `[%netblob { runtime = "https://goo.gl/nTD9Oc" }]` is expanded 62 | into a decently performant function which handles a few problematic cases. This 63 | feature is very incomplete, however, and users of this tool (when and if they 64 | start to exist) should not expect it to retain a consistent interface over the 65 | next few months. 66 | 67 | TODO 68 | ---- 69 | 70 | - Allow constraints to be placed on which parameters will be accepted when 71 | using the runtime netblob ppx, e.g. `[%netblob { runtime = "https://github.com/search" ; parameters = ["utf8"; "q"]}` 72 | - Allow the user to place more security constraints when fetching a string at 73 | compile time 74 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | : package(ppx_tools), package(ppx_tools.metaquot), package(ppx_deriving.api), package(result), package(cohttp.lwt), package(lwt), package(ppx_deriving), package(ppx_deriving.api) 2 | -------------------------------------------------------------------------------- /example/Makefile: -------------------------------------------------------------------------------- 1 | SOURCES = quine.ml 2 | 3 | #Uncomment this, and remove -ppx ../ppx_netblob below to use the installed version 4 | #PACKS = ppx_netblob 5 | PACKS = cohttp.lwt ppx_deriving ppx_deriving_yojson ppx_netblob 6 | 7 | RESULT = quine 8 | 9 | OCAMLPPXFLAGS = -ppx ../ppx_netblob 10 | 11 | OCAMLNCFLAGS = -g -w -3 $(OCAMLPPXFLAG) -linkall 12 | OCAMLBCFLAGS = -g -w -3 $(OCAMLPPXFLAG) -linkall 13 | OCAMLLDFLAGS = -g 14 | 15 | all : native-code 16 | 17 | -include OCamlMakefile 18 | 19 | -------------------------------------------------------------------------------- /example/OCamlMakefile: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # OCamlMakefile 3 | # Copyright (C) 1999- Markus Mottl 4 | # 5 | # For updates see: 6 | # http://www.ocaml.info/home/ocaml_sources.html 7 | # 8 | ########################################################################### 9 | 10 | # Modified by damien for .glade.ml compilation 11 | 12 | # Set these variables to the names of the sources to be processed and 13 | # the result variable. Order matters during linkage! 14 | 15 | ifndef SOURCES 16 | SOURCES := foo.ml 17 | endif 18 | export SOURCES 19 | 20 | ifndef RES_CLIB_SUF 21 | RES_CLIB_SUF := _stubs 22 | endif 23 | export RES_CLIB_SUF 24 | 25 | ifndef RESULT 26 | RESULT := foo 27 | endif 28 | export RESULT := $(strip $(RESULT)) 29 | 30 | export LIB_PACK_NAME 31 | 32 | ifndef DOC_FILES 33 | DOC_FILES := $(filter %.mli, $(SOURCES)) 34 | endif 35 | export DOC_FILES 36 | FIRST_DOC_FILE := $(firstword $(DOC_FILES)) 37 | 38 | export BCSUFFIX 39 | export NCSUFFIX 40 | 41 | ifndef TOPSUFFIX 42 | TOPSUFFIX := .top 43 | endif 44 | export TOPSUFFIX 45 | 46 | # Eventually set include- and library-paths, libraries to link, 47 | # additional compilation-, link- and ocamlyacc-flags 48 | # Path- and library information needs not be written with "-I" and such... 49 | # Define THREADS if you need it, otherwise leave it unset (same for 50 | # USE_CAMLP4)! 51 | 52 | export THREADS 53 | export VMTHREADS 54 | export ANNOTATE 55 | export USE_CAMLP4 56 | 57 | export INCDIRS 58 | export LIBDIRS 59 | export EXTLIBDIRS 60 | export RESULTDEPS 61 | export OCAML_DEFAULT_DIRS 62 | 63 | export LIBS 64 | export CLIBS 65 | export CFRAMEWORKS 66 | 67 | export OCAMLFLAGS 68 | export OCAMLNCFLAGS 69 | export OCAMLBCFLAGS 70 | 71 | export OCAMLLDFLAGS 72 | export OCAMLNLDFLAGS 73 | export OCAMLBLDFLAGS 74 | 75 | export OCAMLMKLIB_FLAGS 76 | 77 | ifndef OCAMLCPFLAGS 78 | OCAMLCPFLAGS := a 79 | endif 80 | export OCAMLCPFLAGS 81 | 82 | ifndef DOC_DIR 83 | DOC_DIR := doc 84 | endif 85 | export DOC_DIR 86 | 87 | export PPFLAGS 88 | 89 | export LFLAGS 90 | export YFLAGS 91 | export IDLFLAGS 92 | 93 | export OCAMLDOCFLAGS 94 | 95 | export OCAMLFIND_INSTFLAGS 96 | 97 | export DVIPSFLAGS 98 | 99 | export STATIC 100 | 101 | # Add a list of optional trash files that should be deleted by "make clean" 102 | export TRASH 103 | 104 | ECHO := echo 105 | 106 | ifdef REALLY_QUIET 107 | export REALLY_QUIET 108 | ECHO := true 109 | LFLAGS := $(LFLAGS) -q 110 | YFLAGS := $(YFLAGS) -q 111 | endif 112 | 113 | #################### variables depending on your OCaml-installation 114 | 115 | SYSTEM := $(shell ocamlc -config 2>/dev/null | grep system | sed 's/system: //') 116 | # This may be 117 | # - mingw 118 | # - mingw64 119 | # - win32 120 | # - cygwin 121 | # - some other string means Unix 122 | # - empty means ocamlc does not support -config 123 | 124 | ifeq ($(SYSTEM),$(filter $(SYSTEM),mingw mingw64)) 125 | MINGW=1 126 | endif 127 | ifeq ($(SYSTEM),win32) 128 | MSVC=1 129 | endif 130 | 131 | ifdef MINGW 132 | export MINGW 133 | WIN32 := 1 134 | # The default value 'cc' makes 'ocamlc -cc "cc"' raises the error 'The 135 | # NTVDM CPU has encountered an illegal instruction'. 136 | ifndef CC 137 | MNO_CYGWIN := $(shell gcc -Wextra -v --help 2>/dev/null | grep -q '\-mno-cygwin'; echo $$?) 138 | CC := gcc 139 | else 140 | MNO_CYGWIN := $(shell $$CC -Wextra -v --help 2>/dev/null | grep -q '\-mno-cygwin'; echo $$?) 141 | endif 142 | # We are compiling with cygwin tools: 143 | ifeq ($(MNO_CYGWIN),0) 144 | CFLAGS_WIN32 := -mno-cygwin 145 | endif 146 | # The OCaml C header files use this flag: 147 | CFLAGS += -D__MINGW32__ 148 | endif 149 | ifdef MSVC 150 | export MSVC 151 | WIN32 := 1 152 | ifndef STATIC 153 | CPPFLAGS_WIN32 := -DCAML_DLL 154 | endif 155 | CFLAGS_WIN32 += -nologo 156 | EXT_OBJ := obj 157 | EXT_LIB := lib 158 | ifeq ($(CC),gcc) 159 | # work around GNU Make default value 160 | ifdef THREADS 161 | CC := cl -MT 162 | else 163 | CC := cl 164 | endif 165 | endif 166 | ifeq ($(CXX),g++) 167 | # work around GNU Make default value 168 | CXX := $(CC) 169 | endif 170 | CFLAG_O := -Fo 171 | endif 172 | ifdef WIN32 173 | EXT_CXX := cpp 174 | EXE := .exe 175 | endif 176 | 177 | ifndef EXT_OBJ 178 | EXT_OBJ := o 179 | endif 180 | ifndef EXT_LIB 181 | EXT_LIB := a 182 | endif 183 | ifndef EXT_CXX 184 | EXT_CXX := cc 185 | endif 186 | ifndef EXE 187 | EXE := # empty 188 | endif 189 | ifndef CFLAG_O 190 | CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! 191 | endif 192 | 193 | export CC 194 | export CXX 195 | export CFLAGS 196 | export CXXFLAGS 197 | export LDFLAGS 198 | export CPPFLAGS 199 | 200 | ifndef RPATH_FLAG 201 | ifdef ELF_RPATH_FLAG 202 | RPATH_FLAG := $(ELF_RPATH_FLAG) 203 | else 204 | RPATH_FLAG := -R 205 | endif 206 | endif 207 | export RPATH_FLAG 208 | 209 | ifndef MSVC 210 | ifndef PIC_CFLAGS 211 | PIC_CFLAGS := -fPIC 212 | endif 213 | ifndef PIC_CPPFLAGS 214 | PIC_CPPFLAGS := -DPIC 215 | endif 216 | endif 217 | 218 | export PIC_CFLAGS 219 | export PIC_CPPFLAGS 220 | 221 | BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) 222 | NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) 223 | TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) 224 | 225 | ifndef OCAMLFIND 226 | OCAMLFIND := ocamlfind 227 | endif 228 | export OCAMLFIND 229 | 230 | ifndef OCAML 231 | OCAML := ocaml 232 | endif 233 | export OCAML 234 | 235 | ifndef OCAMLC 236 | OCAMLC := ocamlc 237 | endif 238 | export OCAMLC 239 | 240 | ifndef OCAMLOPT 241 | OCAMLOPT := ocamlopt 242 | endif 243 | export OCAMLOPT 244 | 245 | ifndef OCAMLMKTOP 246 | OCAMLMKTOP := ocamlmktop 247 | endif 248 | export OCAMLMKTOP 249 | 250 | ifndef OCAMLCP 251 | OCAMLCP := ocamlcp 252 | endif 253 | export OCAMLCP 254 | 255 | ifndef OCAMLDEP 256 | OCAMLDEP := ocamldep 257 | endif 258 | export OCAMLDEP 259 | 260 | ifndef OCAMLLEX 261 | OCAMLLEX := ocamllex 262 | endif 263 | export OCAMLLEX 264 | 265 | ifndef OCAMLYACC 266 | OCAMLYACC := ocamlyacc 267 | endif 268 | export OCAMLYACC 269 | 270 | ifndef OCAMLMKLIB 271 | OCAMLMKLIB := ocamlmklib 272 | endif 273 | export OCAMLMKLIB 274 | 275 | ifndef OCAML_GLADECC 276 | OCAML_GLADECC := lablgladecc2 277 | endif 278 | export OCAML_GLADECC 279 | 280 | ifndef OCAML_GLADECC_FLAGS 281 | OCAML_GLADECC_FLAGS := 282 | endif 283 | export OCAML_GLADECC_FLAGS 284 | 285 | ifndef CAMELEON_REPORT 286 | CAMELEON_REPORT := report 287 | endif 288 | export CAMELEON_REPORT 289 | 290 | ifndef CAMELEON_REPORT_FLAGS 291 | CAMELEON_REPORT_FLAGS := 292 | endif 293 | export CAMELEON_REPORT_FLAGS 294 | 295 | ifndef CAMELEON_ZOGGY 296 | CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo 297 | endif 298 | export CAMELEON_ZOGGY 299 | 300 | ifndef CAMELEON_ZOGGY_FLAGS 301 | CAMELEON_ZOGGY_FLAGS := 302 | endif 303 | export CAMELEON_ZOGGY_FLAGS 304 | 305 | ifndef OXRIDL 306 | OXRIDL := oxridl 307 | endif 308 | export OXRIDL 309 | 310 | ifndef CAMLIDL 311 | CAMLIDL := camlidl 312 | endif 313 | export CAMLIDL 314 | 315 | ifndef CAMLIDLDLL 316 | CAMLIDLDLL := camlidldll 317 | endif 318 | export CAMLIDLDLL 319 | 320 | ifndef NOIDLHEADER 321 | MAYBE_IDL_HEADER := -header 322 | endif 323 | export NOIDLHEADER 324 | 325 | export NO_CUSTOM 326 | 327 | ifndef CAMLP4 328 | CAMLP4 := camlp4 329 | endif 330 | export CAMLP4 331 | 332 | ifndef REAL_OCAMLFIND 333 | ifdef PACKS 334 | ifndef CREATE_LIB 335 | ifdef THREADS 336 | PACKS += threads 337 | endif 338 | endif 339 | empty := 340 | space := $(empty) $(empty) 341 | comma := , 342 | ifdef PREDS 343 | PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) 344 | PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) 345 | OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) 346 | # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) 347 | OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) 348 | OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) 349 | else 350 | OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) 351 | OCAML_DEP_PACKAGES := 352 | endif 353 | OCAML_FIND_LINKPKG := -linkpkg 354 | REAL_OCAMLFIND := $(OCAMLFIND) 355 | endif 356 | endif 357 | 358 | export OCAML_FIND_PACKAGES 359 | export OCAML_DEP_PACKAGES 360 | export OCAML_FIND_LINKPKG 361 | export REAL_OCAMLFIND 362 | 363 | ifndef OCAMLDOC 364 | OCAMLDOC := ocamldoc 365 | endif 366 | export OCAMLDOC 367 | 368 | ifndef LATEX 369 | LATEX := latex 370 | endif 371 | export LATEX 372 | 373 | ifndef DVIPS 374 | DVIPS := dvips 375 | endif 376 | export DVIPS 377 | 378 | ifndef PS2PDF 379 | PS2PDF := ps2pdf 380 | endif 381 | export PS2PDF 382 | 383 | ifndef OCAMLMAKEFILE 384 | OCAMLMAKEFILE := OCamlMakefile 385 | endif 386 | export OCAMLMAKEFILE 387 | 388 | ifndef OCAMLLIBPATH 389 | OCAMLLIBPATH := \ 390 | $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) 391 | endif 392 | export OCAMLLIBPATH 393 | 394 | ifndef OCAML_LIB_INSTALL 395 | OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib 396 | endif 397 | export OCAML_LIB_INSTALL 398 | 399 | ########################################################################### 400 | 401 | #################### change following sections only if 402 | #################### you know what you are doing! 403 | 404 | # delete target files when a build command fails 405 | .PHONY: .DELETE_ON_ERROR 406 | .DELETE_ON_ERROR: 407 | 408 | # for pedants using "--warn-undefined-variables" 409 | export MAYBE_IDL 410 | export REAL_RESULT 411 | export CAMLIDLFLAGS 412 | export THREAD_FLAG 413 | export RES_CLIB 414 | export MAKEDLL 415 | export ANNOT_FLAG 416 | export C_OXRIDL 417 | export SUBPROJS 418 | export CFLAGS_WIN32 419 | export CPPFLAGS_WIN32 420 | 421 | INCFLAGS := 422 | 423 | SHELL := /bin/sh 424 | 425 | MLDEPDIR := ._d 426 | BCDIDIR := ._bcdi 427 | NCDIDIR := ._ncdi 428 | 429 | FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.m %.$(EXT_CXX) %.rep %.zog %.glade 430 | 431 | FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) 432 | SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) 433 | 434 | FILTERED_REP := $(filter %.rep, $(FILTERED)) 435 | DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) 436 | AUTO_REP := $(FILTERED_REP:.rep=.ml) 437 | 438 | FILTERED_ZOG := $(filter %.zog, $(FILTERED)) 439 | DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) 440 | AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) 441 | 442 | FILTERED_GLADE := $(filter %.glade, $(FILTERED)) 443 | DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) 444 | AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) 445 | 446 | FILTERED_ML := $(filter %.ml, $(FILTERED)) 447 | DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) 448 | 449 | FILTERED_MLI := $(filter %.mli, $(FILTERED)) 450 | DEP_MLI := $(FILTERED_MLI:.mli=.di) 451 | 452 | FILTERED_MLL := $(filter %.mll, $(FILTERED)) 453 | DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) 454 | AUTO_MLL := $(FILTERED_MLL:.mll=.ml) 455 | 456 | FILTERED_MLY := $(filter %.mly, $(FILTERED)) 457 | DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) 458 | AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) 459 | 460 | FILTERED_IDL := $(filter %.idl, $(FILTERED)) 461 | DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) 462 | C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) 463 | ifndef NOIDLHEADER 464 | C_IDL += $(FILTERED_IDL:.idl=.h) 465 | endif 466 | OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) 467 | AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) 468 | 469 | FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) 470 | DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) 471 | AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) 472 | 473 | FILTERED_C_CXX := $(filter %.c %.m %.$(EXT_CXX), $(FILTERED)) 474 | OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) 475 | OBJ_C_CXX := $(OBJ_C_CXX:.m=.$(EXT_OBJ)) 476 | OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) 477 | 478 | PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) 479 | 480 | ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) 481 | 482 | MLDEPS := $(filter %.d, $(ALL_DEPS)) 483 | MLIDEPS := $(filter %.di, $(ALL_DEPS)) 484 | BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) 485 | NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) 486 | 487 | ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) 488 | 489 | IMPLO_INTF := $(ALLML:%.mli=%.mli.__) 490 | IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ 491 | $(basename $(file)).cmi $(basename $(file)).cmo) 492 | IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) 493 | IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) 494 | 495 | IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) 496 | 497 | INTF := $(filter %.cmi, $(IMPLO_INTF)) 498 | IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) 499 | IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) 500 | IMPL_ASM := $(IMPL_CMO:.cmo=.asm) 501 | IMPL_S := $(IMPL_CMO:.cmo=.s) 502 | 503 | OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) 504 | OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) 505 | 506 | EXECS := $(addsuffix $(EXE), \ 507 | $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) 508 | ifdef WIN32 509 | EXECS += $(BCRESULT).dll $(NCRESULT).dll 510 | endif 511 | 512 | CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) 513 | ifneq ($(strip $(OBJ_LINK)),) 514 | RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) 515 | endif 516 | 517 | ifdef WIN32 518 | DLLSONAME := dll$(CLIB_BASE).dll 519 | else 520 | DLLSONAME := dll$(CLIB_BASE).so 521 | endif 522 | 523 | NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ 524 | $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ 525 | $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ 526 | $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ 527 | $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ 528 | $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx \ 529 | $(LIB_PACK_NAME).$(EXT_OBJ) 530 | 531 | ifndef STATIC 532 | NONEXECS += $(DLLSONAME) 533 | endif 534 | 535 | ifndef LIBINSTALL_FILES 536 | LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ 537 | $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) 538 | ifndef STATIC 539 | ifneq ($(strip $(OBJ_LINK)),) 540 | LIBINSTALL_FILES += $(DLLSONAME) 541 | endif 542 | endif 543 | endif 544 | 545 | export LIBINSTALL_FILES 546 | 547 | ifdef WIN32 548 | # some extra stuff is created while linking DLLs 549 | NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib 550 | endif 551 | 552 | TARGETS := $(EXECS) $(NONEXECS) 553 | 554 | # If there are IDL-files 555 | ifneq ($(strip $(FILTERED_IDL)),) 556 | MAYBE_IDL := -cclib -lcamlidl 557 | endif 558 | 559 | ifdef USE_CAMLP4 560 | CAMLP4PATH := \ 561 | $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) 562 | INCFLAGS := -I $(CAMLP4PATH) 563 | CINCFLAGS := -I$(CAMLP4PATH) 564 | endif 565 | 566 | INCFLAGS := $(INCFLAGS) $(INCDIRS:%=-I %) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) 567 | CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) 568 | 569 | ifndef MSVC 570 | CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ 571 | $(EXTLIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%) 572 | 573 | ifeq ($(ELF_RPATH), yes) 574 | CLIBFLAGS += $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) 575 | endif 576 | endif 577 | 578 | ifndef PROFILING 579 | INTF_OCAMLC := $(OCAMLC) 580 | else 581 | ifndef THREADS 582 | INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) 583 | else 584 | # OCaml does not support profiling byte code 585 | # with threads (yet), therefore we force an error. 586 | ifndef REAL_OCAMLC 587 | $(error Profiling of multithreaded byte code not yet supported by OCaml) 588 | endif 589 | INTF_OCAMLC := $(OCAMLC) 590 | endif 591 | endif 592 | 593 | ifndef MSVC 594 | COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ 595 | $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ 596 | $(EXTLIBDIRS:%=-ccopt -Wl $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)) 597 | 598 | ifeq ($(ELF_RPATH),yes) 599 | COMMON_LDFLAGS += $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) 600 | endif 601 | else 602 | COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ 603 | $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ 604 | $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " 605 | endif 606 | 607 | CLIBS_OPTS := $(CLIBS:%=-cclib -l%) $(CFRAMEWORKS:%=-cclib '-framework %') 608 | ifdef MSVC 609 | ifndef STATIC 610 | # MSVC libraries do not have 'lib' prefix 611 | CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) 612 | endif 613 | endif 614 | 615 | ifneq ($(strip $(OBJ_LINK)),) 616 | ifdef CREATE_LIB 617 | OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) 618 | else 619 | OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) 620 | endif 621 | else 622 | OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) 623 | endif 624 | 625 | ifdef LIB_PACK_NAME 626 | FOR_PACK_NAME := $(shell echo $(LIB_PACK_NAME) | awk '{print toupper(substr($$0,1,1))substr($$0,2)}') 627 | endif 628 | 629 | # If we have to make byte-code 630 | ifndef REAL_OCAMLC 631 | BYTE_OCAML := y 632 | 633 | # EXTRADEPS is added dependencies we have to insert for all 634 | # executable files we generate. Ideally it should be all of the 635 | # libraries we use, but it's hard to find the ones that get searched on 636 | # the path since I don't know the paths built into the compiler, so 637 | # just include the ones with slashes in their names. 638 | EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) 639 | 640 | 641 | ifndef LIB_PACK_NAME 642 | SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) 643 | else 644 | SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLBCFLAGS) 645 | endif 646 | 647 | REAL_OCAMLC := $(INTF_OCAMLC) 648 | 649 | REAL_IMPL := $(IMPL_CMO) 650 | REAL_IMPL_INTF := $(IMPLO_INTF) 651 | IMPL_SUF := .cmo 652 | 653 | DEPFLAGS := 654 | MAKE_DEPS := $(MLDEPS) $(BCDEPIS) 655 | 656 | ifdef CREATE_LIB 657 | override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) 658 | override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) 659 | ifndef STATIC 660 | ifneq ($(strip $(OBJ_LINK)),) 661 | MAKEDLL := $(DLLSONAME) 662 | ALL_LDFLAGS := -dllib $(DLLSONAME) 663 | endif 664 | endif 665 | endif 666 | 667 | ifndef NO_CUSTOM 668 | ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS) $(CFRAMEWORKS))" "" 669 | ALL_LDFLAGS += -custom 670 | endif 671 | endif 672 | 673 | ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ 674 | $(COMMON_LDFLAGS) $(LIBS:%=%.cma) 675 | CAMLIDLDLLFLAGS := 676 | 677 | ifdef THREADS 678 | ifdef VMTHREADS 679 | THREAD_FLAG := -vmthread 680 | else 681 | THREAD_FLAG := -thread 682 | endif 683 | ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) 684 | ifndef CREATE_LIB 685 | ifndef REAL_OCAMLFIND 686 | ALL_LDFLAGS := $(ALL_LDFLAGS) 687 | endif 688 | endif 689 | endif 690 | 691 | # we have to make native-code 692 | else 693 | EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) 694 | ifndef PROFILING 695 | SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) 696 | PLDFLAGS := 697 | else 698 | SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) 699 | PLDFLAGS := -p 700 | endif 701 | 702 | ifndef LIB_PACK_NAME 703 | SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) 704 | else 705 | SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLNCFLAGS) 706 | endif 707 | REAL_IMPL := $(IMPL_CMX) 708 | REAL_IMPL_INTF := $(IMPLX_INTF) 709 | IMPL_SUF := .cmx 710 | 711 | override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) 712 | 713 | DEPFLAGS := -native 714 | MAKE_DEPS := $(MLDEPS) $(NCDEPIS) 715 | 716 | ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ 717 | $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) 718 | CAMLIDLDLLFLAGS := -opt 719 | 720 | ifndef CREATE_LIB 721 | ALL_LDFLAGS += $(LIBS:%=%.cmxa) 722 | else 723 | override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) 724 | override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) 725 | endif 726 | 727 | ifdef THREADS 728 | THREAD_FLAG := -thread 729 | ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) 730 | ifndef CREATE_LIB 731 | ifndef REAL_OCAMLFIND 732 | ALL_LDFLAGS := $(ALL_LDFLAGS) 733 | endif 734 | endif 735 | endif 736 | endif 737 | 738 | export MAKE_DEPS 739 | 740 | ifdef ANNOTATE 741 | ANNOT_FLAG := -annot 742 | else 743 | endif 744 | 745 | ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ 746 | $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) 747 | 748 | ifdef make_deps 749 | -include $(MAKE_DEPS) 750 | PRE_TARGETS := 751 | endif 752 | 753 | ########################################################################### 754 | # USER RULES 755 | 756 | # Call "OCamlMakefile QUIET=" to get rid of all of the @'s. 757 | QUIET=@ 758 | 759 | # generates byte-code (default) 760 | byte-code: $(PRE_TARGETS) 761 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 762 | REAL_RESULT="$(BCRESULT)" make_deps=yes 763 | bc: byte-code 764 | 765 | byte-code-nolink: $(PRE_TARGETS) 766 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 767 | REAL_RESULT="$(BCRESULT)" make_deps=yes 768 | bcnl: byte-code-nolink 769 | 770 | top: $(PRE_TARGETS) 771 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ 772 | REAL_RESULT="$(BCRESULT)" make_deps=yes 773 | 774 | # generates native-code 775 | 776 | native-code: $(PRE_TARGETS) 777 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 778 | REAL_RESULT="$(NCRESULT)" \ 779 | REAL_OCAMLC="$(OCAMLOPT)" \ 780 | make_deps=yes 781 | nc: native-code 782 | 783 | native-code-nolink: $(PRE_TARGETS) 784 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 785 | REAL_RESULT="$(NCRESULT)" \ 786 | REAL_OCAMLC="$(OCAMLOPT)" \ 787 | make_deps=yes 788 | ncnl: native-code-nolink 789 | 790 | # generates byte-code libraries 791 | byte-code-library: $(PRE_TARGETS) 792 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 793 | $(RES_CLIB) $(BCRESULT).cma \ 794 | REAL_RESULT="$(BCRESULT)" \ 795 | CREATE_LIB=yes \ 796 | make_deps=yes 797 | bcl: byte-code-library 798 | 799 | # generates native-code libraries 800 | native-code-library: $(PRE_TARGETS) 801 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 802 | $(RES_CLIB) $(NCRESULT).cmxa \ 803 | REAL_RESULT="$(NCRESULT)" \ 804 | REAL_OCAMLC="$(OCAMLOPT)" \ 805 | CREATE_LIB=yes \ 806 | make_deps=yes 807 | ncl: native-code-library 808 | 809 | ifdef WIN32 810 | # generates byte-code dll 811 | byte-code-dll: $(PRE_TARGETS) 812 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 813 | $(RES_CLIB) $(BCRESULT).dll \ 814 | REAL_RESULT="$(BCRESULT)" \ 815 | make_deps=yes 816 | bcd: byte-code-dll 817 | 818 | # generates native-code dll 819 | native-code-dll: $(PRE_TARGETS) 820 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 821 | $(RES_CLIB) $(NCRESULT).dll \ 822 | REAL_RESULT="$(NCRESULT)" \ 823 | REAL_OCAMLC="$(OCAMLOPT)" \ 824 | make_deps=yes 825 | ncd: native-code-dll 826 | endif 827 | 828 | # generates byte-code with debugging information 829 | debug-code: $(PRE_TARGETS) 830 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 831 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 832 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 833 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 834 | dc: debug-code 835 | 836 | debug-code-nolink: $(PRE_TARGETS) 837 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 838 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 839 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 840 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 841 | dcnl: debug-code-nolink 842 | 843 | # generates byte-code with debugging information (native code) 844 | debug-native-code: $(PRE_TARGETS) 845 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 846 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 847 | REAL_OCAMLC="$(OCAMLOPT)" \ 848 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 849 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 850 | dnc: debug-native-code 851 | 852 | debug-native-code-nolink: $(PRE_TARGETS) 853 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 854 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 855 | REAL_OCAMLC="$(OCAMLOPT)" \ 856 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 857 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 858 | dncnl: debug-native-code-nolink 859 | 860 | # generates byte-code libraries with debugging information 861 | debug-code-library: $(PRE_TARGETS) 862 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 863 | $(RES_CLIB) $(BCRESULT).cma \ 864 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 865 | CREATE_LIB=yes \ 866 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 867 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 868 | dcl: debug-code-library 869 | 870 | # generates byte-code libraries with debugging information (native code) 871 | debug-native-code-library: $(PRE_TARGETS) 872 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 873 | $(RES_CLIB) $(NCRESULT).cmxa \ 874 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 875 | REAL_OCAMLC="$(OCAMLOPT)" \ 876 | CREATE_LIB=yes \ 877 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 878 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 879 | dncl: debug-native-code-library 880 | 881 | # generates byte-code for profiling 882 | profiling-byte-code: $(PRE_TARGETS) 883 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 884 | REAL_RESULT="$(BCRESULT)" PROFILING="y" \ 885 | make_deps=yes 886 | pbc: profiling-byte-code 887 | 888 | # generates native-code 889 | 890 | profiling-native-code: $(PRE_TARGETS) 891 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 892 | REAL_RESULT="$(NCRESULT)" \ 893 | REAL_OCAMLC="$(OCAMLOPT)" \ 894 | PROFILING="y" \ 895 | make_deps=yes 896 | pnc: profiling-native-code 897 | 898 | # generates byte-code libraries 899 | profiling-byte-code-library: $(PRE_TARGETS) 900 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 901 | $(RES_CLIB) $(BCRESULT).cma \ 902 | REAL_RESULT="$(BCRESULT)" PROFILING="y" \ 903 | CREATE_LIB=yes \ 904 | make_deps=yes 905 | pbcl: profiling-byte-code-library 906 | 907 | # generates native-code libraries 908 | profiling-native-code-library: $(PRE_TARGETS) 909 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 910 | $(RES_CLIB) $(NCRESULT).cmxa \ 911 | REAL_RESULT="$(NCRESULT)" PROFILING="y" \ 912 | REAL_OCAMLC="$(OCAMLOPT)" \ 913 | CREATE_LIB=yes \ 914 | make_deps=yes 915 | pncl: profiling-native-code-library 916 | 917 | # packs byte-code objects 918 | pack-byte-code: $(PRE_TARGETS) 919 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ 920 | REAL_RESULT="$(BCRESULT)" \ 921 | PACK_LIB=yes make_deps=yes 922 | pabc: pack-byte-code 923 | 924 | # packs native-code objects 925 | pack-native-code: $(PRE_TARGETS) 926 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 927 | $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ 928 | REAL_RESULT="$(NCRESULT)" \ 929 | REAL_OCAMLC="$(OCAMLOPT)" \ 930 | PACK_LIB=yes make_deps=yes 931 | panc: pack-native-code 932 | 933 | # generates HTML-documentation 934 | htdoc: $(DOC_DIR)/$(RESULT)/html/index.html 935 | 936 | # generates Latex-documentation 937 | ladoc: $(DOC_DIR)/$(RESULT)/latex/doc.tex 938 | 939 | # generates PostScript-documentation 940 | psdoc: $(DOC_DIR)/$(RESULT)/latex/doc.ps 941 | 942 | # generates PDF-documentation 943 | pdfdoc: $(DOC_DIR)/$(RESULT)/latex/doc.pdf 944 | 945 | # generates all supported forms of documentation 946 | doc: htdoc ladoc psdoc pdfdoc 947 | 948 | ########################################################################### 949 | # LOW LEVEL RULES 950 | 951 | $(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) 952 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ 953 | $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ 954 | $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@$(EXE) \ 955 | $(REAL_IMPL) 956 | 957 | nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) 958 | 959 | ifdef WIN32 960 | $(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) 961 | $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ 962 | -o $@ $(REAL_IMPL) 963 | endif 964 | 965 | %$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) 966 | $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ 967 | $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ 968 | $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@$(EXE) \ 969 | $(REAL_IMPL) 970 | 971 | .SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ 972 | .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .m .$(EXT_CXX) .h .so \ 973 | .rep .zog .glade 974 | 975 | ifndef STATIC 976 | ifdef MINGW 977 | # From OCaml 3.11.0, ocamlmklib is available on windows 978 | OCAMLMLIB_EXISTS = $(shell which $(OCAMLMKLIB)) 979 | ifeq ($(strip $(OCAMLMLIB_EXISTS)),) 980 | $(DLLSONAME): $(OBJ_LINK) 981 | $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ 982 | $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ 983 | '$(OCAMLLIBPATH)/ocamlrun.a' \ 984 | -Wl,--whole-archive \ 985 | -Wl,--export-all-symbols \ 986 | -Wl,--allow-multiple-definition \ 987 | -Wl,--enable-auto-import 988 | else 989 | $(DLLSONAME): $(OBJ_LINK) 990 | $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ 991 | -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ 992 | $(CFRAMEWORKS:%=-framework %) \ 993 | $(OCAMLMKLIB_FLAGS) 994 | endif 995 | else 996 | ifdef MSVC 997 | $(DLLSONAME): $(OBJ_LINK) 998 | link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ 999 | $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ 1000 | '$(OCAMLLIBPATH)/ocamlrun.lib' 1001 | 1002 | else 1003 | $(DLLSONAME): $(OBJ_LINK) 1004 | $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ 1005 | -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) $(CFRAMEWORKS:%=-framework %) \ 1006 | $(OCAMLMKLIB_FLAGS) 1007 | endif 1008 | endif 1009 | endif 1010 | 1011 | ifndef LIB_PACK_NAME 1012 | $(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) 1013 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(REAL_IMPL) 1014 | 1015 | $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) 1016 | $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(REAL_IMPL) 1017 | else 1018 | # Packing a bytecode library 1019 | LIB_PACK_NAME_MLI = $(wildcard $(LIB_PACK_NAME).mli) 1020 | ifeq ($(LIB_PACK_NAME_MLI),) 1021 | LIB_PACK_NAME_CMI = $(LIB_PACK_NAME).cmi 1022 | else 1023 | # $(LIB_PACK_NAME).mli exists, it likely depends on other compiled interfaces 1024 | LIB_PACK_NAME_CMI = 1025 | $(LIB_PACK_NAME).cmi: $(REAL_IMPL_INTF) 1026 | endif 1027 | ifdef BYTE_OCAML 1028 | $(LIB_PACK_NAME_CMI) $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) 1029 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL) 1030 | # Packing into a unit which can be transformed into a library 1031 | # Remember the .ml's must have been compiled with -for-pack $(LIB_PACK_NAME) 1032 | else 1033 | $(LIB_PACK_NAME_CMI) $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) 1034 | $(REAL_OCAMLFIND) $(OCAMLOPT) -pack -o $(LIB_PACK_NAME).cmx $(OCAMLLDFLAGS) $(REAL_IMPL) 1035 | endif 1036 | 1037 | $(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) 1038 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(LIB_PACK_NAME).cmo 1039 | 1040 | $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) 1041 | $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(OBJS_LIBS) $(filter-out -custom, $(ALL_LDFLAGS)) -o $@ $(LIB_PACK_NAME).cmx 1042 | endif 1043 | 1044 | $(RES_CLIB): $(OBJ_LINK) 1045 | ifndef MSVC 1046 | ifneq ($(strip $(OBJ_LINK)),) 1047 | $(AR) rcs $@ $(OBJ_LINK) 1048 | endif 1049 | else 1050 | ifneq ($(strip $(OBJ_LINK)),) 1051 | lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) 1052 | endif 1053 | endif 1054 | 1055 | %.cmi: %.mli $(EXTRADEPS) 1056 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1057 | if [ -z "$$pp" ]; then \ 1058 | $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1059 | -c $(THREAD_FLAG) $(ANNOT_FLAG) \ 1060 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1061 | $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1062 | -c $(THREAD_FLAG) $(ANNOT_FLAG) \ 1063 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1064 | else \ 1065 | $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1066 | -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ 1067 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1068 | $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1069 | -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ 1070 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1071 | fi 1072 | 1073 | %.cmi: %$(IMPL_SUF); 1074 | 1075 | %$(IMPL_SUF) %.$(EXT_OBJ): %.ml $(EXTRADEPS) 1076 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1077 | if [ -z "$$pp" ]; then \ 1078 | $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1079 | -c $(ALL_OCAMLCFLAGS) $<; \ 1080 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1081 | -c $(ALL_OCAMLCFLAGS) $<; \ 1082 | else \ 1083 | $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1084 | -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ 1085 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1086 | -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ 1087 | fi 1088 | 1089 | .PRECIOUS: %.ml 1090 | %.ml: %.mll 1091 | $(OCAMLLEX) $(LFLAGS) $< 1092 | 1093 | .PRECIOUS: %.ml %.mli 1094 | %.ml %.mli: %.mly 1095 | $(OCAMLYACC) $(YFLAGS) $< 1096 | $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ 1097 | if [ ! -z "$$pp" ]; then \ 1098 | mv $*.ml $*.ml.temporary; \ 1099 | echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ 1100 | cat $*.ml.temporary >> $*.ml; \ 1101 | rm $*.ml.temporary; \ 1102 | mv $*.mli $*.mli.temporary; \ 1103 | echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ 1104 | cat $*.mli.temporary >> $*.mli; \ 1105 | rm $*.mli.temporary; \ 1106 | fi 1107 | 1108 | 1109 | .PRECIOUS: %.ml 1110 | %.ml: %.rep 1111 | $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< 1112 | 1113 | .PRECIOUS: %.ml 1114 | %.ml: %.zog 1115 | $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ 1116 | 1117 | .PRECIOUS: %.ml 1118 | %.ml: %.glade 1119 | $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ 1120 | 1121 | .PRECIOUS: %.ml %.mli 1122 | %.ml %.mli: %.oxridl 1123 | $(OXRIDL) $< 1124 | 1125 | .PRECIOUS: %.ml %.mli %_stubs.c %.h 1126 | %.ml %.mli %_stubs.c %.h: %.idl 1127 | $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ 1128 | $(CAMLIDLFLAGS) $< 1129 | $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi 1130 | 1131 | %.$(EXT_OBJ): %.c 1132 | $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ 1133 | $(CPPFLAGS) $(CPPFLAGS_WIN32) \ 1134 | $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< 1135 | 1136 | %.$(EXT_OBJ): %.m 1137 | $(CC) -c $(CFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ 1138 | -I'$(OCAMLLIBPATH)' \ 1139 | $< $(CFLAG_O)$@ 1140 | 1141 | %.$(EXT_OBJ): %.$(EXT_CXX) 1142 | $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ 1143 | -I'$(OCAMLLIBPATH)' \ 1144 | $< $(CFLAG_O)$@ 1145 | 1146 | $(MLDEPDIR)/%.d: %.ml 1147 | $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi 1148 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1149 | if [ -z "$$pp" ]; then \ 1150 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1151 | $(INCFLAGS) $< \> $@; \ 1152 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1153 | $(INCFLAGS) $< > $@; \ 1154 | else \ 1155 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1156 | -pp \"$$pp $(PPFLAGS)\" $(INCFLAGS) $< \> $@; \ 1157 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1158 | -pp "$$pp $(PPFLAGS)" $(INCFLAGS) $< > $@; \ 1159 | fi 1160 | 1161 | $(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli 1162 | $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi 1163 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1164 | if [ -z "$$pp" ]; then \ 1165 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< \> $@; \ 1166 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ 1167 | else \ 1168 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ 1169 | -pp \"$$pp $(PPFLAGS)\" $(INCFLAGS) $< \> $@; \ 1170 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ 1171 | -pp "$$pp $(PPFLAGS)" $(INCFLAGS) $< > $@; \ 1172 | fi 1173 | 1174 | $(DOC_DIR)/$(RESULT)/html: 1175 | mkdir -p $@ 1176 | 1177 | $(DOC_DIR)/$(RESULT)/html/index.html: $(DOC_DIR)/$(RESULT)/html $(DOC_FILES) 1178 | rm -rf $ appid:string -> (weather Result.result) Lwt.t *) 72 | 73 | let () = 74 | let city = Sys.argv.(1) in 75 | Lwt_main.run ( 76 | netblob_get_weather_req ~q:city ~appid:"f2fe6367e16e3e7ddd4b00cca425a084" 77 | >>= function 78 | | Result.Ok weather -> 79 | Lwt_io.printf 80 | "Current temperature in %s (%f, %f): %f" 81 | city 82 | weather.coord.lat weather.coord.lon 83 | weather.main.temp 84 | | Result.Error msg -> 85 | raise (Failure ("Problem parsing json: " ^ msg))) 86 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | 3 | let () = dispatch (fun phase -> 4 | match phase with 5 | | After_rules -> 6 | let ppx_deriving_component deriver = 7 | (Findlib.query "ppx_deriving").Findlib.location ^ "/" ^ deriver 8 | in 9 | flag ["ocaml"; "compile"; "use_yojson"] & 10 | S[A"-ppx"; A"ocamlfind ppx_import/ppx_import"; 11 | A"-ppx"; A("ocamlfind ppx_deriving/ppx_deriving "^ 12 | "ppx_netblob.cma "^ 13 | (ppx_deriving_component "ppx_deriving_show.cma")); 14 | A"-I"; A(ppx_deriving_component "")]; 15 | flag ["ocaml"; "link"; "use_yojson"; "byte"] & 16 | A(ppx_deriving_component "ppx_deriving_runtime.cma"); 17 | flag ["ocaml"; "link"; "use_yojson"; "native"] & 18 | A(ppx_deriving_component "ppx_deriving_runtime.cmxa"); 19 | 20 | | _ -> ()) 21 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "ppx_netblob" 3 | version: "1.2.1" 4 | authors: [ "John Whitington" "John Christopher McAlpine" ] 5 | maintainer: "christophermcalpine@gmail.com" 6 | homepage: "https://github.com/chrismamo1/ppx_netblob" 7 | dev-repo: "https://github.com/chrismamo1/ppx_netblob.git" 8 | bug-reports: "https://github.com/chrismamo1/ppx_netblob/issues/" 9 | build: [ 10 | [make "native-code"] {ocaml-native} 11 | [make "byte-code"] {!ocaml-native} 12 | ] 13 | install: [ 14 | [make "install"] 15 | ] 16 | remove: [["ocamlfind" "remove" "ppx_netblob"]] 17 | depends: [ 18 | "ocamlfind" {build & >= "1.5.2"} 19 | "ppx_tools" {build} 20 | "cohttp" {build} 21 | "lwt" {build} 22 | "ppx_deriving" {build} 23 | "ppx_deriving_yojson" {build} 24 | "extlib" {build} 25 | ] 26 | available: [ocaml-version > "4.03.0"] 27 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | version = "%{version}%" 2 | description = "[@@deriving netblob]" 3 | requires(-ppx_driver) = "ppx_deriving" 4 | ppxopt(-ppx_driver,-custom_ppx) = "ppx_deriving,./ppx_netblob.cma" 5 | requires(ppx_driver) = "ppx_deriving.api,cohttp.lwt,cohttp,lwt" 6 | archive(ppx_driver, byte) = "ppx_netblob.cma" 7 | archive(ppx_driver, native) = "ppx_netblob.cmxa" 8 | exists_if = "ppx_netblob.cma" 9 | -------------------------------------------------------------------------------- /pkg/META.in: -------------------------------------------------------------------------------- 1 | version = "%{version}%" 2 | description = "[@@deriving netblob]" 3 | requires(-ppx_driver) = "ppx_deriving" 4 | ppxopt(-ppx_driver,-custom_ppx) = "ppx_deriving,./ppx_netblob.cma" 5 | requires(ppx_driver) = "ppx_deriving.api,cohttp.lwt,cohttp,lwt" 6 | archive(ppx_driver, byte) = "ppx_netblob.cma" 7 | archive(ppx_driver, native) = "ppx_netblob.cmxa" 8 | exists_if = "ppx_netblob.cma" 9 | -------------------------------------------------------------------------------- /pkg/build.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #directory "pkg" 3 | #use "topkg.ml" 4 | 5 | let ocamlbuild = 6 | "ocamlbuild -use-ocamlfind -classic-display" 7 | 8 | let () = 9 | Pkg.describe "ppx_netblob" ~builder:(`Other (ocamlbuild, "_build")) [ 10 | Pkg.lib "pkg/META"; 11 | Pkg.lib ~exts:Exts.library "src/ppx_netblob"; 12 | Pkg.doc "README.md"; ] 13 | -------------------------------------------------------------------------------- /pkg/topkg.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2014 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the BSD3 license, see license at the end of the file. 4 | %%NAME%% release %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (* Public api *) 8 | 9 | (** Build environment access *) 10 | module type Env = sig 11 | val bool : string -> bool 12 | (** [bool key] declares [key] as being a boolean key in the environment. 13 | Specifing key=(true|false) on the command line becomes mandatory. *) 14 | 15 | val native : bool 16 | (** [native] is [bool "native"]. *) 17 | 18 | val native_dynlink : bool 19 | (** [native_dylink] is [bool "native-dynlink"] *) 20 | end 21 | 22 | (** Exts defines sets of file extensions. *) 23 | module type Exts = sig 24 | val interface : string list 25 | (** [interface] is [[".mli"; ".cmi"; ".cmti"]] *) 26 | 27 | val interface_opt : string list 28 | (** [interface_opt] is [".cmx" :: interface] *) 29 | 30 | val c_library : string list 31 | (** [c_library] is the extension for C libraries, [".a"] for unices 32 | and [".lib"] for win32 *) 33 | 34 | val c_dll_library : string list 35 | (** [c_dll_library] is the extension for C dynamic libraries [".so"] 36 | for unices and [".dll"] for win32 *) 37 | 38 | val library : string list 39 | (** [library] is [[".cma"; ".cmxa"; ".cmxs"] @ c_library] *) 40 | 41 | val module_library : string list 42 | (** [module_library] is [(interface_opt @ library)]. *) 43 | end 44 | 45 | (** Package description. *) 46 | module type Pkg = sig 47 | type builder = [ `OCamlbuild | `Other of string * string ] 48 | (** The type for build tools. Either [`OCamlbuild] or an 49 | [`Other (tool, bdir)] tool [tool] that generates its build artefacts 50 | in [bdir]. *) 51 | 52 | type moves 53 | (** The type for install moves. *) 54 | 55 | type field = ?cond:bool -> ?exts:string list -> ?dst:string -> string -> moves 56 | (** The type for field install functions. A call 57 | [field cond exts dst path] generates install moves as follows: 58 | {ul 59 | {- If [cond] is [false] (defaults to [true]), no move is generated.} 60 | {- If [exts] is present, generates a move for each path in 61 | the list [List.map (fun e -> path ^ e) exts].} 62 | {- If [dst] is present this path is used as the move destination 63 | (allows to install in subdirectories). If absent [dst] is 64 | [Filename.basename path].} *) 65 | 66 | val lib : field 67 | val bin : ?auto:bool -> field 68 | (** If [auto] is true (defaults to false) generates 69 | [path ^ ".native"] if {!Env.native} is [true] and 70 | [path ^ ".byte"] if {!Env.native} is [false]. *) 71 | val sbin : ?auto:bool -> field (** See {!bin}. *) 72 | val libexec : ?auto:bool -> field (** See {!bin}. *) 73 | val toplevel : field 74 | val share : field 75 | val share_root : field 76 | val etc : field 77 | val doc : field 78 | val misc : field 79 | val stublibs : field 80 | val man : field 81 | val describe : string -> builder:builder -> moves list -> unit 82 | (** [describe name builder moves] describes a package named [name] with 83 | builder [builder] and install moves [moves]. *) 84 | end 85 | 86 | (* Implementation *) 87 | 88 | module Topkg : sig 89 | val cmd : [`Build | `Explain | `Help ] 90 | val env : (string * bool) list 91 | val err_parse : string -> 'a 92 | val err_mdef : string -> 'a 93 | val err_miss : string -> 'a 94 | val err_file : string -> string -> 'a 95 | val warn_unused : string -> unit 96 | end = struct 97 | 98 | (* Parses the command line. The actual cmd execution occurs in the call 99 | to Pkg.describe. *) 100 | 101 | let err fmt = 102 | let k _ = exit 1 in 103 | Format.kfprintf k Format.err_formatter ("%s: " ^^ fmt ^^ "@.") Sys.argv.(0) 104 | 105 | let err_parse a = err "argument `%s' is not of the form key=(true|false)" a 106 | let err_mdef a = err "bool `%s' is defined more than once" a 107 | let err_miss a = err "argument `%s=(true|false)' is missing" a 108 | let err_file f e = err "%s: %s" f e 109 | let warn_unused k = 110 | Format.eprintf "%s: warning: environment key `%s` unused.@." Sys.argv.(0) k 111 | 112 | let cmd, env = 113 | let rec parse_env acc = function (* not t.r. *) 114 | | arg :: args -> 115 | begin try 116 | (* String.cut ... *) 117 | let len = String.length arg in 118 | let eq = String.index arg '=' in 119 | let bool = bool_of_string (String.sub arg (eq + 1) (len - eq - 1)) in 120 | let key = String.sub arg 0 eq in 121 | if key = "" then raise Exit else 122 | try ignore (List.assoc key acc); err_mdef key with 123 | | Not_found -> parse_env ((key, bool) :: acc) args 124 | with 125 | | Invalid_argument _ | Not_found | Exit -> err_parse arg 126 | end 127 | | [] -> acc 128 | in 129 | match List.tl (Array.to_list Sys.argv) with 130 | | "explain" :: args -> `Explain, parse_env [] args 131 | | ("help" | "-h" | "--help" | "-help") :: args -> `Help, parse_env [] args 132 | | args -> `Build, parse_env [] args 133 | end 134 | 135 | module Env : sig 136 | include Env 137 | val get : unit -> (string * bool) list 138 | end = struct 139 | let env = ref [] 140 | let get () = !env 141 | let add_bool key b = env := (key, b) :: !env 142 | let bool key = 143 | let b = try List.assoc key Topkg.env with 144 | | Not_found -> if Topkg.cmd = `Build then Topkg.err_miss key else true 145 | in 146 | add_bool key b; b 147 | 148 | let native = bool "native" 149 | let native_dynlink = bool "native-dynlink" 150 | end 151 | 152 | module Exts : Exts = struct 153 | let interface = [".mli"; ".cmi"; ".cmti"] 154 | let interface_opt = ".cmx" :: interface 155 | let c_library = if Sys.win32 then [".lib"] else [".a"] 156 | let c_dll_library = if Sys.win32 then [".dll"] else [".so"] 157 | let library = [".cma"; ".cmxa"; ".cmxs"] @ c_library 158 | let module_library = (interface_opt @ library) 159 | end 160 | 161 | module Pkg : Pkg = struct 162 | type builder = [ `OCamlbuild | `Other of string * string ] 163 | type moves = (string * (string * string)) list 164 | type field = ?cond:bool -> ?exts:string list -> ?dst:string -> string -> moves 165 | 166 | let str = Printf.sprintf 167 | let warn_unused () = 168 | let keys = List.map fst Topkg.env in 169 | let keys_used = List.map fst (Env.get ()) in 170 | let unused = List.find_all (fun k -> not (List.mem k keys_used)) keys in 171 | List.iter Topkg.warn_unused unused 172 | 173 | let has_suffix = Filename.check_suffix 174 | let build_strings ?(exec_sep = " ") btool bdir mvs = 175 | let no_build = [ ".cmti"; ".cmt" ] in 176 | let install = Buffer.create 1871 in 177 | let exec = Buffer.create 1871 in 178 | let rec add_mvs current = function 179 | | (field, (src, dst)) :: mvs when field = current -> 180 | if List.exists (has_suffix src) no_build then 181 | Buffer.add_string install (str "\n \"?%s/%s\" {\"%s\"}" bdir src dst) 182 | else begin 183 | Buffer.add_string exec (str "%s%s" exec_sep src); 184 | Buffer.add_string install (str "\n \"%s/%s\" {\"%s\"}" bdir src dst); 185 | end; 186 | add_mvs current mvs 187 | | (((field, _) :: _) as mvs) -> 188 | if current <> "" (* first *) then Buffer.add_string install " ]\n"; 189 | Buffer.add_string install (str "%s: [" field); 190 | add_mvs field mvs 191 | | [] -> () 192 | in 193 | Buffer.add_string exec btool; 194 | add_mvs "" mvs; 195 | Buffer.add_string install " ]\n"; 196 | Buffer.contents install, Buffer.contents exec 197 | 198 | let pr = Format.printf 199 | let pr_explanation btool bdir pkg mvs = 200 | let env = Env.get () in 201 | let install, exec = build_strings ~exec_sep:" \\\n " btool bdir mvs in 202 | pr "@["; 203 | pr "Package name: %s@," pkg; 204 | pr "Build tool: %s@," btool; 205 | pr "Build directory: %s@," bdir; 206 | pr "Environment:@, "; 207 | List.iter (fun (k,v) -> pr "%s=%b@, " k v) (List.sort compare env); 208 | pr "@,Build invocation:@,"; 209 | pr " %s@,@," exec; 210 | pr "Install file:@,"; 211 | pr "%s@," install; 212 | pr "@]"; 213 | () 214 | 215 | let pr_help () = 216 | pr "Usage example:@\n %s" Sys.argv.(0); 217 | List.iter (fun (k,v) -> pr " %s=%b" k v) (List.sort compare (Env.get ())); 218 | pr "@." 219 | 220 | let build btool bdir pkg mvs = 221 | let install, exec = build_strings btool bdir mvs in 222 | let e = Sys.command exec in 223 | if e <> 0 then exit e else 224 | let install_file = pkg ^ ".install" in 225 | try 226 | let oc = open_out install_file in 227 | output_string oc install; flush oc; close_out oc 228 | with Sys_error e -> Topkg.err_file install_file e 229 | 230 | let mvs ?(drop_exts = []) field ?(cond = true) ?(exts = []) ?dst src = 231 | if not cond then [] else 232 | let mv src dst = (field, (src, dst)) in 233 | let expand exts s d = List.map (fun e -> mv (s ^ e) (d ^ e)) exts in 234 | let dst = match dst with None -> Filename.basename src | Some dst -> dst in 235 | let files = if exts = [] then [mv src dst] else expand exts src dst in 236 | let keep (_, (src, _)) = not (List.exists (has_suffix src) drop_exts) in 237 | List.find_all keep files 238 | 239 | let lib = 240 | let drop_exts = 241 | if Env.native && not Env.native_dynlink then [ ".cmxs" ] else 242 | if not Env.native then Exts.c_library @ [".cmx"; ".cmxa"; ".cmxs" ] 243 | else [] 244 | in 245 | mvs ~drop_exts "lib" 246 | 247 | let share = mvs "share" 248 | let share_root = mvs "share_root" 249 | let etc = mvs "etc" 250 | let toplevel = mvs "toplevel" 251 | let doc = mvs "doc" 252 | let misc = mvs "misc" 253 | let stublibs = mvs "stublibs" 254 | let man = mvs "man" 255 | 256 | let bin_drops = if not Env.native then [ ".native" ] else [] 257 | let bin_mvs field ?(auto = false) ?cond ?exts ?dst src = 258 | let src, dst = 259 | if not auto then src, dst else 260 | let dst = match dst with 261 | | None -> Some (Filename.basename src) 262 | | Some _ as dst -> dst 263 | in 264 | let src = if Env.native then src ^ ".native" else src ^ ".byte" in 265 | src, dst 266 | in 267 | mvs ~drop_exts:bin_drops field ?cond ?dst src 268 | 269 | let bin = bin_mvs "bin" 270 | let sbin = bin_mvs "sbin" 271 | let libexec = bin_mvs "libexec" 272 | 273 | let describe pkg ~builder mvs = 274 | let mvs = List.sort compare (List.flatten mvs) in 275 | let btool, bdir = match builder with 276 | | `OCamlbuild -> "ocamlbuild -use-ocamlfind -classic-display", "_build" 277 | | `Other (btool, bdir) -> btool, bdir 278 | in 279 | match Topkg.cmd with 280 | | `Explain -> pr_explanation btool bdir pkg mvs 281 | | `Help -> pr_help () 282 | | `Build -> warn_unused (); build btool bdir pkg mvs 283 | end 284 | 285 | (*--------------------------------------------------------------------------- 286 | Copyright (c) 2014 Daniel C. Bünzli. 287 | All rights reserved. 288 | 289 | Redistribution and use in source and binary forms, with or without 290 | modification, are permitted provided that the following conditions 291 | are met: 292 | 293 | 1. Redistributions of source code must retain the above copyright 294 | notice, this list of conditions and the following disclaimer. 295 | 296 | 2. Redistributions in binary form must reproduce the above 297 | copyright notice, this list of conditions and the following 298 | disclaimer in the documentation and/or other materials provided 299 | with the distribution. 300 | 301 | 3. Neither the name of Daniel C. Bünzli nor the names of 302 | contributors may be used to endorse or promote products derived 303 | from this software without specific prior written permission. 304 | 305 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 306 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 307 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 308 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 309 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 310 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 311 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 312 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 313 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 314 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 315 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 316 | ---------------------------------------------------------------------------*) 317 | -------------------------------------------------------------------------------- /src/ppx_netblob.ml: -------------------------------------------------------------------------------- 1 | open Ast_convenience 2 | open Ast_mapper 3 | open Ast_helper 4 | open Asttypes 5 | open Cohttp 6 | open Cohttp_lwt_unix 7 | open Parsetree 8 | open Location 9 | open Longident 10 | 11 | let deriver = "netblob" 12 | 13 | let raise_errorf = Ppx_deriving.raise_errorf 14 | 15 | (** parse the options passed to the direct invocation of the deriver 16 | * @returns a tuple of the target url of the request as a string and the method 17 | * of the request as a polymorphic variant 18 | * @TODO change the type of the target URL to an actual cohttp `Url.t` type or 19 | * something, add support for more than just `get` requests 20 | *) 21 | let parse_options options = 22 | let (_, expr) = 23 | try 24 | List.hd options 25 | with 26 | | exn -> raise (Failure "parsing options") 27 | in 28 | try 29 | let url = 30 | List.find (fun (name, _) -> name = "url") options 31 | |> snd 32 | |> Ast_convenience.get_str 33 | |> function 34 | | Some s -> 35 | s 36 | | None -> 37 | raise_errorf 38 | ~loc:expr.pexp_loc 39 | "%s option \"url\" accepts a string constant parameter" 40 | deriver 41 | in 42 | let meth = 43 | List.find (fun (name, _) -> name = "meth") options 44 | |> snd 45 | |> function 46 | | [%expr `Get] -> `Get 47 | | [%expr `Post] -> `Post 48 | | _ -> 49 | raise_errorf ~loc:expr.pexp_loc "%s: invalid HTTP method" deriver 50 | in 51 | let format = 52 | List.find (fun (name, _) -> name = "format") options 53 | |> snd 54 | |> function 55 | | [%expr `Json] -> `Json None 56 | | [%expr (`Json [%e? func])] -> `Json (Some func) 57 | | [%expr `Xml] -> `Xml 58 | | [%expr `Text] -> `Text 59 | | _ -> raise_errorf ~loc:expr.pexp_loc "%s: invalid response format" deriver 60 | in 61 | url, meth, format 62 | with 63 | | Not_found -> 64 | raise_errorf ~loc:expr.pexp_loc "%s requires both a 'meth' option and a 'url' option" deriver 65 | 66 | let attr_key attrs = 67 | Ppx_deriving.(attrs |> attr ~deriver "key" |> Arg.(get_attr ~deriver expr)) 68 | 69 | let attr_default attrs = 70 | Ppx_deriving.(attrs |> attr ~deriver "default" |> Arg.(get_attr ~deriver expr)) 71 | 72 | let attr_ispostparam attrs = 73 | Ppx_deriving.(attrs |> attr ~deriver "post" |> Arg.get_flag ~deriver) 74 | 75 | let attr_isgetparam attrs = 76 | Ppx_deriving.(attrs |> attr ~deriver "get" |> Arg.get_flag ~deriver) 77 | 78 | let attr_ispathparam attrs = 79 | Ppx_deriving.(attrs |> attr ~deriver "path" |> Arg.get_flag ~deriver) 80 | 81 | let is_optional { pld_name = { txt = name }; pld_type; pld_attributes } = 82 | let attrs = pld_attributes @ pld_type.ptyp_attributes in 83 | match attr_default attrs with 84 | | Some _ -> true 85 | | None -> 86 | (match Ppx_deriving.remove_pervasives ~deriver pld_type with 87 | | [%type: [%t? _] option] -> true 88 | | _ -> false) 89 | 90 | let str_of_type ~options ~path ({ ptype_loc = loc } as type_decl) = 91 | let url, meth, format = parse_options options in 92 | let quoter = Ppx_deriving.create_quoter () in 93 | let creator = 94 | match type_decl.ptype_kind with 95 | | Ptype_record labels -> 96 | let fields = 97 | List.map 98 | (fun { pld_name = { txt = name; loc } } -> 99 | name, evar name) 100 | labels 101 | in 102 | let is_option = List.exists is_optional labels in 103 | (* [fn] is the actual HTTP calling function, so it's at the very 104 | * bottom of the recursive stack *) 105 | let fn = 106 | let formatter = 107 | match format with 108 | | `Json None -> 109 | [%expr Yojson.Safe.from_string] 110 | | `Json (Some func) -> 111 | [%expr 112 | (fun s -> 113 | let open Result in 114 | let mime = 115 | Cohttp.( 116 | Header.get (Response.headers resp) "Content-Type") 117 | |> function 118 | | Some s -> s 119 | | None -> "" 120 | in 121 | match String.trim (String.lowercase_ascii mime) with 122 | | "application/json; charset=utf-8" 123 | | "application/json;" 124 | | "application/json" 125 | | "" -> 126 | let json = Yojson.Safe.from_string s in 127 | begin match [%e func] json with 128 | | Ok _ as x -> 129 | x 130 | | Error msg -> 131 | Error ( 132 | "netblob: the following fragment does \ 133 | not adhere to the expected schema (" ^ 134 | msg ^ "):\n" ^ 135 | Yojson.Safe.pretty_to_string json 136 | ^ "\n") 137 | end 138 | | s -> 139 | Error ( 140 | Printf.sprintf 141 | "bad response Content-Type (%s):expected (%s)" 142 | mime 143 | "application/json; charset=utf-8"))] 144 | | `Xml -> [%expr (fun s -> Xmlm.make_input (`String (0, s)))] 145 | | `Text -> [%expr (fun s -> s)] 146 | in 147 | let requestor = 148 | begin match meth with 149 | | `Get -> [%expr Client.get ~headers uri] 150 | | `Post -> [%expr Client.post ~headers ~body:(Cohttp_lwt_body.of_string body) uri] 151 | end 152 | in 153 | let payload = 154 | [%expr 155 | let headers = Cohttp.Header.init_with "User-Agent" "Mozilla/5.0" in 156 | let cookies = 157 | begin match cookies with 158 | | [] -> "" 159 | | cookies' -> 160 | let first_cookie = 161 | let (k, v) = List.hd cookies' in 162 | k ^ "=" ^ v 163 | in 164 | List.fold_left 165 | (fun acc (k, v) -> 166 | acc ^ "; " ^ k ^ "=" ^ v) 167 | first_cookie 168 | (List.tl cookies') 169 | end 170 | in 171 | let headers = Cohttp.Header.(add headers "Cookie" cookies) in 172 | Lwt_io.printf "url: %s\n" (Uri.to_string uri) 173 | >>= fun _ -> 174 | [%e requestor] 175 | >>= fun (resp, body) -> 176 | let cookies_headers = Cohttp.Header.get_multi resp.headers "Set-Cookie" in 177 | let cookies = 178 | begin match Cohttp.Header.get resp.headers "Cookie" with 179 | | Some cookies -> 180 | ExtString.String.nsplit cookies "; " 181 | |> List.map 182 | (fun cookie -> 183 | let [k; v] = ExtString.String.nsplit cookie "=" in 184 | k, v) 185 | | None -> 186 | [] 187 | end 188 | in 189 | let cookies = 190 | List.fold_left 191 | (fun acc c -> 192 | acc @ ( 193 | ExtString.String.nsplit c ";" 194 | |> List.hd 195 | |> fun s -> 196 | ExtString.String.nsplit s "=" 197 | |> fun [k; v] -> 198 | [k, v])) 199 | cookies 200 | cookies_headers 201 | in 202 | let rcode = Code.code_of_status (Response.status resp) in 203 | (* return a triple of the code, body, cookies *) 204 | match rcode with 205 | | 200 -> 206 | Cohttp_lwt_body.to_string body 207 | >>= fun s -> 208 | Lwt.return (200, ([%e formatter] s), cookies) 209 | | 301 -> 210 | Lwt.fail_with ( 211 | Printf.sprintf 212 | "Netblob received HTTP response code 301, meaning \ 213 | that the requested resource has been moved.") 214 | | n -> 215 | Cohttp_lwt_body.to_string body 216 | >>= fun s -> 217 | Lwt.return (n, ([%e formatter] s), cookies)] 218 | in 219 | let payload = Exp.fun_ Label.nolabel None (punit ()) payload in 220 | Exp.fun_ (Label.optional "cookies") (Some [%expr []]) (pvar "cookies") payload 221 | (*match is_option with 222 | | true -> 223 | Exp.fun_ Label.nolabel None (punit ()) payload 224 | | false -> 225 | payload*) 226 | in 227 | List.fold_left (fun accum { pld_name = { txt = name }; pld_type; pld_attributes } -> 228 | let attrs = pld_attributes @ pld_type.ptyp_attributes in 229 | let pld_type = Ppx_deriving.remove_pervasives ~deriver pld_type in 230 | let evar_name = evar name in 231 | let ename = Exp.constant (Pconst_string (name, None)) in 232 | let key = 233 | match attr_key attrs with 234 | | Some key -> key 235 | | None -> ename 236 | in 237 | (** The function that will be used at runtime to marshal this 238 | * parameter into a string or (nonempty) list of strings *) 239 | let rec make_converter pld_type = 240 | let t = 241 | (** We need to start by extracting the base type 242 | * @TODO figure out the desired semantics for [list option]s 243 | * and [option list]s *) 244 | match pld_type with 245 | | [%type: [%t? t] list] -> t 246 | | [%type: [%t? t] option] -> t 247 | | [%type: [%t? t]] -> t 248 | in 249 | match t with 250 | | [%type: int] -> 251 | [%expr (string_of_int)] 252 | | [%type: bool] -> 253 | [%expr (string_of_bool)] 254 | | [%type: float] -> 255 | [%expr (string_of_float)] 256 | | [%type: string] -> 257 | [%expr ((fun x -> x)[@inlined])] 258 | | [%type: [%t? t1] * [%t? t2]] -> (* I'm so sorry *) 259 | let c1, c2 = make_converter t1, make_converter t2 in 260 | [%expr (fun (a, b) -> ([%e c1] a) ^ "," ^ ([%e c2] b))] 261 | | [%type: [%t? t1] * [%t? t2] * [%t? t3]] -> 262 | (* I'll never use anything bigger than a 3-tuple, right? *) 263 | let c1, c2, c3 = make_converter t1, make_converter t2, make_converter t3 in 264 | [%expr (fun (a, b, c) -> ([%e c1] a) ^ "," ^ ([%e c2] b) ^ "," ([%e c3]))] 265 | | [%type: [%t? _]] -> 266 | raise_errorf ~loc "%s doesn't know about this type" deriver 267 | in 268 | let converter = make_converter pld_type in 269 | (** The converter needs to get wrapped with [List.map] if t is a 270 | * list type *) 271 | let converter = 272 | match pld_type with 273 | | [%type: [%t? _] list] -> 274 | [%expr 275 | List.map ([%e converter])] 276 | | _ -> 277 | [%expr (fun x -> [[%e converter] x])] 278 | in 279 | let add_to_uri_accum = 280 | [%expr 281 | let x = [%e converter] [%e evar_name] in 282 | let uri = Uri.add_query_param uri ([%e key], x) in 283 | [%e accum]] 284 | in 285 | let add_path_to_uri_accum = 286 | [%expr 287 | let [x] = [%e converter] [%e evar_name] in 288 | let path = Filename.concat (Uri.path uri) x in 289 | let uri = Uri.with_path uri path in 290 | [%e accum]] 291 | in 292 | let add_post_param_accum = 293 | [%expr 294 | let [x] = [%e converter] [%e evar_name] in 295 | let body = 296 | begin match body with 297 | | "" -> 298 | (Uri.pct_encode [%e key]) ^ "=" ^ (Uri.pct_encode x) 299 | | s -> 300 | s ^ "&" ^ (Uri.pct_encode [%e key]) ^ "=" ^ (Uri.pct_encode x) 301 | end 302 | in 303 | [%e accum]] 304 | in 305 | let add_body_accum = 306 | [%expr 307 | let [x] = [%e converter] [%e evar_name] in 308 | let body = x in 309 | [%e accum]] 310 | in 311 | let addparam_accum = 312 | match attr_ispathparam attrs with 313 | | true -> 314 | add_path_to_uri_accum 315 | | false -> 316 | if name = "body" 317 | then add_body_accum 318 | else begin match attr_ispostparam attrs with 319 | | true -> 320 | add_post_param_accum 321 | | false -> 322 | add_to_uri_accum 323 | end 324 | in 325 | match attr_default attrs with 326 | | Some default -> 327 | let default = Some (Ppx_deriving.quote ~quoter default) in 328 | Exp.fun_ (Label.optional name) default (pvar name) addparam_accum 329 | | None -> 330 | begin match pld_type with 331 | | [%type: [%t? _] option] -> 332 | let accum' = 333 | [%expr 334 | let uri = 335 | match [%e evar_name] with 336 | | Some x -> 337 | let x = [%e converter] x in 338 | begin match x with 339 | | [] -> 340 | (* because fuck you that's why *) 341 | raise (Failure ("parameter is required")) 342 | | x -> 343 | Uri.add_query_param uri ([%e key], x) 344 | end 345 | | None -> uri 346 | in 347 | [%e accum]] 348 | in 349 | Exp.fun_ (Label.optional name) None (pvar name) accum' 350 | | _ -> 351 | Exp.fun_ (Label.labelled name) None (pvar name) addparam_accum 352 | end) 353 | fn 354 | labels 355 | | _ -> raise_errorf ~loc "%s can be derived only for record types" deriver 356 | in 357 | let uri = Exp.constant (Pconst_string (url, None)) in 358 | let creator = 359 | [%expr 360 | let open Cohttp in 361 | let open Cohttp_lwt_unix in 362 | let open Lwt in 363 | let uri = Uri.of_string [%e uri] in 364 | let body = "" in 365 | [%e creator]] 366 | in 367 | let prefix = 368 | match meth with 369 | | `Get -> "netblob_get" 370 | | `Post -> "netblob_post" 371 | in 372 | let name = 373 | match type_decl with 374 | | { ptype_name = { txt = "t" } } -> 375 | prefix 376 | | _ -> 377 | Ppx_deriving.mangle_type_decl (`Prefix prefix) type_decl 378 | in 379 | [Vb.mk (pvar name) (Ppx_deriving.sanitize ~quoter creator)] 380 | 381 | let sig_of_type ~options ~path ({ ptype_loc = loc } as type_decl) = 382 | let url, meth, format = parse_options options in 383 | let typ = Ppx_deriving.core_type_of_type_decl type_decl in 384 | let typ = 385 | match type_decl.ptype_kind with 386 | | Ptype_record labels -> 387 | let has_option = List.exists is_optional labels in 388 | let typ = 389 | match has_option with 390 | | true -> Typ.arrow Label.nolabel (tconstr "unit" []) typ 391 | | false -> typ 392 | in 393 | List.fold_left (fun accum { pld_name = { txt = name; loc }; pld_type; pld_attributes } -> 394 | let attrs = pld_type.ptyp_attributes @ pld_attributes in 395 | let pld_type = Ppx_deriving.remove_pervasives ~deriver pld_type in 396 | match attr_default attrs with 397 | | Some _ -> Typ.arrow (Label.optional name) pld_type accum 398 | | None -> 399 | begin match pld_type with 400 | | [%type: [%t? _] list] -> 401 | Typ.arrow (Label.optional name) pld_type accum 402 | | [%type: [%t? opt] option] -> 403 | Typ.arrow (Label.optional name) opt accum 404 | | _ -> 405 | Typ.arrow (Label.labelled name) pld_type accum 406 | end) 407 | typ labels 408 | | _ -> raise_errorf ~loc "%s can only be derived for record types" deriver 409 | in 410 | let prefix = 411 | match meth with 412 | | `Get -> "netblob_get" 413 | | `Post -> "netblob_post" 414 | in 415 | let name = 416 | match type_decl with 417 | | { ptype_name = { txt = "t" } } -> 418 | prefix 419 | | _ -> 420 | Ppx_deriving.mangle_type_decl (`Prefix prefix) type_decl 421 | in 422 | [Sig.value (Val.mk (mknoloc name) typ)] 423 | 424 | let () = 425 | Ppx_deriving.(register (create deriver 426 | ~type_decl_str: (fun ~options ~path type_decls -> 427 | [Str.value Nonrecursive (List.concat (List.map (str_of_type ~options ~path) type_decls))]) 428 | ~type_decl_sig: (fun ~options ~path type_decls -> 429 | List.concat (List.map (sig_of_type ~options ~path) type_decls)) 430 | ())) 431 | --------------------------------------------------------------------------------