Skip to content

bugfix: use normal release if no master release exists #77

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 20, 2025
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 43 additions & 27 deletions .github/scripts/pull_album_info/app/Main.hs
Original file line number Diff line number Diff line change
@@ -1,19 +1,22 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Main where

-- Standard library imports
import Control.Exception (SomeException, try)
import System.Environment (getArgs, getProgName, lookupEnv)
import System.FilePath (takeDirectory)

-- Third-party library imports
import Control.Lens (Identity (runIdentity), (^?))
import Data.Aeson (FromJSON (parseJSON), ToJSON,
Value (Object), decodeStrict, (.:))
import Data.Aeson.Key (fromString)
import Data.Aeson.Lens (AsNumber (_Integer), key, nth)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
Expand All @@ -23,14 +26,12 @@ import GHC.Generics (Generic)
import Network.HTTP.Simple (Query, getResponseBody, httpBS,
parseRequest_, setRequestHeader,
setRequestQueryString)
import System.FilePath (takeDirectory)
import Text.Ginger (IncludeResolver, SourcePos, Template,
ToGVal (..), dict, easyRender,
parseGinger)
import Control.Exception (try, SomeException)

-- Data type definitions
data MainRelease = MainRelease {
data Release = Release {
artists :: [String],
title :: String,
year :: Int,
Expand All @@ -40,9 +41,9 @@ data MainRelease = MainRelease {
uri :: String
} deriving (Show, Eq, Generic)

instance ToJSON MainRelease
instance ToJSON Release

instance ToGVal m MainRelease where
instance ToGVal m Release where
toGVal release = dict [
("artists", toGVal . L.intercalate ", " . artists $ release),
("title", toGVal $ title release),
Expand All @@ -53,8 +54,7 @@ instance ToGVal m MainRelease where
("uri", toGVal $ uri release)
]


instance FromJSON MainRelease where
instance FromJSON Release where
parseJSON (Object v) = do
artists <- v .: "artists" >>= traverse (.: "name")
title <- v .: "title"
Expand All @@ -66,7 +66,7 @@ instance FromJSON MainRelease where
[] -> fail "No images found"
labels <- v .: "labels" >>= traverse (.: "name")
uri <- v .: "uri"
return MainRelease {
return Release {
artists = artists,
title = title,
year = year,
Expand All @@ -91,35 +91,54 @@ runDiscogsQuery query url = do
parseRequest_ url
getResponseBody <$> httpBS request

getMasterReleaseId :: String -> String -> IO String
getMasterReleaseId artistName albumName = do
data ReleaseType = Master | Regular deriving (Show)

toQueryParams :: ReleaseType -> (String, String)
toQueryParams Master = ("master", "master_id")
toQueryParams Regular = ("release", "id")

fetchReleaseIdByType :: String -> String -> ReleaseType -> IO String
fetchReleaseIdByType artistName albumName releaseType = do
let url = "https://api.discogs.com/database/search"
(queryType, queryKey) = toQueryParams releaseType
query =
[ ("artist", Just $ BS.pack artistName),
("release_title", Just $ BS.pack albumName),
("type", Just "master")
("type", Just $ BS.pack queryType)
]
body <- BS.unpack <$> runDiscogsQuery query url
case body ^? key "results" . nth 0 . key "master_id" . _Integer of
Just masterId -> return $ show masterId
Nothing -> fail "Failed to extract master_id from the response"
case body ^? key "results" . nth 0 . key (fromString queryKey) . _Integer of
Just idValue -> return $ show idValue
Nothing -> fail $ "Failed to extract " ++ queryKey ++ " from the response"

getMainReleaseId :: String -> IO String
getMainReleaseId masterId = do
fetchMainReleaseId :: String -> IO String
fetchMainReleaseId masterId = do
let url = "https://api.discogs.com/masters/" ++ masterId
body <- BS.unpack <$> runDiscogsQuery [] url
case body ^? key "main_release" . _Integer of
Just mainId -> return $ show mainId
Nothing -> fail "Failed to extract main_release from the response"

getMainRelease :: String -> IO MainRelease
getMainRelease releaseId = do
-- | Fetches the master release ID. If fetching the master release ID fails,
-- it falls back to fetching the first item's ID where the type is 'release'.
-- This ensures that a valid release ID is returned even if the master release
-- ID is unavailable.
getReleaseId :: String -> String -> IO String
getReleaseId artistName albumName = do
result <- try (fetchReleaseIdByType artistName albumName Master) :: IO (Either SomeException String)
case result of
Right masterId -> fetchMainReleaseId masterId
Left _ -> fetchReleaseIdByType artistName albumName Regular

getRelease :: String -> IO Release
getRelease releaseId = do
let url = "https://api.discogs.com/releases/" ++ releaseId
body <- runDiscogsQuery [] url
case (decodeStrict body :: Maybe MainRelease) of
case (decodeStrict body :: Maybe Release) of
Just release -> return release
Nothing -> fail "Cannot decode main release"

-- Template rendering
nullResolver :: IncludeResolver Identity
nullResolver = const $ return Nothing

Expand All @@ -134,12 +153,9 @@ templatePath = do

runGenAlbumPost :: String -> String -> IO String
runGenAlbumPost artistName albumName = do
-- Get the MainRelease of the album
release <- getMasterReleaseId artistName albumName
>>= getMainReleaseId
>>= getMainRelease
content <- templatePath >>= readFile
return $ T.unpack . easyRender release $ getTemplate content
release <- getReleaseId artistName albumName >>= getRelease
content <- templatePath >>= readFile
return $ T.unpack . easyRender release $ getTemplate content

-- Main function
main :: IO ()
Expand Down