├── lib ├── dune ├── test │ ├── dune │ ├── nightmare_test.ml │ ├── dummy_request.ml │ ├── nightmare_test.mli │ └── dummy_request.mli ├── dream │ ├── dune │ ├── redirect.ml │ ├── router.ml │ ├── nightmare_dream.ml │ ├── router.mli │ ├── redirect.mli │ └── nightmare_dream.mli ├── service │ ├── dune │ ├── handler.ml │ ├── handler.mli │ ├── middleware.ml │ ├── middleware.mli │ ├── signatures.mli │ ├── nightmare_service.ml │ ├── parser.mli │ ├── method.ml │ ├── nightmare_service.mli │ ├── parser.ml │ ├── method.mli │ ├── service.ml │ ├── path.ml │ └── endpoint.ml ├── tyxml │ ├── dune │ └── attrib.mli ├── vdom │ ├── dune │ ├── nightmare_js_vdom.ml │ └── nightmare_js_vdom.mli └── js │ ├── dune │ ├── aliases.mli │ ├── optional.mli │ ├── nightmare_js.ml │ ├── util.ml │ ├── util.mli │ ├── headers.mli │ ├── blob.mli │ ├── form_data.mli │ ├── url_search_params.mli │ ├── suspension.ml │ ├── blob.ml │ ├── stream.mli │ ├── headers.ml │ ├── nightmare_js.mli │ ├── form_data.ml │ ├── stream.ml │ ├── suspension.mli │ ├── promise.mli │ ├── url_search_params.ml │ ├── promise.ml │ ├── console.ml │ ├── bindings.mli │ ├── stubs │ └── caml_promise_stubs.js │ ├── console.mli │ ├── optional.ml │ ├── fetch.mli │ └── storage.mli ├── examples ├── shared │ ├── dune │ └── endpoint.ml ├── backend │ ├── dune │ ├── main.ml │ ├── template.ml │ └── service.ml ├── frontend │ ├── dune │ ├── main.ml │ ├── counter_vdom.ml │ └── server_counter_vdom.ml └── priv │ └── style.css ├── test ├── service_test │ ├── dune │ ├── nightmare_service_test.mli │ ├── method_test.mli │ ├── parser_test.mli │ ├── path_test.mli │ ├── service_test.mli │ ├── endpoint_test.mli │ ├── nightmare_service_test.ml │ ├── method_test.ml │ └── parser_test.ml └── tyxml_test │ ├── dune │ ├── nightmare_tyxml_test.mli │ ├── nightmare_tyxml_test.ml │ └── element_test.mli ├── .ocamlformat ├── .gitignore ├── nightmare-tyxml.opam ├── nightmare-test.opam ├── nightmare-dream.opam ├── .github └── workflows │ ├── unit-test.yml │ └── check-lint.yml ├── nightmare.opam ├── nightmare_js-vdom.opam ├── nightmare_js.opam ├── LICENSE ├── Makefile ├── README.md └── dune-project /lib/dune: -------------------------------------------------------------------------------- 1 | (documentation 2 | (package nightmare)) 3 | -------------------------------------------------------------------------------- /examples/shared/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name shared) 3 | (libraries nightmare.service)) 4 | -------------------------------------------------------------------------------- /lib/test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name nightmare-test) 3 | (name nightmare_test) 4 | (libraries alcotest lwt lwt.unix)) 5 | -------------------------------------------------------------------------------- /test/service_test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name nightmare_service_test) 3 | (libraries alcotest nightmare-test nightmare.service)) 4 | -------------------------------------------------------------------------------- /test/tyxml_test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name nightmare_tyxml_test) 3 | (libraries alcotest tyxml nightmare-test nightmare-tyxml)) 4 | -------------------------------------------------------------------------------- /lib/dream/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name nightmare-dream) 3 | (name nightmare_dream) 4 | (libraries dream nightmare.service)) 5 | -------------------------------------------------------------------------------- /lib/service/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name nightmare.service) 3 | (name nightmare_service) 4 | (modules_without_implementation signatures) 5 | (libraries lwt)) 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.26.1 2 | profile = janestreet 3 | break-infix = fit-or-vertical 4 | parse-docstrings = true 5 | module-item-spacing = compact 6 | margin = 80 7 | -------------------------------------------------------------------------------- /lib/tyxml/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name nightmare-tyxml) 3 | (name nightmare_tyxml) 4 | (modules_without_implementation attrib) 5 | (libraries tyxml nightmare.service)) 6 | -------------------------------------------------------------------------------- /examples/backend/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries 4 | dream 5 | tyxml 6 | nightmare.service 7 | nightmare_dream 8 | nightmare_tyxml 9 | shared)) 10 | -------------------------------------------------------------------------------- /lib/vdom/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name nightmare_js-vdom) 3 | (name nightmare_js_vdom) 4 | (libraries tyxml lwt vdom nightmare.service nightmare-tyxml nightmare_js) 5 | (modes byte)) 6 | -------------------------------------------------------------------------------- /examples/frontend/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (modes js) 4 | (preprocess 5 | (pps js_of_ocaml-ppx)) 6 | (js_of_ocaml 7 | (flags :standard)) 8 | (promote 9 | (until-clean) 10 | (into "../priv") 11 | (only main.bc.js)) 12 | (libraries nightmare_js nightmare_js-vdom shared)) 13 | -------------------------------------------------------------------------------- /lib/js/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name nightmare_js) 3 | (name nightmare_js) 4 | (libraries 5 | preface 6 | nightmare.service 7 | js_of_ocaml-compiler.runtime 8 | lwt 9 | js_of_ocaml-lwt) 10 | (modules_without_implementation aliases interfaces bindings) 11 | (modes byte) 12 | (js_of_ocaml 13 | (javascript_files stubs/caml_promise_stubs.js)) 14 | (preprocess 15 | (pps js_of_ocaml-ppx))) 16 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | # ocamlbuild working directory 12 | _build/ 13 | 14 | # ocamlbuild targets 15 | *.byte 16 | *.native 17 | *.bc.js 18 | *.bc-for-jsoo 19 | 20 | # oasis generated files 21 | setup.data 22 | setup.log 23 | 24 | # Merlin configuring file for Vim and Emacs 25 | .merlin 26 | 27 | # Dune generated files 28 | *.install 29 | 30 | # Local OPAM switch 31 | _opam/ 32 | -------------------------------------------------------------------------------- /nightmare-tyxml.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Glue between Nightmare and TyXML" 4 | description: "Facilitates interaction between Nightmare and TyXML" 5 | maintainer: ["Funkywork"] 6 | authors: ["Funkywork"] 7 | license: "MIT" 8 | homepage: "https://github.com/funkywork/nightmare" 9 | bug-reports: "https://github.com/funkywork/nightmare/issues" 10 | depends: [ 11 | "dune" {>= "3.0"} 12 | "ocaml" {>= "5.0.0"} 13 | "tyxml" {>= "4.6.0"} 14 | "nightmare" {= version} 15 | "odoc" {with-doc} 16 | ] 17 | build: [ 18 | ["dune" "subst"] {dev} 19 | [ 20 | "dune" 21 | "build" 22 | "-p" 23 | name 24 | "-j" 25 | jobs 26 | "@install" 27 | "@runtest" {with-test} 28 | "@doc" {with-doc} 29 | ] 30 | ] 31 | dev-repo: "git+https://github.com/funkywork/nightmare.git" 32 | -------------------------------------------------------------------------------- /nightmare-test.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Test utilities for Nightmare" 4 | description: 5 | "Some shortcuts for writting test for a Nightmare application (or library)" 6 | maintainer: ["Funkywork"] 7 | authors: ["Funkywork"] 8 | license: "MIT" 9 | homepage: "https://github.com/funkywork/nightmare" 10 | bug-reports: "https://github.com/funkywork/nightmare/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "ocaml" {>= "5.0.0"} 14 | "lwt" {>= "5.6.1"} 15 | "alcotest" 16 | "odoc" {with-doc} 17 | ] 18 | build: [ 19 | ["dune" "subst"] {dev} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "@install" 28 | "@runtest" {with-test} 29 | "@doc" {with-doc} 30 | ] 31 | ] 32 | dev-repo: "git+https://github.com/funkywork/nightmare.git" 33 | -------------------------------------------------------------------------------- /nightmare-dream.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Glue between Nightmare and Dream" 4 | description: "An overlay built on top of Dream for using Nightmare tools" 5 | maintainer: ["Funkywork"] 6 | authors: ["Funkywork"] 7 | license: "MIT" 8 | homepage: "https://github.com/funkywork/nightmare" 9 | bug-reports: "https://github.com/funkywork/nightmare/issues" 10 | depends: [ 11 | "dune" {>= "3.0"} 12 | "ocaml" {>= "5.0.0"} 13 | "dream" {>= "1.0.0~alpha5"} 14 | "nightmare" {= version} 15 | "odoc" {with-doc} 16 | ] 17 | build: [ 18 | ["dune" "subst"] {dev} 19 | [ 20 | "dune" 21 | "build" 22 | "-p" 23 | name 24 | "-j" 25 | jobs 26 | "@install" 27 | "@runtest" {with-test} 28 | "@doc" {with-doc} 29 | ] 30 | ] 31 | dev-repo: "git+https://github.com/funkywork/nightmare.git" 32 | -------------------------------------------------------------------------------- /examples/backend/main.ml: -------------------------------------------------------------------------------- 1 | (* A very simple example of routing using services. *) 2 | 3 | let router = 4 | Nightmare_dream.router 5 | ~services: 6 | [ Service.home 7 | ; Service.Simple_routing.home 8 | ; Service.Simple_routing.about 9 | ; Service.Simple_routing.hello 10 | ; Service.Counter_vdom.home 11 | ; Service.Counter_vdom.about 12 | ; Service.Server_side_counter.home 13 | ; Service.Server_side_counter.about 14 | ; Service.Server_side_counter.increment 15 | ; Service.Server_side_counter.decrement 16 | ; Service.Server_side_counter.value 17 | ] 18 | ;; 19 | 20 | let static_path = 21 | let open Dream in 22 | router [ get "/priv/**" @@ static "examples/priv/" ] 23 | ;; 24 | 25 | let () = 26 | Dream.run ~port:8888 27 | @@ Dream.logger 28 | @@ Dream.memory_sessions 29 | @@ router 30 | @@ static_path 31 | ;; 32 | -------------------------------------------------------------------------------- /.github/workflows/unit-test.yml: -------------------------------------------------------------------------------- 1 | name: Unit test 2 | on: 3 | pull_request: 4 | 5 | jobs: 6 | build_opam: 7 | name: Builds the project and performs the unit tests 8 | strategy: 9 | fail-fast: false 10 | matrix: 11 | os: 12 | - ubuntu-latest 13 | ocaml-compiler: 14 | - 5.0.0 15 | runs-on: ${{ matrix.os }} 16 | 17 | steps: 18 | - name: configure git LF 19 | run: | 20 | git config --global core.autocrlf false 21 | git config --global core.eol lf 22 | - name: Checkout code 23 | uses: actions/checkout@v2 24 | # 25 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 26 | uses: ocaml/setup-ocaml@v2 27 | with: 28 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 29 | opam-depext-flags: --with-test 30 | - run: opam install . --deps-only --with-test -y 31 | - run: opam exec -- dune build 32 | - run: opam exec -- dune runtest 33 | -------------------------------------------------------------------------------- /.github/workflows/check-lint.yml: -------------------------------------------------------------------------------- 1 | name: Check lint 2 | on: 3 | pull_request: 4 | 5 | jobs: 6 | build_opam: 7 | name: Checks that the source code respects the formatting imposed by OCamlformat 8 | strategy: 9 | fail-fast: true 10 | matrix: 11 | os: 12 | - ubuntu-latest 13 | ocaml-compiler: 14 | - 5.0.0 15 | runs-on: ${{ matrix.os }} 16 | 17 | steps: 18 | - name: configure git LF 19 | run: | 20 | git config --global core.autocrlf false 21 | git config --global core.eol lf 22 | - name: Checkout code 23 | uses: actions/checkout@v2 24 | # 25 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 26 | uses: ocaml/setup-ocaml@v2 27 | with: 28 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 29 | opam-depext-flags: --with-test 30 | - run: opam install dune -y 31 | - run: opam install ocamlformat -y 32 | - run: opam exec -- dune build @fmt 33 | -------------------------------------------------------------------------------- /nightmare.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "An ad-hoc framework for writing web application using OCaml" 4 | description: 5 | "An ad-hoc framework (that should fit well with Dream) for writting OCaml web application" 6 | maintainer: ["Funkywork"] 7 | authors: ["Funkywork"] 8 | license: "MIT" 9 | homepage: "https://github.com/funkywork/nightmare" 10 | bug-reports: "https://github.com/funkywork/nightmare/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "ocaml" {>= "5.0.0"} 14 | "lwt" {>= "5.6.1"} 15 | "preface" {>= "1.0.0"} 16 | "alcotest" {with-test} 17 | "nightmare-test" {= version & with-test} 18 | "odoc" {with-doc} 19 | ] 20 | build: [ 21 | ["dune" "subst"] {dev} 22 | [ 23 | "dune" 24 | "build" 25 | "-p" 26 | name 27 | "-j" 28 | jobs 29 | "@install" 30 | "@runtest" {with-test} 31 | "@doc" {with-doc} 32 | ] 33 | ] 34 | dev-repo: "git+https://github.com/funkywork/nightmare.git" 35 | -------------------------------------------------------------------------------- /nightmare_js-vdom.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A companion library and glue for ocaml-vdom and Nightmare" 4 | description: 5 | "Provides additional HTML tags and attributes for the ocaml-vdom library and adds support for Nightmare services" 6 | maintainer: ["Funkywork"] 7 | authors: ["Funkywork"] 8 | license: "MIT" 9 | homepage: "https://github.com/funkywork/nightmare" 10 | bug-reports: "https://github.com/funkywork/nightmare/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "ocaml" {>= "5.0.0"} 14 | "tyxml" {>= "4.5.0"} 15 | "vdom" {>= "0.3"} 16 | "nightmare-tyxml" {= version} 17 | "nightmare_js" {= version} 18 | "odoc" {with-doc} 19 | ] 20 | build: [ 21 | ["dune" "subst"] {dev} 22 | [ 23 | "dune" 24 | "build" 25 | "-p" 26 | name 27 | "-j" 28 | jobs 29 | "@install" 30 | "@runtest" {with-test} 31 | "@doc" {with-doc} 32 | ] 33 | ] 34 | dev-repo: "git+https://github.com/funkywork/nightmare.git" 35 | -------------------------------------------------------------------------------- /nightmare_js.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "The JavaScript Runtime for Nightmare JS Application" 4 | description: 5 | "A list of helpers to deal with Nightmare inside a Js_of_ocaml application" 6 | maintainer: ["Funkywork"] 7 | authors: ["Funkywork"] 8 | license: "MIT" 9 | homepage: "https://github.com/funkywork/nightmare" 10 | bug-reports: "https://github.com/funkywork/nightmare/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "ocaml" {>= "5.0.0"} 14 | "lwt" {>= "5.6.1"} 15 | "preface" {>= "1.0.0"} 16 | "js_of_ocaml-compiler" {>= "5.6.0"} 17 | "js_of_ocaml-ppx" {>= "5.6.0"} 18 | "js_of_ocaml-lwt" {>= "5.6.0"} 19 | "nightmare" {= version} 20 | "odoc" {with-doc} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {dev} 24 | [ 25 | "dune" 26 | "build" 27 | "-p" 28 | name 29 | "-j" 30 | jobs 31 | "@install" 32 | "@runtest" {with-test} 33 | "@doc" {with-doc} 34 | ] 35 | ] 36 | dev-repo: "git+https://github.com/funkywork/nightmare.git" 37 | -------------------------------------------------------------------------------- /examples/frontend/main.ml: -------------------------------------------------------------------------------- 1 | open Js_of_ocaml 2 | open Nightmare_js 3 | 4 | let () = Suspension.allow () 5 | 6 | let () = 7 | Js.export 8 | "nightmare_example" 9 | (object%js 10 | (* A simple example of Js Exportation to suspension. *) 11 | method helloToConsole message = 12 | let message = "Hello, " ^ Js.to_string message ^ " !" in 13 | Console.(string log) message 14 | 15 | (* Mount the Counter Example *) 16 | method mountCounterVdom id = 17 | let id = Js.to_string id in 18 | Nightmare_js_vdom.mount_to ~id (fun _ -> 19 | let () = Console.(string info) @@ "Mounting " ^ id in 20 | let app = Counter_vdom.app () in 21 | Lwt.return app) 22 | 23 | (* Mount the Server Side counter example *) 24 | method mountServerCounterVdom id = 25 | let id = Js.to_string id in 26 | Nightmare_js_vdom.mount_to ~id (fun _ -> 27 | let () = Console.(string info) @@ "Mounting " ^ id in 28 | let app = Server_counter_vdom.app () in 29 | Lwt.return app) 30 | end) 31 | ;; 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | -------------------------------------------------------------------------------- /examples/shared/endpoint.ml: -------------------------------------------------------------------------------- 1 | open Nightmare_service.Endpoint 2 | 3 | let home () = get root 4 | let priv () = get @@ (~/"priv" /: string) 5 | 6 | module Simple_routing = struct 7 | let home () = get ~/"simple-routing" 8 | let about () = get (~/"simple-routing" / "about") 9 | let hello () = get (~/"simple-routing" / "hello" /: string) 10 | end 11 | 12 | module Counter_vdom = struct 13 | let home () = get ~/"counter-vdom" 14 | let about () = get (~/"counter-vdom" / "about") 15 | end 16 | 17 | module Server_side_counter = struct 18 | let home () = get ~/"server-side-counter" 19 | let about () = get (~/"server-side-counter" / "about") 20 | let value () = get (~/"server-side-counter" / "get") 21 | let increment () = post (~/"server-side-counter" / "incr") 22 | let decrement () = post (~/"server-side-counter" / "decr") 23 | end 24 | 25 | module External = struct 26 | let ocaml_v2 action path = outer action "https://v2.ocaml.org/" path 27 | let ocaml_org () = outer get "https://ocaml.org" root 28 | 29 | let ocaml_logo () = 30 | ocaml_v2 get (~/"releases" / "5.0" / "htmlman" / "colour-logo.svg") 31 | ;; 32 | 33 | let github_repository () = outer get "https://github.com" (~/:string /: string) 34 | end 35 | -------------------------------------------------------------------------------- /test/service_test/nightmare_service_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (* Deliberately left empty *) 24 | -------------------------------------------------------------------------------- /test/tyxml_test/nightmare_tyxml_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (* Deliberately left empty *) 24 | -------------------------------------------------------------------------------- /lib/service/handler.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type ('request, 'response) t = 'request -> 'response Lwt.t 24 | -------------------------------------------------------------------------------- /test/tyxml_test/nightmare_tyxml_test.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | let () = Alcotest.run "Nightmare_tyxml" [ Element_test.cases ] 24 | -------------------------------------------------------------------------------- /examples/backend/template.ml: -------------------------------------------------------------------------------- 1 | let page ~title content = 2 | let page_title = "Nightmare example -" ^ title in 3 | let open Tyxml.Html in 4 | let open Nightmare_tyxml in 5 | let node_title = title (txt page_title) in 6 | html 7 | ~a:[ a_lang "en" ] 8 | (head 9 | node_title 10 | [ link_of ~rel:[ `Stylesheet ] Shared.Endpoint.priv "style.css" 11 | ; script_of Shared.Endpoint.priv "main.bc.js" "" 12 | ]) 13 | (body (content @ [ script (txt "nightmare_js.mount();") ])) 14 | ;; 15 | 16 | let default 17 | ~title 18 | ~example_title 19 | ~example_subtitle 20 | ~page_title 21 | ~page_subtitle 22 | ~links 23 | content 24 | = 25 | let doc_title = title in 26 | let open Tyxml.Html in 27 | let open Nightmare_tyxml in 28 | page 29 | ~title:doc_title 30 | [ header 31 | [ main [ h1 [ txt example_title ]; h2 [ txt example_subtitle ] ] 32 | ; nav [ ul (List.map (fun l -> li [ l ]) links) ] 33 | ] 34 | ; main (h1 [ txt page_title ] :: h2 [ txt page_subtitle ] :: content) 35 | ; footer 36 | [ div 37 | [ span [ txt "Proudly powered by" ] 38 | ; br () 39 | ; a_of 40 | Shared.Endpoint.External.ocaml_org 41 | [ img_of Shared.Endpoint.External.ocaml_logo ] 42 | ] 43 | ] 44 | ] 45 | |> Format.asprintf "%a" (Tyxml.Html.pp ()) 46 | |> Dream.html 47 | ;; 48 | -------------------------------------------------------------------------------- /lib/service/handler.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A Handler is just a function that takes a request and returns a response 24 | (wrapped in a promise [Lwt.t]). *) 25 | 26 | (** {1 Types} *) 27 | 28 | type ('request, 'response) t = 'request -> 'response Lwt.t 29 | -------------------------------------------------------------------------------- /test/service_test/method_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The presence of an [mli] file may seem a bit excessive, but it is mainly to 24 | quickly identify unused tests. *) 25 | 26 | (** List of all test-cases. *) 27 | val cases : string * unit Alcotest.test_case list 28 | -------------------------------------------------------------------------------- /test/service_test/parser_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The presence of an [mli] file may seem a bit excessive, but it is mainly to 24 | quickly identify unused tests. *) 25 | 26 | (** List of all test-cases. *) 27 | val cases : string * unit Alcotest.test_case list 28 | -------------------------------------------------------------------------------- /test/service_test/path_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The presence of an [mli] file may seem a bit excessive, but it is mainly to 24 | quickly identify unused tests. *) 25 | 26 | (** List of all test-cases. *) 27 | val cases : string * unit Alcotest.test_case list 28 | -------------------------------------------------------------------------------- /test/service_test/service_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The presence of an [mli] file may seem a bit excessive, but it is mainly to 24 | quickly identify unused tests. *) 25 | 26 | (** List of all test-cases. *) 27 | val cases : string * unit Alcotest.test_case list 28 | -------------------------------------------------------------------------------- /test/tyxml_test/element_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The presence of an [mli] file may seem a bit excessive, but it is mainly to 24 | quickly identify unused tests. *) 25 | 26 | (** List of all test-cases. *) 27 | val cases : string * unit Alcotest.test_case list 28 | -------------------------------------------------------------------------------- /test/service_test/endpoint_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The presence of an [mli] file may seem a bit excessive, but it is mainly to 24 | quickly identify unused tests. *) 25 | 26 | (** List of all test-cases. *) 27 | val cases : string * unit Alcotest.test_case list 28 | -------------------------------------------------------------------------------- /test/service_test/nightmare_service_test.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | let () = 24 | Alcotest.run 25 | "Nightmare_service" 26 | [ Parser_test.cases 27 | ; Path_test.cases 28 | ; Method_test.cases 29 | ; Endpoint_test.cases 30 | ; Service_test.cases 31 | ] 32 | ;; 33 | -------------------------------------------------------------------------------- /lib/dream/redirect.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | let run ?status ?code ?headers ?anchor ?parameters endpoint = 24 | Nightmare_service.Endpoint.href_with 25 | ?anchor 26 | ?parameters 27 | endpoint 28 | (fun target request -> Dream.redirect ?status ?code ?headers request target) 29 | ;; 30 | -------------------------------------------------------------------------------- /lib/service/middleware.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type ('request, 'response) t = 24 | ('request, 'response) Handler.t -> ('request, 'response) Handler.t 25 | 26 | let fold middlewares handler = 27 | let rec aux = function 28 | | [] -> handler 29 | | x :: xs -> x (aux xs) 30 | in 31 | aux middlewares 32 | ;; 33 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all test build clean check-lint lint doc utop example 2 | 3 | all: build 4 | 5 | # [make build] (or [make]) will build the source 6 | build: 7 | dune build 8 | 9 | # [make test] run all test 10 | test: 11 | dune runtest --no-buffer -j 1 12 | 13 | # [make clean] remove build artifacts (essentially the 14 | # "_build/" folder) 15 | clean: 16 | dune clean 17 | 18 | # [make doc] build the documentation (using odoc) 19 | doc: build 20 | dune build @doc 21 | 22 | # [make utop] launch an REPL with the whole package in 23 | # the context 24 | utop: 25 | dune utop 26 | 27 | # [make check-lint] ensure that the code is properly formatted 28 | # according to the ".ocamlformat" file 29 | check-lint: 30 | dune build @fmt 31 | 32 | # [make lint] apply formatting according to the ".ocamlformat" file 33 | lint: 34 | dune build @fmt --auto-promote 35 | 36 | 37 | 38 | # Setting up the development environment 39 | 40 | .PHONY: dev-deps deps 41 | 42 | # [make dev-deps] will download locally the dependencies needed 43 | # to develop the project. Mainly formatting features, and IDE support. 44 | dev-deps: 45 | opam install dune merlin ocamlformat ocp-indent utop -y 46 | 47 | 48 | # [make deps] will download locally the dependencies needed 49 | # to build the libraries. That is, all the dependencies referenced 50 | # in the OPAM description files. 51 | deps: 52 | opam install . --deps-only --with-doc --with-test -y 53 | 54 | # Example 55 | 56 | example: 57 | dune build examples/frontend/main.bc.js 58 | dune exec examples/backend/main.exe 59 | -------------------------------------------------------------------------------- /lib/js/aliases.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Some common and recurring type aliases. *) 24 | 25 | (** A value wrapped as a JavaScript value. *) 26 | type 'a js = 'a Js_of_ocaml.Js.t 27 | 28 | (** An alias over [Js.Opt.t]. *) 29 | type +'a or_null = 'a Js_of_ocaml.Js.opt 30 | 31 | (** An alias over [Js.Optdef.t]. *) 32 | type +'a or_undefined = 'a Js_of_ocaml.Js.optdef 33 | -------------------------------------------------------------------------------- /lib/js/optional.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Concrete implementations of [Optional]. *) 24 | 25 | open Aliases 26 | 27 | (** Uniformity of [Option] in terms of [Optional]. *) 28 | module Option : Interfaces.OPTIONAL with type 'a t = 'a option 29 | 30 | (** Uniformity of [Nullable] in terms of [Optional]. *) 31 | module Nullable : Interfaces.OPTIONAL with type 'a t = 'a or_null 32 | 33 | (** Uniformity of [Undefinable] in terms of [Optional]. *) 34 | module Undefinable : Interfaces.OPTIONAL with type 'a t = 'a or_undefined 35 | -------------------------------------------------------------------------------- /lib/service/middleware.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A Middleware is just a function that takes {!type:Handler.t}, perform some 24 | code and return {!type:Handler.t}. *) 25 | 26 | (** {1 Types} *) 27 | 28 | (** A type that describe a middleware. *) 29 | type ('request, 'response) t = 30 | ('request, 'response) Handler.t -> ('request, 'response) Handler.t 31 | 32 | (** {1 Helpers over middleware} *) 33 | 34 | (** Reduce a list of {!type:t} into once. *) 35 | val fold : ('request, 'response) t list -> ('request, 'response) t 36 | -------------------------------------------------------------------------------- /lib/js/nightmare_js.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | module Aliases = Aliases 24 | include Aliases 25 | module Optional = Optional 26 | module Option = Optional.Option 27 | module Nullable = Optional.Nullable 28 | module Undefinable = Optional.Undefinable 29 | module Console = Console 30 | module Storage = Storage 31 | module Suspension = Suspension 32 | module Promise = Promise 33 | module Stream = Stream 34 | module Headers = Headers 35 | module Blob = Blob 36 | module Form_data = Form_data 37 | module Url_search_params = Url_search_params 38 | module Fetch = Fetch 39 | -------------------------------------------------------------------------------- /lib/dream/router.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | let run ~services fallback request = 24 | let given_uri = Dream.target request 25 | and given_method = Dream.method_ request in 26 | match given_method with 27 | | `Method _ -> fallback request 28 | | ( `GET 29 | | `POST 30 | | `PUT 31 | | `DELETE 32 | | `HEAD 33 | | `CONNECT 34 | | `OPTIONS 35 | | `TRACE 36 | | `PATCH ) as given_method -> 37 | Nightmare_service.Service.choose 38 | ~given_method 39 | ~given_uri 40 | ~services 41 | fallback 42 | request 43 | ;; 44 | -------------------------------------------------------------------------------- /lib/service/signatures.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Description of a module describing a type that can be interpreted as a 24 | fragment of {!type: Path.t} *) 25 | module type PATH_FRAGMENT = sig 26 | (**The type of fragment. *) 27 | type t 28 | 29 | (** A label, or name, to describe the path fragment. *) 30 | val fragment_name : string 31 | 32 | (** A function to read a string as a path fragment. *) 33 | val fragment_from_string : string -> t option 34 | 35 | (** A function to project a string into a path fragment. *) 36 | val fragment_to_string : t -> string 37 | end 38 | -------------------------------------------------------------------------------- /lib/dream/nightmare_dream.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type request = Dream.request 24 | type response = Dream.response 25 | type service = (request, response) Nightmare_service.service 26 | type handler = (request, response) Nightmare_service.handler 27 | type middleware = (request, response) Nightmare_service.middleware 28 | 29 | let router ~services fallback request = Router.run ~services fallback request 30 | 31 | let redirect_to ?status ?code ?headers ?anchor ?parameters endpoint = 32 | Redirect.run ?status ?code ?headers ?anchor ?parameters endpoint 33 | ;; 34 | 35 | module Router = Router 36 | module Redirect = Redirect 37 | -------------------------------------------------------------------------------- /lib/js/util.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | 25 | let from_array_to_js_array f caml_array = 26 | let js_array = new%js Js.array_empty in 27 | let () = 28 | Array.iter 29 | (fun elt -> 30 | let new_elt = f elt in 31 | ignore (js_array##push new_elt)) 32 | caml_array 33 | in 34 | js_array 35 | ;; 36 | 37 | let from_list_to_js_array f caml_list = 38 | let js_array = new%js Js.array_empty in 39 | let () = 40 | List.iter 41 | (fun elt -> 42 | let new_elt = f elt in 43 | ignore (js_array##push new_elt)) 44 | caml_list 45 | in 46 | js_array 47 | ;; 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Nightmare 2 | 3 | > **Warning** _Nightmare_ is still _Work In Progress_. 4 | 5 | A set of components that fit, in theory, relatively well with the web framework 6 | ([OCaml](https://ocaml.org)) [Dream](https://aantron.github.io/dream/) to try to 7 | build quickly and as best as possible dynamic web applications. 8 | 9 | **Nightmare** was very much inspired by the development of 10 | [Muhokama](https://github.com/xvw/muhokama/), a forum written in 11 | [OCaml](https://ocaml.org) which had many of its components imported 12 | directly into **Nightmare**. The set of ideas implemented in this "adhoc 13 | framework" comes from different sources of inspiration which we will try to list 14 | meticulously in an appropriate section. 15 | 16 | Even though the framework is intended to be as agnostic as possible, it has been 17 | designed to blend in naturally with [Dream](https://aantron.github.io/dream/), 18 | hence the library's name. 19 | 20 | ## Setting up the development environment 21 | 22 | Setting up a development environment is quite straightforward. We recommend setting 23 | up a local switch to collect dependencies locally. Here are the commands to enter 24 | to initialize the environment: 25 | 26 | ```shellsession 27 | opam update 28 | opam switch create . ocaml-base-compiler.5.0.0 --deps-only -y 29 | eval $(opam env) 30 | ``` 31 | 32 | After initializing the switch, you can collect the development and project 33 | dependencies using `make`: 34 | 35 | ```shellsession 36 | make dev-deps 37 | make deps 38 | ``` 39 | 40 | Now you should be able to easily start contributing to **Nightmare**. 41 | 42 | > **Note** If you are not using [GNU/Make](https://www.gnu.org/software/make/) 43 | > (or equivalent), you can refer to the [Makefile](Makefile) and observe the 44 | > `dev-deps` and `deps` rules to get the commands to run. 45 | -------------------------------------------------------------------------------- /lib/js/util.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Some internal tools to facilitate development. *) 24 | 25 | open Aliases 26 | open Js_of_ocaml 27 | open Js 28 | 29 | (** {2 Some internal tools to facilitate development} *) 30 | 31 | (** [from_array_to_js_array f x] will transforms the OCaml array [x], applying 32 | [f] on each element, to a JavaScript one. *) 33 | val from_array_to_js_array : ('a -> 'b) -> 'a array -> 'b js_array js 34 | 35 | (** [from_list_to_js_array f x] will transforms the OCaml List [x], applying [f] 36 | on each element, to a JavaScript one. *) 37 | val from_list_to_js_array : ('a -> 'b) -> 'a list -> 'b js_array js 38 | -------------------------------------------------------------------------------- /lib/js/headers.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A very simple binding of HTTP headers in JavaScript (mainly implemented to 24 | build the [fetch] function). *) 25 | 26 | open Js_of_ocaml 27 | 28 | (** {1 Types} *) 29 | 30 | type t = Bindings.http_headers Js.t 31 | 32 | (** {1 Constructing Headers object} *) 33 | 34 | (** [make key_value_list] build a new [Headers] object. *) 35 | val make : (string * string) list -> t 36 | 37 | (** {1 Acting on headers} *) 38 | 39 | val append : t -> key:string -> value:string -> t 40 | val delete : t -> key:string -> t 41 | val set : t -> key:string -> value:string -> t 42 | val get : t -> key:string -> string option 43 | val has : t -> key:string -> bool 44 | -------------------------------------------------------------------------------- /lib/js/blob.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The Blob object represents a blob, which is a file-like object of immutable, 24 | raw data; they can be read as text or binary data, or converted into a 25 | ReadableStream so its methods can be used for processing the data. *) 26 | 27 | open Js_of_ocaml 28 | 29 | type t = Bindings.blob Js.t 30 | 31 | val size : t -> int 32 | val content_type : t -> string 33 | val array_buffer : t -> Typed_array.arrayBuffer Js.t Lwt.t 34 | val slice : ?content_type:string -> start:int -> stop:int -> t -> t 35 | val stream : t -> Typed_array.uint8Array Js.t Stream.Readable.t 36 | val text : t -> string Lwt.t 37 | val make : ?content_type:string -> string list -> t 38 | -------------------------------------------------------------------------------- /lib/js/form_data.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The [Form_data] interface provides a way to construct a set of key/value 24 | pairs representing form fields and their values). *) 25 | 26 | open Js_of_ocaml 27 | 28 | (** {1 Types} *) 29 | 30 | type t = Bindings.form_data Js.t 31 | 32 | (** {1 Constructing Form_data object} *) 33 | 34 | (** [make key_value_list] build a new [Form_data] object. *) 35 | val make : (string * string) list -> t 36 | 37 | (** {1 Acting on Form_data} *) 38 | 39 | val append : t -> key:string -> value:string -> t 40 | val delete : t -> key:string -> t 41 | val set : t -> key:string -> value:string -> t 42 | val get : t -> key:string -> string option 43 | val get_all : t -> key:string -> string list 44 | val has : t -> key:string -> bool 45 | -------------------------------------------------------------------------------- /test/service_test/method_test.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Nightmare_test 24 | 25 | let method_testable = 26 | let open Nightmare_service in 27 | Alcotest.testable Method.pp Method.equal 28 | ;; 29 | 30 | let test_to_string_from_string = 31 | test_equality 32 | ~about:"to_string & from_string" 33 | ~desc: 34 | "[to_string] should returns valid string and [from_string] should return \ 35 | valid method wrapped in [Some]" 36 | Alcotest.(list @@ option method_testable) 37 | (fun () -> 38 | let open Nightmare_service.Method in 39 | let expected = List.map Option.some all 40 | and computed = List.map (fun meth -> from_string @@ to_string meth) all in 41 | expected, computed) 42 | ;; 43 | 44 | let cases = "Method", [ test_to_string_from_string ] 45 | -------------------------------------------------------------------------------- /lib/js/url_search_params.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The [Url_search_params] interface defines utility methods to work with the 24 | query string of a URL. *) 25 | 26 | open Js_of_ocaml 27 | 28 | (** {1 Types} *) 29 | 30 | type t = Bindings.url_search_params Js.t 31 | 32 | (** {1 Constructing Url Search Params object} *) 33 | 34 | (** [make query_string] build a new [Url Search Params] object. *) 35 | val make : string -> t 36 | 37 | (** {1 Acting on Url Search Params} *) 38 | 39 | val append : t -> key:string -> value:string -> t 40 | val delete : t -> key:string -> t 41 | val set : t -> key:string -> value:string -> t 42 | val get : t -> key:string -> string option 43 | val get_all : t -> key:string -> string list 44 | val has : t -> key:string -> bool 45 | val to_string : t -> string 46 | val sort : t -> t 47 | -------------------------------------------------------------------------------- /lib/js/suspension.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | 25 | let start f = 26 | let open Lwt.Syntax in 27 | let* _ = Js_of_ocaml_lwt.Lwt_js_events.onload () in 28 | let+ () = f () in 29 | () 30 | ;; 31 | 32 | let context = 33 | object%js (self) 34 | val nightmare_internal = 35 | object%js 36 | val suspending = Js.array [||] 37 | end 38 | 39 | method suspend f = self##.nightmare_internal##.suspending##push f |> ignore 40 | 41 | method mount = 42 | let suspension = 43 | self##.nightmare_internal##.suspending 44 | |> Js.to_array 45 | |> Array.fold_left 46 | (fun chain task () -> 47 | let open Lwt.Syntax in 48 | let+ () = chain () in 49 | Js.Unsafe.fun_call task [||]) 50 | (fun () -> Lwt.return_unit) 51 | in 52 | start suspension 53 | end 54 | ;; 55 | 56 | let allow () = Js.export "nightmare_js" context 57 | -------------------------------------------------------------------------------- /lib/test/nightmare_test.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | let test ?(speed = `Quick) ~about ~desc a_test = 24 | let title = Format.asprintf "%-42s%s" about desc in 25 | Alcotest.test_case title speed a_test 26 | ;; 27 | 28 | let test_lwt ?(speed = `Quick) ~about ~desc a_test = 29 | test ~speed ~about ~desc (fun () -> Lwt_main.run (a_test ())) 30 | ;; 31 | 32 | let same testable ~expected ~computed = 33 | Alcotest.check testable "should be same" expected computed 34 | ;; 35 | 36 | let test_equality ?(speed = `Quick) ~about ~desc testable a_test = 37 | test ~speed ~about ~desc (fun () -> 38 | let expected, computed = a_test () in 39 | same testable ~expected ~computed) 40 | ;; 41 | 42 | let test_equality_lwt ?(speed = `Quick) ~about ~desc testable a_test = 43 | test ~speed ~about ~desc (fun () -> 44 | let expected, computed = Lwt_main.run (a_test ()) in 45 | same testable ~expected ~computed) 46 | ;; 47 | 48 | module Dummy_request = Dummy_request 49 | -------------------------------------------------------------------------------- /lib/service/nightmare_service.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type method_ = Method.t 24 | type ('continuation, 'witness) path = ('continuation, 'witness) Path.t 25 | 26 | type ('continuation, 'witness) wrapped_path = 27 | ('continuation, 'witness) Path.wrapped 28 | 29 | type ('scope, 'method_, 'continuation, 'witness) endpoint = 30 | ('scope, 'method_, 'continuation, 'witness) Endpoint.t 31 | 32 | type ('scope, 'method_, 'continuation, 'witness) wrapped_endpoint = 33 | ('scope, 'method_, 'continuation, 'witness) Endpoint.wrapped 34 | 35 | type ('request, 'response) handler = ('request, 'response) Handler.t 36 | type ('request, 'response) middleware = ('request, 'response) Middleware.t 37 | type ('request, 'response) service = ('request, 'response) Service.t 38 | 39 | module Path = Path 40 | module Endpoint = Endpoint 41 | module Parser = Parser 42 | module Method = Method 43 | module Handler = Handler 44 | module Middleware = Middleware 45 | module Service = Service 46 | module Signatures = Signatures 47 | -------------------------------------------------------------------------------- /lib/js/blob.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | 25 | type t = Bindings.blob Js.t 26 | 27 | let size b = b##.size 28 | let content_type b = b##._type |> Js.to_string 29 | let array_buffer b = b##arrayBuffer |> Promise.as_lwt 30 | 31 | let slice ?content_type ~start ~stop b = 32 | let open Optional.Option in 33 | let content_type = Js.string <$> content_type |> to_optdef in 34 | b##slice start stop content_type 35 | ;; 36 | 37 | let stream b = b##stream 38 | 39 | let text b = 40 | let open Lwt.Syntax in 41 | let+ tarr = b##text |> Promise.as_lwt in 42 | Js.to_string tarr 43 | ;; 44 | 45 | let constr = Js.Unsafe.global##._Blob 46 | 47 | let make ?content_type values = 48 | let open Optional.Option in 49 | let content_type = 50 | (fun ct -> 51 | object%js 52 | val _type = Js.string ct 53 | end) 54 | <$> content_type 55 | |> to_optdef 56 | in 57 | let values = Util.from_list_to_js_array Js.string values in 58 | new%js constr values content_type 59 | ;; 60 | -------------------------------------------------------------------------------- /lib/js/stream.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** JavaScript's usual stream binding. *) 24 | 25 | open Js_of_ocaml 26 | 27 | module Reader : sig 28 | (** A [Reader] represents a default reader that can be used to read stream 29 | data supplied from a network (such as a fetch request). *) 30 | 31 | type 'a t = 'a Bindings.readable_stream_default_reader Js.t 32 | 33 | val is_closed : 'a t -> bool 34 | val cancel : ?reason:string -> 'a t -> unit Lwt.t 35 | val close : 'a t -> unit Lwt.t 36 | val read : 'a t -> (bool * 'a) Lwt.t 37 | val read_string : 'a t -> (bool * string) Lwt.t 38 | val release_lock : 'a t -> unit 39 | end 40 | 41 | module Readable : sig 42 | (** The ReadableStream interface of the Streams API represents a readable 43 | stream of byte data. The Fetch API offers a concrete instance of a 44 | ReadableStream through the body property of a Response object. *) 45 | 46 | type 'a t = 'a Bindings.readable_stream Js.t 47 | 48 | val is_locked : 'a t -> bool 49 | val cancel : ?reason:string -> 'a t -> unit Lwt.t 50 | val get_reader : 'a t -> 'a Reader.t 51 | end 52 | -------------------------------------------------------------------------------- /lib/js/headers.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | open Optional 25 | 26 | type t = Bindings.http_headers Js.t 27 | 28 | let constr : (unit -> t) Js.constr = Js.Unsafe.global##._Headers 29 | 30 | let append headers ~key ~value = 31 | let key = Js.string key 32 | and value = Js.string value in 33 | let () = headers##append key value in 34 | headers 35 | ;; 36 | 37 | let delete headers ~key = 38 | let key = Js.string key in 39 | let () = headers##delete key in 40 | headers 41 | ;; 42 | 43 | let get headers ~key = 44 | let key = Js.string key in 45 | let open Nullable in 46 | Js.to_string <$> headers##get key |> to_option 47 | ;; 48 | 49 | let has headers ~key = 50 | let key = Js.string key in 51 | headers##has key |> Js.to_bool 52 | ;; 53 | 54 | let set headers ~key ~value = 55 | let key = Js.string key 56 | and value = Js.string value in 57 | let () = headers##set key value in 58 | headers 59 | ;; 60 | 61 | let make args = 62 | let headers = new%js constr () in 63 | List.fold_left 64 | (fun headers (key, value) -> append headers ~key ~value) 65 | headers 66 | args 67 | ;; 68 | -------------------------------------------------------------------------------- /lib/js/nightmare_js.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** [Nightmare_js] provides an API for working with the web browser (via 24 | [Js_of_ocaml]) and tries to provide bindings missing from the standard 25 | [Js_of_ocaml] library. *) 26 | 27 | (** {1 Types} 28 | 29 | Some common type aliases to simplify function signatures. *) 30 | 31 | (**/**) 32 | 33 | module Aliases = Aliases 34 | 35 | (**/**) 36 | 37 | include module type of Aliases (** @inline *) 38 | 39 | (** {2 Optional values} *) 40 | 41 | module Optional = Optional 42 | module Option = Optional.Option 43 | module Nullable = Optional.Nullable 44 | module Undefinable = Optional.Undefinable 45 | 46 | (** {2 Promise} *) 47 | 48 | module Promise = Promise 49 | 50 | (** {2 Streaming} *) 51 | 52 | module Stream = Stream 53 | 54 | (** {2 Http} *) 55 | 56 | module Headers = Headers 57 | module Blob = Blob 58 | module Form_data = Form_data 59 | module Url_search_params = Url_search_params 60 | module Fetch = Fetch 61 | 62 | (** {2 Web Storage API} *) 63 | 64 | module Storage = Storage 65 | 66 | (** {1 Utils} *) 67 | 68 | module Console = Console 69 | module Suspension = Suspension 70 | -------------------------------------------------------------------------------- /examples/backend/service.ml: -------------------------------------------------------------------------------- 1 | open Nightmare_service.Service 2 | 3 | type t = Nightmare_dream.service 4 | 5 | let home : t = straight ~endpoint:Shared.Endpoint.home Page.home 6 | 7 | module Simple_routing = struct 8 | let home : t = 9 | straight 10 | ~endpoint:Shared.Endpoint.Simple_routing.home 11 | Page.Simple_routing.home 12 | ;; 13 | 14 | let about : t = 15 | straight 16 | ~endpoint:Shared.Endpoint.Simple_routing.about 17 | Page.Simple_routing.about 18 | ;; 19 | 20 | let hello : t = 21 | straight 22 | ~endpoint:Shared.Endpoint.Simple_routing.hello 23 | Page.Simple_routing.hello 24 | ;; 25 | end 26 | 27 | module Counter_vdom = struct 28 | let home : t = 29 | straight ~endpoint:Shared.Endpoint.Counter_vdom.home Page.Counter_vdom.home 30 | ;; 31 | 32 | let about : t = 33 | straight 34 | ~endpoint:Shared.Endpoint.Counter_vdom.about 35 | Page.Counter_vdom.about 36 | ;; 37 | end 38 | 39 | module Server_side_counter = struct 40 | let session_key = "ssc-current-value" 41 | 42 | let home : t = 43 | straight 44 | ~endpoint:Shared.Endpoint.Server_side_counter.home 45 | Page.Server_side_counter.home 46 | ;; 47 | 48 | let about : t = 49 | straight 50 | ~endpoint:Shared.Endpoint.Server_side_counter.about 51 | Page.Server_side_counter.about 52 | ;; 53 | 54 | let value : t = 55 | straight ~endpoint:Shared.Endpoint.Server_side_counter.value (fun request -> 56 | Dream.respond 57 | @@ 58 | match Dream.session_field request session_key with 59 | | Some x -> x 60 | | None -> "0") 61 | ;; 62 | 63 | let operation f request = 64 | let value = 65 | Dream.session_field request session_key 66 | |> fun x -> Option.bind x int_of_string_opt 67 | in 68 | let value = f @@ Option.value ~default:0 value |> string_of_int in 69 | let open Lwt.Syntax in 70 | let* () = Dream.set_session_field request session_key value in 71 | Dream.respond "done" 72 | ;; 73 | 74 | let increment : t = 75 | straight 76 | ~endpoint:Shared.Endpoint.Server_side_counter.increment 77 | (operation succ) 78 | ;; 79 | 80 | let decrement : t = 81 | straight 82 | ~endpoint:Shared.Endpoint.Server_side_counter.decrement 83 | (operation pred) 84 | ;; 85 | end 86 | -------------------------------------------------------------------------------- /lib/dream/router.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Defines a [Middleware] compatible with [Dream] (and thus [Dream.run] which 24 | routes a request to a given list of services. 25 | 26 | It can, for example, be used in this way: 27 | 28 | {[ 29 | let services = [ my_first_service; my_second_service; my_third_service ] 30 | 31 | let start ?(interface = "0.0.0.0") ~port () = 32 | Dream.run ~port ~interface 33 | @@ Dream.logger 34 | @@ Dream.sql_pool "sqlite3:db.sqlite" 35 | @@ Dream.sql_sessions 36 | @@ Dream.flash 37 | @@ Nightmare_dream.Router.run ~services 38 | @@ Dream.not_found 39 | ;; 40 | ]} 41 | 42 | Since [Router.run] is [Middleware] (in the sense of [Dream]), not finding a 43 | candidate route allows a fallback, for example [Dream.not_found]. *) 44 | 45 | (** [run ~services fallback request] defines a [Middleware] that tries to match 46 | a route, and relays on [fallback] if no route is candidate. *) 47 | val run 48 | : services:(Dream.request, Dream.response) Nightmare_service.service list 49 | -> (Dream.request, Dream.response) Nightmare_service.middleware 50 | -------------------------------------------------------------------------------- /examples/frontend/counter_vdom.ml: -------------------------------------------------------------------------------- 1 | type model = int 2 | type 'msg Vdom.Cmd.t += Delayed of 'msg 3 | 4 | let register () = 5 | let open Vdom_blit in 6 | let handler = 7 | { Cmd.f = 8 | (fun ctx -> function 9 | | Delayed message -> 10 | let () = 11 | Lwt.async (fun () -> 12 | let open Lwt.Syntax in 13 | let+ () = Nightmare_js.Promise.(set_timeout 3000 |> as_lwt) in 14 | Cmd.send_msg ctx message) 15 | in 16 | true 17 | | _ -> false) 18 | } 19 | in 20 | register @@ cmd handler 21 | ;; 22 | 23 | type message = 24 | | Increment 25 | | Decrement 26 | | Ask_for_delayed_increment 27 | | Ask_for_delayed_decrement 28 | 29 | let update (_, value) = function 30 | | Increment -> Vdom.return @@ (false, value + 1) 31 | | Decrement -> Vdom.return @@ (false, value - 1) 32 | | Ask_for_delayed_increment -> 33 | Vdom.return ~c:[ Delayed Increment ] (true, value) 34 | | Ask_for_delayed_decrement -> 35 | Vdom.return ~c:[ Delayed Decrement ] (true, value) 36 | ;; 37 | 38 | let view (is_disabled, value) = 39 | let open Nightmare_js_vdom in 40 | div 41 | ~a:[ a_class [ "counter-application" ] ] 42 | [ span 43 | [ button 44 | ~a: 45 | [ a_disabled is_disabled 46 | ; on_click (fun _ -> Ask_for_delayed_decrement) 47 | ] 48 | [ txt "- slow" ] 49 | ] 50 | ; span 51 | [ button 52 | ~a:[ a_disabled is_disabled; on_click (fun _ -> Decrement) ] 53 | [ txt "-" ] 54 | ] 55 | ; samp 56 | [ (txt 57 | @@ 58 | if is_disabled 59 | then "This is a voluntary slow action" 60 | else string_of_int value) 61 | ] 62 | ; span 63 | [ button 64 | ~a:[ a_disabled is_disabled; on_click (fun _ -> Increment) ] 65 | [ txt "+" ] 66 | ] 67 | ; span 68 | [ button 69 | ~a: 70 | [ a_disabled is_disabled 71 | ; on_click (fun _ -> Ask_for_delayed_increment) 72 | ] 73 | [ txt "+ slow" ] 74 | ] 75 | ] 76 | ;; 77 | 78 | let init = Vdom.return (false, 0) 79 | 80 | let app () = 81 | let () = register () in 82 | Nightmare_js_vdom.app ~init ~update ~view () 83 | ;; 84 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | 3 | ;; Project configuration 4 | (name nightmare) 5 | (generate_opam_files true) 6 | 7 | ;; Project description 8 | (source (github funkywork/nightmare)) 9 | (license MIT) 10 | (authors "Funkywork") 11 | (maintainers "Funkywork") 12 | 13 | ;; Packages description 14 | 15 | (package 16 | (name nightmare-test) 17 | (synopsis "Test utilities for Nightmare") 18 | (description "Some shortcuts for writting test for a Nightmare application (or library)") 19 | (depends 20 | (ocaml (>= 5.0.0)) 21 | (lwt (>= 5.6.1)) 22 | alcotest)) 23 | 24 | (package 25 | (name nightmare) 26 | (synopsis "An ad-hoc framework for writing web application using OCaml") 27 | (description "An ad-hoc framework (that should fit well with Dream) for writting OCaml web application") 28 | (depends 29 | (ocaml (>= 5.0.0)) 30 | (lwt (>= 5.6.1)) 31 | (preface (>= 1.0.0)) 32 | (alcotest :with-test) 33 | (nightmare-test (and (= :version) :with-test)))) 34 | 35 | (package 36 | (name nightmare-dream) 37 | (synopsis "Glue between Nightmare and Dream") 38 | (description "An overlay built on top of Dream for using Nightmare tools") 39 | (depends 40 | (ocaml (>= 5.0.0)) 41 | (dream (>= 1.0.0~alpha5)) 42 | (nightmare (= :version)))) 43 | 44 | (package 45 | (name nightmare-tyxml) 46 | (synopsis "Glue between Nightmare and TyXML") 47 | (description "Facilitates interaction between Nightmare and TyXML") 48 | (depends 49 | (ocaml (>= 5.0.0)) 50 | (tyxml (>= 4.6.0)) 51 | (nightmare (= :version)))) 52 | 53 | (package 54 | (name nightmare_js) 55 | (synopsis "The JavaScript Runtime for Nightmare JS Application") 56 | (description "A list of helpers to deal with Nightmare inside a Js_of_ocaml application") 57 | (depends 58 | (ocaml (>= 5.0.0)) 59 | (lwt (>= 5.6.1)) 60 | (preface (>= 1.0.0)) 61 | (js_of_ocaml-compiler (>= 5.6.0)) 62 | (js_of_ocaml-ppx (>= 5.6.0)) 63 | (js_of_ocaml-lwt (>= 5.6.0)) 64 | (nightmare (= :version)))) 65 | 66 | (package 67 | (name nightmare_js-vdom) 68 | (synopsis "A companion library and glue for ocaml-vdom and Nightmare") 69 | (description "Provides additional HTML tags and attributes for the ocaml-vdom library and adds support for Nightmare services") 70 | (depends 71 | (ocaml (>= 5.0.0)) 72 | (tyxml (>= 4.5.0)) 73 | (vdom (>= 0.3)) 74 | (nightmare-tyxml (= :version)) 75 | (nightmare_js (= :version)))) 76 | -------------------------------------------------------------------------------- /lib/js/form_data.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | open Optional 25 | 26 | type t = Bindings.form_data Js.t 27 | 28 | let constr : (unit -> t) Js.constr = Js.Unsafe.global##._FormData 29 | 30 | let append form_data ~key ~value = 31 | let key = Js.string key 32 | and value = Js.string value in 33 | let () = form_data##append key value in 34 | form_data 35 | ;; 36 | 37 | let delete form_data ~key = 38 | let key = Js.string key in 39 | let () = form_data##delete key in 40 | form_data 41 | ;; 42 | 43 | let get form_data ~key = 44 | let key = Js.string key in 45 | let open Nullable in 46 | Js.to_string <$> form_data##get key |> to_option 47 | ;; 48 | 49 | let get_all form_data ~key = 50 | let key = Js.string key in 51 | form_data##getAll key |> Js.to_array |> Array.to_list |> List.map Js.to_string 52 | ;; 53 | 54 | let has form_data ~key = 55 | let key = Js.string key in 56 | form_data##has key |> Js.to_bool 57 | ;; 58 | 59 | let set form_data ~key ~value = 60 | let key = Js.string key 61 | and value = Js.string value in 62 | let () = form_data##set key value in 63 | form_data 64 | ;; 65 | 66 | let make args = 67 | let form_data = new%js constr () in 68 | List.fold_left 69 | (fun form_data (key, value) -> append form_data ~key ~value) 70 | form_data 71 | args 72 | ;; 73 | -------------------------------------------------------------------------------- /lib/service/parser.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Some quickly written parsers to process data of different types. *) 24 | 25 | module Href : sig 26 | (** Allows you to extract different fragments of an internal URL (without the 27 | scheme and protocol) represented as the [href] parameter of a link. Either 28 | respecting the [fragments?query_string#anchor] schema. *) 29 | 30 | (** A parsed [href]. *) 31 | type t 32 | 33 | (** Builds an internal URL with an optional query string and an optional 34 | anchor. *) 35 | val make : ?query_string:string -> ?anchor:string -> string list -> t 36 | 37 | (** Return the [fragments] part of the [Href]. *) 38 | val fragments : t -> string list 39 | 40 | (** Return the [query_string] part of the [Href]. *) 41 | val query_string : t -> string option 42 | 43 | (** Return the [anchor] part of the [Href]. *) 44 | val anchor : t -> string option 45 | 46 | (** Produce a {{!type:t} Href.t} from a string. The function will never fail 47 | since if an internal URL is not valid, it will return an empty fragment 48 | and anchor and query string at None. *) 49 | val from_string : string -> t 50 | 51 | (** Equality between internal URL (mostly used for test). *) 52 | val equal : t -> t -> bool 53 | 54 | (** A pretty-printer (mostly used for test). *) 55 | val pp : Format.formatter -> t -> unit 56 | end 57 | -------------------------------------------------------------------------------- /lib/js/stream.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | 25 | module Reader = struct 26 | type 'a t = 'a Bindings.readable_stream_default_reader Js.t 27 | 28 | let is_closed r = r##.closed |> Js.to_bool 29 | 30 | let cancel ?reason r = 31 | let reason = Optional.Option.(Js.string <$> reason |> to_optdef) in 32 | r##cancel reason |> Promise.as_lwt 33 | ;; 34 | 35 | let close r = r##close |> Promise.as_lwt 36 | 37 | let read r = 38 | let open Lwt.Syntax in 39 | let+ result = r##read |> Promise.as_lwt in 40 | let is_done = result##._done |> Js.to_bool 41 | and value = result##.value in 42 | is_done, value 43 | ;; 44 | 45 | let new_decoder () = 46 | let constr = Js.Unsafe.global##._TextDecoder in 47 | new%js constr 48 | ;; 49 | 50 | let read_string r = 51 | let open Lwt.Syntax in 52 | let+ is_done, result = read r in 53 | let decoder = new_decoder () in 54 | let str_result = decoder##decode result in 55 | is_done, str_result |> Js.to_string 56 | ;; 57 | 58 | let release_lock r = r##releaseLock 59 | end 60 | 61 | module Readable = struct 62 | type 'a t = 'a Bindings.readable_stream Js.t 63 | 64 | let is_locked s = s##.locked |> Js.to_bool 65 | 66 | let cancel ?reason s = 67 | let reason = Optional.Option.(Js.string <$> reason |> to_optdef) in 68 | s##cancel reason |> Promise.as_lwt 69 | ;; 70 | 71 | let get_reader s = s##getReader 72 | end 73 | -------------------------------------------------------------------------------- /lib/js/suspension.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Suspensions allow a succession of tasks to be executed (in the form of 24 | promises) to be arbitrarily called in an HTML document. *) 25 | 26 | (** [allow ()] Exports the [nightmare_js] object for recording suspensions.*) 27 | val allow : unit -> unit 28 | 29 | (** {1 Basic idea} 30 | 31 | Suspensions allow the construction of sequentially executed JavaScript 32 | operations that will be executed once the DOM is fully loaded. For example, 33 | imagine this HTML document in which several [ 40 |

