diff --git a/Handler/Alias.hs b/Handler/Alias.hs index 1aacdd2..ad6179f 100644 --- a/Handler/Alias.hs +++ b/Handler/Alias.hs @@ -9,7 +9,7 @@ import Data.Slug (Slug) import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR, getSnapshotPackagesR, getDocsR) import Handler.StackageIndex (getStackageIndexR) import Handler.StackageSdist (getStackageSdistR) -import Handler.Hoogle (getHoogleR) +import Handler.Hoogle (getHoogleR, getHoogleDatabaseR) import Handler.BuildPlan (getBuildPlanR) handleAliasR :: Slug -> Slug -> [Text] -> Handler () @@ -79,5 +79,6 @@ goSid sid pieces = do SnapshotPackagesR -> getSnapshotPackagesR slug >>= sendResponse DocsR -> getDocsR slug >>= sendResponse HoogleR -> getHoogleR slug >>= sendResponse + HoogleDatabaseR -> getHoogleDatabaseR slug >>= sendResponse BuildPlanR -> getBuildPlanR slug >>= sendResponse _ -> notFound diff --git a/Handler/Hoogle.hs b/Handler/Hoogle.hs index 98868f2..0d18311 100644 --- a/Handler/Hoogle.hs +++ b/Handler/Hoogle.hs @@ -32,14 +32,7 @@ getHoogleR slug = do mdatabasePath <- getHoogleDB dirs stackage heDatabase <- case mdatabasePath of Just x -> return $ liftIO $ Hoogle.loadDatabase $ fpToString x - Nothing -> (>>= sendResponse) $ defaultLayout $ do - setTitle "Hoogle database not available" - [whamlet| -
-

The given Hoogle database is not available. -

- Return to snapshot homepage - |] + Nothing -> hoogleDatabaseNotAvailableFor slug mresults <- case mquery of Just query -> runHoogleQuery heDatabase HoogleQueryInput @@ -60,6 +53,25 @@ getHoogleR slug = do setTitle "Hoogle Search" $(widgetFile "hoogle") +getHoogleDatabaseR :: SnapSlug -> Handler Html +getHoogleDatabaseR slug = do + dirs <- getDirs + Entity _ stackage <- runDB $ getBy404 $ UniqueSnapshot slug + mdatabasePath <- getHoogleDB dirs stackage + case mdatabasePath of + Nothing -> hoogleDatabaseNotAvailableFor slug + Just path -> sendFile "application/octet-stream" $ fpToString path + +hoogleDatabaseNotAvailableFor :: SnapSlug -> Handler a +hoogleDatabaseNotAvailableFor slug = (>>= sendResponse) $ defaultLayout $ do + setTitle "Hoogle database not available" + [whamlet| +

+

The given Hoogle database is not available. +

+ Return to snapshot homepage + |] + getPageCount :: Int -> Int getPageCount totalCount = 1 + div totalCount perPage diff --git a/config/routes b/config/routes index ef493b5..9fc3c7a 100644 --- a/config/routes +++ b/config/routes @@ -26,6 +26,7 @@ /packages SnapshotPackagesR GET /docs DocsR GET /hoogle HoogleR GET + /db.hoo HoogleDatabaseR GET /build-plan BuildPlanR GET /aliases AliasesR PUT diff --git a/templates/stackage-home.hamlet b/templates/stackage-home.hamlet index 15f3b25..599634c 100644 --- a/templates/stackage-home.hamlet +++ b/templates/stackage-home.hamlet @@ -39,6 +39,8 @@ $newline never

Hoogle (experimental) ^{hoogleForm} + + Download this hoogle database

Packages