SPA routing and token acquistition with purescript-react, purescript-routing, and purescript-rx-state

Main.purs

module Main where

import Prelude
import Control.Monad.Eff.Console (log, CONSOLE)
import Control.Monad.Eff
import Control.Monad.Eff.Class
import Control.Monad.Aff
import Control.Monad.Eff.Exception

import Data.Maybe
import Data.Tuple
import Data.Foldable (class Foldable, foldl, traverse_)
import Data.Maybe.Unsafe (fromJust)
import Data.Nullable (toMaybe)

import DOM (DOM())
import DOM.HTML (window)
import DOM.HTML.Types (htmlDocumentToDocument)
import DOM.HTML.Window (document)

import DOM.Node.NonElementParentNode (getElementById)
import DOM.Node.Types (Element(), ElementId(..), documentToNonElementParentNode)

import Control.Alt ((<|>))
import Control.Apply
import Data.Functor

import React
import ReactDOM as RD
import React.DOM as D
import React.DOM.Props as P

import Routing
import Routing.Match
import Routing.Match.Class
import Routing.Hash

import Network.HTTP.Affjax (AJAX)

import Data.RxState as Rx

type State =
  { currPage :: Route
  , token    :: Maybe String
  }

initialState :: State
initialState = { currPage: Home
               , token: Nothing
               }

data Route
  = Home
  | About


instance showRoute :: Show Route where
  show Home  = "/"
  show About = "/about"


instance showAction :: Show Action where
  show NoOp        = "NoOp"
  show (SetPage r) = "Setpage " ++ (show r)
  show (SetToken mStr) = "SetToken" ++ (show mStr)

data Action
  = NoOp
  | SetPage Route
  | SetToken (Maybe String)

data Effect
  = NoFx
  | GoTo Route

actionsChannel :: Rx.Channel (Array Action)
actionsChannel = Rx.newChannel []

effectsChannel :: Rx.Channel (Array Effect)
effectsChannel = Rx.newChannel []

update :: State -> Action -> State
update state action =
  case action of
    NoOp           -> state
    SetPage page   -> state { currPage = page }
    SetToken tkn   -> state { token = tkn }

performEffect :: forall eff. Effect -> Eff (console :: CONSOLE, dom :: DOM | eff) Unit
performEffect effect =
  case effect of
    NoFx       -> return unit
    GoTo Home  -> setHash (show Home)
    GoTo About -> do
      log "Doing some async stuff before routing"
      setHash (show About)

routingContainer :: ReactClass State
routingContainer = createClass $ spec unit $ \ctx -> do
  state <- getProps ctx
  case state.currPage of
    Home    -> displayPage home state
    About   -> displayPage about state
  where
    displayPage page state =
      return $ D.div [] [(createElement page state [])]

home :: ReactClass State
home = createClass $ spec unit $ \ctx -> do
  state <- getProps ctx
  return $
    D.div [] [ D.text "This is the Home Page"
             , D.div' [
                        D.a [ P.onClick $ \_ -> Rx.send [ GoTo About ] effectsChannel ]
                            [ D.text "About"   ]
                      ]
              ]

about :: ReactClass State
about = createClass $ spec unit $ \ctx -> do
  state <- getProps ctx
  return $
    D.div [] [ D.text "This is the About Page"
             , D.div' [
                        D.a [ P.onClick $ \_ -> Rx.send [ GoTo Home ] effectsChannel ]
                            [ D.text "Home" ]
                      ]
             ]

routing :: Match Route
routing = about <|> home
  where
    route str = lit "" *> lit str
    home    = Home <$ lit ""
    about   = About <$ (route "about")


type MainEffects eff = (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff )

main :: forall eff. Eff (MainEffects eff) Unit
main = do

  Rx.send [ SetToken (Just "Hurray!") ] actionsChannel -- In a real app, we'd tap into local storage

  Rx.startApp update performEffect myRender actionsChannel effectsChannel initialState

  Rx.subscribe actionsChannel (\action -> log (show action)) -- FOR DEBUGGING

  matches routing (\old new -> Rx.send [ SetPage new ] actionsChannel )

  where
    view :: State -> ReactElement
    view appState = D.div' [ createFactory routingContainer appState ]

    myRender state = do
      container <- elm'
      RD.render (view state) container

    elm' :: forall eff. Eff (dom :: DOM | eff) Element
    elm' = do
      win <- window
      doc <- document win
      elm <- getElementById (ElementId "app") (documentToNonElementParentNode (htmlDocumentToDocument doc))
      return $ fromJust (toMaybe elm)