From d8893ab0d92051f3d06be0d0ba35aa48c03eef56 Mon Sep 17 00:00:00 2001
From: Rizo <rizo@odis.io>
Date: Wed, 19 Jun 2024 12:00:53 +0100
Subject: [PATCH] Add Router.link ~alias for an additional active check

---
 src/helix/Helix.mli | 18 +++++++++++-------
 src/helix/Router.ml | 12 ++++++++----
 2 files changed, 19 insertions(+), 11 deletions(-)

diff --git a/src/helix/Helix.mli b/src/helix/Helix.mli
index 57de824..53dc148 100644
--- a/src/helix/Helix.mli
+++ b/src/helix/Helix.mli
@@ -335,20 +335,24 @@ module Router : sig
     ?active:Html.attr ->
     ?inactive:Html.attr ->
     ?exact:bool ->
+    ?alias:(unit -> 'alias, 'alias, 'alias) path ->
     ?up:int ->
     t ->
     ('view, 'link, Html.attr) path ->
     'link
-  (** [link ?absolute ?active ?exact router path vars...] is an HTML [href]
-      attribute that binds a link described by [path] and any [vars] contained
-      in it (or none, if it's a const only path). A link relative to [router]
-      will be created, unless [absolute] is [true].
+  (** [link ?absolute ?active ?exact ?alias router path vars...] is an HTML
+      [href] attribute that binds a link described by [path] and any [vars]
+      contained in it (or none, if it's a const only path). A link relative to
+      [router] will be created, unless [absolute] is [true].
 
       If [active] attribute is provided, in addition to binding [href], [active]
       will be bound in case the current path is active, otherwise [inactive] is
-      bound (if provided). By default a path is considered active if it is a
-      prefix of the current path, unless [exact] is [true], in which case the
-      path is only considered active when it is equal to the current path. *)
+      bound (if provided).
+
+      By default a path is considered active if it is a prefix of the current
+      path, unless [exact] is [true], in which case the path is only considered
+      active when it is equal to the current path. Additionally, the path is
+      considered active if it is equal to [alias]. *)
 
   val route : ('view, 'link, Html.elem) path -> 'view -> route
   (** Create a route by assigning a path to a view. *)
diff --git a/src/helix/Router.ml b/src/helix/Router.ml
index 3729b40..a0a5b1e 100644
--- a/src/helix/Router.ml
+++ b/src/helix/Router.ml
@@ -234,11 +234,15 @@ let pick_qpath segments =
     segments
 
 let link ?(absolute = false) ?(active = Html.Attr.empty)
-    ?(inactive = Html.Attr.empty) ?(exact = false) ?(up = 0) (router : t) path0
-    =
+    ?(inactive = Html.Attr.empty) ?(exact = false) ?alias ?(up = 0) (router : t)
+    path0 =
+  let alias = Option.map string_of_path alias in
   let check_is_active link curr =
-    if exact then String.equal link curr
-    else String.starts_with ~prefix:link curr
+    match alias with
+    | Some alias -> String.equal alias curr
+    | None ->
+      if exact then String.equal link curr
+      else String.starts_with ~prefix:link curr
   in
   eval_path
     (fun str_path ->