I'm trying to do pushState routing in PureScript, using the purescript-routing library. To help work it out, I've built the following minimal example:
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 ]
What works:
What doesn't work: Clicking a link in the DOM is handled by a page load, instead of a signal being sent to the application.
What code changes/additions need to be made so clicking a link results in a signal being sent to Flame, as opposed to a browser page load? Is my general approach even correct?
I've tried using the 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, but it doesn't seem applicable to Flame.
This is one way to complete it:
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 concrete types for route changes originating from inside the application versus outside, i.e. from the user typing in the address bar, loading the application from an external link, etc. This is not necessary, but I wanted to highlight that the logic and code paths for these circumstances are different.routeMatch handles external routing changes, onClick_ is for internal and uses Flame's own createRawEvent function.preventDefault, I did find this test of key capture very helpful when making onClick_.