Serve


1 Overview

The functionality provided by this library basically replaces the need to use something like

python -m http.server 8010

to view the woven HTML in a browser. Instead you could just run

lilac serve --port 8010 .

for the same effect. See f:lilacServe for the entrypoint.

2 Lilac.Serve module

module:Lilac.Serve
🎯 src/Lilac/Serve.hs
module Lilac.Serve
  ( fsWatcher,
    liveReloadMiddleware,
  )
where

import Control.Concurrent (forkIO, threadDelay, withMVar)
import Control.Concurrent.Async (withAsync)
import Control.Concurrent.STM
  ( TChan,
    TVar,
    dupTChan,
    isEmptyTChan,
    modifyTVar',
    readTChan,
    readTVar,
    writeTChan,
    writeTVar,
  )
import Control.Exception (catch, finally)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Map.Strict (findWithDefault)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (getZonedTime)
import Network.HTTP.Types (status200)
import Network.Wai (Middleware, pathInfo, responseLBS)
import Network.Wai.Handler.WebSockets (websocketsOr)
import Network.WebSockets qualified as WS
import Relude
  ( Bool (False, True),
    FilePath,
    IO,
    Int,
    LByteString,
    MVar,
    Map,
    Maybe (Just),
    STM,
    Text,
    Type,
    atomically,
    not,
    null,
    otherwise,
    pure,
    putMVar,
    readMVar,
    show,
    void,
    when,
    ($),
    (&&),
    (+),
    (-),
    (.),
    (<$>),
    (<>),
    (==),
  )
import Relude.Extra.Map (delete, insert, lookup)
import System.Directory (doesFileExist, getModificationTime)
import System.FSNotify
  ( Event (Added, Modified),
    eventPath,
    watchTree,
    withManager,
  )
import System.FilePath
  ( dropTrailingPathSeparator,
    makeRelative,
    takeExtension,
    (</>),
  )
import System.IO (stderr)

type:GenMap
f:liveReloadMiddleware
f:readStableHtmlFile
f:fsWatcher
f:debouncePerPath
f:wsHandler
f:drainChannel
f:handleClientConnection
f:waitForMatch
f:getTimestamp
f:logVerbose
f:logVerboseLn

3 Architecture

The user is expected to run

lilac serve .

to start serving all HTML files (ending with *.html) in the current directory. And then in another terminal window, they can run

watch -n 0.1 make

and assuming that their Makefile knows how to weave Org files into HTML, the newly woven HTML files will get picked up by the server and any browser tabs pointing to these HTML files will get refreshed. This way, the user doesn't have to manually refresh the page to pick up the new changes in the just-woven HTML page.

