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

Fixed Handler.Tag

Browse Source
This commit is contained in:
Michael Snoyman 2015-05-14 16:24:21 +03:00
parent 79bc1a9662
commit 0dc4cab5da
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Handler/Tag.hs
View File

@ -3,7 +3,7 @@ module Handler.Tag where
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import Data.Slug (Slug, unSlug) import Data.Slug (Slug, unSlug)
import Import import Import
import Stackage.Database
getTagListR :: Handler Html getTagListR :: Handler Html
getTagListR = do getTagListR = do
@ -20,19 +20,17 @@ getTagListR = do
getTagR :: Slug -> Handler Html getTagR :: Slug -> Handler Html
getTagR tagSlug = do getTagR tagSlug = do
error "getTagR"
{-
-- FIXME arguably: check if this tag is banned. Leaving it as displayed for -- 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. -- 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 $ tags <- runDB $ selectList [TagTag ==. tagSlug] [Asc TagPackage]
E.selectDistinct $ E.from $ \(tag,meta) -> do packages <- fmap catMaybes $ forM tags $ \(Entity _ t) -> do
E.where_ (tag E.^. TagTag E.==. E.val tagSlug E.&&. let pname = tagPackage t
meta E.^. MetadataName E.==. tag E.^. TagPackage) mp <- getPackage $ toPathPiece pname
E.orderBy [E.asc (tag E.^. TagPackage)] return $ case mp of
return (tag E.^. TagPackage,meta E.^. MetadataSynopsis) Nothing -> Nothing
Just (Entity _ p) -> Just (pname, strip $ packageSynopsis p)
let tag = unSlug tagSlug let tag = unSlug tagSlug
defaultLayout $ do defaultLayout $ do
setTitle $ "Stackage tag" setTitle $ "Stackage tag"
$(widgetFile "tag") $(widgetFile "tag")
where strip x = fromMaybe x (stripSuffix "." x) where strip x = fromMaybe x (stripSuffix "." x)
-}