From 4f9b6a0406eee0e0f8b17a5e0f4a549374c9c40b Mon Sep 17 00:00:00 2001
From: thomasjm <tom@codedown.io>
Date: Sat, 14 Nov 2026 06:17:22 -0800
Subject: [PATCH 1/4] Locate program: edit positions on outputs, locate and
 sourceAt

---
 README.md                                  | 23 +++++-
 app/Main.hs                                |  3 +-
 lsp-export-protocol/src/Render/Protocol.hs | 54 +++++++++++++-
 lsp-export-server.cabal                    |  1 +
 src/Render/Command.hs                      | 87 +++++++++++++++++++++-
 src/Render/Server.hs                       | 71 +++++++++++++++---
 test-lib/TestLib/Session.hs                | 17 ++++-
 test/Spec/Locate.hs                        | 87 ++++++++++++++++++++++
 8 files changed, 324 insertions(+), 19 deletions(-)
 create mode 100644 test/Spec/Locate.hs

diff --git a/README.md b/README.md
index 41a4dbd..e276f60 100644
--- a/README.md
+++ b/README.md
@@ -7,7 +7,7 @@ server as `didChange` and a new render comes back without a trip through the dis
 The server knows nothing about document formats. The packaging names the program that renders:
 
 ```
-lsp-export-server serve --render latex-render --settle latex-render -o engine=pdflatex   # the LSP, on stdio
+lsp-export-server serve --render latex-render --settle latex-render --locate latex-locate -o engine=pdflatex   # the LSP, on stdio
 lsp-export-server render --render latex-render input.tex output.pdf                      # once, from disk
 ```
 
