WIP

assets/js/app.js

@@ -1,3 +1,6 @@
+import './custom.js';
+import 'htmx-ext-sse';
+
 import Alpine from "alpinejs";
 window.Alpine = Alpine;
 Alpine.start();

assets/js/custom.js

@@ -0,0 +1 @@
+window.htmx = require('htmx.org');

assets/package.json

@@ -16,6 +16,7 @@
     "esbuild-sass-plugin": "^3.3.1",
     "esbuild-style-plugin": "^1.6.0",
     "htmx-ext-sse": "^2.2.2",
+    "htmx.org": "^2.0.2",
     "livereload-js": "^4.0.2",
     "postcss": "^8.4.31",
     "postcss-cli": "^9.0.2",

assets/yarn.lock

@@ -5345,6 +5345,11 @@ htmx-ext-sse@^2.2.2:
   resolved "https://registry.yarnpkg.com/htmx-ext-sse/-/htmx-ext-sse-2.2.2.tgz#f310696d11944b0f9f28e2ab186f5cd78bd310d9"
   integrity sha512-MTnKkBzA2t4sI8gOXrRiPaceTlkUbrw3+3qOy1BfuBNIPBalsJiT4qxUGd6W48ggOkfe2akOnB8uxICJKw+Dsg==
 
+htmx.org@^2.0.2:
+  version "2.0.2"
+  resolved "https://registry.yarnpkg.com/htmx.org/-/htmx.org-2.0.2.tgz#62852952dcce8f61253caf476f3cc5c1192a5afd"
+  integrity sha512-eUPIpQaWKKstX393XNCRCMJTrqPzikh36Y9RceqsUZLTtlFjFaVDgwZLUsrFk8J2uzZxkkfiy0TE359j2eN6hA==
+
 http-cache-semantics@^4.1.1:
   version "4.1.1"
   resolved "https://registry.yarnpkg.com/http-cache-semantics/-/http-cache-semantics-4.1.1.tgz#abe02fcb2985460bf0323be664436ec3476a6d5a"

src/web/FloraWeb/Components/Header.hs

@@ -69,7 +69,7 @@ header = do
         meta_ [name_ "twitter:dnt", content_ "on"]
 
       body_ [] $ do
-        div_ [hxExt_ "sse", hxSseConnect_ "/liveload", hxSseSwap_ "reload-page"] ""
+        div_ [hxExt_ "sse", hxSseConnect_ "/livereload", hxSseSwap_ "reload-page"] ""
         navbar
 
 jsLink :: FloraHTML

src/web/FloraWeb/Components/Utils.hs

@@ -34,8 +34,8 @@ defaultLinkOptions =
     }
 
 -- Standard WAI-ARIA attributes for accessibility purpose
-ariaLabel_ :: Text -> Attribute
-ariaLabel_ = makeAttribute "aria-label"
+ariaLabel_ :: Text -> Attributes
+ariaLabel_ = makeAttributes "aria-label"
 
 -- Prefer these ones as they are integrated with AlpineJS
 ariaControls_ :: Text -> Attributes

src/web/FloraWeb/LiveReload.hs

@@ -1,7 +1,7 @@
 module FloraWeb.LiveReload (livereloadHandler) where
 
 import Effectful
-import Effectful.Concurrent.MVar.Strict
+import Effectful.Concurrent.STM
 import Servant.API.EventStream
 import Servant.Types.SourceT (SourceT, source)
 
@@ -10,16 +10,15 @@ import Flora.Environment (DeploymentEnv (..))
 livereloadHandler
   :: (Concurrent :> es, IOE :> es)
   => DeploymentEnv
-  -> MVar Bool
+  -> TVar Bool
   -> Eff es (SourceT IO ServerEvent)
-livereloadHandler deploymentEnv mvar =
+livereloadHandler deploymentEnv tvar =
   case deploymentEnv of
     Development -> do
-      needsReload <- readMVar mvar
+      needsReload <- readTVarIO tvar
       liftIO $ print needsReload
       if needsReload
         then do
