From b6fee0e084f3eb512fa73f0ab5da1702297e74a8 Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Sun, 9 Mar 2025 15:04:16 +0100 Subject: [PATCH] feat(users/Profpatsch/whatcd-resolver): show latest releases MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Let’s start improving the main page. So far, it was just all release groups sorted by weight on a single page, which was not super helpful (and got kinda large). The first feature is to show the latest releases that are known. This is done by torrent group ID. This ID does not always correspond to the date, but can also be a very old album that gets uploaded, or (seldomly) a group that gets merged for metadata. We should think about restricting this to favourites, automatically marking everything as favourite where we have an album downloaded or clicked on the artist before, and then selectively allow to un-mark it after the fact. An even stronger “not interested” could be used to automatically reclaim seedbox space once it becomes an issue. Eventually (after implementing favourites), we should introduce a job system that automatically updates these entries every few hours. Maybe even have a “very interested” feature that automatically downloads everything new for an artist? And then a “veryvery interested” feature that also buys the thing from bandcamp lol Change-Id: I467c350722279ff37150f847f5014d7e0e67e626 Reviewed-on: https://cl.tvl.fyi/c/depot/+/13225 Tested-by: BuildkiteCI Reviewed-by: Profpatsch --- .../whatcd-resolver/src/Redacted.hs | 14 ++- .../whatcd-resolver/src/WhatcdResolver.hs | 113 +++++++++--------- 2 files changed, 66 insertions(+), 61 deletions(-) diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs index 402bce298..2ea681654 100644 --- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs +++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs @@ -622,9 +622,12 @@ getTorrentById dat = do data GetBestTorrentsFilter = GetBestTorrentsFilter { onlyArtist :: Maybe (Label "artistRedactedId" Int), onlyTheseTorrents :: Maybe ([Label "torrentId" Int]), - limitResults :: Maybe Natural + limitResults :: Maybe Natural, + ordering :: BestTorrentsOrdering } +data BestTorrentsOrdering = BySeedingWeight | ByLastReleases + -- | Find the best torrent for each torrent group (based on the seeding_weight) getBestTorrents :: (MonadPostgres m) => @@ -632,7 +635,7 @@ getBestTorrents :: Transaction m [TorrentData ()] getBestTorrents opts = do queryWith - [sql| + ( [sql| WITH filtered_torrents AS ( SELECT DISTINCT ON (torrent_group) id @@ -669,9 +672,14 @@ getBestTorrents opts = do FROM filtered_torrents f JOIN redacted.torrents t ON t.id = f.id JOIN redacted.torrent_groups tg ON tg.id = t.torrent_group - ORDER BY seeding_weight DESC + |] + <> case opts.ordering of + BySeedingWeight -> [fmt|ORDER BY seeding_weight DESC|] <> "\n" + ByLastReleases -> [fmt|ORDER BY tg.group_id DESC|] <> "\n" + <> [sql| LIMIT ?::int |] + ) ( do let (onlyArtistB, onlyArtistId) = case opts.onlyArtist of Nothing -> (True, 0) diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs index 70e30b02b..926691565 100644 --- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs +++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs @@ -156,20 +156,23 @@ htmlUi = do res <- t (table, settings) <- concurrentlyTraced - ( getBestTorrentsTable - (t2 #groupByReleaseType True #limitResults Nothing) - ( Just - ( E21 - (label @"onlyTheseTorrents" res.newTorrents) - ) :: - Maybe - ( E2 - "onlyTheseTorrents" - [Label "torrentId" Int] - "artistRedactedId" - Int - ) - ) + ( do + d <- + getBestTorrentsData + (t2 #limitResults Nothing #ordering BySeedingWeight) + ( Just + ( E21 + (label @"onlyTheseTorrents" res.newTorrents) + ) :: + Maybe + ( E2 + "onlyTheseTorrents" + [Label "torrentId" Int] + "artistRedactedId" + Int + ) + ) + pure $ mkBestTorrentsTableByReleaseType d ) (getSettings) pure $ @@ -376,7 +379,12 @@ htmlUi = do -- <&> renderJsonld (bestTorrentsTable, settings) <- concurrentlyTraced - (getBestTorrentsTable (t2 #groupByReleaseType False #limitResults (Just 1000)) Nothing) + ( do + d <- getBestTorrentsData (t2 #limitResults (Just 30) #ordering ByLastReleases) Nothing + pure $ case d & nonEmpty of + Nothing -> [hsx|

Last Releases

No torrents found

