Server-side rendering of category-detail (#193)

front-ps/bower.json

@@ -13,7 +13,8 @@
     "purescript-node-process": "^5.0.0",
     "purescript-pux": "^11.0.0",
     "purescript-aff": "^3.1.0",
-    "purescript-affjax": "^4.0.0"
+    "purescript-affjax": "^4.0.0",
+    "purescript-argonaut-generic-codecs": "^6.0.4"
   },
   "devDependencies": {
     "purescript-psci-support": "^3.0.0"

front-ps/client/Guide/Client/CategoryDetail.purs

@@ -1,14 +1,16 @@
 module Guide.Client.CategoryDetail where
 
 import Prelude
+
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE, log)
+import DOM (DOM)
+import DOM.HTML (window)
+import DOM.HTML.Types (HISTORY)
 import Guide.CategoryDetail.Events (AppEffects, Event(..), foldp)
 import Guide.CategoryDetail.Routes (match)
 import Guide.CategoryDetail.State (State, init)
 import Guide.CategoryDetail.View.Layout (view)
-import Control.Monad.Eff (Eff)
-import DOM (DOM)
-import DOM.HTML (window)
-import DOM.HTML.Types (HISTORY)
 import Pux (CoreEffects, App, start)
 import Pux.DOM.Events (DOMEvent)
 import Pux.DOM.History (sampleURL)
@@ -17,27 +19,19 @@ import Signal ((~>))
 
 type WebApp = App (DOMEvent -> Event) Event State
 
-type ClientEffects = CoreEffects (AppEffects (history :: HISTORY, dom :: DOM))
+type ClientEffects = CoreEffects (AppEffects (history :: HISTORY, dom :: DOM, console :: CONSOLE))
 
 main :: String -> State -> Eff ClientEffects WebApp
 main url state = do
-  -- | Create a signal of URL changes.
   urlSignal <- sampleURL =<< window
-
-  -- | Map a signal of URL changes to PageView actions.
   let routeSignal = urlSignal ~> \r -> PageView (match r)
-
-  -- | Start the app.
-  app <- start
-    { initialState: state
+  app <- start  { initialState: state
                 , view
                 , foldp
-    , inputs: [routeSignal] }
-
-  -- | Render to the DOM
+                , inputs: [routeSignal]
+                }
   renderToDOM "#guide" app.markup app.input
-
-  -- | Return Guide.Client.CategoryDetail.to be used for hot reloading logic in support/client.entry.js
+  log "Heeeelloooo, here is category-detail page rendered on client-side"
   pure app
 
 initialState :: State

front-ps/common/Guide/CategoryDetail/Routes.purs

@@ -1,11 +1,22 @@
 module Guide.CategoryDetail.Routes where
 
+import Data.Eq (class Eq)
 import Data.Function (($))
 import Data.Functor ((<$))
+import Data.Generic (class Generic, gEq, gShow)
 import Data.Maybe (fromMaybe)
+import Data.Show (class Show)
 import Pux.Router (end, router)
 
-data Route = Home | NotFound String
+data Route
+  = Home
+  | NotFound String
+
+derive instance genericRoute :: Generic Route
+instance showRoute :: Show Route where
+    show = gShow
+instance eqRoute :: Eq Route where
+    eq = gEq
 
 match :: String -> Route
 match url = fromMaybe (NotFound url) $ router url $

front-ps/common/Guide/CategoryDetail/State.purs

@@ -1,7 +1,9 @@
 module Guide.CategoryDetail.State where
 
-import Guide.CategoryDetail.Routes (Route, match)
+import Data.Generic (class Generic, gShow)
 import Data.Newtype (class Newtype)
+import Data.Show (class Show)
+import Guide.CategoryDetail.Routes (Route, match)
 
 newtype State = State
   { title :: String
@@ -9,11 +11,14 @@ newtype State = State
   , loaded :: Boolean
   }
 
+derive instance gState :: Generic State
 derive instance newtypeState :: Newtype State _
+instance showState :: Show State where
+  show = gShow
 
 init :: String -> State
 init url = State
