diff --git a/config/routes b/config/routes index 7c8fb83..cf4e549 100644 --- a/config/routes +++ b/config/routes @@ -17,6 +17,8 @@ /cabal.config StackageCabalConfigR GET /00-index.tar.gz StackageIndexR GET /package/#PackageNameVersion StackageSdistR GET + /package/#PackageNameVersion/deps SnapshotPackageDepsR GET + /package/#PackageNameVersion/revdeps SnapshotPackageRevDepsR GET /packages SnapshotPackagesR GET /docs DocsR GET /hoogle HoogleR GET @@ -33,6 +35,8 @@ /package/#PackageName/snapshots PackageSnapshotsR GET /package/#PackageName/badge/#SnapshotBranch PackageBadgeR GET /package PackageListR GET +/package/#PackageName/deps PackageDepsR GET +/package/#PackageName/revdeps PackageRevDepsR GET /authors AuthorsR GET /install InstallR GET @@ -51,4 +55,4 @@ /stack DownloadStackListR GET /stack/#Text DownloadStackR GET -/status/mirror MirrorStatusR GET \ No newline at end of file +/status/mirror MirrorStatusR GET diff --git a/src/Application.hs b/src/Application.hs index 5d0e78c..29b3b4e 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -47,6 +47,7 @@ import Handler.StackageSdist import Handler.System import Handler.Haddock import Handler.Package +import Handler.PackageDeps import Handler.PackageList import Handler.Hoogle import Handler.BuildVersion diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs index 39b3b04..84a0bdc 100644 --- a/src/Handler/Package.hs +++ b/src/Handler/Package.hs @@ -64,8 +64,9 @@ packagePage mversion pname = track "Handler.Package.packagePage" $ do let pname' = toPathPiece pname (deprecated, inFavourOf) <- getDeprecated pname' latests <- getLatests pname' - deps' <- getDeps pname' - revdeps' <- getRevDeps pname' + deps' <- getDeps pname' $ Just maxDisplayedDeps + revdeps' <- getRevDeps pname' $ Just maxDisplayedDeps + (depsCount, revdepsCount) <- getDepsCount pname' Entity _ package <- getPackage pname' >>= maybe notFound return mdocs <- @@ -134,6 +135,16 @@ packagePage mversion pname = track "Handler.Package.packagePage" $ do pathRev' = component:pathRev path' = T.intercalate "." $ reverse pathRev' + maxDisplayedDeps :: Int + maxDisplayedDeps = 40 + + (packageDepsLink, packageRevDepsLink) = + case mversion of + Nothing -> (PackageDepsR pname, PackageRevDepsR pname) + Just (snap, version) -> + let wrap f = SnapshotR snap $ f $ PNVNameVersion pname version + in (wrap SnapshotPackageDepsR, wrap SnapshotPackageRevDepsR) + -- | An identifier specified in a package. Because this field has -- quite liberal requirements, we often encounter various forms. A -- name, a name and email, just an email, or maybe nothing at all. diff --git a/src/Handler/PackageDeps.hs b/src/Handler/PackageDeps.hs new file mode 100644 index 0000000..1c7b456 --- /dev/null +++ b/src/Handler/PackageDeps.hs @@ -0,0 +1,59 @@ +module Handler.PackageDeps + ( getPackageDepsR + , getPackageRevDepsR + , getSnapshotPackageDepsR + , getSnapshotPackageRevDepsR + ) where + +import Import +import Stackage.Database + +getPackageDepsR :: PackageName -> Handler Html +getPackageDepsR = packageDeps Nothing + +getSnapshotPackageDepsR :: SnapName -> PackageNameVersion -> Handler Html +getSnapshotPackageDepsR snap (PNVNameVersion pname version) = + packageDeps (Just (snap, version)) pname +getSnapshotPackageDepsR _ _ = notFound + +packageDeps :: Maybe (SnapName, Version) -> PackageName -> Handler Html +packageDeps = helper Deps + +getPackageRevDepsR :: PackageName -> Handler Html +getPackageRevDepsR = packageRevDeps Nothing + +getSnapshotPackageRevDepsR :: SnapName -> PackageNameVersion -> Handler Html +getSnapshotPackageRevDepsR snap (PNVNameVersion pname version) = + packageRevDeps (Just (snap, version)) pname +getSnapshotPackageRevDepsR _ _ = notFound + +packageRevDeps :: Maybe (SnapName, Version) -> PackageName -> Handler Html +packageRevDeps = helper Revdeps + +data DepType = Deps | Revdeps + +helper :: DepType -> Maybe (SnapName, Version) -> PackageName -> Handler Html +helper depType mversion pname = track "Handler.PackageDeps.helper" $ do + deps <- + (case depType of + Deps -> getDeps + Revdeps -> getRevDeps) (toPathPiece pname) Nothing + let packagePage = + case mversion of + Nothing -> PackageR pname + Just (snap, version) -> SnapshotR snap $ StackageSdistR $ PNVNameVersion pname version + defaultLayout $ do + let title = toHtml $ + (case depType of + Deps -> "Dependencies" + Revdeps -> "Reverse dependencies ") ++ " for " ++ toPathPiece pname + setTitle title + [whamlet| +

#{title} +

+ Return to package page +