diff --git a/Handler/Package.hs b/Handler/Package.hs index 940dd77..fc99d99 100644 --- a/Handler/Package.hs +++ b/Handler/Package.hs @@ -10,6 +10,7 @@ import qualified Data.Text.Encoding as T import Data.Time (addUTCTime) import Database.Esqueleto ((^.), (&&.), Value (Value)) import qualified Database.Esqueleto as E +import qualified Database.Persist as P import Formatting import Import import Text.Email.Validate @@ -22,7 +23,8 @@ getPackageR pn = do asInt = id haddocksLink ident version = HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]] - (packages, downloads, recentDownloads, Entity _ metadata) <- runDB $ do + muid <- maybeAuthId + (packages, downloads, recentDownloads, nLikes, liked, Entity _ metadata) <- 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) @@ -31,12 +33,19 @@ getPackageR pn = do E.limit maxSnaps --selectList [PackageName' ==. pn] [LimitTo 10, Desc PackageStackage] return (p ^. PackageVersion, s ^. StackageTitle, s ^. StackageIdent, s ^. StackageHasHaddocks) + nLikes <- count [LikePackage ==. pn] + let getLiked uid = (>0) <$> count [LikePackage ==. pn, LikeVoter ==. uid] + liked <- maybe (return False) getLiked muid downloads <- count [DownloadPackage ==. pn] now <- liftIO getCurrentTime let nowMinus30 = addUTCTime (-30 * 24 * 60 * 60) now recentDownloads <- count [DownloadPackage ==. pn, DownloadTimestamp >=. nowMinus30] metadata <- getBy404 (UniqueMetadata pn) - return (packages, downloads, recentDownloads, metadata) + + return (packages, downloads, recentDownloads, nLikes, liked, metadata) + + let likedClass = if liked then "fa-thumbs-up" else "fa-thumbs-o-up" :: Text + let deps = enumerate (metadataDeps metadata) authors = enumerate (parseIdentitiesLiberally (metadataAuthor metadata)) maintainers = let ms = enumerate (parseIdentitiesLiberally (metadataMaintainer metadata)) @@ -151,3 +160,19 @@ renderEmail = T.decodeUtf8 . toByteString -- | Format a number with commas nicely. formatNum :: Int -> Text formatNum = sformat commas + +postPackageLikeR :: PackageName -> Handler () +postPackageLikeR packageName = maybeAuthId >>= \muid -> case muid of + Nothing -> return () + Just uid -> do + runDB $ P.insert $ Like packageName uid + return () + +postPackageUnlikeR :: PackageName -> Handler () +postPackageUnlikeR name = maybeAuthId >>= \muid -> case muid of + Nothing -> return () + Just uid -> do + runDB $ E.delete $ E.from $ \like -> + E.where_ $ like ^. LikePackage E.==. E.val name + &&. like ^. LikeVoter E.==. E.val uid + return () diff --git a/config/models b/config/models index 3e17533..593ff09 100644 --- a/config/models +++ b/config/models @@ -47,6 +47,10 @@ Tag tag Slug voter UserId +Like + package PackageName + voter UserId + Download ident PackageSetIdent Maybe view HackageView Maybe diff --git a/config/routes b/config/routes index 015dfd8..199cc1d 100644 --- a/config/routes +++ b/config/routes @@ -27,3 +27,5 @@ /package/#PackageName PackageR GET /package PackageListR GET /compressor-status CompressorStatusR GET +/package/#PackageName/like PackageLikeR POST +/package/#PackageName/unlike PackageUnlikeR POST diff --git a/templates/package.hamlet b/templates/package.hamlet index c77417d..0cf469f 100644 --- a/templates/package.hamlet +++ b/templates/package.hamlet @@ -32,9 +32,11 @@ $newline never