├── .gitignore ├── .travis-ci.sh ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── Makefile ├── Readme.md ├── benchmark ├── angstrom_rFC2616.ml ├── benchmark_angstrom.ml ├── data │ ├── http-requests.txt │ └── replicate ├── dune └── rFC2616.ml ├── dune-project ├── examples ├── dims.ml ├── dune └── ini.ml ├── src ├── dune ├── tyre.ml └── tyre.mli ├── test ├── dune ├── test.ml └── test.mli └── tyre.opam /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.byte 3 | *.native 4 | .gh-pages 5 | perf.* 6 | .merlin 7 | *.install 8 | 9 | benchmark/data/http-requests.txt.* 10 | -------------------------------------------------------------------------------- /.travis-ci.sh: -------------------------------------------------------------------------------- 1 | bash -ex .travis-opam.sh 2 | 3 | ## Documentation stuff 4 | 5 | set -e 6 | # Make sure we're not echoing any sensitive data 7 | set +x 8 | set -o errexit -o nounset 9 | 10 | if [ -z "${DOC+x}" ]; then 11 | echo "This is not a push Travis-ci build, doing nothing..." 12 | exit 0 13 | else 14 | echo "Building docs..." 15 | fi 16 | 17 | eval `opam config env` 18 | opam install -y odoc 19 | make doc 20 | 21 | if [ -z "$TRAVIS" \ 22 | -o "$TRAVIS_PULL_REQUEST" != "false" \ 23 | -o "$TRAVIS_BRANCH" != "master" \ 24 | -o -z "${DOC+x}" \ 25 | ]; then 26 | echo "This is not a push Travis-ci build, doing nothing..." 27 | exit 0 28 | else 29 | echo "Updating docs on Github pages..." 30 | fi 31 | 32 | DOCDIR=.gh-pages 33 | 34 | # Error out if $GH_TOKEN is empty or unset 35 | : ${GH_TOKEN:?"GH_TOKEN need to be uploaded via travis-encrypt"} 36 | 37 | git clone https://${GH_TOKEN}@github.com/${TRAVIS_REPO_SLUG} $DOCDIR 2>&1 | sed -e "s/$GH_TOKEN/!REDACTED!/g" 38 | git -C $DOCDIR checkout gh-pages || git -C $DOCDIR checkout --orphan gh-pages 39 | 40 | cp -r _build/default/_doc/_html/* ${DOCDIR}/doc/dev/ 41 | 42 | git -C $DOCDIR config user.email "travis@travis-ci.org" 43 | git -C $DOCDIR config user.name "Travis" 44 | git -C $DOCDIR add --all 45 | git -C $DOCDIR commit --allow-empty -m "Travis build $TRAVIS_BUILD_NUMBER pushed docs to gh-pages" 46 | git -C $DOCDIR push origin gh-pages 2>&1 | sed -e "s/$GH_TOKEN/!REDACTED!/g" 47 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh 4 | script: bash -ex .travis-ci.sh 5 | env: 6 | global: 7 | - PINS="tyre:." 8 | - PACKAGE=tyre 9 | - secure: GKTOZklOf/ZyPCWOEw89ECtSzNtLy+UBJXeruNuogWEPVd00Z01I0xncvnpf2+PKeyDaVXF7x/3XsxUxnXa0rBL/KLvdPX4zEdI0LB+ck8TaE33Q+sorxvjFIcN+arbdFbkNyqVy1nQrBq1n9OlM+HHBKO1clDbitgAb23rWzmRiC4742gY+SoNIl3LSVfA0JlOdth1UOwKpDhJC4r4LeeOJrmz0aefKvgAet/nmoEebv63Onghdiamx55e5CGEEecIXal7Goi02QAHmc8SFe/FfJxzpWiFHILpjTO/a58BwMu82UxKwpaYJFIcQ9GZMIW+eT+58VBitNzfM6YBQMhALCIOcz9Ed8oA+4Tiu9P5I8ls5th0LkQ5ln67F0LhjcaI+UYYAAsY7wiFFaQzsPmt0YZ+gX6Q1pM5Wy1wpD5wsiYjoGABnw2mmZDZSs5ftWUxMc42hxt/Z46hMRylf+OrQkqzvgCVEO6ScqtcCOdqZjbAn5Ydo3xoEfipbxs+IxQMulKWhNsXwhxgjYFbKHfsvmqs589iRFzMUmvd+zaEqhXSWencPBLr6w/D8CRGKIu8f1wKBHnfWca2R4zQ0OPYxnLijWuUb8Ty6wfbqeSvjWTj+6AuQxEwLDZiuT1f0DAvJFBcnrLEjqG3tPuHJ96oc3p/KUTrpZZER9SJ/8zw= 10 | - secure: oAAhgDvYsF5Yc6zMevCNu4hogt6I/Z9F9kAA9XUndvk5jdDN0iQo3dQaDmKpRQaVBvypRyX1PcXYTqgqu1mISUyiw3/fhwx1IZc9P4/mViOSnifgvSqGaB7FY8wMb7jdVcX1etz+VmBBoHlUiPPNKYz1L6fD+0xlvPToChcdLWzmo36z7r+RnmNKfKkrDuAYZhT8A/IjQpBT7auItVOdTFOTU8GMdb42IRum5vDBYo2A33SzbStaNu6KEx2LVCw8TPGxL8SAjLGZWrindXcOy7Eh38hQJUgswQBbchkKloPwGPbjdInobo2aR7MB7P76kqkSkbobxbuKhyKV5VWlLbXIzqj52CvKwP0+Ark/JUW7G8G7FWW+H5xcYPwF01Xwc/yCvDZEmWy8eXlVdnBah3SPUIFxZEWYQbGc3kvmvf+xtFUOJVTB0olq1WATfWtB8BXhii8a0nlKmUqC127LjZejnxLYNZqn9kwNTjwy0GIp01jfBiVcngBF+WEpD26FmYcvF+NVeVRL6HQ9c4Uz5RVc59w4M5tkvbu/9BrOQFMlJVfOo91nanMY7BMPSfBfO4SSGDvgTVmtEa1WVMwqsMB2n2hzuCPPggZyg/4NsW5waLFXv8Zuwalv1uFx+3hImYyaSa3CmrvC/TRBGT4k7Huvmc9FJA4aQ7hENrvUs8I= 11 | matrix: 12 | include: 13 | - os: linux 14 | env: OCAML_VERSION=4.03 15 | - os: linux 16 | env: OCAML_VERSION=4.04 17 | - os: linux 18 | env: OCAML_VERSION=4.05 19 | - os: linux 20 | env: OCAML_VERSION=4.06 21 | - os: linux 22 | env: OCAML_VERSION=4.07 23 | - os: linux 24 | env: OCAML_VERSION=4.08 25 | - os: linux 26 | env: OCAML_VERSION=4.09 DOC=true 27 | - os: osx 28 | env: OCAML_VERSION=4.09 29 | - os: linux 30 | env: OCAML_VERSION=4.09 REVDEPS=true 31 | allow_failures: 32 | - os: linux 33 | env: OCAML_VERSION=4.09 REVDEPS=true 34 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # 0.5 (24 January 2020) 2 | 3 | * Move to dune 4 | * Avoid deprecate Re functions 5 | 6 | # 0.4.1 (17 August 2018) 7 | 8 | * Reverts the removal of Re.marks. 9 | This fixes various bugs in the previous version. 10 | 11 | # 0.4 (06 August 2018) 12 | 13 | * Move to dune 14 | * Remove the need for Re.marks. 15 | This might open the way to alterative backends, such as JS regexs. 16 | See https://github.com/Drup/tyre/issues/1 for details. 17 | * Use Seq instead of Gen. This is a breaking change. 18 | 19 | # 0.3 (17 April 2017) 20 | 21 | * Performance improvements. 22 | * Fix the behavior of opt (Prefer eating input). 23 | * Remove conv_fail and allow usual converters to fail with an exception. 24 | * Add Tyre.all and Tyre.all_gen 25 | 26 | # 0.2 (08 October 2016) 27 | * Rename `` to `<|>` 28 | * Rename `<*>` to `<&>` 29 | * Add the `str` and `char` combinators for constant patterns. 30 | * Add the `blank` combinator. 31 | * Add an Infix module. 32 | * `Tyre.conv` is now separated into two combinators, `conv` which doesn't use 33 | an option, but is not allowed to fail, and `conv_fail` which allows failures. 34 | * The prefix (`<*`) and suffix (`*>`) operators now accepts tyregexs on both 35 | sides. The old behavior can be recovered by combining with `Tyre.str`. 36 | This makes prefixstr/suffixstr (`**>`/`<**`) redundant, they are removed. 37 | * The various list combinators now accept a tyregex as separator. 38 | The old behavior can be recovered by combining with `Tyre.str`. 39 | * Add the `start` and `stop` combinators. 40 | * The ~whole argument for compile and route is removed. 41 | tyregex don't match the whole string by default anymore. 42 | You can use `Tyre.whole_string` or `Tyre.start` and `Tyre.stop` instead. 43 | 44 | # 0.1.1 (09 September 2016) 45 | * Fix a bug with nested repetitions. Also avoid some copying of the original string. 46 | * Add Tyre.execp 47 | 48 | # 0.1 (11 August 2016) 49 | First version :tada: 50 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 year, Gabriel Radanne 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. 4 | 5 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: default 2 | default: build 3 | 4 | .PHONY: build 5 | build: 6 | dune build @install 7 | 8 | .PHONY: test 9 | test: 10 | dune runtest 11 | 12 | .PHONY: clean 13 | clean: 14 | dune clean 15 | 16 | .PHONY: doc 17 | doc: 18 | dune build @doc 19 | 20 | NAME=tyre 21 | DOCDIR=.gh-pages 22 | 23 | $(DOCDIR)/.git: 24 | mkdir -p $(DOCDIR) 25 | cd $(DOCDIR) && (\ 26 | git clone -b gh-pages git@github.com:Drup/$(NAME).git . \ 27 | ) 28 | 29 | gh-pages: $(DOCDIR)/.git doc 30 | cp -r _build/default/_doc/_html/* $(DOCDIR)/doc/dev/ 31 | git -C $(DOCDIR) add --all 32 | git -C $(DOCDIR) commit -a -m "gh-page updates" 33 | git -C $(DOCDIR) push origin gh-pages 34 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # Tyre [![Build Status](https://travis-ci.org/Drup/tyre.svg?branch=master)](https://travis-ci.org/Drup/tyre) [![docs](https://img.shields.io/badge/doc-online-blue.svg)][doc] 2 | 3 | Tyre is a set of combinators to build type-safe regular expressions, allowing automatic extraction and modification of matched groups. 4 | 5 | Tyre is bi-directional: a typed regular expressions can be used for parsing and unparsing. It also allows routing, by providing a list of regexs/routes and their handlers. 6 | 7 | Tyre is pure OCaml and uses [re][]. To install it: 8 | 9 | ``` 10 | opam install tyre 11 | ``` 12 | 13 | Documentation is available [here][doc]. See also the [examples/](examples/) directory. 14 | A primitive HTTP parser can be found in the [benchmark/](benchmark/) directory. 15 | 16 | [re]: https://github.com/ocaml/ocaml-re 17 | [doc]: https://drup.github.io/tyre/doc/dev/tyre/Tyre/index.html 18 | 19 | ```ocaml 20 | # let dim = Tyre.( str"dim:" *> int <&> str"x" *> int ) ;; 21 | val dim : (int * int) Tyre.t 22 | 23 | # let dim_re = Tyre.compile dim ;; 24 | val dim_re : (int * int) Tyre.re 25 | 26 | # Tyre.exec dim_re "dim:3x4" ;; 27 | - : (int * int, (int * int) Tyre.error) result = Result.Ok (3, 4) 28 | 29 | # Tyre.eval dim (2, 5) ;; 30 | - : string = "dim:2x5" 31 | ``` 32 | 33 | ## Benchmark 34 | 35 | Some benchmarks are available under the [benchmark/](benchmark/) directory. 36 | The benchmark compares the parsing of HTTP requests using angstrom and various 37 | tyre methods. 38 | You can run them with: 39 | ``` 40 | ./benchmark/data/replicate benchmark/data/http-requests.txt 100 41 | jbuilder exec benchmark/benchmark_angstrom.exe -- -a 42 | ``` 43 | -------------------------------------------------------------------------------- /benchmark/angstrom_rFC2616.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-44"] 2 | (* HTTP "parser", copied from angstrom. *) 3 | open Angstrom 4 | 5 | module P = struct 6 | let is_space = 7 | function | ' ' | '\t' -> true | _ -> false 8 | 9 | let is_eol = 10 | function | '\r' | '\n' -> true | _ -> false 11 | 12 | let is_hex = 13 | function | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false 14 | 15 | let is_digit = 16 | function '0' .. '9' -> true | _ -> false 17 | 18 | let is_separator = 19 | function 20 | | ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' 21 | | '/' | '[' | ']' | '?' | '=' | '{' | '}' | ' ' | '\t' -> true 22 | | _ -> false 23 | 24 | let is_token = 25 | (* The commented-out ' ' and '\t' are not necessary because of the range at 26 | * the top of the match. *) 27 | function 28 | | '\000' .. '\031' | '\127' 29 | | ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' 30 | | '/' | '[' | ']' | '?' | '=' | '{' | '}' (* | ' ' | '\t' *) -> false 31 | | _ -> true 32 | end 33 | 34 | let token = take_while1 P.is_token 35 | let digits = take_while1 P.is_digit 36 | let spaces = skip_while P.is_space 37 | 38 | let lex p = p <* spaces 39 | 40 | let version = 41 | string "HTTP/" *> 42 | lift2 (fun major minor -> major, minor) 43 | (digits <* char '.') 44 | digits 45 | 46 | let uri = 47 | take_till P.is_space 48 | 49 | let meth = token 50 | let eol = string "\r\n" 51 | 52 | let request_first_line = 53 | lift3 (fun meth uri version -> (meth, uri, version)) 54 | (lex meth) 55 | (lex uri) 56 | version 57 | 58 | let response_first_line = 59 | lift3 (fun version status msg -> (version, status, msg)) 60 | (lex version) 61 | (lex (take_till P.is_space)) 62 | (take_till P.is_eol) 63 | 64 | let header = 65 | let colon = char ':' <* spaces in 66 | lift2 (fun key value -> (key, value)) 67 | token 68 | (colon *> take_till P.is_eol) 69 | 70 | let request = 71 | lift2 (fun (meth, uri, version) headers -> (meth, uri, version, headers)) 72 | (request_first_line <* eol) 73 | (many (header <* eol) <* eol) 74 | 75 | let response = 76 | lift2 (fun (version, status, msg) headers -> (version, status, msg, headers)) 77 | (response_first_line <* eol) 78 | (many (header <* eol) <* eol) 79 | -------------------------------------------------------------------------------- /benchmark/benchmark_angstrom.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-40-44-48"] 2 | 3 | let length seq = 4 | let rec aux acc seq = match seq () with 5 | | Seq.Nil -> acc 6 | | Cons (_, l) -> aux (acc + 1) l 7 | in 8 | aux 0 seq 9 | 10 | let re = Tyre.compile Tyre.(whole_string @@ rep RFC2616.request) 11 | let tyre s = 12 | match Tyre.exec re s with 13 | | Result.Ok l -> assert (length l = 55 * 100) 14 | | Result.Error _ -> failwith "oups" 15 | 16 | let tyre_test s = 17 | assert (Tyre.execp re s) 18 | 19 | let re2 = Tyre.compile RFC2616.request 20 | let tyre_all s = 21 | match Tyre.all re2 s with 22 | | Result.Ok l -> assert (List.length l = 55 * 100) 23 | | Result.Error _ -> failwith "oups" 24 | let tyre_all_seq s = 25 | let l = Tyre.all_seq re2 s in 26 | assert (length l = 55 * 100) 27 | 28 | let angstrom s = 29 | match Angstrom.(parse_string (many Angstrom_rFC2616.request)) s with 30 | | Result.Ok l -> assert (List.length l = 55 * 100) 31 | | Result.Error _ -> failwith "oups" 32 | 33 | 34 | 35 | let oc = open_in "benchmark/data/http-requests.txt.100" 36 | let s = CCIO.read_all oc 37 | 38 | let l = [ 39 | "tyre", tyre ; 40 | "tyre.all", tyre_all ; 41 | "tyre.all_seq", tyre_all_seq ; 42 | "tyre.test", tyre_test ; 43 | "angstrom", angstrom ; 44 | ] 45 | 46 | 47 | 48 | (** Utilities *) 49 | 50 | let benchs = 51 | let get_sample (name, f) = 52 | name, lazy (Benchmark.latency1 ~style:Nil ~name ~repeat:4 50L f s) 53 | in 54 | List.map get_sample l 55 | 56 | let tree = 57 | let open Benchmark.Tree in 58 | let f (n,s) = n @> s in 59 | concat @@ List.map f benchs 60 | 61 | let samples () = 62 | let f (_,s) l = 63 | if Lazy.is_val s then 64 | Benchmark.merge (Lazy.force s) l 65 | else l 66 | in 67 | List.fold_right f benchs [] 68 | 69 | let () = 70 | let open Benchmark in 71 | let tree = Tree.("http" @>> tree) in 72 | Tree.register tree ; 73 | Tree.run_global () ; 74 | let l = samples () in 75 | if l <> [] then tabulate l 76 | -------------------------------------------------------------------------------- /benchmark/data/http-requests.txt: -------------------------------------------------------------------------------- 1 | GET / HTTP/1.1 2 | Host: www.reddit.com 3 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 4 | Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 5 | Accept-Language: en-us,en;q=0.5 6 | Accept-Encoding: gzip, deflate 7 | Connection: keep-alive 8 | 9 | GET /reddit.v_EZwRzV-Ns.css HTTP/1.1 10 | Host: www.redditstatic.com 11 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 12 | Accept: text/css,*/*;q=0.1 13 | Accept-Language: en-us,en;q=0.5 14 | Accept-Encoding: gzip, deflate 15 | Connection: keep-alive 16 | Referer: http://www.reddit.com/ 17 | 18 | GET /reddit-init.en-us.O1zuMqOOQvY.js HTTP/1.1 19 | Host: www.redditstatic.com 20 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 21 | Accept: */* 22 | Accept-Language: en-us,en;q=0.5 23 | Accept-Encoding: gzip, deflate 24 | Connection: keep-alive 25 | Referer: http://www.reddit.com/ 26 | 27 | GET /reddit.en-us.31yAfSoTsfo.js HTTP/1.1 28 | Host: www.redditstatic.com 29 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 30 | Accept: */* 31 | Accept-Language: en-us,en;q=0.5 32 | Accept-Encoding: gzip, deflate 33 | Connection: keep-alive 34 | Referer: http://www.reddit.com/ 35 | 36 | GET /kill.png HTTP/1.1 37 | Host: www.redditstatic.com 38 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 39 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 40 | Accept-Language: en-us,en;q=0.5 41 | Accept-Encoding: gzip, deflate 42 | Connection: keep-alive 43 | Referer: http://www.reddit.com/ 44 | 45 | GET /icon.png HTTP/1.1 46 | Host: www.redditstatic.com 47 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 48 | Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 49 | Accept-Language: en-us,en;q=0.5 50 | Accept-Encoding: gzip, deflate 51 | Connection: keep-alive 52 | 53 | GET /favicon.ico HTTP/1.1 54 | Host: www.redditstatic.com 55 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 56 | Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 57 | Accept-Language: en-us,en;q=0.5 58 | Accept-Encoding: gzip, deflate 59 | Connection: keep-alive 60 | 61 | GET /AMZM4CWd6zstSC8y.jpg HTTP/1.1 62 | Host: b.thumbs.redditmedia.com 63 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 64 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 65 | Accept-Language: en-us,en;q=0.5 66 | Accept-Encoding: gzip, deflate 67 | Connection: keep-alive 68 | Referer: http://www.reddit.com/ 69 | 70 | GET /jz1d5Nm0w97-YyNm.jpg HTTP/1.1 71 | Host: b.thumbs.redditmedia.com 72 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 73 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 74 | Accept-Language: en-us,en;q=0.5 75 | Accept-Encoding: gzip, deflate 76 | Connection: keep-alive 77 | Referer: http://www.reddit.com/ 78 | 79 | GET /aWGO99I6yOcNUKXB.jpg HTTP/1.1 80 | Host: a.thumbs.redditmedia.com 81 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 82 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 83 | Accept-Language: en-us,en;q=0.5 84 | Accept-Encoding: gzip, deflate 85 | Connection: keep-alive 86 | Referer: http://www.reddit.com/ 87 | 88 | GET /rZ_rD5TjrJM0E9Aj.css HTTP/1.1 89 | Host: e.thumbs.redditmedia.com 90 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 91 | Accept: text/css,*/*;q=0.1 92 | Accept-Language: en-us,en;q=0.5 93 | Accept-Encoding: gzip, deflate 94 | Connection: keep-alive 95 | Referer: http://www.reddit.com/ 96 | 97 | GET /tmsPwagFzyTvrGRx.jpg HTTP/1.1 98 | Host: a.thumbs.redditmedia.com 99 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 100 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 101 | Accept-Language: en-us,en;q=0.5 102 | Accept-Encoding: gzip, deflate 103 | Connection: keep-alive 104 | Referer: http://www.reddit.com/ 105 | 106 | GET /KYgUaLvXCK3TCEJx.jpg HTTP/1.1 107 | Host: a.thumbs.redditmedia.com 108 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 109 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 110 | Accept-Language: en-us,en;q=0.5 111 | Accept-Encoding: gzip, deflate 112 | Connection: keep-alive 113 | Referer: http://www.reddit.com/ 114 | 115 | GET /81pzxT5x2ozuEaxX.jpg HTTP/1.1 116 | Host: e.thumbs.redditmedia.com 117 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 118 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 119 | Accept-Language: en-us,en;q=0.5 120 | Accept-Encoding: gzip, deflate 121 | Connection: keep-alive 122 | Referer: http://www.reddit.com/ 123 | 124 | GET /MFqCUiUVPO5V8t6x.jpg HTTP/1.1 125 | Host: a.thumbs.redditmedia.com 126 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 127 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 128 | Accept-Language: en-us,en;q=0.5 129 | Accept-Encoding: gzip, deflate 130 | Connection: keep-alive 131 | Referer: http://www.reddit.com/ 132 | 133 | GET /TFpYTiAO5aEowokv.jpg HTTP/1.1 134 | Host: e.thumbs.redditmedia.com 135 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 136 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 137 | Accept-Language: en-us,en;q=0.5 138 | Accept-Encoding: gzip, deflate 139 | Connection: keep-alive 140 | Referer: http://www.reddit.com/ 141 | 142 | GET /eMWMpmm9APNeNqcF.jpg HTTP/1.1 143 | Host: e.thumbs.redditmedia.com 144 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 145 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 146 | Accept-Language: en-us,en;q=0.5 147 | Accept-Encoding: gzip, deflate 148 | Connection: keep-alive 149 | Referer: http://www.reddit.com/ 150 | 151 | GET /S-IpsJrOKuaK9GZ8.jpg HTTP/1.1 152 | Host: c.thumbs.redditmedia.com 153 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 154 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 155 | Accept-Language: en-us,en;q=0.5 156 | Accept-Encoding: gzip, deflate 157 | Connection: keep-alive 158 | Referer: http://www.reddit.com/ 159 | 160 | GET /3V6dj9PDsNnheDXn.jpg HTTP/1.1 161 | Host: c.thumbs.redditmedia.com 162 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 163 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 164 | Accept-Language: en-us,en;q=0.5 165 | Accept-Encoding: gzip, deflate 166 | Connection: keep-alive 167 | Referer: http://www.reddit.com/ 168 | 169 | GET /wQ3-VmNXhv8sg4SJ.jpg HTTP/1.1 170 | Host: c.thumbs.redditmedia.com 171 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 172 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 173 | Accept-Language: en-us,en;q=0.5 174 | Accept-Encoding: gzip, deflate 175 | Connection: keep-alive 176 | Referer: http://www.reddit.com/ 177 | 178 | GET /ixd1C1njpczEWC22.jpg HTTP/1.1 179 | Host: c.thumbs.redditmedia.com 180 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 181 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 182 | Accept-Language: en-us,en;q=0.5 183 | Accept-Encoding: gzip, deflate 184 | Connection: keep-alive 185 | Referer: http://www.reddit.com/ 186 | 187 | GET /nGsQj15VyOHMwmq8.jpg HTTP/1.1 188 | Host: c.thumbs.redditmedia.com 189 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 190 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 191 | Accept-Language: en-us,en;q=0.5 192 | Accept-Encoding: gzip, deflate 193 | Connection: keep-alive 194 | Referer: http://www.reddit.com/ 195 | 196 | GET /zT4yQmDxQLbIxK1b.jpg HTTP/1.1 197 | Host: c.thumbs.redditmedia.com 198 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 199 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 200 | Accept-Language: en-us,en;q=0.5 201 | Accept-Encoding: gzip, deflate 202 | Connection: keep-alive 203 | Referer: http://www.reddit.com/ 204 | 205 | GET /L5e1HcZLv1iu4nrG.jpg HTTP/1.1 206 | Host: f.thumbs.redditmedia.com 207 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 208 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 209 | Accept-Language: en-us,en;q=0.5 210 | Accept-Encoding: gzip, deflate 211 | Connection: keep-alive 212 | Referer: http://www.reddit.com/ 213 | 214 | GET /WJFFPxD8X4JO_lIG.jpg HTTP/1.1 215 | Host: f.thumbs.redditmedia.com 216 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 217 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 218 | Accept-Language: en-us,en;q=0.5 219 | Accept-Encoding: gzip, deflate 220 | Connection: keep-alive 221 | Referer: http://www.reddit.com/ 222 | 223 | GET /hVMVTDdjuY3bQox5.jpg HTTP/1.1 224 | Host: f.thumbs.redditmedia.com 225 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 226 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 227 | Accept-Language: en-us,en;q=0.5 228 | Accept-Encoding: gzip, deflate 229 | Connection: keep-alive 230 | Referer: http://www.reddit.com/ 231 | 232 | GET /rnWf8CjBcyPQs5y_.jpg HTTP/1.1 233 | Host: f.thumbs.redditmedia.com 234 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 235 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 236 | Accept-Language: en-us,en;q=0.5 237 | Accept-Encoding: gzip, deflate 238 | Connection: keep-alive 239 | Referer: http://www.reddit.com/ 240 | 241 | GET /gZJL1jNylKbGV4d-.jpg HTTP/1.1 242 | Host: d.thumbs.redditmedia.com 243 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 244 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 245 | Accept-Language: en-us,en;q=0.5 246 | Accept-Encoding: gzip, deflate 247 | Connection: keep-alive 248 | Referer: http://www.reddit.com/ 249 | 250 | GET /aNd2zNRLXiMnKUFh.jpg HTTP/1.1 251 | Host: c.thumbs.redditmedia.com 252 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 253 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 254 | Accept-Language: en-us,en;q=0.5 255 | Accept-Encoding: gzip, deflate 256 | Connection: keep-alive 257 | Referer: http://www.reddit.com/ 258 | 259 | GET /droparrowgray.gif HTTP/1.1 260 | Host: www.redditstatic.com 261 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 262 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 263 | Accept-Language: en-us,en;q=0.5 264 | Accept-Encoding: gzip, deflate 265 | Connection: keep-alive 266 | Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css 267 | 268 | GET /sprite-reddit.an0Lnf61Ap4.png HTTP/1.1 269 | Host: www.redditstatic.com 270 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 271 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 272 | Accept-Language: en-us,en;q=0.5 273 | Accept-Encoding: gzip, deflate 274 | Connection: keep-alive 275 | Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css 276 | 277 | GET /ga.js HTTP/1.1 278 | Host: www.google-analytics.com 279 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 280 | Accept: */* 281 | Accept-Language: en-us,en;q=0.5 282 | Accept-Encoding: gzip, deflate 283 | Connection: keep-alive 284 | Referer: http://www.reddit.com/ 285 | If-Modified-Since: Tue, 29 Oct 2013 19:33:51 GMT 286 | 287 | GET /reddit/ads.html?sr=-reddit.com&bust2 HTTP/1.1 288 | Host: static.adzerk.net 289 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 290 | Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 291 | Accept-Language: en-us,en;q=0.5 292 | Accept-Encoding: gzip, deflate 293 | Connection: keep-alive 294 | Referer: http://www.reddit.com/ 295 | 296 | GET /pixel/of_destiny.png?v=hOlmDALJCWWdjzfBV4ZxJPmrdCLWB%2Ftq7Z%2Ffp4Q%2FxXbVPPREuMJMVGzKraTuhhNWxCCwi6yFEZg%3D&r=783333388 HTTP/1.1 297 | Host: pixel.redditmedia.com 298 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 299 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 300 | Accept-Language: en-us,en;q=0.5 301 | Accept-Encoding: gzip, deflate 302 | Connection: keep-alive 303 | Referer: http://www.reddit.com/ 304 | 305 | GET /UNcO-h_QcS9PD-Gn.jpg HTTP/1.1 306 | Host: c.thumbs.redditmedia.com 307 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 308 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 309 | Accept-Language: en-us,en;q=0.5 310 | Accept-Encoding: gzip, deflate 311 | Connection: keep-alive 312 | Referer: http://e.thumbs.redditmedia.com/rZ_rD5TjrJM0E9Aj.css 313 | 314 | GET /welcome-lines.png HTTP/1.1 315 | Host: www.redditstatic.com 316 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 317 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 318 | Accept-Language: en-us,en;q=0.5 319 | Accept-Encoding: gzip, deflate 320 | Connection: keep-alive 321 | Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css 322 | 323 | GET /welcome-upvote.png HTTP/1.1 324 | Host: www.redditstatic.com 325 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 326 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 327 | Accept-Language: en-us,en;q=0.5 328 | Accept-Encoding: gzip, deflate 329 | Connection: keep-alive 330 | Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css 331 | 332 | GET /__utm.gif?utmwv=5.5.1&utms=1&utmn=720496082&utmhn=www.reddit.com&utme=8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512705&utmac=UA-12131688-1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=qR~ HTTP/1.1 333 | Host: www.google-analytics.com 334 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 335 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 336 | Accept-Language: en-us,en;q=0.5 337 | Accept-Encoding: gzip, deflate 338 | Connection: keep-alive 339 | Referer: http://www.reddit.com/ 340 | 341 | GET /ImnpOQhbXUPkwceN.png HTTP/1.1 342 | Host: a.thumbs.redditmedia.com 343 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 344 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 345 | Accept-Language: en-us,en;q=0.5 346 | Accept-Encoding: gzip, deflate 347 | Connection: keep-alive 348 | Referer: http://www.reddit.com/ 349 | 350 | GET /ajax/libs/jquery/1.7.1/jquery.min.js HTTP/1.1 351 | Host: ajax.googleapis.com 352 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 353 | Accept: */* 354 | Accept-Language: en-us,en;q=0.5 355 | Accept-Encoding: gzip, deflate 356 | Connection: keep-alive 357 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 358 | 359 | GET /__utm.gif?utmwv=5.5.1&utms=2&utmn=1493472678&utmhn=www.reddit.com&utmt=event&utme=5(AdBlock*enabled*false)(0)8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512708&utmac=UA-12131688-1&utmni=1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=6R~ HTTP/1.1 360 | Host: www.google-analytics.com 361 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 362 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 363 | Accept-Language: en-us,en;q=0.5 364 | Accept-Encoding: gzip, deflate 365 | Connection: keep-alive 366 | Referer: http://www.reddit.com/ 367 | 368 | GET /ados.js?q=43 HTTP/1.1 369 | Host: secure.adzerk.net 370 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 371 | Accept: */* 372 | Accept-Language: en-us,en;q=0.5 373 | Accept-Encoding: gzip, deflate 374 | Connection: keep-alive 375 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 376 | 377 | GET /fetch-trackers?callback=jQuery111005268222517967478_1400862512407&ids%5B%5D=t3_25jzeq-t8_k2ii&_=1400862512408 HTTP/1.1 378 | Host: tracker.redditmedia.com 379 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 380 | Accept: */* 381 | Accept-Language: en-us,en;q=0.5 382 | Accept-Encoding: gzip, deflate 383 | Connection: keep-alive 384 | Referer: http://www.reddit.com/ 385 | 386 | GET /ados?t=1400862512892&request={%22Placements%22:[{%22A%22:5146,%22S%22:24950,%22D%22:%22main%22,%22AT%22:5},{%22A%22:5146,%22S%22:24950,%22D%22:%22sponsorship%22,%22AT%22:8}],%22Keywords%22:%22-reddit.com%22,%22Referrer%22:%22http%3A%2F%2Fwww.reddit.com%2F%22,%22IsAsync%22:true,%22WriteResults%22:true} HTTP/1.1 387 | Host: engine.adzerk.net 388 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 389 | Accept: */* 390 | Accept-Language: en-us,en;q=0.5 391 | Accept-Encoding: gzip, deflate 392 | Connection: keep-alive 393 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 394 | 395 | GET /pixel/of_doom.png?id=t3_25jzeq-t8_k2ii&hash=da31d967485cdbd459ce1e9a5dde279fef7fc381&r=1738649500 HTTP/1.1 396 | Host: pixel.redditmedia.com 397 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 398 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 399 | Accept-Language: en-us,en;q=0.5 400 | Accept-Encoding: gzip, deflate 401 | Connection: keep-alive 402 | Referer: http://www.reddit.com/ 403 | 404 | GET /Extensions/adFeedback.js HTTP/1.1 405 | Host: static.adzrk.net 406 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 407 | Accept: */* 408 | Accept-Language: en-us,en;q=0.5 409 | Accept-Encoding: gzip, deflate 410 | Connection: keep-alive 411 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 412 | 413 | GET /Extensions/adFeedback.css HTTP/1.1 414 | Host: static.adzrk.net 415 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 416 | Accept: text/css,*/*;q=0.1 417 | Accept-Language: en-us,en;q=0.5 418 | Accept-Encoding: gzip, deflate 419 | Connection: keep-alive 420 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 421 | 422 | GET /reddit/ads-load.html?bust2 HTTP/1.1 423 | Host: static.adzerk.net 424 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 425 | Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 426 | Accept-Language: en-us,en;q=0.5 427 | Accept-Encoding: gzip, deflate 428 | Connection: keep-alive 429 | Referer: http://www.reddit.com/ 430 | 431 | GET /Advertisers/a774d7d6148046efa89403a8db635a81.jpg HTTP/1.1 432 | Host: static.adzerk.net 433 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 434 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 435 | Accept-Language: en-us,en;q=0.5 436 | Accept-Encoding: gzip, deflate 437 | Connection: keep-alive 438 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 439 | 440 | GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo1LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxNSwiZGkiOiI4NmI2Y2UzYWM5NDM0MjhkOTk2ZTg4MjYwZDE5ZTE1YyIsImRtIjoxLCJmYyI6NDE2MTI4LCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ1fQ&s=lwlbFf2Uywt7zVBFRj_qXXu7msY HTTP/1.1 441 | Host: engine.adzerk.net 442 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 443 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 444 | Accept-Language: en-us,en;q=0.5 445 | Accept-Encoding: gzip, deflate 446 | Connection: keep-alive 447 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 448 | Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966 449 | 450 | GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9994987&PluID=0&ord=1400862593644&rtu=-1 HTTP/1.1 451 | Host: bs.serving-sys.com 452 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 453 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 454 | Accept-Language: en-us,en;q=0.5 455 | Accept-Encoding: gzip, deflate 456 | Connection: keep-alive 457 | Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2 458 | 459 | GET /Advertisers/63cfd0044ffd49c0a71a6626f7a1d8f0.jpg HTTP/1.1 460 | Host: static.adzerk.net 461 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 462 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 463 | Accept-Language: en-us,en;q=0.5 464 | Accept-Encoding: gzip, deflate 465 | Connection: keep-alive 466 | Referer: http://static.adzerk.net/reddit/ads-load.html?bust2 467 | 468 | GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9962555&PluID=0&ord=1400862593645&rtu=-1 HTTP/1.1 469 | Host: bs.serving-sys.com 470 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 471 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 472 | Accept-Language: en-us,en;q=0.5 473 | Accept-Encoding: gzip, deflate 474 | Connection: keep-alive 475 | Referer: http://static.adzerk.net/reddit/ads-load.html?bust2 476 | Cookie: S_9994987=6754579095859875029; A4=01fmFvgRnI09SF00000; u2=d1263d39-874b-4a89-86cd-a2ab0860ed4e3Zl040 477 | 478 | GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo4LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxOCwiZGkiOiI3OTdlZjU3OWQ5NjE0ODdiODYyMGMyMGJkOTE4YzNiMSIsImRtIjoxLCJmYyI6NDE2MTMxLCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ2fQ&s=OjzxzXAgQksbdQOHNm-bjZcnZPA HTTP/1.1 479 | Host: engine.adzerk.net 480 | User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1 481 | Accept: image/png,image/*;q=0.8,*/*;q=0.5 482 | Accept-Language: en-us,en;q=0.5 483 | Accept-Encoding: gzip, deflate 484 | Connection: keep-alive 485 | Referer: http://static.adzerk.net/reddit/ads-load.html?bust2 486 | Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966 487 | 488 | GET /subscribe?host_int=1042356184&ns_map=571794054_374233948806,464381511_13349283399&user_id=245722467&nid=1399334269710011966&ts=1400862514 HTTP/1.1 489 | Host: notify8.dropbox.com 490 | Accept-Encoding: identity 491 | Connection: keep-alive 492 | X-Dropbox-Locale: en_US 493 | User-Agent: DropboxDesktopClient/2.7.54 (Macintosh; 10.8; ('i32',); en_US) 494 | 495 | -------------------------------------------------------------------------------- /benchmark/data/replicate: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # `replicate f n` creates a new file called `f.n` containing n copies of f. 4 | for i in `seq 1 $2`; do 5 | cat $1 >> $1.$2 6 | done 7 | -------------------------------------------------------------------------------- /benchmark/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name benchmark_angstrom) 3 | (libraries benchmark angstrom tyre containers gen)) 4 | -------------------------------------------------------------------------------- /benchmark/rFC2616.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-44"] 2 | (* HTTP "parser", copied from angstrom. *) 3 | 4 | open Tyre 5 | 6 | module P = struct 7 | let space = Re.blank 8 | 9 | let eol = Re.set "\r\n" 10 | 11 | let token = 12 | Re.(rep1 @@ compl [ 13 | rg '\000' '\031' ; 14 | set "\127)(<>@,;:\\/[]?={}" 15 | ]) 16 | end 17 | 18 | let take_till re = regex @@ Re.(rep @@ compl [re]) 19 | 20 | let token = regex P.token 21 | let digits = regex @@ Re.(rep1 digit) 22 | let spaces = regex @@ Re.rep P.space 23 | 24 | let lex p = p <* blanks 25 | 26 | let version = 27 | str"HTTP/" *> 28 | seq 29 | (digits <* char '.') 30 | digits 31 | 32 | let uri = 33 | take_till P.space 34 | 35 | let meth = token 36 | let eol = str"\r\n" 37 | 38 | let request_first_line = 39 | lex meth <&> lex uri <&> version 40 | 41 | let response_first_line = 42 | (lex version) <&> 43 | (lex (take_till P.space)) <&> 44 | (take_till P.eol) 45 | 46 | let header = 47 | seq 48 | token 49 | (char ':' *> blanks *> take_till P.eol) 50 | 51 | 52 | let request = 53 | let to_ (((meth, uri), version), headers) = (meth, uri, version, headers) in 54 | let of_ (meth, uri, version, headers) = (((meth, uri), version), headers) in 55 | conv to_ of_ @@ seq 56 | (request_first_line <* eol) 57 | (rep (header <* eol) <* eol) 58 | 59 | let response = 60 | let to_ (((version, status), msg), headers) = (version, status, msg, headers) in 61 | let of_ (version, status, msg, headers) = (((version, status), msg), headers) in 62 | conv to_ of_ @@ seq 63 | (response_first_line <* eol) 64 | (rep (header <* eol) <* eol) 65 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (name tyre) 3 | -------------------------------------------------------------------------------- /examples/dims.ml: -------------------------------------------------------------------------------- 1 | (** This is a simple example for tyre. *) 2 | 3 | (* We create a typed regular expression matching "[0-9]+x[0-9]+" 4 | <&> is the sequence operator. *> is the prefix operator. 5 | This typed regular expression will return a pair of positive integers. 6 | *) 7 | let dim : (int * int) Tyre.t = Tyre.( pos_int <&> str"x" *> pos_int ) 8 | 9 | (* We can keep composing! *) 10 | let prefixed_dim : (int * int) Tyre.t = Tyre.(str"dim:" *> dim) 11 | 12 | (* Before using it, we need to compile it *) 13 | let dim_re = Tyre.compile prefixed_dim 14 | 15 | (* We can now use it to parse. *) 16 | let () = 17 | assert (Tyre.exec dim_re "dim:23x10" = Result.Ok (23, 10)) 18 | 19 | (* We can also use it to unparse! *) 20 | let () = 21 | assert (Tyre.eval prefixed_dim (5, 2) = "dim:5x2") 22 | (* Note that unparsing doesn't need the compiled regular expression. 23 | Unparsing can never fail. 24 | *) 25 | 26 | (* Pairs are fine, but we want pretty types. 27 | We can use converters to transform the value. *) 28 | type dim = { x : int ; y : int } 29 | let nice_dim : dim Tyre.t = 30 | Tyre.conv 31 | (fun (x,y) -> { x ; y }) 32 | (fun {x;y} -> (x,y)) (* We provide the backward transformation to unparse *) 33 | dim 34 | 35 | (* We can keep composing regular expressions. 36 | Here, we parse a list of dimensions ended by semi-colons. 37 | 38 | The <* and *> operators allow to suffix and prefix with a regex. 39 | *) 40 | let list_of_dims : dim list Tyre.t = 41 | let sep = Tyre.( blanks *> char ';' <* blanks )in 42 | Tyre.( str"dims:" *> terminated_list ~sep nice_dim ) 43 | 44 | let () = 45 | assert (Tyre.eval list_of_dims [{x=2;y=3}; {x=12; y=54}] = "dims:2x3;12x54;") 46 | 47 | let list_of_dims_re = Tyre.compile list_of_dims 48 | let () = 49 | assert (Tyre.exec list_of_dims_re "dims:12x89 ; 60x10 ; 1x1 ;" 50 | = Result.Ok [{x=12;y=89}; {x=60; y=10}; {x=1;y=1}]) 51 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names dims ini) 3 | (modules Dims Ini) 4 | (libraries tyre)) 5 | 6 | (alias 7 | (name runtest) 8 | (deps dims.exe) 9 | (action 10 | (run %{exe:dims.exe}))) 11 | 12 | (alias 13 | (name runtest) 14 | (deps ini.exe) 15 | (action 16 | (run %{exe:ini.exe}))) 17 | -------------------------------------------------------------------------------- /examples/ini.ml: -------------------------------------------------------------------------------- 1 | open Tyre.Infix 2 | 3 | type section = string * (string * string) list 4 | 5 | type ini = 6 | { named: section list 7 | ; anon: (string * string) list } 8 | 9 | let take_till cset = Re.(rep (compl [set cset])) |> Tyre.regex 10 | let strip = Tyre.conv String.trim (fun x -> x) 11 | 12 | let section_title = 13 | let open! Tyre in 14 | let sec_name = "]" |> take_till |> strip in 15 | char '[' *> sec_name <* char ']' 16 | 17 | let entry : (string * string) Tyre.t = 18 | let open Tyre in 19 | let equal = blanks *> char '=' <* blanks in 20 | let key = strip @@ take_till "[]=" in 21 | key <&> equal *> take_till "\n" 22 | 23 | let empty_line = 24 | Re.( seq [rep (set " \t") ; char '\n'] |> rep ) 25 | |> Tyre.regex 26 | 27 | let line t = 28 | let open Tyre in 29 | t <* blanks <* char '\n' 30 | 31 | let entry = 32 | empty_line *> entry <* empty_line 33 | 34 | let section = Tyre.(terminated_list ~sep:(char '\n') entry) 35 | 36 | let named_section = 37 | line section_title <&> section 38 | 39 | let ini = 40 | Tyre.start *> section <&> Tyre.list named_section <* Tyre.stop 41 | |> Tyre.conv 42 | (fun (anon, named) -> { anon ; named }) 43 | (fun { anon ; named } -> (anon, named)) 44 | 45 | let sample_ini = 46 | { anon=[ "lang", "OCaml" 47 | ; "lib", "foo bar" ] 48 | ; named = 49 | [ "lib", 50 | [ "re", "1.5.0" 51 | ; "tyre", "> 1.5.0" ] 52 | ; "src", 53 | [ "one", "two" 54 | ; "xxx", "foo bar baz" ] 55 | ; "lib_test", 56 | [ "alcotest", "*" ] 57 | ] 58 | } 59 | 60 | let sample_ini_str = Tyre.eval ini sample_ini 61 | 62 | let sample_ini' = Tyre.exec (Tyre.compile ini) sample_ini_str 63 | 64 | let () = 65 | assert (Result.Ok sample_ini = sample_ini') 66 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name tyre) 3 | (public_name tyre) 4 | (synopsis 5 | "Tyre is a set of combinators to build type-safe regular expressions") 6 | (libraries re result seq) 7 | (ocamlopt_flags :standard -O3)) 8 | -------------------------------------------------------------------------------- /src/tyre.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Gabriel Radanne 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | module Seq = struct 18 | include Seq 19 | 20 | let of_list l = 21 | let rec aux l () = match l with 22 | | [] -> Seq.Nil 23 | | x :: tail -> Seq.Cons (x, aux tail) 24 | in 25 | aux l 26 | let to_rev_list gen = 27 | fold_left (fun acc x -> x :: acc) [] gen 28 | let to_list gen = List.rev (to_rev_list gen) 29 | end 30 | 31 | let map_3 f (x,y,z) = (x, y, f z) 32 | 33 | (** {2 The various types} *) 34 | 35 | module T = struct 36 | 37 | type ('a, 'b) conv = { 38 | to_ : 'a -> 'b ; 39 | from_ : 'b -> 'a ; 40 | } 41 | 42 | type 'a raw = 43 | (* We store a compiled regex to efficiently check string when unparsing. *) 44 | | Regexp : Re.t * Re.re Lazy.t -> string raw 45 | | Conv : 'a raw * ('a, 'b) conv -> 'b raw 46 | | Opt : 'a raw -> ('a option) raw 47 | | Alt : 'a raw * 'b raw -> [`Left of 'a | `Right of 'b] raw 48 | | Seq : 'a raw * 'b raw -> ('a * 'b) raw 49 | | Prefix : 'b raw * 'a raw -> 'a raw 50 | | Suffix : 'a raw * 'b raw -> 'a raw 51 | | Rep : 'a raw -> 'a Seq.t raw 52 | | Mod : (Re.t -> Re.t) * 'a raw -> 'a raw 53 | 54 | type _ wit = 55 | | Lit : int -> string wit 56 | | Conv : 'a wit * ('a, 'b) conv -> 'b wit 57 | | Opt : Re.Mark.t * 'a wit -> 'a option wit 58 | | Alt : Re.Mark.t * 'a wit * 'b wit 59 | -> [`Left of 'a | `Right of 'b] wit 60 | | Seq : 61 | 'a wit * 'b wit -> ('a * 'b) wit 62 | | Rep : int * 'a wit * Re.re -> 'a Seq.t wit 63 | 64 | end 65 | 66 | type 'a t = 'a T.raw 67 | 68 | let regex x : _ t = 69 | let re = lazy Re.(compile @@ whole_string @@ no_group x) in 70 | Regexp (x, re) 71 | 72 | let pcre s = regex @@ Re.Pcre.re s 73 | 74 | (* Converters 75 | 76 | The exception matching of converters is handled by {!Tyre.exec} directly. 77 | *) 78 | let conv to_ from_ x : _ t = 79 | Conv (x, {to_; from_}) 80 | 81 | let seq a b : _ t = Seq (a, b) 82 | let alt a b : _ t = Alt (a, b) 83 | 84 | let prefix x a : _ t = Prefix (x, a) 85 | let suffix a x : _ t = Suffix (a, x) 86 | let opt a : _ t = Opt a 87 | 88 | module Infix = struct 89 | 90 | let (<|>) = alt 91 | let (<&>) = seq 92 | 93 | let ( *>) = prefix 94 | let (<* ) = suffix 95 | 96 | end 97 | include Infix 98 | 99 | let rep x : _ t = Rep x 100 | let rep1 x = x <&> rep x 101 | 102 | (* [modifier] is unsafe in general (for example [modifier Re.group]). 103 | It shouldn't be exposed to the user. 104 | *) 105 | let modifier f re : _ t = Mod (f, re) 106 | 107 | let word re = modifier Re.word re 108 | let whole_string re = modifier Re.whole_string re 109 | let longest re = modifier Re.longest re 110 | let shortest re = modifier Re.shortest re 111 | let first re = modifier Re.first re 112 | let greedy re = modifier Re.greedy re 113 | let non_greedy re = modifier Re.non_greedy re 114 | let nest re = modifier Re.nest re 115 | 116 | module Regex = struct 117 | open! Re 118 | 119 | (** [0-9]+ *) 120 | let pos_int = rep1 digit 121 | 122 | (** -?[0-9]+ *) 123 | let int = 124 | seq [opt (char '-') ; pos_int] 125 | 126 | (** -?[0-9]+( .[0-9]* )? *) 127 | let float = 128 | seq [opt (char '-') ; rep1 digit ; opt (seq [char '.'; rep digit])] 129 | 130 | (** true|false *) 131 | let bool = 132 | alt [str "true" ; str "false"] 133 | 134 | end 135 | 136 | let unit s re = 137 | conv 138 | (fun _ -> ()) 139 | (fun () -> s) 140 | (regex re) 141 | 142 | let start = unit "" Re.start 143 | let stop = unit "" Re.stop 144 | 145 | let str s = unit s (Re.str s) 146 | 147 | let char c = 148 | let s = String.make 1 c in 149 | unit s (Re.char c) 150 | 151 | let blanks = unit "" (Re.rep Re.blank) 152 | 153 | let pos_int = 154 | conv int_of_string string_of_int (regex Regex.pos_int) 155 | 156 | let int = 157 | conv int_of_string string_of_int (regex Regex.int) 158 | 159 | let float = 160 | conv float_of_string string_of_float (regex Regex.float) 161 | 162 | let bool = 163 | conv bool_of_string string_of_bool (regex Regex.bool) 164 | 165 | let list e = 166 | conv Seq.to_list Seq.of_list (rep e) 167 | 168 | let terminated_list ~sep e = list (e <* sep) 169 | let separated_list ~sep e = 170 | let e = opt (e <&> list (sep *> e)) in 171 | let to_ = function None -> [] | Some (h, t) -> (h :: t) 172 | and from_ = function [] -> None | h :: t -> Some (h, t) 173 | in 174 | conv to_ from_ e 175 | 176 | 177 | (** {2 Witness} *) 178 | 179 | (** A witness is a string such that [exec (compile re) (witness re) = true]. 180 | The computation of the witness is deterministic and should result in 181 | a small example. 182 | 183 | It is used in [eval] for the part of the regex that are ignored. 184 | *) 185 | 186 | let rec witnesspp 187 | : type a . Format.formatter -> a t -> unit 188 | = fun ppf tre -> let open T in match tre with 189 | | Regexp (re, _) -> Format.pp_print_string ppf @@ Re.witness re 190 | | Conv (tre, _) -> witnesspp ppf tre 191 | | Opt _ -> () 192 | | Alt (tre1, _) -> witnesspp ppf tre1 193 | | Seq (tre1, tre2) -> 194 | witnesspp ppf tre1 ; 195 | witnesspp ppf tre2 196 | | Prefix (tre1,tre2) -> 197 | witnesspp ppf tre1 ; 198 | witnesspp ppf tre2 199 | | Suffix (tre1,tre2) -> 200 | witnesspp ppf tre1 ; 201 | witnesspp ppf tre2 202 | | Rep _ -> () 203 | | Mod (_,tre) -> 204 | witnesspp ppf tre 205 | 206 | (** {2 Evaluation functions} *) 207 | 208 | (** Evaluation is the act of filling the holes. *) 209 | 210 | let pstr = Format.pp_print_string 211 | let rec pprep f ppf seq = match seq () with 212 | | Seq.Nil -> () 213 | | Cons (x, seq) -> f ppf x ; pprep f ppf seq 214 | 215 | let rec evalpp 216 | : type a . a t -> Format.formatter -> a -> unit 217 | = fun tre ppf -> let open T in match tre with 218 | | Regexp (_, lazy cre) -> begin function v -> 219 | if not @@ Re.execp cre v then 220 | invalid_arg @@ 221 | Printf.sprintf "Tyre.eval: regexp not respected by \"%s\"." v ; 222 | pstr ppf v 223 | end 224 | | Conv (tre, conv) -> fun v -> evalpp tre ppf (conv.from_ v) 225 | | Opt p -> begin function 226 | | None -> pstr ppf "" 227 | | Some x -> evalpp p ppf x 228 | end 229 | | Seq (tre1,tre2) -> fun (x1, x2) -> 230 | evalpp tre1 ppf x1 ; 231 | evalpp tre2 ppf x2 ; 232 | | Prefix(tre_l,tre) -> 233 | fun v -> witnesspp ppf tre_l ; evalpp tre ppf v 234 | | Suffix(tre,tre_g) -> 235 | fun v -> evalpp tre ppf v ; witnesspp ppf tre_g 236 | | Alt (treL, treR) -> begin function 237 | | `Left x -> evalpp treL ppf x 238 | | `Right x -> evalpp treR ppf x 239 | end 240 | | Rep tre -> 241 | pprep (evalpp tre) ppf 242 | | Mod (_, tre) -> evalpp tre ppf 243 | 244 | let eval tre = Format.asprintf "%a" (evalpp tre) 245 | 246 | (** {2 matching} *) 247 | 248 | (** {3 Regexp construction} 249 | 250 | In order to record how we constructed the regexp and how to later 251 | extract information, we build a witness containing all the tools we need. 252 | 253 | Each alternative is marked with {!Re.mark}. We store the markid in order 254 | to be able to guess the branch matched. 255 | *) 256 | 257 | let rec build 258 | : type a. int -> a t -> int * a T.wit * Re.t 259 | = let open! Re in let open T in 260 | fun i -> function 261 | | Regexp (re, _) -> 262 | (i+1), Lit i, group @@ no_group re 263 | | Conv (e, conv) -> 264 | let i', w, re = build i e in 265 | i', Conv (w, conv), re 266 | | Opt e -> 267 | let i', w, (id, re) = map_3 mark @@ build i e in 268 | i', Opt (id,w), opt re 269 | | Alt (e1,e2) -> 270 | let i', w1, (id1, re1) = map_3 mark @@ build i e1 in 271 | let i'', w2, re2 = build i' e2 in 272 | i'', Alt (id1, w1, w2), alt [re1 ; re2] 273 | | Prefix (e_ign,e) -> 274 | let i', w, re = build i e in 275 | let _, _, re_ign = build 1 e_ign in 276 | i', w, seq [no_group re_ign ; re] 277 | | Suffix (e,e_ign) -> 278 | let i', w, re = build i e in 279 | let _, _, re_ign = build 1 e_ign in 280 | i', w, seq [re ; no_group re_ign] 281 | | Seq (e1,e2) -> 282 | let i', w1, re1 = build i e1 in 283 | let i'', w2, re2 = build i' e2 in 284 | i'', Seq (w1, w2), seq [re1; re2] 285 | | Rep e -> 286 | let _, w, re = build 1 e in 287 | (i+1), Rep (i,w,Re.compile re), group @@ rep @@ no_group re 288 | | Mod (f, e) -> 289 | let i', w, re = build i e in 290 | i', w, f re 291 | 292 | (** {3 Extraction.} *) 293 | 294 | (** Extracting is just a matter of following the witness. 295 | We just need to take care of counting where we are in the matching groups. 296 | 297 | To avoid copy, we pass around the original string (and we use positions). 298 | *) 299 | let[@specialize] rec extract 300 | : type a. original:string -> a T.wit -> Re.Group.t -> a 301 | = fun ~original rea s -> let open T in match rea with 302 | | Lit i -> Re.Group.get s i 303 | | Conv (w, conv) -> 304 | let v = extract ~original w s in 305 | conv.to_ v 306 | | Opt (id,w) -> 307 | if not @@ Re.Mark.test s id then None 308 | else Some (extract ~original w s) 309 | | Alt (i1,w1,w2) -> 310 | if Re.Mark.test s i1 then 311 | `Left (extract ~original w1 s) 312 | else 313 | (* Invariant: Alt produces [Re.alt [e1 ; e2]] *) 314 | `Right (extract ~original w2 s) 315 | | Seq (e1,e2) -> 316 | let v1 = extract ~original e1 s in 317 | let v2 = extract ~original e2 s in 318 | (v1, v2) 319 | | Rep (i,e,re) -> extract_list ~original e re i s 320 | 321 | (** We need to re-match the string for lists, in order to extract 322 | all the elements. 323 | Re doesn't offer the possibility to keep the results when 324 | grouping under a star (one could argue it's theoretically not 325 | possible as it would be equivalent to counting in an automaton). 326 | *) 327 | and[@specialize] extract_list 328 | : type a. original:string -> a T.wit -> Re.re -> int -> Re.Group.t -> a Seq.t 329 | = fun ~original e re i s -> 330 | let aux = extract ~original e in 331 | let (pos, pos') = Re.Group.offset s i in 332 | let len = pos' - pos in 333 | Seq.map aux @@ Re.Seq.all ~pos ~len re original 334 | 335 | (** {4 Multiple match} *) 336 | 337 | type +'r route = Route : 'a t * ('a -> 'r) -> 'r route 338 | 339 | let route re f = Route (re, f) 340 | 341 | let (-->) = route 342 | 343 | type 'r wit_route = 344 | WRoute : Re.Mark.t * 'a T.wit * ('a -> 'r) -> 'r wit_route 345 | 346 | (* It's important to keep the order here, since Re will choose 347 | the first regexp if there is ambiguity. 348 | *) 349 | let rec build_route_aux i rel wl = function 350 | | [] -> List.rev rel, List.rev wl 351 | | Route (tre, f) :: l -> 352 | let i', wit, re = build i tre in 353 | let id, re = Re.mark re in 354 | let w = WRoute (id, wit, f) in 355 | build_route_aux i' (re::rel) (w::wl) l 356 | 357 | let build_route l = build_route_aux 1 [] [] l 358 | 359 | let rec extract_route ~original wl subs = match wl with 360 | | [] -> 361 | (* Invariant: At least one of the regexp of the alternative matches. *) 362 | assert false 363 | | WRoute (id, wit, f) :: wl -> 364 | if Re.Mark.test subs id then 365 | f (extract ~original wit subs) 366 | else 367 | extract_route ~original wl subs 368 | 369 | (** {4 Compilation and execution} *) 370 | 371 | type 'r info = 372 | | One of 'r T.wit 373 | | Routes of 'r wit_route list 374 | 375 | type 'a re = { info : 'a info ; cre : Re.re } 376 | 377 | let compile tre = 378 | let _, wit, re = build 1 tre in 379 | let cre = Re.compile re in 380 | { info = One wit ; cre } 381 | 382 | let route l = 383 | let rel, wl = build_route l in 384 | let cre = Re.compile @@ Re.alt rel in 385 | { info = Routes wl ; cre } 386 | 387 | 388 | type 'a error = [ 389 | | `NoMatch of 'a re * string 390 | | `ConverterFailure of exn 391 | ] 392 | 393 | let extract_with_info ~info ~original subs = match info with 394 | | One w -> extract ~original w subs 395 | | Routes wl -> extract_route ~original wl subs 396 | 397 | let[@inline] exec ?pos ?len ({ info ; cre } as tcre) original = 398 | match Re.exec_opt ?pos ?len cre original with 399 | | None -> Result.Error (`NoMatch (tcre, original)) 400 | | Some subs -> 401 | try 402 | Result.Ok (extract_with_info ~info ~original subs) 403 | with exn -> 404 | Result.Error (`ConverterFailure exn) 405 | 406 | let execp ?pos ?len {cre ; _ } original = 407 | Re.execp ?pos ?len cre original 408 | 409 | let all_seq ?pos ?len { info ; cre } original = 410 | let seq = Re.Seq.all ?pos ?len cre original in 411 | let get_res subs = extract_with_info ~info ~original subs in 412 | Seq.map get_res seq 413 | 414 | let all ?pos ?len tcre original = 415 | try 416 | Result.Ok (Seq.to_list @@ all_seq ?pos ?len tcre original) 417 | with exn -> 418 | Result.Error (`ConverterFailure exn) 419 | 420 | (** Pretty printers *) 421 | 422 | let sexp ppf s fmt = Format.fprintf ppf ("@[<3>(%s@ "^^fmt^^")@]") s 423 | 424 | (* Only in the stdlib since 4.02, so we copy. *) 425 | let rec pp_list pp ppf = function 426 | | [] -> () 427 | | [v] -> pp ppf v 428 | | v :: vs -> 429 | pp ppf v; 430 | Format.pp_print_space ppf (); 431 | pp_list pp ppf vs 432 | 433 | let rec pp 434 | : type a. _ -> a t -> unit 435 | = fun ppf -> let open T in function 436 | | Regexp (re,_) -> sexp ppf "Re" "%a" Re.pp re 437 | | Conv (tre,_) -> sexp ppf "Conv" "%a" pp tre 438 | | Opt tre -> sexp ppf "Opt" "%a" pp tre 439 | | Alt (tre1, tre2) -> sexp ppf "Alt" "%a@ %a" pp tre1 pp tre2 440 | | Seq (tre1 ,tre2) -> sexp ppf "Seq" "%a@ %a" pp tre1 pp tre2 441 | | Prefix (tre1, tre2) -> 442 | sexp ppf "Prefix" "%a@ %a" pp tre1 pp tre2 443 | | Suffix (tre1, tre2) -> 444 | sexp ppf "Suffix" "%a@ %a" pp tre1 pp tre2 445 | | Rep tre -> sexp ppf "Rep" "%a" pp tre 446 | | Mod (_,tre) -> sexp ppf "Mod" "%a" pp tre 447 | 448 | let rec pp_wit 449 | : type a. _ -> a T.wit -> unit 450 | = fun ppf -> let open T in function 451 | | Lit i -> sexp ppf "Lit" "%i" i 452 | | Conv (tre,_) -> sexp ppf "Conv" "%a" pp_wit tre 453 | | Opt (_, tre) -> sexp ppf "Opt" "%a" pp_wit tre 454 | | Alt (_, tre1, tre2) -> sexp ppf "Alt" "%a@ %a" pp_wit tre1 pp_wit tre2 455 | | Seq (tre1 ,tre2) -> sexp ppf "Seq" "%a@ %a" pp_wit tre1 pp_wit tre2 456 | | Rep (i, w, re) -> sexp ppf "Rep" "%i@ %a@ %a" i pp_wit w Re.pp_re re 457 | 458 | let pp_wit_route 459 | : type a. _ -> a wit_route -> unit 460 | = fun ppf (WRoute (_,w,_)) -> pp_wit ppf w 461 | 462 | let pp_re ppf = function 463 | | { info = One w; cre } -> 464 | sexp ppf "One" "%a@ %a" Re.pp_re cre pp_wit w 465 | | { info = Routes wl; cre } -> 466 | sexp ppf "Route" "%a@ %a" Re.pp_re cre (pp_list pp_wit_route) wl 467 | 468 | let pp_error ppf : _ error -> unit = function 469 | | `NoMatch (re, s) -> 470 | Format.fprintf ppf "`NoMatch (%a, %s)" pp_re re s 471 | | `ConverterFailure exn -> 472 | Format.pp_print_string ppf @@ Printexc.to_string exn 473 | 474 | module Internal = struct 475 | include T 476 | 477 | let to_t x = x 478 | let from_t x = x 479 | 480 | let build = build 481 | let extract = extract 482 | end 483 | -------------------------------------------------------------------------------- /src/tyre.mli: -------------------------------------------------------------------------------- 1 | (** {1 Typed regular expressions} *) 2 | 3 | (** 4 | Tyre is a set of combinators to build type-safe regular expressions, allowing automatic extraction and modification of matched groups. 5 | 6 | Tyre is bi-directional: a typed regular expressions can be used both for {{!matching}matching} and {{!eval}evaluation}. Multiple tyregexs can be combined in order to do {{!routing}routing} in similar manner as switches/pattern matching. 7 | Typed regular expressions are strictly as expressive as regular expressions from {{:https://github.com/ocaml/ocaml-re}re} (and are, as such, {b regular} expressions, not PCREs). Performances should be exactly the same. 8 | 9 | {[ 10 | # let dim = Tyre.( str"dim:" *> int <&> str"x" *> int ) ;; 11 | val dim : (int * int) Tyre.t 12 | 13 | # let dim_re = Tyre.compile dim ;; 14 | val dim_re : (int * int) Tyre.re 15 | 16 | # Tyre.exec dim_re "dim:3x4" ;; 17 | - : (int * int, (int * int) Tyre.error) result = Result.Ok (3, 4) 18 | 19 | # Tyre.eval dim (2, 5) ;; 20 | - : string = "dim:2x5" 21 | ]} 22 | 23 | {{:https://github.com/paurkedal/ppx_regexp#ppx_tyre---syntax-support-for-tyre-routes}ppx_tyre} allows to use the usual regular syntax, if prefered: 24 | 25 | {[ 26 | # let dim = [%tyre "dim:(?&int)x(?&int)"] ;; 27 | val dim : (int * int) Tyre.t 28 | ]} 29 | 30 | *) 31 | 32 | type 'a t 33 | (** A typed regular expression. 34 | 35 | The type variable is the type of the returned value when the typed regular expression (tyregex) is executed. 36 | 37 | For example [tyre : int t] can be used to return an [int]. In the rest of the documentation, we will use «[tyre]» to designate a value of type {!t}. 38 | *) 39 | 40 | (** {1 Combinators} *) 41 | 42 | val pcre : string -> string t 43 | (** [pcre s] is a tyregex that matches the PCRE [s] and return the 44 | corresponding string. 45 | Groups in [s] are ignored. 46 | *) 47 | 48 | val regex : Re.t -> string t 49 | (** [regex re] is a tyregex that matches [re] and return the corresponding string. 50 | Groups inside [re] are erased. 51 | *) 52 | 53 | val conv : ('a -> 'b) -> ('b -> 'a) -> 'a t -> 'b t 54 | (** [conv to_ from_ tyre] matches the same text as [tyre], but converts back and forth to a different data type. 55 | 56 | [to_] is allowed to raise an exception [exn]. 57 | In this case, {!exec} will return [`ConverterFailure exn]. 58 | 59 | For example, this is the implementation of {!pos_int}: 60 | 61 | {[ 62 | let pos_int = 63 | Tyre.conv 64 | int_of_string string_of_int 65 | (Tyre.regex (Re.rep1 Re.digit)) 66 | ]} 67 | *) 68 | 69 | val opt : 'a t -> 'a option t 70 | (** [opt tyre] matches either [tyre] or the empty string. Similar to {!Re.opt}. *) 71 | 72 | val alt : 'a t -> 'b t -> [`Left of 'a | `Right of 'b] t 73 | (** [alt tyreL tyreR] matches either [tyreL] (and will then return [`Left v]) or [tyreR] (and will then return [`Right v]). 74 | *) 75 | 76 | (** {2 Repetitions} *) 77 | 78 | val rep : 'a t -> 'a Seq.t t 79 | (** [rep tyre] matches [tyre] zero or more times. Similar to {!Re.rep}. 80 | 81 | For {{!matching}matching}, [rep tyre] will matches the string a first time, then [tyre] will be used to walk the matched part to extract values. 82 | *) 83 | 84 | val rep1 : 'a t -> ('a * 'a Seq.t) t 85 | (** [rep1 tyre] is [seq tyre (rep tyre)]. Similar to {!Re.rep1}. *) 86 | 87 | (** {2 Sequences} *) 88 | 89 | val seq : 'a t -> 'b t -> ('a * 'b) t 90 | (** [seq tyre1 tyre2] matches [tyre1] then [tyre2] and return both values. *) 91 | 92 | val prefix : _ t -> 'a t -> 'a t 93 | (** [prefix tyre_i tyre] matches [tyre_i], ignores the result, and then matches [tyre] and returns its result. Converters in [tyre_i] are never called. 94 | *) 95 | 96 | val suffix : 'a t -> _ t -> 'a t 97 | (** Same as [prefix], but reversed. *) 98 | 99 | 100 | 101 | (** {2 Infix operators} *) 102 | 103 | val (<|>) : 'a t -> 'b t -> [`Left of 'a | `Right of 'b] t 104 | (** [t <|> t'] is [alt t t']. *) 105 | 106 | val (<&>) : 'a t -> 'b t -> ('a * 'b) t 107 | (** [t <&> t'] is [seq t t']. *) 108 | 109 | val ( *>) : _ t -> 'a t -> 'a t 110 | (** [ ti *> t ] is [prefix ti t]. *) 111 | 112 | val (<* ) : 'a t -> _ t -> 'a t 113 | (** [ t <* ti ] is [suffix t ti]. *) 114 | 115 | module Infix : sig 116 | 117 | val (<|>) : 'a t -> 'b t -> [`Left of 'a | `Right of 'b] t 118 | (** [t <|> t'] is [alt t t']. *) 119 | 120 | val (<&>) : 'a t -> 'b t -> ('a * 'b) t 121 | (** [t <&> t'] is [seq t t']. *) 122 | 123 | val ( *>) : _ t -> 'a t -> 'a t 124 | (** [ ti *> t ] is [prefix ti t]. *) 125 | 126 | val (<* ) : 'a t -> _ t -> 'a t 127 | (** [ t <* ti ] is [suffix t ti]. *) 128 | 129 | end 130 | 131 | (** {2 Useful combinators} *) 132 | 133 | val str : string -> unit t 134 | (** [str s] matches [s] and evaluates to [s]. *) 135 | 136 | val char : char -> unit t 137 | (** [char c] matches [c] and evaluates to [c]. *) 138 | 139 | val blanks : unit t 140 | (** [blanks] matches [Re.(rep blank)] and doesn't return anything. *) 141 | 142 | val int : int t 143 | (** [int] matches [-?[0-9]+] and returns the matched integer. 144 | 145 | Integers that do not fit in an [int] will fail. 146 | *) 147 | 148 | val pos_int : int t 149 | (** [pos_int] matches [[0-9]+] and returns the matched positive integer. 150 | 151 | Integers that do not fit in an [int] will fail. 152 | *) 153 | 154 | val float : float t 155 | (** [float] matches [-?[0-9]+( .[0-9]* )?] and returns the matched floating point number. 156 | 157 | Floating point numbers that do not fit in a [float] returns {!infinity} or {!neg_infinity}. 158 | *) 159 | 160 | val bool : bool t 161 | (** [bool] matches [true|false] and returns the matched boolean. *) 162 | 163 | val list : 'a t -> 'a list t 164 | (** [list e] is similar to [rep e], but returns a list. *) 165 | 166 | val terminated_list : sep:_ t -> 'a t -> 'a list t 167 | (** [terminated_list ~sep tyre] is [ list (tyre <* sep) ]. *) 168 | 169 | val separated_list : sep:_ t -> 'a t -> 'a list t 170 | (** [separated_list ~sep tyre] is equivalent to [opt (e <&> list (sep *> e))]. *) 171 | 172 | (** {2 Other combinators} 173 | 174 | See {!Re} for details on the semantics of those combinators. *) 175 | 176 | val start : unit t 177 | val stop : unit t 178 | 179 | val word : 'a t -> 'a t 180 | val whole_string : 'a t -> 'a t 181 | val longest : 'a t -> 'a t 182 | val shortest : 'a t -> 'a t 183 | val first : 'a t -> 'a t 184 | val greedy : 'a t -> 'a t 185 | val non_greedy : 'a t -> 'a t 186 | val nest : 'a t -> 'a t 187 | 188 | (** {1:matching Matching} *) 189 | 190 | type 'a re 191 | (** A compiled typed regular expression. *) 192 | 193 | val compile : 'a t -> 'a re 194 | (** [compile tyre] is the compiled tyregex representing [tyre]. 195 | *) 196 | 197 | type 'a error = [ 198 | | `NoMatch of 'a re * string 199 | | `ConverterFailure of exn 200 | ] 201 | 202 | val pp_error : Format.formatter -> _ error -> unit 203 | 204 | val exec : ?pos:int -> ?len:int -> 'a re -> string -> ('a, 'a error) Result.result 205 | (** [exec ctyre s] matches the string [s] using 206 | the compiled tyregex [ctyre] and returns the extracted value. 207 | 208 | Returns [Error (`NoMatch (tyre, s)] if [tyre] doesn't match [s]. 209 | Returns [Error (`ConverterFailure exn)] if a converter failed with the exception [exn]. 210 | 211 | @param pos Optional beginning of the string (default 0) 212 | @param len Length of the substring of [str] that can be matched (default to the end of the string) 213 | *) 214 | 215 | val execp : ?pos:int -> ?len:int -> 'a re -> string -> bool 216 | (** [execp ctyre s] returns [true] if [ctyre] matches [s]. Converters 217 | are never called. 218 | 219 | @param pos Optional beginning of the string (default 0) 220 | @param len Length of the substring of [str] that can be matched (default to the end of the string) 221 | 222 | @since 0.1.1 223 | *) 224 | 225 | 226 | (** {2:repeat Repeated Matching} *) 227 | 228 | val all : ?pos:int -> ?len:int -> 'a re -> string -> ('a list, 'a error) Result.result 229 | (** [all ctyre s] calls to {!exec} repeatedly and returns the list of all the matches. *) 230 | 231 | val all_seq : ?pos:int -> ?len:int -> 'a re -> string -> 'a Seq.t 232 | (** [all_seq ctyre s] is [all ctyre s] but returns a {!gen} instead. Matches 233 | are enumerated lazily. 234 | 235 | Exceptions raised by converters are not caught. 236 | *) 237 | 238 | (** {2:routing Routing} *) 239 | 240 | type +'a route = Route : 'x t * ('x -> 'a) -> 'a route 241 | (** A route is a pair of a tyregex and a handler. 242 | When the tyregex is matched, the function is called with the 243 | result of the matching. 244 | *) 245 | 246 | val (-->) : 'x t -> ('x -> 'a) -> 'a route 247 | (** [tyre --> f] is [Route (tyre, f)]. *) 248 | 249 | val route : 'a route list -> 'a re 250 | (** [route [ tyre1 --> f1 ; tyre2 --> f2 ]] produces a compiled 251 | tyregex such that, if [tyre1] matches, [f1] is called, and so on. 252 | 253 | The compiled tyregex shoud be used with {!exec}. 254 | *) 255 | 256 | 257 | (** {1:eval Evaluating} *) 258 | 259 | val eval : 'a t -> 'a -> string 260 | (** [eval tyre v] returns a string [s] such that [exec (compile tyre) s = v]. 261 | 262 | Note that such string [s] is not unique. [eval] will usually returns a very simple witness. *) 263 | 264 | val evalpp : 'a t -> Format.formatter -> 'a -> unit 265 | (** [evalpp tyre ppf v] is equivalent to [Format.fprintf ppf "%s" (eval tyre v)], but more efficient. 266 | 267 | Is is generally used with ["%a"]: 268 | {[ 269 | let my_pp = Tyre.evalpp tyre in 270 | Format.printf "%a@." my_pp v 271 | ]} 272 | *) 273 | 274 | (** {1:pp Pretty printing} *) 275 | 276 | val pp : Format.formatter -> 'a t -> unit 277 | 278 | val pp_re : Format.formatter -> 'a re -> unit 279 | 280 | (**/**) 281 | 282 | (** Internal types *) 283 | module Internal : sig 284 | 285 | type ('a, 'b) conv = { 286 | to_ : 'a -> 'b ; 287 | from_ : 'b -> 'a ; 288 | } 289 | 290 | type 'a raw = 291 | (* We store a compiled regex to efficiently check string when unparsing. *) 292 | | Regexp : Re.t * Re.re Lazy.t -> string raw 293 | | Conv : 'a raw * ('a, 'b) conv -> 'b raw 294 | | Opt : 'a raw -> ('a option) raw 295 | | Alt : 'a raw * 'b raw -> [`Left of 'a | `Right of 'b] raw 296 | | Seq : 'a raw * 'b raw -> ('a * 'b) raw 297 | | Prefix : 'b raw * 'a raw -> 'a raw 298 | | Suffix : 'a raw * 'b raw -> 'a raw 299 | | Rep : 'a raw -> 'a Seq.t raw 300 | | Mod : (Re.t -> Re.t) * 'a raw -> 'a raw 301 | 302 | val from_t : 'a t -> 'a raw 303 | val to_t : 'a raw -> 'a t 304 | 305 | type _ wit = 306 | | Lit : int -> string wit 307 | | Conv : 'a wit * ('a, 'b) conv -> 'b wit 308 | | Opt : Re.Mark.t * 'a wit -> 'a option wit 309 | | Alt : Re.Mark.t * 'a wit * 'b wit 310 | -> [`Left of 'a | `Right of 'b] wit 311 | | Seq : 312 | 'a wit * 'b wit -> ('a * 'b) wit 313 | | Rep : int * 'a wit * Re.re -> 'a Seq.t wit 314 | 315 | val build : int -> 'a raw -> int * 'a wit * Re.t 316 | val extract : original:string -> 'a wit -> Re.Group.t -> 'a 317 | 318 | end 319 | 320 | (* 321 | * Copyright (c) 2016 Gabriel Radanne 322 | * 323 | * Permission to use, copy, modify, and distribute this software for any 324 | * purpose with or without fee is hereby granted, provided that the above 325 | * copyright notice and this permission notice appear in all copies. 326 | * 327 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 328 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 329 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 330 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 331 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 332 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 333 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 334 | *) 335 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules Test) 4 | (libraries tyre alcotest)) 5 | 6 | (alias 7 | (name runtest) 8 | (deps test.exe) 9 | (action 10 | (run %{exe:test.exe}))) 11 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | module A = struct 2 | include Alcotest 3 | let choice 4 | (type a) (type b) 5 | (module M1 : TESTABLE with type t = a) 6 | (module M2 : TESTABLE with type t = b) 7 | : (module TESTABLE with type t = [`Left of M1.t | `Right of M2.t]) 8 | = (module struct 9 | type t = [`Left of M1.t | `Right of M2.t] 10 | let pp ppf = function 11 | | `Left x -> M1.pp ppf x 12 | | `Right x -> M2.pp ppf x 13 | let equal x y = match x, y with 14 | | `Left x, `Left y -> M1.equal x y 15 | | `Right x, `Right y -> M2.equal x y 16 | | _ -> false 17 | end) 18 | 19 | let equal_error x1 x2 = match x1, x2 with 20 | | `NoMatch _, `NoMatch _ -> true 21 | | `ConverterFailure exn, `ConverterFailure exn' -> exn = exn' 22 | | _ -> false 23 | let tyre desc = result desc @@ testable Tyre.pp_error equal_error 24 | end 25 | 26 | open Tyre 27 | exception ConvFail 28 | let cfail : unit t = 29 | conv (fun _ -> raise ConvFail) (fun _ -> raise ConvFail) (regex Re.any) 30 | 31 | let test_fail title desc cre s error b = 32 | A.(check @@ tyre desc) 33 | (title^" exec") (Tyre.exec cre s) (Result.Error error) ; 34 | A.(check bool) (title^" execp") (Tyre.execp cre s) b 35 | 36 | let nomatch title desc re s = 37 | title, `Quick, fun () -> 38 | let cre = Tyre.compile re in 39 | test_fail title desc cre s (`NoMatch (cre, s)) false ; 40 | A.(check @@ tyre @@ list desc) 41 | (title^" all") (Tyre.all cre s) (Result.Ok []) 42 | 43 | let convfail title desc re s = 44 | title, `Quick, fun () -> 45 | let cre = Tyre.compile re in 46 | test_fail title desc cre s (`ConverterFailure ConvFail) true ; 47 | A.(check @@ tyre @@ list desc) 48 | (title^" all") (Tyre.all cre s) 49 | (Result.Error (`ConverterFailure ConvFail)) ; 50 | A.check_raises 51 | (title^" all_seq") ConvFail (fun () -> ignore @@ Tyre.all_seq cre s ()) 52 | 53 | 54 | let test title desc cre re v s = 55 | A.(check @@ tyre desc) 56 | (title^" exec") (Tyre.exec cre s) (Result.Ok v) ; 57 | A.(check bool) (title^" execp") (Tyre.execp cre s) true ; 58 | A.(check string) (title^" eval") s (Tyre.eval re v) 59 | 60 | let test_all title desc cre re l s = 61 | A.(check @@ tyre @@ list desc) 62 | (title^" all") (Tyre.all cre s) (Result.Ok l) ; 63 | A.(check string) (title^" eval all") s (Tyre.eval (list re) l) 64 | 65 | let t' ?(all=true) title desc re v s = 66 | title, `Quick, fun () -> 67 | let cre = Tyre.compile re in 68 | test title desc cre re v s ; 69 | if all then test_all title desc cre re [v] s 70 | 71 | let t ?all title desc re v s = 72 | t' ?all title desc (Tyre.whole_string re) v s 73 | 74 | let topt' title desc re v s s' = 75 | title, `Quick, 76 | fun () -> 77 | let cre = Tyre.compile re in 78 | test (title ^" some") (A.option desc) cre re (Some v) s ; 79 | test_all (title ^"some") (A.option desc) cre re [Some v] s ; 80 | test (title ^" none") (A.option desc) cre re None s' 81 | 82 | let topt title desc re v s s' = 83 | topt' title desc (Tyre.whole_string re) v s s' 84 | 85 | let basics = [ 86 | t "int" A.int int 42 "42" ; 87 | t "int pos" A.int pos_int 549085 "549085" ; 88 | t "int neg" A.int int (-54) "-54" ; 89 | 90 | t "float int" (A.float epsilon_float) float 3. "3." ; 91 | (* t "float_int2" A.float float 3. "3" ; *) 92 | t "float" (A.float epsilon_float) float 4.2 "4.2" ; 93 | t "float neg" (A.float epsilon_float) float (-4.2) "-4.2" ; 94 | 95 | t "bool true" A.bool bool true "true" ; 96 | t "bool false" A.bool bool false "false" ; 97 | 98 | topt "int option" A.int (opt int) 3 "3" "" ; 99 | t "int seq" A.(pair int bool) (int <&> bool) (3,true) "3true" ; 100 | ] 101 | 102 | let notwhole = [ 103 | topt' "int option" A.int (opt int) 3 "3" "" ; 104 | t' "separated list" A.(list int) (separated_list ~sep:(char ',') int) [4;4;4] "4,4,4" ; 105 | ] 106 | 107 | let prefix_suffix = [ 108 | t "prefix" A.int (bool *> int) 3 "true3" ; 109 | t "prefix" A.int (int *> bool *> int) (-2) "0true-2" ; 110 | 111 | t "prefixstr" A.int (str "foo" *> int) 3 "foo3" ; 112 | t "suffixstr" A.int (int <* str "foo") 3 "3foo" ; 113 | 114 | t "prefix seq" A.(pair int int) (int <&> str "foo" *> int) (3,4) "3foo4" ; 115 | t "prefix seq" A.(pair int bool) (int <&> bool <* str "foo") (3,true) "3truefoo" ; 116 | t "suffix seq" A.(pair int int) (int <* str "foo" <&> int) (3,4) "3foo4" ; 117 | t "suffix seq" A.(pair bool int) (str "foo" *> bool <&> int) (true,4) "footrue4" ; 118 | ] 119 | 120 | let composed = [ 121 | topt "option prefix" A.int (opt int <* str "foo") 3 "3foo" "foo" ; 122 | t "terminated list" A.(list int) (terminated_list ~sep:(char ';') int) 123 | [1;254;3;54;] "1;254;3;54;" ; 124 | t "separated list" A.(list int) (separated_list ~sep:(char ';') int) 125 | [1;254;3;54] "1;254;3;54" ; 126 | t "alt list" A.(list @@ choice string string) (list (regex Re.digit <|> regex Re.alpha)) 127 | [`Left "1";`Right "a"; `Left "2"; `Left "5"; `Right "c"] "1a25c" ; 128 | t "list of list" 129 | A.(list @@ list @@ choice int string) 130 | (list @@ str"@" *> list (pos_int <|> regex Re.alpha)) 131 | [[`Left 1;`Right "a"]; [`Right "c"] ; [`Right "d";`Left 33]] "@1a@c@d33" 132 | ] 133 | 134 | 135 | let marks = 136 | let t ?all s = 137 | t ?all s A.(choice (option string) (option string)) 138 | (opt @@ pcre "a" <|> opt @@ pcre "b") 139 | in [ 140 | t "alt option left" (`Left (Some "a")) "a" ; 141 | t "alt option rigth" (`Right (Some "b")) "b" ; 142 | t ~all:false "alt option none" (`Left None) "" ; 143 | ] 144 | 145 | let nomatch = [ 146 | nomatch "int" A.int int "a" ; 147 | nomatch "bool" A.bool bool "" ; 148 | nomatch "string" A.unit (str "foo") "fo"; 149 | nomatch "2char" A.(pair string string) (regex Re.any <&> regex Re.any) "x" ; 150 | nomatch "anchored" A.unit (whole_string @@ char 'x') "xx" ; 151 | ] 152 | 153 | let conv_failure = [ 154 | convfail "char" A.unit cfail "x"; 155 | convfail "alt" A.(choice unit int) (cfail <|> int) "x" ; 156 | t "alt2" A.(choice int unit) (int <|> cfail) (`Left 2) "2" ; 157 | convfail "prefix" A.unit (str "foo" *> cfail) "fooy" ; 158 | t "prefix2" A.unit (cfail *> str "foo") () "\000foo" ; 159 | ] 160 | 161 | let routes = 162 | let fixed n = regex Re.(repn any n (Some n)) in 163 | let f n x = n, x in 164 | route [ 165 | (str"foo" *> fixed 3 <* str"xx") --> f 1 ; 166 | (str"foo" *> fixed 5) --> f 2 ; 167 | (str"bar" *> fixed 5) --> f 3 ; 168 | (fixed 2 <* str"blob") --> f 4 ; 169 | ] 170 | 171 | let troute title s n res = 172 | title, `Quick, 173 | fun () -> 174 | A.(check @@ result (pair int string) reject) 175 | title (exec routes s) (Result.Ok (n,res)) 176 | 177 | let route_test = [ 178 | troute "route 1" "foo123xx" 1 "123" ; 179 | troute "route 2" "foo12345" 2 "12345" ; 180 | troute "route 3" "bar12345" 3 "12345" ; 181 | troute "route 4" "xxblob" 4 "xx" ; 182 | ] 183 | 184 | 185 | let () = Alcotest.run "tyre" [ 186 | "basics", basics ; 187 | "not whole", notwhole ; 188 | "prefix suffix", prefix_suffix ; 189 | "composed", composed ; 190 | "marks", marks ; 191 | "routes", route_test ; 192 | "nomatch", nomatch ; 193 | "convfail", conv_failure ; 194 | ] 195 | -------------------------------------------------------------------------------- /test/test.mli: -------------------------------------------------------------------------------- 1 | (* EMPTY *) 2 | -------------------------------------------------------------------------------- /tyre.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "tyre" 3 | maintainer: "Gabriel Radanne " 4 | authors: "Gabriel Radanne " 5 | homepage: "https://github.com/Drup/tyre" 6 | doc: "https://drup.github.io/tyre/doc/dev/tyre/Tyre/" 7 | bug-reports: "https://github.com/Drup/tyre/issues" 8 | license: "ISC" 9 | dev-repo: "git+https://github.com/Drup/tyre.git" 10 | tags: [ "regex" ] 11 | 12 | build: [ 13 | ["dune" "subst"]{pinned} 14 | ["dune" "build" "-p" name "-j" jobs] 15 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 16 | ] 17 | 18 | 19 | depends: [ 20 | "ocaml" { >= "4.03.0" } 21 | "dune" {build & >= "1.0"} 22 | "re" {>= "1.8.0"} 23 | "alcotest" {with-test & >= "0.8.0"} 24 | "odoc" { with-doc } 25 | "result" 26 | "seq" 27 | ] 28 | 29 | synopsis: "Typed Regular Expressions" 30 | 31 | description: """ 32 | Tyre is a set of combinators to build type-safe regular expressions, 33 | allowing automatic extraction and modification of matched groups. 34 | Tyre is bi-directional: a typed regular expressions can be used for 35 | parsing and unparsing. It also allows routing, by providing a list of 36 | regexs/routes and their handlers 37 | """ 38 | --------------------------------------------------------------------------------