Embed loaded data as json into meta tag for front-end

- front-end can take this and build the initial model, otherwise it
  will just render a blank page
This commit is contained in:
towards-a-new-leftypol 2024-03-27 15:35:06 -04:00
parent 16a84035da
commit 5ca711cb6d
1 changed files with 21 additions and 6 deletions

View File

@ -7,6 +7,7 @@ module Main where
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.Text.Lazy (toStrict)
import Miso (ToServerRoutes, View) import Miso (ToServerRoutes, View)
import Miso.String (toMisoString) import Miso.String (toMisoString)
import Data.Proxy import Data.Proxy
@ -28,7 +29,8 @@ import qualified Lucid.Base as L
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy.UTF8 (fromString) import Data.ByteString.Lazy.UTF8 (fromString)
import System.Console.CmdArgs (cmdArgs, Data, Typeable) import System.Console.CmdArgs (cmdArgs, Data, Typeable)
import Data.Aeson (decode) import Data.Aeson (decode, ToJSON)
import Data.Aeson.Text (encodeToLazyText)
import Data.Time.Clock (getCurrentTime) import Data.Time.Clock (getCurrentTime)
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Data.Time.Clock (UTCTime) import Data.Time.Clock (UTCTime)
@ -46,11 +48,11 @@ import Common.Network.CatalogPostType (CatalogPost)
import qualified Common.Component.CatalogGrid as Grid import qualified Common.Component.CatalogGrid as Grid
import qualified Common.Component.TimeControl as TC import qualified Common.Component.TimeControl as TC
newtype HtmlPage a = HtmlPage (JSONSettings, a) data HtmlPage a = forall b. (ToJSON b) => HtmlPage (JSONSettings, b, a)
instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where
toHtmlRaw = L.toHtml toHtmlRaw = L.toHtml
toHtml (HtmlPage (settings, x)) = do toHtml (HtmlPage (settings, initial_data, x)) = do
L.doctype_ L.doctype_
L.head_ $ do L.head_ $ do
L.meta_ [L.charset_ "utf-8"] L.meta_ [L.charset_ "utf-8"]
@ -58,6 +60,7 @@ instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where
L.meta_ [L.name_ "postgrest-root", L.content_ (pack $ postgrest_url settings)] 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_ "postgrest-fetch-count", L.content_ (pack $ show $ postgrest_fetch_count settings)]
L.meta_ [L.name_ "media-root", L.content_ (pack $ media_root settings)] L.meta_ [L.name_ "media-root", L.content_ (pack $ media_root settings)]
L.meta_ [L.name_ "initial-data", L.content_ (toStrict $ encodeToLazyText initial_data) ]
L.title_ "Chandlr" L.title_ "Chandlr"
@ -79,6 +82,18 @@ instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where
static_root = pack $ static_serve_url_root settings static_root = pack $ static_serve_url_root settings
type FrontEndRoutes = ToServerRoutes FE.Route HtmlPage FE.Action type FrontEndRoutes = ToServerRoutes FE.Route HtmlPage FE.Action
{-
:Created By:
___________ _____ ______
/\________ \ /\ __`\ /\_____\
\/_______//'/' __ _ __\ \ \/\ \\/_____/
//'/' /'__`\/\`'__\ \ \ \ \
//'/'_______ /\ __/\ \ \/ \ \ \_\ \
/\___________\ \____\\ \_\ \ \_____\
\/___________/\/____/ \/_/ \/_____/
-}
type StaticRoute = "static" :> Servant.Raw type StaticRoute = "static" :> Servant.Raw
@ -120,7 +135,7 @@ catalogView settings = do
where where
render :: UTCTime -> [ CatalogPost ] -> HtmlPage (View FE.Action) render :: UTCTime -> [ CatalogPost ] -> HtmlPage (View FE.Action)
render t posts = HtmlPage (settings, FE.catalogView model) render t posts = HtmlPage (settings, posts, FE.catalogView model)
where where
model = FE.Model model = FE.Model
{ FE.grid_model = grid_model { FE.grid_model = grid_model
@ -141,10 +156,10 @@ catalogView settings = do
tc_model = TC.Model 0 tc_model = TC.Model 0
threadView :: Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action)) threadView :: Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action))
threadView _ _ _ = throwError $ err404 { errBody = "404 - Not Found" } threadView _ _ _ = throwError $ err404 { errBody = "404 - Not Implemented" }
searchView :: Maybe Text -> Handler (HtmlPage (View FE.Action)) searchView :: Maybe Text -> Handler (HtmlPage (View FE.Action))
searchView _ = throwError $ err404 { errBody = "404 - Not Found" } searchView _ = throwError $ err404 { errBody = "404 - Not Implemented" }
app :: JSONSettings -> Wai.Application app :: JSONSettings -> Wai.Application
app settings = app settings =