Force search index evaluation on startup

This commit is contained in:
paul-brinkmeier 2025-07-10 23:15:52 +02:00
parent 11ed38d364
commit 911e0f5f4f
3 changed files with 13 additions and 4 deletions

View File

@ -13,6 +13,9 @@
module Main (main) where module Main (main) where
import Control.DeepSeq (force)
import Control.Exception (evaluate)
import Control.Monad (void)
import Data.Char (chr) import Data.Char (chr)
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import Data.Foldable (for_) import Data.Foldable (for_)
@ -55,7 +58,12 @@ import qualified UToy.Names as Names
import qualified UToy.Parsers as Parsers import qualified UToy.Parsers as Parsers
main :: IO () main :: IO ()
main = Warp.run 3000 app main = do
-- Forced evaluation of Names.lowerNames to reduce number of thunks.
putStrLn "* Building search index"
void $ evaluate $ force Names.lowerNames
putStrLn "* Listening on http://localhost:3000"
Warp.run 3000 app
app :: Application app :: Application
app = serve (Proxy :: Proxy API) server app = serve (Proxy :: Proxy API) server

View File

@ -1,4 +1,4 @@
module UToy.Names (allNames, blockName, searchCaseInsensitive) where module UToy.Names (allNames, blockName, lowerNames, searchCaseInsensitive) where
import Data.Char (ord) import Data.Char (ord)
import Data.Maybe (maybeToList) import Data.Maybe (maybeToList)
@ -25,7 +25,7 @@ searchCaseInsensitive search = filter go [minBound..maxBound]
go c = any matches $ Vector.unsafeIndex lowerNames (ord c - ord minBound) go c = any matches $ Vector.unsafeIndex lowerNames (ord c - ord minBound)
matches t = Text.toLower search `Text.isInfixOf` t matches t = Text.toLower search `Text.isInfixOf` t
lowerNames :: Vector [Text] lowerNames :: Vector (Vector Text)
lowerNames = Vector.fromList $ map go [minBound..maxBound] lowerNames = Vector.fromList $ map go [minBound..maxBound]
where where
go = map Text.toLower . allNames go = Vector.fromList . map Text.toLower . allNames

View File

@ -46,6 +46,7 @@ executable utoy
, base >=4.7 && <5 , base >=4.7 && <5
, blaze-html , blaze-html
, bytestring , bytestring
, deepseq
, file-embed , file-embed
, http-media , http-media
, servant-server , servant-server