More conservative chunking

src/Embeddings.hs

@@ -26,7 +26,6 @@ import Data.Functor.Contravariant ((>$<))
 import Data.Generics.Product (HasType, typed)
 import Data.List (sortOn)
 import Data.Map.Strict qualified as Map
-import Data.Maybe (mapMaybe)
 import Data.Ord (Down (..))
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -194,10 +193,10 @@ hardWrap t
   | T.null t = []
   | otherwise = let (a, b) = T.splitAt (chunkMaxTokens * 3) t in a : hardWrap b
 
-coalesceBlocks :: [Text] -> [Text]
-coalesceBlocks blocks = reverse (go [] 0 blocks)
+coalesceBlocks :: Int -> [Text] -> [Text]
+coalesceBlocks titleSize blocks = reverse (go [] 0 blocks)
   where
-    chunkMaxChars = chunkMaxTokens * 3
+    chunkMaxChars = (chunkMaxTokens * 3) - titleSize
 
     go :: [Text] -> Int -> [Text] -> [Text]
     go acc _ [] = [T.concat (reverse acc) | not (null acc)]
@@ -216,9 +215,10 @@ coalesceBlocks blocks = reverse (go [] 0 blocks)
 
 chunkArticle :: Text -> Text -> [Text]
 chunkArticle title_ html =
-  map (prefixTitle title_) (coalesceBlocks (extractBlocks html))
+  map (prefixTitle title_) (coalesceBlocks titleSize (extractBlocks html))
   where
     prefixTitle t chunk = "Title: " <> t <> "\n\n" <> chunk
+    titleSize = T.length ("Title: " <> title_)
 
 processEntry ::
   ( MonadIO m,