Merge pull request #86 from fpco/download-hoogle-db

Add download link for hoogle database

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

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|
-                <div .container>
-                    <p>The given Hoogle database is not available.
-                    <p>
-                        <a href=@{SnapshotR slug StackageHomeR}>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|
+        <div .container>
+            <p>The given Hoogle database is not available.
+            <p>
+                <a href=@{SnapshotR slug StackageHomeR}>Return to snapshot homepage
+    |]
+
 getPageCount :: Int -> Int
 getPageCount totalCount = 1 + div totalCount perPage
 

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

templates/stackage-home.hamlet

@@ -39,6 +39,8 @@ $newline never
 
     <h3>Hoogle (experimental)
     ^{hoogleForm}
+    <a href=@{SnapshotR slug HoogleDatabaseR}>
+      Download this hoogle database
 
     <h3>Packages