diff --git a/tests/dune b/tests/dune
index af815ab..f73c188 100644
--- a/tests/dune
+++ b/tests/dune
@@ -4,6 +4,7 @@
test_each
test_show
test_router
+ test_router_specialize
test_cleanup
test_basic)
(libraries helix signal stdweb html jx_jsoo)
@@ -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
diff --git a/tests/test_router.ml b/tests/test_router.ml
index b84eed8..7b140e8 100644
--- a/tests/test_router.ml
+++ b/tests/test_router.ml
@@ -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)
@@ -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")
@@ -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));
];
]
diff --git a/tests/test_router_specialize.html b/tests/test_router_specialize.html
new file mode 100644
index 0000000..e0b30b5
--- /dev/null
+++ b/tests/test_router_specialize.html
@@ -0,0 +1,15 @@
+
+
+
+
+
+ Helix - Tests
+
+
+
+
+
+
+
+
+
diff --git a/tests/test_router_specialize.ml b/tests/test_router_specialize.ml
new file mode 100644
index 0000000..9a25fdb
--- /dev/null
+++ b/tests/test_router_specialize.ml
@@ -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"