Hello World

41 | 44 | 45 | 46 | 47 | ]} 48 | 49 | Will be displayed in the development console: [3, 1, 2] because the 50 | [console.log(3)] is not suspended, so it does not wait for the DOM to be 51 | fully loaded. 52 | 53 | {1 When is it useful} 54 | 55 | Even if in the context of a classical application, suspensions may seem 56 | anecdotal, they can be very useful to invoke OCaml code exported from the 57 | DOM, for example to load several applications. *) 58 | -------------------------------------------------------------------------------- /lib/js/promise.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A Dead simple binding for promises. The purpose of this binding is 24 | essentially to be converted into a promise [Lwt] and should remain internal. *) 25 | 26 | (** The liaison is incredibly inspired by these different projects: 27 | 28 | - https://github.com/aantron/promise 29 | - https://github.com/dbuenzli/brr/blob/master/src/fut.ml#L6 30 | - https://github.com/mnxn/promise_jsoo 31 | 32 | But its reimplementation aims to be as simple as possible (and as 33 | comprehensible as possible to the project's maintainers). *) 34 | 35 | (** {1 Types} *) 36 | 37 | (** The type that describes a promise. *) 38 | type +'a t 39 | 40 | (** The type that describes an error. *) 41 | type error 42 | 43 | (** {1 Building promises} *) 44 | 45 | val pending_with_rejection : unit -> 'a t * ('a -> unit) * (error -> unit) 46 | val pending : unit -> 'a t * ('a -> unit) 47 | val resolved : 'a -> 'a t 48 | 49 | (** {1 Acting on promise} *) 50 | 51 | val then_ : ('a -> 'b t) -> 'a t -> 'b t 52 | val catch : (error -> 'a t) -> 'a t -> 'a t 53 | 54 | (** {1 Predefined promises} *) 55 | 56 | val set_timeout : int -> unit t 57 | 58 | (** {1 Lwt interop} *) 59 | 60 | val as_lwt : 'a t -> 'a Lwt.t 61 | 62 | (** {1 Interfaces} *) 63 | 64 | module Functor : Preface.Specs.FUNCTOR with type 'a t = 'a t 65 | module Applicative : Preface.Specs.APPLICATIVE with type 'a t = 'a t 66 | module Monad : Preface.Specs.MONAD with type 'a t = 'a t 67 | -------------------------------------------------------------------------------- /lib/vdom/nightmare_js_vdom.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | module Attrib = Attrib 24 | 25 | let app ~init ~update ~view () = 26 | Vdom.app 27 | ~init 28 | ~update 29 | ~view:(fun model -> view model |> Node.remove_node_kind) 30 | () 31 | ;; 32 | 33 | let simple_app ~init ~update ~view () = 34 | Vdom.simple_app 35 | ~init 36 | ~update 37 | ~view:(fun model -> view model |> Node.remove_node_kind) 38 | () 39 | ;; 40 | 41 | let append_to 42 | ~id 43 | ?(not_found = 44 | fun ~id -> 45 | let message = "Unable to find the node #" ^ id in 46 | let () = Nightmare_js.Console.(string error) message in 47 | Lwt.return_unit) 48 | callback 49 | = 50 | let open Js_browser in 51 | match Document.get_element_by_id document id with 52 | | None -> not_found ~id 53 | | Some root -> 54 | let open Lwt.Syntax in 55 | let* app = callback root in 56 | let () = Vdom_blit.run app |> Vdom_blit.dom |> Element.append_child root in 57 | Lwt.return_unit 58 | ;; 59 | 60 | let mount_to ~id ?not_found callback = 61 | append_to ~id ?not_found (fun element -> 62 | let () = Js_browser.Element.remove_all_children element in 63 | callback element) 64 | ;; 65 | 66 | type ('a, 'msg) attrib = ('a, 'msg) Attrib.t 67 | type ('a, 'msg) node = ('a, 'msg) Node.t 68 | 69 | include (Node : module type of Node with type ('a, 'b) t := ('a, 'b) node) 70 | include Endpoint_node 71 | include (Attrib : module type of Attrib with type ('a, 'b) t := ('a, 'b) attrib) 72 | -------------------------------------------------------------------------------- /examples/priv/style.css: -------------------------------------------------------------------------------- 1 | *, 2 | *::before, 3 | *::after { 4 | box-sizing: border-box; 5 | } 6 | 7 | body { 8 | min-height: 100vh; 9 | display: flex; 10 | flex-direction: column; 11 | padding: 0; 12 | margin: 0; 13 | font-family: sans-serif; 14 | font-size: 1.2rem; 15 | font-weight: 400; 16 | line-height: 1.4; 17 | background-color: #fff; 18 | } 19 | 20 | header { 21 | background-color: #111; 22 | color: #fff; 23 | } 24 | 25 | header > nav, 26 | header > main { 27 | width: 100%; 28 | max-width: 800px; 29 | margin: auto; 30 | padding: 8px; 31 | } 32 | 33 | header > main { 34 | margin: 64px auto; 35 | } 36 | 37 | header > main > h1, 38 | header > main > h2 { 39 | margin: 0; 40 | text-align: center; 41 | } 42 | 43 | header > main > h1 { 44 | font-weight: 900; 45 | font-size: 220%; 46 | } 47 | 48 | header > main > h2 { 49 | font-weight: 300; 50 | font-size: 120%; 51 | } 52 | 53 | header > nav { 54 | border-top: 1px solid #2a2a2a; 55 | } 56 | 57 | header > nav:empty { 58 | display: none; 59 | } 60 | 61 | header > nav > ul { 62 | padding: 0; 63 | list-style: none; 64 | display: flex; 65 | flex-direction: row; 66 | } 67 | 68 | header > nav > ul:empty { 69 | display: none; 70 | } 71 | 72 | header > nav > ul > li { 73 | flex: 1; 74 | text-align: center; 75 | border-left: 1px solid #fff; 76 | } 77 | 78 | header > nav > ul > li:first-child { 79 | border: 0px solid transparent; 80 | } 81 | 82 | header > nav > ul > li > a { 83 | text-decoration: none; 84 | color: #fff; 85 | font-size: 110%; 86 | display: block; 87 | } 88 | 89 | footer { 90 | background-color: #fff; 91 | padding: 32px; 92 | } 93 | 94 | footer > div { 95 | width: 100%; 96 | max-width: 800px; 97 | margin: auto; 98 | } 99 | 100 | footer > div > span { 101 | font-weight: 700; 102 | } 103 | 104 | footer > div > a { 105 | text-decoration: none; 106 | } 107 | 108 | footer > div > a > img { 109 | width: 120px; 110 | } 111 | 112 | body > main { 113 | flex: 1; 114 | width: 100%; 115 | max-width: 800px; 116 | margin: 32px auto; 117 | padding: 12px; 118 | font-size: 88%; 119 | } 120 | 121 | body > main > h1, 122 | body > main > h2 { 123 | margin: 0; 124 | } 125 | 126 | body > main > h2 { 127 | font-weight: 300; 128 | margin-bottom: 64px; 129 | } 130 | 131 | @media all and (max-width: 640px) { 132 | header > nav > ul { 133 | display: flex; 134 | flex-direction: column; 135 | } 136 | 137 | header > nav > ul > li { 138 | border-left: 0px solid transparent; 139 | padding: 12px; 140 | border-top: 1px solid #2a2a2a; 141 | } 142 | } 143 | -------------------------------------------------------------------------------- /lib/js/url_search_params.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | open Optional 25 | 26 | type t = Bindings.url_search_params Js.t 27 | 28 | let constr : (Js.js_string Js.t -> t) Js.constr = 29 | Js.Unsafe.global##._URLSearchParams 30 | ;; 31 | 32 | let append url_search_params ~key ~value = 33 | let key = Js.string key 34 | and value = Js.string value in 35 | let () = url_search_params##append key value in 36 | url_search_params 37 | ;; 38 | 39 | let delete url_search_params ~key = 40 | let key = Js.string key in 41 | let () = url_search_params##delete key in 42 | url_search_params 43 | ;; 44 | 45 | let get url_search_params ~key = 46 | let key = Js.string key in 47 | let open Nullable in 48 | Js.to_string <$> url_search_params##get key |> to_option 49 | ;; 50 | 51 | let get_all url_search_params ~key = 52 | let key = Js.string key in 53 | url_search_params##getAll key 54 | |> Js.to_array 55 | |> Array.to_list 56 | |> List.map Js.to_string 57 | ;; 58 | 59 | let has url_search_params ~key = 60 | let key = Js.string key in 61 | url_search_params##has key |> Js.to_bool 62 | ;; 63 | 64 | let set url_search_params ~key ~value = 65 | let key = Js.string key 66 | and value = Js.string value in 67 | let () = url_search_params##set key value in 68 | url_search_params 69 | ;; 70 | 71 | let make query_string = new%js constr (Js.string query_string) 72 | 73 | let sort url_search_params = 74 | let () = url_search_params##sort in 75 | url_search_params 76 | ;; 77 | 78 | let to_string url_search_params = url_search_params##toString |> Js.to_string 79 | -------------------------------------------------------------------------------- /lib/service/method.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type t = 24 | [ `GET 25 | | `POST 26 | | `PUT 27 | | `DELETE 28 | | `HEAD 29 | | `CONNECT 30 | | `OPTIONS 31 | | `TRACE 32 | | `PATCH 33 | ] 34 | 35 | type for_link = [ `GET ] 36 | 37 | type for_form_action = 38 | [ `GET 39 | | `POST 40 | ] 41 | 42 | let equal a b = 43 | match (a :> t), (b :> t) with 44 | | `GET, `GET -> true 45 | | `POST, `POST -> true 46 | | `PUT, `PUT -> true 47 | | `DELETE, `DELETE -> true 48 | | `HEAD, `HEAD -> true 49 | | `CONNECT, `CONNECT -> true 50 | | `OPTIONS, `OPTIONS -> true 51 | | `TRACE, `TRACE -> true 52 | | `PATCH, `PATCH -> true 53 | | _, _ -> false 54 | ;; 55 | 56 | let pp ppf = function 57 | | `GET -> Format.fprintf ppf "GET" 58 | | `POST -> Format.fprintf ppf "POST" 59 | | `PUT -> Format.fprintf ppf "PUT" 60 | | `DELETE -> Format.fprintf ppf "DELETE" 61 | | `HEAD -> Format.fprintf ppf "HEAD" 62 | | `CONNECT -> Format.fprintf ppf "CONNECT" 63 | | `OPTIONS -> Format.fprintf ppf "OPTIONS" 64 | | `TRACE -> Format.fprintf ppf "TRACE" 65 | | `PATCH -> Format.fprintf ppf "PATCH" 66 | ;; 67 | 68 | let to_string x = Format.asprintf "%a" pp x 69 | 70 | let from_string str = 71 | match String.(trim @@ lowercase_ascii str) with 72 | | "get" -> Some (`GET :> t) 73 | | "post" -> Some `POST 74 | | "put" -> Some `PUT 75 | | "delete" -> Some `DELETE 76 | | "head" -> Some `HEAD 77 | | "connect" -> Some `CONNECT 78 | | "options" -> Some `OPTIONS 79 | | "trace" -> Some `TRACE 80 | | "patch" -> Some `PATCH 81 | | _ -> None 82 | ;; 83 | 84 | let all = 85 | [ `GET; `POST; `PUT; `DELETE; `HEAD; `CONNECT; `OPTIONS; `TRACE; `PATCH ] 86 | ;; 87 | -------------------------------------------------------------------------------- /examples/frontend/server_counter_vdom.ml: -------------------------------------------------------------------------------- 1 | type model = int 2 | 3 | type 'msg Vdom.Cmd.t += 4 | | Increment of 'msg 5 | | Decrement of 'msg 6 | | Get_value of (int -> 'msg) 7 | 8 | type message = 9 | | Ask_for_increment 10 | | Ask_for_decrement 11 | | Ask_for_value 12 | | Replace_value of int 13 | 14 | let update value = function 15 | | Ask_for_increment -> Vdom.return ~c:[ Increment Ask_for_value ] value 16 | | Ask_for_decrement -> Vdom.return ~c:[ Decrement Ask_for_value ] value 17 | | Ask_for_value -> 18 | Vdom.return ~c:[ Get_value (fun x -> Replace_value x) ] value 19 | | Replace_value x -> Vdom.return x 20 | ;; 21 | 22 | let view value = 23 | let open Nightmare_js_vdom in 24 | div 25 | ~a:[ a_class [ "counter-application" ] ] 26 | [ span 27 | [ button 28 | ~a:[ on_click (fun _ -> Ask_for_decrement) ] 29 | [ txt " (server) -" ] 30 | ] 31 | ; samp [ txt @@ string_of_int value ] 32 | ; span 33 | [ button 34 | ~a:[ on_click (fun _ -> Ask_for_increment) ] 35 | [ txt "+ (server)" ] 36 | ] 37 | ] 38 | ;; 39 | 40 | let init = Vdom.return ~c:[ Get_value (fun x -> Replace_value x) ] 0 41 | 42 | let register () = 43 | let open Vdom_blit in 44 | let handler = 45 | { Cmd.f = 46 | (fun ctx -> function 47 | | Increment msg -> 48 | let () = 49 | Lwt.async (fun () -> 50 | let open Lwt.Syntax in 51 | let+ _ = 52 | Nightmare_js.Fetch.from 53 | Shared.Endpoint.Server_side_counter.increment 54 | in 55 | Cmd.send_msg ctx msg) 56 | in 57 | true 58 | | Decrement msg -> 59 | let () = 60 | Lwt.async (fun () -> 61 | let open Lwt.Syntax in 62 | let+ _ = 63 | Nightmare_js.Fetch.from 64 | Shared.Endpoint.Server_side_counter.decrement 65 | in 66 | Cmd.send_msg ctx msg) 67 | in 68 | true 69 | | Get_value handler -> 70 | let () = 71 | Lwt.async (fun () -> 72 | let open Lwt.Syntax in 73 | let* response = 74 | Nightmare_js.Fetch.from 75 | Shared.Endpoint.Server_side_counter.value 76 | in 77 | let+ text = Nightmare_js.Fetch.Response.text response in 78 | let result = Option.value ~default:0 (int_of_string_opt text) in 79 | Cmd.send_msg ctx (handler result)) 80 | in 81 | true 82 | | _ -> false) 83 | } 84 | in 85 | register @@ cmd handler 86 | ;; 87 | 88 | let app () = 89 | let () = register () in 90 | Nightmare_js_vdom.app ~init ~update ~view () 91 | ;; 92 | -------------------------------------------------------------------------------- /lib/dream/redirect.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Since [Nightmare_service] [Endpoints] are typed, [Redirect] provides a 24 | utility for constructing {i type-safe} redirections. 25 | 26 | For example, consider this [Endpoint]: 27 | 28 | {[ 29 | let my_endpoint () = 30 | let open Nightmare_service.Endpoint in 31 | get (~/"foo" / "bar" /: int /: string /: bool) 32 | ;; 33 | ]} 34 | 35 | It is possible to construct a redirection {i à la Dream} in this way: 36 | 37 | {[ 38 | Nightmare_dream.Redirect.run my_endpoint 10 "foo" false 39 | ]} 40 | 41 | As the [Endpoint] holds a continuation the parameters to be passed to the 42 | {!:val:run} function are defined by the type of the [Endpoint]. 43 | 44 | In addition, in accordance with the [Dream] documentation, it is possible to 45 | optionally specify a status, HTTP code and header list, as well as an anchor 46 | and additional GET parameters. 47 | 48 | Beware, however, that a redirection can only act on an [Endpoint] whose 49 | method is [GET]. Using [run] on an endpoint attached to another method will 50 | cause a compile-time error. *) 51 | 52 | (** [run ?status ?code ?headers ?anchor ?parameters endpoint] returns a function 53 | that waits to be provisioned by the variables defined by the [Endpoint] and 54 | a request. *) 55 | val run 56 | : ?status:[< Dream.redirection ] 57 | -> ?code:int 58 | -> ?headers:(string * string) list 59 | -> ?anchor:string 60 | -> ?parameters:(string * string) list 61 | -> ( 'scope_ 62 | , [< Nightmare_service.Method.for_link ] 63 | , 'continuation 64 | , (Dream.request, Dream.response) Nightmare_service.Handler.t ) 65 | Nightmare_service.Endpoint.wrapped 66 | -> 'continuation 67 | -------------------------------------------------------------------------------- /lib/service/nightmare_service.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** [Nightmare_service] is a library that embeds everything that concerns the 24 | definition of services/controllers. *) 25 | 26 | (** {1 Types aliases} *) 27 | 28 | (** [method_] is an alias for {!type:Method.t}. *) 29 | type method_ = Method.t 30 | 31 | (** [path] is an alias for {!type:Path.t}. *) 32 | type ('continuation, 'witness) path = ('continuation, 'witness) Path.t 33 | 34 | (** [wrapped_path] is an alias for {!type:Path.wrapped}. *) 35 | type ('continuation, 'witness) wrapped_path = 36 | ('continuation, 'witness) Path.wrapped 37 | 38 | (** [endpoint] is an alias for {!type:Endpoint.t}. *) 39 | type ('scope, 'method_, 'continuation, 'witness) endpoint = 40 | ('scope, 'method_, 'continuation, 'witness) Endpoint.t 41 | 42 | (** [wrapped_endpoint] is an alias for {!type:Endpoint.wrapped}. *) 43 | type ('scope, 'method_, 'continuation, 'witness) wrapped_endpoint = 44 | ('scope, 'method_, 'continuation, 'witness) Endpoint.wrapped 45 | 46 | (** [handler] is an alias for {!type:Handler.t}. *) 47 | type ('request, 'response) handler = ('request, 'response) Handler.t 48 | 49 | (** [middleware] is an alias for {!type:Middleware.t}. *) 50 | type ('request, 'response) middleware = ('request, 'response) Middleware.t 51 | 52 | (** [service] is an alias for {!type:Service.t}. *) 53 | type ('request, 'response) service = ('request, 'response) Service.t 54 | 55 | (** {1 Modules} 56 | 57 | Modules describing the different components of a service/controller (its 58 | path, an endpoint, supported HTTP methods) and other utilities. *) 59 | 60 | module Path = Path 61 | module Endpoint = Endpoint 62 | module Parser = Parser 63 | module Method = Method 64 | module Handler = Handler 65 | module Middleware = Middleware 66 | module Service = Service 67 | 68 | (** {1 Signatures} 69 | 70 | Signatures of modules that can be used as parameters of functors or to type 71 | first class modules. *) 72 | 73 | module Signatures = Signatures 74 | -------------------------------------------------------------------------------- /lib/service/parser.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | module Href = struct 24 | type t = 25 | { fragments : string list 26 | ; query_string : string option 27 | ; anchor : string option 28 | } 29 | 30 | let make ?query_string ?anchor fragments = { fragments; query_string; anchor } 31 | let fragments { fragments; _ } = fragments 32 | let query_string { query_string; _ } = query_string 33 | let anchor { anchor; _ } = anchor 34 | 35 | let extract_at chr str = 36 | match String.split_on_char chr str with 37 | | [ ""; "" ] -> None, None 38 | | [ ""; x ] -> None, Some x 39 | | [ x; "" ] -> Some x, None 40 | | [ x; y ] -> Some x, Some y 41 | | [ "" ] -> None, None 42 | | [ x ] -> Some x, None 43 | | _ -> None, None 44 | ;; 45 | 46 | let extract_anchor = extract_at '#' 47 | 48 | let extract_query_string = function 49 | | None -> None, None 50 | | Some tl -> extract_at '?' tl 51 | ;; 52 | 53 | let split_fragments str = 54 | match String.split_on_char '/' str with 55 | | "" :: "" :: fragments | "" :: fragments | fragments -> fragments 56 | ;; 57 | 58 | let extract_fragments = function 59 | | None -> [] 60 | | Some x -> split_fragments x 61 | ;; 62 | 63 | let from_string str = 64 | let tl, anchor = extract_anchor str in 65 | let tl, query_string = extract_query_string tl in 66 | let fragments = extract_fragments tl in 67 | make ?query_string ?anchor fragments 68 | ;; 69 | 70 | let pp ppf { fragments; query_string; anchor } = 71 | let anchor = Option.fold ~none:"" ~some:(fun x -> "#" ^ x) anchor 72 | and querys = Option.fold ~none:"" ~some:(fun x -> "?" ^ x) query_string 73 | and fragmt = String.concat "/" fragments in 74 | Format.fprintf ppf "/%s%s%s" fragmt querys anchor 75 | ;; 76 | 77 | let equal 78 | { fragments = f_a; query_string = q_a; anchor = a_a } 79 | { fragments = f_b; query_string = q_b; anchor = a_b } 80 | = 81 | List.equal String.equal f_a f_b 82 | && Option.equal String.equal q_a q_b 83 | && Option.equal String.equal a_a a_b 84 | ;; 85 | end 86 | -------------------------------------------------------------------------------- /lib/test/dummy_request.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | module MString = Map.Make (String) 24 | 25 | type status = 26 | | Ok of string 27 | | Redirect of string 28 | | Error of string 29 | 30 | let eq_status x y = 31 | match x, y with 32 | | Ok x, Ok y | Redirect x, Redirect y | Error x, Error y -> String.equal x y 33 | | _ -> false 34 | ;; 35 | 36 | let pp_status ppf = function 37 | | Ok x -> Format.fprintf ppf "Ok %s" x 38 | | Redirect x -> Format.fprintf ppf "Redirect to %s" x 39 | | Error x -> Format.fprintf ppf "Error %s" x 40 | ;; 41 | 42 | type t = 43 | { status : status 44 | ; env : string MString.t 45 | } 46 | 47 | let status_of { status; _ } = status 48 | 49 | let make ?(env = []) status = 50 | let env = 51 | List.fold_left (fun map (k, v) -> MString.add k v map) MString.empty env 52 | in 53 | { env; status } 54 | ;; 55 | 56 | let make_ok ?env content = make ?env (Ok content) 57 | let make_error ?env content = make ?env (Error content) 58 | let make_redirect ?env content = make ?env (Redirect content) 59 | let get_var ~key { env; _ } = MString.find_opt key env 60 | 61 | let add_var ~key ~value ({ env; _ } as req) = 62 | { req with env = MString.add key value env } 63 | ;; 64 | 65 | let remove_var ~key ({ env; _ } as req) = 66 | { req with env = MString.remove key env } 67 | ;; 68 | 69 | let clean_var req = { req with env = MString.empty } 70 | let redirect url req = { req with status = Redirect url } 71 | let error error req = { req with status = Error error } 72 | let ok content req = { req with status = Ok content } 73 | 74 | let equal { status = status_a; env = env_a } { status = status_b; env = env_b } = 75 | eq_status status_a status_b && MString.equal String.equal env_a env_b 76 | ;; 77 | 78 | let pp_tuple ppf (k, v) = Format.fprintf ppf "['%s'] -> '%s';" k v 79 | 80 | let pp_env ppf env = 81 | let env = MString.to_seq env |> List.of_seq in 82 | Format.fprintf ppf "[%a]" (Format.pp_print_list pp_tuple) env 83 | ;; 84 | 85 | let pp ppf { status; env } = 86 | Format.fprintf ppf "{status = %a; env = %a}" pp_status status pp_env env 87 | ;; 88 | 89 | let testable = Alcotest.testable pp equal 90 | -------------------------------------------------------------------------------- /lib/js/promise.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type +'a t 24 | type error 25 | 26 | exception Promise_rejection of error 27 | 28 | module Internal = struct 29 | external construct 30 | : (('a -> unit) -> (error -> unit) -> unit) 31 | -> 'a t 32 | = "caml_construct_promise" 33 | 34 | external resolved : 'a -> 'a t = "caml_resolve_promise" 35 | external then_ : 'a t -> ('a -> 'b t) -> 'b t = "caml_then_promise" 36 | 37 | external then_with 38 | : 'a t 39 | -> ('a -> 'b t) 40 | -> (error -> 'b t) 41 | -> 'b t 42 | = "caml_then_with_rejection" 43 | 44 | external catch : 'a t -> (error -> 'a t) -> 'a t = "caml_catch_promise" 45 | external set_timeout : int -> unit t = "caml_set_timeout_promise" 46 | end 47 | 48 | let pending_with_rejection () = 49 | let resolver = ref ignore 50 | and rejecter = ref ignore in 51 | let promise = 52 | Internal.construct (fun resolve reject -> 53 | let () = resolver := resolve in 54 | rejecter := reject) 55 | in 56 | promise, !resolver, !rejecter 57 | ;; 58 | 59 | let pending () = 60 | let promise, resolver, _ = pending_with_rejection () in 61 | promise, resolver 62 | ;; 63 | 64 | let resolved x = Internal.resolved x 65 | let then_ handler promise = Internal.then_ promise handler 66 | let then' resolve reject promise = Internal.then_with promise resolve reject 67 | let catch handler promise = Internal.catch promise handler 68 | 69 | let as_lwt promise = 70 | let lwt_promise, resolver = Lwt.wait () in 71 | let resolve value = 72 | let () = Lwt.wakeup_later resolver value in 73 | resolved () 74 | and reject error = 75 | let () = Lwt.wakeup_later_exn resolver (Promise_rejection error) in 76 | resolved () 77 | in 78 | let _ = then' resolve reject promise in 79 | lwt_promise 80 | ;; 81 | 82 | let set_timeout duration = Internal.set_timeout duration 83 | 84 | module Monad = Preface.Make.Monad.Via_return_and_bind (struct 85 | type nonrec 'a t = 'a t 86 | 87 | let return x = resolved x 88 | let bind f x = then_ f x 89 | end) 90 | 91 | module Applicative = Preface.Make.Applicative.From_monad (Monad) 92 | module Functor = Applicative 93 | -------------------------------------------------------------------------------- /lib/service/method.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Deal with common HTTP methods. Associated with a {!type:Path.t}, we can 24 | describe endpoints to build internal and external links. *) 25 | 26 | (** {1 types} 27 | 28 | The set of methods supported by Nightmare are described in polymorphic 29 | variants that are unified in {!type:t}. This allows methods to be 30 | intersected, particularly to index certain types more finely. *) 31 | 32 | (** See 33 | {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods} MDN Web 34 | documentation} for more information about [HTTP request methods]. *) 35 | type t = 36 | [ `GET (** Requests a representation of the specified resource. *) 37 | | `POST (** Submits an entity to the specified resource. *) 38 | | `PUT 39 | (** Replaces all current representations of the target resource with the 40 | request payload. *) 41 | | `DELETE (** Deletes the specified resource. *) 42 | | `HEAD (** Like [GET] but without the response body. *) 43 | | `CONNECT 44 | (** Makes a tunnel to the server identified by the target resource. *) 45 | | `OPTIONS (** Describes the communication options for the target resource. *) 46 | | `TRACE 47 | (** Performs a message loop-back test along the path to the target resource. *) 48 | | `PATCH (** Applies partial modifications to a resource. *) 49 | ] 50 | 51 | (** {2 Specialized methods} 52 | 53 | Despite the diversity of HTTP methods, it is not possible to make hyperlinks 54 | that do more than [GET] and forms can only be [GET] or [POST]. *) 55 | 56 | (** A type for the methods accepted by the links. *) 57 | type for_link = [ `GET ] 58 | 59 | (** A type for methods accepted as a method of a form. *) 60 | type for_form_action = 61 | [ `GET 62 | | `POST 63 | ] 64 | 65 | (** {1 Utils} *) 66 | 67 | (** Equality between {!type:t}. *) 68 | val equal : t -> t -> bool 69 | 70 | (** Pretty printer for {!type:t}. *) 71 | val pp : Format.formatter -> t -> unit 72 | 73 | (** [to_string meth] will render a {!type:t} into an uppercased string. *) 74 | val to_string : t -> string 75 | 76 | (** [from_string str] try to find the corresponding method for a given string. *) 77 | val from_string : string -> t option 78 | 79 | (** Returns a list of all supported methods. *) 80 | val all : t list 81 | -------------------------------------------------------------------------------- /lib/test/nightmare_test.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A very small collection of tools to make writing unit and integration tests 24 | easier (based on [Alcotest]). *) 25 | 26 | (** {1 Unit testing} 27 | 28 | Although it is complicated to give a fairly formal definition of a unit test 29 | (compared to an integration test or an {i end-to-end test}), here we 30 | consider a unit test to be a test that simply calculates things 31 | {i computationally} whereas an integration test embeds a database 32 | connection. *) 33 | 34 | (** {2 Unit test definition} *) 35 | 36 | (** [test ?speed ~about ~desc a_test] will define a test for a function or a 37 | tool described by [about] and with a comprehensive description into [desc]. 38 | It is almost an alias over [Alcotest.test_case]. *) 39 | val test 40 | : ?speed:Alcotest.speed_level 41 | -> about:string 42 | -> desc:string 43 | -> ('a -> unit) 44 | -> 'a Alcotest.test_case 45 | 46 | (** Lwt version of {!val:test}. *) 47 | val test_lwt 48 | : ?speed:Alcotest.speed_level 49 | -> about:string 50 | -> desc:string 51 | -> (unit -> unit Lwt.t) 52 | -> unit Alcotest.test_case 53 | 54 | (** [test_equality ?speed ~about ~desc testable a_test] is almost the same of 55 | {!val:test} except that the test is supposed to return a couple of value 56 | that have to be equal. It is a shortcut for writting test that only rely on 57 | the equality of computed values (versus expected value). *) 58 | val test_equality 59 | : ?speed:Alcotest.speed_level 60 | -> about:string 61 | -> desc:string 62 | -> 'a Alcotest.testable 63 | -> (unit -> 'a * 'a) 64 | -> unit Alcotest.test_case 65 | 66 | (** Lwt version of {!val:test_equality}. *) 67 | val test_equality_lwt 68 | : ?speed:Alcotest.speed_level 69 | -> about:string 70 | -> desc:string 71 | -> 'a Alcotest.testable 72 | -> (unit -> ('a * 'a) Lwt.t) 73 | -> unit Alcotest.test_case 74 | 75 | (** {1 Test helpers} *) 76 | 77 | (** [same testable x y] make the test fails if [x] and [y] are not equal 78 | (according to the meaning of equality defined into the [testable] value). *) 79 | val same : 'a Alcotest.testable -> expected:'a -> computed:'a -> unit 80 | 81 | (** A module that mimic a form of [Request] that can be used to deal with 82 | middlewares. *) 83 | 84 | module Dummy_request = Dummy_request 85 | -------------------------------------------------------------------------------- /lib/test/dummy_request.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Dummy_request is a module that mimics a pseudo-http context that potentially 24 | simulates the application of middleware. The dummy request is an association 25 | between environment variables and a status that can be [ok content], 26 | [redirect url] or [error message]. *) 27 | 28 | (** {1 Types} *) 29 | 30 | (** A dummy request (a set of environment variables and a status)*) 31 | type t 32 | 33 | (** An pseudo HTTP status.*) 34 | type status = 35 | | Ok of string 36 | | Redirect of string 37 | | Error of string 38 | 39 | (** {1 Construction} *) 40 | 41 | (** [make_ok ?env content] will produce a dummy request that is [ok content]. *) 42 | val make_ok : ?env:(string * string) list -> string -> t 43 | 44 | (** [make_error ?env message] will produce a dummy request that is 45 | [error message]. *) 46 | val make_error : ?env:(string * string) list -> string -> t 47 | 48 | (** [make_redirect ?env message] will produce a dummy request that is 49 | [redirect url]. *) 50 | val make_redirect : ?env:(string * string) list -> string -> t 51 | 52 | (** {1 Accessors} *) 53 | 54 | (** [status_of request] get the status of a request. *) 55 | val status_of : t -> status 56 | 57 | (** {1 Update} *) 58 | 59 | (** [ok content request] will replace the status of the given request to 60 | [ok content]. *) 61 | val ok : string -> t -> t 62 | 63 | (** [error message request] will replace the status of the given request to 64 | [error message]. *) 65 | val error : string -> t -> t 66 | 67 | (** [redirect url request] will replace the status of the given request to 68 | [redirect url]. *) 69 | val redirect : string -> t -> t 70 | 71 | (** {1 Environment Variables} *) 72 | 73 | (** [get_var ~key request] try to find the key into the request. *) 74 | val get_var : key:string -> t -> string option 75 | 76 | (** [add_var ~key ~value request] add a variable into the request. *) 77 | val add_var : key:string -> value:string -> t -> t 78 | 79 | (** [remove_var ~key request] remove a variable into the request. *) 80 | val remove_var : key:string -> t -> t 81 | 82 | (** [clean_var request] remove all variables into the request. *) 83 | val clean_var : t -> t 84 | 85 | (** {1 Helpers} *) 86 | 87 | val pp : Format.formatter -> t -> unit 88 | val equal : t -> t -> bool 89 | val testable : t Alcotest.testable 90 | -------------------------------------------------------------------------------- /lib/dream/nightmare_dream.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** [Nightmare] is a {i relatively} independent overlay, the [Nightmare_dream] 24 | package provides the necessary glue to integrate into a web application 25 | developed with {{:https://aantron.github.io/dream/} Dream}.*) 26 | 27 | (** {1 Types} 28 | 29 | Some common type aliases to simplify function signatures. *) 30 | 31 | type request = Dream.request 32 | type response = Dream.response 33 | type service = (request, response) Nightmare_service.service 34 | type handler = (request, response) Nightmare_service.handler 35 | type middleware = (request, response) Nightmare_service.middleware 36 | 37 | (** {1 Router} 38 | 39 | The [Router] is a [Middleware] (in the sense of [Dream]) that can be easily 40 | integrated into a middleware pipeline. 41 | 42 | It can, for example, be used in this way: 43 | 44 | {[ 45 | let services = [ my_first_service; my_second_service; my_third_service ] 46 | 47 | let start ?(interface = "0.0.0.0") ~port () = 48 | Dream.run ~port ~interface 49 | @@ Dream.logger 50 | @@ Nightmare_dream.router ~services 51 | ;; 52 | ]} 53 | 54 | See {!module:Router} for a more comprehensive example. *) 55 | 56 | (** [router ~services fallback request] defines a [Middleware] that tries to 57 | match a route, and relays on [fallback] if no route is candidate. *) 58 | val router : services:service list -> middleware 59 | 60 | module Router = Router 61 | 62 | (** {1 Redirection} 63 | 64 | [Nightmare_dream] allows to build redirections (which are [Handler] indexed 65 | by an [Endpoint]) in order to correctly type the parameters to be provided 66 | to execute the redirection. 67 | 68 | See {!module:Redirect} for a comprehensive example. *) 69 | 70 | (** [redirect_to ?status ?code ?headers ?anchor ?parameters endpoint] returns a 71 | function that waits to be provisioned by the variables defined by the 72 | [Endpoint] and a request. *) 73 | val redirect_to 74 | : ?status:[< Dream.redirection ] 75 | -> ?code:int 76 | -> ?headers:(string * string) list 77 | -> ?anchor:string 78 | -> ?parameters:(string * string) list 79 | -> ( 'scope_ 80 | , [< Nightmare_service.Method.for_link ] 81 | , 'continuation 82 | , handler ) 83 | Nightmare_service.Endpoint.wrapped 84 | -> 'continuation 85 | 86 | module Redirect = Redirect 87 | -------------------------------------------------------------------------------- /lib/js/console.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | 25 | external get_console 26 | : unit 27 | -> Bindings.console_hook Js.t 28 | = "caml_js_get_console" 29 | 30 | let console = get_console () 31 | let clear () = console##clear 32 | let log value = console##log value 33 | let debug value = console##debug value 34 | let info value = console##info value 35 | let warning value = console##warn value 36 | let error value = console##error value 37 | let dir value = console##dir value 38 | let dir_xml node = console##dirxml node 39 | let trace () = console##trace 40 | let string handler str = handler (Js.string str) 41 | 42 | let assert' ?message ?payload flag = 43 | let flag = Js.bool flag in 44 | match Stdlib.Option.map Js.string message, payload with 45 | | Some message, Some payload -> console##assert_2 flag message payload 46 | | Some x, None -> console##assert_1 flag x 47 | | None, Some x -> 48 | (* Not grouped to deal with payload as a generic value *) 49 | console##assert_1 flag x 50 | | None, None -> console##assert_ flag 51 | ;; 52 | 53 | let table ?columns obj = 54 | let columns = 55 | columns 56 | |> Stdlib.Option.map (Util.from_list_to_js_array Js.string) 57 | |> Js.Optdef.option 58 | in 59 | console##table obj columns 60 | ;; 61 | 62 | let default_label = "default" 63 | let default_label_js = Js.string default_label 64 | 65 | let make_label = function 66 | | None -> default_label_js 67 | | Some x -> Js.string x 68 | ;; 69 | 70 | module Timer = struct 71 | let default_label = default_label 72 | let start ?label () = console##time (make_label label) 73 | let stop ?label () = console##timeEnd (make_label label) 74 | 75 | let log ?label ?payload () = 76 | let payload = Js.Optdef.option payload in 77 | console##timeLog (make_label label) payload 78 | ;; 79 | end 80 | 81 | module Counter = struct 82 | let default_label = default_label 83 | let tick ?label () = console##count (Js.Optdef.return @@ make_label label) 84 | 85 | let reset ?label () = 86 | console##countReset (Js.Optdef.return @@ make_label label) 87 | ;; 88 | end 89 | 90 | module Indent = struct 91 | let increase ?(collapsed = false) ?label () = 92 | let label = label |> Stdlib.Option.map Js.string |> Js.Optdef.option in 93 | if collapsed then console##groupCollapsed label else console##group label 94 | ;; 95 | 96 | let decrease () = console##groupEnd 97 | end 98 | -------------------------------------------------------------------------------- /lib/vdom/nightmare_js_vdom.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A library to glue together [Nightmare], [Tyxml] and [ocaml-vdom]. While 24 | having some differences, the API for describing nodes and attributes is very 25 | similar to Tyxml (and shares many signatures), *) 26 | 27 | (** [app ~init ~update ~view ()] initialize an application that can propagate 28 | messages and commands. *) 29 | val app 30 | : init:'model * 'msg Vdom.Cmd.t 31 | -> update:('model -> 'msg -> 'model * 'msg Vdom.Cmd.t) 32 | -> view:('model -> ('kind, 'msg) Node.t) 33 | -> unit 34 | -> ('model, 'msg) Vdom.app 35 | 36 | (** [simple_app ~init ~update ~view ()] initialize an application that can 37 | propagate messages. *) 38 | val simple_app 39 | : init:'model 40 | -> update:('model -> 'msg -> 'model) 41 | -> view:('model -> ('kind, 'msg) Node.t) 42 | -> unit 43 | -> ('model, 'msg) Vdom.app 44 | 45 | (** {1 Mounting an application} *) 46 | 47 | (** [append_to ~id ~not_found f] will append the application returned by [f] 48 | into the element referenced by [id]. If the [element] does not exists, 49 | [not_found] will be fired. *) 50 | val append_to 51 | : id:string 52 | -> ?not_found:(id:string -> unit Lwt.t) 53 | -> (Js_browser.Element.t -> ('model, 'msg) Vdom.app Lwt.t) 54 | -> unit Lwt.t 55 | 56 | (** [mount_to ~id ~not_found f] same of [append_to] but it removes all children 57 | of the target. *) 58 | val mount_to 59 | : id:string 60 | -> ?not_found:(id:string -> unit Lwt.t) 61 | -> (Js_browser.Element.t -> ('model, 'msg) Vdom.app Lwt.t) 62 | -> unit Lwt.t 63 | 64 | (** {1 Types} *) 65 | 66 | (** {2 Html elements} *) 67 | 68 | (** The type describing an attribute of an HTML node. The first parameter is a 69 | ghost type and the second is used to propagate messages from the virtual 70 | DOM.*) 71 | type ('a, 'msg) attrib = ('a, 'msg) Attrib.t 72 | 73 | (** The type describing an Html Node. *) 74 | type ('a, 'msg) node = ('a, 'msg) Node.t 75 | 76 | (** {1 Html Elements} *) 77 | 78 | include module type of Node with type ('a, 'b) t := ('a, 'b) node (** @inline *) 79 | 80 | (** {2 Html Elements connected to endpoints} *) 81 | 82 | include module type of Endpoint_node (** @inline*) 83 | 84 | (** {1 Attributes} *) 85 | 86 | include module type of Attrib with type ('a, 'b) t := ('a, 'b) attrib 87 | (** @inline*) 88 | 89 | (** {1 Internal modules} 90 | 91 | Even if all functions are re-exported in this module, the auxiliary modules 92 | are accessible. *) 93 | 94 | module Attrib = Attrib 95 | -------------------------------------------------------------------------------- /lib/tyxml/attrib.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** As endpoints render certain attributes (such as [href] or [src]) useless, 24 | this module re-exports the attributes of certain tags without these useless 25 | attributes to render certain expressions invalid such as : 26 | 27 | {[ 28 | a_of ~a [ a_href "google.be" ] my_endpoint my_param [ txt "my link" ] 29 | ]} 30 | 31 | Allowing to avoid that a given attribute overwrites the one computed by the 32 | endpoint. *) 33 | 34 | module Without_source : sig 35 | type a = 36 | [ Html_types.common 37 | | `Hreflang 38 | | `Media 39 | | `Rel 40 | | `Target 41 | | `Mime_type 42 | | `Download 43 | ] 44 | 45 | type base = 46 | [ Html_types.common 47 | | `Target 48 | ] 49 | 50 | type button = 51 | [ Html_types.common 52 | | `Autofocus 53 | | `Disabled 54 | | `Form 55 | | `Formenctype 56 | | `Formnovalidate 57 | | `Formtarget 58 | | `Name 59 | | `Text_Value 60 | | `Button_Type 61 | ] 62 | 63 | type blockquote = Html_types.common 64 | type q = Html_types.common 65 | 66 | type del = 67 | [ Html_types.common 68 | | `Datetime 69 | ] 70 | 71 | type ins = 72 | [ Html_types.common 73 | | `Datetime 74 | ] 75 | 76 | type embed = 77 | [ Html_types.common 78 | | `Height 79 | | `Mime_type 80 | | `Width 81 | ] 82 | 83 | type form = 84 | [ Html_types.common 85 | | `Accept_charset 86 | | `Enctype 87 | | `Name 88 | | `Target 89 | | `Autocomplete 90 | | `Novalidate 91 | ] 92 | 93 | type iframe = 94 | [ Html_types.common 95 | | `Allowfullscreen 96 | | `Allowpaymentrequest 97 | | `Name 98 | | `Sandbox 99 | | `Seamless 100 | | `Width 101 | | `Height 102 | | `Referrerpolicy 103 | ] 104 | 105 | type link = 106 | [ Html_types.common 107 | | Html_types.subressource_integrity 108 | | `Hreflang 109 | | `Media 110 | | `Sizes 111 | | `Mime_type 112 | ] 113 | 114 | type object_ = 115 | [ Html_types.common 116 | | `Form 117 | | `Mime_type 118 | | `Height 119 | | `Width 120 | | `Name 121 | | `Usemap 122 | ] 123 | 124 | type script = 125 | [ Html_types.common 126 | | Html_types.subressource_integrity 127 | | `Async 128 | | `Charset 129 | | `Defer 130 | | `Script_type 131 | | `Src 132 | ] 133 | 134 | type source = 135 | [ Html_types.common 136 | | `Mime_type 137 | | `Media 138 | ] 139 | end 140 | -------------------------------------------------------------------------------- /lib/service/service.ml: -------------------------------------------------------------------------------- 1 | type ('request, 'response) t = 2 | | Straight : 3 | { middlewares : ('request, 'response) Middleware.t list 4 | ; endpoint : 5 | ( [ `Inner ] 6 | , Method.t 7 | , 'continuation 8 | , ('request, 'response) Handler.t ) 9 | Endpoint.wrapped 10 | ; handler : 'continuation 11 | } 12 | -> ('request, 'response) t 13 | | Straight' : 14 | { middlewares : ('request, 'response) Middleware.t list 15 | ; endpoint : 16 | ( [ `Inner ] 17 | , Method.t 18 | , 'continuation 19 | , 'attachment -> ('request, 'response) Handler.t ) 20 | Endpoint.wrapped 21 | ; provider : 22 | ('attachment -> ('request, 'response) Handler.t) 23 | -> ('request, 'response) Handler.t 24 | ; handler : 'continuation 25 | } 26 | -> ('request, 'response) t 27 | | Failable : 28 | { middlewares : ('request, 'response) Middleware.t list 29 | ; endpoint : 30 | ( [ `Inner ] 31 | , Method.t 32 | , 'continuation 33 | , ('request, ('result, 'error) result) Handler.t ) 34 | Endpoint.wrapped 35 | ; handler : 'continuation 36 | ; ok : 'result -> ('request, 'response) Handler.t 37 | ; error : 'error -> ('request, 'response) Handler.t 38 | } 39 | -> ('request, 'response) t 40 | | Failable' : 41 | { middlewares : ('request, 'response) Middleware.t list 42 | ; endpoint : 43 | ( [ `Inner ] 44 | , Method.t 45 | , 'continuation 46 | , 'attachment -> ('request, ('result, 'error) result) Handler.t ) 47 | Endpoint.wrapped 48 | ; provider : 49 | ('attachment -> ('request, 'response) Handler.t) 50 | -> ('request, 'response) Handler.t 51 | ; ok : 'result -> ('request, 'response) Handler.t 52 | ; error : 'error -> ('request, 'response) Handler.t 53 | ; handler : 'continuation 54 | } 55 | -> ('request, 'response) t 56 | 57 | let straight ?(middlewares = []) ~endpoint handler = 58 | Straight { middlewares; endpoint; handler } 59 | ;; 60 | 61 | let straight' ?(middlewares = []) ~provider ~endpoint handler = 62 | Straight' { middlewares; endpoint; provider; handler } 63 | ;; 64 | 65 | let failable ?(middlewares = []) ~endpoint ~ok ~error handler = 66 | Failable { middlewares; endpoint; ok; error; handler } 67 | ;; 68 | 69 | let failable' ?(middlewares = []) ~provider ~endpoint ~ok ~error handler = 70 | Failable' { middlewares; provider; endpoint; ok; error; handler } 71 | ;; 72 | 73 | let choose ~services ~given_method ~given_uri fallback request = 74 | let rec aux = function 75 | | Straight { endpoint; middlewares; handler } :: continue -> 76 | (match Endpoint.sscanf endpoint given_method given_uri handler with 77 | | Some handler -> (Middleware.fold middlewares handler) request 78 | | None -> aux continue) 79 | | Straight' { endpoint; middlewares; handler; provider } :: continue -> 80 | (match Endpoint.sscanf endpoint given_method given_uri handler with 81 | | Some handler -> 82 | let inner_handler request = provider handler request in 83 | (Middleware.fold middlewares inner_handler) request 84 | | None -> aux continue) 85 | | Failable { middlewares; endpoint; handler; ok; error } :: continue -> 86 | (match Endpoint.sscanf endpoint given_method given_uri handler with 87 | | Some handler -> 88 | let shell_handler request = 89 | Lwt.bind (handler request) (function 90 | | Ok x -> ok x request 91 | | Error x -> error x request) 92 | in 93 | (Middleware.fold middlewares shell_handler) request 94 | | None -> aux continue) 95 | | Failable' { middlewares; endpoint; handler; ok; error; provider } 96 | :: continue -> 97 | (match Endpoint.sscanf endpoint given_method given_uri handler with 98 | | Some handler -> 99 | let shell_handler provider request = 100 | Lwt.bind (handler provider request) (function 101 | | Ok x -> ok x request 102 | | Error x -> error x request) 103 | in 104 | let full_handler request = provider shell_handler request in 105 | (Middleware.fold middlewares full_handler) request 106 | | None -> aux continue) 107 | | [] -> fallback request 108 | in 109 | aux services 110 | ;; 111 | -------------------------------------------------------------------------------- /lib/js/bindings.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** Low-level bindings with the JavaScript API. Ideally, these bindings should 24 | be hidden behind a higher-level API. *) 25 | 26 | open Js_of_ocaml 27 | open Js 28 | open Aliases 29 | 30 | (** {1 Console Bindings} 31 | 32 | Binding to deal with the browser console. *) 33 | 34 | (** Javascript object. *) 35 | class type console_hook = object 36 | inherit Firebug.console 37 | method clear : unit meth 38 | method count : js_string t or_undefined -> unit meth 39 | method countReset : js_string t or_undefined -> unit meth 40 | method timeLog : 'a. js_string t -> 'a -> unit meth 41 | method table : 'a. 'a -> js_string t js_array t or_undefined -> unit meth 42 | end 43 | 44 | (** {1 Fetch API} 45 | 46 | A rough attempt to make a binding for fetch. 47 | {{:https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API} MDN 48 | documentation} *) 49 | 50 | class type ['a] readable_stream_result = object 51 | method _done : bool t readonly_prop 52 | method value : 'a readonly_prop 53 | end 54 | 55 | class type ['a] readable_stream_default_reader = object 56 | method closed : bool t readonly_prop 57 | method cancel : js_string t or_undefined -> unit Promise.t meth 58 | method close : unit Promise.t meth 59 | method read : 'a readable_stream_result t Promise.t meth 60 | method releaseLock : unit meth 61 | end 62 | 63 | class type ['a] readable_stream = object 64 | method locked : bool t readonly_prop 65 | method cancel : js_string t or_undefined -> unit Promise.t meth 66 | method getReader : 'a readable_stream_default_reader t meth 67 | end 68 | 69 | class type blob = object 70 | method size : int readonly_prop 71 | method _type : js_string t readonly_prop 72 | method arrayBuffer : Typed_array.arrayBuffer t Promise.t meth 73 | method slice : int -> int -> js_string t or_undefined -> blob t meth 74 | method stream : Typed_array.uint8Array t readable_stream t meth 75 | method text : js_string t Promise.t meth 76 | end 77 | 78 | class type http_headers = object 79 | method append : js_string t -> js_string t -> unit meth 80 | method delete : js_string t -> unit meth 81 | method get : js_string t -> js_string t opt meth 82 | method has : js_string t -> bool t meth 83 | method set : js_string t -> js_string t -> unit meth 84 | end 85 | 86 | class type form_data = object 87 | inherit http_headers 88 | method getAll : js_string t -> js_string t js_array t meth 89 | end 90 | 91 | class type url_search_params = object 92 | inherit form_data 93 | method toString : js_string t meth 94 | method sort : unit meth 95 | end 96 | 97 | type fetch_body 98 | 99 | class type fetch_options = object 100 | method _method : js_string t readonly_prop 101 | method headers : http_headers t or_undefined readonly_prop 102 | method body : fetch_body t or_undefined readonly_prop 103 | method mode : js_string t or_undefined readonly_prop 104 | method credentials : js_string t or_undefined readonly_prop 105 | method cache : js_string t or_undefined readonly_prop 106 | method redirect : js_string t or_undefined readonly_prop 107 | method referrer : js_string t or_undefined readonly_prop 108 | method referrerPolicy : js_string t or_undefined readonly_prop 109 | method integrity : js_string t or_undefined readonly_prop 110 | method keepalive : bool t or_undefined readonly_prop 111 | end 112 | 113 | class type fetch_response = object 114 | method headers : http_headers t readonly_prop 115 | method ok : bool t readonly_prop 116 | method redirected : bool t readonly_prop 117 | method status : int readonly_prop 118 | method statusText : js_string t readonly_prop 119 | method _type : js_string t readonly_prop 120 | method url : js_string t readonly_prop 121 | method body : Typed_array.uint8Array t readable_stream t readonly_prop 122 | method text : js_string t Promise.t meth 123 | method arrayBuffer : Typed_array.arrayBuffer t Promise.t meth 124 | method blob : blob t Promise.t meth 125 | method formData : form_data t Promise.t meth 126 | end 127 | -------------------------------------------------------------------------------- /lib/js/stubs/caml_promise_stubs.js: -------------------------------------------------------------------------------- 1 | /* 2 | MIT License 3 | 4 | Copyright (c) 2023 funkywork 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | */ 24 | 25 | //Provides: caml_is_a_promise 26 | function caml_is_a_promise(value) { 27 | return Boolean(value && typeof value.then === 'function'); 28 | } 29 | 30 | //Provides: caml_print_error 31 | function caml_print_error(error) { 32 | const message = "The promise does not handle the following exception"; 33 | console.error(message); 34 | console.error(error); 35 | } 36 | 37 | //Provides: CAMLWrappedPromise 38 | function CAMLWrappedPromise(value) { 39 | /* Wraps a promise in an object to make it safe. The approach is more than 40 | * greatly inspired by : 41 | * - https://github.com/aantron/promise 42 | * - https://github.com/dbuenzli/brr/blob/master/src/fut.ml#L6 43 | */ 44 | this.wrapped = value; 45 | } 46 | 47 | //Provides: caml_wrap_promise 48 | //Requires: CAMLWrappedPromise, caml_is_a_promise 49 | function caml_wrap_promise(value) { 50 | // Wraps a promise in a `CAMLWrappedPromise` object if necessary. 51 | if (caml_is_a_promise(value)) { 52 | return new CAMLWrappedPromise(value); 53 | } else return value; 54 | } 55 | 56 | //Provides: caml_unwrap_promise 57 | //Requires: CAMLWrappedPromise 58 | function caml_unwrap_promise(value) { 59 | // Wraps the promise in a `CAMLWrappedPromise` if necessary. 60 | if (value instanceof CAMLWrappedPromise) { 61 | return value.wrapped; 62 | } else return value; 63 | } 64 | 65 | //Provides: caml_construct_promise 66 | //Requires: caml_wrap_promise 67 | function caml_construct_promise(handler) { 68 | // Builds a promise by wrapping in its value. 69 | const safePromise = new globalThis.Promise(function(resolve, reject) { 70 | const wrappedResolver = function(value) { 71 | const wrapped = caml_wrap_promise(value); 72 | resolve(wrapped); 73 | }; 74 | handler(wrappedResolver, reject); 75 | }); 76 | return safePromise; 77 | } 78 | 79 | //Provides: caml_resolve_promise 80 | //Requires: caml_wrap_promise 81 | function caml_resolve_promise(value) { 82 | // Solve a promise by wrapping up its value. 83 | const wrapped = caml_wrap_promise(value); 84 | return globalThis.Promise.resolve(wrapped); 85 | } 86 | 87 | // Provides: caml_then_promise 88 | // Requires: caml_unwrap_promise, caml_print_error 89 | function caml_then_promise(promise, handler) { 90 | // Safe wrapper around `then`. 91 | const safeHandler = function (value) { 92 | try { 93 | const unwrapped = caml_unwrap_promise(value); 94 | return handler(unwrapped); 95 | } catch (exception) { 96 | // Should maybe improved 97 | caml_print_error(exception); 98 | return new globalThis.Promise(function(){}); 99 | }; 100 | }; 101 | return promise.then(safeHandler); 102 | }; 103 | 104 | //Provides: caml_then_with_rejection 105 | //Requires: caml_unwrap_promise, caml_print_error 106 | function caml_then_with_rejection(promise, resolver, rejecter) { 107 | // Safe wrapper around `then` with rejection. 108 | const safeResolver = function(value) { 109 | const unwrapped = caml_unwrap_promise(value); 110 | return resolver(unwrapped); 111 | }; 112 | const safeRejecter = function(value) { 113 | try { return rejecter(value); } 114 | catch (exception) { 115 | caml_print_error(exception); 116 | return new globalThis.Promise(function(){}); 117 | } 118 | }; 119 | return promise.then(safeResolver, safeRejecter); 120 | } 121 | 122 | //Provides: caml_catch_promise 123 | //Requires: caml_print_error 124 | function caml_catch_promise(promise, handler) { 125 | // Safe wrapper around `catch`. 126 | const safeHandler = function (errorValue) { 127 | try { return handler(errorValue); } 128 | catch (exception) { 129 | caml_print_error(exception); 130 | return new globalThis.Promise(function(){}); 131 | } 132 | }; 133 | return promise.catch(safeHandler); 134 | }; 135 | 136 | //Provides: caml_set_timeout_promise 137 | function caml_set_timeout_promise(duration) { 138 | // A promisified version of setTimeout 139 | return new globalThis.Promise( 140 | function(resolve) { 141 | setTimeout(function() {resolve(); }, duration); 142 | } 143 | ); 144 | } -------------------------------------------------------------------------------- /test/service_test/parser_test.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Nightmare_test 24 | 25 | let href_testable = 26 | Alcotest.testable 27 | Nightmare_service.Parser.Href.pp 28 | Nightmare_service.Parser.Href.equal 29 | ;; 30 | 31 | let test_href_empty_string = 32 | test_equality 33 | ~about:"Href.from_string" 34 | ~desc:"When the string is empty, it should produces an empty href" 35 | href_testable 36 | (fun () -> 37 | let open Nightmare_service.Parser.Href in 38 | let expected = make [] 39 | and computed = from_string "" in 40 | expected, computed) 41 | ;; 42 | 43 | let test_href_without_anchor_and_query_string = 44 | test_equality 45 | ~about:"Href.from_string" 46 | ~desc: 47 | "When the string has no anchor and query string, it should just parse \ 48 | the fragments" 49 | href_testable 50 | (fun () -> 51 | let open Nightmare_service.Parser.Href in 52 | let expected = make [ "foo"; "bar"; "baz" ] 53 | and computed = from_string "foo/bar/baz" in 54 | expected, computed) 55 | ;; 56 | 57 | let test_href_with_anchor_and_without_query_string = 58 | test_equality 59 | ~about:"Href.from_string" 60 | ~desc: 61 | "When the string has an anchor but no query string, it should just parse \ 62 | the fragments and retreive the anchor" 63 | href_testable 64 | (fun () -> 65 | let open Nightmare_service.Parser.Href in 66 | let expected = make ~anchor:"foo-bar-baz" [ "foo"; "bar"; "baz" ] 67 | and computed = from_string "foo/bar/baz#foo-bar-baz" in 68 | expected, computed) 69 | ;; 70 | 71 | let test_href_without_anchor_and_with_query_string = 72 | test_equality 73 | ~about:"Href.from_string" 74 | ~desc: 75 | "When the string has no anchor but a query string, it should just parse \ 76 | the fragments and retreive the query string" 77 | href_testable 78 | (fun () -> 79 | let open Nightmare_service.Parser.Href in 80 | let expected = 81 | make ~query_string:"foo=bar&baz=foo" [ "foo"; "bar"; "baz" ] 82 | and computed = from_string "foo/bar/baz?foo=bar&baz=foo" in 83 | expected, computed) 84 | ;; 85 | 86 | let test_href_with_anchor_and_with_query_string = 87 | test_equality 88 | ~about:"Href.from_string" 89 | ~desc: 90 | "When the string has an anchor but a query string, it should just parse \ 91 | the fragments and retreive the query string and the anchor" 92 | href_testable 93 | (fun () -> 94 | let open Nightmare_service.Parser.Href in 95 | let expected = 96 | make 97 | ~query_string:"foo=bar&baz=foo" 98 | ~anchor:"foo-bar-baz" 99 | [ "foo"; "bar"; "baz" ] 100 | and computed = from_string "foo/bar/baz?foo=bar&baz=foo#foo-bar-baz" in 101 | expected, computed) 102 | ;; 103 | 104 | let test_href_without_fragment_and_query_string_but_with_anchor = 105 | test_equality 106 | ~about:"Href.from_string" 107 | ~desc:"When the string has anchor and nothing else" 108 | href_testable 109 | (fun () -> 110 | let open Nightmare_service.Parser.Href in 111 | let expected = make ~anchor:"foo-bar-baz" [] 112 | and computed = from_string "#foo-bar-baz" in 113 | expected, computed) 114 | ;; 115 | 116 | let test_href_without_fragment_and_anchor_string_but_with_query_string = 117 | test_equality 118 | ~about:"Href.from_string" 119 | ~desc:"When the string has query string and nothing else" 120 | href_testable 121 | (fun () -> 122 | let open Nightmare_service.Parser.Href in 123 | let expected = make ~query_string:"foo=true&baz=bar" [] 124 | and computed = from_string "?foo=true&baz=bar" in 125 | expected, computed) 126 | ;; 127 | 128 | let test_href_without_fragment = 129 | test_equality 130 | ~about:"Href.from_string" 131 | ~desc:"When the string has query string and nothing else" 132 | href_testable 133 | (fun () -> 134 | let open Nightmare_service.Parser.Href in 135 | let expected = 136 | make ~query_string:"foo=true&baz=bar" ~anchor:"foo-bar-baz" [] 137 | and computed = from_string "?foo=true&baz=bar#foo-bar-baz" in 138 | expected, computed) 139 | ;; 140 | 141 | let cases = 142 | ( "Parser" 143 | , [ test_href_empty_string 144 | ; test_href_without_anchor_and_query_string 145 | ; test_href_with_anchor_and_without_query_string 146 | ; test_href_without_anchor_and_with_query_string 147 | ; test_href_with_anchor_and_with_query_string 148 | ; test_href_without_fragment_and_query_string_but_with_anchor 149 | ; test_href_without_fragment_and_anchor_string_but_with_query_string 150 | ; test_href_without_fragment 151 | ] ) 152 | ;; 153 | -------------------------------------------------------------------------------- /lib/service/path.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type 'a variable = 24 | | Record of 25 | { from_string : string -> 'a option 26 | ; to_string : 'a -> string 27 | ; name : string 28 | } 29 | | Module of (module Signatures.PATH_FRAGMENT with type t = 'a) 30 | 31 | type (_, _) t = 32 | | Root : ('witness, 'witness) t 33 | | Const : ('continuation, 'witness) t * string -> ('continuation, 'witness) t 34 | | Var : 35 | ('continuation, 'new_variable -> 'witness) t * 'new_variable variable 36 | -> ('continuation, 'witness) t 37 | 38 | type ('continuation, 'witness) wrapped = unit -> ('continuation, 'witness) t 39 | 40 | let variable ~from_string ~to_string name = 41 | Record { from_string; to_string; name } 42 | ;; 43 | 44 | let variable' (type a) (module PF : Signatures.PATH_FRAGMENT with type t = a) = 45 | Module (module PF) 46 | ;; 47 | 48 | let variable_name : type a. a variable -> string = function 49 | | Record { name; _ } -> name 50 | | Module (module M) -> M.fragment_name 51 | ;; 52 | 53 | let variable_to_string : type a. a variable -> a -> _ = 54 | fun fragment value -> 55 | match fragment with 56 | | Record { to_string; _ } -> to_string value 57 | | Module (module M) -> M.fragment_to_string value 58 | ;; 59 | 60 | let variable_from_string : type a. a variable -> string -> a option = 61 | fun fragment value -> 62 | match fragment with 63 | | Record { from_string; _ } -> from_string value 64 | | Module (module M) -> M.fragment_from_string value 65 | ;; 66 | 67 | module Preset = struct 68 | let string = 69 | variable ~from_string:Option.some ~to_string:(fun x -> x) "string" 70 | ;; 71 | 72 | let int = 73 | variable ~from_string:int_of_string_opt ~to_string:string_of_int "int" 74 | ;; 75 | 76 | let float = 77 | variable ~from_string:float_of_string_opt ~to_string:string_of_float "float" 78 | ;; 79 | 80 | let bool = 81 | variable ~from_string:bool_of_string_opt ~to_string:string_of_bool "bool" 82 | ;; 83 | 84 | let char = 85 | let is_char s = Int.equal 1 @@ String.length s in 86 | let from_string s = if is_char s then Some s.[0] else None in 87 | let to_string c = String.make 1 c in 88 | variable ~from_string ~to_string "char" 89 | ;; 90 | end 91 | 92 | include Preset 93 | 94 | let root = Root 95 | let add_constant value base = Const (base, value) 96 | let add_variable variable base = Var (base, variable) 97 | 98 | module Infix = struct 99 | let ( ~/ ) value = add_constant value root 100 | let ( ~/: ) variable = add_variable variable root 101 | let ( / ) base value = add_constant value base 102 | let ( /: ) base variable = add_variable variable base 103 | end 104 | 105 | include Infix 106 | 107 | let pp ppf path = 108 | let rec aux 109 | : type continuation witness. 110 | string list -> (continuation, witness) t -> string list 111 | = 112 | fun acc -> function 113 | | Root -> acc 114 | | Const (path_xs, x) -> aux (x :: acc) path_xs 115 | | Var (path_xs, fr) -> aux ((":" ^ variable_name fr) :: acc) path_xs 116 | in 117 | let str = aux [] path |> String.concat "/" in 118 | Format.fprintf ppf "/%s" str 119 | ;; 120 | 121 | let sprintf_with path handler = 122 | let collapse_list x = handler ("/" ^ String.concat "/" @@ List.rev x) in 123 | let rec aux 124 | : type continuation witness. 125 | (string list -> witness) -> (continuation, witness) t -> continuation 126 | = 127 | fun continue -> function 128 | | Root -> continue [] 129 | | Const (path_xs, x) -> aux (fun xs -> continue (x :: xs)) path_xs 130 | | Var (path_xs, fr) -> 131 | aux (fun xs w -> continue (variable_to_string fr w :: xs)) path_xs 132 | in 133 | aux collapse_list path 134 | ;; 135 | 136 | let sprintf path = sprintf_with path (fun x -> x) 137 | 138 | let sscanf path uri = 139 | let rec aux 140 | : type continuation witness normal_form. 141 | (witness -> normal_form) 142 | -> (continuation, witness) t 143 | -> string list 144 | -> continuation 145 | -> normal_form option 146 | = 147 | fun continue path fragments -> 148 | match path, fragments with 149 | | Root, [] -> fun x -> Some (continue x) 150 | | Const (path_xs, x), fragment :: uri_xs -> 151 | if String.equal x fragment 152 | then aux continue path_xs uri_xs 153 | else fun _ -> None 154 | | Var (path_xs, fr), fragment :: uri_xs -> 155 | Option.fold 156 | ~none:(fun _ -> None) 157 | ~some:(fun var -> aux (fun acc -> continue (acc var)) path_xs uri_xs) 158 | @@ variable_from_string fr fragment 159 | | _ -> fun _ -> None 160 | in 161 | let parsed = Parser.Href.from_string uri in 162 | let fragments = List.rev @@ Parser.Href.fragments parsed in 163 | aux (fun x -> x) path fragments 164 | ;; 165 | -------------------------------------------------------------------------------- /lib/js/console.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** A dead simple binding of the debugging console. The correspondence of the 24 | functions can be found on the MND documentation: 25 | {{:https://developer.mozilla.org/en-US/docs/Web/API/Console} WebAPI/Console}. 26 | 27 | The goal of this module is mostly for debugging. *) 28 | 29 | open Aliases 30 | open Js_of_ocaml 31 | 32 | (** {1 Basis functionality} 33 | 34 | Straightforward binding of console utilities. *) 35 | 36 | (** [Console.clear ()] clears the console if the console allows it. *) 37 | val clear : unit -> unit 38 | 39 | (** [Console.log x] logs an aribtrary value [x] in the console. *) 40 | val log : 'a -> unit 41 | 42 | (** [Console.debug x] outputs an arbitrary value [x] to the console with the log 43 | level [debug]. *) 44 | val debug : 'a -> unit 45 | 46 | (** [Console.info x] informative logging of an arbitrary value [x]. *) 47 | val info : 'a -> unit 48 | 49 | (** [Console.warning x] outputs a warning message of an arbitrary value [x]. *) 50 | val warning : 'a -> unit 51 | 52 | (** [Console.error x] outputs an error message of an arbitrary value [x]. *) 53 | val error : 'a -> unit 54 | 55 | (** [Console.dir js_value] displays an interactive list of the properties of the 56 | specified JavaScript object ([js_value]). The output is presented as a 57 | hierarchical listing with disclosure triangles that let you see the contents 58 | of child objects. 59 | {b This is why you can't pass an regular OCaml value but you have to give a 60 | JavaScript one}. *) 61 | val dir : 'a js -> unit 62 | 63 | (** [Console.dir_xml node] displays an interactive tree of the descendant 64 | elements of the specified XML/HTML element ([node]). *) 65 | val dir_xml : Dom.node js -> unit 66 | 67 | (** [Console.trace ()] outputs a stack trace to the Web console. *) 68 | val trace : unit -> unit 69 | 70 | (** [Console.assert' ?message ?payload assertion] writes an error message to the 71 | console if the assertion is false. If the assertion is true, nothing 72 | happens. *) 73 | val assert' : ?message:string -> ?payload:'a -> bool -> unit 74 | 75 | (** [Console.table ?columns js_value] displays tabular data as a table. *) 76 | val table : ?columns:string list -> 'a js -> unit 77 | 78 | (** [Console.string handler str] allows you to easily display OCaml strings. It 79 | is used with another function. For example : 80 | [Console.(string warning "Attention")]. 81 | 82 | Which will display [" Attention"] in a [warning]. *) 83 | val string : (Js.js_string js -> unit) -> string -> unit 84 | 85 | (** {1 Timer} *) 86 | 87 | module Timer : sig 88 | (** Allows you to start (and stop) and monitor timers from the console. *) 89 | 90 | (** Returns the default label, used when no specific label is given to the 91 | following functions. *) 92 | val default_label : string 93 | 94 | (** [Console.Timer.start ?label ()] starts a [timer] with a given [label] (if 95 | the [label] is not given, it will use ["default"] as a label). *) 96 | val start : ?label:string -> unit -> unit 97 | 98 | (** [Console.Timer.stop ?label ()] stops a [timer] of a given [label] (if the 99 | [label] is not given, it will use ["default"] as a label). *) 100 | val stop : ?label:string -> unit -> unit 101 | 102 | (** [Console.Timer.log ?label ?payload ()] logs the current value of a timer. 103 | with a given [label] (if the [label] is not given, it will use ["default"] 104 | as a label). A [payload] can be also dumped. *) 105 | val log : ?label:string -> ?payload:'a -> unit -> unit 106 | end 107 | 108 | (** {1 Counter} *) 109 | 110 | module Counter : sig 111 | (** Allows you to tick (and log) and reset counters from the console. *) 112 | 113 | (** Returns the default label, used when no specific label is given to the 114 | following functions. *) 115 | val default_label : string 116 | 117 | (** [Console.Counter.tick ?label ()] logs the number of times that this 118 | particular call to [tick] has been called for a given [label]. (if the 119 | [label] is not given, it will use ["default"] as a label) *) 120 | val tick : ?label:string -> unit -> unit 121 | 122 | (** [Console.Counter.reset ?label ()] resets counter of a given [label] (if 123 | the [label] is not given, it will use ["default"] as a label). *) 124 | val reset : ?label:string -> unit -> unit 125 | end 126 | 127 | (** {1 Indent} 128 | 129 | This is usually referred to as [groups]. But it allows you to build 130 | indentation levels in console logging. *) 131 | 132 | module Indent : sig 133 | (** Add or remove indentation levels in the console. *) 134 | 135 | (** [Console.Indent.increase ?collapsed ?label ()] creates an indentation 136 | level (which may or may not be open via the [collapsed] parameter and may 137 | or may not have a textual [label]). *) 138 | val increase : ?collapsed:bool -> ?label:string -> unit -> unit 139 | 140 | (** [Console.Ident.decrease ()] reduce the current level of indentation. *) 141 | val decrease : unit -> unit 142 | end 143 | -------------------------------------------------------------------------------- /lib/js/optional.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | open Js_of_ocaml 24 | 25 | module Make (R : Interfaces.FOLDABLE_OPTION) = struct 26 | include R 27 | 28 | let halt () = empty 29 | let iter f x = fold (fun () -> ()) f x 30 | 31 | let equal f left right = 32 | let left_is_empty () = fold (fun () -> true) (fun _ -> false) right 33 | and left_is_filled left = fold (fun () -> false) (f left) right in 34 | fold left_is_empty left_is_filled left 35 | ;; 36 | 37 | let test x = fold (fun () -> false) (fun _ -> true) x 38 | let value ~default x = fold (fun () -> default) (fun x -> x) x 39 | let to_option x = fold (fun () -> None) Stdlib.Option.some x 40 | let from_option x = Stdlib.Option.fold ~none:empty ~some:fill x 41 | let to_opt x = fold (fun () -> Js.Opt.empty) Js.Opt.return x 42 | let from_opt x = Js.Opt.case x halt fill 43 | let to_optdef x = fold (fun () -> Js.Optdef.empty) Js.Optdef.return x 44 | let from_optdef x = Js.Optdef.case x halt fill 45 | 46 | let traverse_aux wrap map f = 47 | fold (fun () -> wrap empty) (fun x -> map fill (f x)) 48 | ;; 49 | 50 | module Functor = Preface.Make.Functor.Via_map (struct 51 | type nonrec 'a t = 'a t 52 | 53 | let map f x = fold halt (fun x -> fill (f x)) x 54 | end) 55 | 56 | module Alt = 57 | Preface.Make.Alt.Over_functor 58 | (Functor) 59 | (struct 60 | type nonrec 'a t = 'a t 61 | 62 | let combine left right = fold (fun () -> right) fill left 63 | end) 64 | 65 | module Alternative = Preface.Make.Alternative.Via_pure_and_apply (struct 66 | type nonrec 'a t = 'a t 67 | 68 | let pure = fill 69 | let neutral = empty 70 | let combine = Alt.combine 71 | 72 | let apply fs xs = 73 | let right f x = pure (f x) in 74 | let left f = fold halt (right f) xs in 75 | fold halt left fs 76 | ;; 77 | end) 78 | 79 | module Applicative = 80 | Preface.Make.Traversable.Join_with_applicative 81 | (Alternative) 82 | (functor 83 | (A : Preface.Specs.APPLICATIVE) 84 | -> 85 | Preface.Make.Traversable.Over_applicative 86 | (A) 87 | (struct 88 | type 'a iter = 'a t 89 | type 'a t = 'a A.t 90 | 91 | let traverse f x = traverse_aux A.pure A.map f x 92 | end)) 93 | 94 | module Monad_plus = Preface.Make.Monad_plus.Via_bind (struct 95 | include Alternative 96 | 97 | let return = fill 98 | let bind f x = fold halt f x 99 | end) 100 | 101 | module Monad = 102 | Preface.Make.Traversable.Join_with_monad 103 | (Monad_plus) 104 | (functor 105 | (M : Preface.Specs.MONAD) 106 | -> 107 | Preface.Make.Traversable.Over_monad 108 | (M) 109 | (struct 110 | type 'a iter = 'a t 111 | type 'a t = 'a M.t 112 | 113 | let traverse f x = traverse_aux M.return M.map f x 114 | end)) 115 | 116 | module Selective = 117 | Preface.Make.Selective.Over_applicative_via_select 118 | (Applicative) 119 | (Preface.Make.Selective.Select_from_monad (Monad)) 120 | 121 | module Foldable = Preface.Make.Foldable.Via_fold_right (struct 122 | type nonrec 'a t = 'a t 123 | 124 | let fold_right f x acc = fold (fun () -> acc) (fun x -> f x acc) x 125 | end) 126 | 127 | module Infix = struct 128 | let ( <$> ), ( <&> ), ( <$ ), ( $> ) = 129 | Functor.Infix.(( <$> ), ( <&> ), ( <$ ), ( $> )) 130 | ;; 131 | 132 | let ( <*> ), ( <**> ), ( *> ), ( <* ) = 133 | Applicative.Infix.(( <*> ), ( <**> ), ( *> ), ( <* )) 134 | ;; 135 | 136 | let ( <|> ) = Alternative.Infix.( <|> ) 137 | 138 | let ( <*? ), ( <||> ), ( <&&> ) = 139 | Selective.Infix.(( <*? ), ( <||> ), ( <&&> )) 140 | ;; 141 | 142 | let ( =|< ), ( >|= ), ( >>= ), ( =<< ), ( >=> ), ( <=< ), ( >> ), ( << ) = 143 | Monad.Infix.( 144 | ( =|< ), ( >|= ), ( >>= ), ( =<< ), ( >=> ), ( <=< ), ( >> ), ( << )) 145 | ;; 146 | end 147 | 148 | module Syntax = struct 149 | include Applicative.Syntax 150 | 151 | let ( let* ) = Monad.Syntax.( let* ) 152 | end 153 | 154 | include Syntax 155 | include Infix 156 | end 157 | 158 | module Option = Make (struct 159 | type 'a t = 'a option 160 | 161 | let empty = None 162 | let fill x = Some x 163 | 164 | let fold n s = function 165 | | None -> n () 166 | | Some x -> s x 167 | ;; 168 | 169 | let pp pp' formater = function 170 | | None -> Format.fprintf formater "None" 171 | | Some x -> Format.fprintf formater "@[<2>Some@ @[%a@]@]" pp' x 172 | ;; 173 | end) 174 | 175 | module Nullable = Make (struct 176 | type 'a t = 'a Js.Opt.t 177 | 178 | let empty = Js.Opt.empty 179 | let fill x = Js.Opt.return x 180 | let fold n s x = Js.Opt.case x n s 181 | 182 | let pp pp' formater x = 183 | fold 184 | (fun () -> Format.fprintf formater "Js.null") 185 | (fun x -> Format.fprintf formater "@[<2>Js.not_null@ @[%a@]@]" pp' x) 186 | x 187 | ;; 188 | end) 189 | 190 | module Undefinable = Make (struct 191 | type 'a t = 'a Js.Optdef.t 192 | 193 | let empty = Js.Optdef.empty 194 | let fill x = Js.Optdef.return x 195 | let fold n s x = Js.Optdef.case x n s 196 | 197 | let pp pp' formater x = 198 | fold 199 | (fun () -> Format.fprintf formater "Js.undefined") 200 | (fun x -> 201 | Format.fprintf formater "@[<2>Js.not_undefined@ @[%a@]@]" pp' x) 202 | x 203 | ;; 204 | end) 205 | -------------------------------------------------------------------------------- /lib/service/endpoint.ml: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | type (_, _, _) path = 24 | | GET : 25 | ('continuation, 'witness) Path.t 26 | -> ([> `GET ], 'continuation, 'witness) path 27 | | POST : 28 | ('continuation, 'witness) Path.t 29 | -> ([> `POST ], 'continuation, 'witness) path 30 | | PUT : 31 | ('continuation, 'witness) Path.t 32 | -> ([> `PUT ], 'continuation, 'witness) path 33 | | DELETE : 34 | ('continuation, 'witness) Path.t 35 | -> ([> `DELETE ], 'continuation, 'witness) path 36 | | HEAD : 37 | ('continuation, 'witness) Path.t 38 | -> ([> `HEAD ], 'continuation, 'witness) path 39 | | CONNECT : 40 | ('continuation, 'witness) Path.t 41 | -> ([> `CONNECT ], 'continuation, 'witness) path 42 | | OPTIONS : 43 | ('continuation, 'witness) Path.t 44 | -> ([> `OPTIONS ], 'continuation, 'witness) path 45 | | TRACE : 46 | ('continuation, 'witness) Path.t 47 | -> ([> `TRACE ], 'continuation, 'witness) path 48 | | PATCH : 49 | ('continuation, 'witness) Path.t 50 | -> ([> `PATCH ], 'continuation, 'witness) path 51 | 52 | type (_, _, _, _) t = 53 | | Inner : 54 | ('m, 'continuation, 'witness) path 55 | -> ([> `Inner ], 'm, 'continuation, 'witness) t 56 | | Outer : 57 | string * ('m, 'continuation, 'witness) path 58 | -> ([> `Outer ], 'm, 'continuation, 'witness) t 59 | 60 | type ('scope, 'method_, 'continuation, 'witness) wrapped = 61 | unit -> ('scope, 'method_, 'continuation, 'witness) t 62 | 63 | let inner x = Inner x 64 | let get x = inner @@ GET x 65 | let post x = inner @@ POST x 66 | let put x = inner @@ PUT x 67 | let delete x = inner @@ DELETE x 68 | let head x = inner @@ HEAD x 69 | let connect x = inner @@ CONNECT x 70 | let options x = inner @@ OPTIONS x 71 | let trace x = inner @@ TRACE x 72 | let patch x = inner @@ PATCH x 73 | 74 | let outer 75 | : (('continuation, 'witness) Path.t 76 | -> ([ `Inner ], 'method_, 'continuation, 'witness) t) 77 | -> string -> ('continuation, 'witness) Path.t 78 | -> ([> `Outer ], 'method_, 'continuation, 'witness) t 79 | = 80 | fun f prefix path -> 81 | match f path with 82 | | Inner p -> Outer (prefix, p) 83 | ;; 84 | 85 | let get_path 86 | : type method_ continuation witness. 87 | (method_, continuation, witness) path -> (continuation, witness) Path.t 88 | = function 89 | | GET p 90 | | POST p 91 | | PUT p 92 | | DELETE p 93 | | HEAD p 94 | | CONNECT p 95 | | OPTIONS p 96 | | TRACE p 97 | | PATCH p -> p 98 | ;; 99 | 100 | let handle_path_with 101 | : type scope method_ continuation witness. 102 | (scope, method_, continuation, witness) wrapped 103 | -> (string -> witness) 104 | -> continuation 105 | = 106 | fun endpoint handler -> 107 | match endpoint () with 108 | | Inner p -> 109 | let path = get_path p in 110 | Path.sprintf_with path handler 111 | | Outer (suffix, p) -> 112 | let path = get_path p in 113 | Path.sprintf_with path (fun str -> handler @@ suffix ^ str) 114 | ;; 115 | 116 | let render_anchor = function 117 | | None -> "" 118 | | Some x -> if String.(equal x empty) then "" else "#" ^ x 119 | ;; 120 | 121 | let render_key_value key value = key ^ "=" ^ value 122 | 123 | let render_parameters = function 124 | | None | Some [] -> "" 125 | | Some params -> 126 | let query_string = 127 | List.fold_left 128 | (fun acc (key, value) -> 129 | let key_value = render_key_value key value in 130 | match acc with 131 | | None -> Some key_value 132 | | Some x -> Some (x ^ "&" ^ key_value)) 133 | None 134 | params 135 | in 136 | Option.fold ~none:"" ~some:(fun qs -> "?" ^ qs) query_string 137 | ;; 138 | 139 | let gen_link ?anchor ?parameters endpoint handler = 140 | let anchor = render_anchor anchor 141 | and query_string = render_parameters parameters in 142 | handle_path_with endpoint (fun link -> 143 | handler @@ link ^ query_string ^ anchor) 144 | ;; 145 | 146 | let href_with = gen_link 147 | 148 | let href ?anchor ?parameters endpoint = 149 | href_with ?anchor ?parameters endpoint (fun x -> x) 150 | ;; 151 | 152 | let form_action_with = href_with 153 | let form_action = href 154 | 155 | let form_method 156 | : type scope. 157 | (scope, Method.for_form_action, _, _) wrapped -> [> Method.for_form_action ] 158 | = 159 | fun endpoint -> 160 | match endpoint () with 161 | | Inner (GET _) | Outer (_, GET _) -> `GET 162 | | Inner (POST _) | Outer (_, POST _) -> `POST 163 | ;; 164 | 165 | let sscanf endpoint given_method given_uri = 166 | let aux : ([ `Inner ], Method.t, _, _) wrapped -> _ = 167 | fun endpoint -> 168 | let (Inner p) = endpoint () in 169 | match p, (given_method :> Method.t) with 170 | | GET path, `GET 171 | | POST path, `POST 172 | | PUT path, `PUT 173 | | DELETE path, `DELETE 174 | | HEAD path, `HEAD 175 | | CONNECT path, `CONNECT 176 | | OPTIONS path, `OPTIONS 177 | | TRACE path, `TRACE 178 | | PATCH path, `PATCH -> Path.sscanf path given_uri 179 | | _ -> fun _ -> None 180 | in 181 | aux endpoint 182 | ;; 183 | 184 | module Infix = Path.Infix 185 | include Path.Infix 186 | module Variables = Path.Preset 187 | include Path.Preset 188 | 189 | let root = Path.root 190 | 191 | let method_of : type scope. (scope, Method.t, _, _) wrapped -> [> Method.t ] = 192 | fun endpoint -> 193 | let (Inner x | Outer (_, x)) = endpoint () in 194 | match x with 195 | | GET _ -> `GET 196 | | POST _ -> `POST 197 | | PUT _ -> `PUT 198 | | DELETE _ -> `DELETE 199 | | HEAD _ -> `HEAD 200 | | CONNECT _ -> `CONNECT 201 | | OPTIONS _ -> `OPTIONS 202 | | TRACE _ -> `TRACE 203 | | PATCH _ -> `PATCH 204 | ;; 205 | -------------------------------------------------------------------------------- /lib/js/fetch.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** The global fetch() method starts the process of fetching a resource from the 24 | network, returning a promise which is fulfilled once the response is 25 | available. *) 26 | 27 | open Js_of_ocaml 28 | 29 | (** {1 Types} *) 30 | 31 | type body = 32 | [ `Blob of Blob.t 33 | | `FormData of Form_data.t 34 | | `UrlSearchParams of Url_search_params.t 35 | | `String of string 36 | | `ReadableStream of Typed_array.uint8Array Js.t Stream.Readable.t 37 | ] 38 | 39 | type mode = 40 | [ `Cors 41 | | `No_cors 42 | | `Same_origin 43 | ] 44 | 45 | type credentials = 46 | [ `Omit 47 | | `Same_origin 48 | | `Include 49 | ] 50 | 51 | type cache = 52 | [ `Default 53 | | `No_store 54 | | `Reload 55 | | `No_cache 56 | | `Force_cache 57 | | `Only_if_cached 58 | ] 59 | 60 | type redirect = 61 | [ `Follow 62 | | `Error 63 | | `Manual 64 | ] 65 | 66 | type referrer = 67 | [ `No_referrer 68 | | `Client 69 | | `Refer_to of string 70 | ] 71 | 72 | type referrer_policy = 73 | [ `No_referrer 74 | | `No_referrer_when_downgrade 75 | | `Origin 76 | | `Origin_when_cross_origin 77 | | `Unsafe_url 78 | ] 79 | 80 | type response_type = 81 | [ `Basic 82 | | `Cors 83 | | `Error 84 | | `Opaque 85 | | `Opaque_redirect 86 | ] 87 | 88 | (** {1 Response} *) 89 | 90 | module Response : sig 91 | (** The Response interface of the Fetch API represents the response to a 92 | request. *) 93 | 94 | type t = Bindings.fetch_response Js.t 95 | 96 | val headers : t -> Headers.t 97 | val is_ok : t -> bool 98 | val is_redirected : t -> bool 99 | val status : t -> int 100 | val type_ : t -> response_type 101 | val url : t -> string 102 | val body : t -> Typed_array.uint8Array Js.t Stream.Readable.t 103 | val text : t -> string Lwt.t 104 | val array_buffer : t -> Typed_array.arrayBuffer Js.t Lwt.t 105 | val blob : t -> Blob.t Lwt.t 106 | val form_data : t -> Form_data.t Lwt.t 107 | end 108 | 109 | (** {1 API} *) 110 | 111 | (** A [fetch] promise only rejects when a network error is encountered (which is 112 | usually when there's a permissions issue or similar). A fetch() promise does 113 | not reject on HTTP errors (404, etc.). Instead, a then() handler must check 114 | the Response.ok and/or Response.status properties. *) 115 | 116 | (** [fetch ~method_ target] perform a [fetch] request. *) 117 | val fetch 118 | : ?headers:Headers.t 119 | -> ?body:body 120 | -> ?mode:mode 121 | -> ?credentials:credentials 122 | -> ?cache:cache 123 | -> ?redirect:redirect 124 | -> ?referrer:referrer 125 | -> ?referrer_policy:referrer_policy 126 | -> ?integrity:string 127 | -> ?keepalive:bool 128 | -> method_:[< Nightmare_service.Method.t ] 129 | -> string 130 | -> Response.t Lwt.t 131 | 132 | (** {2 Specialized fetch} *) 133 | 134 | val get 135 | : ?headers:Headers.t 136 | -> ?mode:mode 137 | -> ?credentials:credentials 138 | -> ?cache:cache 139 | -> ?redirect:redirect 140 | -> ?referrer:referrer 141 | -> ?referrer_policy:referrer_policy 142 | -> ?integrity:string 143 | -> ?keepalive:bool 144 | -> string 145 | -> Response.t Lwt.t 146 | 147 | val head 148 | : ?headers:Headers.t 149 | -> ?mode:mode 150 | -> ?credentials:credentials 151 | -> ?cache:cache 152 | -> ?redirect:redirect 153 | -> ?referrer:referrer 154 | -> ?referrer_policy:referrer_policy 155 | -> ?integrity:string 156 | -> ?keepalive:bool 157 | -> string 158 | -> Response.t Lwt.t 159 | 160 | val post 161 | : ?headers:Headers.t 162 | -> ?body:body 163 | -> ?mode:mode 164 | -> ?credentials:credentials 165 | -> ?cache:cache 166 | -> ?redirect:redirect 167 | -> ?referrer:referrer 168 | -> ?referrer_policy:referrer_policy 169 | -> ?integrity:string 170 | -> ?keepalive:bool 171 | -> string 172 | -> Response.t Lwt.t 173 | 174 | val put 175 | : ?headers:Headers.t 176 | -> ?body:body 177 | -> ?mode:mode 178 | -> ?credentials:credentials 179 | -> ?cache:cache 180 | -> ?redirect:redirect 181 | -> ?referrer:referrer 182 | -> ?referrer_policy:referrer_policy 183 | -> ?integrity:string 184 | -> ?keepalive:bool 185 | -> string 186 | -> Response.t Lwt.t 187 | 188 | val delete 189 | : ?headers:Headers.t 190 | -> ?body:body 191 | -> ?mode:mode 192 | -> ?credentials:credentials 193 | -> ?cache:cache 194 | -> ?redirect:redirect 195 | -> ?referrer:referrer 196 | -> ?referrer_policy:referrer_policy 197 | -> ?integrity:string 198 | -> ?keepalive:bool 199 | -> string 200 | -> Response.t Lwt.t 201 | 202 | val connect 203 | : ?headers:Headers.t 204 | -> ?body:body 205 | -> ?mode:mode 206 | -> ?credentials:credentials 207 | -> ?cache:cache 208 | -> ?redirect:redirect 209 | -> ?referrer:referrer 210 | -> ?referrer_policy:referrer_policy 211 | -> ?integrity:string 212 | -> ?keepalive:bool 213 | -> string 214 | -> Response.t Lwt.t 215 | 216 | val options 217 | : ?headers:Headers.t 218 | -> ?body:body 219 | -> ?mode:mode 220 | -> ?credentials:credentials 221 | -> ?cache:cache 222 | -> ?redirect:redirect 223 | -> ?referrer:referrer 224 | -> ?referrer_policy:referrer_policy 225 | -> ?integrity:string 226 | -> ?keepalive:bool 227 | -> string 228 | -> Response.t Lwt.t 229 | 230 | val trace 231 | : ?headers:Headers.t 232 | -> ?body:body 233 | -> ?mode:mode 234 | -> ?credentials:credentials 235 | -> ?cache:cache 236 | -> ?redirect:redirect 237 | -> ?referrer:referrer 238 | -> ?referrer_policy:referrer_policy 239 | -> ?integrity:string 240 | -> ?keepalive:bool 241 | -> string 242 | -> Response.t Lwt.t 243 | 244 | val patch 245 | : ?headers:Headers.t 246 | -> ?body:body 247 | -> ?mode:mode 248 | -> ?credentials:credentials 249 | -> ?cache:cache 250 | -> ?redirect:redirect 251 | -> ?referrer:referrer 252 | -> ?referrer_policy:referrer_policy 253 | -> ?integrity:string 254 | -> ?keepalive:bool 255 | -> string 256 | -> Response.t Lwt.t 257 | 258 | (** {2 Fetch from endpoint} *) 259 | 260 | val from 261 | : ?parameters:(string * string) list 262 | -> ?headers:Headers.t 263 | -> ?body:body 264 | -> ?mode:mode 265 | -> ?credentials:credentials 266 | -> ?cache:cache 267 | -> ?redirect:redirect 268 | -> ?referrer:referrer 269 | -> ?referrer_policy:referrer_policy 270 | -> ?integrity:string 271 | -> ?keepalive:bool 272 | -> ( _ 273 | , Nightmare_service.Method.t 274 | , 'continuation 275 | , Response.t Lwt.t ) 276 | Nightmare_service.Endpoint.wrapped 277 | -> 'continuation 278 | -------------------------------------------------------------------------------- /lib/js/storage.mli: -------------------------------------------------------------------------------- 1 | (* MIT License 2 | 3 | Copyright (c) 2023 funkywork 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 | 23 | (** {1 Common types} *) 24 | 25 | (** Describes the change of state of a storage. Mostly used for event handling. *) 26 | type ('key, 'value) change = ('key, 'value) Interfaces.storage_change_state = 27 | | Clear 28 | | Insert of 29 | { key : 'key 30 | ; value : 'value 31 | } 32 | | Remove of 33 | { key : 'key 34 | ; old_value : 'value 35 | } 36 | | Update of 37 | { key : 'key 38 | ; old_value : 'value 39 | ; new_value : 'value 40 | } 41 | 42 | (** {1 Storage Event} *) 43 | 44 | (** The type that describe a storage event (emit by [Local] or [Session] 45 | storage)*) 46 | type event = Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t 47 | 48 | (** The value of a storage event. Used for the function [addEventListener]. *) 49 | val event : event Js_of_ocaml.Dom.Event.typ 50 | 51 | (** {1 Common signatures} *) 52 | 53 | module type REQUIREMENT = Interfaces.STORAGE_REQUIREMENT 54 | module type S = Interfaces.STORAGE 55 | 56 | (** {1 Exception} 57 | 58 | Exceptions are not supposed to appear, they are only present to make the API 59 | complete. *) 60 | 61 | (** In the age of our modern browsers, this exception should never be launched. *) 62 | exception Not_supported 63 | 64 | (** {1 Create a storage} *) 65 | 66 | module Make (Req : REQUIREMENT) : 67 | S with type key = string and type value = string 68 | 69 | (** {1 Predefined storages} *) 70 | 71 | module Local : S with type key = string and type value = string 72 | module Session : S with type key = string and type value = string 73 | 74 | (** {1 References} 75 | 76 | A reference is similar to OCaml's [ref] except that it is persisted in an 77 | associated backend. ([Local] or [Session]), however, as deletion of storage 78 | is not controllable, they always return options. A key is prefixed, which is 79 | a poor way of making a scope. *) 80 | 81 | module type VALUE = Interfaces.STORAGE_SERIALIZABLE 82 | module type KEY = Interfaces.PREFIXED_KEY 83 | 84 | (** A functor to build particular kind of references. *) 85 | module Ref 86 | (Backend : S with type key = string and type value = string) 87 | (Key : KEY) 88 | (Value : VALUE) : sig 89 | (** The type that describe a Ref. *) 90 | type t 91 | 92 | (** [make key] build a new reference indexed by [key]. *) 93 | val make : string -> t 94 | 95 | (** [make_with key value] build a new reference indexed by the given [key] and 96 | with the given value. *) 97 | val make_with : string -> Value.t -> t 98 | 99 | (** [make_if_not_exists key value] build a new reference indexed by the given 100 | [key] and if the value does not exists, it fill it with the given [value]. *) 101 | val make_if_not_exists : string -> Value.t -> t 102 | 103 | (** [set reference value] set the [value] of the given [reference]. *) 104 | val set : t -> Value.t -> unit 105 | 106 | (** [get reference] returns the value of the [given] reference. As the backend 107 | is not controlled by the library, the result is wrapped into an option. *) 108 | val get : t -> Value.t option 109 | 110 | (** [unset reference] remove the value positionned at the indexed reference. *) 111 | val unset : t -> unit 112 | 113 | (** {1 Events Handling} *) 114 | 115 | (** [on ?capture ?once ?passive ?prefix] sets up a function that will be 116 | called whenever the storage change. It return an [event_listener_id] (in 117 | order to be revoked). A [prefix]. a prefix can be given to filter on keys 118 | starting only with the prefix. *) 119 | val on 120 | : ?capture:bool 121 | -> ?once:bool 122 | -> ?passive:bool 123 | -> key:string 124 | -> ((t, Value.t) change 125 | -> Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t 126 | -> unit) 127 | -> Js_of_ocaml.Dom.event_listener_id 128 | 129 | (** A specialized version of {!val:on} only for storage insertion. *) 130 | val on_insert 131 | : ?capture:bool 132 | -> ?once:bool 133 | -> ?passive:bool 134 | -> key:string 135 | -> (key:t 136 | -> value:Value.t 137 | -> Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t 138 | -> unit) 139 | -> Js_of_ocaml.Dom.event_listener_id 140 | 141 | (** A specialized version of {!val:on} only for storage deletion (the value of 142 | the handler contains the deleted value). *) 143 | val on_remove 144 | : ?capture:bool 145 | -> ?once:bool 146 | -> ?passive:bool 147 | -> key:string 148 | -> (key:t 149 | -> old_value:Value.t 150 | -> Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t 151 | -> unit) 152 | -> Js_of_ocaml.Dom.event_listener_id 153 | 154 | (** A specialized version of {!val:on} only for storage update. *) 155 | val on_update 156 | : ?capture:bool 157 | -> ?once:bool 158 | -> ?passive:bool 159 | -> key:string 160 | -> (key:t 161 | -> old_value:Value.t 162 | -> new_value:Value.t 163 | -> Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t 164 | -> unit) 165 | -> Js_of_ocaml.Dom.event_listener_id 166 | 167 | (** {2 Lwt events} 168 | 169 | Some event description to deal with [js_of_ocaml-lwt] (using 170 | [Lwt_js_event]). *) 171 | 172 | (** Lwt version of [on]. *) 173 | val lwt_on 174 | : ?capture:bool 175 | -> ?passive:bool 176 | -> key:string 177 | -> unit 178 | -> ((t, Value.t) change 179 | * Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t) 180 | Lwt.t 181 | 182 | (** Lwt version of [on_insert]. *) 183 | val lwt_on_insert 184 | : ?capture:bool 185 | -> ?passive:bool 186 | -> key:string 187 | -> unit 188 | -> (t * Value.t * Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t) Lwt.t 189 | 190 | (** Lwt version of [on_remove]. *) 191 | val lwt_on_remove 192 | : ?capture:bool 193 | -> ?passive:bool 194 | -> key:string 195 | -> unit 196 | -> (t * Value.t * Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t) Lwt.t 197 | 198 | (** Lwt version of [on_update]. *) 199 | val lwt_on_update 200 | : ?capture:bool 201 | -> ?passive:bool 202 | -> key:string 203 | -> unit 204 | -> (t 205 | * Value.t 206 | * [ `Old_value of Value.t ] 207 | * Js_of_ocaml.Dom_html.storageEvent Js_of_ocaml.Js.t) 208 | Lwt.t 209 | 210 | (** {1 Infix Operators} *) 211 | 212 | module Infix : sig 213 | (** [!reference] is [get reference]. *) 214 | val ( ! ) : t -> Value.t option 215 | 216 | (** [reference := value] is [set reference value]. *) 217 | val ( := ) : t -> Value.t -> unit 218 | end 219 | 220 | include module type of Infix (** @inline*) 221 | end 222 | --------------------------------------------------------------------------------