From ede7ea7148cb173e24fbf70e79a259cebbf4e6e8 Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Mon, 3 Aug 2026 21:29:22 -0400
Subject: fig-web: Add leaderboards

---
 fig-web/src/Fig/Web/MaudeCode.hs          |  2 +-
 fig-web/src/Fig/Web/Module/Leaderboard.hs | 36 +++++++++++++++++++++++++++++++
 fig-web/src/Fig/Web/Public.hs             |  2 ++
 3 files changed, 39 insertions(+), 1 deletion(-)
 create mode 100644 fig-web/src/Fig/Web/Module/Leaderboard.hs

(limited to 'fig-web/src/Fig')

diff --git a/fig-web/src/Fig/Web/MaudeCode.hs b/fig-web/src/Fig/Web/MaudeCode.hs
index 306ffa7..0eac748 100644
--- a/fig-web/src/Fig/Web/MaudeCode.hs
+++ b/fig-web/src/Fig/Web/MaudeCode.hs
@@ -36,7 +36,7 @@ newtype RequestChatCompletions = RequestChatCompletions
 instance Aeson.FromJSON RequestChatCompletions where
   parseJSON = Aeson.withObject "RequestChatCompletions" \o -> do
     messages :: [Aeson.Object] <- o Aeson..: "messages"
-    msg <- maybe (pure "") (Aeson..: "content") $ lastMaybe messages
+    msg <- maybe (pure "") (Aeson..: "content") $ lastMay messages
     let message = Text.replace "\n" " " msg
     pure RequestChatCompletions{..}
 
diff --git a/fig-web/src/Fig/Web/Module/Leaderboard.hs b/fig-web/src/Fig/Web/Module/Leaderboard.hs
new file mode 100644
index 0000000..1b093a1
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Leaderboard.hs
@@ -0,0 +1,36 @@
+module Fig.Web.Module.Leaderboard
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import qualified Lucid as L
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import Fig.Utils.DB (DB)
+import qualified Fig.Utils.DB as DB
+
+leaderboardKey :: ByteString -> ByteString
+leaderboardKey = ("leaderboard:"<>)
+
+fetchLeaderboard :: MonadIO m => DB -> ByteString -> m [(Text, Text, Double)]
+fetchLeaderboard db lid = DB.run db do
+  top <- DB.zrevrange (leaderboardKey lid) 0 (-1)
+  forM top $ \(uid, score) -> do
+    name <- fromMaybe uid <$> DB.hget ("user:properties:" <> uid) "name"
+    pure (decodeUtf8 uid, decodeUtf8 name, score)
+
+public :: PublicModule
+public a = do
+  onGet "/leaderboard/:lid" do
+    lid <- pathParam "lid"
+    top10 <- fetchLeaderboard a.db lid
+    respondHTML do
+      head_ . title_ . L.toHtml $ "LCOLONQ Leaderboard: " <> decodeUtf8 lid
+      body_ do
+        ol_ $ forM_ top10 $ \(_, key, score) -> do
+          li_ . L.toHtml $ key <> ": " <> tshow score
+  onGet "/api/leaderboard/:lid" do
+    lid <- pathParam "lid"
+    respondJSON =<< fetchLeaderboard a.db lid
diff --git a/fig-web/src/Fig/Web/Public.hs b/fig-web/src/Fig/Web/Public.hs
index 8263d90..4d2e05a 100644
--- a/fig-web/src/Fig/Web/Public.hs
+++ b/fig-web/src/Fig/Web/Public.hs
@@ -28,6 +28,7 @@ import qualified Fig.Web.Module.HLS as HLS
 import qualified Fig.Web.Module.TCG as TCG
 import qualified Fig.Web.Module.Debt as Debt
 import qualified Fig.Web.Module.ShindigsSorting as ShindigsSorting
+import qualified Fig.Web.Module.Leaderboard as Leaderboard
 
 allBusEvents :: PublicModuleArgs -> BusEventHandlers
 allBusEvents args = busEvents . mconcat $ fmap ($ args)
@@ -103,6 +104,7 @@ app args = do
     TCG.public args
     Debt.public args
     ShindigsSorting.public args
+    Leaderboard.public args
     websocket $ mconcat
       [ Gizmo.publicWebsockets args
       , Circle.publicWebsockets args
-- 
cgit v1.3.1