haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-23 01:11:56 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Prevent concurrent Hoogle queries #172

Browse Source
This commit is contained in:
Michael Snoyman 2016-05-08 11:39:19 +03:00
parent 4b953f8585
commit c5f16f2faa
3 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Application.hs
View File

@ -146,6 +146,7 @@ makeFoundation useEcho conf = do
, updateAction = getLatestMatcher manager , updateAction = getLatestMatcher manager
} }
hoogleLock <- newMVar ()
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App foundation = App
{ settings = conf { settings = conf
@ -156,6 +157,7 @@ makeFoundation useEcho conf = do
, websiteContent = websiteContent' , websiteContent = websiteContent'
, stackageDatabase = stackageDatabase' , stackageDatabase = stackageDatabase'
, latestStackMatcher = latestStackMatcher' , latestStackMatcher = latestStackMatcher'
, appHoogleLock = hoogleLock
} }
return foundation return foundation

3
Foundation.hs
View File

@ -30,6 +30,9 @@ data App = App
, stackageDatabase :: IO StackageDatabase , stackageDatabase :: IO StackageDatabase
, latestStackMatcher :: IO (Text -> Maybe Text) , latestStackMatcher :: IO (Text -> Maybe Text)
-- ^ Give a pattern, get a URL -- ^ 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 instance HasGenIO App where

5
Handler/Hoogle.hs
View File

@ -37,8 +37,11 @@ getHoogleR name = do
Just x -> return $ liftIO $ Hoogle.loadDatabase x Just x -> return $ liftIO $ Hoogle.loadDatabase x
Nothing -> hoogleDatabaseNotAvailableFor name Nothing -> hoogleDatabaseNotAvailableFor name
-- Avoid concurrent Hoogle queries, see
-- https://github.com/fpco/stackage-server/issues/172
lock <- appHoogleLock <$> getYesod
mresults <- case mquery of mresults <- case mquery of
Just query -> runHoogleQuery heDatabase HoogleQueryInput Just query -> withMVar lock $ const $ runHoogleQuery heDatabase HoogleQueryInput
{ hqiQueryInput = query { hqiQueryInput = query
, hqiExactSearch = if exact then Just query else Nothing , hqiExactSearch = if exact then Just query else Nothing
, hqiLimitTo = count' , hqiLimitTo = count'