Skip to content

Instantly share code, notes, and snippets.

@jgoux
Forked from sloosch/NestedRoutes.purs
Created August 17, 2016 07:38
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save jgoux/a107e585b02260fa7021c1c4b2db5420 to your computer and use it in GitHub Desktop.
nested routes
module Main where
import HeroPrelude
import Component as C
import Counter as Counter
import Data.String as String
import Pux as Pux
import Pux.Html as H
import Pux.Router as PuxRouter
import TypeHere as TypeHere
import Control.Monad.Eff (Eff)
import Data.Array (catMaybes)
import Data.Generic (class Generic)
type RouteView a s e = Array (C.PuxComponent a s e) -> C.PuxComponent a s e
type MountPoint = String
type Path = String
data Route a s e =
Route Path (RouteView a s e) (Array (Route a s e))
| Mount (MountPoint × Path -> Maybe (C.PuxComponent a s e))
data RouteAction a = UrlChanged PathActionInRoute a
type RouteState s = {currentUrl :: Paths}
type AppState = {currentUrl :: Path, counter :: Counter.State, typeHere :: TypeHere.State}
data AppAction = CounterAction Counter.ActionTypeHereAction TypeHere.Action
derive instance appActionGeneric :: Generic (AppAction)
init :: AppState
init = {
currentUrl : "",
counter : Counter.init,
typeHere : TypeHere.init
}
helloComponent :: a s e. C.PuxComponent a s e
helloComponent = C.Stateless $ H.div [] [H.text "hello"]
otherComponent :: a s e. C.PuxComponent a s e
otherComponent = C.Stateless $ H.div [] [H.text "other component says hello too"]
route :: e. Route AppAction AppState e
route =
Route "bla" (C.wrapManyWith navigationBar) [
Route "blub" nestedStatefulRoute [
Route "here" (const typeHereComp) [],
Route "here" (const otherComponent) []
],
Route "bar/foo" (const helloComponent) [],
Route "something" (C.wrapManyWith $ caption "Here is something") [
Mount $ map implantInApp <<< childRouter
]
]
where
implantInApp :: C.PuxComponent TypeHere.Action TypeHere.State e -> C.PuxComponent AppAction AppState e
implantInApp = C.gAdaptAction TypeHereAction <<< C.adaptState _{typeHere=_} _.typeHere
childRouter :: MountPoint × Path -> Maybe (C.PuxComponent TypeHere.Action TypeHere.State e)
childRouter p@(mountPoint × base) = runRoute childRoute p
where
childRoute :: Route TypeHere.Action TypeHere.State e
childRoute =
Route "child" (C.wrapManyWith childNavigationBar) [
Route "typehere" (const $ TypeHere.component) [],
Route "a" (C.wrapManyWith $ H.span []) [
Route "b" (const $ C.Stateless $ H.div [] [H.text "B!"]) []
],
Route "inception" (C.wrapManyWith $ caption "going deeper") [
Mount \mp -> childRouter mp
]
]
childNavigationBar children =
H.div [] $ [
PuxRouter.link (mountPoint <> "/child/typehere") [] [H.text " typehere "],
PuxRouter.link (mountPoint <> "/child/a/b") [] [H.text " a-b "],
PuxRouter.link (mountPoint <> "/child/inception/child") [] [H.text " inception "]
] <> children
caption :: a. String -> Array (H.Html a) -> H.Html a
caption str children =
H.div [] $ [
H.h4 [] [H.text str]
] <> children
navigationBar :: a. Array (H.Html a) -> H.Html a
navigationBar children =
H.div [] $ [
H.div [] [
PuxRouter.link "/bla/blub" [] [H.text " blub "],
PuxRouter.link "/bla/something/child" [] [H.text " blub-childroute "],
PuxRouter.link "/bla/blub/here" [] [H.text " blub-here "],
PuxRouter.link "/bla/bar/foo" [] [H.text " bar-foo "]
]
] <> children
nestedStatefulRoute :: RouteView AppAction AppState e
nestedStatefulRoute childComps = C.Effectful update' view'
where
counterComp = Counter.component #
C.gAdaptAction CounterAction <<< C.adaptState _{counter=_} _.counter
update' = C.updateMany $ [counterComp] <> childComps
view' s = H.div [] [
H.h4 [] [H.text "something bla"],
C.view counterComp s,
H.div [] $ [
H.h4 [] case childComps of
[] -> [H.text "Here is nothing"]
_ -> [H.text "Below is something"]
] <> (C.views s <$> childComps)
]
typeHereComp :: C.PuxComponent AppAction AppState e
typeHereComp = TypeHere.component #
C.gAdaptAction TypeHereAction <<< C.adaptState _{typeHere=_} _.typeHere
runRoute :: a s e. Route a s e -> MountPoint × Path -> Maybe (C.PuxComponent a s e)
runRoute (Route url view' children) (mountpoint × base) = do
--TODO parse url etc using PuxRouter.Match instead of strings...
let currentPath = "/" <> url
remainingPath <- String.stripPrefix currentPath base
let newMountPoint = mountpoint <> currentPath
let childComp = catMaybes $ flip runRoute (newMountPoint × remainingPath) <$> children
Just $ view' childComp
runRoute (Mount mount) mb = mount mb
rootRouter :: a s e. Route a (RouteState s) e -> C.PuxComponent (RouteAction a) (RouteState s) e
rootRouter r = C.Effectful update' view'
where
update' (UrlChanged u) s =
Pux.noEffects $ s{currentUrl = u}
update' (ActionInRoute a) s =
case runRoute r ("" × s.currentUrl) of
Just comp -> Pux.mapEffects ActionInRoute $ C.update comp a s
_ -> Pux.noEffects s
view' s =
case runRoute r ("" × s.currentUrl) of
Just comp -> ActionInRoute <$> C.view comp s
_ -> H.h4 [] [H.text $ s.currentUrl <> " not found!"]
main :: Eff _ Unit
main = do
url <- PuxRouter.sampleUrl
let rootComp = rootRouter route
app <- Pux.start {
initialState : init,
update: C.update rootComp,
view : C.view rootComp,
inputs: [UrlChanged <$> url]
}
PuxRouter.navigateTo "bla/blub"
Pux.renderToDOM "#app" app.html
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment