|
| 1 | +module RoutingPushReactHooks.Main where |
| 2 | + |
| 3 | +import Prelude |
| 4 | +import Control.Monad.Reader (ReaderT(..)) |
| 5 | +import Control.Monad.Reader as Reader |
| 6 | +import Data.Array as Array |
| 7 | +import Data.Foldable as Foldable |
| 8 | +import Data.Maybe (Maybe(..)) |
| 9 | +import Effect (Effect) |
| 10 | +import Effect.Class as Effect.Class |
| 11 | +import Effect.Exception as Exception |
| 12 | +import Foreign as Foreign |
| 13 | +import Partial.Unsafe as Partial.Unsafe |
| 14 | +import React.Basic (JSX, ReactContext) |
| 15 | +import React.Basic as React.Basic |
| 16 | +import React.Basic.DOM as R |
| 17 | +import React.Basic.DOM.Events as DOM.Events |
| 18 | +import React.Basic.Events as Events |
| 19 | +import React.Basic.Hooks (Hook, UseContext, (/\), Render) |
| 20 | +import React.Basic.Hooks as React |
| 21 | +import Routing.Match (Match) |
| 22 | +import Routing.Match as Match |
| 23 | +import Routing.PushState (PushStateInterface) |
| 24 | +import Routing.PushState as PushState |
| 25 | +import Web.HTML as HTML |
| 26 | +import Web.HTML.HTMLDocument as HTMLDocument |
| 27 | +import Web.HTML.HTMLElement as HTMLElement |
| 28 | +import Web.HTML.Window as Window |
| 29 | + |
| 30 | +main :: Effect Unit |
| 31 | +main = do |
| 32 | + maybeBody <- HTMLDocument.body =<< Window.document =<< HTML.window |
| 33 | + case maybeBody of |
| 34 | + Nothing -> Exception.throw "Could not find body." |
| 35 | + Just body -> do |
| 36 | + routerContext <- mkRouterContext |
| 37 | + routerProvider <- Reader.runReaderT mkRouterProvider routerContext |
| 38 | + app <- Reader.runReaderT mkApp routerContext |
| 39 | + R.render |
| 40 | + (routerProvider [ app unit ]) |
| 41 | + (HTMLElement.toElement body) |
| 42 | + |
| 43 | +-- | Note that we are not using `React.Basic.Hooks.Component` here, replacing it |
| 44 | +-- | instead with a very similar type, that has some extra "environment" |
| 45 | +-- | provided by `ReaderT` (namely the `RouterContext` that we need to pass to |
| 46 | +-- | `useRouterContext`). By using `ReaderT` we can avoid explicitly threading |
| 47 | +-- | the context through to all the components that use it, instead we can just |
| 48 | +-- | use `ask` to access it as needed. |
| 49 | +type Component props |
| 50 | + = ReaderT RouterContext Effect (props -> JSX) |
| 51 | + |
| 52 | +component :: |
| 53 | + forall props hooks. |
| 54 | + String -> (props -> Render Unit hooks JSX) -> Component props |
| 55 | +component name render = ReaderT \_ -> React.component name render |
| 56 | + |
| 57 | +mkApp :: Component Unit |
| 58 | +mkApp = do |
| 59 | + routerContext <- Reader.ask |
| 60 | + postIndex <- mkPostIndex |
| 61 | + post <- mkPost |
| 62 | + postEdit <- mkPostEdit |
| 63 | + headerNav <- mkHeaderNav |
| 64 | + component "App" \_ -> React.do |
| 65 | + { route } <- useRouterContext routerContext |
| 66 | + pure do |
| 67 | + React.Basic.fragment |
| 68 | + [ R.header_ [ headerNav unit ] |
| 69 | + , case route of |
| 70 | + Just Home -> R.h1_ [ R.text "Home" ] |
| 71 | + Just PostIndex -> postIndex unit |
| 72 | + Just (Post postId) -> post postId |
| 73 | + Just (PostEdit postId) -> postEdit postId |
| 74 | + Nothing -> R.h1_ [ R.text "Not found" ] |
| 75 | + ] |
| 76 | + |
| 77 | +mkHeaderNav :: Component Unit |
| 78 | +mkHeaderNav = do |
| 79 | + link <- mkLink |
| 80 | + component "Link" \_ -> |
| 81 | + pure do |
| 82 | + R.nav_ |
| 83 | + [ link |
| 84 | + { to: "/posts" |
| 85 | + , children: [ R.text "Posts" ] |
| 86 | + } |
| 87 | + , R.text " | " |
| 88 | + , link |
| 89 | + { to: "/" |
| 90 | + , children: [ R.text "Home" ] |
| 91 | + } |
| 92 | + ] |
| 93 | + |
| 94 | +mkPostIndex :: Component Unit |
| 95 | +mkPostIndex = do |
| 96 | + link <- mkLink |
| 97 | + component "PostIndex" \_ -> |
| 98 | + pure do |
| 99 | + R.ul_ |
| 100 | + ( Array.range 1 10 |
| 101 | + <#> \n -> |
| 102 | + R.li_ |
| 103 | + [ link |
| 104 | + { to: "/posts/" <> show n |
| 105 | + , children: |
| 106 | + [ R.text ("Post " <> show n) ] |
| 107 | + } |
| 108 | + ] |
| 109 | + ) |
| 110 | + |
| 111 | +mkPost :: Component Int |
| 112 | +mkPost = do |
| 113 | + link <- mkLink |
| 114 | + component "Post" \n -> |
| 115 | + pure do |
| 116 | + React.Basic.fragment |
| 117 | + [ R.h1_ [ R.text ("Post " <> show n) ] |
| 118 | + , R.p_ |
| 119 | + [ link |
| 120 | + { to: "/posts/" <> show n <> "/edit" |
| 121 | + , children: [ R.text "Click here" ] |
| 122 | + } |
| 123 | + , R.text " to edit this post" |
| 124 | + ] |
| 125 | + ] |
| 126 | + |
| 127 | +mkPostEdit :: Component Int |
| 128 | +mkPostEdit = |
| 129 | + component "PostEdit" \n -> |
| 130 | + pure (R.h1_ [ R.text ("Edit post " <> show n) ]) |
| 131 | + |
| 132 | +data AppRoute |
| 133 | + = PostIndex |
| 134 | + | Post Int |
| 135 | + | PostEdit Int |
| 136 | + | Home |
| 137 | + |
| 138 | +appRoute :: Match (Maybe AppRoute) |
| 139 | +appRoute = |
| 140 | + Foldable.oneOf |
| 141 | + [ Just <$> postRoute |
| 142 | + , Just <$> (Match.root *> pure Home <* Match.end) |
| 143 | + , pure Nothing |
| 144 | + ] |
| 145 | + where |
| 146 | + postRoute = |
| 147 | + Match.root *> Match.lit "posts" |
| 148 | + *> Foldable.oneOf |
| 149 | + [ PostEdit <$> Match.int <* Match.lit "edit" |
| 150 | + , Post <$> Match.int |
| 151 | + , pure PostIndex |
| 152 | + ] |
| 153 | + <* Match.end |
| 154 | + |
| 155 | +type RouterContextValue |
| 156 | + = { route :: Maybe AppRoute |
| 157 | + , nav :: PushStateInterface |
| 158 | + } |
| 159 | + |
| 160 | +-- | Note that we actually want a `RouterContextValue` where the context is |
| 161 | +-- | being consumed, not a `Maybe RouterContextValue`, but `createContext` |
| 162 | +-- | requires an "initial" value to use as a fallback in the case that the |
| 163 | +-- | context is used with no context provider. One solution would be to |
| 164 | +-- | construct a "dummy" value of type `RouterContextValue` that could work as a |
| 165 | +-- | sensible default. Another solution is to consider the use of the context |
| 166 | +-- | where it's not provided as *unintended behavior*, as described in this |
| 167 | +-- | article (in JS): |
| 168 | +-- | https://kentcdodds.com/blog/how-to-use-react-context-effectively. |
| 169 | +-- | *tl;dr* -- In JavaScript, the approach is to pass `undefined` or `null` as |
| 170 | +-- | the initial value and then instead of consuming the context directly at the |
| 171 | +-- | component level via `useContext`, to implement a custom hook that wraps |
| 172 | +-- | `useContext` and throws an error if the context is used where it's not |
| 173 | +-- | provided (signalling that this is not a use case we want to support). We've |
| 174 | +-- | done similar, by wrapping our context value in `Maybe` and using `Nothing` |
| 175 | +-- | as the case that we pattern-match on to trigger the error. |
| 176 | +type RouterContext |
| 177 | + = ReactContext (Maybe RouterContextValue) |
| 178 | + |
| 179 | +-- | An alternative would be to use `unsafePerformEffect` to have a "global" |
| 180 | +-- | `RouterContext` (not wrapped in `Effect`) that could be used directly |
| 181 | +-- | inside of `useRouterContext` instead of binding it in the top-level |
| 182 | +-- | component "bootstrapping" phase (inside of `main :: Effect Unit`) and |
| 183 | +-- | passing it down the component tree from there (as we're doing). |
| 184 | +mkRouterContext :: Effect RouterContext |
| 185 | +mkRouterContext = React.createContext Nothing |
| 186 | + |
| 187 | +useRouterContext :: |
| 188 | + RouterContext -> |
| 189 | + Hook (UseContext (Maybe RouterContextValue)) RouterContextValue |
| 190 | +useRouterContext routerContext = React.do |
| 191 | + maybeContextValue <- React.useContext routerContext |
| 192 | + pure case maybeContextValue of |
| 193 | + -- If we have no context value from a provider, we throw a fatal error |
| 194 | + Nothing -> |
| 195 | + Partial.Unsafe.unsafeCrashWith |
| 196 | + "useContext can only be used in a descendant of \ |
| 197 | + \the corresponding context provider component" |
| 198 | + Just contextValue -> contextValue |
| 199 | + |
| 200 | +mkRouterProvider :: Component (Array JSX) |
| 201 | +mkRouterProvider = do |
| 202 | + routerContext <- Reader.ask |
| 203 | + nav <- Effect.Class.liftEffect PushState.makeInterface |
| 204 | + component "Router" \children -> React.do |
| 205 | + let |
| 206 | + routerProvider = React.Basic.provider routerContext |
| 207 | + route /\ setRoute <- React.useState' (Just Home) |
| 208 | + React.useEffectOnce do |
| 209 | + nav |
| 210 | + # PushState.matches appRoute \_ newRoute -> do |
| 211 | + setRoute newRoute |
| 212 | + pure (routerProvider (Just { nav, route }) children) |
| 213 | + |
| 214 | +mkLink :: Component { to :: String, children :: Array JSX } |
| 215 | +mkLink = do |
| 216 | + routerContext <- Reader.ask |
| 217 | + component "Link" \{ to, children } -> React.do |
| 218 | + { nav } <- useRouterContext routerContext |
| 219 | + pure do |
| 220 | + R.a |
| 221 | + { href: to |
| 222 | + , onClick: |
| 223 | + Events.handler |
| 224 | + DOM.Events.preventDefault \_ -> do |
| 225 | + nav.pushState (Foreign.unsafeToForeign unit) to |
| 226 | + , children |
| 227 | + } |
0 commit comments