There are three main parts to make the above work, in order of increasing complexity:

  1. Client JavaScript injection. We don't want to weave the WebSocket JavaScript to every woven HTML file, because lilac serve is meant for development purposes, when the user is authoring an Org file they want to weave into HTML. So instead, we inject it into the HTML via middleware.

  2. Filesystem watcher. This is how the server knows when an HTML file has changed on disk, and thus when to reload its HTML page.

  3. WebSockets. This is used to tell the client (browser) to reload the page. It is also used by the client (on initial page load) to let the server know that it has loaded that particular page. This information from the client is important, because the server needs to know which client to send the reload command to (it needs to pick the one that's looking at a stale HTML file).

Figure 1. Call sequence (of interesting bits) for f:lilacServe (happy path). The heartbeatHandlerThread and waitForMatch boxes are separate looping threads. Dashed lines represent multiple actions.
Call sequence (of interesting bits) for [[id:b0033603-7251-449b-ba7d-be4a1a118fd0::f:lilacServe]] (happy path). The [[(f:handleClientConnection-heartbeatHandlerThread)][=heartbeatHandlerThread=]] and [[f:waitForMatch][=waitForMatch=]] boxes are separate looping threads. Dashed lines represent multiple actions.
fig:lilac-serve.pikchr
🎯 image/lilac-serve.pikchr

4 Client JavaScript injection

If f:liveReloadMiddleware detect that we're serving an HTML page, we inject it with js:live-reload.

f:liveReloadMiddleware
liveReloadMiddleware :: FilePath -> TChan FilePath -> MVar () -> Bool -> Middleware
liveReloadMiddleware root fsChan logLock verbose baseApp req respond =
  websocketsOr
    WS.defaultConnectionOptions
    (wsHandler fsChan logLock verbose)
    backupApp
    req
    respond
  where
    backupApp req' resp' = do
      let pieces = pathInfo req'
          relPath =
            if null pieces
              then "index.html"
              else T.unpack (T.intercalate "/" pieces)
          fullPath = dropTrailingPathSeparator root </> relPath
      isHtmlFile <-
        if takeExtension fullPath == ".html"
          then doesFileExist fullPath
          else pure False
      if isHtmlFile
        then do
          content <- readStableHtmlFile fullPath logLock verbose -- 1
          resp'
            $ responseLBS
              status200
              [("Content-Type", "text/html")]
              (injectScript content)
        else baseApp req' resp'
    injectScript body =
      let (before, after) = BS.breakSubstring "</body>" (LBS.toStrict body)
          script :: LByteString
          script =
            """
            <script>
            js:live-reload 2
            </script>
            """
       in if BS.null after
            then body
            else LBS.fromStrict before <> script <> LBS.fromStrict after

f:readStableHtmlFile 1 reads the file until it stabilizes (not only has not been modified in 200ms, but has a </html> tag inside it). This is needed because we cannot really predict exactly how the file will be saved by Lilac when it is overwritten (when woven), such as whether the file is truncated to 0 bytes first and then saved again.

f:readStableHtmlFile
readStableHtmlFile :: FilePath -> MVar () -> Bool -> IO LByteString
readStableHtmlFile path logLock verbose = go (20 :: Int)
  where
    go 0 = LBS.readFile path
    go n = do
      before <- getModificationTime path
      content <- LBS.readFile path
      after <- getModificationTime path
      let looksComplete =
            not (LBS.null content)
              && "</html>"
              `BS.isInfixOf` LBS.toStrict content
          pathText = T.pack path
      if before == after && looksComplete
        then do
          logVerboseLn logLock verbose
            $ "[readStableHtmlFile] File stable: "
            <> pathText
          pure content
        else do
          logVerboseLn logLock verbose
            $ "[readStableHtmlFile] File unstable/incomplete, retrying "
            <> pathText
          threadDelay 200_000
          go (n - 1)

js:live-reload 2 is the one that initiates the creation of the WebSocket with the server. We do several things over the WebSocket:

  1. Initially, we tell the server about the path (specific HTML page) we're looking at 4.

  2. Every 30 seconds, we send the server a heartbeat message 5. This is so that the server knows not to kill the WebSocket connection due to inactivity.

  3. When the WebSocket is deliberately closed (due to network issues and whatnot), we attempt to open it again instead of reloading the whole page 7.

  4. When there's an error with the WebSocket itself, we close it ourselves 8.

  5. Of course, when the server tells us to reload, we do so by calling reloadPage() 6.

js:live-reload
(function() {
    let reloading = false;
    const path = window.location.pathname;
    const wsUrl = (window.location.protocol === 'https:' ? 'wss://' : 'ws://')
                  + window.location.host
                  + '/lilac-ws';

    js:reload-page

    function connectWebSocket() {
        const ws = new WebSocket(wsUrl); // 3

        const trigger = () => {
            if (!reloading) {
                reloading = true;
                console.log("Lilac: Initiating reload...");
                reloadPage();
            }
        };

        ws.onopen = () => {
            console.log("Lilac: WebSocket connected. Monitoring path:", path);
            ws.send(path); // 4

            // 5
            const heartbeat = setInterval(() => {
                if (ws.readyState === WebSocket.OPEN) {
                    ws.send('LILAC_WS_HEARTBEAT_FROM_JS_CLIENT');
                } else {
                    clearInterval(heartbeat);
                }
            }, 30000);
        };

        ws.onmessage = (msg) => {
            if (msg.data === 'reload') {
                console.log("Lilac: Reload signal received."); // 6
                trigger();
            }
        };

        ws.onclose = (e) => {
            if (!reloading) {
                console.log("Lilac: WebSocket closed (Code " + e.code + ").");
                console.log("Lilac: Reconnecting in 2s...");
                setTimeout(connectWebSocket, 2000); // 7
            }
        };

        ws.onerror = (err) => {
            console.error("Lilac: WebSocket error observed:", err);
            ws.close(); // 8
        };
    }

    connectWebSocket();
})();

Now we get to the script which refreshes the page. We can't just issue a raw window.location.reload() by itself because we want to remember our scroll position in the page. Otherwise when the reload happens, unless we were at a link anchor, we would be move up to the very top of the page.

We want to first load the scroll positions (that were saved from the previous invocation, if any), then save the current scroll positions (to local storage), and then finally do a hard refresh. The one other thing we do is avoid performing the hard refresh if either the page has been recently scrolled (if the user is interacting with the page by scrolling).

js:reload-page
const scrollSelectors = ['nav.toc', 'main', 'aside.sidebar']; // 9
const storageKey = 'dev-scroll-map';

let lastScrollTime = 0;
window.addEventListener('scroll', () => { // 10
  lastScrollTime = Date.now();
}, true);

function setScrollPositions(map) {
  for (let sel in map) {
    let el = document.querySelector(sel);
    if (el) el.scrollTop = map[sel];
  }
}

function getScrollPositions(selectors) {
  let map = {};
  selectors.forEach(sel => {
    let el = document.querySelector(sel);
    if (el) map[sel] = el.scrollTop;
  });
  return map;
}

const rawData = localStorage.getItem(storageKey);
if (rawData) {
  const prevScrollPositions = JSON.parse(rawData);
  setTimeout(() => {
    setScrollPositions(prevScrollPositions); // 11
    localStorage.removeItem(storageKey);
  }, 200); // 12
}

// 13
function reloadPage() {
  const recentlyScrolled = (Date.now() - lastScrollTime) < 1500; // 14

  if (recentlyScrolled) { // 15
    setTimeout(reloadPage, 500); // 16
    return;
  }

  const currentScrollPositions = getScrollPositions(scrollSelectors);
  localStorage.setItem(storageKey,
                       JSON.stringify(currentScrollPositions)); // 17

  window.location.reload(); // 18
}

The scrollable elements 9 are based on those top-level helpers described in Object and Page layout. The event listener at (lastScrollTimeListener)]] updates the value of lastScrollTime so that we can tell how recently the user scrolled anything on the page at 14.

