Finish Devalloc miso app prototype

After hours of trying to get a page abstraction working in a Miso app (both
Devalloc and Hero) I had a revelation: Miso is an SPA - *single* page
application - framework, and so trying to put multiple pages into it is
fundamentally at odds with the rest of the architecture.

Of course this is also a problem with Elm's pattern of nesting models in order
to create a page abstraction. They can pull it off because they don't also try
to do isomorphic rendering.

In hindsight this should be obvious... if I actually do want some kind of
page-like abstraction or separation, then I need a much more complex server that
can embed different Miso apps based on some logic. But this is more like
multi-tenancy, or something.

Also I'm starting to think that I don't want Devalloc to be an SPA anyway, so
I'll try an experimental branch where I rip it out and just use Servant, Lucid,
and Turbolinks.

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