Generate renderer functions using TH

These take (and project from) a data type instead of hash maps, _and_
use text-builder-linear, _and_ have the full template inlined. The
result is that this is the fastest renderer yet.

9 files changed, 414 insertions, 72 deletions

diff --git a/src/EscapeXML.hs b/escapexml/EscapeXML.hs
index 662d2ed..662d2ed 100644
--- a/src/EscapeXML.hs
+++ b/escapexml/EscapeXML.hs
diff --git a/cbits/escapexml.c b/escapexml/escapexml.c
index 6eb366d..6eb366d 100644
--- a/cbits/escapexml.c
+++ b/escapexml/escapexml.c
diff --git a/pages/calendar-day.mustache b/pages/calendar-day.mustache
index 9df9998..f3a1895 100644
--- a/pages/calendar-day.mustache
+++ b/pages/calendar-day.mustache
@@ -21,8 +21,8 @@
         {{#events}}
           <tr{{#classlist}} class="{{&.}}"{{/classlist}}>
             <td><a href="/cal/{{&alias}}/{{&date}}?eid={{&linkid}}#ev-{{&linkid}}" name="ev-{{&linkid}}">{{&time}}</a></td>
-            <td>{{#nickwrap1}}<span class="nickwrap">{{&.}}</span>{{/nickwrap1}}{{&nickE}}{{#nickwrap2}}<span class="nickwrap">{{&.}}</span>{{/nickwrap2}}</td>
-            <td>{{&messageE}}</td>
+            <td>{{#nickwrap1}}<span class="nickwrap">{{&.}}</span>{{/nickwrap1}}{{nick}}{{#nickwrap2}}<span class="nickwrap">{{&.}}</span>{{/nickwrap2}}</td>
+            <td>{{message}}</td>
           </tr>
         {{/events}}
       </tbody></table>
diff --git a/pages/log.mustache b/pages/log.mustache
index c07eb20..3d91a2a 100644
--- a/pages/log.mustache
+++ b/pages/log.mustache
@@ -19,8 +19,8 @@
       <h1>Logs: {{network}}/{{channel}}</h1>
       <div class="pagepicker">
         {{#picker}}
-          {{#prevpage}}<a href="?page={{prevpage}}">{{/prevpage}}{{^prevpage}}<span class="link-disabled">{{/prevpage}}&larr;Prev</a>&nbsp;
-          {{#nextpage}}<a href="?page={{nextpage}}">{{/nextpage}}{{^nextpage}}<span class="link-disabled">{{/nextpage}}Next&rarr;</a>
+          {{#prevpage}}<a href="?page={{.}}">{{/prevpage}}{{^prevpage}}<span class="link-disabled">{{/prevpage}}&larr;Prev</a>&nbsp;
+          {{#nextpage}}<a href="?page={{.}}">{{/nextpage}}{{^nextpage}}<span class="link-disabled">{{/nextpage}}Next&rarr;</a>
           <div class="pagepicker-pages">
             Page
             {{#firstpage}}
@@ -51,15 +51,15 @@
         {{#events}}
           <tr{{#classlist}} class="{{&.}}"{{/classlist}}>
             <td><a href="/log/{{&alias}}?eid={{&linkid}}#ev-{{&linkid}}" name="ev-{{&linkid}}">{{&datetime}}</a></td>
-            <td>{{#nickwrap1}}<span class="nickwrap">{{&nickwrap1}}</span>{{/nickwrap1}}{{&nickE}}{{#nickwrap2}}<span class="nickwrap">{{&nickwrap2}}</span>{{/nickwrap2}}</td>
-            <td>{{&messageE}}</td>
+            <td>{{#nickwrap1}}<span class="nickwrap">{{&.}}</span>{{/nickwrap1}}{{nick}}{{#nickwrap2}}<span class="nickwrap">{{&.}}</span>{{/nickwrap2}}</td>
+            <td>{{message}}</td>
           </tr>
         {{/events}}
       </tbody></table>
       <div class="pagepicker">
         {{#picker}}
-          {{#prevpage}}<a href="?page={{prevpage}}">{{/prevpage}}{{^prevpage}}<span class="link-disabled">{{/prevpage}}&larr;Prev</a>&nbsp;
-          {{#nextpage}}<a href="?page={{nextpage}}">{{/nextpage}}{{^nextpage}}<span class="link-disabled">{{/nextpage}}Next&rarr;</a>
+          {{#prevpage}}<a href="?page={{.}}">{{/prevpage}}{{^prevpage}}<span class="link-disabled">{{/prevpage}}&larr;Prev</a>&nbsp;
+          {{#nextpage}}<a href="?page={{.}}">{{/nextpage}}{{^nextpage}}<span class="link-disabled">{{/nextpage}}Next&rarr;</a>
           <div class="pagepicker-pages">
             Page
             {{#firstpage}}
diff --git a/src/Index.hs b/src/Index.hs
index 5ac59be..3e40cac 100644
--- a/src/Index.hs
+++ b/src/Index.hs
@@ -35,7 +35,6 @@ import Data.Text (Text)
 import Data.Time
 import Data.Vector.Storable qualified as VS
 import Data.Word
-import Numeric (showIntAtBase)
 import System.Clock qualified as Clock
 import System.Directory
 import System.FilePath
diff --git a/src/Main.hs b/src/Main.hs
index 5c73fce..433f6c6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -41,6 +42,7 @@ import Calendar
 import Config
 import EscapeXML
 import Index
+import Pages
 import Util
 import ZNC
 import System.Directory (listDirectory)
@@ -74,8 +76,8 @@ pageIndex conf pages =
           [(nw, ch : map chanChannel chs)
           | Channel nw ch :| chs <- groupBy ((==) `on` chanNetwork) (econfChannels conf)]]]
 
-pageLog :: Config -> Pages -> Index -> Request -> Text -> IO Response
-pageLog conf pages index req alias =
+pageLog :: Config -> Index -> Request -> Text -> IO Response
+pageLog conf index req alias =
   case econfAlias2Chan conf Map.!? alias of
     Nothing -> page404 "Channel not found"
     Just chan -> do
@@ -96,36 +98,73 @@ pageLog conf pages index req alias =
               ntoright = min 5 (npages - curpage)
           -- traceShowM (indexNumEvents index chan, npages, curpage, ntoleft, ntoright)
           events <- indexGetEventsLinear index chan ((curpage - 1) * numPerPage) numPerPage
-          return $ sendPage200 pages "log" $ M.object
-            ["network" ~> chanNetwork chan
-            ,"channel" ~> chanChannel chan
-            ,"alias" ~> alias
-            ,"totalevents" ~> renderLargeNumber numEvents
-            ,"picker" ~> M.object
-              ["prevpage" ~> if curpage > 1 then Just (curpage - 1) else Nothing
-              ,"nextpage" ~> if curpage < npages then Just (curpage + 1) else Nothing
-              ,"firstpage" ~> (curpage > 6)
-              ,"leftdots" ~> (curpage > 7)
-              ,"rightdots" ~> (curpage < npages - 6)
-              ,"lastpage" ~> (curpage < npages - 5)
-              ,"leftnums" ~> [curpage - ntoleft .. curpage - 1]
-              ,"curnum" ~> curpage
-              ,"rightnums" ~> [curpage + 1 .. curpage + ntoright]
-              ,"npages" ~> npages]
-            ,"events" ~> [M.object
-                           ["classlist" ~> if mpagehighlight == Just dayidx
-                                             then Just (classlist `classListAdd` "highlight")
-                                             else classlist
-                           ,"datetime" ~> let YMDHMS (YMD y mo d) (HMS h mi s) = time
-                                          in pad '0' 4 y ++ '-' : pad '0' 2 mo ++ '-' : pad '0' 2 d ++ ' ' :
-                                             pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s
-                           ,"linkid" ~> eid
-                           ,"nickwrap1" ~> nickw1
-                           ,"nickE" ~> escapeXML nick
-                           ,"nickwrap2" ~> nickw2
-                           ,"messageE" ~> escapeXML msg]
-                         | ((time, eid, ev), dayidx) <- zip events [0..]
-                         , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]]
+          return $ responseBS
+            status200
+            [("Content-Type", "text/html")]
+            (renderPageLog LogData
+              { network = chanNetwork chan
+              , channel = chanChannel chan
+              , alias = alias
+              , totalevents = renderLargeNumber numEvents
+              , picker = PickerData
+                  { prevpage = if curpage > 1 then Just (curpage - 1) else Nothing
+                  , nextpage = if curpage < npages then Just (curpage + 1) else Nothing
+                  , firstpage = curpage > 6
+                  , leftdots = curpage > 7
+                  , rightdots = curpage < npages - 6
+                  , lastpage = curpage < npages - 5
+                  , leftnums = [curpage - ntoleft .. curpage - 1]
+                  , curnum = curpage
+                  , rightnums = [curpage + 1 .. curpage + ntoright]
+                  , npages = npages }
+              , events =
+                  [EventData
+                     { classlist = if mpagehighlight == Just dayidx
+                                     then Just (classlist `classListAdd` "highlight")
+                                     else classlist
+                     , time = ()
+                     , datetime = let YMDHMS (YMD y mo d) (HMS h mi s) = time
+                                  in T.pack
+                                       (pad '0' 4 y ++ '-' : pad '0' 2 mo ++ '-' : pad '0' 2 d ++ ' ' :
+                                        pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s)
+                     , linkid = eid
+                     , nickwrap1 = nickw1
+                     , nick = nick
+                     , nickwrap2 = nickw2
+                     , message = msg }
+                  | ((time, eid, ev), dayidx) <- zip events [0..]
+                  , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]
+              })
+          -- return $ sendPage200 pages "log" $ M.object
+          --   ["network" ~> chanNetwork chan
+          --   ,"channel" ~> chanChannel chan
+          --   ,"alias" ~> alias
+          --   ,"totalevents" ~> renderLargeNumber numEvents
+          --   ,"picker" ~> M.object
+          --     ["prevpage" ~> if curpage > 1 then Just (curpage - 1) else Nothing
+          --     ,"nextpage" ~> if curpage < npages then Just (curpage + 1) else Nothing
+          --     ,"firstpage" ~> (curpage > 6)
+          --     ,"leftdots" ~> (curpage > 7)
+          --     ,"rightdots" ~> (curpage < npages - 6)
+          --     ,"lastpage" ~> (curpage < npages - 5)
+          --     ,"leftnums" ~> [curpage - ntoleft .. curpage - 1]
+          --     ,"curnum" ~> curpage
+          --     ,"rightnums" ~> [curpage + 1 .. curpage + ntoright]
+          --     ,"npages" ~> npages]
+          --   ,"events" ~> [M.object
+          --                  ["classlist" ~> if mpagehighlight == Just dayidx
+          --                                    then Just (classlist `classListAdd` "highlight")
+          --                                    else classlist
+          --                  ,"datetime" ~> let YMDHMS (YMD y mo d) (HMS h mi s) = time
+          --                                 in pad '0' 4 y ++ '-' : pad '0' 2 mo ++ '-' : pad '0' 2 d ++ ' ' :
+          --                                    pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s
+          --                  ,"linkid" ~> eid
+          --                  ,"nickwrap1" ~> nickw1
+          --                  ,"nick" ~> nick
+          --                  ,"nickwrap2" ~> nickw2
+          --                  ,"message" ~> msg]
+          --                | ((time, eid, ev), dayidx) <- zip events [0..]
+          --                , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]]
   where
     numPerPage = 100
 
@@ -243,8 +282,8 @@ renderSimple topnodes topvalue = runBufferBS (\b -> foldlIntoBuffer (go [topvalu
 --       _ -> case consumeBuffer buf of
 --              () -> error $ "renderCalendarDayPage: unexpected node in implicit section: " ++ show node
 
-pageCalendarDay :: Config -> Pages -> Index -> Request -> Text -> Text -> IO Response
-pageCalendarDay conf pages index req alias datestr =
+pageCalendarDay :: Config -> Index -> Request -> Text -> Text -> IO Response
+pageCalendarDay conf index req alias datestr =
   case (econfAlias2Chan conf Map.!? alias, parseDatestr datestr) of
     (Nothing, _) -> page404 "Channel not found"
     (_, Nothing) -> page404 "Invalid date"
@@ -260,31 +299,34 @@ pageCalendarDay conf pages index req alias datestr =
                  _ -> return Nothing
            | otherwise -> return Nothing
 
+      return $ responseBS
+        status200
+        [("Content-Type", "text/html")]
+        (renderPageCalendarDay CalendarDayData
+          { network = chanNetwork chan
+          , channel = chanChannel chan
+          , alias = alias
+          , date = T.pack (ymdToString (dayToYMD day))
+          , events =
+              [EventData
+                { classlist = if mpagehighlight == Just dayidx
+                                then Just (classlist `classListAdd` "highlight")
+                                else classlist
+                , time = let HMS h mi s = time
+                         in T.pack (pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s)
+                , datetime = ()
+                , linkid = eid
+                , nickwrap1 = nickw1
+                , nick = nick
+                , nickwrap2 = nickw2
+                , message = msg }
+              | ((time, eid, ev), dayidx) <- zip events [0..]
+              , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev] })
+
       -- return $ responseBS
       --   status200
       --   [("Content-Type", "text/html")]
       --   (renderCalendarDayPage (getPage pages "calendar-day") chan day alias mpagehighlight events)
-
-      -- -- return $ sendPage200 pages "calendar-day" $! forceValue $ M.object
-      -- return $ sendPage200 pages "calendar-day" $ M.object
-      return $ responseBS status200 [("Content-Type", "text/html")] $ renderSimple (toSimple (getPage pages "calendar-day")) $ M.object
-        ["network" ~> chanNetwork chan
-        ,"channel" ~> chanChannel chan
-        ,"alias" ~> alias
-        ,"date" ~> ymdToString (dayToYMD day)
-        ,"events" ~> [M.object
-                       ["classlist" ~> if mpagehighlight == Just dayidx
-                                         then Just (classlist `classListAdd` "highlight")
-                                         else classlist
-                       ,"time" ~> let HMS h mi s = time
-                                  in pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s
-                       ,"linkid" ~> eid
-                       ,"nickwrap1" ~> nickw1
-                       ,"nickE" ~> escapeXML nick
-                       ,"nickwrap2" ~> nickw2
-                       ,"messageE" ~> escapeXML msg]
-                     | ((time, eid, ev), dayidx) <- zip events [0..]
-                     , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]]
   where
     parseDatestr :: Text -> Maybe Day
     parseDatestr t = do  -- YYYY-mm-dd
@@ -386,11 +428,11 @@ mainServe confpath = do
     [] ->
       pageIndex config pages
     ["log", TE.decodeUtf8' -> Right alias] ->
-      pageLog config pages index req alias
+      pageLog config index req alias
     ["cal", TE.decodeUtf8' -> Right alias] ->
       pageCalendar config pages index alias
     ["cal", TE.decodeUtf8' -> Right alias, TE.decodeUtf8' -> Right date] ->
-      pageCalendarDay config pages index req alias date
+      pageCalendarDay config index req alias date
     [fname] | fname `elem` staticFiles ->
       return $ responseFile status200 [] ("pages/" ++ BS8.unpack fname)
     _ ->
diff --git a/src/Pages.hs b/src/Pages.hs
new file mode 100644
index 0000000..4efd8fe
--- /dev/null
+++ b/src/Pages.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NoFieldSelectors #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Pages (
+  renderPageLog, LogData(..),
+  renderPageCalendarDay, CalendarDayData(..),
+  PickerData(..), EventData(..),
+) where
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Text (Text)
+import Data.Text.IO qualified as T
+import Language.Haskell.TH.Syntax (addDependentFile)
+import System.Directory (makeAbsolute)
+import Text.Mustache.Compile qualified as M
+
+import Pages.TH
+
+
+data LogData = LogData
+  { network :: Text
+  , channel :: Text
+  , alias :: Text
+  , totalevents :: Text
+  , picker :: PickerData
+  , events :: [EventData () Text]
+  }
+
+data CalendarDayData = CalendarDayData
+  { network :: Text
+  , channel :: Text
+  , alias :: Text
+  , date :: Text
+  , events :: [EventData Text ()]
+  }
+
+data PickerData = PickerData
+  { prevpage :: Maybe Int
+  , nextpage :: Maybe Int
+  , firstpage :: Bool
+  , leftdots :: Bool
+  , rightdots :: Bool
+  , lastpage :: Bool
+  , leftnums :: [Int]
+  , curnum :: Int
+  , rightnums :: [Int]
+  , npages :: Int
+  }
+
+data EventData tm dttm = EventData
+  { classlist :: Maybe Text
+  , time :: tm
+  , datetime :: dttm
+  , linkid :: Text
+  , nickwrap1 :: Maybe Text
+  , nick :: Text
+  , nickwrap2 :: Maybe Text
+  , message :: Text
+  }
+
+$(do let readTemplate name = do
+           path <- liftIO $ makeAbsolute ("pages/" ++ name ++ ".mustache")
+           tplSrc <- liftIO $ T.readFile path
+           addDependentFile path
+           case M.compileTemplate name tplSrc of
+             Right tpl -> return tpl
+             Left err -> fail $ "Reading " ++ path ++ ": " ++ show err
+     concat <$> mapM (\(name, ty) -> (`makeRender` ty) =<< readTemplate name)
+       [("log", ''LogData)
+       ,("calendar-day", ''CalendarDayData)])
diff --git a/src/Pages/TH.hs b/src/Pages/TH.hs
new file mode 100644
index 0000000..0cc93db
--- /dev/null
+++ b/src/Pages/TH.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module Pages.TH where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.Char (toUpper)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.List.NonEmpty qualified as NE
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Data.Text.Builder.Linear.Buffer
+import Language.Haskell.TH
+import Text.Mustache qualified as M
+import Text.Mustache.Types qualified as M
+
+import EscapeXML
+
+
+data DataMap
+  = VQInt
+  | VQBool
+  | VQText
+  | VQUnit  -- ()
+  | VQList DataMap  -- ^ embedded map is of a list element
+  | VQMaybe DataMap
+  | VQObject [(Text, (Exp -> Exp, DataMap))]  -- ^ field name, projection function, submap
+
+
+makeDataMap :: Name -> Q DataMap
+makeDataMap name = makeDataMapTy (ConT name)
+
+makeDataMapTy :: Type -> Q DataMap
+makeDataMapTy (ConT tyname)
+  | tyname == ''Int = return VQInt
+  | tyname == ''Bool = return VQBool
+  | tyname == ''Text = return VQText
+makeDataMapTy (TupleT 0) = return VQUnit
+makeDataMapTy (AppT ListT ty) = VQList <$> makeDataMapTy ty
+makeDataMapTy (AppT (ConT name) ty) | name == ''Maybe = VQMaybe <$> makeDataMapTy ty
+
+makeDataMapTy topty = do
+  case splitApps topty [] of
+    (ConT tyname, tyargs) ->
+      reify tyname >>= \case
+        TyConI (DataD [] _ tyvars _ [RecC conname fields] _) ->
+          let n = length fields
+          in VQObject <$> sequence
+               [do dm <- makeDataMapTy (subst (Map.fromList (zip (map tyvarName tyvars) tyargs)) fieldty)
+                   f <- projectField conname i n
+                   return (T.pack (nameBase name), (f, dm))
+               | ((name, _bang, fieldty), i) <- zip fields [0..]]
+        _ -> fail $ "Not a suitable data type: " ++ show tyname
+    _ -> fail $ "Not a straightforward type: " ++ show topty
+  where
+    projectField :: Name -> Int -> Int -> Q (Exp -> Exp)
+    projectField conname i n = do
+      varname <- newName ('x' : show (i + 1))
+      let pats = replicate i WildP ++ [VarP varname] ++ replicate (n-i-1) WildP
+      return $ \e ->
+        CaseE e [Match (ConP conname [] pats) (NormalB (VarE varname)) []]
+
+    splitApps :: Type -> [Type] -> (Type, [Type])
+    splitApps (AppT t1 t2) args = splitApps t1 (t2 : args)
+    splitApps t args = (t, args)
+
+    tyvarName :: TyVarBndr flag -> Name
+    tyvarName (PlainTV n _) = n
+    tyvarName (KindedTV n _ _) = n
+
+    subst :: Map Name Type -> Type -> Type
+    subst _ t@ConT{} = t
+    subst _ t@ListT = t
+    subst _ t@TupleT{} = t
+    subst mp (VarT n) | Just t <- Map.lookup n mp = t
+    subst mp (AppT t1 t2) = AppT (subst mp t1) (subst mp t2)
+    subst _ t = error $ "Unsupported type: " ++ show t
+
+makeRender :: M.Template -> Name -> Q [Dec]
+makeRender (M.Template tplname nodes _) dataname = do
+  dm <- makeDataMap dataname
+  let funname = mkName ("renderPage" ++ toPascalCase tplname)
+  argname <- newName "dat"
+  bufname <- newName "buf"
+  body <- renderNodes ((dm, VarE argname) :| []) (DuplicableExp (VarE bufname)) nodes
+  let body' = VarE 'runBufferBS `AppE` LamE [VarP bufname] body
+  return
+    [SigD funname (ArrowT `AppT` ConT dataname `AppT` ConT ''ByteString)
+    ,FunD funname
+      [Clause [BangP (VarP argname)] (NormalB body') []]]
+
+data ExpensiveExp
+  = ExpensiveExp Exp
+  | DuplicableExp Exp
+
+expensive :: ExpensiveExp -> Exp
+expensive (ExpensiveExp e) = e
+expensive (DuplicableExp e) = e
+
+makeDuplicable :: ExpensiveExp -> (Exp -> Q Exp) -> Q Exp
+makeDuplicable (ExpensiveExp e) k = do
+  varname <- newName "a"
+  caseE (pure e)
+    [match (varP varname) (normalB (k (VarE varname))) []]
+makeDuplicable (DuplicableExp e) k = k e
+
+-- | This is just '(|>)', but with a @NOINLINE@ pragma. This is because GHC
+-- eagerly inlines '(|>)', and that function contains some conditionals, and as
+-- a result the generated Core for the render function contains a whole forest
+-- of join points. By avoiding inlining this function, the Core becomes a
+-- straight line of @case@s that contains join points only when there is
+-- genuinely control flow going on, i.e. when substituting a @Maybe@ or when
+-- looping over a list.
+{-# NOINLINE noinlineAppText #-}
+noinlineAppText :: Buffer %1-> Text -> Buffer
+noinlineAppText = (|>)
+
+-- | All input expressions must be duplicable.
+renderNodes :: NonEmpty (DataMap, Exp) -> ExpensiveExp -> [M.Node Text] -> Q (Exp {- Buffer -})
+renderNodes _    buf [] = return (expensive buf)
+renderNodes dats buf (node : nodes) = do
+  let app buf' name e = InfixE (Just buf') (VarE name) (Just e)
+
+  buf' <- case node of
+    M.TextBlock t ->
+      let bytes = BS.unpack (TE.encodeUtf8 t)
+      in return $ app (expensive buf) '(|>#) (LitE (StringPrimL bytes))
+    M.Variable esc named -> 
+      case search named dats of
+        Just (VQInt, e) -> return $ app (expensive buf) '(|>$) e
+        Just (VQText, e) ->
+          return $ app (expensive buf) 'noinlineAppText (if esc then VarE 'escapeXML `AppE` e else e)
+        Just (_, _) -> fail $ "Strange value in variable reference " ++ show named
+        Nothing -> fail $ "Variable not found: " ++ show named
+    M.Section named nodes' ->
+      case search named dats of
+        Just (VQBool, e) ->
+          makeDuplicable buf $ \buf' ->
+            condE (pure e)
+              (renderNodes ((VQBool, e) NE.<| dats) (DuplicableExp buf') nodes')
+              (pure buf')
+        Just (VQText, e) ->
+          makeDuplicable buf $ \buf' ->
+            condE [| T.null $(pure e) |]
+              (pure buf')
+              (renderNodes ((VQText, e) NE.<| dats) (DuplicableExp buf') nodes')
+        Just (VQList dm, e) -> do
+          bvar <- newName "b"
+          vvar <- newName "v"
+          varE 'foldlIntoBuffer
+            `appE` lamE [varP bvar, varP vvar]
+                     (renderNodes ((dm, VarE vvar) NE.<| dats) (DuplicableExp (VarE bvar)) nodes')
+            `appE` pure (expensive buf)
+            `appE` pure e
+        Just (VQMaybe dm, e) -> do
+          xvar <- newName "x"
+          makeDuplicable buf $ \buf' ->
+            caseE (pure e)
+              [match (conP 'Nothing []) (normalB (pure buf')) []
+              ,match (conP 'Just [varP xvar])
+                     (normalB (renderNodes ((dm, VarE xvar) NE.<| dats) (DuplicableExp buf') nodes'))
+                     []]
+        Just pair@(VQObject _, _) -> do
+          renderNodes (pair NE.<| dats) buf nodes'
+        Just (VQInt, _) -> fail $ "Int value in section scrutinee " ++ show named
+        Just (VQUnit, _) -> fail $ "() value in section scrutinee " ++ show named
+        Nothing -> fail $ "Section scrutinee not found: " ++ show named
+    M.InvertedSection named nodes' ->
+      case search named dats of
+        Just (VQBool, e) ->
+          makeDuplicable buf $ \buf' ->
+            condE (pure e)
+              (pure buf')
+              (renderNodes dats (DuplicableExp buf') nodes')
+        Just (VQText, e) ->
+          makeDuplicable buf $ \buf' ->
+            condE [| T.null $(pure e) |]
+              (renderNodes dats (DuplicableExp buf') nodes')
+              (pure buf')
+        Just (VQMaybe _, e) ->
+          makeDuplicable buf $ \buf' ->
+            caseE (pure e)
+              [match (conP 'Nothing []) (normalB (renderNodes dats (DuplicableExp buf') nodes')) []
+              ,match (conP 'Just [wildP]) (normalB (pure buf')) []]
+        Just (VQList _, e) ->
+          makeDuplicable buf $ \buf' ->
+            caseE (pure e)
+              [match (listP []) (normalB (renderNodes dats (DuplicableExp buf') nodes')) []
+              ,match wildP (normalB (pure buf')) []]
+        Just (VQObject _, _) -> fail $ "Object value in inverted section scrutinee " ++ show named
+        Just (VQInt, _) -> fail $ "Int value in inverted section scrutinee " ++ show named
+        Just (VQUnit, _) -> fail $ "() value in inverted section scrutinee " ++ show named
+        Nothing -> fail $ "Inverted section scrutinee not found: " ++ show named
+    M.Partial _ _ -> fail $ "TODO partials"
+
+  renderNodes dats (ExpensiveExp buf') nodes
+
+search :: M.DataIdentifier -> NonEmpty (DataMap, Exp) -> Maybe (DataMap, Exp)
+search M.Implicit (value :| _) = Just value
+search (M.NamedData []) (value :| _) = Just value
+search (M.NamedData (key : keys)) ((dm, e) :| dats) =
+  case dm of
+    VQObject fields ->
+      case lookup key fields of
+        Just (proj, dm') -> search (M.NamedData keys) ((dm', proj e) :| [])
+        Nothing -> search (M.NamedData (key : keys)) =<< NE.nonEmpty dats
+    _ ->
+      search (M.NamedData (key : keys)) =<< NE.nonEmpty dats
+
+toPascalCase :: String -> String
+toPascalCase "" = ""
+toPascalCase (c:cs) = toUpper c : go cs
+  where go ('-':cs') = toPascalCase cs'
+        go (c':cs') = c' : go cs'
+        go "" = ""
diff --git a/tirclogv.cabal b/tirclogv.cabal
index 051453b..4ecc933 100644
--- a/tirclogv.cabal
+++ b/tirclogv.cabal
@@ -14,6 +14,7 @@ common common
     MultiWayIf
     TypeApplications
     TupleSections
+  ghc-options: -Wall
 
 executable tirclogv
   import: common
@@ -23,15 +24,18 @@ executable tirclogv
     Calendar
     Config
     Debounce
-    EscapeXML
     ImmutGrowVector
     Index
     Mmap
+    Pages
+    Pages.TH
     Util
     ZNC
   build-depends:
     base >= 4.19,
+    escapexml,
     mini-http-server,
+
     attoparsec,
     bytestring,
     clock,
@@ -42,6 +46,7 @@ executable tirclogv
     mustache,
     text-builder-linear,
     random,
+    template-haskell,
     text >= 2.1.2,
     transformers,
     time,
@@ -51,8 +56,17 @@ executable tirclogv
   hs-source-dirs: src
   c-sources:
     cbits/mmap.c
-    cbits/escapexml.c
-  ghc-options: -Wall -threaded
+  -- necessary so profiling works:
+  other-extensions:
+    TemplateHaskell
+  ghc-options: -threaded
+
+library escapexml
+  import: common
+  exposed-modules: EscapeXML
+  build-depends: base, text
+  hs-source-dirs: escapexml
+  c-sources: escapexml/escapexml.c
 
 library mini-http-server
   import: common
@@ -76,7 +90,6 @@ library mini-http-server
     transformers,
     stm
   hs-source-dirs: mini-http-server
-  ghc-options: -Wall
 
 test-suite server-test
   import: common
@@ -89,7 +102,6 @@ test-suite server-test
     hedgehog,
     transformers
   hs-source-dirs: server-test
-  ghc-options: -Wall
 
 executable echo-server
   import: common
@@ -98,4 +110,4 @@ executable echo-server
     base,
     mini-http-server,
     bytestring
-  ghc-options: -Wall
+  ghc-options: -threaded