about summary refs log tree commit diff
path: root/users/Profpatsch
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2024-05-15T12·09+0200
committerclbot <clbot@tvl.fyi>2024-06-03T14·55+0000
commitb54ad3e5806b60096c40830d08bd6a813703e74e (patch)
tree512911db1c96053467b381ec80f1a75cf6a05095 /users/Profpatsch
parenta3a03a5a80209245867704a3b5425d4ae55f7458 (diff)
feat(users/Profpatsch/whatcd-resolver): add artist albums r/8200
Simple artist album page that only shows albums the artist was
involved with.

Change-Id: Icff34afc6d1b39b6fb17765c1b3ea500dd4b4d95
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11675
Tested-by: BuildkiteCI
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>
Diffstat (limited to 'users/Profpatsch')
-rw-r--r--users/Profpatsch/whatcd-resolver/src/JsonLd.hs1
-rw-r--r--users/Profpatsch/whatcd-resolver/src/Redacted.hs53
-rw-r--r--users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs31
3 files changed, 67 insertions, 18 deletions
diff --git a/users/Profpatsch/whatcd-resolver/src/JsonLd.hs b/users/Profpatsch/whatcd-resolver/src/JsonLd.hs
index 16b1ab991b..1a021b706c 100644
--- a/users/Profpatsch/whatcd-resolver/src/JsonLd.hs
+++ b/users/Profpatsch/whatcd-resolver/src/JsonLd.hs
@@ -3,7 +3,6 @@
 module JsonLd where
 
 import AppT
-import Control.Monad.Reader
 import Data.Aeson qualified as Json
 import Data.Aeson.BetterErrors qualified as Json
 import Data.ByteString.Builder qualified as Builder
diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
index bc13d049ed..0c16c70c21 100644
--- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
@@ -362,10 +362,15 @@ data TorrentData transmissionInfo = TorrentData
     seedingWeight :: Int,
     artists :: [T2 "artistId" Int "artistName" Text],
     torrentJson :: Json.Value,
-    torrentGroupJson :: T2 "groupName" Text "groupYear" Int,
+    torrentGroupJson :: TorrentGroupJson,
     torrentStatus :: TorrentStatus transmissionInfo
   }
 
+data TorrentGroupJson = TorrentGroupJson
+  { groupName :: Text,
+    groupYear :: Int
+  }
+
 data TorrentStatus transmissionInfo
   = NoTorrentFileYet
   | NotInTransmissionYet
@@ -382,30 +387,58 @@ getTorrentById dat = do
     (Dec.json Json.asValue)
     >>= ensureSingleRow
 
+data GetBestTorrentsFilter = GetBestTorrentsFilter
+  { onlyDownloaded :: Bool,
+    onlyArtist :: Maybe (Label "artistId" Natural)
+  }
+
 -- | Find the best torrent for each torrent group (based on the seeding_weight)
