summaryrefslogtreecommitdiff
path: root/Biz/Devalloc/Host.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Devalloc/Host.hs')
-rw-r--r--Biz/Devalloc/Host.hs37
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