如何完成这个 PureScript pushState 路由示例？

Question

我正在尝试使用 purescript-routing 库在 PureScript 中执行 pushState 路由。为了帮助解决这个问题，我构建了以下最小示例：

module Main where

import Prelude

import Data.Foldable (oneOf)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Effect (Effect)
import Effect.Console (log)
import Flame (Html, QuerySelector(..))
import Flame.Application.NoEffects as FAN
import Flame.HTML.Attribute as HA
import Flame.HTML.Element as HE
import Routing.Match (Match, end, int, lit, root)
import Routing.PushState (makeInterface, matches)
import Signal.Channel (send)

type Model = {
  route :: Route
}

data Message = ChangeRoute Route

data Route
  = RouteOne
  | RouteTwo
  | RouteThree Int
  | Root

derive instance genericRoute :: Generic Route _
instance showRoute :: Show Route where
  show = genericShow

route :: Match Route
route = root *> oneOf
  [ Root <$ end
  , RouteOne <$ lit "route-1" <* end
  , RouteTwo <$ lit "route-2" <* end
  , RouteThree <$> (lit "route-3" *> int)
  ]

init :: Model
init = { route: Root }

update :: Model -> Message -> Model
update model = case _ of
  ChangeRoute x -> model { route = x }

view :: Model -> Html Message
view model = HE.main "main" $
  [ HE.p_ ("Route: " <> show model.route)
  , HE.ul_
    [ HE.li_
      [ HE.a [ HA.href "/route-1" ] "route 1"
      ]
    , HE.li_
      [ HE.a [ HA.href "/route-2" ] "route 2"
      ]
    , HE.li_
      [ HE.a [ HA.href "/route-3/123" ] "route 3"
      ]
    ]
  ]

main :: Effect Unit
main = do
  nav <- makeInterface

  flameChannel <- FAN.mount (QuerySelector "main")
    { init
    , update
    , view
    }

  void $ nav # matches route \oldRoute newRoute -> do
    log $ show oldRoute <> " -> " <> show newRoute
    send flameChannel [ ChangeRoute newRoute ]

什么有效：

路由解析
正在控制台打印当前路由

什么不起作用：单击 DOM 中的 link 由页面加载处理，而不是向应用程序发送信号。

需要编写什么代码 changes/additions 才能使单击 link 导致向 Flame 发送信号，而不是加载浏览器页面？我的一般方法是否正确？

我试过使用 purescript-routing documentation and purescript-routing tests to gain an understanding, but neither show a complete example (including clickable URLs). I have also tried working from the RoutingPushHalogenClassic PureScript cookbook code，但它似乎不适用于 Flame。

Answer 1

这是完成它的一种方法：

module Main where

import Prelude
import Data.Foldable (oneOf)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), isNothing)
import Debug.Trace (spy)
import Effect (Effect)
import Effect.Console (log)
import Flame (Html, QuerySelector(..))
import Flame.Application.NoEffects as FAN
import Flame.HTML.Attribute as HA
import Flame.HTML.Element as HE
import Foreign (unsafeToForeign)
import Routing.Match (Match, end, int, lit, root)
import Routing.PushState (PushStateInterface, makeInterface, matches)
import Signal.Channel (Channel, send)
import Web.Event.Event (preventDefault)

type Model
  = { navInterface :: PushStateInterface
    , route :: Route
    }

data Message
  = ChangeRouteInternal Route
  | ChangeRouteExternal Route

data Route
  = RouteOne
  | RouteTwo
  | RouteThree Int
  | Root

derive instance genericRoute :: Generic Route _

instance showRoute :: Show Route where
  show = genericShow

route :: Match Route
route =
  root
    *> oneOf
        [ Root <$ end
        , RouteOne <$ lit "route-1" <* end
        , RouteTwo <$ lit "route-2" <* end
        , RouteThree <$> (lit "route-3" *> int) <* end
        ]

init :: PushStateInterface -> Model
init nav = { navInterface: nav, route: Root }

update :: Model -> Message -> Model
update model = case _ of
  ChangeRouteInternal x -> spy "ChangeRouteInternal" model { route = x }
  ChangeRouteExternal x -> spy "ChangeRouteExternal" model { route = x }

view :: Model -> Html Message
view model =
  HE.main "main"
    $ [ HE.p_ ("Route: " <> show model.route)
      , HE.ul_
          [ HE.li_
              [ HE.a (routeAnchorAttributes (ChangeRouteInternal RouteOne)) "route 1"
              ]
          , HE.li_
              [ HE.a (routeAnchorAttributes (ChangeRouteInternal RouteTwo)) "route 2"
              ]
          , HE.li_
              [ HE.a (routeAnchorAttributes (ChangeRouteInternal (RouteThree 123))) "route 3"
              ]
          ]
      ]
  where
  routeAnchorAttributes = case _ of
    ChangeRouteInternal anchorRoute -> [ HA.href (routeToUrl anchorRoute), onClick_ anchorRoute ]
    _ -> []

  -- Based on keypress example at:
  -- https://github.com/easafe/purescript-flame/blob/master/test/Basic/EffectList.purs
  onClick_ clickedRoute =
    HA.createRawEvent "click"
      $ \event -> do
          preventDefault event
          model.navInterface.pushState (unsafeToForeign {}) (routeToUrl clickedRoute)
          pure $ Just (ChangeRouteInternal clickedRoute)

routeToUrl :: Route -> String
routeToUrl = case _ of
  Root -> "/"
  RouteOne -> "/route-1"
  RouteTwo -> "/route-2"
  RouteThree n -> "/route-3/" <> (show n)

routeMatch :: Match Route -> Channel (Array Message) -> PushStateInterface -> Effect Unit
routeMatch m chan =
  void
    <$> matches m \oldRoute newRoute -> do
        log $ show oldRoute <> " -> " <> show newRoute
        if isNothing oldRoute then
          send chan [ ChangeRouteExternal newRoute ]
        else
          pure unit

main :: Effect Unit
main = do
  nav <- makeInterface
  flameChannel <-
    FAN.mount (QuerySelector "main")
      { init: init nav
      , update
      , view
      }
  routeMatch route flameChannel nav

此代码具有单独的 Message 路由更改的具体类型，这些路由更改源自应用程序内部与外部，即来自用户在地址栏中键入内容、从外部加载应用程序 link 等. 这不是必需的，但我想强调的是，这些情况的逻辑和代码路径是不同的。
routeMatch 处理外部路由更改，onClick_ 用于内部并使用 Flame 自己的 createRawEvent 功能。
虽然 Flame 文档不包含点击处理和 preventDefault，但我确实发现 this test of key capture 在制作 onClick_.
打开开发人员工具控制台以查看消息和内部状态更改。

如何完成这个 PureScript pushState 路由示例？

How do I complete this PureScript pushState routing example?

url-routing

purescript