-getBestTorrents :: (MonadPostgres m, HasField "onlyDownloaded" opts Bool) => opts -> Transaction m [TorrentData ()]
+getBestTorrents ::
+  (MonadPostgres m) =>
+  GetBestTorrentsFilter ->
+  Transaction m [TorrentData ()]
 getBestTorrents opts = do
   queryWith
     [sql|
-      SELECT * FROM (
-        SELECT DISTINCT ON (group_id)
+      SELECT
+        group_id,
+        torrent_id,
+        seeding_weight,
+        torrent_json,
+        torrent_group_json,
+        has_torrent_file,
+        transmission_torrent_hash
+      FROM (
+        SELECT DISTINCT ON (tg.group_id)
           tg.group_id,
           t.torrent_id,
           seeding_weight,
           t.full_json_result AS torrent_json,
           tg.full_json_result AS torrent_group_json,
           t.torrent_file IS NOT NULL as has_torrent_file,
-          t.transmission_torrent_hash
+          t.transmission_torrent_hash,
+          (jsonb_path_query_array(t.full_json_result, '$.artists[*].id')) as torrent_artists
         FROM redacted.torrents t
         JOIN redacted.torrent_groups tg ON tg.id = t.torrent_group
-        ORDER BY group_id, seeding_weight DESC
+        ORDER BY tg.group_id, seeding_weight DESC
       ) as _
       WHERE
         -- onlyDownloaded
         ((NOT ?::bool) OR has_torrent_file)
+        -- filter by artist id
+        AND
+        (?::bool OR (to_jsonb(?::int) <@ torrent_artists))
       ORDER BY seeding_weight DESC
     |]
-    (Only opts.onlyDownloaded :: Only Bool)
+    ( do
+        let (onlyArtistB, onlyArtistId) = case opts.onlyArtist of
+              Nothing -> (True, 0)
+              Just a -> (False, a.artistId)
+        ( opts.onlyDownloaded :: Bool,
+          onlyArtistB :: Bool,
+          onlyArtistId & fromIntegral @Natural @Int
+          )
+    )
     ( do
         groupId <- Dec.fromField @Int
         torrentId <- Dec.fromField @Int
@@ -419,9 +452,9 @@ getBestTorrents opts = do
           pure (val, artists)
         torrentGroupJson <-
           ( Dec.json $ do
-              groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
-              groupYear <- Json.keyLabel @"groupYear" "groupYear" (Json.asIntegral @_ @Int)
-              pure $ T2 groupName groupYear
+              groupName <- Json.key "groupName" Json.asText
+              groupYear <- Json.key "groupYear" (Json.asIntegral @_ @Int)
+              pure $ TorrentGroupJson {..}
             )
         hasTorrentFile <- Dec.fromField @Bool
         transmissionTorrentHash <-
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index 0a8d7dcebb..fe6a36baca 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -213,7 +213,7 @@ htmlUi = do
 
                     htmlWithQueryArgs
                       ( label @"dbId"
-                          <$> (singleQueryArgument "db_id" Field.utf8)
+                          <$> (singleQueryArgument "db_id" (Field.utf8 >>> Field.decimalNatural))
                       )
                       $ \qry _span -> do
                         artistPage qry
@@ -256,7 +256,7 @@ htmlUi = do
       --       "https://musicbrainz.org/work/92000fd4-d304-406d-aeb4-6bdbeed318ec"
       --     )
       --     <&> renderJsonld
-      bestTorrentsTable <- getBestTorrentsTable
+      bestTorrentsTable <- getBestTorrentsTable Nothing
       -- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable
       pure $
         Html.docTypeHtml
@@ -305,11 +305,23 @@ htmlUi = do
       </body>
     |]
 
-artistPage :: (HasField "dbId" dat Text, Applicative m) => dat -> m Html
-artistPage dat = do
+artistPage ::
+  ( HasField "dbId" dat Natural,
+    MonadPostgres m,
+    MonadOtel m,
+    MonadLogger m,
+    MonadThrow m,
+    MonadTransmission m
+  ) =>
+  dat ->
+  m Html
+artistPage dat = runTransaction $ do
+  torrents <- getBestTorrentsTable (Just $ label @"artistId" dat.dbId)
   pure
     [hsx|
     Artist ID: {dat.dbId}
+
+    {torrents}
   |]
 
 type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived)
@@ -451,7 +463,11 @@ snipsRedactedSearch dat = do
       ]
   runTransaction $ do
     t
-    getBestTorrentsTable
+    getBestTorrentsTable (Nothing :: Maybe (Label "artistId" Natural))
+
+data ArtistFilter = ArtistFilter
+  { onlyArtist :: Maybe (Label "artistId" Text)
+  }
 
 getBestTorrentsTable ::
   ( MonadTransmission m,
@@ -460,9 +476,10 @@ getBestTorrentsTable ::
     MonadPostgres m,
     MonadOtel m
   ) =>
+  Maybe (Label "artistId" Natural) ->
   Transaction m Html
-getBestTorrentsTable = do
-  bestStale :: [TorrentData ()] <- getBestTorrents (label @"onlyDownloaded" False)
+getBestTorrentsTable artistFilter = do
+  bestStale :: [TorrentData ()] <- getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False}
   actual <-
     getAndUpdateTransmissionTorrentsStatus
       ( bestStale