-  { title: "hello"
+  { title: "CategoryDetail page" -- TODO (sectore): Change title
   , route: match url
   , loaded: false
   }

front-ps/server/Guide/Server/HTMLWrapper.purs

@@ -0,0 +1,37 @@
+module Guide.Server.HTMLWrapper where
+
+import Prelude
+
+import Pux.DOM.HTML (HTML) as P
+import Pux.DOM.HTML.Attributes (key) as P
+import Pux.Renderer.React (dangerouslySetInnerHTML) as P
+
+import Text.Smolder.HTML (body, div, head, html, link, meta, script, title, br) as S
+import Text.Smolder.HTML.Attributes (charset, content, href, id, name, rel, src, type') as S
+import Text.Smolder.Markup (text) as S
+import Text.Smolder.Markup ((!))
+
+htmlWrapper :: forall eff . String -> String -> String -> P.HTML eff
+htmlWrapper app_html state_json js_name =
+  S.html do
+    S.head do
+      S.meta ! S.charset "UTF-8"
+      S.meta ! S.name "viewport" ! S.content "width=device-width, initial-scale=1"
+      S.title $ S.text "Aelve-Guide" -- TODO (sectore): Provide title
+      S.link ! S.rel "icon" ! S.type' "image/x-icon" ! S.href "/favicon.ico"
+    S.body do
+      S.div
+        ! P.key "guide"
+        ! S.id "guide"
+        ! P.dangerouslySetInnerHTML app_html
+        $ S.br
+      S.script
+        ! P.key "initial_state"
+        ! S.type' "text/javascript"
+        ! P.dangerouslySetInnerHTML state_json
+        $ S.br
+      S.script
+        ! P.key "js_bundle"
+        ! S.type' "text/javascript"
+        ! S.src ("/" <> js_name <> ".js")
+        $ S.br

front-ps/server/Guide/Server/Handler.purs

@@ -2,15 +2,27 @@ module Guide.Server.Handler where
 
 import Prelude
 
+import Control.Monad.Aff.Class (liftAff)
+import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Exception (Error, message)
+import Data.Argonaut.Generic.Aeson (options)
+import Data.Argonaut.Generic.Encode (genericEncodeJson)
 import Data.Maybe (fromMaybe)
+import Guide.CategoryDetail.Events (AppEffects, Event(..), foldp) as CD
+import Guide.CategoryDetail.Routes (Route(..), match) as CD
+import Guide.CategoryDetail.State (State(..), init) as CD
+import Guide.CategoryDetail.View.Layout (view) as CD
 import Guide.Server.Common (renderPage)
 import Guide.Server.Constants (defaultCategoryName)
+import Guide.Server.HTMLWrapper (htmlWrapper)
 import Guide.Server.Types (PageConfig(..))
-import Node.Express.Handler (HandlerM)
-import Node.Express.Request (getRouteParam)
-import Node.Express.Response (redirect, sendJson, setStatus)
+import Node.Express.Handler (HandlerM, Handler)
+import Node.Express.Request (getOriginalUrl, getRouteParam)
+import Node.Express.Response (redirect, send, sendJson, setStatus)
 import Node.Express.Types (EXPRESS)
+import Pux (CoreEffects, start, waitState)
+import Pux.Renderer.React (renderToStaticMarkup, renderToString)
+import Signal (constant)
 
 indexHandler :: forall e. HandlerM (express :: EXPRESS | e ) Unit
 indexHandler =
@@ -21,16 +33,35 @@ errorHandler err = do
   setStatus 500
   sendJson {error: message err}
 
-categoryDetailHandler :: forall e. HandlerM (express :: EXPRESS | e) Unit
+categoryDetailHandler :: forall e. Handler (CoreEffects (CD.AppEffects e))
 categoryDetailHandler = do
-  catName <- fromMaybe defaultCategoryName <$> getRouteParam "name"
-  catDetailId <- fromMaybe "0" <$> getRouteParam "id"
-  renderPage $ PageConfig { contentId: "category-detail"
-                          , title: "Aelve - Guide: Category Detail" <> catDetailId
-                          , catName
-                          , catDetailId
+  let getState (CD.State st) = st
+
+  url <- getOriginalUrl
+
+  app <- liftEff $ start
+   { initialState: CD.init url
+   , view: CD.view
+   , foldp: CD.foldp
+   , inputs: [constant (CD.PageView (CD.match url))]
    }
 
+  state <- liftAff $ waitState (\(CD.State st) -> st.loaded) app
+
+  case (getState state).route of
+    (CD.NotFound _) -> setStatus 404
+    _ -> setStatus 200
+
+  html <- liftEff do
+    let state_json = "window.__puxInitialState = "
+                     <> (show $ genericEncodeJson options state)
+                     <> ";"
+
+    app_html <- renderToString app.markup
+    renderToStaticMarkup $ constant (htmlWrapper app_html state_json "category-detail")
+
+  send html
+
 
 categoryOverviewHandler :: forall e. HandlerM (express :: EXPRESS | e) Unit
 categoryOverviewHandler = do

front-ps/server/Main.purs

@@ -7,6 +7,7 @@ import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Console (CONSOLE, log)
 import Data.Int (fromString)
 import Data.Maybe (fromMaybe)
+import Guide.CategoryDetail.Events (AppEffects)
 import Guide.Server.Handler (categoryDetailHandler, categoryOverviewHandler, indexHandler, errorHandler)
 import Node.Express.App (App, get, listenHttp, setProp, use, useOnError)
 import Node.Express.Handler (Handler, next)
@@ -15,6 +16,7 @@ import Node.Express.Request (getOriginalUrl)
 import Node.Express.Types (EXPRESS)
 import Node.HTTP (Server)
 import Node.Process (PROCESS, lookupEnv)
+import Pux (CoreEffects)
 
 logger :: forall e. Handler (console :: CONSOLE | e)
 logger = do
@@ -22,7 +24,7 @@ logger = do
   liftEff $ log ("url: " <> url)
   next
 
-appSetup :: forall e. App (console :: CONSOLE | e)
+appSetup :: forall e. App (CoreEffects (AppEffects (console :: CONSOLE | e)))
 appSetup = do
   liftEff $ log "app setup"
 
@@ -38,7 +40,7 @@ appSetup = do
 
   useOnError errorHandler
 
-main :: forall e. Eff (express :: EXPRESS, process :: PROCESS, console :: CONSOLE | e) Server
+main :: forall e. Eff (CoreEffects (AppEffects (express :: EXPRESS, process :: PROCESS, console :: CONSOLE | e))) Server
 main = do
   port <- (fromMaybe defaultPort <<< fromString <<< fromMaybe (show defaultPort)) <$> lookupEnv "PORT"
   listenHttp appSetup port (callback port)

front-ps/server/entry.js

@@ -0,0 +1,6 @@
+// shared js
+import '../common/shared.js';
+
+// server app
+import Main from './Main.purs';
+Main.main();