Exact Route Matchers in purescript-routing

I was using purescript-routing and there didn’t seem to be a built-in way to match an exact route. For example, if you defined a “home” route and none of your other routes matched, it would default to the “home” route because it is the root component of every other route.

import Routing
import Prelude
import Control.Alt ((<|>))
import Routing.Match (Match(..))
import Routing.Match.Class (lit, str)
import RoutingM.Match (exact)

data Location
  = Home
  | Login
  | NotFound
  | Profile String

{- home is treated as a parent of the
   other routes, so it will always be the 
   fallback route -}
home :: Match Location
home = Home <$ sep

sep :: Match Unit
sep = lit ""

login :: Match Location
login = Login <$ (sep *> lit "login")

notFound :: Match Location
notFound = pure NotFound

profile :: Match Location
profile = Profile <$> (sep *> lit "profile" *> str)

applicationRouter :: Match Location
applicationRouter =
  -- matches /#/login, /#/login/morestuff
  login <|>
  -- matches /#/profile/john, /#/profile/bill, etc...
  profile <|>
  -- matches /#/, /#/anything/else/not/previously/matched
  home <|>
  -- matches nothing
  notFound

What I really wanted was to only match the home route on “/#/”. That way, the fallback would be NotFound. So I created a new matcher function named “exact” that only succeeds if there are no trailing components after a match…

import Prelude
import Routing.Match.Error
import Data.List (List(..))
import Data.Semiring.Free (free)
import Data.Tuple (Tuple(..))
import Data.Validation.Semiring (invalid, unV)
import Routing.Match (Match(..))
import Routing.Types (RoutePart(..))

exact :: forall a. Match a -> Match a
exact (Match f) = Match \route ->
  (f route) # unV invalid \(Tuple mroute a) ->
    -- The initial match was successful. If
    -- there are any trailing url components
    -- then we'll fail the match, since we
    -- only want an exact match...
    case mroute of
      Nil ->
        pure $ Tuple mroute a
      Cons (Path "") Nil ->
        pure $ Tuple mroute a
      Cons (Path _) (Cons (Path n) _) ->
        invalid $ free $ UnexpectedPath n
      _ ->
        invalid $ free ExpectedPathPart

So now I can route to home only when there is nothing else following “/#” or “/#/”.

applicationRouter :: Match Location
applicationRouter =
  -- matches nothing, /#, /#/ only
  (exact home) <|>
  -- matches #/login, #/login/ only
  (exact login) <|>
  -- matches #/profile/name and all child routes
  profile <|>
  -- Any other case
  notFound