(Mostly) reenable Hoogle

Handler/Hoogle.hs

@@ -10,11 +10,12 @@ import           Import
 import           Text.Blaze.Html (preEscapedToHtml)
 import Stackage.Database
 
+getHoogleDB :: SnapName -> Handler (Maybe FilePath)
+getHoogleDB _ = return Nothing -- FIXME
+
 getHoogleR :: SnapName -> Handler Html
-getHoogleR slug = do
+getHoogleR name = do
-    error "getHoogleR"
+    Entity _ snapshot <- lookupSnapshot name >>= maybe notFound return
-    {- FIXME
-    dirs <- getDirs
     mquery <- lookupGetParam "q"
     mpage <- lookupGetParam "page"
     exact <- maybe False (const True) <$> lookupGetParam "exact"
@@ -28,11 +29,10 @@ getHoogleR slug = do
                 Just (Right (i, "")) -> i
                 _ -> 1
         offset = (page - 1) * perPage
-    Entity _ stackage <- runDB $ getBy404 $ UniqueSnapshot slug
+    mdatabasePath <- getHoogleDB name
-    mdatabasePath <- getHoogleDB dirs stackage
     heDatabase <- case mdatabasePath of
         Just x -> return $ liftIO $ Hoogle.loadDatabase $ fpToString x
-        Nothing -> hoogleDatabaseNotAvailableFor slug
+        Nothing -> hoogleDatabaseNotAvailableFor name
 
     mresults <- case mquery of
         Just query -> runHoogleQuery heDatabase HoogleQueryInput
@@ -43,36 +43,31 @@ getHoogleR slug = do
             }
         Nothing -> return $ HoogleQueryOutput "" [] Nothing
     let queryText = fromMaybe "" mquery
-        pageLink p = (SnapshotR slug HoogleR
+        pageLink p = (SnapshotR name HoogleR
             , (if exact then (("exact", "true"):) else id)
             $ (maybe id (\q' -> (("q", q'):)) mquery)
               [("page", tshow p)])
-        snapshotLink = SnapshotR slug StackageHomeR
+        snapshotLink = SnapshotR name StackageHomeR
         hoogleForm = $(widgetFile "hoogle-form")
     defaultLayout $ do
         setTitle "Hoogle Search"
         $(widgetFile "hoogle")
-    -}
 
 getHoogleDatabaseR :: SnapName -> Handler Html
-getHoogleDatabaseR slug = do
+getHoogleDatabaseR name = do
-    error "getHoogleDatabaseR"
+    mdatabasePath <- getHoogleDB name
-    {-
-    dirs <- getDirs
-    Entity _ stackage <- runDB $ getBy404 $ UniqueSnapshot slug
-    mdatabasePath <- getHoogleDB dirs stackage
     case mdatabasePath of
-        Nothing -> hoogleDatabaseNotAvailableFor slug
+        Nothing -> hoogleDatabaseNotAvailableFor name
         Just path -> sendFile "application/octet-stream" $ fpToString path
 
-hoogleDatabaseNotAvailableFor :: SnapSlug -> Handler a
+hoogleDatabaseNotAvailableFor :: SnapName -> Handler a
-hoogleDatabaseNotAvailableFor slug = (>>= sendResponse) $ defaultLayout $ do
+hoogleDatabaseNotAvailableFor name = (>>= 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
+                <a href=@{SnapshotR name StackageHomeR}>Return to snapshot homepage
     |]
 
 getPageCount :: Int -> Int
@@ -170,4 +165,3 @@ runHoogleQuery heDatabase HoogleQueryInput {..} =
             modu' = ModuleLink moduname modu
         return $ asMap $ singletonMap pkg' [modu']
     getPkgModPair _ = Nothing
-    -}

templates/hoogle.hamlet

@@ -1,7 +1,7 @@
 <div .container>
     <div .content>
         <h1>Hoogle Search (experimental)
-        <p>Within <a href=@{snapshotLink}>#{stackageTitle stackage}</a>
+        <p>Within <a href=@{snapshotLink}>#{snapshotTitle snapshot}</a>
         ^{hoogleForm}
         $case mresults
             $of HoogleQueryBad err