Created
February 2, 2026 09:30
-
-
Save thelissimus/ed40a27220362d485e4005504f635232 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| type str = char list | |
| let str_of_string s = s |> String.to_seq |> List.of_seq | |
| let string_of_str s = s |> List.to_seq |> String.of_seq | |
| type 'a parser = str -> ('a * str) option | |
| let ( <$> ) (p : 'a parser) (f : 'a -> 'b) : 'b parser = | |
| fun input -> | |
| match p input with | |
| | Some (a, rest) -> Some (f a, rest) | |
| | None -> None | |
| ;; | |
| let ( $> ) (p : 'a parser) (b : 'b) : 'b parser = p <$> fun _ -> b | |
| let pure v = fun input -> Some (v, input) | |
| let ( >>= ) (p : 'a parser) (f : 'a -> 'b parser) : 'b parser = | |
| fun input -> | |
| match p input with | |
| | Some (a, rest) -> f a rest | |
| | None -> None | |
| ;; | |
| let ( >> ) (p : 'a parser) (act : 'b parser) : 'b parser = p >>= fun _ -> act | |
| let ( *> ) (fa : 'a parser) (fb : 'b parser) : 'b parser = | |
| fun input -> | |
| match fa input with | |
| | Some (_, rest) -> fb rest | |
| | None -> None | |
| ;; | |
| let ( <* ) fa fb = fa >>= fun a -> fb >> pure a | |
| let ( <|> ) (p1 : 'a parser) (p2 : 'a parser) : 'a parser = | |
| fun input -> | |
| match p1 input with | |
| | Some (v, rest) -> Some (v, rest) | |
| | None -> p2 input | |
| ;; | |
| let rec sequence : 'a parser list -> 'a list parser = function | |
| | [] -> pure [] | |
| | p :: ps -> p >>= fun x -> sequence ps >>= fun xs -> pure (x :: xs) | |
| ;; | |
| let satisfy pred : char parser = | |
| fun input -> | |
| match input with | |
| | c :: rest when pred c -> Some (c, rest) | |
| | _ -> None | |
| ;; | |
| let char ch : char parser = satisfy (( = ) ch) | |
| let string (s : str) : str parser = sequence (List.map char s) | |
| let parse_null = string (str_of_string "null") $> `Null | |
| let parse_true = string (str_of_string "true") $> `Bool true | |
| let parse_false = string (str_of_string "false") $> `Bool false | |
| let parse_bool = parse_true <|> parse_false | |
| let take_while pred = | |
| fun input -> | |
| let rec loop acc = function | |
| | c :: cs when pred c -> loop (c :: acc) cs | |
| | rest -> List.rev acc, rest | |
| in | |
| Some (loop [] input) | |
| ;; | |
| let take_while1 pred = | |
| fun input -> | |
| match take_while pred input with | |
| | Some ([], _) -> None | |
| | res -> res | |
| ;; | |
| let rec many p = p >>= (fun x -> many p >>= fun xs -> pure (x :: xs)) <|> pure [] | |
| let sep_by sep p = | |
| p >>= (fun x -> many (sep >> p) >>= fun xs -> pure (x :: xs)) <|> pure [] | |
| ;; | |
| let is_digit ch = ch >= '0' && ch <= '9' | |
| let is_space = function | |
| | ' ' | '\n' | '\t' -> true | |
| | _ -> false | |
| ;; | |
| let ws p = take_while is_space *> p <* take_while is_space | |
| let parse_number = | |
| take_while1 is_digit <$> fun digs -> `Number (digs |> string_of_str |> int_of_string) | |
| ;; | |
| let escaped_char = | |
| char '\\' | |
| >> (char 'n' | |
| $> '\n' | |
| <|> (char 't' $> '\t') | |
| <|> (char 'r' $> '\r') | |
| <|> (char '\\' $> '\\') | |
| <|> (char '"' $> '"')) | |
| ;; | |
| let string_char = escaped_char <|> satisfy (fun c -> c <> '"' && c <> '\\') | |
| let parse_string = | |
| char '"' *> many string_char <* char '"' <$> fun chars -> `String (string_of_str chars) | |
| ;; | |
| let rec parse_list = | |
| fun input -> | |
| let p = sep_by (ws (char ',')) (ws parse_json) <$> fun xs -> `Array xs in | |
| (char '[' *> p <* char ']') input | |
| and parse_object = | |
| fun input -> | |
| let kv = | |
| ws parse_string | |
| >>= fun (`String k) -> ws (char ':') >> ws parse_json >>= fun v -> pure (k, v) | |
| in | |
| let p = sep_by (ws (char ',')) kv <$> fun xs -> `Object xs in | |
| (char '{' *> p <* char '}') input | |
| and parse_json = | |
| fun input -> | |
| (parse_null | |
| <|> parse_bool | |
| <|> parse_number | |
| <|> parse_string | |
| <|> parse_list | |
| <|> parse_object) | |
| input | |
| ;; | |
| let ex = {|{ "age": 42, "name": "Bo\t\"b" , "pets": [ "Rex"] }|} | |
| let parse p = fun input -> input |> str_of_string |> p |> Option.map fst |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment