Some cleaning, added a readme and an example

Author: robertdp

README.md

@@ -0,0 +1,23 @@
+# purescript-wire-react-router
+
+A basic pushstate router for React, with support for asynchronous routing logic. Built using [react-basic-hooks](https://github.com/spicydonuts/purescript-react-basic-hooks) and [wire](https://github.com/robertdp/purescript-wire). I recommend [routing-duplex](https://github.com/natefaubion/purescript-routing-duplex) for easy parsing and printing.
+
+```purescript
+makeRouter ::
+  forall route f.
+  Foldable f =>
+  { interface :: PushStateInterface
+  , fallback :: route
+  , parse :: String -> f route
+  , print :: route -> String
+  , onRoute :: route -> Router route Transitioning Resolved Unit
+  } ->
+  Effect
+    { signal :: Signal (Route route)
+    , component :: JSX
+    , navigate :: route -> Effect Unit
+    , redirect :: route -> Effect Unit
+    }
+```
+
+For a basic example see [`examples/RoutingDuplex.purs`](https://github.com/robertdp/purescript-wire-react-router/blob/master/examples/RoutingDuplex.purs).

examples/RoutingDuplex.purs

@@ -0,0 +1,82 @@
+{-| This example also requires the following dependencies to be installed:
+    - react-basic-dom
+    - routing-duplex
+    - wire-react
+-}
+module Example.RoutingDuplex where
+
+import Prelude hiding ((/))
+import Data.Generic.Rep (class Generic)
+import Data.Lens as Lens
+import Effect (Effect)
+import React.Basic.DOM as R
+import React.Basic.Events (handler_)
+import React.Basic.Hooks (JSX)
+import React.Basic.Hooks as React
+import Routing.Duplex (RouteDuplex', default, end, parse, print, root)
+import Routing.Duplex.Generic (noArgs, sum)
+import Routing.Duplex.Generic.Syntax ((/))
+import Routing.PushState as PushState
+import Wire.React as Wire
+import Wire.React.Router (_Route)
+import Wire.React.Router as Router
+
+data Route
+  = Home
+  | About
+  | NotFound
+
+derive instance genericRoute :: Generic Route _
+
+routes :: RouteDuplex' Route
+routes =
+  default NotFound
+    $ root
+    $ sum
+        { "Home": end noArgs
+        , "About": "about" / end noArgs
+        , "NotFound": "_" / "not-found" / end noArgs
+        }
+
+makeApp :: Effect (Unit -> JSX)
+makeApp = do
+  interface <- PushState.makeInterface
+  router <-
+    Router.makeRouter
+      { interface
+      , fallback:
+          -- used as the initial route if the parser fails
+          NotFound
+      , parse: parse routes
+      , print: print routes
+      , onRoute:
+          \_ ->
+            -- this skips any async routing logic by accepting the parsed route immediately
+            Router.continue
+      }
+  React.component "App" \props -> React.do
+    route <-
+      -- subscribe to the signal containing the current route
+      Wire.useSignal router.signal
+    pure
+      $ React.fragment
+          [ -- the router subscriber to pushstate events when this component is mounted, and unsubscribes when unmounted
+            router.component
+          , R.h1_
+              [ R.text case Lens.view _Route route of
+                  Home -> "Home"
+                  About -> "About"
+                  NotFound -> "Not Found"
+              ]
+          , R.div_
+              [ R.text "Menu: "
+              , R.button
+                  { onClick: handler_ $ router.navigate Home
+                  , children: [ R.text "Go to Home page" ]
+                  }
+              , R.button
+                  { onClick: handler_ $ router.navigate About
+                  , children: [ R.text "Go to About page" ]
+                  }
+              ]
+          ]

spago.dhall

@@ -2,11 +2,11 @@
 Welcome to a Spago project!
 You can edit this file as you like.
 -}
-{ name = "my-project"
+{ name = "wire-react-router"
 , dependencies =
   [ "aff"
-  , "indexed-monad"
   , "freet"
+  , "indexed-monad"
   , "profunctor-lenses"
   , "react-basic-hooks"
   , "routing"

src/Router.purs

@@ -5,7 +5,7 @@ module Wire.React.Router
 
 import Prelude
 import Control.Monad.Free.Trans (runFreeT)
-import Data.Foldable (class Foldable, for_, traverse_)
+import Data.Foldable (class Foldable, for_)
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (error, killFiber, launchAff, launchAff_)
@@ -21,48 +21,55 @@ import Wire.React.Router.Control (Command, Resolved, Route(..), Router, Transiti
 import Wire.Signal (Signal)
 import Wire.Signal as Signal
 
-makeRouter ::
-  forall route f.
-  Foldable f =>
-  { interface :: PushStateInterface
-  , default :: route
-  , decode :: String -> f route
-  , encode :: route -> String
-  , onRouteChange :: route -> Router route Transitioning Resolved Unit
-  } ->
-  Effect
-    { signal :: Signal (Route route)
+type Interface route
+  = { signal :: Signal (Route route)
     , component :: JSX
     , navigate :: route -> Effect Unit
     , redirect :: route -> Effect Unit
     }
-makeRouter { interface, default, decode, encode, onRouteChange } =
+
+makeRouter ::
+  forall f route.
+  Foldable f =>
+  { interface :: PushStateInterface
+  , fallback :: route
+  , parse :: String -> f route
+  , print :: route -> String
+  , onRoute :: route -> Router route Transitioning Resolved Unit
+  } ->
+  Effect (Interface route)
+makeRouter { interface, fallback, parse, print, onRoute } =
   let
-    onPushState k = PushState.matchesWith decode (\_ -> k) interface
+    onPushState k = PushState.matchesWith parse (\_ -> k) interface
 
-    navigate route = interface.pushState (unsafeToForeign {}) (encode route)
+    navigate route = interface.pushState (unsafeToForeign {}) (print route)
 
-    redirect route = interface.replaceState (unsafeToForeign {}) (encode route)
+    redirect route = interface.replaceState (unsafeToForeign {}) (print route)
   in
     do
-      { modify, signal } <- Signal.create (Transitioning Nothing default)
-      -- replace the user-supplied default route with the current route, if possible
-      interface.locationState >>= \{ path } -> for_ (decode path) \route -> modify \_ -> Transitioning Nothing route
+      { modify, signal } <- Signal.create (Transitioning Nothing fallback)
+      do
+        -- replace the user-supplied fallback route with the current route, if possible
+        { path } <- interface.locationState
+        for_ (parse path) \route -> modify \_ -> Transitioning Nothing route
       fiberRef <- Ref.new Nothing
       previousRouteRef <- Ref.new Nothing
       let
         runRouter route = do
-          -- if some previous long-running routing logic is still active, kill it
-          Ref.read fiberRef >>= traverse_ (launchAff_ <<< killFiber (error "Transition cancelled"))
+          do
+            -- if some previous long-running routing logic is still active, kill it
+            oldFiber <- Ref.read fiberRef
+            for_ oldFiber \fiber -> launchAff_ (killFiber (error "Transition cancelled") fiber)
           previousRoute <- Ref.read previousRouteRef
+          -- set the route state to "transitioning" with the previous successful route
           modify \_ -> Transitioning previousRoute route
           let
             finalise r =
               liftEffect do
                 Ref.write (Just r) previousRouteRef
                 modify \_ -> Resolved previousRoute r
           fiber <-
-            launchAff case onRouteChange route of
+            launchAff case onRoute route of
               Router router ->
                 router
                   # runFreeT \cmd -> do
@@ -75,6 +82,6 @@ makeRouter { interface, default, decode, encode, onRouteChange } =
           Ref.write (Just fiber) fiberRef
       component <-
         React.component "Wire.Router" \_ -> React.do
-          React.useEffectOnce do onPushState runRouter
+          React.useEffectOnce (onPushState runRouter)
           pure React.empty
       pure { signal, component: component unit, navigate, redirect }