├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── examples ├── ini.ml └── test.ini ├── src └── parcoom.ml └── tests └── parcoomTest.ml /.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 | 18 | # oasis generated files 19 | setup.data 20 | setup.log 21 | 22 | # Merlin configuring file for Vim and Emacs 23 | .merlin 24 | 25 | # Dune generated files 26 | *.install 27 | 28 | # Local OPAM switch 29 | _opam/ 30 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Tsoding 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all 2 | all: ini.native ini.byte parcoomTest.native parcoomTest.byte 3 | 4 | ini.native: src/parcoom.ml examples/ini.ml 5 | ocamlfind ocamlopt -I src/ -I examples/ -o ini.native src/parcoom.ml examples/ini.ml 6 | 7 | ini.byte: src/parcoom.ml examples/ini.ml 8 | ocamlfind ocamlc -I src/ -I examples/ -o ini.byte src/parcoom.ml examples/ini.ml 9 | 10 | parcoomTest.native: src/parcoom.ml tests/parcoomTest.ml 11 | ocamlfind ocamlopt -I src/ -I tests/ -o parcoomTest.native src/parcoom.ml tests/parcoomTest.ml 12 | 13 | parcoomTest.byte: src/parcoom.ml tests/parcoomTest.ml 14 | ocamlfind ocamlc -I src/ -I tests/ -o parcoomTest.byte src/parcoom.ml tests/parcoomTest.ml 15 | 16 | .PHONY: test 17 | test: test.native test.byte 18 | 19 | .PHONY: test.native 20 | test.native: parcoomTest.native 21 | ./parcoomTest.native 22 | 23 | .PHONY: test.byte 24 | test.byte: parcoomTest.byte 25 | ./parcoomTest.byte 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # parcoom 2 | 3 | Super Fast and Lightweight Monadic Parser Combinator library in OCaml. No dependencies. You can just copy-paste it to your project and use it. 4 | 5 | ## Quick Start 6 | 7 | ``` 8 | $ make 9 | $ ./ini.native ./examples/test.ini 10 | $ make test 11 | ``` 12 | 13 | ## References 14 | 15 | - https://www.cs.nott.ac.uk/~pszgmh/monparsing.pdf 16 | -------------------------------------------------------------------------------- /examples/ini.ml: -------------------------------------------------------------------------------- 1 | open Parcoom 2 | 3 | type key_t = string 4 | type value_t = string 5 | type pair_t = key_t * value_t 6 | type section_t = 7 | { name: string; 8 | pairs: pair_t list; 9 | } 10 | 11 | let show_pair ((key, value): pair_t): string = 12 | Printf.sprintf "(%s, %s)" key value 13 | 14 | let show_pairs (pairs: pair_t list): string = 15 | pairs 16 | |> List.map show_pair 17 | |> String.concat "," 18 | |> Printf.sprintf "[%s]" 19 | 20 | let show_section (section: section_t): string = 21 | Printf.sprintf 22 | "{ name = %s; pairs = %s }" 23 | section.name 24 | (show_pairs section.pairs) 25 | 26 | let show_sections (sections: section_t list): string = 27 | sections 28 | |> List.map show_section 29 | |> String.concat "," 30 | |> Printf.sprintf "[%s]" 31 | 32 | let read_whole_file (file_path: string): string = 33 | let ch = open_in file_path in 34 | let n = in_channel_length ch in 35 | let s = really_input_string ch n in 36 | close_in ch; 37 | s 38 | 39 | let section_name: string Parcoom.parser = 40 | prefix "[" *> parse_while (fun x -> x != ']') <* any_char 41 | 42 | let is_space (x: char) = x == ' ' || x == '\n' 43 | 44 | let wss: string Parcoom.parser = 45 | parse_while is_space 46 | 47 | let pair: pair_t Parcoom.parser = 48 | let name = parse_while (fun x -> not (is_space x) && x != '=') in 49 | (wss *> name <* wss <* prefix "=" <* wss) <*> (name <* wss) 50 | 51 | let section: section_t Parcoom.parser = 52 | section_name <*> many pair 53 | |> map (fun (name, pairs) -> { name = name; pairs = pairs; }) 54 | 55 | let ini: section_t list Parcoom.parser = 56 | many section 57 | 58 | let () = 59 | match Sys.argv |> Array.to_list with 60 | | _ :: file_path :: _ -> 61 | let result = file_path 62 | |> read_whole_file 63 | |> Parcoom.run ini 64 | in 65 | (match result with 66 | | Ok sections -> sections |> show_sections |> print_endline 67 | | Error error -> Printf.printf 68 | "Error during parsing at position %d: %s" 69 | error.pos 70 | error.desc) 71 | | _ -> failwith "Expected path to an ini file" 72 | -------------------------------------------------------------------------------- /examples/test.ini: -------------------------------------------------------------------------------- 1 | [section 1] 2 | key1 = value1 3 | key2 = value2 4 | key3 = value3 5 | 6 | 7 | [section 2] 8 | key1 = value1 9 | key2 = value2 10 | key3 = value3 -------------------------------------------------------------------------------- /src/parcoom.ml: -------------------------------------------------------------------------------- 1 | type input = 2 | { text: string; 3 | pos: int; 4 | } 5 | 6 | let input_sub (start: int) (len: int) (s: input): input = 7 | { text = String.sub (s.text) start len; 8 | pos = s.pos + start; 9 | } 10 | 11 | let make_input (s: string): input = 12 | { text = s; pos = 0 } 13 | 14 | type error = 15 | { desc: string; 16 | pos: int 17 | } 18 | 19 | type 'a parser = 20 | { run : input -> input * ('a, string) result 21 | } 22 | 23 | let fail (e: string) = { run = fun input -> input, Error e } 24 | let wrap (x: 'a) = { run = fun input -> input, Ok x } 25 | 26 | let map (f: 'a -> 'b) (p: 'a parser): 'b parser = 27 | { run = fun input -> 28 | match p.run input with 29 | | input', Ok x -> input', Ok (f x) 30 | | input', Error error -> input', Error error 31 | } 32 | 33 | let bind (f: 'a -> 'b parser) (p: 'a parser): 'b parser = 34 | { run = fun input -> 35 | match p.run input with 36 | | input', Ok x -> (f x).run input' 37 | | input', Error error -> input', Error error 38 | } 39 | 40 | let parse_while (p: char -> bool): string parser = 41 | { run = fun input -> 42 | let n = String.length input.text in 43 | let i = ref 0 in 44 | while !i < n && (String.get input.text !i |> p) do 45 | incr i 46 | done; 47 | input_sub !i (n - !i) input, Ok (String.sub input.text 0 !i) 48 | } 49 | 50 | let prefix (prefix_str: string): string parser = 51 | { run = fun input -> 52 | let unexpected_prefix_error = 53 | Printf.sprintf "expected `%s`" prefix_str 54 | in 55 | try 56 | let prefix_size = String.length prefix_str in 57 | let input_size = String.length input.text in 58 | let prefix_input = input |> input_sub 0 prefix_size in 59 | if String.equal prefix_input.text prefix_str then 60 | let rest = input |> input_sub prefix_size (input_size - prefix_size) in 61 | rest, Ok prefix_str 62 | else 63 | input, Error unexpected_prefix_error 64 | with 65 | Invalid_argument _ -> input, Error unexpected_prefix_error 66 | } 67 | 68 | let ( *> ) (p1: 'a parser) (p2: 'b parser): 'b parser = 69 | { run = fun input -> 70 | let input', result = p1.run input in 71 | match result with 72 | | Ok _ -> p2.run input' 73 | | Error e -> input', Error e 74 | } 75 | 76 | let ( <* ) (p1: 'a parser) (p2: 'b parser): 'a parser = 77 | { run = fun input -> 78 | let input', result = p1.run input in 79 | match result with 80 | | Ok x -> 81 | let input'', result' = p2.run input' in 82 | (match result' with 83 | | Ok _ -> input'', Ok x 84 | | Error e -> input'', Error e) 85 | | Error e -> input', Error e 86 | } 87 | 88 | let ( <*> ) (p1: 'a parser) (p2: 'b parser): ('a * 'b) parser = 89 | { run = fun input -> 90 | let input', result = p1.run input in 91 | match result with 92 | | Ok x -> 93 | let input'', result' = p2.run input' in 94 | (match result' with 95 | | Ok y -> input'', Ok (x, y) 96 | | Error e -> input'', Error e) 97 | | Error e -> input', Error e 98 | } 99 | 100 | let ( <|> ) (p1: 'a parser) (p2: 'a parser): 'a parser = 101 | { run = fun input -> 102 | let input', result = p1.run input in 103 | match result with 104 | | Ok x -> input', Ok x 105 | | Error left_error -> p2.run input 106 | } 107 | 108 | let optional (p: 'a parser): 'a option parser = 109 | { run = fun input -> 110 | let input', result = p.run input in 111 | match result with 112 | | Ok x -> input', Ok (Some x) 113 | | Error _ -> input', Ok None 114 | } 115 | 116 | let many_exact (n: int) (p: 'a parser): 'a list parser = 117 | { run = fun input -> 118 | let rec loop i xs input' = 119 | if i < n then 120 | let input'', result = p.run input' in 121 | match result with 122 | | Ok x -> loop (i + 1) (x :: xs) input'' 123 | | Error e -> input'', Error e 124 | else 125 | input', Ok (List.rev xs) 126 | in loop 0 [] input 127 | } 128 | 129 | let many (p: 'a parser): 'a list parser = 130 | { run = fun input -> 131 | let xs = ref [] in 132 | let rec loop input = 133 | let input', result = p.run input in 134 | match result with 135 | | Ok x -> 136 | xs := x :: !xs; 137 | loop input' 138 | | Error _ -> 139 | input 140 | in 141 | let input' = loop input in 142 | input', Ok (!xs |> List.rev) 143 | } 144 | 145 | let any_char: char parser = 146 | { run = fun input -> 147 | let n = String.length input.text in 148 | try 149 | input_sub 1 (n - 1) input, Ok (String.get input.text 0) 150 | with 151 | Invalid_argument _ -> input, Error "expected any character" 152 | } 153 | 154 | let run (p: 'a parser) (s: string): ('a, error) result = 155 | match s |> make_input |> p.run with 156 | | _ , Ok x -> Ok x 157 | | input', Error desc -> Error {pos = input'.pos; desc = desc; } 158 | -------------------------------------------------------------------------------- /tests/parcoomTest.ml: -------------------------------------------------------------------------------- 1 | open Parcoom 2 | 3 | let test_fail () = 4 | print_endline "test_fail..."; 5 | let input = "whatever input" in 6 | let message = "khello" in 7 | let expected = Error { desc = message; pos = 0 } in 8 | let actual = run (fail message) input in 9 | assert (compare expected actual == 0) 10 | 11 | let test_wrap () = 12 | print_endline "test_wrap..."; 13 | let input = "whatever input" in 14 | let result = 69 in 15 | let expected = Ok result in 16 | let actual = run (wrap result) input in 17 | assert (compare expected actual == 0) 18 | 19 | let test_map () = 20 | print_endline "test_map..."; 21 | let input = "whatever input" in 22 | let ok_map () = 23 | let result = 68 in 24 | let expected = Ok (result + 1) in 25 | let actual = run (result |> wrap |> map (fun x -> x + 1)) input in 26 | assert (compare expected actual == 0) 27 | in 28 | let error_map () = 29 | let message = "khello" in 30 | let expected = Error {desc = message; pos = 0} in 31 | let actual = run (message |> fail |> map (fun x -> x + 1)) input in 32 | assert (compare expected actual == 0) 33 | in 34 | ok_map (); 35 | error_map () 36 | 37 | let () = 38 | test_fail (); 39 | test_wrap (); 40 | test_map () 41 | --------------------------------------------------------------------------------