From 985f48a6dcf7fcdd84fefe561218685517556bd1 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 20 Nov 2014 12:26:45 +0200
Subject: [PATCH] Banned tags #34

---
 Handler/Package.hs | 10 +++++++---
 Handler/Tag.hs     |  6 +++++-
 config/models      |  4 ++++
 3 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/Handler/Package.hs b/Handler/Package.hs
index 31e5469..31377ab 100644
--- a/Handler/Package.hs
+++ b/Handler/Package.hs
@@ -45,9 +45,13 @@ getPackageR pn = do
 
     tags <- fmap (map (\(E.Value v) -> v))
                  (runDB (E.selectDistinct
-                             (E.from (\t -> do E.where_ (t ^. TagPackage E.==. E.val pn)
-                                               E.orderBy [E.asc (t ^. TagTag)]
-                                               return (t ^. TagTag)))))
+                             (E.from (\(t `E.LeftOuterJoin` bt) -> do
+                                E.on $ t E.^. TagTag E.==. bt E.^. BannedTagTag
+                                E.where_
+                                    $ (t ^. TagPackage E.==. E.val pn) E.&&.
+                                      (E.isNothing $ E.just $ bt E.^. BannedTagTag)
+                                E.orderBy [E.asc (t ^. TagTag)]
+                                return (t ^. TagTag)))))
 
     let likeTitle = if liked
                        then "You liked this!"
diff --git a/Handler/Tag.hs b/Handler/Tag.hs
index 8966dc5..eeb8574 100644
--- a/Handler/Tag.hs
+++ b/Handler/Tag.hs
@@ -8,9 +8,11 @@ import           Import
 getTagListR :: Handler Html
 getTagListR = do
     tags <- fmap (zip [0::Int ..] . (map (\(E.Value v,E.Value i) -> (v,i::Int)))) $ runDB $
-        E.select $ E.from $ \tag -> do
+        E.select $ E.from $ \(tag `E.LeftOuterJoin` bt) -> do
             E.groupBy (tag E.^. TagTag)
             E.orderBy [E.desc (E.count (tag E.^. TagTag) :: E.SqlExpr (E.Value Int))]
+            E.on $ tag E.^. TagTag E.==. bt E.^. BannedTagTag
+            E.where_ $ E.isNothing $ E.just $ bt E.^. BannedTagTag
             return (tag E.^. TagTag, E.count (tag E.^. TagTag))
     defaultLayout $ do
         setTitle "Stackage tags"
@@ -18,6 +20,8 @@ getTagListR = do
 
 getTagR :: Slug -> Handler Html
 getTagR tagSlug = do
+    -- FIXME arguably: check if this tag is banned. Leaving it as displayed for
+    -- now, since someone needs to go out of their way to find it.
     packages <- fmap (map (\(E.Value t,E.Value s) -> (t,strip s))) $ runDB $
         E.select $ E.from $ \(tag,meta) -> do
             E.where_ (tag E.^. TagTag E.==. E.val tagSlug E.&&.
diff --git a/config/models b/config/models
index 676595a..ada38e3 100644
--- a/config/models
+++ b/config/models
@@ -84,3 +84,7 @@ Metadata
     licenseContent Html Maybe
 
     UniqueMetadata name
+
+BannedTag
+    tag Slug
+    UniqueBannedTag tag