Hello\<\/div\>")
--- @
-sseResponse :: (ServerSentEventGenerator -> IO ()) -> WAI.Response
-sseResponse callback =
+{- | Create a WAI 'WAI.Response' that streams SSE events.
+
+The callback receives a 'ServerSentEventGenerator' for sending events.
+The SSE connection stays open until the callback returns.
+
+@
+app :: WAI.Request -> (WAI.Response -> IO b) -> IO b
+app req respond =
+ respond $ sseResponse $ \\gen -> do
+ sendPatchElements gen (patchElements "\
Hello\<\/div\>")
+@
+-}
+sseResponse :: Logger.DatastarLogger -> (ServerSentEventGenerator -> IO ()) -> WAI.Response
+sseResponse logger callback =
WAI.responseStream
WAI.status200
headers
@@ -101,6 +106,7 @@
{ sseWrite = write
, sseFlush = flush
, sseLock = lock
+ , sseLogger = logger
}
send :: ServerSentEventGenerator -> DatastarEvent -> IO ()
@@ -126,24 +132,25 @@
sendExecuteScript :: ServerSentEventGenerator -> ES.ExecuteScript -> IO ()
sendExecuteScript gen es = send gen $ ES.toDatastarEvent es
--- | Decode signals sent by the browser in a Datastar request.
---
--- For GET requests, signals are URL-encoded in the @datastar@ query parameter.
--- For POST requests (and other methods), signals are read from the request
--- body as JSON.
---
--- Define a Haskell data type with a 'FromJSON' instance to decode into:
---
--- @
--- data MySignals = MySignals { count :: Int, label :: Text }
--- deriving (Generic)
--- deriving anyclass (FromJSON)
---
--- handler :: WAI.Request -> IO ()
--- handler req = do
--- Right signals <- readSignals req
--- putStrLn $ \"Count is: \" <> show (count signals)
--- @
+{- | Decode signals sent by the browser in a Datastar request.
+
+For GET requests, signals are URL-encoded in the @datastar@ query parameter.
+For POST requests (and other methods), signals are read from the request
+body as JSON.
+
+Define a Haskell data type with a 'FromJSON' instance to decode into:
+
+@
+data MySignals = MySignals { count :: Int, label :: Text }
+ deriving (Generic)
+ deriving anyclass (FromJSON)
+
+handler :: WAI.Request -> IO ()
+handler req = do
+ Right signals <- readSignals req
+ putStrLn $ \"Count is: \" <> show (count signals)
+@
+-}
readSignals :: (FromJSON a) => WAI.Request -> IO (Either String a)
readSignals req
| WAI.requestMethod req == "GET" =
@@ -161,19 +168,20 @@
parseFromBody :: (FromJSON a) => WAI.Request -> IO (Either String a)
parseFromBody req = A.eitherDecode <$> WAI.strictRequestBody req
--- | Check whether a request was initiated by Datastar.
---
--- Datastar adds a @datastar-request@ header to its SSE requests. Use this to
--- distinguish Datastar requests from normal page loads — for example, to
--- serve either an SSE stream or a full HTML page from the same route.
---
--- @
--- app req respond
--- | isDatastarRequest req =
--- respond $ sseResponse $ \\gen -> ...
--- | otherwise =
--- respond $ responseLBS status200 [] fullPageHtml
--- @
+{- | Check whether a request was initiated by Datastar.
+
+Datastar adds a @datastar-request@ header to its SSE requests. Use this to
+distinguish Datastar requests from normal page loads — for example, to
+serve either an SSE stream or a full HTML page from the same route.
+
+@
+app req respond
+ | isDatastarRequest req =
+ respond $ sseResponse $ \\gen -> ...
+ | otherwise =
+ respond $ responseLBS status200 [] fullPageHtml
+@
+-}
isDatastarRequest :: WAI.Request -> Bool
isDatastarRequest req = any ((== "datastar-request") . fst) (WAI.requestHeaders req)
diff --git a/test/Hypermedia/Datastar/ExecuteScriptSpec.hs b/test/Hypermedia/Datastar/ExecuteScriptSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Hypermedia/Datastar/ExecuteScriptSpec.hs
@@ -0,0 +1,98 @@
+module Hypermedia.Datastar.ExecuteScriptSpec (spec) where
+
+import Test.Hspec
+
+import Hypermedia.Datastar.ExecuteScript
+import Hypermedia.Datastar.Types
+
+spec :: Spec
+spec = describe "Hypermedia.Datastar.ExecuteScript.toDatastarEvent" $ do
+ it "minimal: single-line script with auto-remove" $ do
+ let event = toDatastarEvent $ executeScript "console.log('Here')"
+
+ eventType event `shouldBe` EventPatchElements
+ eventId event `shouldBe` Nothing
+ retry event `shouldBe` defaultRetryDuration
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
+
+ it "full: all options set" $ do
+ let pAutoRemove = True
+ pAttrs = ["type=\"application/javascript\""]
+ pEventId = Just "123"
+ pRetryDuration = 2000
+ es =
+ (executeScript "console.log('Here')")
+ { esAutoRemove = pAutoRemove
+ , esAttributes = pAttrs
+ , esEventId = pEventId
+ , esRetryDuration = pRetryDuration
+ }
+ event = toDatastarEvent es
+
+ eventType event `shouldBe` EventPatchElements
+ eventId event `shouldBe` pEventId
+ retry event `shouldBe` pRetryDuration
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
+
+ it "auto-remove disabled" $ do
+ let es = (executeScript "alert(1)"){esAutoRemove = False}
+ event = toDatastarEvent es
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
+
+ it "multi-line script" $ do
+ let es = executeScript "var x = 1;\nconsole.log(x);"
+ event = toDatastarEvent es
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
+
+ it "multi-line script with three lines" $ do
+ let es = executeScript "var x = 1;\nvar y = 2;\nconsole.log(x + y);"
+ event = toDatastarEvent es
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
+
+ it "empty script" $ do
+ let es = executeScript ""
+ event = toDatastarEvent es
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
+
+ it "multiple attributes" $ do
+ let es =
+ (executeScript "go()")
+ { esAttributes = ["type=\"module\"", "defer"]
+ }
+ event = toDatastarEvent es
+ dataLines event
+ `shouldBe` [ "selector body"
+ , "mode append"
+ , "elements "
+ ]
diff --git a/test/Hypermedia/Datastar/PatchSignalsSpec.hs b/test/Hypermedia/Datastar/PatchSignalsSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Hypermedia/Datastar/PatchSignalsSpec.hs
@@ -0,0 +1,58 @@
+module Hypermedia.Datastar.PatchSignalsSpec (spec) where
+
+import Test.Hspec
+
+import Hypermedia.Datastar.PatchSignals
+import Hypermedia.Datastar.Types
+
+spec :: Spec
+spec = describe "Hypermedia.Datastar.PatchSignals.toDatastarEvent" $ do
+ it "minimal: single-line signals, all defaults" $ do
+ let event = toDatastarEvent $ patchSignals "{\"output\":\"Patched Output Test\",\"show\":true}"
+
+ eventType event `shouldBe` EventPatchSignals
+ eventId event `shouldBe` Nothing
+ retry event `shouldBe` defaultRetryDuration
+ dataLines event `shouldBe` ["signals {\"output\":\"Patched Output Test\",\"show\":true}"]
+
+ it "full: all options set" $ do
+ let pOnlyIfMissing = True
+ pEventId = Just "123"
+ pRetryDuration = 2000
+
+ ps =
+ (patchSignals "{\"output\":\"Patched Output Test\",\"show\":true}")
+ { psOnlyIfMissing = pOnlyIfMissing
+ , psEventId = pEventId
+ , psRetryDuration = pRetryDuration
+ }
+ event = toDatastarEvent ps
+
+ eventType event `shouldBe` EventPatchSignals
+ eventId event `shouldBe` pEventId
+ retry event `shouldBe` pRetryDuration
+
+ dataLines event
+ `shouldBe` [ "onlyIfMissing true"
+ , "signals {\"output\":\"Patched Output Test\",\"show\":true}"
+ ]
+
+ it "omits onlyIfMissing when false (default)" $ do
+ let ps = patchSignals "{\"foo\":1}"
+ event = toDatastarEvent ps
+ dataLines event `shouldBe` ["signals {\"foo\":1}"]
+
+ it "handles multi-line JSON" $ do
+ let event = toDatastarEvent $ patchSignals "{\n \"foo\": 1,\n \"bar\": 2\n}"
+
+ dataLines event
+ `shouldBe` [ "signals {"
+ , "signals \"foo\": 1,"
+ , "signals \"bar\": 2"
+ , "signals }"
+ ]
+
+ it "documents null removal via JSON merge patch" $ do
+ let ps = patchSignals "{\"key\": null}"
+ event = toDatastarEvent ps
+ dataLines event `shouldBe` ["signals {\"key\": null}"]
diff --git a/test/Hypermedia/Datastar/SSESpec.hs b/test/Hypermedia/Datastar/SSESpec.hs
--- a/test/Hypermedia/Datastar/SSESpec.hs
+++ b/test/Hypermedia/Datastar/SSESpec.hs
@@ -13,6 +13,7 @@
import Hypermedia.Datastar.PatchSignals
import Hypermedia.Datastar.Types
import Hypermedia.Datastar.WAI (renderEvent)
+import Hypermedia.Datastar.Logger (nullLogger)
import Network.Wai.Internal (Response (..))
render :: DatastarEvent -> String
@@ -51,7 +52,7 @@
e1 = "
2
"
e2 = "{\"count\": 42}"
- resp = sseResponse $ \gen -> do
+ resp = sseResponse nullLogger $ \gen -> do
sendPatchElements gen (patchElements e0)
sendPatchElements gen (patchElements e1)
sendPatchSignals gen (patchSignals e2)
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -2,10 +2,15 @@
import Test.Hspec
+import Hypermedia.Datastar qualified
+import Hypermedia.Datastar.ExecuteScriptSpec qualified
import Hypermedia.Datastar.PatchElementsSpec qualified
-import Hypermedia.Datastar.SSESpec qualified
+import Hypermedia.Datastar.PatchSignalsSpec qualified
+import Hypermedia.Datastar.SSESpec qualified
main :: IO ()
main = hspec $ do
+ Hypermedia.Datastar.ExecuteScriptSpec.spec
Hypermedia.Datastar.PatchElementsSpec.spec
+ Hypermedia.Datastar.PatchSignalsSpec.spec
Hypermedia.Datastar.SSESpec.spec
