package opium

  1. Overview
  2. Docs

Source file route.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
open Import

type path_segment =
  | Match of string
  | Param of string
  | Splat
  | FullSplat
  | Slash

type matches =
  { params : (string * string) list
  ; splat : string list
  }

let sexp_of_matches { params; splat } =
  let splat' = Sexp_conv.sexp_of_list Sexp_conv.sexp_of_string splat in
  let sexp_of_param (a, b) = Sexp_conv.sexp_of_list Sexp_conv.sexp_of_string [ a; b ] in
  Sexp.List
    [ List [ Atom "params"; Sexp_conv.sexp_of_list sexp_of_param params ]
    ; List [ Atom "splat"; splat' ]
    ]
;;

type t = path_segment list

let parse_param s =
  if s = "/"
  then Slash
  else if s = "*"
  then Splat
  else if s = "**"
  then FullSplat
  else (
    try Scanf.sscanf s ":%s" (fun s -> Param s) with
    | Scanf.Scan_failure _ -> Match s)
;;

let of_list l =
  let last_i = List.length l - 1 in
  l
  |> List.mapi ~f:(fun i s ->
         match parse_param s with
         | FullSplat when i <> last_i -> invalid_arg "** is only allowed at the end"
         | x -> x)
;;

let split_slash_delim =
  let re = '/' |> Re.char |> Re.compile in
  fun path ->
    path
    |> Re.split_full re
    |> List.map ~f:(function
           | `Text s -> `Text s
           | `Delim _ -> `Delim)
;;

let split_slash path =
  path
  |> split_slash_delim
  |> List.map ~f:(function
         | `Text s -> s
         | `Delim -> "/")
;;

let of_string path = path |> split_slash |> of_list

let to_string l =
  let r =
    l
    |> List.filter_map ~f:(function
           | Match s -> Some s
           | Param s -> Some (":" ^ s)
           | Splat -> Some "*"
           | FullSplat -> Some "**"
           | Slash -> None)
    |> String.concat ~sep:"/"
  in
  "/" ^ r
;;

let rec match_url t url ({ params; splat } as matches) =
  match t, url with
  | [], [] | [ FullSplat ], _ -> Some matches
  | FullSplat :: _, _ -> assert false (* splat can't be last *)
  | Match x :: t, `Text y :: url when x = y -> match_url t url matches
  | Slash :: t, `Delim :: url -> match_url t url matches
  | Splat :: t, `Text s :: url ->
    match_url t url { matches with splat = Uri.pct_decode s :: splat }
  | Param name :: t, `Text p :: url ->
    match_url t url { matches with params = (name, Uri.pct_decode p) :: params }
  | Splat :: _, `Delim :: _
  | Param _ :: _, `Delim :: _
  | Match _ :: _, _
  | Slash :: _, _
  | _ :: _, []
  | [], _ :: _ -> None
;;

let match_url t url =
  let path =
    match String.index_opt url '?' with
    | None -> url
    | Some i -> String.sub url ~pos:0 ~len:i
  in
  let path = path |> split_slash_delim in
  match_url t path { params = []; splat = [] }
;;