Skip to content

Commit

Permalink
feat: full route specialization with backtracking
Browse files Browse the repository at this point in the history
  • Loading branch information
@rizo
rizo committed Apr 15, 2024
1 parent acbdc57 commit 99248b4
Show file tree
Hide file tree
Showing 5 changed files with 224 additions and 9 deletions.
24 changes: 15 additions & 9 deletions src/helix/Router.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -129,22 +129,23 @@ module Table = struct
exception No_match of string list

let lookup (table0 : t) (input0 : string list) : (lookup, exn) result =
let rec loop node input matched args =
let rec loop ?bt node input matched args =
match input with
| [] -> (
match node.capture with
| No_match -> Error (Incomplete_match input0)
| No_match -> (
(* If we have a backtracking continuation, try that before failing. *)
match bt with
| None -> Error (Incomplete_match input0)
| Some bt -> bt ()
)
| Match route ->
Ok { route; matched = List.rev matched; args = List.rev args }
| Partial route ->
Ok { route; matched = List.rev matched; args = List.rev args }
)
| input_hd :: input' -> (
(* Const *)
match String_map.find_opt input_hd node.children with
| Some node' -> loop node' input' (input_hd :: matched) args
| None -> (
(* Rest *)
let bt () =
match node.capture with
| Partial route ->
Ok
Expand All @@ -154,13 +155,18 @@ module Table = struct
args = List.rev args @ input;
}
| _ -> (
(* Var *)
match String_map.find_opt ":" node.children with
| Some node' ->
loop node' input' (input_hd :: matched) (input_hd :: args)
| None -> Error (No_match input0)
)
)
in
(* Follow Const. If not defined, check for Rest and Var.
In addition to checking this now, we create a "backtracking"
continuation that might attempt the Rest/Var match if Const fails. *)
match String_map.find_opt input_hd node.children with
| Some node' -> loop ~bt node' input' (input_hd :: matched) args
| None -> bt ()
)
in
loop table0 input0 [] []
Expand Down
3 changes: 3 additions & 0 deletions tests/dune
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
test_each
test_show
test_router
test_router_specialize
test_cleanup
test_basic)
(libraries helix signal stdweb html jx_jsoo)
Expand All @@ -20,6 +21,8 @@
test_show.html
test_router.bc.js
test_router.html
test_router_specialize.bc.js
test_router_specialize.html
test_cleanup.bc.js
test_cleanup.html
test_basic.bc.js
Expand Down
15 changes: 15 additions & 0 deletions tests/test_router.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -240,6 +240,10 @@ module Links = struct
let open Router in
Const ("devices", Const ("!new", End))

let device_schema_edit =
let open Router in
Const ("devices", Var (string, None, Const ("schema", (Const ("!edit", End)))))

let account =
let open Router in
Const ("account", End)
Expand Down Expand Up @@ -361,6 +365,16 @@ let view router =
]
[ text "#/devices/!new" ];
];
li []
[
a
[
Router.link router
~active:(style_list [ ("font-weight", "bold") ])
Links.device_schema_edit "dev_1";
]
[ text "#/devices/dev_1/schema/!edit" ];
];
];
hr [];
Router.dispatch router ~label:"main" ~default:(text "NOT FOUND")
Expand All @@ -372,6 +386,7 @@ let view router =
show (fun id -> Html.text ("DEVICE EDIT: " ^ id)) id
);
Router.route Links.devices_new (fun () -> Html.text "DEVICE NEW");
Router.route Links.device_schema_edit (fun dev_id () -> let$ dev_id in Html.text ("DEVICE SCHEMA EDIT: " ^ dev_id));
];
]

Expand Down
15 changes: 15 additions & 0 deletions tests/test_router_specialize.html
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
<!DOCTYPE html>
<html lang="en">

<head>
<meta charset="utf-8" />
<title>Helix - Tests</title>
</head>

<body>
<div id="root"></div>
<noscript>You need to enable JavaScript to run this app.</noscript>
<script src="./test_router_specialize.bc.js" type="text/javascript"></script>
</body>

</html>
176 changes: 176 additions & 0 deletions tests/test_router_specialize.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,176 @@
open Helix
open Stdweb.Dom

module Links = struct
open Helix.Router

let team = Const ("teams", Var (string, None, Rest))

