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

Create Hoogle DB on demand, if necessary #47

Browse Source
This commit is contained in:
Michael Sloan 2014-12-27 23:24:11 -08:00
parent eeb0aae9d9
commit 3229c1ef56
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Handler/Hoogle.hs
View File

@ -1,15 +1,16 @@
module Handler.Hoogle where
import Control.DeepSeq (NFData(..))
import Control.DeepSeq.Generics (genericRnf)
import Control.Spoon (spoon)
import Data.Data (Data (..))
import Data.Slug (SnapSlug)
import Data.Text.Read (decimal)
import Filesystem (isFile)
import Handler.Haddock (dirHoogleFp, getDirs)
import qualified Hoogle
import Import
import Text.Blaze.Html (preEscapedToHtml)
import Control.DeepSeq (NFData(..))
import Control.DeepSeq.Generics (genericRnf)
getHoogleR :: SnapSlug -> Handler Html
getHoogleR slug = do
@ -27,9 +28,15 @@ getHoogleR slug = do
Just (Right (i, "")) -> i
_ -> 1
offset = (page - 1) * perPage
Entity _ stackage <- runDB $ getBy404 $ UniqueSnapshot slug
stackageEnt@(Entity _ stackage) <- runDB $ getBy404 $ UniqueSnapshot slug
-- Unpack haddocks and generate hoogle DB, if necessary.
master <- getYesod
liftIO $ haddockUnpacker master False stackageEnt
let databasePath = dirHoogleFp dirs (stackageIdent stackage) ["default.hoo"]
heDatabase = liftIO $ Hoogle.loadDatabase (fpToString databasePath)
-- If the hoogle DB isn't yet generated, yield 404.
dbExists <- liftIO $ isFile databasePath
when (not dbExists) notFound
mresults <- case mquery of
Just query -> runHoogleQuery heDatabase HoogleQueryInput
{ hqiQueryInput = query