diff --git a/Handler/Package.hs b/Handler/Package.hs index a83558f..8c1ad07 100644 --- a/Handler/Package.hs +++ b/Handler/Package.hs @@ -245,3 +245,32 @@ postPackageUntagR packageName = ,TagTag ==. slug ,TagVoter ==. uid])) Nothing -> error "Need a slug" + +getPackageSnapshotsR :: PackageName -> Handler Html +getPackageSnapshotsR pn = + do let haddocksLink ident version = + HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]] + muid <- maybeAuthId + snapshots <- (runDB . + fmap (map reformat) . + E.select . E.from) + (\(p,s) -> + do E.where_ $ + (p ^. PackageStackage E.==. s ^. StackageId) &&. + (p ^. PackageName' E.==. E.val pn) + E.orderBy [E.desc $ s ^. StackageUploaded] + return + (p ^. PackageVersion + ,s ^. StackageTitle + ,s ^. StackageSlug + ,s ^. StackageHasHaddocks)) + defaultLayout + (do setTitle ("Packages for " >> toHtml pn) + $(combineStylesheets 'StaticR + [css_font_awesome_min_css]) + $(widgetFile "package-snapshots")) + where reformat (Value version,Value title,Value ident,Value hasHaddocks) = + (version + ,fromMaybe title (stripPrefix "Stackage build for " title) + ,ident + ,hasHaddocks) diff --git a/config/routes b/config/routes index 8463bc2..cd27a81 100644 --- a/config/routes +++ b/config/routes @@ -33,6 +33,7 @@ /system SystemR GET /haddock/#SnapSlug/*Texts HaddockR GET /package/#PackageName PackageR GET +/package/#PackageName/snapshots PackageSnapshotsR GET /package PackageListR GET /compressor-status CompressorStatusR GET /package/#PackageName/like PackageLikeR POST diff --git a/templates/package-snapshots.hamlet b/templates/package-snapshots.hamlet new file mode 100644 index 0000000..7b58fc8 --- /dev/null +++ b/templates/package-snapshots.hamlet @@ -0,0 +1,21 @@ +$newline never +
| + Package + | + Snapshot + $forall (version, title, slug, hasHaddocks) <- snapshots + | |
|---|---|---|
| + $if hasHaddocks + + Docs + | + #{version} + | + #{fromMaybe title $ stripSuffix ", exclusive" title} |