haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-01 13:50:25 +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 module Handler.Hoogle where
import Control.DeepSeq (NFData(..))
import Control.DeepSeq.Generics (genericRnf)
import Control.Spoon (spoon) import Control.Spoon (spoon)
import Data.Data (Data (..)) import Data.Data (Data (..))
import Data.Slug (SnapSlug) import Data.Slug (SnapSlug)
import Data.Text.Read (decimal) import Data.Text.Read (decimal)
import Filesystem (isFile)
import Handler.Haddock (dirHoogleFp, getDirs) import Handler.Haddock (dirHoogleFp, getDirs)
import qualified Hoogle import qualified Hoogle
import Import import Import
import Text.Blaze.Html (preEscapedToHtml) import Text.Blaze.Html (preEscapedToHtml)
import Control.DeepSeq (NFData(..))
import Control.DeepSeq.Generics (genericRnf)
getHoogleR :: SnapSlug -> Handler Html getHoogleR :: SnapSlug -> Handler Html
getHoogleR slug = do getHoogleR slug = do
@ -27,9 +28,15 @@ getHoogleR slug = do
Just (Right (i, "")) -> i Just (Right (i, "")) -> i
_ -> 1 _ -> 1
offset = (page - 1) * perPage 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"] let databasePath = dirHoogleFp dirs (stackageIdent stackage) ["default.hoo"]
heDatabase = liftIO $ Hoogle.loadDatabase (fpToString databasePath) 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 mresults <- case mquery of
Just query -> runHoogleQuery heDatabase HoogleQueryInput Just query -> runHoogleQuery heDatabase HoogleQueryInput
{ hqiQueryInput = query { hqiQueryInput = query