@@ -40,10 +40,29 @@ that exit code. Paths listed in `RENDER_DEPS` under `RENDER_SRC` or `RENDER_OVER
 back to the documents they stand for; the client is told to watch the ones it does not hold open,
 and a `rebuild` renders again only when one of them changed.
 
+## The locate program
+
+Optional. It maps between source positions and places in the last output, as SyncTeX does for
+LaTeX. It runs in the document's directory with `RENDER_DOCUMENT`, `RENDER_JOB`, `RENDER_FORMAT`,
+`RENDER_OUTPUT`, `RENDER_WORK` and `RENDER_OUT` as for the render program, and:
+
+| Variable | |
+|---|---|
+| `RENDER_QUERY` | `forward` or `inverse` |
+| `RENDER_SOURCE`, `RENDER_LINE`, `RENDER_COLUMN` | forward: the file as the render program saw it (the copy under `RENDER_WORK` for a buffer), and a one-based line and column |
+| `RENDER_PAGE`, `RENDER_X`, `RENDER_Y` | inverse: a one-based page, and a point on it in PDF points from its top-left corner |
+| `RENDER_RESULT` | where to write the answer, one line: `page left top width height` for forward, in the same units; `line column file` for inverse, one-based. Nothing when there is no match |
+
+After each render that follows an edit, the server locates the edit and sends the box with the
+output as `position`. The `locate` and `sourceAt` commands answer the same queries for the client,
+from the last render. Files under `RENDER_WORK` in an inverse answer are mapped back to the
+documents they stand for, as with `RENDER_DEPS`.
+
 ## Protocol
 
 Commands (`workspace/executeCommand`): `codedown.render.start`, `codedown.render.stop`,
-`codedown.render.rebuild`, `codedown.render.setPaused`, `codedown.render.resync`. Notifications:
+`codedown.render.rebuild`, `codedown.render.setPaused`, `codedown.render.resync`,
+`codedown.render.locate`, `codedown.render.sourceAt`. Notifications:
 `codedown/render/status`, `codedown/render/output`, `codedown/render/log`. See `src/Render/Protocol.hs`.
 Statuses carry the pass (`phase`) and what triggered it (`reason`), and `──` marker lines in the
 log say when each pass started, why, how long it took and what was sent.
diff --git a/app/Main.hs b/app/Main.hs
index 4b7772b..e1ad411 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -31,7 +31,8 @@ commonParser :: Parser Common
 commonParser = Common
   <$> (Programs
     <$> strOption (long "render" <> metavar "EXE" <> help "The program that renders: run in the document's directory with the RENDER_* variables; writes RENDER_OUTPUT")
-    <*> optional (strOption (long "settle" <> metavar "EXE" <> help "The program for the settle pass once edits stay quiet; without one there is no settle pass")))
+    <*> optional (strOption (long "settle" <> metavar "EXE" <> help "The program for the settle pass once edits stay quiet; without one there is no settle pass"))
+    <*> optional (strOption (long "locate" <> metavar "EXE" <> help "The program that maps source positions to places in the output and back; without one, outputs carry no position")))
   <*> many (option (eitherReader keyValue) (long "option" <> short 'o' <> metavar "KEY=VALUE" <> help "An option passed on as RENDER_OPT_KEY"))
   where
     keyValue s = case break (== '=') s of
diff --git a/lsp-export-protocol/src/Render/Protocol.hs b/lsp-export-protocol/src/Render/Protocol.hs
index bba5f09..f947d49 100644
--- a/lsp-export-protocol/src/Render/Protocol.hs
+++ b/lsp-export-protocol/src/Render/Protocol.hs
@@ -8,6 +8,8 @@ module Render.Protocol (
   , commandRebuild
   , commandSetPaused
   , commandResync
+  , commandLocate
+  , commandSourceAt
   , allCommands
 
   , methodStatus
@@ -17,6 +19,10 @@ module Render.Protocol (
   , StartParams(..)
   , StartResult(..)
   , RebuildParams(..)
+  , LocateParams(..)
+  , SourceAtParams(..)
+  , SourceLocation(..)
+  , PageBox(..)
 
   , Status(..)
   , Phase(..)
@@ -37,15 +43,17 @@ import Data.Text (Text)
 import GHC.Generics (Generic)
 
 
-commandStart, commandStop, commandRebuild, commandSetPaused, commandResync :: Text
+commandStart, commandStop, commandRebuild, commandSetPaused, commandResync, commandLocate, commandSourceAt :: Text
 commandStart = "codedown.render.start"
 commandStop = "codedown.render.stop"
 commandRebuild = "codedown.render.rebuild"
 commandSetPaused = "codedown.render.setPaused"
 commandResync = "codedown.render.resync"
+commandLocate = "codedown.render.locate"
+commandSourceAt = "codedown.render.sourceAt"
 
 allCommands :: [Text]
-allCommands = [commandStart, commandStop, commandRebuild, commandSetPaused, commandResync]
+allCommands = [commandStart, commandStop, commandRebuild, commandSetPaused, commandResync, commandLocate, commandSourceAt]
 
 methodStatus, methodOutput, methodLog :: Text
 methodStatus = "codedown/render/status"
@@ -89,6 +97,46 @@ newtype RebuildParams = RebuildParams {
 instance ToJSON RebuildParams where toJSON = genericToJSON (fieldOptions 7)
 instance FromJSON RebuildParams where parseJSON = genericParseJSON (fieldOptions 7)
 
+-- | A source position, zero-based like LSP positions
+data LocateParams = LocateParams {
+  locateTaskId :: Text
+  , locateUri :: Text
+  , locateLine :: Int
+  , locateCharacter :: Int
+  } deriving (Show, Eq, Generic)
+instance ToJSON LocateParams where toJSON = genericToJSON (fieldOptions 6)
+instance FromJSON LocateParams where parseJSON = genericParseJSON (fieldOptions 6)
+
+-- | A point on a page of the last output: a one-based page and PDF points from its top-left corner
+data SourceAtParams = SourceAtParams {
+  sourceAtTaskId :: Text
+  , sourceAtPage :: Int
+  , sourceAtX :: Double
+  , sourceAtY :: Double
+  } deriving (Show, Eq, Generic)
+instance ToJSON SourceAtParams where toJSON = genericToJSON (fieldOptions 8)
+instance FromJSON SourceAtParams where parseJSON = genericParseJSON (fieldOptions 8)
+
+-- | Zero-based like LSP positions
+data SourceLocation = SourceLocation {
+  sourceUri :: Text
+  , sourceLine :: Int
+  , sourceCharacter :: Int
+  } deriving (Show, Eq, Generic)
+instance ToJSON SourceLocation where toJSON = genericToJSON (fieldOptions 6)
+instance FromJSON SourceLocation where parseJSON = genericParseJSON (fieldOptions 6)
+
+-- | A box on a page of the output: a one-based page, and PDF points from the page's top-left corner
+data PageBox = PageBox {
+  boxPage :: Int
+  , boxLeft :: Double
+  , boxTop :: Double
+  , boxWidth :: Double
+  , boxHeight :: Double
+  } deriving (Show, Eq, Generic)
+instance ToJSON PageBox where toJSON = genericToJSON (fieldOptions 3)
+instance FromJSON PageBox where parseJSON = genericParseJSON (fieldOptions 3)
+
 data Timing = Timing {
   timingLabel :: Text
   , timingMs :: Double
@@ -144,6 +192,8 @@ data OutputParams = OutputParams {
   , outputDeps :: [FilePath]
   , outputRenderMs :: Double
   , outputTimings :: [Timing]
+  -- | Where the edit this render answers landed in the output
+  , outputPosition :: Maybe PageBox
   } deriving (Show, Eq, Generic)
 instance ToJSON OutputParams where toJSON = genericToJSON (fieldOptions 6)
 instance FromJSON OutputParams where parseJSON = genericParseJSON (fieldOptions 6)
diff --git a/lsp-export-server.cabal b/lsp-export-server.cabal
index 6c6b582..09079db 100644
--- a/lsp-export-server.cabal
+++ b/lsp-export-server.cabal
@@ -185,6 +185,7 @@ test-suite lsp-export-server-test
   other-modules:
       Spec
       Spec.Deps
+      Spec.Locate
       Spec.Protocol
       Spec.Server
       Spec.Xdelta
diff --git a/src/Render/Command.hs b/src/Render/Command.hs
index 2296c07..d30deba 100644
--- a/src/Render/Command.hs
+++ b/src/Render/Command.hs
@@ -6,35 +6,44 @@ module Render.Command (
   , render
   , prepareWorkDir
   , mapDeps
+  , locate
+  , sourceAt
+  , workPathFor
   ) where
 
 import Control.Monad (forM_, unless)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
+import Data.IORef
 import Data.List (isPrefixOf, nub)
 import Data.Map (Map)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 import Data.String.Interpolate
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Time
 import Render.Process
-import Render.Protocol (LogStream(..), Timing(..))
+import Render.Protocol (LogStream(..), PageBox(..), Timing(..))
 import System.Directory
 import System.Environment (getEnvironment)
 import System.Exit
 import System.FilePath
+import System.IO (hClose)
+import Text.Read (readMaybe)
 import UnliftIO (Exception, throwIO)
+import UnliftIO.Temporary (withTempFile)
 
 
 -- | The programs that render: one for the quick pass after each edit, and optionally one for the
 -- settle pass once edits stay quiet. Each runs in the document's directory with the layout and
--- options in @RENDER_*@ variables and must write @RENDER_OUTPUT@.
+-- options in @RENDER_*@ variables and must write @RENDER_OUTPUT@. The optional locate program maps
+-- between source positions and places in the last output.
 data Programs = Programs {
   programRender :: FilePath
   , programSettle :: Maybe FilePath
+  , programLocate :: Maybe FilePath
   }
 
 data RenderRequest = RenderRequest {
@@ -163,3 +172,75 @@ mapDeps entryDir entryPath workDir = nub . concatMap (classify . normalise . abs
       | overlayDir `isPrefixOf` p = [entryDir </> makeRelative overlayDir p]
       | normalise workDir `isPrefixOf` p = []
       | otherwise = [p]
+
+-- | Run the locate program forward: a one-based line and column of a file, as the programs see it
+-- (see 'workPathFor'), to the box it landed in. Nothing when the program finds no match.
+locate :: FilePath -> FilePath -> FilePath -> Text -> FilePath -> Int -> Int -> IO (Either Text (Maybe PageBox))
+locate exe entryPath workDir format source line column =
+  fmap (>>= parseBox) <$> runLocate exe entryPath workDir format [
+    ("RENDER_QUERY", "forward")
+    , ("RENDER_SOURCE", source)
+    , ("RENDER_LINE", show line)
+    , ("RENDER_COLUMN", show column)
+    ]
+  where
+    parseBox t = case words (T.unpack t) of
+      [page, left, top, width, height] -> PageBox <$> readMaybe page <*> readMaybe left <*> readMaybe top <*> readMaybe width <*> readMaybe height
+      _ -> Nothing
+
+-- | Run the locate program inverse: a one-based page and a point on it in PDF points from its
+-- top-left corner, to the document, one-based line and column it came from.
+sourceAt :: FilePath -> FilePath -> FilePath -> Text -> Int -> Double -> Double -> IO (Either Text (Maybe (FilePath, Int, Int)))
+sourceAt exe entryPath workDir format page x y =
+  fmap (>>= parseSource) <$> runLocate exe entryPath workDir format [
+    ("RENDER_QUERY", "inverse")
+    , ("RENDER_PAGE", show page)
+    , ("RENDER_X", show x)
+    , ("RENDER_Y", show y)
+    ]
+  where
+    parseSource t = do
+      let (line, rest) = T.breakOn " " (T.strip t)
+      let (column, path) = T.breakOn " " (T.stripStart rest)
+      line' <- readMaybe (T.unpack line)
+      column' <- readMaybe (T.unpack column)
+      source <- case T.stripStart path of
+        "" -> Nothing
+        p -> listToMaybe (mapDeps (takeDirectory entryPath) entryPath workDir [T.unpack p])
+      return (source, line', column')
+
+-- | The first line the locate program wrote to @RENDER_RESULT@, if any
+runLocate :: FilePath -> FilePath -> FilePath -> Text -> [(String, String)] -> IO (Either Text (Maybe Text))
+runLocate exe entryPath workDir format query = withTempFile workDir "located" $ \resultFile h -> do
+  hClose h
+  let job = dropExtension (takeFileName entryPath)
+  let vars = [
+        ("RENDER_DOCUMENT", entryPath)
+        , ("RENDER_JOB", job)
+        , ("RENDER_FORMAT", T.unpack format)
+        , ("RENDER_OUTPUT", workDir </> "out" </> job <.> T.unpack format)
+        , ("RENDER_WORK", workDir)
+        , ("RENDER_OUT", workDir </> "out")
+        , ("RENDER_RESULT", resultFile)
+        ] <> query
+  env <- (vars <>) . filter ((`notElem` map fst vars) . fst) <$> getEnvironment
+  logs <- newIORef []
+  code <- runCapturing (takeDirectory entryPath) env exe [] $ \_ line -> modifyIORef' logs (line :)
+  case code of
+    ExitFailure n -> do
+      lastLines <- reverse . take 5 <$> readIORef logs
+      return (Left [i|#{takeFileName exe} exited with code #{n}: #{T.intercalate " / " lastLines}|])
+    ExitSuccess -> Right . listToMaybe . filter (not . T.null) . T.lines <$> T.readFile resultFile
+
+-- | Where the programs see a document: the entry's copy under @src/@, an open buffer's under
+-- @overlay/@ when the last render wrote one, and any other file at its own path.
+workPathFor :: FilePath -> FilePath -> FilePath -> IO FilePath
+workPathFor entryPath workDir path
+  | path == entryPath = return (workDir </> "src" </> takeFileName entryPath)
+  | isAbsolute rel || ".." `isPrefixOf` rel = return path
+  | otherwise = doesFileExist overlay >>= \case
+      True -> return overlay
+      False -> return path
+  where
+    rel = makeRelative (takeDirectory entryPath) path
+    overlay = workDir </> "overlay" </> rel
diff --git a/src/Render/Server.hs b/src/Render/Server.hs
index af9e229..6ef54e1 100644
--- a/src/Render/Server.hs
+++ b/src/Render/Server.hs
@@ -15,7 +15,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64 as B64
 import Data.Map (Map)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, listToMaybe)
 import Data.Proxy
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -53,6 +53,10 @@ data Task = Task {
   , taskDirty :: TVar Bool
   -- | What has made the task dirty since the last render started
   , taskReasons :: TVar [Text]
+  -- | Where the last edit landed, until a quick render takes it
+  , taskEdit :: TVar (Maybe (FilePath, Position))
+  -- | The edit the last quick render answered, located again by the settle pass
+  , taskRenderedEdit :: TVar (Maybe (FilePath, Position))
   , taskPaused :: TVar Bool
   , taskResync :: TVar Bool
   , taskDeps :: TVar (Set FilePath)
@@ -103,9 +107,10 @@ handlers :: ServerEnv -> Handlers (LspM ())
 handlers env = mconcat [
   notificationHandler SMethod_Initialized $ \_ -> return ()
   , notificationHandler SMethod_TextDocumentDidOpen $ \msg ->
-      liftIO $ documentTouched env (msg ^. L.params . L.textDocument . L.uri) Nothing
+      liftIO $ documentTouched env (msg ^. L.params . L.textDocument . L.uri) Nothing Nothing
   , notificationHandler SMethod_TextDocumentDidChange $ \msg ->
       liftIO $ documentTouched env (msg ^. L.params . L.textDocument . L.uri) (Just (msg ^. L.params . L.textDocument . L.version))
+                                (lastEditPosition (msg ^. L.params . L.contentChanges))
   , notificationHandler SMethod_TextDocumentDidClose $ \_ -> return ()
   , notificationHandler SMethod_TextDocumentDidSave $ \_ -> return ()
   , notificationHandler SMethod_WorkspaceDidChangeConfiguration $ \_ -> return ()
@@ -122,8 +127,8 @@ handlers env = mconcat [
   ]
 
 -- An edit to a task's entry or to one of its dependencies means a render is due
-documentTouched :: ServerEnv -> Uri -> Maybe Int32 -> IO ()
-documentTouched env uri version = case uriToFilePath uri of
+documentTouched :: ServerEnv -> Uri -> Maybe Int32 -> Maybe Position -> IO ()
+documentTouched env uri version position = case uriToFilePath uri of
   Nothing -> return ()
   Just path -> do
     tasks <- M.elems <$> readTVarIO (envTasks env)
@@ -131,9 +136,14 @@ documentTouched env uri version = case uriToFilePath uri of
       deps <- readTVarIO (taskDeps task)
       when (path == taskEntryPath task) $
         forM_ version $ \v -> atomically (writeTVar (taskVersion task) (Just v))
-      when (path == taskEntryPath task || path `S.member` deps) $
+      when (path == taskEntryPath task || path `S.member` deps) $ do
+        forM_ position $ \pos -> atomically (writeTVar (taskEdit task) (Just (path, pos)))
         markDirty task [i|edit to #{takeFileName path}#{maybe "" (\v -> " (v" <> show v <> ")") version}|]
 
+-- | Where the last ranged change starts; Nothing for a whole-document replacement
+lastEditPosition :: [TextDocumentContentChangeEvent] -> Maybe Position
+lastEditPosition changes = listToMaybe [ partial ^. L.range . L.start | TextDocumentContentChangeEvent (InL partial) <- reverse changes ]
+
 executeCommand :: ServerEnv -> Text -> [Value] -> IO (Maybe Value)
 executeCommand env cmd args
   | cmd == commandStart = case args of
@@ -154,6 +164,25 @@ executeCommand env cmd args
   | cmd == commandResync = withTaskArg $ \task -> do
       atomically (writeTVar (taskResync task) True)
       markDirty task "full output requested by the client"
+  | cmd == commandLocate = case args of
+      [v] | Success (LocateParams {..}) <- fromJSON v -> lookupTask locateTaskId >>= \case
+        Nothing -> return Nothing
+        Just task -> case uriToFilePath (Uri locateUri) of
+          Nothing -> bad [i|not a file uri: #{locateUri}|]
+          Just path -> locatePosition env task path (Position (fromIntegral locateLine) (fromIntegral locateCharacter)) >>= \case
+            Left err -> bad err
+            Right box -> return (toJSON <$> box)
+      _ -> bad "expected [LocateParams]"
+  | cmd == commandSourceAt = case args of
+      [v] | Success (SourceAtParams {..}) <- fromJSON v -> lookupTask sourceAtTaskId >>= \case
+        Nothing -> return Nothing
+        Just task -> case programLocate (envCommand env) of
+          Nothing -> return Nothing
+          Just exe -> sourceAt exe (taskEntryPath task) (taskWorkDir task) (taskFormat task) sourceAtPage sourceAtX sourceAtY >>= \case
+            Left err -> bad err
+            Right found -> return $ flip fmap found $ \(path, line, column) ->
+              toJSON (SourceLocation (getUri (filePathToUri path)) (max 0 (line - 1)) (max 0 (column - 1)))
+      _ -> bad "expected [SourceAtParams]"
   | otherwise = bad [i|unknown command #{cmd}|]
   where
     bad :: Text -> IO a
@@ -186,7 +215,7 @@ startTask env (StartParams {..}) = do
   let options = M.insert "format" startFormat (M.union startOptions (envDefaultOptions env))
   task <- Task startTaskId path (toNormalizedUri (Uri startUri)) options
             (fromMaybe 100 startDebounceMs) epoch workDir
-            <$> newTVarIO True <*> newTVarIO ["task started"] <*> newTVarIO False <*> newTVarIO False <*> newTVarIO (S.singleton path) <*> newTVarIO mempty
+            <$> newTVarIO True <*> newTVarIO ["task started"] <*> newTVarIO Nothing <*> newTVarIO Nothing <*> newTVarIO False <*> newTVarIO False <*> newTVarIO (S.singleton path) <*> newTVarIO mempty
             <*> newTVarIO Nothing <*> newTVarIO Nothing <*> newTVarIO 1 <*> newTVarIO Nothing
   atomically $ modifyTVar' (envTasks env) (M.insert startTaskId task)
   worker <- async (runWorker env task)
@@ -238,6 +267,12 @@ renderOnce :: ServerEnv -> Task -> Phase -> IO Bool
 renderOnce env task phase = do
   (entryText, version, overlays) <- snapshotBuffers env task
   reasons <- atomically (swapTVar (taskReasons task) [])
+  edit <- atomically $ case phase of
+    PhaseQuick -> do
+      e <- swapTVar (taskEdit task) Nothing
+      writeTVar (taskRenderedEdit task) e
+      return e
+    PhaseSettle -> readTVar (taskRenderedEdit task)
   let reason = case reasons of
         [] -> Nothing
         _ -> Just (T.intercalate ", " reasons)
@@ -287,7 +322,13 @@ renderOnce env task phase = do
       sendStatus env task StatusErrored phase reason (Just code) (Just ms) []
       return False
     Right (Right result) -> do
-      sent <- publish env task result (map fst overlays) version ms
+      position <- forM edit (uncurry (locatePosition env task)) >>= \case
+        Just (Left err) -> do
+          logLine [i|locating the edit in #{taskId task} failed: #{err}|]
+          return Nothing
+        Just (Right box) -> return box
+        Nothing -> return Nothing
+      sent <- publish env task result position (map fst overlays) version ms
       marker [i|#{label} done in #{showMs ms}: #{fromMaybe "output unchanged, nothing sent" sent}|]
       when (isJust sent) flush
       sendStatus env task StatusReady phase reason Nothing (Just ms) (resultTimings result)
@@ -298,6 +339,17 @@ hashFile path = doesFileExist path >>= \case
   False -> return Nothing
   True -> Just . SHA256.hash <$> B.readFile path
 
+-- | Where a zero-based source position landed in the last output; Nothing without a locate program
+locatePosition :: ServerEnv -> Task -> FilePath -> Position -> IO (Either Text (Maybe PageBox))
+locatePosition env task path (Position line character) = case programLocate (envCommand env) of
+  Nothing -> return (Right Nothing)
+  Just exe -> do
+    source <- workPathFor (taskEntryPath task) (taskWorkDir task) path
+    locate exe (taskEntryPath task) (taskWorkDir task) (taskFormat task) source (fromIntegral line + 1) (fromIntegral character + 1)
+
+taskFormat :: Task -> Text
+taskFormat task = fromMaybe "" (M.lookup "format" (taskOptions task))
+
 showMs :: Double -> Text
 showMs ms = T.pack (show (round ms :: Int)) <> "ms"
 
@@ -323,8 +375,8 @@ snapshotBuffers env task = readTVarIO (envLsp env) >>= \case
 -- | Send the output, as a diff against the last one where possible, and say what was sent (Nothing
 -- when it was identical to the last one). The deps a client should watch on disk leave out the
 -- buffers it sends us itself.
-publish :: ServerEnv -> Task -> RenderResult -> [FilePath] -> Maybe Int32 -> Double -> IO (Maybe Text)
-publish env task (RenderResult {..}) overlayPaths version ms = do
+publish :: ServerEnv -> Task -> RenderResult -> Maybe PageBox -> [FilePath] -> Maybe Int32 -> Double -> IO (Maybe Text)
+publish env task (RenderResult {..}) position overlayPaths version ms = do
   resync <- atomically (swapTVar (taskResync task) False)
   lastOutput <- readTVarIO (taskLast task)
   encoded <- case lastOutput of
@@ -355,6 +407,7 @@ publish env task (RenderResult {..}) overlayPaths version ms = do
         , outputDeps = diskDeps
         , outputRenderMs = ms
         , outputTimings = resultTimings
+        , outputPosition = position
         }
       return $ Just $ case encoding of
         EncodingFull -> [i|sent the full #{B.length bytes}B output as render #{renderId}|]
diff --git a/test-lib/TestLib/Session.hs b/test-lib/TestLib/Session.hs
index 23d3c1e..79d784a 100644
--- a/test-lib/TestLib/Session.hs
+++ b/test-lib/TestLib/Session.hs
@@ -4,12 +4,16 @@ module TestLib.Session (
   , withServer
   , start
   , execute
+  , executeResult
   , whole
+  , insertAt
   ) where
 
 import Control.Lens ((&), (.~))
+import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (Value, toJSON)
+import qualified Data.Aeson as A
 import qualified Data.Map as M
 import Data.String.Interpolate
 import Data.Text (Text)
@@ -72,11 +76,20 @@ start docDir debounceMs options = do
   return doc
 
 execute :: Text -> [Value] -> Session (ExampleT context IO) ()
-execute cmd args = do
+execute cmd args = void (executeResult cmd args)
+
+executeResult :: Text -> [Value] -> Session (ExampleT context IO) Value
+executeResult cmd args = do
   TResponseMessage {_result} <- request SMethod_WorkspaceExecuteCommand (ExecuteCommandParams Nothing cmd (Just args))
   case _result of
     Left err -> liftIO $ expectationFailure [i|#{cmd} failed: #{err}|]
-    Right _ -> return ()
+    Right (InL v) -> return v
+    Right (InR _) -> return A.Null
 
 whole :: Text -> TextDocumentContentChangeEvent
 whole text = TextDocumentContentChangeEvent (InR (TextDocumentContentChangeWholeDocument text))
+
+-- | Insert text at a zero-based line and character
+insertAt :: UInt -> UInt -> Text -> TextDocumentContentChangeEvent
+insertAt line character text = TextDocumentContentChangeEvent (InL (TextDocumentContentChangePartial (Range pos pos) Nothing text))
+  where pos = Position line character
diff --git a/test/Spec/Locate.hs b/test/Spec/Locate.hs
new file mode 100644
index 0000000..1b2e5aa
--- /dev/null
+++ b/test/Spec/Locate.hs
@@ -0,0 +1,87 @@
+module Spec.Locate (tests, main) where
+
+import Control.Monad (void)
+import Data.Aeson (fromJSON, toJSON)
+import qualified Data.Aeson as A
+import Data.String.Interpolate
+import Data.Text (Text)
+import Language.LSP.Protocol.Types (filePathToUri, getUri)
+import Language.LSP.Test
+import Render.Protocol
+import System.FilePath
+import Test.Sandwich
+import TestLib.Events
+import TestLib.Main
+import TestLib.Session
+
+
+tests :: HasBaseContext context => SpecFree context IO ()
+tests = describe "locate" $ do
+  it "puts where the edit landed on the output that answers it" $ do
+    (docDir, script) <- setupDocument
+    locator <- locateScript
+    (first, second) <- withServer docDir ["--render", script, "--locate", locator] $ do
+      doc <- start docDir 50 mempty
+      (_, _, first) <- untilOutput
+      changeDoc doc [insertAt 0 4 "!"]
+      (_, _, second) <- untilOutput
+      return (first, second)
+
+    outputPosition first `shouldBe` Nothing
+    outputPosition second `shouldBe` Just (PageBox 1 1 5 100 10)
+
+  it "sends no position without a locate program" $ do
+    (docDir, script) <- setupDocument
+    out <- withServer docDir ["--render", script] $ do
+      doc <- start docDir 50 mempty
+      void untilOutput
+      changeDoc doc [insertAt 0 4 "!"]
+      (_, _, out) <- untilOutput
+      return out
+
+    outputPosition out `shouldBe` Nothing
+
+  it "answers locate and sourceAt from the last render, through the work directory's paths" $ do
+    (docDir, script) <- setupDocument
+    locator <- locateScript
+    (inEntry, inOverlay, inDisk, source) <- withServer docDir ["--render", script, "--locate", locator] $ do
+      void $ openDoc "inc.txt" "plaintext"
+      void $ start docDir 50 mempty
+      void untilOutput
+      let locateIn name = executeResult commandLocate [toJSON (LocateParams "t1" (uriOf (docDir </> name)) 2 0)]
+      inEntry <- locateIn "main.txt"
+      inOverlay <- locateIn "inc.txt"
+      inDisk <- locateIn "other.txt"
+      source <- executeResult commandSourceAt [toJSON (SourceAtParams "t1" 3 10 20)]
+      return (inEntry, inOverlay, inDisk, source)
+
+    (fromJSON inEntry, fromJSON inOverlay, fromJSON inDisk) `shouldBe` (A.Success (PageBox 3 1 1 100 10), A.Success (PageBox 3 2 1 100 10), A.Success (PageBox 3 3 1 100 10))
+    fromJSON source `shouldBe` A.Success (SourceLocation (uriOf (docDir </> "inc.txt")) 2 6)
+
+main :: IO ()
+main = specMain tests
+
+-- | Forward: the line as the page, which of the work directory's copies the source is as the left
+-- edge, the column as the top. Inverse: line page, column 7, in the open buffer of inc.txt.
+locateScript :: HasBaseContext context => ExampleT context IO FilePath
+locateScript = do
+  Just dir <- getCurrentFolder
+  writeScript dir "locate.sh" [__i|
+    \#!/bin/sh
+    set -e
+    [ -f "$RENDER_OUTPUT" ]
+    case "$RENDER_QUERY" in
+      forward)
+        case "$RENDER_SOURCE" in
+          "$RENDER_WORK"/src/*) kind=1 ;;
+          "$RENDER_WORK"/overlay/*) kind=2 ;;
+          *) kind=3 ;;
+        esac
+        echo "$RENDER_LINE $kind $RENDER_COLUMN 100 10" > "$RENDER_RESULT" ;;
+      inverse)
+        echo "$RENDER_PAGE 7 $RENDER_WORK/overlay/inc.txt" > "$RENDER_RESULT" ;;
+    esac
+  |]
+
+uriOf :: FilePath -> Text
+uriOf = getUri . filePathToUri

From e637bc819578922a7dab66de9d5ea702e2ca051c Mon Sep 17 00:00:00 2001
From: thomasjm <tom@codedown.io>
Date: Sat, 14 Nov 2026 06:17:22 -0800
Subject: [PATCH 2/4] Version 0.1.1.0

---
 CHANGELOG.md                                  | 6 ++++++
 lsp-export-protocol/lsp-export-protocol.cabal | 2 +-
 lsp-export-protocol/package.yaml              | 2 +-
 lsp-export-server.cabal                       | 2 +-
 package.yaml                                  | 2 +-
 5 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index cfc8569..1e3cf80 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Changelog
 
+## 0.1.1.0
+
+- `--locate EXE` names an optional program that maps source positions to places in the output and
+  back. Each output that answers an edit carries where the edit landed (`position`), and
+  `codedown.render.locate` / `codedown.render.sourceAt` answer the same queries on request.
+
 ## 0.1.0.0
 
 - First release. A language server that renders a document from the buffers the client sends and
diff --git a/lsp-export-protocol/lsp-export-protocol.cabal b/lsp-export-protocol/lsp-export-protocol.cabal
index 7e11a50..66f803d 100644
--- a/lsp-export-protocol/lsp-export-protocol.cabal
+++ b/lsp-export-protocol/lsp-export-protocol.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           lsp-export-protocol
-version:        0.1.0.0
+version:        0.1.1.0
 synopsis:       The codedown/render wire protocol spoken by lsp-export-server
 homepage:       https://github.com/codedownio/lsp-export-server#readme
 bug-reports:    https://github.com/codedownio/lsp-export-server/issues
diff --git a/lsp-export-protocol/package.yaml b/lsp-export-protocol/package.yaml
index e9b5317..f90367b 100644
--- a/lsp-export-protocol/package.yaml
+++ b/lsp-export-protocol/package.yaml
@@ -1,5 +1,5 @@
 name:                lsp-export-protocol
-version:             0.1.0.0
+version:             0.1.1.0
 synopsis:            The codedown/render wire protocol spoken by lsp-export-server
 license:             BSD-3-Clause
 github:              codedownio/lsp-export-server
diff --git a/lsp-export-server.cabal b/lsp-export-server.cabal
index 09079db..2b4b19f 100644
--- a/lsp-export-server.cabal
+++ b/lsp-export-server.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           lsp-export-server
-version:        0.1.0.0
+version:        0.1.1.0
 synopsis:       A language server that renders documents from their in-memory buffers
 homepage:       https://github.com/codedownio/lsp-export-server#readme
 bug-reports:    https://github.com/codedownio/lsp-export-server/issues
diff --git a/package.yaml b/package.yaml
index 8ac5e9c..937a4da 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                lsp-export-server
-version:             0.1.0.0
+version:             0.1.1.0
 synopsis:            A language server that renders documents from their in-memory buffers
 license:             BSD-3-Clause
 github:              codedownio/lsp-export-server

From b6fb92f062af0afbcd806e0448ae0da2cb76fa15 Mon Sep 17 00:00:00 2001
From: thomasjm <tom@codedown.io>
Date: Sat, 14 Nov 2026 23:45:10 -0800
Subject: [PATCH 3/4] Trim comments

---
 lsp-export-protocol/src/Render/Protocol.hs | 15 ++++---------
 src/Render/Command.hs                      | 25 ++--------------------
 src/Render/Process.hs                      |  5 +----
 src/Render/Server.hs                       | 22 ++++---------------
 src/Render/Xdelta.hs                       |  4 +---
 test-lib/TestLib/Events.hs                 |  2 --
 test-lib/TestLib/Session.hs                |  8 +------
 test/Spec/Locate.hs                        |  3 +--
 8 files changed, 14 insertions(+), 70 deletions(-)

diff --git a/lsp-export-protocol/src/Render/Protocol.hs b/lsp-export-protocol/src/Render/Protocol.hs
index f947d49..6f88f3c 100644
--- a/lsp-export-protocol/src/Render/Protocol.hs
+++ b/lsp-export-protocol/src/Render/Protocol.hs
@@ -1,7 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
 
--- The wire protocol between a render client (the codedown runner) and this server. Commands go
--- client -> server as workspace/executeCommand; results come back as custom notifications.
 module Render.Protocol (
   commandStart
   , commandStop
@@ -60,14 +58,12 @@ methodStatus = "codedown/render/status"
 methodOutput = "codedown/render/output"
 methodLog = "codedown/render/log"
 
--- Field names are the record field with its prefix dropped, lower-cased: startTaskId -> taskId
 fieldOptions :: Int -> Options
 fieldOptions n = defaultOptions {
   fieldLabelModifier = lowerFirst . drop n
   , omitNothingFields = True
   }
 
--- Constructor names with their prefix dropped, lower-cased: StatusReady -> ready
 tagOptions :: Int -> Options
 tagOptions n = defaultOptions { constructorTagModifier = map toLower . drop n }
 
@@ -97,7 +93,7 @@ newtype RebuildParams = RebuildParams {
 instance ToJSON RebuildParams where toJSON = genericToJSON (fieldOptions 7)
 instance FromJSON RebuildParams where parseJSON = genericParseJSON (fieldOptions 7)
 
--- | A source position, zero-based like LSP positions
+-- | Zero-based
 data LocateParams = LocateParams {
   locateTaskId :: Text
   , locateUri :: Text
@@ -107,7 +103,7 @@ data LocateParams = LocateParams {
 instance ToJSON LocateParams where toJSON = genericToJSON (fieldOptions 6)
 instance FromJSON LocateParams where parseJSON = genericParseJSON (fieldOptions 6)
 
--- | A point on a page of the last output: a one-based page and PDF points from its top-left corner
+-- | One-based page; PDF points from its top-left
 data SourceAtParams = SourceAtParams {
   sourceAtTaskId :: Text
   , sourceAtPage :: Int
@@ -117,7 +113,7 @@ data SourceAtParams = SourceAtParams {
 instance ToJSON SourceAtParams where toJSON = genericToJSON (fieldOptions 8)
 instance FromJSON SourceAtParams where parseJSON = genericParseJSON (fieldOptions 8)
 
--- | Zero-based like LSP positions
+-- | Zero-based
 data SourceLocation = SourceLocation {
   sourceUri :: Text
   , sourceLine :: Int
@@ -126,7 +122,7 @@ data SourceLocation = SourceLocation {
 instance ToJSON SourceLocation where toJSON = genericToJSON (fieldOptions 6)
 instance FromJSON SourceLocation where parseJSON = genericParseJSON (fieldOptions 6)
 
--- | A box on a page of the output: a one-based page, and PDF points from the page's top-left corner
+-- | One-based page; PDF points from its top-left
 data PageBox = PageBox {
   boxPage :: Int
   , boxLeft :: Double
@@ -149,7 +145,6 @@ data Status = StatusRendering | StatusReady | StatusErrored
 instance ToJSON Status where toJSON = genericToJSON (tagOptions 6)
 instance FromJSON Status where parseJSON = genericParseJSON (tagOptions 6)
 
--- | The quick pass runs right after the debounce; the settle pass follows once edits stay quiet
 data Phase = PhaseQuick | PhaseSettle
   deriving (Show, Eq, Generic)
 instance ToJSON Phase where toJSON = genericToJSON (tagOptions 5)
@@ -159,7 +154,6 @@ data StatusParams = StatusParams {
   statusTaskId :: Text
   , statusStatus :: Status
   , statusPhase :: Phase
-  -- | What made the render run, e.g. the edit it answers
   , statusReason :: Maybe Text
   , statusExitCode :: Maybe Int
   , statusRenderMs :: Maybe Double
@@ -192,7 +186,6 @@ data OutputParams = OutputParams {
   , outputDeps :: [FilePath]
   , outputRenderMs :: Double
   , outputTimings :: [Timing]
-  -- | Where the edit this render answers landed in the output
   , outputPosition :: Maybe PageBox
   } deriving (Show, Eq, Generic)
 instance ToJSON OutputParams where toJSON = genericToJSON (fieldOptions 6)
diff --git a/src/Render/Command.hs b/src/Render/Command.hs
index d30deba..1cba93f 100644
--- a/src/Render/Command.hs
+++ b/src/Render/Command.hs
@@ -36,10 +36,6 @@ import UnliftIO (Exception, throwIO)
 import UnliftIO.Temporary (withTempFile)
 
 
--- | The programs that render: one for the quick pass after each edit, and optionally one for the
--- settle pass once edits stay quiet. Each runs in the document's directory with the layout and
--- options in @RENDER_*@ variables and must write @RENDER_OUTPUT@. The optional locate program maps
--- between source positions and places in the last output.
 data Programs = Programs {
   programRender :: FilePath
   , programSettle :: Maybe FilePath
@@ -47,17 +43,13 @@ data Programs = Programs {
   }
 
 data RenderRequest = RenderRequest {
-  -- | The real document, as an absolute path; the render's working directory is its directory
   requestEntryPath :: FilePath
   , requestEntryText :: Text
-  -- | Other open buffers (absolute real paths) that take priority over their disk copies
   , requestOverlays :: [(FilePath, Text)]
-  -- | Private scratch space for this task, kept across renders
   , requestWorkDir :: FilePath
   , requestOptions :: Map Text Text
-  -- | The settle pass rather than the quick one
   , requestSettle :: Bool
-  -- | Unix time for the output's timestamps, kept fixed so unchanged input gives unchanged bytes
+  -- | Fixed, so unchanged input gives unchanged bytes
   , requestEpoch :: Integer
   , requestLog :: LogStream -> Text -> IO ()
   }
@@ -65,7 +57,6 @@ data RenderRequest = RenderRequest {
 data RenderResult = RenderResult {
   resultFileName :: Text
   , resultBytes :: ByteString
-  -- | Absolute paths of every file read, excluding the scratch space and the Nix store
   , resultDeps :: [FilePath]
   , resultTimings :: [Timing]
   }
@@ -76,7 +67,6 @@ data RenderFailure = RenderFailure {
   } deriving (Show)
 instance Exception RenderFailure
 
--- | Lay out the work directory, run the pass's program and collect its output and dependencies.
 render :: Programs -> RenderRequest -> IO RenderResult
 render cmd req@(RenderRequest {..}) = do
   prepareWorkDir req
@@ -134,8 +124,6 @@ logStream = \case
   True -> LogStdout
   False -> LogStderr
 
--- | Lay out the work directory: the entry buffer under @src/@, the other open buffers under
--- @overlay/@ at their paths relative to the entry's directory, and an @out/@ for the output.
 prepareWorkDir :: RenderRequest -> IO ()
 prepareWorkDir (RenderRequest {..}) = do
   let srcDir = requestWorkDir </> "src"
@@ -153,9 +141,7 @@ prepareWorkDir (RenderRequest {..}) = do
       createDirectoryIfMissing True (takeDirectory (overlayDir </> rel))
       T.writeFile (overlayDir </> rel) text
 
--- | The files a render read, as the program reported them (absolute, or relative to the document's
--- directory): the work directory's copies mapped back to the documents they stand for, its other
--- files and the Nix store left out.
+-- | Work directory copies map back to their documents; other work files and the store are dropped
 mapDeps :: FilePath -> FilePath -> FilePath -> [FilePath] -> [FilePath]
 mapDeps entryDir entryPath workDir = nub . concatMap (classify . normalise . absolute)
   where
@@ -173,8 +159,6 @@ mapDeps entryDir entryPath workDir = nub . concatMap (classify . normalise . abs
       | normalise workDir `isPrefixOf` p = []
       | otherwise = [p]
 
--- | Run the locate program forward: a one-based line and column of a file, as the programs see it
--- (see 'workPathFor'), to the box it landed in. Nothing when the program finds no match.
 locate :: FilePath -> FilePath -> FilePath -> Text -> FilePath -> Int -> Int -> IO (Either Text (Maybe PageBox))
 locate exe entryPath workDir format source line column =
   fmap (>>= parseBox) <$> runLocate exe entryPath workDir format [
@@ -188,8 +172,6 @@ locate exe entryPath workDir format source line column =
       [page, left, top, width, height] -> PageBox <$> readMaybe page <*> readMaybe left <*> readMaybe top <*> readMaybe width <*> readMaybe height
       _ -> Nothing
 
--- | Run the locate program inverse: a one-based page and a point on it in PDF points from its
--- top-left corner, to the document, one-based line and column it came from.
 sourceAt :: FilePath -> FilePath -> FilePath -> Text -> Int -> Double -> Double -> IO (Either Text (Maybe (FilePath, Int, Int)))
 sourceAt exe entryPath workDir format page x y =
   fmap (>>= parseSource) <$> runLocate exe entryPath workDir format [
@@ -209,7 +191,6 @@ sourceAt exe entryPath workDir format page x y =
         p -> listToMaybe (mapDeps (takeDirectory entryPath) entryPath workDir [T.unpack p])
       return (source, line', column')
 
--- | The first line the locate program wrote to @RENDER_RESULT@, if any
 runLocate :: FilePath -> FilePath -> FilePath -> Text -> [(String, String)] -> IO (Either Text (Maybe Text))
 runLocate exe entryPath workDir format query = withTempFile workDir "located" $ \resultFile h -> do
   hClose h
@@ -232,8 +213,6 @@ runLocate exe entryPath workDir format query = withTempFile workDir "located" $
       return (Left [i|#{takeFileName exe} exited with code #{n}: #{T.intercalate " / " lastLines}|])
     ExitSuccess -> Right . listToMaybe . filter (not . T.null) . T.lines <$> T.readFile resultFile
 
--- | Where the programs see a document: the entry's copy under @src/@, an open buffer's under
--- @overlay/@ when the last render wrote one, and any other file at its own path.
 workPathFor :: FilePath -> FilePath -> FilePath -> IO FilePath
 workPathFor entryPath workDir path
   | path == entryPath = return (workDir </> "src" </> takeFileName entryPath)
diff --git a/src/Render/Process.hs b/src/Render/Process.hs
index a29f70c..b4e03fd 100644
--- a/src/Render/Process.hs
+++ b/src/Render/Process.hs
@@ -13,9 +13,7 @@ import UnliftIO (IOException, SomeException, bracket, handle, race_, throwIO, wa
 import UnliftIO.Concurrent (threadDelay)
 
 
--- | Run a command in @cwd@ with the given environment, feeding each output line to the callback,
--- and return its exit code. The command runs in its own process group so that a cancellation
--- (an async exception here) ends the whole tree, latexmk's children included.
+-- | In its own process group, so cancelling ends the whole tree
 runCapturing :: FilePath -> [(String, String)] -> FilePath -> [String] -> (Bool -> T.Text -> IO ()) -> IO ExitCode
 runCapturing cwd env exe args onLine = do
   let cp = (proc exe args) {
@@ -42,7 +40,6 @@ runCapturing cwd env exe args onLine = do
   where
     pump h f = handle (\(_ :: IOException) -> return ()) $ forever $ T.hGetLine h >>= f
 
-    -- Only a process that is still running (we were cancelled) needs its group ended
     cleanup (_, mOut, mErr, ph) = do
       getProcessExitCode ph >>= \case
         Just _ -> return ()
diff --git a/src/Render/Server.hs b/src/Render/Server.hs
index 6ef54e1..0bd1941 100644
--- a/src/Render/Server.hs
+++ b/src/Render/Server.hs
@@ -51,19 +51,14 @@ data Task = Task {
   , taskEpoch :: Integer
   , taskWorkDir :: FilePath
   , taskDirty :: TVar Bool
-  -- | What has made the task dirty since the last render started
   , taskReasons :: TVar [Text]
-  -- | Where the last edit landed, until a quick render takes it
   , taskEdit :: TVar (Maybe (FilePath, Position))
-  -- | The edit the last quick render answered, located again by the settle pass
   , taskRenderedEdit :: TVar (Maybe (FilePath, Position))
   , taskPaused :: TVar Bool
   , taskResync :: TVar Bool
   , taskDeps :: TVar (Set FilePath)
-  -- | Content hashes of the on-disk dependencies as of the last render
   , taskDepHashes :: TVar (Map FilePath (Maybe B.ByteString))
   , taskVersion :: TVar (Maybe Int32)
-  -- | The last output announced: its render id and bytes, the base for the next diff
   , taskLast :: TVar (Maybe (Int, B.ByteString))
   , taskNextRenderId :: TVar Int
   , taskWorker :: TVar (Maybe (Async ()))
@@ -77,7 +72,6 @@ data ServerEnv = ServerEnv {
   , envLsp :: TVar (Maybe (LanguageContextEnv ()))
   }
 
--- | Serve on stdio until the client exits us. Returns the exit code.
 runRenderServer :: Programs -> FilePath -> Map Text Text -> IO Int
 runRenderServer command workRoot defaultOpts = do
   env <- ServerEnv command workRoot defaultOpts <$> newTVarIO mempty <*> newTVarIO Nothing
@@ -115,7 +109,7 @@ handlers env = mconcat [
   , notificationHandler SMethod_TextDocumentDidSave $ \_ -> return ()
   , notificationHandler SMethod_WorkspaceDidChangeConfiguration $ \_ -> return ()
   , notificationHandler SMethod_CancelRequest $ \_ -> return ()
-  -- The lsp library always advertises semantic tokens; answer with nothing rather than an error
+  -- lsp always advertises semantic tokens
   , requestHandler SMethod_TextDocumentSemanticTokensFull $ \_ respond -> respond (Right (InR Null))
   , requestHandler SMethod_WorkspaceExecuteCommand $ \req respond -> do
       let args = fromMaybe [] (req ^. L.params . L.arguments)
@@ -126,7 +120,6 @@ handlers env = mconcat [
         Right (Just v) -> Right (InL v)
   ]
 
--- An edit to a task's entry or to one of its dependencies means a render is due
 documentTouched :: ServerEnv -> Uri -> Maybe Int32 -> Maybe Position -> IO ()
 documentTouched env uri version position = case uriToFilePath uri of
   Nothing -> return ()
@@ -140,7 +133,6 @@ documentTouched env uri version position = case uriToFilePath uri of
         forM_ position $ \pos -> atomically (writeTVar (taskEdit task) (Just (path, pos)))
         markDirty task [i|edit to #{takeFileName path}#{maybe "" (\v -> " (v" <> show v <> ")") version}|]
 
--- | Where the last ranged change starts; Nothing for a whole-document replacement
 lastEditPosition :: [TextDocumentContentChangeEvent] -> Maybe Position
 lastEditPosition changes = listToMaybe [ partial ^. L.range . L.start | TextDocumentContentChangeEvent (InL partial) <- reverse changes ]
 
@@ -151,7 +143,6 @@ executeCommand env cmd args
       _ -> bad "expected [StartParams]"
   | cmd == commandStop = withTaskArg $ \task -> stopTask env task
   | cmd == commandRebuild = withTaskArg $ \task -> do
-      -- A rebuild is only worth doing when some dependency's content actually changed
       known <- readTVarIO (taskDepHashes task)
       changed <- filterM (\(path, h) -> (/= h) <$> hashFile path) (M.toList known)
       case changed of
@@ -235,8 +226,6 @@ stopTask env task = do
     False -> return ()
   logLine [i|stopped task #{taskId task}|]
 
--- Render whenever the task is dirty and unpaused: a quick pass once edits go quiet for the
--- debounce period, then a settling build once they go quiet for longer.
 runWorker :: ServerEnv -> Task -> IO ()
 runWorker env task = forever $ do
   atomically $ do
@@ -262,7 +251,7 @@ runWorker env task = forever $ do
 settleQuietMs :: Int
 settleQuietMs = 1500
 
--- | One render of the current buffers. False when it was superseded by an edit or failed.
+-- | False when superseded by an edit or failed
 renderOnce :: ServerEnv -> Task -> Phase -> IO Bool
 renderOnce env task phase = do
   (entryText, version, overlays) <- snapshotBuffers env task
@@ -279,7 +268,7 @@ renderOnce env task phase = do
   let label = case phase of
         PhaseQuick -> "quick render" :: Text
         PhaseSettle -> "settle pass"
-  -- The settle pass stays out of the log unless it fails or changes the output
+  -- The settle pass logs only when it fails or changes the output
   buffered <- newTVarIO ([] :: [(LogStream, Text)])
   let logFn stream text = case phase of
         PhaseQuick -> sendLog env task stream text False
@@ -339,7 +328,6 @@ hashFile path = doesFileExist path >>= \case
   False -> return Nothing
   True -> Just . SHA256.hash <$> B.readFile path
 
--- | Where a zero-based source position landed in the last output; Nothing without a locate program
 locatePosition :: ServerEnv -> Task -> FilePath -> Position -> IO (Either Text (Maybe PageBox))
 locatePosition env task path (Position line character) = case programLocate (envCommand env) of
   Nothing -> return (Right Nothing)
@@ -372,9 +360,7 @@ snapshotBuffers env task = readTVarIO (envLsp env) >>= \case
       text <- T.readFile (taskEntryPath task)
       return (text, Nothing, [])
 
--- | Send the output, as a diff against the last one where possible, and say what was sent (Nothing
--- when it was identical to the last one). The deps a client should watch on disk leave out the
--- buffers it sends us itself.
+-- | Nothing when the output is unchanged
 publish :: ServerEnv -> Task -> RenderResult -> Maybe PageBox -> [FilePath] -> Maybe Int32 -> Double -> IO (Maybe Text)
 publish env task (RenderResult {..}) position overlayPaths version ms = do
   resync <- atomically (swapTVar (taskResync task) False)
diff --git a/src/Render/Xdelta.hs b/src/Render/Xdelta.hs
index e6aad44..f8109f7 100644
--- a/src/Render/Xdelta.hs
+++ b/src/Render/Xdelta.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 
--- Binary diffs with the vendored xdelta3 (cbits/), in VCDIFF
 module Render.Xdelta (
   encode
   , decode
@@ -20,13 +19,12 @@ foreign import ccall "xdelta3.h xd3_encode_memory"
 foreign import ccall "xdelta3.h xd3_decode_memory"
   c_xd3_decode_memory :: Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> CSize -> CInt -> IO CInt
 
--- | @encode new old@ is the patch taking @old@ to @new@; empty when they are equal.
+-- | @encode new old@ is the patch taking @old@ to @new@
 encode :: ByteString -> ByteString -> IO (Either String ByteString)
 encode new old
   | new == old = return (Right B.empty)
   | otherwise = call c_xd3_encode_memory new old (max 1024 (B.length new + B.length old + 1024))
 
--- | @decode patch old@ rebuilds the bytes @encode@ was given.
 decode :: ByteString -> ByteString -> IO (Either String ByteString)
 decode patch old
   | B.null patch = return (Right old)
diff --git a/test-lib/TestLib/Events.hs b/test-lib/TestLib/Events.hs
index ddc6587..24ff3af 100644
--- a/test-lib/TestLib/Events.hs
+++ b/test-lib/TestLib/Events.hs
@@ -42,7 +42,6 @@ classify = \case
       A.Success x -> f x
       A.Error _ -> EvOther
 
--- | The statuses and log lines up to the next output, and the output.
 untilOutput :: Session (ExampleT context IO) ([StatusParams], [LogParams], OutputParams)
 untilOutput = go [] []
   where
@@ -53,7 +52,6 @@ untilOutput = go [] []
       EvLog l -> go statuses (l : logs)
       EvOther -> go statuses logs
 
--- | The log lines up to the first status matching the predicate, and that status.
 untilStatus :: (StatusParams -> Bool) -> Session (ExampleT context IO) ([LogParams], StatusParams)
 untilStatus p = go []
   where
diff --git a/test-lib/TestLib/Session.hs b/test-lib/TestLib/Session.hs
index 79d784a..2189d79 100644
--- a/test-lib/TestLib/Session.hs
+++ b/test-lib/TestLib/Session.hs
@@ -29,8 +29,6 @@ import System.Process (proc)
 import Test.Sandwich
 
 
--- | A document directory with main.txt and inc.txt, and a render program that concatenates them
--- (the open buffer of inc.txt if there is one), appends the phase, and reports what it read.
 setupDocument :: HasBaseContext context => ExampleT context IO (FilePath, FilePath)
 setupDocument = do
   Just dir <- getCurrentFolder
@@ -58,16 +56,13 @@ writeScript dir name body = liftIO $ do
   getPermissions path >>= setPermissions path . setOwnerExecutable True
   return path
 
--- | Runs the built server on the given document directory. The client does not offer
--- workspace/configuration: lsp-test answers that request from its listener thread while the session
--- thread is still writing, and the two writes interleave on the server's stdin.
+-- | No workspace/configuration: lsp-test's answer to it interleaves with our writes on stdin
 withServer :: FilePath -> [String] -> Session (ExampleT context IO) a -> ExampleT context IO a
 withServer root args = runSessionWithConfig config (proc "lsp-export-server" ("serve" : args)) caps root
   where
     config = defaultConfig { messageTimeout = 20 }
     caps = fullLatestClientCaps & L.workspace . traverse . L.configuration .~ Just False
 
--- | Opens main.txt and starts task t1 on it.
 start :: FilePath -> Int -> M.Map Text Text -> Session (ExampleT context IO) TextDocumentIdentifier
 start docDir debounceMs options = do
   doc <- openDoc "main.txt" "plaintext"
@@ -89,7 +84,6 @@ executeResult cmd args = do
 whole :: Text -> TextDocumentContentChangeEvent
 whole text = TextDocumentContentChangeEvent (InR (TextDocumentContentChangeWholeDocument text))
 
--- | Insert text at a zero-based line and character
 insertAt :: UInt -> UInt -> Text -> TextDocumentContentChangeEvent
 insertAt line character text = TextDocumentContentChangeEvent (InL (TextDocumentContentChangePartial (Range pos pos) Nothing text))
   where pos = Position line character
diff --git a/test/Spec/Locate.hs b/test/Spec/Locate.hs
index 1b2e5aa..e3bc097 100644
--- a/test/Spec/Locate.hs
+++ b/test/Spec/Locate.hs
@@ -61,8 +61,7 @@ tests = describe "locate" $ do
 main :: IO ()
 main = specMain tests
 
--- | Forward: the line as the page, which of the work directory's copies the source is as the left
--- edge, the column as the top. Inverse: line page, column 7, in the open buffer of inc.txt.
+-- | Forward answers page=line, left=1/2/3 for src/overlay/disk, top=column
 locateScript :: HasBaseContext context => ExampleT context IO FilePath
 locateScript = do
   Just dir <- getCurrentFolder

From be28f7506c0d1cc8f2df4cd51530081bf901ca9a Mon Sep 17 00:00:00 2001
From: thomasjm <tom@codedown.io>
Date: Sat, 14 Nov 2026 23:48:06 -0800
Subject: [PATCH 4/4] Split Render.Server into Render.Server.* modules

---
 lsp-export-server.cabal       |   4 +
 src/Render/Server.hs          | 337 +---------------------------------
 src/Render/Server/Commands.hs | 109 +++++++++++
 src/Render/Server/Env.hs      |  89 +++++++++
 src/Render/Server/Publish.hs  |  65 +++++++
 src/Render/Server/Worker.hs   | 153 +++++++++++++++
 6 files changed, 424 insertions(+), 333 deletions(-)
 create mode 100644 src/Render/Server/Commands.hs
 create mode 100644 src/Render/Server/Env.hs
 create mode 100644 src/Render/Server/Publish.hs
 create mode 100644 src/Render/Server/Worker.hs

diff --git a/lsp-export-server.cabal b/lsp-export-server.cabal
index 2b4b19f..0979f93 100644
--- a/lsp-export-server.cabal
+++ b/lsp-export-server.cabal
@@ -40,6 +40,10 @@ library
       Render.Command
       Render.Process
       Render.Server
+      Render.Server.Commands
+      Render.Server.Env
+      Render.Server.Publish
+      Render.Server.Worker
       Render.Xdelta
   other-modules:
       Paths_lsp_export_server
diff --git a/src/Render/Server.hs b/src/Render/Server.hs
index 0bd1941..76ac57c 100644
--- a/src/Render/Server.hs
+++ b/src/Render/Server.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeOperators #-}
-
 module Render.Server (
   runRenderServer
   ) where
@@ -7,71 +5,26 @@ module Render.Server (
 import Control.Lens ((^.))
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.STM (check)
-import qualified Crypto.Hash.SHA256 as SHA256
-import Data.Aeson (Result(..), Value, fromJSON, toJSON)
-import qualified Data.Aeson as A
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Base64 as B64
 import Data.Map (Map)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe, isJust, listToMaybe)
-import Data.Proxy
-import Data.Set (Set)
+import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Set as S
 import Data.String.Interpolate
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
-import Data.Time
-import Data.Time.Clock.POSIX (getPOSIXTime)
 import qualified Language.LSP.Protocol.Lens as L
 import Language.LSP.Protocol.Message
 import Language.LSP.Protocol.Types
 import Language.LSP.Server
-import Language.LSP.VFS
 import Render.Command
 import Render.Protocol
-import qualified Render.Xdelta as Xdelta
-import System.Directory
+import Render.Server.Commands
+import Render.Server.Env
 import System.FilePath
-import System.IO (hPutStrLn, stderr)
-import UnliftIO (Async, SomeException, async, cancel, fromException, race, try)
-import UnliftIO.Concurrent (threadDelay)
+import UnliftIO (SomeException, try)
 import UnliftIO.STM
 
 
-data Task = Task {
-  taskId :: Text
-  , taskEntryPath :: FilePath
-  , taskEntryUri :: NormalizedUri
-  , taskOptions :: Map Text Text
-  , taskDebounceMs :: Int
-  , taskEpoch :: Integer
-  , taskWorkDir :: FilePath
-  , taskDirty :: TVar Bool
-  , taskReasons :: TVar [Text]
-  , taskEdit :: TVar (Maybe (FilePath, Position))
-  , taskRenderedEdit :: TVar (Maybe (FilePath, Position))
-  , taskPaused :: TVar Bool
-  , taskResync :: TVar Bool
-  , taskDeps :: TVar (Set FilePath)
-  , taskDepHashes :: TVar (Map FilePath (Maybe B.ByteString))
-  , taskVersion :: TVar (Maybe Int32)
-  , taskLast :: TVar (Maybe (Int, B.ByteString))
-  , taskNextRenderId :: TVar Int
-  , taskWorker :: TVar (Maybe (Async ()))
-  }
-
-data ServerEnv = ServerEnv {
-  envCommand :: Programs
-  , envWorkRoot :: FilePath
-  , envDefaultOptions :: Map Text Text
-  , envTasks :: TVar (Map Text Task)
-  , envLsp :: TVar (Maybe (LanguageContextEnv ()))
-  }
-
 runRenderServer :: Programs -> FilePath -> Map Text Text -> IO Int
 runRenderServer command workRoot defaultOpts = do
   env <- ServerEnv command workRoot defaultOpts <$> newTVarIO mempty <*> newTVarIO Nothing
@@ -135,285 +88,3 @@ documentTouched env uri version position = case uriToFilePath uri of
 
 lastEditPosition :: [TextDocumentContentChangeEvent] -> Maybe Position
 lastEditPosition changes = listToMaybe [ partial ^. L.range . L.start | TextDocumentContentChangeEvent (InL partial) <- reverse changes ]
-
-executeCommand :: ServerEnv -> Text -> [Value] -> IO (Maybe Value)
-executeCommand env cmd args
-  | cmd == commandStart = case args of
-      [v] | Success (params :: StartParams) <- fromJSON v -> Just . toJSON <$> startTask env params
-      _ -> bad "expected [StartParams]"
-  | cmd == commandStop = withTaskArg $ \task -> stopTask env task
-  | cmd == commandRebuild = withTaskArg $ \task -> do
-      known <- readTVarIO (taskDepHashes task)
-      changed <- filterM (\(path, h) -> (/= h) <$> hashFile path) (M.toList known)
-      case changed of
-        [] -> logLine [i|rebuild of #{taskId task} requested, but no known dependency changed on disk|]
-        _ -> markDirty task [i|#{T.intercalate ", " [T.pack (takeFileName p) | (p, _) <- changed]} changed on disk|]
-  | cmd == commandSetPaused = case args of
-      [tid, pausedV] | Success (tid' :: Text) <- fromJSON tid, Success (paused :: Bool) <- fromJSON pausedV ->
-        lookupTask tid' >>= mapM_ (\task -> atomically (writeTVar (taskPaused task) paused)) >> return Nothing
-      _ -> bad "expected [taskId, bool]"
-  | cmd == commandResync = withTaskArg $ \task -> do
-      atomically (writeTVar (taskResync task) True)
-      markDirty task "full output requested by the client"
-  | cmd == commandLocate = case args of
-      [v] | Success (LocateParams {..}) <- fromJSON v -> lookupTask locateTaskId >>= \case
-        Nothing -> return Nothing
-        Just task -> case uriToFilePath (Uri locateUri) of
-          Nothing -> bad [i|not a file uri: #{locateUri}|]
-          Just path -> locatePosition env task path (Position (fromIntegral locateLine) (fromIntegral locateCharacter)) >>= \case
-            Left err -> bad err
-            Right box -> return (toJSON <$> box)
-      _ -> bad "expected [LocateParams]"
-  | cmd == commandSourceAt = case args of
-      [v] | Success (SourceAtParams {..}) <- fromJSON v -> lookupTask sourceAtTaskId >>= \case
-        Nothing -> return Nothing
-        Just task -> case programLocate (envCommand env) of
-          Nothing -> return Nothing
-          Just exe -> sourceAt exe (taskEntryPath task) (taskWorkDir task) (taskFormat task) sourceAtPage sourceAtX sourceAtY >>= \case
-            Left err -> bad err
-            Right found -> return $ flip fmap found $ \(path, line, column) ->
-              toJSON (SourceLocation (getUri (filePathToUri path)) (max 0 (line - 1)) (max 0 (column - 1)))
-      _ -> bad "expected [SourceAtParams]"
-  | otherwise = bad [i|unknown command #{cmd}|]
-  where
-    bad :: Text -> IO a
-    bad msg = ioError (userError (T.unpack msg))
-
-    lookupTask tid = M.lookup tid <$> readTVarIO (envTasks env)
-
-    withTaskArg f = case args of
-      (tid : _) | Success (tid' :: Text) <- fromJSON tid -> do
-        lookupTask tid' >>= mapM_ f
-        return Nothing
-      _ -> bad "expected [taskId]"
-
-markDirty :: Task -> Text -> IO ()
-markDirty task reason = atomically $ do
-  writeTVar (taskDirty task) True
-  modifyTVar' (taskReasons task) (<> [reason])
-
-startTask :: ServerEnv -> StartParams -> IO StartResult
-startTask env (StartParams {..}) = do
-  path <- case uriToFilePath (Uri startUri) of
-    Just p -> return p
-    Nothing -> ioError (userError [i|not a file uri: #{startUri}|])
-  existing <- M.lookup startTaskId <$> readTVarIO (envTasks env)
-  mapM_ (stopTask env) existing
-
-  let workDir = envWorkRoot env </> T.unpack (T.map safeChar startTaskId)
-  createDirectoryIfMissing True workDir
-  epoch <- round <$> getPOSIXTime
-  let options = M.insert "format" startFormat (M.union startOptions (envDefaultOptions env))
-  task <- Task startTaskId path (toNormalizedUri (Uri startUri)) options
-            (fromMaybe 100 startDebounceMs) epoch workDir
-            <$> newTVarIO True <*> newTVarIO ["task started"] <*> newTVarIO Nothing <*> newTVarIO Nothing <*> newTVarIO False <*> newTVarIO False <*> newTVarIO (S.singleton path) <*> newTVarIO mempty
-            <*> newTVarIO Nothing <*> newTVarIO Nothing <*> newTVarIO 1 <*> newTVarIO Nothing
-  atomically $ modifyTVar' (envTasks env) (M.insert startTaskId task)
-  worker <- async (runWorker env task)
-  atomically $ writeTVar (taskWorker task) (Just worker)
-  logLine [i|started task #{startTaskId} for #{path} (debounce #{taskDebounceMs task}ms)|]
-  return (StartResult startTaskId)
-  where
-    safeChar c | c `elem` ['a'..'z'] || c `elem` ['A'..'Z'] || c `elem` ['0'..'9'] || c `elem` ("-_" :: String) = c
-               | otherwise = '_'
-
-stopTask :: ServerEnv -> Task -> IO ()
-stopTask env task = do
-  atomically $ modifyTVar' (envTasks env) (M.delete (taskId task))
-  readTVarIO (taskWorker task) >>= mapM_ cancel
-  doesDirectoryExist (taskWorkDir task) >>= \case
-    True -> removeDirectoryRecursive (taskWorkDir task)
-    False -> return ()
-  logLine [i|stopped task #{taskId task}|]
-
-runWorker :: ServerEnv -> Task -> IO ()
-runWorker env task = forever $ do
-  atomically $ do
-    dirty <- readTVar (taskDirty task)
-    paused <- readTVar (taskPaused task)
-    check (dirty && not paused)
-  atomically $ writeTVar (taskDirty task) False
-  threadDelay (taskDebounceMs task * 1000)
-  readTVarIO (taskDirty task) >>= \case
-    True -> return ()
-    False -> renderOnce env task PhaseQuick >>= \case
-      False -> return ()
-      True -> case programSettle (envCommand env) of
-        Nothing -> return ()
-        Just _ -> quietFor settleQuietMs >>= \case
-          False -> return ()
-          True -> void (renderOnce env task PhaseSettle)
-  where
-    quietFor ms = race (threadDelay (ms * 1000)) (atomically (readTVar (taskDirty task) >>= check)) >>= \case
-      Left () -> return True
-      Right () -> return False
-
-settleQuietMs :: Int
-settleQuietMs = 1500
-
--- | False when superseded by an edit or failed
-renderOnce :: ServerEnv -> Task -> Phase -> IO Bool
-renderOnce env task phase = do
-  (entryText, version, overlays) <- snapshotBuffers env task
-  reasons <- atomically (swapTVar (taskReasons task) [])
-  edit <- atomically $ case phase of
-    PhaseQuick -> do
-      e <- swapTVar (taskEdit task) Nothing
-      writeTVar (taskRenderedEdit task) e
-      return e
-    PhaseSettle -> readTVar (taskRenderedEdit task)
-  let reason = case reasons of
-        [] -> Nothing
-        _ -> Just (T.intercalate ", " reasons)
-  let label = case phase of
-        PhaseQuick -> "quick render" :: Text
-        PhaseSettle -> "settle pass"
-  -- The settle pass logs only when it fails or changes the output
-  buffered <- newTVarIO ([] :: [(LogStream, Text)])
-  let logFn stream text = case phase of
-        PhaseQuick -> sendLog env task stream text False
-        PhaseSettle -> atomically (modifyTVar' buffered ((stream, text) :))
-  let marker text = logFn LogStdout ("── " <> text)
-  let flush = do
-        lines' <- reverse <$> atomically (swapTVar buffered [])
-        forM_ lines' $ \(stream, text) -> sendLog env task stream text False
-  case phase of
-    PhaseQuick -> do
-      sendStatus env task StatusRendering phase reason Nothing Nothing []
-      sendLog env task LogStdout "" True
-      marker [i|#{label}: #{fromMaybe "no reason recorded" reason}|]
-    PhaseSettle -> marker [i|#{label} after #{settleQuietMs}ms without edits|]
-  start <- getCurrentTime
-  let request = RenderRequest {
-        requestEntryPath = taskEntryPath task
-        , requestEntryText = entryText
-        , requestOverlays = overlays
-        , requestWorkDir = taskWorkDir task
-        , requestOptions = taskOptions task
-        , requestSettle = phase == PhaseSettle
-        , requestEpoch = taskEpoch task
-        , requestLog = logFn
-        }
-  outcome <- race (atomically (readTVar (taskDirty task) >>= check)) (try (render (envCommand env) request))
-  end <- getCurrentTime
-  let ms = realToFrac (diffUTCTime end start) * 1000 :: Double
-  case outcome of
-    Left () -> do
-      marker [i|#{label} cancelled after #{showMs ms}: a new edit arrived|]
-      return False
-    Right (Left (e :: SomeException)) -> do
-      let (code, msg) = case fromException e of
-            Just (RenderFailure c m) -> (c, m)
-            Nothing -> (-1, T.pack (show e))
-      logFn LogStderr msg
-      marker [i|#{label} failed after #{showMs ms}|]
-      flush
-      sendStatus env task StatusErrored phase reason (Just code) (Just ms) []
-      return False
-    Right (Right result) -> do
-      position <- forM edit (uncurry (locatePosition env task)) >>= \case
-        Just (Left err) -> do
-          logLine [i|locating the edit in #{taskId task} failed: #{err}|]
-          return Nothing
-        Just (Right box) -> return box
-        Nothing -> return Nothing
-      sent <- publish env task result position (map fst overlays) version ms
-      marker [i|#{label} done in #{showMs ms}: #{fromMaybe "output unchanged, nothing sent" sent}|]
-      when (isJust sent) flush
-      sendStatus env task StatusReady phase reason Nothing (Just ms) (resultTimings result)
-      return True
-
-hashFile :: FilePath -> IO (Maybe B.ByteString)
-hashFile path = doesFileExist path >>= \case
-  False -> return Nothing
-  True -> Just . SHA256.hash <$> B.readFile path
-
-locatePosition :: ServerEnv -> Task -> FilePath -> Position -> IO (Either Text (Maybe PageBox))
-locatePosition env task path (Position line character) = case programLocate (envCommand env) of
-  Nothing -> return (Right Nothing)
-  Just exe -> do
-    source <- workPathFor (taskEntryPath task) (taskWorkDir task) path
-    locate exe (taskEntryPath task) (taskWorkDir task) (taskFormat task) source (fromIntegral line + 1) (fromIntegral character + 1)
-
-taskFormat :: Task -> Text
-taskFormat task = fromMaybe "" (M.lookup "format" (taskOptions task))
-
-showMs :: Double -> Text
-showMs ms = T.pack (show (round ms :: Int)) <> "ms"
-
-snapshotBuffers :: ServerEnv -> Task -> IO (Text, Maybe Int32, [(FilePath, Text)])
-snapshotBuffers env task = readTVarIO (envLsp env) >>= \case
-  Nothing -> fromDisk
-  Just lspEnv -> runLspT lspEnv $ do
-    vfs <- getVirtualFiles
-    let overlays = [ (p, virtualFileText vf)
-                   | (uri, Open vf) <- M.toList (vfs ^. vfsMap)
-                   , uri /= taskEntryUri task
-                   , Just p <- [uriToFilePath (fromNormalizedUri uri)] ]
-    getVirtualFile (taskEntryUri task) >>= \case
-      Just vf -> return (virtualFileText vf, Just (virtualFileVersion vf), overlays)
-      Nothing -> do
-        (text, v, _) <- liftIO fromDisk
-        return (text, v, overlays)
-  where
-    fromDisk = do
-      text <- T.readFile (taskEntryPath task)
-      return (text, Nothing, [])
-
--- | Nothing when the output is unchanged
-publish :: ServerEnv -> Task -> RenderResult -> Maybe PageBox -> [FilePath] -> Maybe Int32 -> Double -> IO (Maybe Text)
-publish env task (RenderResult {..}) position overlayPaths version ms = do
-  resync <- atomically (swapTVar (taskResync task) False)
-  lastOutput <- readTVarIO (taskLast task)
-  encoded <- case lastOutput of
-    Just (_, baseBytes) | not resync, baseBytes == resultBytes -> return Nothing
-    Just (baseId, baseBytes) | not resync -> Xdelta.encode resultBytes baseBytes >>= \case
-      Right patch -> return (Just (EncodingXdelta3, Just baseId, patch))
-      Left err -> do
-        logLine [i|xdelta3 failed, sending a full output: #{err}|]
-        return (Just (EncodingFull, Nothing, resultBytes))
-    _ -> return (Just (EncodingFull, Nothing, resultBytes))
-
-  let diskDeps = filter (`notElem` (taskEntryPath task : overlayPaths)) resultDeps
-  hashes <- M.fromList <$> mapM (\p -> (p,) <$> hashFile p) diskDeps
-  atomically $ do
-    writeTVar (taskDeps task) (S.fromList (taskEntryPath task : resultDeps))
-    writeTVar (taskDepHashes task) hashes
-  case encoded of
-    Nothing -> return Nothing
-    Just (encoding, baseId, bytes) -> do
-      renderId <- atomically $ stateTVar (taskNextRenderId task) (\n -> (n, n + 1))
-      atomically $ writeTVar (taskLast task) (Just (renderId, resultBytes))
-      send env methodOutput $ OutputParams {
-        outputTaskId = taskId task
-        , outputRenderId = renderId
-        , outputBaseRenderId = baseId
-        , outputDocumentVersion = version
-        , outputFiles = [OutputFile resultFileName encoding (T.decodeUtf8 (B64.encode bytes)) (B.length resultBytes)]
-        , outputDeps = diskDeps
-        , outputRenderMs = ms
-        , outputTimings = resultTimings
-        , outputPosition = position
-        }
-      return $ Just $ case encoding of
-        EncodingFull -> [i|sent the full #{B.length bytes}B output as render #{renderId}|]
-        EncodingXdelta3 -> [i|output changed, sent a #{B.length bytes}B diff as render #{renderId}|]
-
-sendStatus :: ServerEnv -> Task -> Status -> Phase -> Maybe Text -> Maybe Int -> Maybe Double -> [Timing] -> IO ()
-sendStatus env task status phase reason code ms timings =
-  send env methodStatus (StatusParams (taskId task) status phase reason code ms timings)
-
-sendLog :: ServerEnv -> Task -> LogStream -> Text -> Bool -> IO ()
-sendLog env task stream text clear = send env methodLog (LogParams (taskId task) stream text clear)
-
-send :: A.ToJSON a => ServerEnv -> Text -> a -> IO ()
-send env method params = readTVarIO (envLsp env) >>= \case
-  Nothing -> return ()
-  Just lspEnv -> runLspT lspEnv $ case method of
-    "codedown/render/status" -> sendNotification (SMethod_CustomMethod (Proxy @"codedown/render/status")) (toJSON params)
-    "codedown/render/output" -> sendNotification (SMethod_CustomMethod (Proxy @"codedown/render/output")) (toJSON params)
-    "codedown/render/log" -> sendNotification (SMethod_CustomMethod (Proxy @"codedown/render/log")) (toJSON params)
-    _ -> return ()
-
-logLine :: Text -> IO ()
-logLine = hPutStrLn stderr . T.unpack . ("lsp-export-server: " <>)
diff --git a/src/Render/Server/Commands.hs b/src/Render/Server/Commands.hs
new file mode 100644
index 0000000..5c5317f
--- /dev/null
+++ b/src/Render/Server/Commands.hs
@@ -0,0 +1,109 @@
+module Render.Server.Commands (
+  executeCommand
+  ) where
+
+import Control.Monad
+import Data.Aeson (Result(..), Value, fromJSON, toJSON)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as S
+import Data.String.Interpolate
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Clock.POSIX (getPOSIXTime)
+import Language.LSP.Protocol.Types
+import Render.Command
+import Render.Protocol
+import Render.Server.Env
+import Render.Server.Publish
+import Render.Server.Worker
+import System.Directory
+import System.FilePath
+import UnliftIO (async, cancel)
+import UnliftIO.STM
+
+
+executeCommand :: ServerEnv -> Text -> [Value] -> IO (Maybe Value)
+executeCommand env cmd args
+  | cmd == commandStart = case args of
+      [v] | Success (params :: StartParams) <- fromJSON v -> Just . toJSON <$> startTask env params
+      _ -> bad "expected [StartParams]"
+  | cmd == commandStop = withTaskArg $ \task -> stopTask env task
+  | cmd == commandRebuild = withTaskArg $ \task -> do
+      known <- readTVarIO (taskDepHashes task)
+      changed <- filterM (\(path, h) -> (/= h) <$> hashFile path) (M.toList known)
+      case changed of
+        [] -> logLine [i|rebuild of #{taskId task} requested, but no known dependency changed on disk|]
+        _ -> markDirty task [i|#{T.intercalate ", " [T.pack (takeFileName p) | (p, _) <- changed]} changed on disk|]
+  | cmd == commandSetPaused = case args of
+      [tid, pausedV] | Success (tid' :: Text) <- fromJSON tid, Success (paused :: Bool) <- fromJSON pausedV ->
+        lookupTask tid' >>= mapM_ (\task -> atomically (writeTVar (taskPaused task) paused)) >> return Nothing
+      _ -> bad "expected [taskId, bool]"
+  | cmd == commandResync = withTaskArg $ \task -> do
+      atomically (writeTVar (taskResync task) True)
+      markDirty task "full output requested by the client"
+  | cmd == commandLocate = case args of
+      [v] | Success (LocateParams {..}) <- fromJSON v -> lookupTask locateTaskId >>= \case
+        Nothing -> return Nothing
+        Just task -> case uriToFilePath (Uri locateUri) of
+          Nothing -> bad [i|not a file uri: #{locateUri}|]
+          Just path -> locatePosition env task path (Position (fromIntegral locateLine) (fromIntegral locateCharacter)) >>= \case
+            Left err -> bad err
+            Right box -> return (toJSON <$> box)
+      _ -> bad "expected [LocateParams]"
+  | cmd == commandSourceAt = case args of
+      [v] | Success (SourceAtParams {..}) <- fromJSON v -> lookupTask sourceAtTaskId >>= \case
+        Nothing -> return Nothing
+        Just task -> case programLocate (envCommand env) of
+          Nothing -> return Nothing
+          Just exe -> sourceAt exe (taskEntryPath task) (taskWorkDir task) (taskFormat task) sourceAtPage sourceAtX sourceAtY >>= \case
+            Left err -> bad err
+            Right found -> return $ flip fmap found $ \(path, line, column) ->
+              toJSON (SourceLocation (getUri (filePathToUri path)) (max 0 (line - 1)) (max 0 (column - 1)))
+      _ -> bad "expected [SourceAtParams]"
+  | otherwise = bad [i|unknown command #{cmd}|]
+  where
+    bad :: Text -> IO a
+    bad msg = ioError (userError (T.unpack msg))
+
+    lookupTask tid = M.lookup tid <$> readTVarIO (envTasks env)
+
+    withTaskArg f = case args of
+      (tid : _) | Success (tid' :: Text) <- fromJSON tid -> do
+        lookupTask tid' >>= mapM_ f
+        return Nothing
+      _ -> bad "expected [taskId]"
+
+startTask :: ServerEnv -> StartParams -> IO StartResult
+startTask env (StartParams {..}) = do
+  path <- case uriToFilePath (Uri startUri) of
+    Just p -> return p
+    Nothing -> ioError (userError [i|not a file uri: #{startUri}|])
+  existing <- M.lookup startTaskId <$> readTVarIO (envTasks env)
+  mapM_ (stopTask env) existing
+
+  let workDir = envWorkRoot env </> T.unpack (T.map safeChar startTaskId)
+  createDirectoryIfMissing True workDir
+  epoch <- round <$> getPOSIXTime
+  let options = M.insert "format" startFormat (M.union startOptions (envDefaultOptions env))
+  task <- Task startTaskId path (toNormalizedUri (Uri startUri)) options
+            (fromMaybe 100 startDebounceMs) epoch workDir
+            <$> newTVarIO True <*> newTVarIO ["task started"] <*> newTVarIO Nothing <*> newTVarIO Nothing <*> newTVarIO False <*> newTVarIO False <*> newTVarIO (S.singleton path) <*> newTVarIO mempty
+            <*> newTVarIO Nothing <*> newTVarIO Nothing <*> newTVarIO 1 <*> newTVarIO Nothing
+  atomically $ modifyTVar' (envTasks env) (M.insert startTaskId task)
+  worker <- async (runWorker env task)
+  atomically $ writeTVar (taskWorker task) (Just worker)
+  logLine [i|started task #{startTaskId} for #{path} (debounce #{taskDebounceMs task}ms)|]
+  return (StartResult startTaskId)
+  where
+    safeChar c | c `elem` ['a'..'z'] || c `elem` ['A'..'Z'] || c `elem` ['0'..'9'] || c `elem` ("-_" :: String) = c
+               | otherwise = '_'
+
+stopTask :: ServerEnv -> Task -> IO ()
+stopTask env task = do
+  atomically $ modifyTVar' (envTasks env) (M.delete (taskId task))
+  readTVarIO (taskWorker task) >>= mapM_ cancel
+  doesDirectoryExist (taskWorkDir task) >>= \case
+    True -> removeDirectoryRecursive (taskWorkDir task)
+    False -> return ()
+  logLine [i|stopped task #{taskId task}|]
diff --git a/src/Render/Server/Env.hs b/src/Render/Server/Env.hs
new file mode 100644
index 0000000..3e5ad17
--- /dev/null
+++ b/src/Render/Server/Env.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE TypeOperators #-}
+
+module Render.Server.Env (
+  ServerEnv(..)
+  , Task(..)
+  , markDirty
+  , taskFormat
+  , sendStatus
+  , sendLog
+  , send
+  , logLine
+  ) where
+
+import Data.Aeson (toJSON)
+import qualified Data.Aeson as A
+import qualified Data.ByteString as B
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Proxy
+import Data.Set (Set)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Language.LSP.Protocol.Message
+import Language.LSP.Protocol.Types
+import Language.LSP.Server
+import Render.Command
+import Render.Protocol
+import System.IO (hPutStrLn, stderr)
+import UnliftIO (Async)
+import UnliftIO.STM
+
+
+data Task = Task {
+  taskId :: Text
+  , taskEntryPath :: FilePath
+  , taskEntryUri :: NormalizedUri
+  , taskOptions :: Map Text Text
+  , taskDebounceMs :: Int
+  , taskEpoch :: Integer
+  , taskWorkDir :: FilePath
+  , taskDirty :: TVar Bool
+  , taskReasons :: TVar [Text]
+  , taskEdit :: TVar (Maybe (FilePath, Position))
+  , taskRenderedEdit :: TVar (Maybe (FilePath, Position))
+  , taskPaused :: TVar Bool
+  , taskResync :: TVar Bool
+  , taskDeps :: TVar (Set FilePath)
+  , taskDepHashes :: TVar (Map FilePath (Maybe B.ByteString))
+  , taskVersion :: TVar (Maybe Int32)
+  , taskLast :: TVar (Maybe (Int, B.ByteString))
+  , taskNextRenderId :: TVar Int
+  , taskWorker :: TVar (Maybe (Async ()))
+  }
+
+data ServerEnv = ServerEnv {
+  envCommand :: Programs
+  , envWorkRoot :: FilePath
+  , envDefaultOptions :: Map Text Text
+  , envTasks :: TVar (Map Text Task)
+  , envLsp :: TVar (Maybe (LanguageContextEnv ()))
+  }
+
+markDirty :: Task -> Text -> IO ()
+markDirty task reason = atomically $ do
+  writeTVar (taskDirty task) True
+  modifyTVar' (taskReasons task) (<> [reason])
+
+taskFormat :: Task -> Text
+taskFormat task = fromMaybe "" (M.lookup "format" (taskOptions task))
+
+sendStatus :: ServerEnv -> Task -> Status -> Phase -> Maybe Text -> Maybe Int -> Maybe Double -> [Timing] -> IO ()
+sendStatus env task status phase reason code ms timings =
+  send env methodStatus (StatusParams (taskId task) status phase reason code ms timings)
+
+sendLog :: ServerEnv -> Task -> LogStream -> Text -> Bool -> IO ()
+sendLog env task stream text clear = send env methodLog (LogParams (taskId task) stream text clear)
+
+send :: A.ToJSON a => ServerEnv -> Text -> a -> IO ()
+send env method params = readTVarIO (envLsp env) >>= \case
+  Nothing -> return ()
+  Just lspEnv -> runLspT lspEnv $ case method of
+    "codedown/render/status" -> sendNotification (SMethod_CustomMethod (Proxy @"codedown/render/status")) (toJSON params)
+    "codedown/render/output" -> sendNotification (SMethod_CustomMethod (Proxy @"codedown/render/output")) (toJSON params)
+    "codedown/render/log" -> sendNotification (SMethod_CustomMethod (Proxy @"codedown/render/log")) (toJSON params)
+    _ -> return ()
+
+logLine :: Text -> IO ()
+logLine = hPutStrLn stderr . T.unpack . ("lsp-export-server: " <>)
diff --git a/src/Render/Server/Publish.hs b/src/Render/Server/Publish.hs
new file mode 100644
index 0000000..c6a308a
--- /dev/null
+++ b/src/Render/Server/Publish.hs
@@ -0,0 +1,65 @@
+module Render.Server.Publish (
+  publish
+  , hashFile
+  ) where
+
+import qualified Crypto.Hash.SHA256 as SHA256
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.String.Interpolate
+import Data.Text (Text)
+import qualified Data.Text.Encoding as T
+import Language.LSP.Protocol.Types (Int32)
+import Render.Command
+import Render.Protocol
+import Render.Server.Env
+import qualified Render.Xdelta as Xdelta
+import System.Directory
+import UnliftIO.STM
+
+
+-- | Nothing when the output is unchanged
+publish :: ServerEnv -> Task -> RenderResult -> Maybe PageBox -> [FilePath] -> Maybe Int32 -> Double -> IO (Maybe Text)
+publish env task (RenderResult {..}) position overlayPaths version ms = do
+  resync <- atomically (swapTVar (taskResync task) False)
+  lastOutput <- readTVarIO (taskLast task)
+  encoded <- case lastOutput of
+    Just (_, baseBytes) | not resync, baseBytes == resultBytes -> return Nothing
+    Just (baseId, baseBytes) | not resync -> Xdelta.encode resultBytes baseBytes >>= \case
+      Right patch -> return (Just (EncodingXdelta3, Just baseId, patch))
+      Left err -> do
+        logLine [i|xdelta3 failed, sending a full output: #{err}|]
+        return (Just (EncodingFull, Nothing, resultBytes))
+    _ -> return (Just (EncodingFull, Nothing, resultBytes))
+
+  let diskDeps = filter (`notElem` (taskEntryPath task : overlayPaths)) resultDeps
+  hashes <- M.fromList <$> mapM (\p -> (p,) <$> hashFile p) diskDeps
+  atomically $ do
+    writeTVar (taskDeps task) (S.fromList (taskEntryPath task : resultDeps))
+    writeTVar (taskDepHashes task) hashes
+  case encoded of
+    Nothing -> return Nothing
+    Just (encoding, baseId, bytes) -> do
+      renderId <- atomically $ stateTVar (taskNextRenderId task) (\n -> (n, n + 1))
+      atomically $ writeTVar (taskLast task) (Just (renderId, resultBytes))
+      send env methodOutput $ OutputParams {
+        outputTaskId = taskId task
+        , outputRenderId = renderId
+        , outputBaseRenderId = baseId
+        , outputDocumentVersion = version
+        , outputFiles = [OutputFile resultFileName encoding (T.decodeUtf8 (B64.encode bytes)) (B.length resultBytes)]
+        , outputDeps = diskDeps
+        , outputRenderMs = ms
+        , outputTimings = resultTimings
+        , outputPosition = position
+        }
+      return $ Just $ case encoding of
+        EncodingFull -> [i|sent the full #{B.length bytes}B output as render #{renderId}|]
+        EncodingXdelta3 -> [i|output changed, sent a #{B.length bytes}B diff as render #{renderId}|]
+
+hashFile :: FilePath -> IO (Maybe B.ByteString)
+hashFile path = doesFileExist path >>= \case
+  False -> return Nothing
+  True -> Just . SHA256.hash <$> B.readFile path
diff --git a/src/Render/Server/Worker.hs b/src/Render/Server/Worker.hs
new file mode 100644
index 0000000..77c9cab
--- /dev/null
+++ b/src/Render/Server/Worker.hs
@@ -0,0 +1,153 @@
+module Render.Server.Worker (
+  runWorker
+  , locatePosition
+  ) where
+
+import Control.Lens ((^.))
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.STM (check)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe, isJust)
+import Data.String.Interpolate
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Time
+import Language.LSP.Protocol.Types
+import Language.LSP.Server
+import Language.LSP.VFS
+import Render.Command
+import Render.Protocol
+import Render.Server.Env
+import Render.Server.Publish
+import UnliftIO (SomeException, fromException, race, try)
+import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.STM
+
+
+runWorker :: ServerEnv -> Task -> IO ()
+runWorker env task = forever $ do
+  atomically $ do
+    dirty <- readTVar (taskDirty task)
+    paused <- readTVar (taskPaused task)
+    check (dirty && not paused)
+  atomically $ writeTVar (taskDirty task) False
+  threadDelay (taskDebounceMs task * 1000)
+  readTVarIO (taskDirty task) >>= \case
+    True -> return ()
+    False -> renderOnce env task PhaseQuick >>= \case
+      False -> return ()
+      True -> case programSettle (envCommand env) of
+        Nothing -> return ()
+        Just _ -> quietFor settleQuietMs >>= \case
+          False -> return ()
+          True -> void (renderOnce env task PhaseSettle)
+  where
+    quietFor ms = race (threadDelay (ms * 1000)) (atomically (readTVar (taskDirty task) >>= check)) >>= \case
+      Left () -> return True
+      Right () -> return False
+
+settleQuietMs :: Int
+settleQuietMs = 1500
+
+-- | False when superseded by an edit or failed
+renderOnce :: ServerEnv -> Task -> Phase -> IO Bool
+renderOnce env task phase = do
+  (entryText, version, overlays) <- snapshotBuffers env task
+  reasons <- atomically (swapTVar (taskReasons task) [])
+  edit <- atomically $ case phase of
+    PhaseQuick -> do
+      e <- swapTVar (taskEdit task) Nothing
+      writeTVar (taskRenderedEdit task) e
+      return e
+    PhaseSettle -> readTVar (taskRenderedEdit task)
+  let reason = case reasons of
+        [] -> Nothing
+        _ -> Just (T.intercalate ", " reasons)
+  let label = case phase of
+        PhaseQuick -> "quick render" :: Text
+        PhaseSettle -> "settle pass"
+  -- The settle pass logs only when it fails or changes the output
+  buffered <- newTVarIO ([] :: [(LogStream, Text)])
+  let logFn stream text = case phase of
+        PhaseQuick -> sendLog env task stream text False
+        PhaseSettle -> atomically (modifyTVar' buffered ((stream, text) :))
+  let marker text = logFn LogStdout ("── " <> text)
+  let flush = do
+        lines' <- reverse <$> atomically (swapTVar buffered [])
+        forM_ lines' $ \(stream, text) -> sendLog env task stream text False
+  case phase of
+    PhaseQuick -> do
+      sendStatus env task StatusRendering phase reason Nothing Nothing []
+      sendLog env task LogStdout "" True
+      marker [i|#{label}: #{fromMaybe "no reason recorded" reason}|]
+    PhaseSettle -> marker [i|#{label} after #{settleQuietMs}ms without edits|]
+  start <- getCurrentTime
+  let request = RenderRequest {
+        requestEntryPath = taskEntryPath task
+        , requestEntryText = entryText
+        , requestOverlays = overlays
+        , requestWorkDir = taskWorkDir task
+        , requestOptions = taskOptions task
+        , requestSettle = phase == PhaseSettle
+        , requestEpoch = taskEpoch task
+        , requestLog = logFn
+        }
+  outcome <- race (atomically (readTVar (taskDirty task) >>= check)) (try (render (envCommand env) request))
+  end <- getCurrentTime
+  let ms = realToFrac (diffUTCTime end start) * 1000 :: Double
+  case outcome of
+    Left () -> do
+      marker [i|#{label} cancelled after #{showMs ms}: a new edit arrived|]
+      return False
+    Right (Left (e :: SomeException)) -> do
+      let (code, msg) = case fromException e of
+            Just (RenderFailure c m) -> (c, m)
+            Nothing -> (-1, T.pack (show e))
+      logFn LogStderr msg
+      marker [i|#{label} failed after #{showMs ms}|]
+      flush
+      sendStatus env task StatusErrored phase reason (Just code) (Just ms) []
+      return False
+    Right (Right result) -> do
+      position <- forM edit (uncurry (locatePosition env task)) >>= \case
+        Just (Left err) -> do
+          logLine [i|locating the edit in #{taskId task} failed: #{err}|]
+          return Nothing
+        Just (Right box) -> return box
+        Nothing -> return Nothing
+      sent <- publish env task result position (map fst overlays) version ms
+      marker [i|#{label} done in #{showMs ms}: #{fromMaybe "output unchanged, nothing sent" sent}|]
+      when (isJust sent) flush
+      sendStatus env task StatusReady phase reason Nothing (Just ms) (resultTimings result)
+      return True
+
+locatePosition :: ServerEnv -> Task -> FilePath -> Position -> IO (Either Text (Maybe PageBox))
+locatePosition env task path (Position line character) = case programLocate (envCommand env) of
+  Nothing -> return (Right Nothing)
+  Just exe -> do
+    source <- workPathFor (taskEntryPath task) (taskWorkDir task) path
+    locate exe (taskEntryPath task) (taskWorkDir task) (taskFormat task) source (fromIntegral line + 1) (fromIntegral character + 1)
+
+showMs :: Double -> Text
+showMs ms = T.pack (show (round ms :: Int)) <> "ms"
+
+snapshotBuffers :: ServerEnv -> Task -> IO (Text, Maybe Int32, [(FilePath, Text)])
+snapshotBuffers env task = readTVarIO (envLsp env) >>= \case
+  Nothing -> fromDisk
+  Just lspEnv -> runLspT lspEnv $ do
+    vfs <- getVirtualFiles
+    let overlays = [ (p, virtualFileText vf)
+                   | (uri, Open vf) <- M.toList (vfs ^. vfsMap)
+                   , uri /= taskEntryUri task
+                   , Just p <- [uriToFilePath (fromNormalizedUri uri)] ]
+    getVirtualFile (taskEntryUri task) >>= \case
+      Just vf -> return (virtualFileText vf, Just (virtualFileVersion vf), overlays)
+      Nothing -> do
+        (text, v, _) <- liftIO fromDisk
+        return (text, v, overlays)
+  where
+    fromDisk = do
+      text <- T.readFile (taskEntryPath task)
+      return (text, Nothing, [])