diff --git a/lib/Hikaru/Link.hs b/lib/Hikaru/Link.hs index d0ff46ed8d25fb1f7846faf27bdd75cb98432054..02864853c75fc9a69eff3ed2fa752667651d4544 100644 --- a/lib/Hikaru/Link.hs +++ b/lib/Hikaru/Link.hs @@ -7,7 +7,8 @@ Maintainer : mordae@anilinux.org Stability : unstable Portability : non-portable (ghc) -This module provides various ways to build local links. +This module provides various ways to build local links and provide +feedback based on the request path. -} module Hikaru.Link @@ -18,6 +19,10 @@ module Hikaru.Link , lhref_ , phref_ , qhref_ + + -- ** Path Feedback + , isActivePath + , isActivePrefix ) where import BasePrelude @@ -96,4 +101,26 @@ where qhref_ qs = href_ (makeLink [] qs) + -- Path Feedback ----------------------------------------------------------- + + + -- | + -- Determine whether the supplied path is the one user has requested. + -- + isActivePath :: (MonadAction m) => [Text] -> m Bool + isActivePath link = do + path <- getPathInfo + return $ link == path + + + -- | + -- Determine whether the supplied path is a prefix of the one user has + -- requested. Empty path components in the supplied path are ignored. + -- + isActivePrefix :: (MonadAction m) => [Text] -> m Bool + isActivePrefix link = do + path <- getPathInfo + return $ isPrefixOf (filter (/= "") link) path + + -- vim:set ft=haskell sw=2 ts=2 et: