diff options
Diffstat (limited to 'Biz/Devalloc/Host.hs')
-rw-r--r-- | Biz/Devalloc/Host.hs | 37 |
1 files changed, 26 insertions, 11 deletions
diff --git a/Biz/Devalloc/Host.hs b/Biz/Devalloc/Host.hs index 5a9ff80..c6c6724 100644 --- a/Biz/Devalloc/Host.hs +++ b/Biz/Devalloc/Host.hs @@ -28,17 +28,19 @@ import Alpha import Biz.App (CSS (..), HtmlApp (..)) -- import qualified CMark as Cmark -import qualified Biz.Devalloc.Page.Home as Home -import qualified Biz.Devalloc.Page.Signup as Signup import qualified Biz.Look +import qualified Biz.Devalloc.Core as Core +import qualified Biz.Devalloc.Path as Path import qualified Clay import qualified Control.Exception as Exception +import qualified Data.Text as Text import qualified Lucid import qualified Lucid.Base as Lucid import Miso hiding (node) import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp import Network.Wai.Middleware.RequestLogger (logStdout) +import Network.Wai.Application.Static (defaultWebAppSettings) import Servant import qualified System.Envy as Envy @@ -52,17 +54,17 @@ main = Exception.bracket startup shutdown run putText "@" putText "devalloc" putText <| "port: " <> (show <| port cfg) - return (cfg, serve (Proxy @AllRoutes) <| serverHandlers) + putText <| "node: " <> (Text.pack <| node cfg) + let static = serveDirectoryWith <| defaultWebAppSettings <| node cfg + return (cfg, serve (Proxy @AllPaths) <| serverHandlers static) shutdown :: (Config, Application) -> IO () shutdown _ = pure () run :: (Config, Wai.Application) -> IO () run (cfg, app) = Warp.run (port cfg) (logStdout app) -type HomeServer = ToServerRoutes Home.Path HtmlApp Home.Move +type HostPaths = ToServerRoutes Path.Paths HtmlApp Core.Move -type SignupServer = ToServerRoutes Signup.Path HtmlApp Signup.Move - -type AllRoutes = HomeServer :<|> SignupServer :<|> CssRoute +type AllPaths = ("static" :> Raw) :<|> HostPaths :<|> CssRoute type CssRoute = "css" :> "main.css" :> Get '[CSS] Text @@ -76,7 +78,6 @@ instance Lucid.ToHtml a => Lucid.ToHtml (HtmlApp a) where Lucid.head_ <| do Lucid.meta_ [Lucid.charset_ "utf-8"] jsRef "/static/all.js" - jsRef "//unpkg.com/turbolinks@5.2.0/dist/turbolinks.js" cssRef "/css/main.css" Lucid.body_ (Lucid.toHtml x) where @@ -108,13 +109,27 @@ instance Envy.DefConfig Config where Config { port = 3000, pitches = "./Biz/Devalloc/pitch.md", - node = "_/bild/dev/Devalloc.Node/static" + node = "_/bild/dev/static/devalloc.js" } instance Envy.FromEnv Config -serverHandlers :: Server AllRoutes -serverHandlers = Home.host :<|> Signup.host :<|> cssHandlers +home :: Handler (HtmlApp (View Core.Move)) +home = + Core.Form {Core.uri = Path.home} + |> Core.view + |> HtmlApp + |> pure + +signup :: Handler (HtmlApp (View Core.Move)) +signup = + Core.Form {Core.uri = Path.signup} + |> Core.view + |> HtmlApp + |> pure + +serverHandlers :: Tagged Handler Application -> Server AllPaths +serverHandlers static = static :<|> (home :<|> signup) :<|> cssHandlers look :: Clay.Css look = do |