Prevent concurrent Hoogle queries #172
This commit is contained in:
parent
4b953f8585
commit
c5f16f2faa
3 changed files with 9 additions and 1 deletions
|
@ -146,6 +146,7 @@ makeFoundation useEcho conf = do
|
|||
, updateAction = getLatestMatcher manager
|
||||
}
|
||||
|
||||
hoogleLock <- newMVar ()
|
||||
let logger = Yesod.Core.Types.Logger loggerSet' getter
|
||||
foundation = App
|
||||
{ settings = conf
|
||||
|
@ -156,6 +157,7 @@ makeFoundation useEcho conf = do
|
|||
, websiteContent = websiteContent'
|
||||
, stackageDatabase = stackageDatabase'
|
||||
, latestStackMatcher = latestStackMatcher'
|
||||
, appHoogleLock = hoogleLock
|
||||
}
|
||||
|
||||
return foundation
|
||||
|
|
|
@ -30,6 +30,9 @@ data App = App
|
|||
, stackageDatabase :: IO StackageDatabase
|
||||
, latestStackMatcher :: IO (Text -> Maybe Text)
|
||||
-- ^ Give a pattern, get a URL
|
||||
, appHoogleLock :: MVar ()
|
||||
-- ^ Avoid concurrent Hoogle queries, see
|
||||
-- https://github.com/fpco/stackage-server/issues/172
|
||||
}
|
||||
|
||||
instance HasGenIO App where
|
||||
|
|
|
@ -37,8 +37,11 @@ getHoogleR name = do
|
|||
Just x -> return $ liftIO $ Hoogle.loadDatabase x
|
||||
Nothing -> hoogleDatabaseNotAvailableFor name
|
||||
|
||||
-- Avoid concurrent Hoogle queries, see
|
||||
-- https://github.com/fpco/stackage-server/issues/172
|
||||
lock <- appHoogleLock <$> getYesod
|
||||
mresults <- case mquery of
|
||||
Just query -> runHoogleQuery heDatabase HoogleQueryInput
|
||||
Just query -> withMVar lock $ const $ runHoogleQuery heDatabase HoogleQueryInput
|
||||
{ hqiQueryInput = query
|
||||
, hqiExactSearch = if exact then Just query else Nothing
|
||||
, hqiLimitTo = count'
|
||||
|
|
Loading…
Reference in a new issue