Module listing

Handler/Alias.hs

@@ -6,7 +6,7 @@ module Handler.Alias
 
 import Import
 import Data.Slug (Slug)
-import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR, getSnapshotPackagesR)
+import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR, getSnapshotPackagesR, getDocsR)
 import Handler.StackageIndex (getStackageIndexR, getStackageBundleR)
 import Handler.StackageSdist (getStackageSdistR)
 
@@ -76,4 +76,5 @@ goSid sid pieces = do
                 StackageBundleR -> getStackageBundleR slug >>= sendResponse
                 StackageSdistR pnv -> getStackageSdistR slug pnv >>= sendResponse
                 SnapshotPackagesR -> getSnapshotPackagesR slug >>= sendResponse
+                DocsR -> getDocsR slug >>= sendResponse
         _ -> notFound

Handler/StackageHome.hs

@@ -220,3 +220,30 @@ getSnapshotPackagesR slug = do
             $(widgetFile "package-list")
   where strip x = fromMaybe x (stripSuffix "." x)
         mback = Just (SnapshotR slug StackageHomeR, "Return to snapshot")
+
+getDocsR :: SnapSlug -> Handler Html
+getDocsR slug = do
+    Entity sid _stackage <- runDB $ getBy404 $ UniqueSnapshot slug
+    defaultLayout $ do
+        setTitle $ toHtml $ "Module list for " ++ toPathPiece slug
+        cachedWidget (20 * 60) ("module-list-" ++ toPathPiece slug) $ do
+            modules' <- handlerToWidget $ runDB $ E.select $ E.from $ \(d,m) -> do
+                E.where_ $
+                    (d E.^. DocsSnapshot E.==. E.val (Just sid)) E.&&.
+                    (d E.^. DocsId E.==. m E.^. ModuleDocs)
+                E.orderBy [ E.asc $ m E.^. ModuleName
+                          , E.asc $ d E.^. DocsName
+                          ]
+                return
+                    ( m E.^. ModuleName
+                    , m E.^. ModuleUrl
+                    , d E.^. DocsName
+                    , d E.^. DocsVersion
+                    )
+            let modules = flip map modules' $ \(name, url, package, version) ->
+                    ( E.unValue name
+                    , E.unValue url
+                    , E.unValue package
+                    , E.unValue version
+                    )
+            $(widgetFile "doc-list")

config/routes

@@ -24,6 +24,7 @@
     /bundle StackageBundleR GET
     /package/#PackageNameVersion StackageSdistR GET
     /packages SnapshotPackagesR GET
+    /docs DocsR GET
 
 /hackage-view/#HackageView/00-index.tar.gz HackageViewIndexR GET
 /hackage-view/#HackageView/package/#PackageNameVersion HackageViewSdistR GET

templates/doc-list.hamlet

@@ -0,0 +1,8 @@
+<h1>Module listing for #{toPathPiece slug}
+<p>
+    <a href=@{SnapshotR slug DocsR}>Return to snapshot
+<ul>
+    $forall (name, url, package, version) <- modules
+        <li>
+            <a href=#{url}>#{name}
+            (#{package}-#{version})