module Main where import Data.Aeson (FromJSON) import Data.ByteString.Lazy qualified as LBS import Data.Text qualified as T import GHC.Generics (Generic) import Hypermedia.Datastar import Lucid import Lucid.Base (makeAttributes) import Network.HTTP.Types (status200, status404) import Network.Wai qualified as WAI import Network.Wai.Handler.Warp qualified as Warp newtype Greeting = Greeting {greeting :: T.Text} deriving (Generic) deriving anyclass (FromJSON) app :: WAI.Request -> (WAI.Response -> IO b) -> IO b app req respond = case (WAI.requestMethod req, WAI.pathInfo req) of ("GET", []) -> respond $ WAI.responseLBS status200 [("Content-Type", "text/html")] testPage ("GET", ["sse", "patch-elements"]) -> respond $ sseResponse nullLogger $ \gen -> sendPatchElements gen (patchElements "
Patched Content
") ("GET", ["sse", "patch-signals"]) -> respond $ sseResponse nullLogger $ \gen -> sendPatchSignals gen (patchSignals "{\"message\":\"Signal Updated\"}") ("GET", ["sse", "execute-script"]) -> respond $ sseResponse nullLogger $ \gen -> sendExecuteScript gen (executeScript "document.getElementById('es-result').textContent = 'Script Executed'") ("GET", ["sse", "read-signals"]) -> respond $ sseResponse nullLogger $ \gen -> do result <- readSignals req case result of Right (signals :: Greeting) -> sendPatchElements gen (patchElements ("
" <> greeting signals <> "
")) Left err -> sendPatchElements gen (patchElements ("
Error: " <> T.pack err <> "
")) ("GET", ["sse", "multiple-events"]) -> respond $ sseResponse nullLogger $ \gen -> do sendPatchElements gen (patchElements "
Event 1
") sendPatchElements gen (patchElements "
Event 2
") sendPatchElements gen (patchElements "
Event 3
") _ -> respond $ WAI.responseLBS status404 [] "Not found" testPage :: LBS.ByteString testPage = renderBS $ doctypehtml_ $ do head_ $ do title_ "datastar-hs e2e tests" script_ [type_ "module", src_ "https://cdn.jsdelivr.net/gh/starfederation/datastar@1.0.0-RC.8/bundles/datastar.js"] ("" :: T.Text) body_ [makeAttributes "data-signals" "{}"] $ do h1_ "datastar-hs E2E Test Page" section_ [id_ "patch-elements-test"] $ do h2_ "Patch Elements" button_ [id_ "pe-trigger", makeAttributes "data-on:click" "@get('/sse/patch-elements')"] "Trigger" div_ [id_ "pe-result"] "Waiting..." section_ [id_ "patch-signals-test", makeAttributes "data-signals:message" "'Waiting...'"] $ do h2_ "Patch Signals" button_ [id_ "ps-trigger", makeAttributes "data-on:click" "@get('/sse/patch-signals')"] "Trigger" div_ [id_ "ps-result", makeAttributes "data-text" "$message"] "Waiting..." section_ [id_ "execute-script-test"] $ do h2_ "Execute Script" button_ [id_ "es-trigger", makeAttributes "data-on:click" "@get('/sse/execute-script')"] "Trigger" div_ [id_ "es-result"] "Waiting..." section_ [id_ "read-signals-test", makeAttributes "data-signals:greeting" "'Hello from Browser'"] $ do h2_ "Read Signals" button_ [id_ "rs-trigger", makeAttributes "data-on:click" "@get('/sse/read-signals')"] "Trigger" div_ [id_ "rs-result"] "Waiting..." section_ [id_ "multiple-events-test"] $ do h2_ "Multiple Events" button_ [id_ "me-trigger", makeAttributes "data-on:click" "@get('/sse/multiple-events')"] "Trigger" div_ [id_ "me-result"] "Waiting..." main :: IO () main = do putStrLn "e2e-server running on http://localhost:3113" Warp.run 3113 app