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