haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-07 16:47:27 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Module listing

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-25 15:01:14 +02:00
parent 5cb2a6a296
commit cb36a196ba
4 changed files with 38 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Handler/Alias.hs
View File

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

27
Handler/StackageHome.hs
View File

@ -220,3 +220,30 @@ getSnapshotPackagesR slug = do
$(widgetFile "package-list") $(widgetFile "package-list")
where strip x = fromMaybe x (stripSuffix "." x) where strip x = fromMaybe x (stripSuffix "." x)
mback = Just (SnapshotR slug StackageHomeR, "Return to snapshot") 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")

1
config/routes
View File

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

8
templates/doc-list.hamlet Normal file
View File

@ -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})