Restoration of any previously saved scroll positions is handled at 11. The 200 millisecond delay at 12 gives the browser time to finish rendering the page before we attempt to restore the scroll positions (otherwise, the DOM may not have been parsed yet for the JavaScript to look at and manipulate).

Now we get to the refreshing logic. If we have recently scrolled the window, we cancel the refresh at 15, because otherwise we'll get a surprise refresh as we're scrolling through some content ourselves.

Before refreshing, we save the scroll position of the scrollable elements at 17. The hard refresh 18 guarantees that we clear the heap of any listeners and such on the current page. While we could forego a hard refresh and do a DOM replacement in JavaScript, such a strategy is tricky to avoid memory leaks. This is why we do a simple hard refresh.

We wait just half a second 16 if the refresh was canceled, so that we're more responsive if the user either stops scrolling.

5 Filesystem watcher

The filesystem watcher listens to filesystem events, which is simple enough -- we just delegate this work to System.FSNotify.watchTree 19 from f:fsWatcher. Then we receive all filesystem events, where each event gets its own separate thread of execution.

f:fsWatcher
fsWatcher ::
  FilePath ->
  TChan FilePath ->
  TVar GenMap ->
  MVar () ->
  MVar () ->
  MVar () ->
  Bool ->
  IO ()
fsWatcher dir fsChan activePaths shutdownMVar fsWatcherDone logLock verbose = do
  let signalThreadExit = do
        logVerboseLn logLock verbose "done."
        putMVar fsWatcherDone ()
  fsAction `finally` signalThreadExit
  where
    fsAction =
      withManager $ \mgr -> do
        let normalizedDir = dropTrailingPathSeparator dir
        void
          $ watchTree -- 19
            mgr
            normalizedDir
            isHtmlFsEvent
            -- 20
            (debouncePerPath activePaths (signalFsEvent normalizedDir fsChan))
        logVerboseLn
          logLock
          verbose
          $ "[fsWatcher] Listening to "
          <> T.pack dir
          <> "..."
        readMVar shutdownMVar -- 21
        logVerboseLn logLock verbose "[fsWatcher] Received shutdown signal."
        logVerbose logLock verbose "[fsWatcher] Cleaning up resources... "
    -- 22
    isHtmlFsEvent e = case e of
      Added {}
      Modified {} -> takeExtension (eventPath e) == ".html"
      _ -> False
    signalFsEvent :: FilePath -> TChan FilePath -> Event -> IO ()
    signalFsEvent watchedDir chan event = do
      let relPath = makeRelative watchedDir $ eventPath event
      logVerboseLn logLock verbose
        $ "[fsWatcher] Detected event: "
        <> T.pack relPath
        <> " ("
        <> show event
        <> ")"
      atomically $ writeTChan chan relPath -- 23

