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:
towards-a-new-leftypol 2024-03-25 19:05:34 -04:00
parent f32c25faa2
commit 16a84035da
3 changed files with 60 additions and 22 deletions

View File

@ -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

View File

@ -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

View File

@ -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"
}