let team_sig team_id_sig =
Const ("teams", Var (string, Some team_id_sig, Rest))

module Team = struct
let projects = Const ("projects", End)
let projects_new = Const ("projects", Const ("!new", End))

let project_image_upload =
Const
("projects", Var (string, None, Const ("images", Const ("!new", End))))

let project_deployment =
Const
( "projects",
Var (string, None, Const ("deployments", Var (string, None, Rest)))
)

let project = Const ("projects", Var (string, None, Rest))

module Project = struct
let builds = Const ("builds", End)
let images = Const ("images", End)
end
end
end

module Deployment_view = struct
let make ~team_id:_ project_id deployment_id _deployment_router =
let open Html in
let$ project_id and$ deployment_id in
text ("DEPLOYMENT: " ^ project_id ^ "/" ^ deployment_id)
end

module Project_list_view = struct
let make ~team_id:_ team_router () =
let open Html in
div []
[
h3 [] [ text "PROJECT LIST" ];
a
[ Router.link team_router Links.Team.project "project_1" End ]
[ text "project_1" ];
br [];
a
[ Router.link team_router Links.Team.project "project_2" End ]
[ text "project_2" ];
]
end

module Project_new_view = struct
let make ~team_id:_ _team_router () =
let open Html in
text "PROJECT NEW"
end

module Image_upload_view = struct
let make ~team_id:_ _team_router project_id () =
let open Html in
let$ project_id in
text ("IMAGE UPLOAD: " ^ project_id)
end

module Project_view = struct
let make ~team_id:_ project_id project_router =
let open Html in
let open Html in
div []
[
h3 []
[
(let$ project_id in
text ("PROJECT: " ^ project_id)
);
];
Router.dispatch ~label:"project" project_router
Router.
[
route End (fun () -> text "PROJECT INDEX");
route Links.Team.Project.builds (fun () -> text "BUILDS");
route Links.Team.Project.images (fun () -> text "IMAGES");
];
]
end

module Team_view = struct
let make team_id team_router =
let open Html in
div []
[
h2 []
[
(let$ team_id in
text ("TEAM: " ^ team_id)
);
];
Router.dispatch ~label:"team" team_router
Router.
[
route Links.Team.projects
(Project_list_view.make ~team_id team_router);
route Links.Team.projects_new
(Project_new_view.make ~team_id team_router);
route Links.Team.project (Project_view.make ~team_id);
route Links.Team.project_image_upload
(Image_upload_view.make ~team_id team_router);
route Links.Team.project_deployment (Deployment_view.make ~team_id);
];
]
end

let view router =
let current_team_id = Signal.make "team_1" in
let open Html in
div []
[
h1 [] [ text "INDEX" ];
pre []
[
show
(fun parts -> text ("/" ^ String.concat "/" parts))
(Router.path router);
];
hr [];
a [ href "#/" ] [ text "#/" ];
br [];
a
[ href "#/teams/team_1/projects/project_1" ]
[ text "#/teams/team_1/projects/project_1" ];
br [];
a
[ href "#/teams/team_1/projects/project_2" ]
[ text "#/teams/team_1/projects/project_2" ];
br [];
a
[ href "#/teams/team_1/projects/!new" ]
[ text "#/teams/team_1/projects/!new" ];
br [];
a
[ href "#/teams/team_2/projects/project_3" ]
[ text "#/teams/team_2/projects/project_3" ];
br [];
a
[ href "#/teams/team_1/projects/project_1/deployments/dep_1" ]
[ text "#/teams/team_1/projects/project_1/deployments/dep_1" ];
br [];
a
[ href "#/teams/team_1/projects/project_1/images" ]
[ text "#/teams/team_1/projects/project_1/images" ];
br [];
a
[ href "#/teams/team_1/projects/project_1/images/!new" ]
[ text "#/teams/team_1/projects/project_1/images/!new" ];
hr [];
Router.dispatch ~label:"main" router
[
Router.alias Router.End Links.team
(Signal.get current_team_id)
Links.Team.projects;
Router.route (Links.team_sig current_team_id) Team_view.make;
];
]

let () =
Helix.enable_debug false;
let router = Router.make History.hash_path in
match Stdweb.Dom.Document.get_element_by_id "root" with
| Some node -> Html.mount node (view router)
| None -> failwith "no #root node"

0 comments on commit 99248b4

Please sign in to comment.