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

Question

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

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中的链接是通过页面加载来处理的，而不是发送给应用程序的信号。

如果单击链接，需要进行哪些代码更改/添加才能将信号发送到Flame，而不是加载浏览器页面？我的一般做法是否正确？

我尝试过使用纯文本路由文档和纯文本路由测试来获得理解，但是没有给出一个完整的示例(包括可点击的URL)。我也尝试过从RoutingPushHalogenClassic PureScript食谱代码工作，但它似乎不适用于火焰。

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具体类型，用于从应用程序内部和外部进行路由更改，即用户在地址栏中输入、从外部链接加载应用程序等等。这是不必要的，但我想强调的是，这些情况下的逻辑和代码路径是不同的。
• routeMatch处理外部路由更改，onClick_用于内部，并使用Flame自己的createRawEvent功能。
• 虽然Flame不包括单击处理和preventDefault，但我确实发现这个密钥捕获的测试在制作onClick_时非常有用。
• 打开developer工具控制台，查看消息和内部状态更改。