We only look for HTML file modification (or creation) events in isHtmlFsEvent 22. If this event is detected, we write the relative path of that HTML file to the shared TChan channel in signalFsEvent 23, and then other threads can listen to this event 36 to issue a reload request to the client over the WebSocket 37.

It's important to block the thread inside withManager, because if the thread finishes, the file watching will terminate. Because we want the file watcher to run for the duration of the server's running time, we block until shutdown 21.

Some complexity arises from the need to debounce (filter out) bursts of events, because if we sent a reload command for every event, there is a risk of sending too many reload commands (and the client attempting a page reload when the HTML file is blank or partially written to by the OS). Such is the danger of I/O.

The debouncing is done in f:debouncePerPath. We use type:GenMap to assign an incrementing counter (generation number) to each file path we see from the filesystem event.

type:GenMap
type GenMap :: Type
type GenMap = Map FilePath Int

f:debouncePerPath checks the generation number, starting with 0 or incrementing it by 1 24. After waiting for 500ms 25, it looks up the generation number 26. If no other thread has incremented it in that span of time, then the thread knows that it's safe to run the action. Otherwise, the thread is one of several that are all handling a burst of filesystem events for the same path and is stale because another thread has a higher generation number for this path, in which case it does nothing 27.

f:debouncePerPath
debouncePerPath :: TVar GenMap -> (Event -> IO ()) -> Event -> IO ()
debouncePerPath genMap action e = do
  let path = eventPath e
  currentGen <- atomically $ do
    m <- readTVar genMap
    let nextGen = findWithDefault 0 path m + 1 -- 24
    writeTVar genMap $ insert path nextGen m
    pure nextGen

  void . forkIO $ do
    threadDelay 500_000 -- 25
    shouldFire <- atomically $ do
      m <- readTVar genMap
      case lookup path m of -- 26
        Just latestGen | latestGen == currentGen -> do
          modifyTVar' genMap $ delete path
          pure True
        _ -> pure False -- 27
    when shouldFire $ action e

6 WebSockets

