diff --git a/app/JSONSettings.hs b/app/JSONSettings.hs index c0f6966..33f5de3 100644 --- a/app/JSONSettings.hs +++ b/app/JSONSettings.hs @@ -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 diff --git a/app/Main.hs b/app/Main.hs index 53e4296..58d70ba 100644 --- a/app/Main.hs +++ b/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 diff --git a/settings.json b/settings.json index b2c747d..6525618 100644 --- a/settings.json +++ b/settings.json @@ -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" }