-          putMVar mvar False 
           pure $
             source
               [ ServerEvent

src/web/FloraWeb/Server.hs

@@ -12,7 +12,6 @@ import Data.Text.Display (display)
 import Effectful
 import Effectful.Concurrent
 import Effectful.Dispatch.Static
-import Effectful.Concurrent.MVar.Strict
 import Effectful.Error.Static (runErrorNoCallStack, runErrorWith)
 import Effectful.Fail (runFailIO)
 import Effectful.PostgreSQL.Transact.Effect (runDB)
@@ -55,6 +54,7 @@ import Servant
 import Servant.OpenApi
 import Servant.Server.Generic (AsServerT)
 
+import Effectful.Concurrent.STM
 import Flora.Environment
   ( BlobStoreImpl (..)
   , DeploymentEnv
@@ -133,7 +133,7 @@ logException env logger exception =
 
 runServer :: (Concurrent :> es, IOE :> es) => Logger -> FloraEnv -> Eff es ()
 runServer appLogger floraEnv = do
-  reloadMVar <- newMVar True
+  livereloadTVar <- newTVarIO True
   httpManager <- liftIO $ HTTP.newManager tlsManagerSettings
   zipkin <- liftIO $ Tracing.newZipkin floraEnv.mltp.zipkinHost "flora-server"
   let runnerEnv = JobsRunnerEnv httpManager
@@ -154,7 +154,7 @@ runServer appLogger floraEnv = do
   oddJobsEnv <- OddJobs.mkEnv oddjobsUiCfg ("/admin/odd-jobs/" <>)
   let webEnv = WebEnv floraEnv
   webEnvStore <- liftIO $ newWebEnvStore webEnv
-  let server = mkServer appLogger webEnvStore floraEnv oddjobsUiCfg oddJobsEnv zipkin reloadMVar
+  let server = mkServer appLogger webEnvStore floraEnv oddjobsUiCfg oddJobsEnv zipkin livereloadTVar
   let warpSettings =
         setPort (fromIntegral floraEnv.httpPort) $
           setOnException
@@ -178,30 +178,30 @@ mkServer
   -> OddJobs.UIConfig
   -> OddJobs.Env
   -> Zipkin
-  -> MVar Bool
+  -> TVar Bool
   -> Application
-mkServer logger webEnvStore floraEnv cfg jobsRunnerEnv zipkin reloadMVar =
+mkServer logger webEnvStore floraEnv cfg jobsRunnerEnv zipkin livereloadTVar =
   serveWithContextT
     (Proxy @ServerRoutes)
     (genAuthServerContext logger floraEnv)
     (naturalTransform floraEnv logger webEnvStore zipkin)
-    (floraServer cfg jobsRunnerEnv floraEnv.environment reloadMVar)
+    (floraServer cfg jobsRunnerEnv floraEnv.environment livereloadTVar)
 
 floraServer
   :: OddJobs.UIConfig
   -> OddJobs.Env
   -> DeploymentEnv
-  -> MVar Bool
+  -> TVar Bool
   -> Routes (AsServerT FloraEff)
-floraServer cfg jobsRunnerEnv deploymentEnvironment reloadMVar =
+floraServer cfg jobsRunnerEnv deploymentEnvironment livereloadTVar =
   Routes
     { assets = serveDirectoryWebApp "./static"
     , openSearch = openSearchHandler
     , pages = \_ -> Pages.server cfg jobsRunnerEnv
     , api = API.apiServer
     , openApi = pure openApiHandler
     , docs = serveDirectoryWith docsBundler
-    , livereload = LiveReload.livereloadHandler deploymentEnvironment reloadMVar 
+    , livereload = LiveReload.livereloadHandler deploymentEnvironment livereloadTVar
     }
 
 naturalTransform :: FloraEnv -> Logger -> WebEnvStore -> Zipkin -> FloraEff a -> Handler a

src/web/FloraWeb/Types.hs

@@ -29,9 +29,9 @@ import GHC.Generics
 import Servant (FromHttpApiData (..), Handler, ServerError)
 import Web.Cookie
 
+import Effectful.Concurrent (Concurrent)
 import Flora.Environment
 import Flora.Model.BlobStore.API
-import Effectful.Concurrent (Concurrent)
 
 newtype WebEnvStore = WebEnvStore (MVar WebEnv)