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

Banned tags #34

Browse Source
This commit is contained in:
Michael Snoyman 2014-11-20 12:26:45 +02:00
parent fe4cda60f8
commit 985f48a6dc
3 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Handler/Package.hs
View File

@ -45,9 +45,13 @@ getPackageR pn = do
tags <- fmap (map (\(E.Value v) -> v)) tags <- fmap (map (\(E.Value v) -> v))
(runDB (E.selectDistinct (runDB (E.selectDistinct
(E.from (\t -> do E.where_ (t ^. TagPackage E.==. E.val pn) (E.from (\(t `E.LeftOuterJoin` bt) -> do
E.orderBy [E.asc (t ^. TagTag)] E.on $ t E.^. TagTag E.==. bt E.^. BannedTagTag
return (t ^. TagTag))))) 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 let likeTitle = if liked
then "You liked this!" then "You liked this!"

6
Handler/Tag.hs
View File

@ -8,9 +8,11 @@ import Import
getTagListR :: Handler Html getTagListR :: Handler Html
getTagListR = do getTagListR = do
tags <- fmap (zip [0::Int ..] . (map (\(E.Value v,E.Value i) -> (v,i::Int)))) $ runDB $ 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.groupBy (tag E.^. TagTag)
E.orderBy [E.desc (E.count (tag E.^. TagTag) :: E.SqlExpr (E.Value Int))] 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)) return (tag E.^. TagTag, E.count (tag E.^. TagTag))
defaultLayout $ do defaultLayout $ do
setTitle "Stackage tags" setTitle "Stackage tags"
@ -18,6 +20,8 @@ getTagListR = do
getTagR :: Slug -> Handler Html getTagR :: Slug -> Handler Html
getTagR tagSlug = do 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 $ packages <- fmap (map (\(E.Value t,E.Value s) -> (t,strip s))) $ runDB $
E.select $ E.from $ \(tag,meta) -> do E.select $ E.from $ \(tag,meta) -> do
E.where_ (tag E.^. TagTag E.==. E.val tagSlug E.&&. E.where_ (tag E.^. TagTag E.==. E.val tagSlug E.&&.

4
config/models
View File

@ -84,3 +84,7 @@ Metadata
licenseContent Html Maybe licenseContent Html Maybe
UniqueMetadata name UniqueMetadata name
BannedTag
tag Slug
UniqueBannedTag tag