A WebSocket connection allows us to have a two-way communication channel between the browser tab and the server. It is what let's us associate browser connections to file system events. Below is a description of the typical happy path scenario:

  1. When the server starts up, it creates a filesystem watcher f:lilacServe20 thread on the given directory to respond to any filesystem events going on inside there.

  2. When the client starts up (when a browser tab loads an HTML page which falls under the watched directory), the server sends the HTML page, but modifies it by injecting client-side JavaScript (js:live-reload) into the page. Then when that page loads, the injected JavaScript creates a new WebSocket connection 3.

  3. At this point, the job of the client is to listen to any reload requests from the server 6. To this end the client sends heartbeats to keep the WebSocket connection alive while it waits for the server to send those reload requests 5.

  4. From the server's point of view, it needs to handle the WebSocket connection and associate it with one of those filesystem path events, ultimately deciding when to send the reload request.

f:wsHandler handles all incoming WebSocket data from the client. It knows how to handle a single WebSocket connection conn 28.

f:wsHandler
wsHandler :: TChan FilePath -> MVar () -> Bool -> WS.ServerApp
wsHandler fsChan logLock verbose pending =
  f `catch` \(e :: WS.ConnectionException) ->
    logVerboseLn logLock verbose
      $ "[wsHandler] Connection dropped during handshake (Reason: "
      <> T.pack (show e)
      <> ")"
  where
    f = do
      conn <- WS.acceptRequest pending -- 28
      msg <- WS.receiveData conn :: IO Text -- 29
      if msg == "LILAC_WS_HEARTBEAT_FROM_JS_CLIENT"
        then do
          logVerboseLn logLock verbose $ "[wsHandler] Ignored heartbeat (ON INIT): " <> msg
          WS.sendClose conn ("Path expected" :: Text) -- 30
        else handleClientConnection conn fsChan msg logLock verbose

Most of the work falls to f:handleClientConnection, which creates a separate thread for keeping the WebSocket alive (by processing the heartbeats sent by the client). As for the main thread, it just listens for filesystem events through f:waitForMatch.

f:handleClientConnection
handleClientConnection ::
  WS.Connection ->
  TChan FilePath ->
  Text ->
  MVar () ->
  Bool ->
  IO ()
handleClientConnection conn fsChan msg logLock verbose = do
  let browserLocation
        | T.null cleaned = "index.html"
        | otherwise = cleaned
        where
          cleaned = T.dropAround (== '/') msg
  logVerboseLn
    logLock
    verbose
    $ "[wsHandler] Browser connected: "
    <> browserLocation

  fsPathChan <- atomically $ do
    chan <- dupTChan fsChan -- 31
    drainChannel chan
    pure chan

  -- 32
  let fsListenerThread =
        waitForMatch conn fsPathChan browserLocation logLock verbose

  -- 33
  let heartbeatHandlerThread = do
        heartbeat <- WS.receiveData conn :: IO Text
        logVerboseLn
          logLock
          verbose
          $ "[wsHandler] Ignored heartbeat: "
          <> heartbeat
        heartbeatHandlerThread -- 34

  -- 35
  (withAsync fsListenerThread $ \_ -> heartbeatHandlerThread)
    `catch` \(e :: WS.ConnectionException) -> do
      logVerboseLn logLock verbose
        $ "[wsHandler] Browser disconnected: "
        <> browserLocation
        <> " (Reason: "
        <> T.pack (show e)
        <> ")"

The first thing to do is read the very first message from the client 29, which we expect to be a file path. The happy path looks like this:

  1. Client connects 3

  2. Server accepts (f:wsHandler)

  3. Client sends path 4

  4. Server enters f:waitForMatch 32

If the first message is not a path (because of some weird timing edge case), we manually close the WebSocket connection 30 to make the client re-establish the WebSocket in the normal "happy path" order 7. Thus the sequence of events looks like this:

  1. Client connects 3

  2. Server accepts (f:wsHandler)

  3. Client sends heartbeat 5

  4. Server closes 30

  5. Client waits 2s and reconnects 7

  6. Client sends path 4

  7. Server enters f:waitForMatch 32