|] + Just d' -> mkBestTorrentsTableSection (lbl #sectionName "Last Releases") d' + ) (getSettings) -- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable pure $ @@ -420,7 +428,7 @@ mainHtml' dat = do {dat.mainContent} - + /> --> |] withAsyncTraced :: (MonadUnliftIO m) => m a -> (Async a -> m b) -> m b @@ -580,11 +588,11 @@ artistPage dat = runTransaction $ do (fresh, settings) <- concurrentlyTraced ( getBestTorrentsData - (label @"limitResults" Nothing) + (t2 #limitResults Nothing #ordering BySeedingWeight) (Just $ E22 (getLabel @"artistRedactedId" dat)) ) (getSettings) - let torrents = mkBestTorrentsTable (label @"groupByReleaseType" True) fresh + let torrents = mkBestTorrentsTableByReleaseType fresh let returnUrl = textToBytesUtf8 $ @@ -809,22 +817,6 @@ data ArtistFilter = ArtistFilter { onlyArtist :: Maybe (Label "artistId" Text) } -getBestTorrentsTable :: - ( MonadTransmission m, - MonadThrow m, - MonadLogger m, - MonadPostgres m, - MonadOtel m, - HasField "groupByReleaseType" opts Bool, - HasField "limitResults" opts (Maybe Natural) - ) => - opts -> - Maybe (E2 "onlyTheseTorrents" [Label "torrentId" Int] "artistRedactedId" Int) -> - Transaction m Html -getBestTorrentsTable opts dat = do - fresh <- getBestTorrentsData opts dat - pure $ mkBestTorrentsTable opts fresh - doIfJust :: (Applicative f) => (a -> f ()) -> Maybe a -> f () doIfJust = traverse_ @@ -834,7 +826,8 @@ getBestTorrentsData :: MonadLogger m, MonadPostgres m, MonadOtel m, - HasField "limitResults" opts (Maybe Natural) + HasField "limitResults" opts (Maybe Natural), + HasField "ordering" opts BestTorrentsOrdering ) => opts -> Maybe (E2 "onlyTheseTorrents" [Label "torrentId" Int] "artistRedactedId" Int) -> @@ -846,6 +839,7 @@ getBestTorrentsData opts filters = inSpan' "get torrents table data" $ \span -> onlyTheseTorrents & doIfJust (\a -> addAttribute span "torrent-filter.ids" (a <&> (getLabel @"torrentId") & showToText & Otel.toAttribute)) let limitResults = getField @"limitResults" opts + let ordering = opts.ordering let getBest = getBestTorrents GetBestTorrentsFilter {..} bestStale :: [TorrentData ()] <- getBest (statusInfo, transmissionStatus) <- @@ -894,12 +888,25 @@ getBestTorrentsData opts filters = inSpan' "get torrents table data" $ \span -> NoTorrentFileYet -> td {torrentStatus = NoTorrentFileYet} ) -mkBestTorrentsTable :: - (HasField "groupByReleaseType" opts Bool) => - opts -> +mkBestTorrentsTableByReleaseType :: [TorrentData (Label "percentDone" Percentage)] -> Html -mkBestTorrentsTable opts fresh = do +mkBestTorrentsTableByReleaseType fresh = + fresh + & toList + & groupAllWithComparison ((.releaseType) >$< releaseTypeComparison) + & foldMap + ( \ts -> do + let releaseType = ts & NonEmpty.head & (.releaseType.stringKey) + mkBestTorrentsTableSection (lbl #sectionName [fmt|{releaseType}s|]) ts + ) + +mkBestTorrentsTableSection :: + (HasField "sectionName" opts Text) => + opts -> + NonEmpty (TorrentData (Label "percentDone" Percentage)) -> + Html +mkBestTorrentsTableSection opts torrents = do let localTorrent b = case b.torrentStatus of NoTorrentFileYet -> [hsx| @@ -949,11 +956,9 @@ mkBestTorrentsTable opts fresh = do |] ) - let section :: NonEmpty (TorrentData (Label "percentDone" Percentage)) -> Html - section rows = do - let releaseType = rows & NonEmpty.head & (.releaseType.stringKey) - [hsx| -

{releaseType}s

+ + [hsx| +

{opts.sectionName}

@@ -969,23 +974,11 @@ mkBestTorrentsTable opts fresh = do - {bestRows rows} + {bestRows torrents}
|] - case fresh & nonEmpty of - Nothing -> [hsx|No torrents found|] - Just fresh' -> do - ( if opts.groupByReleaseType - then - fresh' - & toList - & groupAllWithComparison ((.releaseType) >$< releaseTypeComparison) - else [fresh'] - ) - & foldMap section - mkLinkList :: [T2 "url" Text "content" Html] -> Html mkLinkList xs = xs @@ -1510,6 +1503,10 @@ t2 :: forall l1 t1 l2 t2. LabelPrx l1 -> t1 -> LabelPrx l2 -> t2 -> T2 l1 t1 l2 {-# INLINE t2 #-} t2 LabelPrx a LabelPrx b = T2 (label @l1 a) (label @l2 b) +t3 :: forall l1 t1 l2 t2 l3 t3. LabelPrx l1 -> t1 -> LabelPrx l2 -> t2 -> LabelPrx l3 -> t3 -> T3 l1 t1 l2 t2 l3 t3 +{-# INLINE t3 #-} +t3 LabelPrx a LabelPrx b LabelPrx c = T3 (label @l1 a) (label @l2 b) (label @l3 c) + lbl :: forall l t. LabelPrx l -> t -> Label l t {-# INLINE lbl #-} lbl LabelPrx a = label @l a