From 346cf7a8da77ec7634f13b25ce44bb0cea18ba22 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 8 Dec 2014 16:15:56 +0200
Subject: [PATCH] Reverse dependencies #33

---
 Application.hs           |  4 ++++
 Handler/Package.hs       | 17 +++++++++++++++--
 config/models            |  5 +++++
 templates/package.hamlet |  9 +++++++++
 4 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/Application.hs b/Application.hs
index 1e9df82..e353347 100644
--- a/Application.hs
+++ b/Application.hs
@@ -282,6 +282,10 @@ appLoadCabalFiles updateDB forceUpdate env dbconf p = do
             let newMD' = toList newMD
             deleteWhere [MetadataName <-. map metadataName newMD']
             insertMany_ newMD'
+            forM_ newMD' $ \md -> do
+                deleteWhere [DependencyUser ==. metadataName md]
+                insertMany_ $ flip map (metadataDeps md) $ \dep ->
+                    Dependency (PackageName dep) (metadataName md)
         let views =
                 [ ("pvp", viewPVP uploadHistory)
                 , ("no-bounds", viewNoBounds)
diff --git a/Handler/Package.hs b/Handler/Package.hs
index 2887624..a793f81 100644
--- a/Handler/Package.hs
+++ b/Handler/Package.hs
@@ -23,7 +23,7 @@ getPackageR pn = do
         haddocksLink ident version =
             HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]]
     muid <- maybeAuthId
-    (packages, downloads, recentDownloads, nLikes, liked, Entity _ metadata) <- runDB $ do
+    (packages, downloads, recentDownloads, nLikes, liked, Entity _ metadata, revdeps') <- runDB $ do
         packages <- fmap (map reformat) $ E.select $ E.from $ \(p, s) -> do
             E.where_ $ (p ^. PackageStackage E.==. s ^. StackageId)
                    &&. (p ^. PackageName' E.==. E.val pn)
@@ -41,7 +41,19 @@ getPackageR pn = do
         recentDownloads <- count [DownloadPackage ==. pn, DownloadTimestamp >=. nowMinus30]
         metadata <- getBy404 (UniqueMetadata pn)
 
-        return (packages, downloads, recentDownloads, nLikes, liked, metadata)
+        revdeps' <- E.select $ E.from $ \dep -> do
+            E.where_ $ dep ^. DependencyDep E.==. E.val pn
+            E.orderBy [E.asc $ dep ^. DependencyUser]
+            return $ dep ^. DependencyUser
+
+        return ( packages
+               , downloads
+               , recentDownloads
+               , nLikes
+               , liked
+               , metadata
+               , map E.unValue revdeps'
+               )
 
     myTags <-
         case muid of
@@ -70,6 +82,7 @@ getPackageR pn = do
                        else "I like this!" :: Text
 
     let deps = enumerate (metadataDeps metadata)
+        revdeps = enumerate revdeps'
         authors = enumerate (parseIdentitiesLiberally (metadataAuthor metadata))
         maintainers = let ms = enumerate (parseIdentitiesLiberally (metadataMaintainer metadata))
                       in if ms == authors
diff --git a/config/models b/config/models
index ab91d2b..75ef561 100644
--- a/config/models
+++ b/config/models
@@ -87,6 +87,11 @@ Metadata
 
     UniqueMetadata name
 
+Dependency
+    dep PackageName
+    user PackageName
+    UniqueDependency dep user
+
 BannedTag
     tag Slug
     UniqueBannedTag tag
diff --git a/templates/package.hamlet b/templates/package.hamlet
index fd8f26a..073353b 100644
--- a/templates/package.hamlet
+++ b/templates/package.hamlet
@@ -103,6 +103,15 @@ $newline never
                             , #
                         <a href=@{PackageR (PackageName name)}>
                             #{name}
+            $if not $ null revdeps
+              <div .reverse-dependencies>
+                Used by
+                <div .dep-list>
+                    $forall (i,name) <- revdeps
+                        $if i /= 0
+                            , #
+                        <a href=@{PackageR name}>
+                            #{name}
         $if not (null packages)
             <div .span6 .snapshots>
                <table .table .snapshots>