f:wsHandler also reads heartbeat messages from the client to keep the connection alive 34 (otherwise, Warp may kill the connection on its own due to a timeout). It does this repeatedly in a long-lived heartbeatHandlerThread 33 until the browser tab is closed (whereupon we'll get a WS.ConnectionException) and kill the fsListenerThread (via withAsync).

fsListenerThread listens to debounced filesystem events coming from 20. Its job is to react to filesystem events on the same path that the client sent, by subscribing to the filesystem channel with dupTChan 31. It then goes into an infinite loop with f:waitForMatch.

The call to f:drainChannel is there to get rid of filesystem events that have been queued up before the WebSocket connection has been established; this can happen if the HTML file is modified multiple times after the server has spawned, but before a browser tab is opened to load the same HTML file.

f:drainChannel
drainChannel :: TChan a -> STM ()
drainChannel chan = do
  isEmpty <- isEmptyTChan chan
  when (not isEmpty) $ do
    _ <- readTChan chan
    drainChannel chan

It's also worth noting that if the browser disconnects 35, this would make the heartbeat handling thread catch a WS.ConnectionException and kill the filesystem listener thread. Conversely, if the filesystem thread dies because it sent a reload request to the client 37, it will kill the heartbeat handling thread 32. This way these threads are not leaked over the life of the server process.

f:waitForMatch reads from the subscribed filesystem events channel 36, and only sends the reload command to the client 37 if the path from the filesystem event matches the path sent by the client. Otherwise it loops by calling itself again 38.

f:waitForMatch
waitForMatch :: WS.Connection -> TChan FilePath -> Text -> MVar () -> Bool -> IO ()
waitForMatch conn fsPathChan browserLocation logLock _verbose = do
  modifiedFile <- T.pack <$> atomically (readTChan fsPathChan) -- 36
  if (browserLocation == modifiedFile)
    then do
      t <- getTimestamp
      let time = "[" <> t <> "]"
          announcement =
            time
              <> " FS event detected, reloading "
              <> browserLocation
              <> "."
      logVerboseLn logLock True announcement
      WS.sendTextData conn ("reload" :: Text) -- 37
    else
      waitForMatch conn fsPathChan browserLocation logLock _verbose -- 38

7 Logging

Below are some helper functions to help with logging. They both use a lock so that no two threads can write at the same time.

f:logVerbose
logVerbose :: MVar () -> Bool -> Text -> IO ()
logVerbose lock verbose msg = when verbose $ do
  t <- getTimestamp
  withMVar lock $ \_ ->
    T.hPutStr stderr $ "[" <> t <> "] " <> msg
f:logVerboseLn
logVerboseLn :: MVar () -> Bool -> Text -> IO ()
logVerboseLn lock verbose msg = when verbose $ do
  t <- getTimestamp
  withMVar lock $ \_ ->
    T.hPutStrLn stderr $ "[" <> t <> "] " <> msg
f:getTimestamp
getTimestamp :: IO Text
getTimestamp = do
  now <- getZonedTime
  let timeStr = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Ez" now
  pure $ T.pack timeStr

Page metrics

Tangled files (2)

  1. image/lilac-serve.pikchr
  2. src/Lilac/Serve.hs

Named cells (17)

  1. f:debouncePerPath
  2. f:drainChannel
  3. f:fsWatcher
  4. f:getTimestamp
  5. f:handleClientConnection
  6. f:liveReloadMiddleware
  7. f:logVerbose
  8. f:logVerboseLn
  9. f:readStableHtmlFile
  10. f:waitForMatch
  11. f:wsHandler
  12. fig:lilac-serve
  13. fig:lilac-serve.pikchr
  14. js:live-reload
  15. js:reload-page
  16. module:Lilac.Serve
  17. type:GenMap