Render out the rest of the html page based on settings
- isomorphism seems to not work correctly, the front-end loads and then simply appends what it renders to the page, duplicating the content. my expectation was that it would replace the content. - there is an initial action on the front-end that is redundant: we don't need to use xhr to fetch the catalog if we already have that from the server. Perhaps this is causing the isomorphism issue?
This commit is contained in:
parent
f32c25faa2
commit
16a84035da
|
@ -8,6 +8,8 @@ data JSONSettings = JSONSettings
|
|||
, jwt :: String
|
||||
, postgrest_fetch_count :: Int
|
||||
, media_root :: String
|
||||
, static_serve_path :: String
|
||||
, static_serve_url_root :: String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
instance FromJSON JSONSettings
|
||||
|
|
71
app/Main.hs
71
app/Main.hs
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
|
@ -13,9 +14,17 @@ import qualified Network.Wai as Wai
|
|||
import qualified Network.Wai.Handler.Warp as Wai
|
||||
import qualified Network.Wai.Middleware.RequestLogger as Wai
|
||||
import Servant.API
|
||||
import Servant.Server (Server, Handler (..), serve, err500, ServerError (..))
|
||||
import qualified Servant
|
||||
import Servant.Server
|
||||
( Server
|
||||
, Handler (..)
|
||||
, serve
|
||||
, err500
|
||||
, err404
|
||||
, ServerError (..)
|
||||
)
|
||||
import qualified Lucid as L
|
||||
-- import qualified Lucid.Base as L
|
||||
import qualified Lucid.Base as L
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.ByteString.Lazy.UTF8 (fromString)
|
||||
import System.Console.CmdArgs (cmdArgs, Data, Typeable)
|
||||
|
@ -37,27 +46,44 @@ import Common.Network.CatalogPostType (CatalogPost)
|
|||
import qualified Common.Component.CatalogGrid as Grid
|
||||
import qualified Common.Component.TimeControl as TC
|
||||
|
||||
newtype HtmlPage a = HtmlPage (FE.Model, a)
|
||||
newtype HtmlPage a = HtmlPage (JSONSettings, a)
|
||||
|
||||
instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where
|
||||
toHtmlRaw = L.toHtml
|
||||
toHtml (HtmlPage (_, x)) = L.toHtml x
|
||||
-- toHtml (HtmlPage x) = do
|
||||
-- L.doctype_
|
||||
-- L.head_ $ do
|
||||
-- L.title_ "Chandlr"
|
||||
-- L.meta_ [L.charset_ "utf-8"]
|
||||
toHtml (HtmlPage (settings, x)) = do
|
||||
L.doctype_
|
||||
L.head_ $ do
|
||||
L.meta_ [L.charset_ "utf-8"]
|
||||
L.meta_ [L.name_ "viewport", L.content_ "width=device-width, initial-scale=1.0"]
|
||||
L.meta_ [L.name_ "postgrest-root", L.content_ (pack $ postgrest_url settings)]
|
||||
L.meta_ [L.name_ "postgrest-fetch-count", L.content_ (pack $ show $ postgrest_fetch_count settings)]
|
||||
L.meta_ [L.name_ "media-root", L.content_ (pack $ media_root settings)]
|
||||
|
||||
-- L.with (L.script_ mempty)
|
||||
-- [ L.makeAttribute "src" "/static/all.js"
|
||||
-- , L.makeAttribute "async" mempty
|
||||
-- , L.makeAttribute "defer" mempty
|
||||
-- ]
|
||||
L.title_ "Chandlr"
|
||||
|
||||
-- L.body_ (L.toHtml x)
|
||||
L.link_ [L.rel_ "stylesheet", L.href_ $ static_root <> "/static/style.css"]
|
||||
L.script_ [L.src_ $ static_root <> "/dist/build/chandlr/chandlr.jsexe/rts.js", L.makeAttribute "language" "javascript"] ("" :: B.ByteString)
|
||||
L.script_ [L.src_ $ static_root <> "/dist/build/chandlr/chandlr.jsexe/lib.js", L.makeAttribute "language" "javascript"] ("" :: B.ByteString)
|
||||
L.script_ [L.src_ $ static_root <> "/dist/build/chandlr/chandlr.jsexe/out.js", L.makeAttribute "language" "javascript"] ("" :: B.ByteString)
|
||||
|
||||
L.body_ (L.toHtml x)
|
||||
|
||||
L.script_
|
||||
[ L.src_ $ static_root <> "/dist/build/chandlr/chandlr.jsexe/runmain.js"
|
||||
, L.makeAttribute "language" "javascript"
|
||||
, L.makeAttribute "defer" mempty
|
||||
]
|
||||
("" :: B.ByteString)
|
||||
|
||||
where
|
||||
static_root = pack $ static_serve_url_root settings
|
||||
|
||||
type FrontEndRoutes = ToServerRoutes FE.Route HtmlPage FE.Action
|
||||
|
||||
type StaticRoute = "static" :> Servant.Raw
|
||||
|
||||
type API = StaticRoute :<|> FrontEndRoutes
|
||||
|
||||
handlers :: JSONSettings -> Server FrontEndRoutes
|
||||
handlers settings = (catalogView settings) :<|> threadView :<|> searchView
|
||||
|
||||
|
@ -94,7 +120,7 @@ catalogView settings = do
|
|||
|
||||
where
|
||||
render :: UTCTime -> [ CatalogPost ] -> HtmlPage (View FE.Action)
|
||||
render t posts = HtmlPage (model, FE.catalogView model)
|
||||
render t posts = HtmlPage (settings, FE.catalogView model)
|
||||
where
|
||||
model = FE.Model
|
||||
{ FE.grid_model = grid_model
|
||||
|
@ -115,13 +141,20 @@ catalogView settings = do
|
|||
tc_model = TC.Model 0
|
||||
|
||||
threadView :: Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action))
|
||||
threadView = undefined
|
||||
threadView _ _ _ = throwError $ err404 { errBody = "404 - Not Found" }
|
||||
|
||||
searchView :: Maybe Text -> Handler (HtmlPage (View FE.Action))
|
||||
searchView = undefined
|
||||
searchView _ = throwError $ err404 { errBody = "404 - Not Found" }
|
||||
|
||||
app :: JSONSettings -> Wai.Application
|
||||
app settings = serve (Proxy @FrontEndRoutes) (handlers settings)
|
||||
app settings =
|
||||
serve
|
||||
(Proxy @API)
|
||||
(staticHandler :<|> handlers settings)
|
||||
|
||||
where
|
||||
staticHandler :: Server StaticRoute
|
||||
staticHandler = Servant.serveDirectoryFileServer (static_serve_path settings)
|
||||
|
||||
port :: Int
|
||||
port = 8888
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
{ "postgrest_url": "http://localhost:3000",
|
||||
{
|
||||
"postgrest_url": "http://localhost:3000",
|
||||
"jwt": "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoiY2hhbl9hcmNoaXZlciJ9.rGIKZokTDKTuQLIv8138bUby5PELfDipYYIDpJzH02c",
|
||||
"postgrest_fetch_count": 1000,
|
||||
"media_root": "http://10.4.0.1:8888"
|
||||
"postgrest_fetch_count": 10,
|
||||
"media_root": "http://10.4.0.1:8888",
|
||||
"static_serve_path": "/home/phil/Documents/haskell/chandlr-miso",
|
||||
"static_serve_url_root": "/static"
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue