From 1a2b75d02cf18c8310c0098839dbdada1ab32532 Mon Sep 17 00:00:00 2001 From: jecaro Date: Thu, 25 Jun 2026 15:26:33 +0200 Subject: [PATCH 01/23] Rename Album -> Disc --- README.md | 8 +- app/ConduitUtils.hs | 14 ++-- app/Main.hs | 22 +++--- app/Options.hs | 44 +++++------ app/Stats.hs | 8 +- data/htagcli.toml | 22 +++--- htagcli.cabal | 6 +- lib/Check/Artist.hs | 6 +- lib/Check/{Album.hs => Disc.hs} | 24 +++--- lib/Commands.hs | 24 +++--- lib/Config.hs | 60 +++++++------- lib/Model/Album.hs | 100 ------------------------ lib/Model/Artist.hs | 34 ++++---- lib/Model/Disc.hs | 100 ++++++++++++++++++++++++ tests/Main.hs | 4 +- tests/Tests/Check/Artist.hs | 26 +++--- tests/Tests/Check/{Album.hs => Disc.hs} | 98 +++++++++++------------ tests/Tests/Common.hs | 40 +++++----- 18 files changed, 319 insertions(+), 321 deletions(-) rename lib/Check/{Album.hs => Disc.hs} (82%) delete mode 100644 lib/Model/Album.hs create mode 100644 lib/Model/Disc.hs rename tests/Tests/Check/{Album.hs => Disc.hs} (53%) diff --git a/README.md b/README.md index 5c3496a..f50ce11 100644 --- a/README.md +++ b/README.md @@ -90,12 +90,12 @@ collection clean and well-organized. Available checks include: - Missing tags: Detects files with missing tag fields - Genre: Verifies that the genre exists in a predefined list - File path: Ensures that the file path follows a given pattern -- Album level: - - Album directory: Checks that all files from an album are stored in the +- Disc level: + - Disc directory: Checks that all files from a disc are stored in the same directory - - Cover file: Checks the presence of a cover image in the album directory. + - Cover file: Checks the presence of a cover image in the disc directory. Also verifies that the cover image size is within specified limits. - - Album tags: Checks that the tags from all files in an album are the same + - Disc tags: Checks that the tags from all files in a disc are the same - Artist level: - Genre: Ensures that all tracks from an artist share the same genre diff --git a/app/ConduitUtils.hs b/app/ConduitUtils.hs index a267007..b9a1a20 100644 --- a/app/ConduitUtils.hs +++ b/app/ConduitUtils.hs @@ -1,11 +1,11 @@ -module ConduitUtils (runConduitWithProgress, albumC, artistC) where +module ConduitUtils (runConduitWithProgress, discC, artistC) where import Conduit ((.|)) import Conduit qualified import Data.Text qualified as Text -import Model.Album qualified as Album import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc import Options qualified import Path qualified import Path.IO qualified as Path @@ -41,15 +41,15 @@ filesC Options.Files {..} = do ) .| Conduit.mapMC Path.parseAbsFile -albumC :: +discC :: (Monad m) => - Conduit.ConduitT AudioTrack.AudioTrack Album.Album m () -albumC = clusterC Album.mkAlbum Album.addTrack + Conduit.ConduitT AudioTrack.AudioTrack Disc.Disc m () +discC = clusterC Disc.mkDisc Disc.addTrack artistC :: (Monad m) => - Conduit.ConduitT Album.Album Artist.Artist m () -artistC = clusterC Artist.mkArtist Artist.addAlbum + Conduit.ConduitT Disc.Disc Artist.Artist m () +artistC = clusterC Artist.mkArtist Artist.addDisc -- | Cluster incoming items into groups using the provided 'mk' and 'add' -- functions diff --git a/app/Main.hs b/app/Main.hs index b1325ad..086e655 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -39,7 +39,7 @@ errorToText (ParseError parseError) = "Failed to parse the edited tags:\n" <> Text.pack (Megaparsec.errorBundlePretty parseError) errorToText MoveCoverWithoutCheck = - "move_cover is enabled but checks.album_cover is disabled." + "move_cover is enabled but checks.disc_cover is disabled." main :: IO () main = do @@ -93,24 +93,24 @@ main = do config <- Config.readConfig -- Get the checks from the CLI and fallback to the config file - let (trackChecks, albumChecks, mbArtistCheck) = Options.checks config options + let (trackChecks, discChecks, mbArtistCheck) = Options.checks config options - when (null trackChecks && null albumChecks && null mbArtistCheck) $ + when (null trackChecks && null discChecks && null mbArtistCheck) $ Exception.throwIO NoCheckInConfig stats <- newIORef Stats.empty let modifyStats = modifyIORef' stats addTrackErrors = modifyStats . Stats.addTrackErrors - addAlbumErrors = modifyStats . Stats.addAlbumErrors + addDiscErrors = modifyStats . Stats.addDiscErrors incArtistErrors = modifyStats Stats.incArtistErrors ConduitUtils.runConduitWithProgress files $ Conduit.mapM AudioTrack.getTags .| Conduit.iterM (addTrackErrors <=< Commands.checkTrack trackChecks) - .| ConduitUtils.albumC + .| ConduitUtils.discC .| Conduit.iterM - (addAlbumErrors <=< Commands.checkAlbum albumChecks) + (addDiscErrors <=< Commands.checkDisc discChecks) .| ConduitUtils.artistC .| Conduit.mapM_C (flip when incArtistErrors <=< Commands.checkArtist mbArtistCheck) @@ -119,14 +119,14 @@ main = do unless (null trackChecks) $ putTextLn $ "Track errors: " <> show ceTrackErrors - unless (null albumChecks) $ + unless (null discChecks) $ putTextLn $ - "Album errors: " <> show ceAlbumErrors + "Disc errors: " <> show ceDiscErrors when (isJust mbArtistCheck) $ putTextLn $ "Artist errors: " <> show ceArtistErrors - let total = ceTrackErrors + ceAlbumErrors + ceArtistErrors + let total = ceTrackErrors + ceDiscErrors + ceArtistErrors when (total > 0) $ System.exitWith $ System.ExitFailure total Options.FixFilePaths Options.FixFilePathsOptions {..} files -> do Config.Config @@ -136,8 +136,8 @@ main = do } <- Config.readConfig let pattern = fromMaybe fiPattern foPattern - coverImages = guard fiMoveCover *> (Cover.coPaths <$> chAlbumHaveCover) - when (fiMoveCover && isNothing chAlbumHaveCover) $ + coverImages = guard fiMoveCover *> (Cover.coPaths <$> chDiscHaveCover) + when (fiMoveCover && isNothing chDiscHaveCover) $ Exception.throwIO MoveCoverWithoutCheck -- Get the base directory from the cli and fallback to the config file diff --git a/app/Options.hs b/app/Options.hs index 658240b..10ec402 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -8,8 +8,8 @@ module Options ) where -import Check.Album qualified as Album import Check.Artist qualified as Artist +import Check.Disc qualified as Disc import Check.Track qualified as Track import Config qualified import Data.Text qualified as Text @@ -57,7 +57,7 @@ data Command checks :: Config.Config -> CheckOptions -> - ([Track.Check], [Album.Check], Maybe Artist.Check) + ([Track.Check], [Disc.Check], Maybe Artist.Check) checks config@(Config.Config {coFilename = Config.Filename {..}}) (Options.CheckOptions {..}) @@ -81,10 +81,10 @@ checksP = <$> optional trackTagsP <*> optional trackGenreAmongP <*> trackFilenameP - <*> optional albumHaveCoverP - <*> albumSameDirP - <*> optional albumSameTagsP - <*> albumTracksSequentialP + <*> optional discHaveCoverP + <*> discSameDirP + <*> optional discSameTagsP + <*> discTracksSequentialP <*> artistSameGenreP fixFilePathsOptionsP :: Options.Parser FixFilePathsOptions @@ -121,19 +121,19 @@ trackFilenameP = "Check that filenames match the specified pattern" ) -albumHaveCoverP :: Options.Parser Cover.Cover -albumHaveCoverP = +discHaveCoverP :: Options.Parser Cover.Cover +discHaveCoverP = Cover.Cover <$> coverPathsP - <*> Options.optional (coverSizeP "album-cover-min-size") - <*> Options.optional (coverSizeP "album-cover-max-size") + <*> Options.optional (coverSizeP "disc-cover-min-size") + <*> Options.optional (coverSizeP "disc-cover-max-size") coverPathsP :: Options.Parser (NonEmpty (Path.Path Path.Rel Path.File)) coverPathsP = Options.some1 ( Options.option (Options.maybeReader Path.parseRelFile) - ( Options.long "album-cover-filename" + ( Options.long "disc-cover-filename" <> Options.metavar "FILENAME" <> Options.help "Check that the specified cover file exists" ) @@ -158,33 +158,33 @@ coverSizeP option = _ -> Left "Width and height must be integers" _ -> Left "Size must be in the form WIDTHxHEIGHT" -albumSameDirP :: Options.Parser Bool -albumSameDirP = +discSameDirP :: Options.Parser Bool +discSameDirP = Options.switch - ( Options.long "album-same-dir" + ( Options.long "disc-same-dir" <> Options.help "Check that all tracks are in the same directory" ) -albumSameTagsP :: Options.Parser (NonEmpty Tag.Tag) -albumSameTagsP = +discSameTagsP :: Options.Parser (NonEmpty Tag.Tag) +discSameTagsP = Options.some1 ( Options.option tagR - ( Options.long "album-same-tag" + ( Options.long "disc-same-tag" <> Options.metavar "TAG" <> Options.help - "Check that all tracks in the album have the same value for \ + "Check that all tracks in the disc have the same value for \ \the specified tag (title, artist, album, albumartist, genre, \ \year, track)" ) ) -albumTracksSequentialP :: Options.Parser Bool -albumTracksSequentialP = +discTracksSequentialP :: Options.Parser Bool +discTracksSequentialP = Options.switch - ( Options.long "album-tracks-sequential" + ( Options.long "disc-tracks-sequential" <> Options.help - "Check that track numbers are sequential within the album" + "Check that track numbers are sequential within the disc" ) artistSameGenreP :: Options.Parser (Maybe Artist.Check) diff --git a/app/Stats.hs b/app/Stats.hs index d0cfeb5..2f95b22 100644 --- a/app/Stats.hs +++ b/app/Stats.hs @@ -2,14 +2,14 @@ module Stats ( CheckErrors (..), Stats.empty, addTrackErrors, - addAlbumErrors, + addDiscErrors, incArtistErrors, ) where data CheckErrors = CheckErrors { ceTrackErrors :: Int, - ceAlbumErrors :: Int, + ceDiscErrors :: Int, ceArtistErrors :: Int } @@ -19,8 +19,8 @@ empty = CheckErrors 0 0 0 addTrackErrors :: Int -> CheckErrors -> CheckErrors addTrackErrors n errors = errors {ceTrackErrors = ceTrackErrors errors + n} -addAlbumErrors :: Int -> CheckErrors -> CheckErrors -addAlbumErrors n errors = errors {ceAlbumErrors = ceAlbumErrors errors + n} +addDiscErrors :: Int -> CheckErrors -> CheckErrors +addDiscErrors n errors = errors {ceDiscErrors = ceDiscErrors errors + n} incArtistErrors :: CheckErrors -> CheckErrors incArtistErrors errors = errors {ceArtistErrors = ceArtistErrors errors + 1} diff --git a/data/htagcli.toml b/data/htagcli.toml index 2694147..278145f 100644 --- a/data/htagcli.toml +++ b/data/htagcli.toml @@ -58,9 +58,9 @@ placeholder_max_length = 30 # Directory where music files are moved when fixing their paths base_dir = "/absolute/path/to/your/Music" -# Used to move cover files along the audio files. `checks.album_cover.filenames` +# Used to move cover files along the audio files. `checks.disc_cover.filenames` # must be enabled for this to work. -# Any file that matches `checks.album_cover.filenames` in the same directory as +# Any file that matches `checks.disc_cover.filenames` in the same directory as # the current audio file will be moved along with it. move_cover = true @@ -91,8 +91,8 @@ among = [ [checks.track_filename] enable = true -# Verify that each album directory contains a cover image -[checks.album_cover] +# Verify that each disc directory contains a cover image +[checks.disc_cover] enable = true filenames = ["cover.jpg", "cover.png", "cover.gif"] # optional size constraints in pixels, not taken into account if left @@ -101,18 +101,18 @@ filenames = ["cover.jpg", "cover.png", "cover.gif"] min_size = { width = 300, height = 300 } max_size = { width = 1000, height = 1000 } -# Verify that all tracks from the same album reside in a single directory -# Note: htagcli groups files by album while scanning input paths recursively. -[checks.album_same_dir] +# Verify that all tracks from the same disc reside in a single directory +# Note: htagcli groups files by disc while scanning input paths recursively. +[checks.disc_same_dir] enable = true -# Verify that album-level tags are consistent across all tracks of an album -[checks.album_tags] +# Verify that disc-level tags are consistent across all tracks of a disc +[checks.disc_tags] enable = true tags = ["albumartist", "album", "year", "genre"] -# Verify that track numbers in each album are sequential starting from 1 -[checks.album_tracks_sequential] +# Verify that track numbers in each disc are sequential starting from 1 +[checks.disc_tracks_sequential] enable = true # Verify that all tracks from an artist have the same genre diff --git a/htagcli.cabal b/htagcli.cabal index f717da2..4a772c7 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -41,16 +41,16 @@ library lib exposed-modules: - Check.Album Check.Artist + Check.Disc Check.Track Commands Config Data.List.NonEmpty.Extra - Model.Album Model.Artist Model.AudioTrack Model.Cover + Model.Disc Model.Pattern Model.SetTagsOptions Model.Tag @@ -119,8 +119,8 @@ test-suite tests Main.hs other-modules: - Tests.Check.Album Tests.Check.Artist + Tests.Check.Disc Tests.Check.Track Tests.Commands Tests.Common diff --git a/lib/Check/Artist.hs b/lib/Check/Artist.hs index a77c124..e336f2f 100644 --- a/lib/Check/Artist.hs +++ b/lib/Check/Artist.hs @@ -8,9 +8,9 @@ where import Data.Map.Strict qualified as Map import Data.Text qualified as Text -import Model.Album qualified as Album import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc import Sound.HTagLib qualified as HTagLib import Sound.HTagLib.Extra qualified as HTagLib import "extra" Data.List.NonEmpty.Extra qualified as NonEmpty @@ -37,9 +37,9 @@ check (SameGenre artistToAllowedGenres) artist Right () | otherwise = Left $ SameGenreError genres where - albums = Artist.albums artist + discs = Artist.discs artist genres = - NonEmpty.nubOrd $ AudioTrack.atGenre <$> (Album.tracks =<< albums) + NonEmpty.nubOrd $ AudioTrack.atGenre <$> (Disc.tracks =<< discs) albumArtistOrArtist = Artist.albumArtistOrArtist artist mbAllowedGenres = Map.lookup diff --git a/lib/Check/Album.hs b/lib/Check/Disc.hs similarity index 82% rename from lib/Check/Album.hs rename to lib/Check/Disc.hs index 26ffdb9..c627d12 100644 --- a/lib/Check/Album.hs +++ b/lib/Check/Disc.hs @@ -1,4 +1,4 @@ -module Check.Album +module Check.Disc ( Check (..), Cover (..), Size (..), @@ -12,9 +12,9 @@ import Codec.Picture qualified as Picture import Control.Monad.Extra qualified as Monad import Control.Monad.Trans.Except qualified as Except import Data.Text qualified as Text -import Model.Album qualified as Album import Model.AudioTrack qualified as AudioTrack import Model.Cover as Cover +import Model.Disc qualified as Disc import Model.Tag qualified as Tag import Path (()) import Path qualified @@ -53,20 +53,20 @@ errorToText (UnableToReadCover file err) = <> ": " <> err errorToText (SameTagsError tags) = - "These tags are not the same for all tracks in the album: " + "These tags are not the same for all tracks in the disc: " <> Text.intercalate ", " (Tag.asText <$> toList tags) errorToText TracksNotSequential = "Tracks are not sequentially numbered" check :: (MonadIO m) => Check -> - Album.Album -> + Disc.Disc -> m (Either Error ()) -check InSameDir album - | isJust $ Album.directory album = pure $ Right () +check InSameDir d + | isJust $ Disc.directory d = pure $ Right () | otherwise = pure $ Left NotInSameDir -check (HaveCover cover@Cover {..}) album - | Just dir <- Album.directory album = runExceptT $ do +check (HaveCover cover@Cover {..}) d + | Just dir <- Disc.directory d = runExceptT $ do let absFiles = (dir ) <$> coPaths coverFile <- @@ -88,17 +88,17 @@ check (HaveCover cover@Cover {..}) album | otherwise = pure $ Left NotInSameDir where readImage = liftIO . Picture.readImage . Path.toFilePath -check (SameTags tagsToCheck) album = pure $ case checkedTags of +check (SameTags tagsToCheck) d = pure $ case checkedTags of [] -> Right () (tag : tags) -> Left (SameTagsError (tag :| tags)) where - checkedTags = mapMaybe (Album.haveSameTag' album) (toList tagsToCheck) -check TracksSequential album = pure $ case mbNumbers of + checkedTags = mapMaybe (Disc.haveSameTag' d) (toList tagsToCheck) +check TracksSequential d = pure $ case mbNumbers of Nothing -> Left TracksNotSequential Just numbers -> if sequential $ toList $ HTagLib.unTrackNumber <$> numbers then Right () else Left TracksNotSequential where - mbNumbers = traverse AudioTrack.atTrack (Album.tracks album) + mbNumbers = traverse AudioTrack.atTrack (Disc.tracks d) sequential list = and $ zipWith (==) (sort list) [1 ..] diff --git a/lib/Commands.hs b/lib/Commands.hs index 3ac2f0e..07e9ea7 100644 --- a/lib/Commands.hs +++ b/lib/Commands.hs @@ -2,7 +2,7 @@ module Commands ( getTags, setTags, checkTrack, - checkAlbum, + checkDisc, checkArtist, FixFilePathsOptions (..), fixFilePaths, @@ -12,12 +12,12 @@ module Commands ) where -import Check.Album qualified as Album import Check.Artist qualified as Artist +import Check.Disc qualified as Disc import Check.Track qualified as Track -import Model.Album qualified as Album import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc import Model.Pattern qualified as Pattern import Model.SetTagsOptions qualified as SetTagsOptions import Path (()) @@ -70,26 +70,26 @@ checkTrack checks track = countTrues <$> traverse checkPrintError checks pure $ isLeft result file = AudioTrack.atFile track -checkAlbum :: (MonadIO m) => [Album.Check] -> Album.Album -> m Int -checkAlbum checks album = countTrues <$> traverse checkPrintError checks +checkDisc :: (MonadIO m) => [Disc.Check] -> Disc.Disc -> m Int +checkDisc checks d = countTrues <$> traverse checkPrintError checks where checkPrintError check = do - result <- Album.check check album + result <- Disc.check check d whenLeft_ result $ \err -> putTextLn $ - "Album " + "Disc " <> albumArtistOrArtistTxt <> albumTxt <> discTxt <> ": " - <> Album.errorToText err + <> Disc.errorToText err pure $ isLeft result albumArtistOrArtistTxt = - HTagLib.unAlbumArtistOrArtist $ Album.albumArtistOrArtist album - albumTxt = "/" <> HTagLib.unAlbum (Album.album album) + HTagLib.unAlbumArtistOrArtist $ Disc.albumArtistOrArtist d + albumTxt = "/" <> HTagLib.unAlbum (Disc.album d) discTxt - | Just disc <- Album.disc album = - "/Disc " <> show (HTagLib.unDiscNumber disc) + | Just discNum <- Disc.disc d = + "/Disc " <> show (HTagLib.unDiscNumber discNum) | otherwise = "" checkArtist :: diff --git a/lib/Config.hs b/lib/Config.hs index 7f01416..5c92319 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -17,8 +17,8 @@ module Config ) where -import Check.Album qualified as Album import Check.Artist qualified as Artist +import Check.Disc qualified as Disc import Check.Track qualified as Track import Data.ByteString qualified as ByteString import Data.FileEmbed qualified as FileEmbed @@ -80,15 +80,15 @@ data Checks = Checks -- one given in the formatting section. This way it is possible to ignore -- the padding when checking the filename and still have it when fixing it. chTrackFilename :: Bool, - -- | The album have a cover file - chAlbumHaveCover :: Maybe Cover.Cover, - -- | All the audio tracks of the album are in the same directory - chAlbumSameDir :: Bool, - -- | All the audio tracks of the album have the same value for the given + -- | The disc have a cover file + chDiscHaveCover :: Maybe Cover.Cover, + -- | All the audio tracks of the disc are in the same directory + chDiscSameDir :: Bool, + -- | All the audio tracks of the disc have the same value for the given -- tags - chAlbumSameTags :: Maybe (NonEmpty Tag.Tag), - -- | The tracks of the album have sequential track numbers - chAlbumTracksSequential :: Bool, + chDiscSameTags :: Maybe (NonEmpty Tag.Tag), + -- | The tracks of the disc have sequential track numbers + chDiscTracksSequential :: Bool, -- | All the tracks from the artist have the same genre chArtistSameGenre :: Maybe Artist.Check } @@ -100,10 +100,10 @@ haveChecks (Checks {..}) = [ isJust chTrackTags, isJust chTrackGenreAmong, chTrackFilename, - isJust chAlbumHaveCover, - chAlbumSameDir, - isJust chAlbumSameTags, - chAlbumTracksSequential, + isJust chDiscHaveCover, + chDiscSameDir, + isJust chDiscSameTags, + chDiscTracksSequential, isJust chArtistSameGenre ] @@ -117,19 +117,19 @@ trackChecks pattern formatting Checks {..} = else Just $ Track.FilenameMatches pattern formatting ] -albumChecks :: Checks -> [Album.Check] -albumChecks (Checks {..}) = +discChecks :: Checks -> [Disc.Check] +discChecks (Checks {..}) = catMaybes - [ Album.HaveCover <$> chAlbumHaveCover, - guarded (const chAlbumSameDir) Album.InSameDir, - Album.SameTags <$> chAlbumSameTags, - guarded (const chAlbumTracksSequential) Album.TracksSequential + [ Disc.HaveCover <$> chDiscHaveCover, + guarded (const chDiscSameDir) Disc.InSameDir, + Disc.SameTags <$> chDiscSameTags, + guarded (const chDiscTracksSequential) Disc.TracksSequential ] artistCheck :: Checks -> Maybe Artist.Check artistCheck (Checks {..}) = chArtistSameGenre -factorChecks :: Config -> ([Track.Check], [Album.Check], Maybe Artist.Check) +factorChecks :: Config -> ([Track.Check], [Disc.Check], Maybe Artist.Check) factorChecks Config {coFilename = Filename {..}, ..} = factorChecks' fiPattern fiFormatting coChecks @@ -137,10 +137,10 @@ factorChecks' :: Pattern.Pattern -> Pattern.Formatting -> Checks -> - ([Track.Check], [Album.Check], Maybe Artist.Check) + ([Track.Check], [Disc.Check], Maybe Artist.Check) factorChecks' pattern formatting checks = ( trackChecks pattern formatting checks, - albumChecks checks, + discChecks checks, artistCheck checks ) @@ -242,17 +242,17 @@ checksC = <$> maybeValidatedC "track_tags" tagsC chTrackTags <*> maybeValidatedC "track_genre" amongC chTrackGenreAmong <*> trackFilenameC .= chTrackFilename - <*> maybeValidatedC "album_cover" albumHaveCoverC chAlbumHaveCover - <*> albumSameDirC .= chAlbumSameDir - <*> maybeValidatedC "album_tags" tagsC chAlbumSameTags - <*> albumTracksSequentialC .= chAlbumTracksSequential + <*> maybeValidatedC "disc_cover" discHaveCoverC chDiscHaveCover + <*> discSameDirC .= chDiscSameDir + <*> maybeValidatedC "disc_tags" tagsC chDiscSameTags + <*> discTracksSequentialC .= chDiscTracksSequential <*> maybeValidatedC "artist_same_genre" artistSameGenreC chArtistSameGenre where trackFilenameC = Toml.table (Toml.bool "enable") "track_filename" - albumSameDirC = Toml.table (Toml.bool "enable") "album_same_dir" + discSameDirC = Toml.table (Toml.bool "enable") "disc_same_dir" tagsC = Toml.arrayNonEmptyOf tagB "tags" - albumTracksSequentialC = - Toml.table (Toml.bool "enable") "album_tracks_sequential" + discTracksSequentialC = + Toml.table (Toml.bool "enable") "disc_tracks_sequential" artistSameGenreC = Toml.diwrap $ Toml.map @@ -260,7 +260,7 @@ checksC = (Toml.arrayNonEmptyOf genreB "genres") "except" amongC = Toml.arrayNonEmptyOf genreB "among" - albumHaveCoverC = + discHaveCoverC = Cover.Cover <$> filenamesC .= Cover.coPaths <*> Toml.dioptional (sizeC "min_size") .= Cover.coMinSize diff --git a/lib/Model/Album.hs b/lib/Model/Album.hs deleted file mode 100644 index dea209f..0000000 --- a/lib/Model/Album.hs +++ /dev/null @@ -1,100 +0,0 @@ -module Model.Album - ( Album, - mkAlbum, - addTrack, - tracks, - artist, - album, - albumArtist, - albumArtistOrArtist, - disc, - directory, - haveSameTag, - haveSameTag', - ) -where - -import Data.List.NonEmpty ((<|)) -import Model.AudioTrack qualified as AudioTrack -import Model.Tag qualified as Tag -import Path qualified -import Sound.HTagLib qualified as HTagLib -import Sound.HTagLib.Extra qualified as HTagLib -import "extra" Data.List.NonEmpty.Extra qualified as NonEmpty - -newtype Album = Album (NonEmpty AudioTrack.AudioTrack) - deriving (Eq, Show) - -mkAlbum :: NonEmpty AudioTrack.AudioTrack -> Maybe Album -mkAlbum tracks'@(firstTrack :| otherTracks) - | allSameAlbum - && allSameDisc - && ( ( AudioTrack.haveTag Tag.AlbumArtist firstTrack - && allSameAlbumArtist - ) - || allSameArtist - ) = - Just $ Album tracks' - | otherwise = Nothing - where - firstAlbum = AudioTrack.atAlbum firstTrack - firstDisc = AudioTrack.atDisc firstTrack - firstAlbumArtist = AudioTrack.atAlbumArtist firstTrack - firstArtist = AudioTrack.atArtist firstTrack - allSameAlbum = all ((== firstAlbum) . AudioTrack.atAlbum) otherTracks - allSameDisc = all ((== firstDisc) . AudioTrack.atDisc) otherTracks - allSameAlbumArtist = - all ((== firstAlbumArtist) . AudioTrack.atAlbumArtist) otherTracks - allSameArtist = all ((== firstArtist) . AudioTrack.atArtist) otherTracks - -addTrack :: AudioTrack.AudioTrack -> Album -> Maybe Album -addTrack track (Album tracks') = mkAlbum (track <| tracks') - -tracks :: Album -> NonEmpty AudioTrack.AudioTrack -tracks (Album tracks') = tracks' - -albumArtistOrArtist :: Album -> HTagLib.AlbumArtistOrArtist -albumArtistOrArtist (Album (track :| _)) = AudioTrack.albumArtistOrArtist track - -artist :: Album -> HTagLib.Artist -artist (Album (track :| _)) = AudioTrack.atArtist track - -albumArtist :: Album -> HTagLib.AlbumArtist -albumArtist (Album (track :| _)) = AudioTrack.atAlbumArtist track - -disc :: Album -> Maybe HTagLib.DiscNumber -disc (Album (track :| _)) = AudioTrack.atDisc track - -album :: Album -> HTagLib.Album -album (Album (track :| _)) = AudioTrack.atAlbum track - --- | Return the directory if all tracks are in the same one -directory :: Album -> Maybe (Path.Path Path.Abs Path.Dir) -directory (Album tracks') - | length directories == 1 = Just $ head directories - | otherwise = Nothing - where - directories = NonEmpty.nubOrd $ Path.parent . AudioTrack.atFile <$> tracks' - -haveSameTag' :: Album -> Tag.Tag -> Maybe Tag.Tag -haveSameTag' album' = guarded (not . haveSameTag album') - -haveSameTag :: Album -> Tag.Tag -> Bool -haveSameTag album' Tag.Title = haveSameTagWithGetter AudioTrack.atTitle album' -haveSameTag album' Tag.Artist = haveSameTagWithGetter AudioTrack.atArtist album' -haveSameTag album' Tag.AlbumArtist = - haveSameTagWithGetter AudioTrack.atAlbumArtist album' -haveSameTag album' Tag.Album = haveSameTagWithGetter AudioTrack.atAlbum album' -haveSameTag album' Tag.Genre = haveSameTagWithGetter AudioTrack.atGenre album' -haveSameTag album' Tag.Year = haveSameTagWithGetter AudioTrack.atYear album' -haveSameTag album' Tag.Track = haveSameTagWithGetter AudioTrack.atTrack album' -haveSameTag album' Tag.Disc = haveSameTagWithGetter AudioTrack.atDisc album' - -haveSameTagWithGetter :: - (Eq a) => - (AudioTrack.AudioTrack -> a) -> - Album -> - Bool -haveSameTagWithGetter getTagValue (Album tracks') = all (== firstTag) otherTags - where - (firstTag :| otherTags) = getTagValue <$> tracks' diff --git a/lib/Model/Artist.hs b/lib/Model/Artist.hs index b234d0f..49b78ca 100644 --- a/lib/Model/Artist.hs +++ b/lib/Model/Artist.hs @@ -1,43 +1,41 @@ module Model.Artist ( Artist, mkArtist, - addAlbum, + addDisc, albumArtistOrArtist, - albums, + discs, ) where import Data.List.NonEmpty ((<|)) import Data.Text qualified as Text -import Model.Album qualified as Album +import Model.Disc qualified as Disc import Sound.HTagLib.Extra qualified as HTagLib -newtype Artist = Artist (NonEmpty Album.Album) +newtype Artist = Artist (NonEmpty Disc.Disc) deriving (Eq, Show) -mkArtist :: NonEmpty Album.Album -> Maybe Artist -mkArtist albums'@(firstAlbum :| otherAlbums) +mkArtist :: NonEmpty Disc.Disc -> Maybe Artist +mkArtist discs'@(firstDisc :| otherDiscs) | ( allSameAlbumArtist && not (Text.null $ HTagLib.unAlbumArtist firstAlbumArtist) && (firstAlbumArtist /= "Various Artists") ) || allSameArtist = - Just $ Artist albums' + Just $ Artist discs' | otherwise = Nothing where - firstAlbumArtist = Album.albumArtist firstAlbum - firstArtist = Album.artist firstAlbum + firstAlbumArtist = Disc.albumArtist firstDisc + firstArtist = Disc.artist firstDisc allSameAlbumArtist = - all - ((== firstAlbumArtist) . Album.albumArtist) - otherAlbums - allSameArtist = all ((== firstArtist) . Album.artist) otherAlbums + all ((== firstAlbumArtist) . Disc.albumArtist) otherDiscs + allSameArtist = all ((== firstArtist) . Disc.artist) otherDiscs -addAlbum :: Album.Album -> Artist -> Maybe Artist -addAlbum album (Artist albums') = mkArtist (album <| albums') +addDisc :: Disc.Disc -> Artist -> Maybe Artist +addDisc d (Artist discs') = mkArtist (d <| discs') albumArtistOrArtist :: Artist -> HTagLib.AlbumArtistOrArtist -albumArtistOrArtist (Artist (album :| _)) = Album.albumArtistOrArtist album +albumArtistOrArtist (Artist (d :| _)) = Disc.albumArtistOrArtist d -albums :: Artist -> NonEmpty Album.Album -albums (Artist albums') = albums' +discs :: Artist -> NonEmpty Disc.Disc +discs (Artist discs') = discs' diff --git a/lib/Model/Disc.hs b/lib/Model/Disc.hs new file mode 100644 index 0000000..b42ec07 --- /dev/null +++ b/lib/Model/Disc.hs @@ -0,0 +1,100 @@ +module Model.Disc + ( Disc, + mkDisc, + addTrack, + tracks, + artist, + album, + albumArtist, + albumArtistOrArtist, + disc, + directory, + haveSameTag, + haveSameTag', + ) +where + +import Data.List.NonEmpty ((<|)) +import Model.AudioTrack qualified as AudioTrack +import Model.Tag qualified as Tag +import Path qualified +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib +import "extra" Data.List.NonEmpty.Extra qualified as NonEmpty + +newtype Disc = Disc (NonEmpty AudioTrack.AudioTrack) + deriving (Eq, Show) + +mkDisc :: NonEmpty AudioTrack.AudioTrack -> Maybe Disc +mkDisc tracks'@(firstTrack :| otherTracks) + | allSameAlbum + && allSameDisc + && ( ( AudioTrack.haveTag Tag.AlbumArtist firstTrack + && allSameAlbumArtist + ) + || allSameArtist + ) = + Just $ Disc tracks' + | otherwise = Nothing + where + firstAlbum = AudioTrack.atAlbum firstTrack + firstDisc = AudioTrack.atDisc firstTrack + firstAlbumArtist = AudioTrack.atAlbumArtist firstTrack + firstArtist = AudioTrack.atArtist firstTrack + allSameAlbum = all ((== firstAlbum) . AudioTrack.atAlbum) otherTracks + allSameDisc = all ((== firstDisc) . AudioTrack.atDisc) otherTracks + allSameAlbumArtist = + all ((== firstAlbumArtist) . AudioTrack.atAlbumArtist) otherTracks + allSameArtist = all ((== firstArtist) . AudioTrack.atArtist) otherTracks + +addTrack :: AudioTrack.AudioTrack -> Disc -> Maybe Disc +addTrack track (Disc tracks') = mkDisc (track <| tracks') + +tracks :: Disc -> NonEmpty AudioTrack.AudioTrack +tracks (Disc tracks') = tracks' + +albumArtistOrArtist :: Disc -> HTagLib.AlbumArtistOrArtist +albumArtistOrArtist (Disc (track :| _)) = AudioTrack.albumArtistOrArtist track + +artist :: Disc -> HTagLib.Artist +artist (Disc (track :| _)) = AudioTrack.atArtist track + +albumArtist :: Disc -> HTagLib.AlbumArtist +albumArtist (Disc (track :| _)) = AudioTrack.atAlbumArtist track + +disc :: Disc -> Maybe HTagLib.DiscNumber +disc (Disc (track :| _)) = AudioTrack.atDisc track + +album :: Disc -> HTagLib.Album +album (Disc (track :| _)) = AudioTrack.atAlbum track + +-- | Return the directory if all tracks are in the same one +directory :: Disc -> Maybe (Path.Path Path.Abs Path.Dir) +directory (Disc tracks') + | length directories == 1 = Just $ head directories + | otherwise = Nothing + where + directories = NonEmpty.nubOrd $ Path.parent . AudioTrack.atFile <$> tracks' + +haveSameTag' :: Disc -> Tag.Tag -> Maybe Tag.Tag +haveSameTag' disc' = guarded (not . haveSameTag disc') + +haveSameTag :: Disc -> Tag.Tag -> Bool +haveSameTag disc' Tag.Title = haveSameTagWithGetter AudioTrack.atTitle disc' +haveSameTag disc' Tag.Artist = haveSameTagWithGetter AudioTrack.atArtist disc' +haveSameTag disc' Tag.AlbumArtist = + haveSameTagWithGetter AudioTrack.atAlbumArtist disc' +haveSameTag disc' Tag.Album = haveSameTagWithGetter AudioTrack.atAlbum disc' +haveSameTag disc' Tag.Genre = haveSameTagWithGetter AudioTrack.atGenre disc' +haveSameTag disc' Tag.Year = haveSameTagWithGetter AudioTrack.atYear disc' +haveSameTag disc' Tag.Track = haveSameTagWithGetter AudioTrack.atTrack disc' +haveSameTag disc' Tag.Disc = haveSameTagWithGetter AudioTrack.atDisc disc' + +haveSameTagWithGetter :: + (Eq a) => + (AudioTrack.AudioTrack -> a) -> + Disc -> + Bool +haveSameTagWithGetter getTagValue (Disc tracks') = all (== firstTag) otherTags + where + (firstTag :| otherTags) = getTagValue <$> tracks' diff --git a/tests/Main.hs b/tests/Main.hs index e2b375a..1aac522 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,8 +1,8 @@ module Main (main) where import Test.Tasty (defaultMain, testGroup) -import Tests.Check.Album qualified as Check.Album import Tests.Check.Artist qualified as Check.Artist +import Tests.Check.Disc qualified as Check.Disc import Tests.Check.Track qualified as Check.Track import Tests.Commands as Commands import Tests.Config as Config @@ -20,7 +20,7 @@ main = Model.AudioTrack.test, Model.Pattern.test, Model.Tag.test, - Check.Album.test, + Check.Disc.test, Check.Artist.test, Check.Track.test ] diff --git a/tests/Tests/Check/Artist.hs b/tests/Tests/Check/Artist.hs index 82e8317..5e277b4 100644 --- a/tests/Tests/Check/Artist.hs +++ b/tests/Tests/Check/Artist.hs @@ -16,41 +16,41 @@ test :: Tasty.TestTree test = Tasty.testGroup "Check.Artist" - [ Tasty.testCase "two albums of the same artist with the same genre" $ do - let album1 = tenTracksAlbum (HTagLib.mkAlbum "album-1") rock - album2 = tenTracksAlbum (HTagLib.mkAlbum "album-2") rock + [ Tasty.testCase "two discs of the same artist with the same genre" $ do + let disc1 = tenTracksDisc (HTagLib.mkAlbum "album-1") rock + disc2 = tenTracksDisc (HTagLib.mkAlbum "album-2") rock artist = Unsafe.fromJust $ Artist.mkArtist $ - fromList [album1, album2] + fromList [disc1, disc2] Artist.check (Artist.SameGenre mempty) artist `shouldBe` Right (), - Tasty.testCase "two albums of the same artist with different genres" $ do - let album1 = tenTracksAlbum (HTagLib.mkAlbum "album-1") pop - album2 = tenTracksAlbum (HTagLib.mkAlbum "album-2") rock + Tasty.testCase "two discs of the same artist with different genres" $ do + let disc1 = tenTracksDisc (HTagLib.mkAlbum "album-1") pop + disc2 = tenTracksDisc (HTagLib.mkAlbum "album-2") rock artist = Unsafe.fromJust $ Artist.mkArtist $ - fromList [album1, album2] + fromList [disc1, disc2] Artist.check (Artist.SameGenre mempty) artist `shouldBe` Left (Artist.SameGenreError genres), Tasty.testCase - "two albums of the same artist with different genres but \ + "two discs of the same artist with different genres but \ \with exceptions" $ do - let album1 = tenTracksAlbum (HTagLib.mkAlbum "album-1") pop - album2 = tenTracksAlbum (HTagLib.mkAlbum "album-2") rock + let disc1 = tenTracksDisc (HTagLib.mkAlbum "album-1") pop + disc2 = tenTracksDisc (HTagLib.mkAlbum "album-2") rock artist = Unsafe.fromJust $ Artist.mkArtist $ - fromList [album1, album2] + fromList [disc1, disc2] Artist.check (Artist.SameGenre (fromList [("Album Artist", genres)])) artist `shouldBe` Right () ] where - tenTracksAlbum = Common.tenTracksAlbum' [absdir|/path/to|] + tenTracksDisc = Common.tenTracksDisc' [absdir|/path/to|] rock = HTagLib.mkGenre "Rock" pop = HTagLib.mkGenre "Pop" genres = fromList [pop, rock] diff --git a/tests/Tests/Check/Album.hs b/tests/Tests/Check/Disc.hs similarity index 53% rename from tests/Tests/Check/Album.hs rename to tests/Tests/Check/Disc.hs index 7bcee49..98e0f62 100644 --- a/tests/Tests/Check/Album.hs +++ b/tests/Tests/Check/Disc.hs @@ -1,13 +1,13 @@ {-# LANGUAGE QuasiQuotes #-} -module Tests.Check.Album (test) where +module Tests.Check.Disc (test) where -import Check.Album qualified as Album +import Check.Disc qualified as Disc import Data.List.NonEmpty ((<|)) import Data.List.NonEmpty qualified as NonEmpty import Data.Maybe qualified as Maybe -import Model.Album qualified as Album import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc import Model.Tag qualified as Tag import Path (reldir, relfile, ()) import Path qualified @@ -21,7 +21,7 @@ import Tests.Common qualified as Common test :: Tasty.TestTree test = Tasty.testGroup - "Check.Album" + "Check.Disc" [ testCheckCover, testCheckDirectory, testCheckSameTags, @@ -32,56 +32,56 @@ testCheckCover :: Tasty.TestTree testCheckCover = Tasty.testGroup "check cover" - [ Tasty.testCase "check an album without a cover.png" $ + [ Tasty.testCase "check a disc without a cover.png" $ Common.withTenTracksFiles $ - \dir album -> do - result <- Album.check (Album.HaveCover coverNoSize) album - result `shouldBe` Left (Album.MissingCover dir), - Tasty.testCase "check an album with a cover.png" $ + \dir disc -> do + result <- Disc.check (Disc.HaveCover coverNoSize) disc + result `shouldBe` Left (Disc.MissingCover dir), + Tasty.testCase "check a disc with a cover.png" $ Common.withTenTracksFiles $ - \dir album -> do + \dir disc -> do let coverFile = [relfile|./data/cover.png|] Path.copyFile coverFile $ dir Path.filename coverFile - result <- Album.check (Album.HaveCover coverNoSize) album + result <- Disc.check (Disc.HaveCover coverNoSize) disc result `shouldBe` Right (), - Tasty.testCase "check an album with a cover.png but too small" $ + Tasty.testCase "check a disc with a cover.png but too small" $ Common.withTenTracksFiles $ - \dir album -> do + \dir disc -> do let coverFile = [relfile|./data/cover.png|] Path.copyFile coverFile $ dir Path.filename coverFile - result <- Album.check (Album.HaveCover coverTooSmall) album + result <- Disc.check (Disc.HaveCover coverTooSmall) disc result `shouldSatisfy` isBadCoverSize, - Tasty.testCase "check an album with a cover.png but too big" $ + Tasty.testCase "check a disc with a cover.png but too big" $ Common.withTenTracksFiles $ - \dir album -> do + \dir disc -> do let coverFile = [relfile|./data/cover.png|] Path.copyFile coverFile $ dir Path.filename coverFile - result <- Album.check (Album.HaveCover coverTooBig) album + result <- Disc.check (Disc.HaveCover coverTooBig) disc result `shouldSatisfy` isBadCoverSize ] where - isBadCoverSize (Left (Album.BadCoverSize _ _)) = True + isBadCoverSize (Left (Disc.BadCoverSize _ _)) = True isBadCoverSize _ = False coverNoSize = - Album.Cover - { Album.coPaths = covers, - Album.coMinSize = Nothing, - Album.coMaxSize = Nothing + Disc.Cover + { Disc.coPaths = covers, + Disc.coMinSize = Nothing, + Disc.coMaxSize = Nothing } coverTooSmall = - Album.Cover - { Album.coPaths = covers, - Album.coMinSize = Just (Album.Size 200 200), - Album.coMaxSize = Nothing + Disc.Cover + { Disc.coPaths = covers, + Disc.coMinSize = Just (Disc.Size 200 200), + Disc.coMaxSize = Nothing } coverTooBig = - Album.Cover - { Album.coPaths = covers, - Album.coMinSize = Nothing, - Album.coMaxSize = Just (Album.Size 50 50) + Disc.Cover + { Disc.coPaths = covers, + Disc.coMinSize = Nothing, + Disc.coMaxSize = Just (Disc.Size 50 50) } covers = fromList [[relfile|cover.jpg|], [relfile|cover.png|]] @@ -89,20 +89,20 @@ testCheckDirectory :: Tasty.TestTree testCheckDirectory = Tasty.testGroup "check directory" - [ Tasty.testCase "an album is in a single directory" $ do - result <- Album.check Album.InSameDir Common.tenTracksAlbum + [ Tasty.testCase "a disc is in a single directory" $ do + result <- Disc.check Disc.InSameDir Common.tenTracksDisc result `shouldBe` Right (), - Tasty.testCase "an album is in multiple directories" $ do - let album = Common.tenTracksAlbum - tracksDir = Maybe.fromJust $ Album.directory album + Tasty.testCase "a disc is in multiple directories" $ do + let d = Common.tenTracksDisc + tracksDir = Maybe.fromJust $ Disc.directory d otherDir = Path.parent tracksDir [reldir|other|] - (firstHalf, secondHalf) = NonEmpty.splitAt 5 (Album.tracks album) + (firstHalf, secondHalf) = NonEmpty.splitAt 5 (Disc.tracks d) secondHalfMoved = moveTo otherDir <$> secondHalf - album' = + d' = Maybe.fromJust $ - Album.mkAlbum (fromList $ firstHalf <> secondHalfMoved) - result <- Album.check Album.InSameDir album' - result `shouldBe` Left Album.NotInSameDir + Disc.mkDisc (fromList $ firstHalf <> secondHalfMoved) + result <- Disc.check Disc.InSameDir d' + result `shouldBe` Left Disc.NotInSameDir ] where moveTo newDir track = @@ -115,12 +115,12 @@ testCheckSameTags = Tasty.testGroup "check same tags" [ Tasty.testCase "all tracks have the same tags" $ do - result <- Album.check (Album.SameTags commonTags) Common.tenTracksAlbum + result <- Disc.check (Disc.SameTags commonTags) Common.tenTracksDisc result `shouldBe` Right (), Tasty.testCase "some tracks have a different tag" $ do - let album = Common.tenTracksAlbum - result <- Album.check (Album.SameTags $ Tag.Track <| commonTags) album - result `shouldBe` Left (Album.SameTagsError $ fromList [Tag.Track]) + let d = Common.tenTracksDisc + result <- Disc.check (Disc.SameTags $ Tag.Track <| commonTags) d + result `shouldBe` Left (Disc.SameTagsError $ fromList [Tag.Track]) ] where commonTags = fromList [Tag.Genre, Tag.Year, Tag.Artist, Tag.AlbumArtist] @@ -130,13 +130,13 @@ testCheckSequential = Tasty.testGroup "check sequential tracks" [ Tasty.testCase "the tracks are sequential" $ do - result <- Album.check Album.TracksSequential Common.tenTracksAlbum + result <- Disc.check Disc.TracksSequential Common.tenTracksDisc result `shouldBe` Right (), Tasty.testCase "there are two tracks number 10" $ do - let (track :| tracks) = Album.tracks Common.tenTracksAlbum + let (track :| tracks) = Disc.tracks Common.tenTracksDisc otherTen = track {AudioTrack.atTrack = HTagLib.mkTrackNumber 10} tracks' = otherTen :| tracks - album' = Maybe.fromJust $ Album.mkAlbum tracks' - result <- Album.check Album.TracksSequential album' - result `shouldBe` Left Album.TracksNotSequential + d' = Maybe.fromJust $ Disc.mkDisc tracks' + result <- Disc.check Disc.TracksSequential d' + result `shouldBe` Left Disc.TracksNotSequential ] diff --git a/tests/Tests/Common.hs b/tests/Tests/Common.hs index 93033a7..987bbf8 100644 --- a/tests/Tests/Common.hs +++ b/tests/Tests/Common.hs @@ -1,16 +1,16 @@ {-# LANGUAGE QuasiQuotes #-} module Tests.Common - ( tenTracksAlbum, - tenTracksAlbum', + ( tenTracksDisc, + tenTracksDisc', withTenTracksFiles, withTenTracksFilesInSubdir, withOneTrackFile, ) where -import Model.Album qualified as Album import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc import Path (absdir, reldir, relfile, ()) import Path qualified import Path.IO qualified as Path @@ -24,28 +24,28 @@ import Test.Tasty.HUnit qualified as Tasty withTenTracksFilesInSubdir :: -- | Subdirectory to put the files in Path.Path Path.Rel Path.Dir -> - -- | Action to run with the temporary directory and the created album - (Path.Path Path.Abs Path.Dir -> Album.Album -> IO ()) -> + -- | Action to run with the temporary directory and the created disc + (Path.Path Path.Abs Path.Dir -> Disc.Disc -> IO ()) -> Tasty.Assertion -withTenTracksFilesInSubdir subdir withTempDirAndAlbum = +withTenTracksFilesInSubdir subdir withTempDirAndDisc = Path.withSystemTempDir "htagcli" $ \dir -> do - let album = - tenTracksAlbum' + let d = + tenTracksDisc' (dir subdir) (HTagLib.mkAlbum "Album") (HTagLib.mkGenre "Pop") - forM_ (Album.tracks album) $ \track -> do + forM_ (Disc.tracks d) $ \track -> do let dstAbsFile = AudioTrack.atFile track Path.ensureDir $ Path.parent dstAbsFile Path.copyFile [relfile|./data/sample.mp3|] dstAbsFile AudioTrack.setTags track - withTempDirAndAlbum dir album + withTempDirAndDisc dir d -- | Same with the files directly in the temporary directory withTenTracksFiles :: - (Path.Path Path.Abs Path.Dir -> Album.Album -> IO ()) -> Tasty.Assertion -withTenTracksFiles withTempDirAndAlbum = - withTenTracksFilesInSubdir [reldir|./|] withTempDirAndAlbum + (Path.Path Path.Abs Path.Dir -> Disc.Disc -> IO ()) -> Tasty.Assertion +withTenTracksFiles withTempDirAndDisc = + withTenTracksFilesInSubdir [reldir|./|] withTempDirAndDisc withOneTrackFile :: (Path.Path Path.Abs Path.Dir -> Path.Path Path.Abs Path.File -> IO ()) -> @@ -69,16 +69,16 @@ withOneTrackFile action = AudioTrack.setTags track action dir file -tenTracksAlbum :: Album.Album -tenTracksAlbum = - tenTracksAlbum' +tenTracksDisc :: Disc.Disc +tenTracksDisc = + tenTracksDisc' [absdir|/path/to|] (HTagLib.mkAlbum "Album") (HTagLib.mkGenre "Pop") -tenTracksAlbum' :: - Path.Path Path.Abs Path.Dir -> HTagLib.Album -> HTagLib.Genre -> Album.Album -tenTracksAlbum' dir album genre = Unsafe.fromJust $ do +tenTracksDisc' :: + Path.Path Path.Abs Path.Dir -> HTagLib.Album -> HTagLib.Genre -> Disc.Disc +tenTracksDisc' dir album genre = Unsafe.fromJust $ do track <- forM (fromList [1 .. 10]) $ \i -> do dstRelFile <- (dir ) <$> Path.parseRelFile (show i <> "-sample.mp3") pure $ @@ -93,4 +93,4 @@ tenTracksAlbum' dir album genre = Unsafe.fromJust $ do AudioTrack.atTrack = HTagLib.mkTrackNumber i, AudioTrack.atDisc = Nothing } - Album.mkAlbum track + Disc.mkDisc track From 0f5b2837d3f251d169e76008c6b19b0f7724d01c Mon Sep 17 00:00:00 2001 From: jecaro Date: Thu, 25 Jun 2026 16:20:53 +0200 Subject: [PATCH 02/23] Add Album data type --- app/ConduitUtils.hs | 12 ++++++--- app/Main.hs | 1 + htagcli.cabal | 1 + lib/Check/Artist.hs | 6 +++-- lib/Model/Album.hs | 51 +++++++++++++++++++++++++++++++++++++ lib/Model/Artist.hs | 32 +++++++++++------------ tests/Tests/Check/Artist.hs | 30 ++++++++++++---------- 7 files changed, 99 insertions(+), 34 deletions(-) create mode 100644 lib/Model/Album.hs diff --git a/app/ConduitUtils.hs b/app/ConduitUtils.hs index b9a1a20..e53bcfc 100644 --- a/app/ConduitUtils.hs +++ b/app/ConduitUtils.hs @@ -1,8 +1,9 @@ -module ConduitUtils (runConduitWithProgress, discC, artistC) where +module ConduitUtils (runConduitWithProgress, discC, albumC, artistC) where import Conduit ((.|)) import Conduit qualified import Data.Text qualified as Text +import Model.Album qualified as Album import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack import Model.Disc qualified as Disc @@ -46,10 +47,15 @@ discC :: Conduit.ConduitT AudioTrack.AudioTrack Disc.Disc m () discC = clusterC Disc.mkDisc Disc.addTrack +albumC :: + (Monad m) => + Conduit.ConduitT Disc.Disc Album.Album m () +albumC = clusterC Album.mkAlbum Album.addDisc + artistC :: (Monad m) => - Conduit.ConduitT Disc.Disc Artist.Artist m () -artistC = clusterC Artist.mkArtist Artist.addDisc + Conduit.ConduitT Album.Album Artist.Artist m () +artistC = clusterC Artist.mkArtist Artist.addAlbum -- | Cluster incoming items into groups using the provided 'mk' and 'add' -- functions diff --git a/app/Main.hs b/app/Main.hs index 086e655..c2e9fc0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -111,6 +111,7 @@ main = do .| ConduitUtils.discC .| Conduit.iterM (addDiscErrors <=< Commands.checkDisc discChecks) + .| ConduitUtils.albumC .| ConduitUtils.artistC .| Conduit.mapM_C (flip when incArtistErrors <=< Commands.checkArtist mbArtistCheck) diff --git a/htagcli.cabal b/htagcli.cabal index 4a772c7..941c8c7 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -47,6 +47,7 @@ library Commands Config Data.List.NonEmpty.Extra + Model.Album Model.Artist Model.AudioTrack Model.Cover diff --git a/lib/Check/Artist.hs b/lib/Check/Artist.hs index e336f2f..07dd0cf 100644 --- a/lib/Check/Artist.hs +++ b/lib/Check/Artist.hs @@ -8,6 +8,7 @@ where import Data.Map.Strict qualified as Map import Data.Text qualified as Text +import Model.Album qualified as Album import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack import Model.Disc qualified as Disc @@ -37,9 +38,10 @@ check (SameGenre artistToAllowedGenres) artist Right () | otherwise = Left $ SameGenreError genres where - discs = Artist.discs artist genres = - NonEmpty.nubOrd $ AudioTrack.atGenre <$> (Disc.tracks =<< discs) + NonEmpty.nubOrd $ + AudioTrack.atGenre + <$> (Disc.tracks =<< Album.discs =<< Artist.albums artist) albumArtistOrArtist = Artist.albumArtistOrArtist artist mbAllowedGenres = Map.lookup diff --git a/lib/Model/Album.hs b/lib/Model/Album.hs new file mode 100644 index 0000000..e731ab0 --- /dev/null +++ b/lib/Model/Album.hs @@ -0,0 +1,51 @@ +module Model.Album + ( Album, + mkAlbum, + addDisc, + discs, + album, + artist, + albumArtist, + albumArtistOrArtist, + ) +where + +import Data.List.NonEmpty ((<|)) +import Model.Disc qualified as Disc +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib + +newtype Album = Album (NonEmpty Disc.Disc) + deriving (Eq, Show) + +mkAlbum :: NonEmpty Disc.Disc -> Maybe Album +mkAlbum discs'@(firstDisc :| otherDiscs) + | allSameAlbum + && (allSameAlbumArtist || allSameArtist) = + Just $ Album discs' + | otherwise = Nothing + where + firstAlbum = Disc.album firstDisc + firstAlbumArtist = Disc.albumArtist firstDisc + firstArtist = Disc.artist firstDisc + allSameAlbum = all ((== firstAlbum) . Disc.album) otherDiscs + allSameAlbumArtist = all ((== firstAlbumArtist) . Disc.albumArtist) otherDiscs + allSameArtist = all ((== firstArtist) . Disc.artist) otherDiscs + +addDisc :: Disc.Disc -> Album -> Maybe Album +addDisc d (Album discs') = mkAlbum (d <| discs') + +discs :: Album -> NonEmpty Disc.Disc +discs (Album discs') = discs' + +album :: Album -> HTagLib.Album +album (Album (d :| _)) = Disc.album d + +artist :: Album -> HTagLib.Artist +artist (Album (d :| _)) = Disc.artist d + +albumArtist :: Album -> HTagLib.AlbumArtist +albumArtist (Album (d :| _)) = Disc.albumArtist d + +albumArtistOrArtist :: Album -> HTagLib.AlbumArtistOrArtist +albumArtistOrArtist (Album (d :| _)) = Disc.albumArtistOrArtist d diff --git a/lib/Model/Artist.hs b/lib/Model/Artist.hs index 49b78ca..bbdaa08 100644 --- a/lib/Model/Artist.hs +++ b/lib/Model/Artist.hs @@ -1,41 +1,41 @@ module Model.Artist ( Artist, mkArtist, - addDisc, + addAlbum, albumArtistOrArtist, - discs, + albums, ) where import Data.List.NonEmpty ((<|)) import Data.Text qualified as Text -import Model.Disc qualified as Disc +import Model.Album qualified as Album import Sound.HTagLib.Extra qualified as HTagLib -newtype Artist = Artist (NonEmpty Disc.Disc) +newtype Artist = Artist (NonEmpty Album.Album) deriving (Eq, Show) -mkArtist :: NonEmpty Disc.Disc -> Maybe Artist -mkArtist discs'@(firstDisc :| otherDiscs) +mkArtist :: NonEmpty Album.Album -> Maybe Artist +mkArtist albums'@(firstAlbum :| otherAlbums) | ( allSameAlbumArtist && not (Text.null $ HTagLib.unAlbumArtist firstAlbumArtist) && (firstAlbumArtist /= "Various Artists") ) || allSameArtist = - Just $ Artist discs' + Just $ Artist albums' | otherwise = Nothing where - firstAlbumArtist = Disc.albumArtist firstDisc - firstArtist = Disc.artist firstDisc + firstAlbumArtist = Album.albumArtist firstAlbum + firstArtist = Album.artist firstAlbum allSameAlbumArtist = - all ((== firstAlbumArtist) . Disc.albumArtist) otherDiscs - allSameArtist = all ((== firstArtist) . Disc.artist) otherDiscs + all ((== firstAlbumArtist) . Album.albumArtist) otherAlbums + allSameArtist = all ((== firstArtist) . Album.artist) otherAlbums -addDisc :: Disc.Disc -> Artist -> Maybe Artist -addDisc d (Artist discs') = mkArtist (d <| discs') +addAlbum :: Album.Album -> Artist -> Maybe Artist +addAlbum a (Artist albums') = mkArtist (a <| albums') albumArtistOrArtist :: Artist -> HTagLib.AlbumArtistOrArtist -albumArtistOrArtist (Artist (d :| _)) = Disc.albumArtistOrArtist d +albumArtistOrArtist (Artist (a :| _)) = Album.albumArtistOrArtist a -discs :: Artist -> NonEmpty Disc.Disc -discs (Artist discs') = discs' +albums :: Artist -> NonEmpty Album.Album +albums (Artist albums') = albums' diff --git a/tests/Tests/Check/Artist.hs b/tests/Tests/Check/Artist.hs index 5e277b4..bd14157 100644 --- a/tests/Tests/Check/Artist.hs +++ b/tests/Tests/Check/Artist.hs @@ -3,6 +3,7 @@ module Tests.Check.Artist (test) where import Check.Artist qualified as Artist +import Model.Album qualified as Album import Model.Artist qualified as Artist import Path (absdir) import Relude.Unsafe qualified as Unsafe @@ -16,41 +17,44 @@ test :: Tasty.TestTree test = Tasty.testGroup "Check.Artist" - [ Tasty.testCase "two discs of the same artist with the same genre" $ do - let disc1 = tenTracksDisc (HTagLib.mkAlbum "album-1") rock - disc2 = tenTracksDisc (HTagLib.mkAlbum "album-2") rock + [ Tasty.testCase "two albums of the same artist with the same genre" $ do + let album1 = tenTracksAlbum (HTagLib.mkAlbum "album-1") rock + album2 = tenTracksAlbum (HTagLib.mkAlbum "album-2") rock artist = Unsafe.fromJust $ Artist.mkArtist $ - fromList [disc1, disc2] + fromList [album1, album2] Artist.check (Artist.SameGenre mempty) artist `shouldBe` Right (), - Tasty.testCase "two discs of the same artist with different genres" $ do - let disc1 = tenTracksDisc (HTagLib.mkAlbum "album-1") pop - disc2 = tenTracksDisc (HTagLib.mkAlbum "album-2") rock + Tasty.testCase "two albums of the same artist with different genres" $ do + let album1 = tenTracksAlbum (HTagLib.mkAlbum "album-1") pop + album2 = tenTracksAlbum (HTagLib.mkAlbum "album-2") rock artist = Unsafe.fromJust $ Artist.mkArtist $ - fromList [disc1, disc2] + fromList [album1, album2] Artist.check (Artist.SameGenre mempty) artist `shouldBe` Left (Artist.SameGenreError genres), Tasty.testCase - "two discs of the same artist with different genres but \ + "two albums of the same artist with different genres but \ \with exceptions" $ do - let disc1 = tenTracksDisc (HTagLib.mkAlbum "album-1") pop - disc2 = tenTracksDisc (HTagLib.mkAlbum "album-2") rock + let album1 = tenTracksAlbum (HTagLib.mkAlbum "album-1") pop + album2 = tenTracksAlbum (HTagLib.mkAlbum "album-2") rock artist = Unsafe.fromJust $ Artist.mkArtist $ - fromList [disc1, disc2] + fromList [album1, album2] Artist.check (Artist.SameGenre (fromList [("Album Artist", genres)])) artist `shouldBe` Right () ] where - tenTracksDisc = Common.tenTracksDisc' [absdir|/path/to|] + tenTracksAlbum albumTag genre = + Unsafe.fromJust $ + Album.mkAlbum $ + (Common.tenTracksDisc' [absdir|/path/to|] albumTag genre) :| [] rock = HTagLib.mkGenre "Rock" pop = HTagLib.mkGenre "Pop" genres = fromList [pop, rock] From 1f8fa7ddcc59d470422c26077283cc22ec6bf6a6 Mon Sep 17 00:00:00 2001 From: jecaro Date: Thu, 25 Jun 2026 22:27:12 +0200 Subject: [PATCH 03/23] Add album checks (discs sequential, same tags) --- app/Main.hs | 20 ++++++-- app/Options.hs | 27 ++++++++++- app/Stats.hs | 7 ++- data/htagcli.toml | 9 ++++ htagcli.cabal | 2 + lib/Check/Album.hs | 48 ++++++++++++++++++ lib/Commands.hs | 20 ++++++++ lib/Config.hs | 23 ++++++++- lib/Model/Album.hs | 8 +++ tests/Main.hs | 2 + tests/Tests/Check/Album.hs | 99 ++++++++++++++++++++++++++++++++++++++ 11 files changed, 257 insertions(+), 8 deletions(-) create mode 100644 lib/Check/Album.hs create mode 100644 tests/Tests/Check/Album.hs diff --git a/app/Main.hs b/app/Main.hs index c2e9fc0..d99500d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -93,15 +93,22 @@ main = do config <- Config.readConfig -- Get the checks from the CLI and fallback to the config file - let (trackChecks, discChecks, mbArtistCheck) = Options.checks config options + let (trackChecks, discChecks, albumChecks, mbArtistCheck) = + Options.checks config options - when (null trackChecks && null discChecks && null mbArtistCheck) $ - Exception.throwIO NoCheckInConfig + when + ( null trackChecks + && null discChecks + && null albumChecks + && null mbArtistCheck + ) + $ Exception.throwIO NoCheckInConfig stats <- newIORef Stats.empty let modifyStats = modifyIORef' stats addTrackErrors = modifyStats . Stats.addTrackErrors addDiscErrors = modifyStats . Stats.addDiscErrors + addAlbumErrors = modifyStats . Stats.addAlbumErrors incArtistErrors = modifyStats Stats.incArtistErrors ConduitUtils.runConduitWithProgress files $ @@ -112,6 +119,8 @@ main = do .| Conduit.iterM (addDiscErrors <=< Commands.checkDisc discChecks) .| ConduitUtils.albumC + .| Conduit.iterM + (addAlbumErrors <=< Commands.checkAlbum albumChecks) .| ConduitUtils.artistC .| Conduit.mapM_C (flip when incArtistErrors <=< Commands.checkArtist mbArtistCheck) @@ -123,11 +132,14 @@ main = do unless (null discChecks) $ putTextLn $ "Disc errors: " <> show ceDiscErrors + unless (null albumChecks) $ + putTextLn $ + "Album errors: " <> show ceAlbumErrors when (isJust mbArtistCheck) $ putTextLn $ "Artist errors: " <> show ceArtistErrors - let total = ceTrackErrors + ceDiscErrors + ceArtistErrors + let total = ceTrackErrors + ceDiscErrors + ceAlbumErrors + ceArtistErrors when (total > 0) $ System.exitWith $ System.ExitFailure total Options.FixFilePaths Options.FixFilePathsOptions {..} files -> do Config.Config diff --git a/app/Options.hs b/app/Options.hs index 10ec402..b218a1a 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -8,6 +8,7 @@ module Options ) where +import Check.Album qualified as Album import Check.Artist qualified as Artist import Check.Disc qualified as Disc import Check.Track qualified as Track @@ -57,7 +58,7 @@ data Command checks :: Config.Config -> CheckOptions -> - ([Track.Check], [Disc.Check], Maybe Artist.Check) + ([Track.Check], [Disc.Check], [Album.Check], Maybe Artist.Check) checks config@(Config.Config {coFilename = Config.Filename {..}}) (Options.CheckOptions {..}) @@ -85,6 +86,8 @@ checksP = <*> discSameDirP <*> optional discSameTagsP <*> discTracksSequentialP + <*> albumDiscsSequentialP + <*> optional albumSameTagsP <*> artistSameGenreP fixFilePathsOptionsP :: Options.Parser FixFilePathsOptions @@ -187,6 +190,28 @@ discTracksSequentialP = "Check that track numbers are sequential within the disc" ) +albumDiscsSequentialP :: Options.Parser Bool +albumDiscsSequentialP = + Options.switch + ( Options.long "album-discs-sequential" + <> Options.help + "Check that disc numbers are sequential within the album" + ) + +albumSameTagsP :: Options.Parser (NonEmpty Tag.Tag) +albumSameTagsP = + Options.some1 + ( Options.option + tagR + ( Options.long "album-same-tag" + <> Options.metavar "TAG" + <> Options.help + "Check that all discs in the album have the same value for \ + \the specified tag (title, artist, album, albumartist, genre, \ + \year, track)" + ) + ) + artistSameGenreP :: Options.Parser (Maybe Artist.Check) artistSameGenreP = Options.flag diff --git a/app/Stats.hs b/app/Stats.hs index 2f95b22..3eb2b17 100644 --- a/app/Stats.hs +++ b/app/Stats.hs @@ -3,6 +3,7 @@ module Stats Stats.empty, addTrackErrors, addDiscErrors, + addAlbumErrors, incArtistErrors, ) where @@ -10,11 +11,12 @@ where data CheckErrors = CheckErrors { ceTrackErrors :: Int, ceDiscErrors :: Int, + ceAlbumErrors :: Int, ceArtistErrors :: Int } empty :: CheckErrors -empty = CheckErrors 0 0 0 +empty = CheckErrors 0 0 0 0 addTrackErrors :: Int -> CheckErrors -> CheckErrors addTrackErrors n errors = errors {ceTrackErrors = ceTrackErrors errors + n} @@ -22,5 +24,8 @@ addTrackErrors n errors = errors {ceTrackErrors = ceTrackErrors errors + n} addDiscErrors :: Int -> CheckErrors -> CheckErrors addDiscErrors n errors = errors {ceDiscErrors = ceDiscErrors errors + n} +addAlbumErrors :: Int -> CheckErrors -> CheckErrors +addAlbumErrors n errors = errors {ceAlbumErrors = ceAlbumErrors errors + n} + incArtistErrors :: CheckErrors -> CheckErrors incArtistErrors errors = errors {ceArtistErrors = ceArtistErrors errors + 1} diff --git a/data/htagcli.toml b/data/htagcli.toml index 278145f..30d5f0c 100644 --- a/data/htagcli.toml +++ b/data/htagcli.toml @@ -115,6 +115,15 @@ tags = ["albumartist", "album", "year", "genre"] [checks.disc_tracks_sequential] enable = true +# Verify that disc numbers within an album are sequential starting from 1 +[checks.album_discs_sequential] +enable = true + +# Verify that album-level tags are consistent across all discs of an album +[checks.album_tags] +enable = true +tags = ["albumartist", "album", "year", "genre"] + # Verify that all tracks from an artist have the same genre [checks.artist_same_genre] enable = true diff --git a/htagcli.cabal b/htagcli.cabal index 941c8c7..0f45fa4 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -41,6 +41,7 @@ library lib exposed-modules: + Check.Album Check.Artist Check.Disc Check.Track @@ -120,6 +121,7 @@ test-suite tests Main.hs other-modules: + Tests.Check.Album Tests.Check.Artist Tests.Check.Disc Tests.Check.Track diff --git a/lib/Check/Album.hs b/lib/Check/Album.hs new file mode 100644 index 0000000..d2f87c7 --- /dev/null +++ b/lib/Check/Album.hs @@ -0,0 +1,48 @@ +module Check.Album + ( Check (..), + Error (..), + errorToText, + check, + ) +where + +import Data.List qualified as List +import Data.Text qualified as Text +import Model.Album qualified as Album +import Model.Disc qualified as Disc +import Model.Tag qualified as Tag +import Sound.HTagLib.Extra qualified as HTagLib + +data Check + = DiscsSequential + | SameTags (NonEmpty Tag.Tag) + deriving (Eq, Show) + +data Error + = DiscsNotSequential + | SameTagsError (NonEmpty Tag.Tag) + deriving (Eq, Show) + +errorToText :: Error -> Text +errorToText DiscsNotSequential = + "Disc numbers are not sequentially numbered" +errorToText (SameTagsError tags) = + "These tags are not the same for all discs in the album: " + <> Text.intercalate ", " (Tag.asText <$> toList tags) + +check :: Check -> Album.Album -> Either Error () +check DiscsSequential album + | length (Album.discs album) == 1 = Right () + | otherwise = case traverse Disc.disc (Album.discs album) of + Nothing -> Left DiscsNotSequential + Just numbers -> + if sequential $ toList $ HTagLib.unDiscNumber <$> numbers + then Right () + else Left DiscsNotSequential + where + sequential list = and $ zipWith (==) (List.sort list) [1 ..] +check (SameTags tagsToCheck) album = case checkedTags of + [] -> Right () + (tag : tags) -> Left (SameTagsError (tag :| tags)) + where + checkedTags = mapMaybe (Album.haveSameTag' album) (toList tagsToCheck) diff --git a/lib/Commands.hs b/lib/Commands.hs index 07e9ea7..0c0ddcd 100644 --- a/lib/Commands.hs +++ b/lib/Commands.hs @@ -3,6 +3,7 @@ module Commands setTags, checkTrack, checkDisc, + checkAlbum, checkArtist, FixFilePathsOptions (..), fixFilePaths, @@ -12,9 +13,11 @@ module Commands ) where +import Check.Album qualified as Album import Check.Artist qualified as Artist import Check.Disc qualified as Disc import Check.Track qualified as Track +import Model.Album qualified as Album import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack import Model.Disc qualified as Disc @@ -92,6 +95,23 @@ checkDisc checks d = countTrues <$> traverse checkPrintError checks "/Disc " <> show (HTagLib.unDiscNumber discNum) | otherwise = "" +checkAlbum :: (MonadIO m) => [Album.Check] -> Album.Album -> m Int +checkAlbum checks a = countTrues <$> traverse checkPrintError checks + where + checkPrintError check = do + let result = Album.check check a + whenLeft_ result $ \err -> + putTextLn $ + "Album " + <> albumArtistOrArtistTxt + <> albumTxt + <> ": " + <> Album.errorToText err + pure $ isLeft result + albumArtistOrArtistTxt = + HTagLib.unAlbumArtistOrArtist $ Album.albumArtistOrArtist a + albumTxt = "/" <> HTagLib.unAlbum (Album.album a) + checkArtist :: (MonadIO m) => Maybe Artist.Check -> diff --git a/lib/Config.hs b/lib/Config.hs index 5c92319..6858fe6 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -17,6 +17,7 @@ module Config ) where +import Check.Album qualified as Album import Check.Artist qualified as Artist import Check.Disc qualified as Disc import Check.Track qualified as Track @@ -89,6 +90,10 @@ data Checks = Checks chDiscSameTags :: Maybe (NonEmpty Tag.Tag), -- | The tracks of the disc have sequential track numbers chDiscTracksSequential :: Bool, + -- | The disc numbers of the album are sequential + chAlbumDiscsSequential :: Bool, + -- | All the discs of the album have the same value for the given tags + chAlbumSameTags :: Maybe (NonEmpty Tag.Tag), -- | All the tracks from the artist have the same genre chArtistSameGenre :: Maybe Artist.Check } @@ -104,6 +109,8 @@ haveChecks (Checks {..}) = chDiscSameDir, isJust chDiscSameTags, chDiscTracksSequential, + chAlbumDiscsSequential, + isJust chAlbumSameTags, isJust chArtistSameGenre ] @@ -126,10 +133,17 @@ discChecks (Checks {..}) = guarded (const chDiscTracksSequential) Disc.TracksSequential ] +albumChecks :: Checks -> [Album.Check] +albumChecks (Checks {..}) = + catMaybes + [ guarded (const chAlbumDiscsSequential) Album.DiscsSequential, + Album.SameTags <$> chAlbumSameTags + ] + artistCheck :: Checks -> Maybe Artist.Check artistCheck (Checks {..}) = chArtistSameGenre -factorChecks :: Config -> ([Track.Check], [Disc.Check], Maybe Artist.Check) +factorChecks :: Config -> ([Track.Check], [Disc.Check], [Album.Check], Maybe Artist.Check) factorChecks Config {coFilename = Filename {..}, ..} = factorChecks' fiPattern fiFormatting coChecks @@ -137,10 +151,11 @@ factorChecks' :: Pattern.Pattern -> Pattern.Formatting -> Checks -> - ([Track.Check], [Disc.Check], Maybe Artist.Check) + ([Track.Check], [Disc.Check], [Album.Check], Maybe Artist.Check) factorChecks' pattern formatting checks = ( trackChecks pattern formatting checks, discChecks checks, + albumChecks checks, artistCheck checks ) @@ -246,6 +261,8 @@ checksC = <*> discSameDirC .= chDiscSameDir <*> maybeValidatedC "disc_tags" tagsC chDiscSameTags <*> discTracksSequentialC .= chDiscTracksSequential + <*> albumDiscsSequentialC .= chAlbumDiscsSequential + <*> maybeValidatedC "album_tags" tagsC chAlbumSameTags <*> maybeValidatedC "artist_same_genre" artistSameGenreC chArtistSameGenre where trackFilenameC = Toml.table (Toml.bool "enable") "track_filename" @@ -253,6 +270,8 @@ checksC = tagsC = Toml.arrayNonEmptyOf tagB "tags" discTracksSequentialC = Toml.table (Toml.bool "enable") "disc_tracks_sequential" + albumDiscsSequentialC = + Toml.table (Toml.bool "enable") "album_discs_sequential" artistSameGenreC = Toml.diwrap $ Toml.map diff --git a/lib/Model/Album.hs b/lib/Model/Album.hs index e731ab0..0a90b84 100644 --- a/lib/Model/Album.hs +++ b/lib/Model/Album.hs @@ -7,11 +7,13 @@ module Model.Album artist, albumArtist, albumArtistOrArtist, + haveSameTag', ) where import Data.List.NonEmpty ((<|)) import Model.Disc qualified as Disc +import Model.Tag qualified as Tag import Sound.HTagLib qualified as HTagLib import Sound.HTagLib.Extra qualified as HTagLib @@ -49,3 +51,9 @@ albumArtist (Album (d :| _)) = Disc.albumArtist d albumArtistOrArtist :: Album -> HTagLib.AlbumArtistOrArtist albumArtistOrArtist (Album (d :| _)) = Disc.albumArtistOrArtist d + +haveSameTag' :: Album -> Tag.Tag -> Maybe Tag.Tag +haveSameTag' a = guarded (not . haveSameTag a) + +haveSameTag :: Album -> Tag.Tag -> Bool +haveSameTag (Album discs') tag = all (`Disc.haveSameTag` tag) discs' diff --git a/tests/Main.hs b/tests/Main.hs index 1aac522..3cfd05c 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,6 +1,7 @@ module Main (main) where import Test.Tasty (defaultMain, testGroup) +import Tests.Check.Album qualified as Check.Album import Tests.Check.Artist qualified as Check.Artist import Tests.Check.Disc qualified as Check.Disc import Tests.Check.Track qualified as Check.Track @@ -21,6 +22,7 @@ main = Model.Pattern.test, Model.Tag.test, Check.Disc.test, + Check.Album.test, Check.Artist.test, Check.Track.test ] diff --git a/tests/Tests/Check/Album.hs b/tests/Tests/Check/Album.hs new file mode 100644 index 0000000..5ef6976 --- /dev/null +++ b/tests/Tests/Check/Album.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Tests.Check.Album (test) where + +import Check.Album qualified as Album +import Model.Album qualified as Album +import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc +import Model.Tag qualified as Tag +import Path (absdir, ()) +import Path qualified +import Relude.Unsafe qualified as Unsafe +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib +import Test.Hspec.Expectations (shouldBe) +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit qualified as Tasty +import Tests.Common qualified as Common + +test :: Tasty.TestTree +test = + Tasty.testGroup + "Check.Album" + [ testCheckDiscsSequential, + testCheckSameTags + ] + +testCheckDiscsSequential :: Tasty.TestTree +testCheckDiscsSequential = + Tasty.testGroup + "check discs sequential" + [ Tasty.testCase "single disc without a disc number" $ do + let album = singleDiscAlbum Common.tenTracksDisc + Album.check Album.DiscsSequential album + `shouldBe` Right (), + Tasty.testCase "two discs with sequential numbers" $ do + let disc1 = discWithNumber albumTag genre (HTagLib.mkDiscNumber 1) dir1 + disc2 = discWithNumber albumTag genre (HTagLib.mkDiscNumber 2) dir2 + album = Unsafe.fromJust $ Album.mkAlbum (disc1 :| [disc2]) + Album.check Album.DiscsSequential album + `shouldBe` Right (), + Tasty.testCase "two discs without disc numbers" $ do + let disc1 = discWithNumber albumTag genre Nothing dir1 + disc2 = discWithNumber albumTag genre Nothing dir2 + album = Unsafe.fromJust $ Album.mkAlbum (disc1 :| [disc2]) + Album.check Album.DiscsSequential album + `shouldBe` Left Album.DiscsNotSequential, + Tasty.testCase "two discs with non-sequential numbers" $ do + let disc1 = discWithNumber albumTag genre (HTagLib.mkDiscNumber 1) dir1 + disc3 = discWithNumber albumTag genre (HTagLib.mkDiscNumber 3) dir2 + album = Unsafe.fromJust $ Album.mkAlbum (disc1 :| [disc3]) + Album.check Album.DiscsSequential album + `shouldBe` Left Album.DiscsNotSequential + ] + where + albumTag = HTagLib.mkAlbum "Album" + genre = HTagLib.mkGenre "Pop" + dir1 = [absdir|/path/to/disc1|] + dir2 = [absdir|/path/to/disc2|] + +testCheckSameTags :: Tasty.TestTree +testCheckSameTags = + Tasty.testGroup + "check same tags" + [ Tasty.testCase "all tracks in all discs have the same genre" $ do + let album = singleDiscAlbum Common.tenTracksDisc + Album.check (Album.SameTags $ fromList [Tag.Genre]) album + `shouldBe` Right (), + Tasty.testCase "a disc has tracks with different track numbers" $ do + let album = singleDiscAlbum Common.tenTracksDisc + Album.check (Album.SameTags $ fromList [Tag.Track]) album + `shouldBe` Left (Album.SameTagsError $ fromList [Tag.Track]) + ] + +singleDiscAlbum :: Disc.Disc -> Album.Album +singleDiscAlbum d = Unsafe.fromJust $ Album.mkAlbum (d :| []) + +discWithNumber :: + HTagLib.Album -> + HTagLib.Genre -> + Maybe HTagLib.DiscNumber -> + Path.Path Path.Abs Path.Dir -> + Disc.Disc +discWithNumber albumTag genre discNum dir = Unsafe.fromJust $ do + track <- forM (fromList [1 .. 10]) $ \i -> do + dstRelFile <- (dir ) <$> Path.parseRelFile (show i <> "-sample.mp3") + pure $ + AudioTrack.AudioTrack + { AudioTrack.atFile = dstRelFile, + AudioTrack.atTitle = HTagLib.mkTitle $ "Track " <> show i, + AudioTrack.atArtist = HTagLib.mkArtist "Artist", + AudioTrack.atAlbumArtist = HTagLib.mkAlbumArtist "Album Artist", + AudioTrack.atAlbum = albumTag, + AudioTrack.atGenre = genre, + AudioTrack.atYear = HTagLib.mkYear 2025, + AudioTrack.atTrack = HTagLib.mkTrackNumber i, + AudioTrack.atDisc = discNum + } + Disc.mkDisc track From fa694e9c6760cf78836918825fa8de72eec97bd0 Mon Sep 17 00:00:00 2001 From: jecaro Date: Wed, 18 Mar 2026 15:19:04 +0100 Subject: [PATCH 04/23] Add MusicBrainz search --- app/ConduitUtils.hs | 30 +- app/Main.hs | 24 ++ app/Options.hs | 53 +++ data/musicbrainz-dischord-search.json | 84 ++++ data/musicbrainz-repeater-detail.json | 564 ++++++++++++++++++++++++++ data/musicbrainz-repeater-search.json | 73 ++++ htagcli.cabal | 14 + lib/MusicBrainz.hs | 237 +++++++++++ tests/Main.hs | 4 +- tests/Tests/MusicBrainz.hs | 103 +++++ 10 files changed, 1184 insertions(+), 2 deletions(-) create mode 100644 data/musicbrainz-dischord-search.json create mode 100644 data/musicbrainz-repeater-detail.json create mode 100644 data/musicbrainz-repeater-search.json create mode 100644 lib/MusicBrainz.hs create mode 100644 tests/Tests/MusicBrainz.hs diff --git a/app/ConduitUtils.hs b/app/ConduitUtils.hs index e53bcfc..20f3a14 100644 --- a/app/ConduitUtils.hs +++ b/app/ConduitUtils.hs @@ -1,4 +1,12 @@ -module ConduitUtils (runConduitWithProgress, discC, albumC, artistC) where +module ConduitUtils + ( runConduitWithProgress, + filesC, + discC, + albumC, + artistC, + oneC, + ) +where import Conduit ((.|)) import Conduit qualified @@ -12,6 +20,7 @@ import Path qualified import Path.IO qualified as Path import Progress qualified import System.FilePath qualified as FilePath +import UnliftIO.Exception qualified as Exception runConduitWithProgress :: Options.Files -> @@ -52,6 +61,25 @@ albumC :: Conduit.ConduitT Disc.Disc Album.Album m () albumC = clusterC Album.mkAlbum Album.addDisc +oneC :: + ( Conduit.MonadThrow m, + Conduit.MonadIO m, + Exception nothing, + Exception moreThanOne + ) => + nothing -> + moreThanOne -> + Conduit.ConduitT album Void m album +oneC nothing moreThanOne = do + mbFirst <- Conduit.await + case mbFirst of + Nothing -> Exception.throwIO nothing + Just album -> do + mbSecond <- Conduit.await + case mbSecond of + Nothing -> pure album + Just _ -> Exception.throwIO moreThanOne + artistC :: (Monad m) => Conduit.ConduitT Album.Album Artist.Artist m () diff --git a/app/Main.hs b/app/Main.hs index d99500d..259a4d7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,8 +7,10 @@ import Data.Conduit.Combinators qualified as Conduit import Data.Either.Extra qualified as Either import Data.Text qualified as Text import Data.Text.IO qualified as Text +import Model.Album qualified as Album import Model.AudioTrack qualified as AudioTrack import Model.Cover qualified as Cover +import MusicBrainz qualified import Options qualified import Options.Applicative qualified as Options import Path.IO qualified as Path @@ -28,6 +30,8 @@ data Error | MoveCoverWithoutCheck | EditorExitError | ParseError (Megaparsec.ParseErrorBundle Text.Text Void) + | NoAudioFiles + | NotSameAlbum deriving (Show) instance Exception.Exception Error @@ -40,6 +44,8 @@ errorToText (ParseError parseError) = <> Text.pack (Megaparsec.errorBundlePretty parseError) errorToText MoveCoverWithoutCheck = "move_cover is enabled but checks.disc_cover is disabled." +errorToText NoAudioFiles = "No audio files found" +errorToText NotSameAlbum = "Input files are not from the same album" main :: IO () main = do @@ -167,11 +173,27 @@ main = do ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C $ Commands.fixFilePaths fixFilePathOptions + Options.Search Options.SearchOptions {..} -> case seSource of + Options.SearchFromFiles files -> do + album <- collectAlbum files + MusicBrainz.searchAlbum seMaxResults album + Options.SearchFromArgs albumArtist album -> + MusicBrainz.search seMaxResults albumArtist album where getTagsAsText filename = do content <- encodeUtf8 . AudioTrack.asText <$> AudioTrack.getTags filename pure $ content <> "\n" + collectAlbum :: Options.Files -> IO Album.Album + collectAlbum files = + Conduit.runResourceT $ + Conduit.runConduit $ + ConduitUtils.filesC files + .| Conduit.mapM AudioTrack.getTags + .| ConduitUtils.discC + .| ConduitUtils.albumC + .| ConduitUtils.oneC NoAudioFiles NotSameAlbum + exceptions :: SomeException -> IO () exceptions someException -- Rethrow exit failures to preserve the exit code @@ -188,4 +210,6 @@ exceptions someException Config.errorToText configException <> "\n" | Just commandsException <- fromException someException = Commands.errorToText commandsException <> "\n" + | Just mbException <- fromException someException = + MusicBrainz.errorToText mbException <> "\n" | otherwise = "Unknown exception: " <> show someException <> "\n" diff --git a/app/Options.hs b/app/Options.hs index b218a1a..5449900 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -3,6 +3,8 @@ module Options Command (..), Files (..), FixFilePathsOptions (..), + SearchOptions (..), + SearchSource (..), optionsInfo, checks, ) @@ -44,6 +46,17 @@ data FixFilePathsOptions = FixFilePathsOptions } deriving (Show) +data SearchOptions = SearchOptions + { seMaxResults :: Int, + seSource :: SearchSource + } + deriving (Show) + +data SearchSource + = SearchFromFiles Files + | SearchFromArgs HTagLib.AlbumArtist HTagLib.Album + deriving (Show) + data Command = CreateConfig | GetTags Files @@ -51,6 +64,7 @@ data Command | Edit Files | Check CheckOptions Files | FixFilePaths FixFilePathsOptions Files + | Search SearchOptions deriving (Show) -- | Get checks from the CLI, and fall back to the config file if none are @@ -97,6 +111,39 @@ fixFilePathsOptionsP = <*> optional baseDirectoryP <*> optional filematchesP +searchOptionsP :: Options.Parser SearchOptions +searchOptionsP = + SearchOptions + <$> Options.option + Options.auto + ( Options.long "max-results" + <> Options.metavar "N" + <> Options.value 3 + <> Options.showDefault + <> Options.help "Maximum number of results to display" + ) + <*> searchSourceP + +searchSourceP :: Options.Parser SearchSource +searchSourceP = searchFromArgsP <|> searchFromFilesP + +searchFromFilesP :: Options.Parser SearchSource +searchFromFilesP = SearchFromFiles <$> filesP + +searchFromArgsP :: Options.Parser SearchSource +searchFromArgsP = + SearchFromArgs + <$> Options.strOption + ( Options.long "artist" + <> Options.metavar "ARTIST" + <> Options.help "Artist name to search for" + ) + <*> Options.strOption + ( Options.long "album" + <> Options.metavar "ALBUM" + <> Options.help "Album name to search for" + ) + dryRunP :: Options.Parser Bool dryRunP = Options.switch @@ -407,4 +454,10 @@ optionsP = (FixFilePaths <$> fixFilePathsOptionsP <*> filesP) (Options.progDesc "Fix file paths according to a pattern") ) + <> Options.command + "search" + ( Options.info + (Search <$> searchOptionsP) + (Options.progDesc "Search MusicBrainz for releases") + ) ) diff --git a/data/musicbrainz-dischord-search.json b/data/musicbrainz-dischord-search.json new file mode 100644 index 0000000..1935fa5 --- /dev/null +++ b/data/musicbrainz-dischord-search.json @@ -0,0 +1,84 @@ +{ + "created": "2026-06-24T12:54:30.758Z", + "count": 1, + "offset": 0, + "releases": [ + { + "id": "2b06e322-88e4-465c-b53d-1f82271e6131", + "score": 100, + "status-id": "4e304316-386d-3409-af2e-78857eec5cfe", + "artist-credit-id": "949a7fd5-fe73-3e8f-922e-01ff4ca958f7", + "count": 1, + "title": "Dischord 1981: The Year in Seven Inches", + "status": "Official", + "text-representation": { + "language": "eng", + "script": "Latn" + }, + "artist-credit": [ + { + "name": "Various Artists", + "artist": { + "id": "89ad4ac3-39f7-470e-963a-56509c546377", + "name": "Various Artists", + "sort-name": "Various Artists", + "disambiguation": "add compilations to this artist" + } + } + ], + "release-group": { + "id": "c61c1544-c22d-3b2d-bcd7-ab0dc38e6210", + "type-id": "dd2a21e1-0c00-3729-a7a0-de60b84eb5d1", + "primary-type-id": "f529b476-6e62-324f-b0aa-1f3e33d313fc", + "title": "Dischord 1981: The Year in Seven Inches", + "primary-type": "Album", + "secondary-types": [ + "Compilation" + ], + "secondary-type-ids": [ + "dd2a21e1-0c00-3729-a7a0-de60b84eb5d1" + ] + }, + "date": "1995-10", + "country": "US", + "release-events": [ + { + "date": "1995-10", + "area": { + "id": "489ce91b-6658-3307-9877-795b68554c98", + "name": "United States", + "sort-name": "United States", + "iso-3166-1-codes": [ + "US" + ] + } + } + ], + "barcode": "", + "label-info": [ + { + "catalog-number": "DIS014CD", + "label": { + "id": "2954d038-b2af-495a-b3b7-ab8028c672c4", + "name": "Dischord Records" + } + } + ], + "track-count": 48, + "media": [ + { + "id": "a40c730a-6290-31b0-b6d8-fd72f97ab90d", + "format": "CD", + "disc-count": 2, + "track-count": 48 + } + ], + "tags": [ + { + "count": 1, + "name": "punk" + } + ] + } + ] +} diff --git a/data/musicbrainz-repeater-detail.json b/data/musicbrainz-repeater-detail.json new file mode 100644 index 0000000..e3bbc0f --- /dev/null +++ b/data/musicbrainz-repeater-detail.json @@ -0,0 +1,564 @@ +{ + "asin": null, + "packaging": "Jewel Case", + "artist-credit": [ + { + "artist": { + "name": "Fugazi", + "country": "US", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group", + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace" + }, + "name": "Fugazi", + "joinphrase": "" + } + ], + "packaging-id": "ec27701a-4a22-37f4-bfac-6616e0f9750a", + "status": "Official", + "release-events": [ + { + "area": { + "iso-3166-1-codes": [ + "US" + ], + "name": "United States", + "type": null, + "type-id": null, + "sort-name": "United States", + "disambiguation": "", + "id": "489ce91b-6658-3307-9877-795b68554c98" + }, + "date": "1990" + } + ], + "quality": "normal", + "title": "Repeater", + "cover-art-archive": { + "front": true, + "artwork": true, + "count": 6, + "darkened": false, + "back": true + }, + "media": [ + { + "track-count": 11, + "title": "", + "tracks": [ + { + "recording": { + "artist-credit": [ + { + "joinphrase": "", + "artist": { + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "country": "US" + }, + "name": "Fugazi" + } + ], + "length": 256026, + "id": "3f0bd23d-0f71-40a8-8407-5fb31d9421ba", + "video": false, + "disambiguation": "", + "title": "Turnover", + "first-release-date": "1990-01" + }, + "title": "Turnover", + "artist-credit": [ + { + "joinphrase": "", + "artist": { + "country": "US", + "name": "Fugazi", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "disambiguation": "", + "sort-name": "Fugazi" + }, + "name": "Fugazi" + } + ], + "number": "A1", + "id": "270f219a-99f6-3aa9-af1f-e7e35aae4eea", + "position": 1, + "length": 258000 + }, + { + "number": "A2", + "artist-credit": [ + { + "artist": { + "country": "US", + "name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "disambiguation": "", + "sort-name": "Fugazi", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group" + }, + "name": "Fugazi", + "joinphrase": "" + } + ], + "id": "075a5048-3296-3a92-91e0-8e39ea03fd56", + "position": 2, + "length": 183000, + "title": "Repeater", + "recording": { + "title": "Repeater", + "first-release-date": "1990-01", + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "name": "Fugazi", + "country": "US", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace" + }, + "joinphrase": "" + } + ], + "video": false, + "disambiguation": "", + "length": 181200, + "id": "e7860b1e-f08e-4b85-a34c-68290032e373" + } + }, + { + "id": "d64e94e8-f4da-393d-ae4e-5b25f838f521", + "position": 3, + "length": 155000, + "number": "A3", + "artist-credit": [ + { + "joinphrase": "", + "artist": { + "name": "Fugazi", + "country": "US", + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group" + }, + "name": "Fugazi" + } + ], + "title": "Brendan #1", + "recording": { + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "country": "US", + "name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "disambiguation": "", + "sort-name": "Fugazi", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group" + }, + "joinphrase": "" + } + ], + "length": 152333, + "id": "2b87333b-b4e3-4106-ab3d-d54664456d95", + "video": false, + "disambiguation": "", + "title": "Brendan #1", + "first-release-date": "1990-01" + } + }, + { + "number": "A4", + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "disambiguation": "", + "sort-name": "Fugazi", + "country": "US", + "name": "Fugazi" + }, + "joinphrase": "" + } + ], + "id": "e9f18682-a890-377b-bf63-4d8bf44df815", + "position": 4, + "length": 181000, + "recording": { + "first-release-date": "1990-01", + "title": "Merchandise", + "length": 179133, + "id": "d730a8b0-4dc0-473b-bb4b-136d48290abf", + "disambiguation": "", + "video": false, + "artist-credit": [ + { + "joinphrase": "", + "name": "Fugazi", + "artist": { + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group", + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "country": "US" + } + } + ] + }, + "title": "Merchandise" + }, + { + "title": "Blueprint", + "recording": { + "video": false, + "disambiguation": "", + "id": "7dcd724c-6cb8-4e6c-88e1-89644839048c", + "length": 232840, + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "country": "US" + }, + "joinphrase": "" + } + ], + "first-release-date": "1990-01", + "title": "Blueprint" + }, + "artist-credit": [ + { + "artist": { + "country": "US", + "name": "Fugazi", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "disambiguation": "", + "sort-name": "Fugazi" + }, + "name": "Fugazi", + "joinphrase": "" + } + ], + "number": "A5", + "position": 5, + "id": "ec222978-ba05-3997-bd3e-cf7e0d33e897", + "length": 235000 + }, + { + "recording": { + "artist-credit": [ + { + "artist": { + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "country": "US" + }, + "name": "Fugazi", + "joinphrase": "" + } + ], + "id": "a3af445b-4b04-40d9-a9f1-a1149d715c27", + "length": 204000, + "video": false, + "disambiguation": "", + "title": "Sieve-Fisted Find", + "first-release-date": "1990-01" + }, + "title": "Sieve-Fisted Find", + "id": "d686a261-98a2-3daa-97b2-a44783042b67", + "position": 6, + "length": 206000, + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "country": "US", + "name": "Fugazi", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "sort-name": "Fugazi", + "disambiguation": "" + }, + "joinphrase": "" + } + ], + "number": "B1" + }, + { + "number": "B2", + "artist-credit": [ + { + "artist": { + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "sort-name": "Fugazi", + "disambiguation": "", + "country": "US", + "name": "Fugazi" + }, + "name": "Fugazi", + "joinphrase": "" + } + ], + "position": 7, + "length": 110000, + "id": "0459b700-303b-3ae5-bc20-028ad8eb0f56", + "title": "Greed", + "recording": { + "first-release-date": "1990-01", + "title": "Greed", + "length": 107426, + "id": "1d3cf800-6dc4-4bb7-82cf-0c293480632f", + "disambiguation": "", + "video": false, + "artist-credit": [ + { + "joinphrase": "", + "name": "Fugazi", + "artist": { + "name": "Fugazi", + "country": "US", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "type": "Group" + } + } + ] + } + }, + { + "number": "B3", + "artist-credit": [ + { + "joinphrase": "", + "name": "Fugazi", + "artist": { + "name": "Fugazi", + "country": "US", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace" + } + } + ], + "id": "8e5cdd6a-8191-307b-be87-4c4485732787", + "position": 8, + "length": 210000, + "recording": { + "length": 208000, + "id": "df579190-394e-44e2-a764-8109b4fd1108", + "disambiguation": "", + "video": false, + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "name": "Fugazi", + "country": "US" + }, + "joinphrase": "" + } + ], + "first-release-date": "1990-01", + "title": "Two Beats Off" + }, + "title": "Two Beats Off" + }, + { + "number": "B4", + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "country": "US" + }, + "joinphrase": "" + } + ], + "length": 157000, + "position": 9, + "id": "0be6d47e-486d-3b04-bf2c-810fafad74a4", + "title": "Styrofoam", + "recording": { + "disambiguation": "", + "video": false, + "id": "b1f6344b-4cf1-4c60-9683-b58204da6dc9", + "length": 154906, + "artist-credit": [ + { + "joinphrase": "", + "artist": { + "country": "US", + "name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "sort-name": "Fugazi", + "disambiguation": "", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b" + }, + "name": "Fugazi" + } + ], + "first-release-date": "1990-01", + "title": "Styrofoam" + } + }, + { + "title": "Reprovisional", + "recording": { + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "name": "Fugazi", + "country": "US", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace" + }, + "joinphrase": "" + } + ], + "id": "eca7fea2-dca1-4e7d-bc45-d00e24efd72e", + "length": 137893, + "disambiguation": "", + "video": false, + "title": "Reprovisional", + "first-release-date": "1990-01" + }, + "artist-credit": [ + { + "joinphrase": "", + "artist": { + "name": "Fugazi", + "country": "US", + "sort-name": "Fugazi", + "disambiguation": "", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b" + }, + "name": "Fugazi" + } + ], + "number": "B5", + "id": "ec78c044-e767-3e29-9b02-fc2a0625d227", + "position": 10, + "length": 140000 + }, + { + "title": "Shut the Door", + "recording": { + "id": "8455897c-41c1-4adb-879d-5f4fa67dd6c3", + "length": 291000, + "disambiguation": "", + "video": false, + "artist-credit": [ + { + "artist": { + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "disambiguation": "", + "sort-name": "Fugazi", + "country": "US", + "name": "Fugazi" + }, + "name": "Fugazi", + "joinphrase": "" + } + ], + "first-release-date": "1990-01", + "title": "Shut the Door" + }, + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "type": "Group", + "type-id": "e431f5f6-b5d2-343d-8b36-72607fffb74b", + "disambiguation": "", + "sort-name": "Fugazi", + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "country": "US" + }, + "joinphrase": "" + } + ], + "number": "B6", + "id": "52114f2c-b006-3cb2-96f9-fe0924efbc1a", + "position": 11, + "length": 291000 + } + ], + "format": "Cassette", + "track-offset": 0, + "id": "97057de6-6514-3972-9b79-b4481b5e3ba0", + "position": 1, + "format-id": "f5e6e254-8f39-331c-936b-9c69d686dc47" + } + ], + "id": "00baa173-29db-33a9-af6d-fe109e53a211", + "disambiguation": "", + "text-representation": { + "script": "Latn", + "language": "eng" + }, + "date": "1990", + "country": "US", + "barcode": "", + "status-id": "4e304316-386d-3409-af2e-78857eec5cfe" +} diff --git a/data/musicbrainz-repeater-search.json b/data/musicbrainz-repeater-search.json new file mode 100644 index 0000000..a4b955e --- /dev/null +++ b/data/musicbrainz-repeater-search.json @@ -0,0 +1,73 @@ +{ + "created": "2026-06-24T12:54:15.623Z", + "count": 7, + "offset": 0, + "releases": [ + { + "id": "37e6a462-1417-45dc-9d88-4ef9aff4bc19", + "score": 100, + "status-id": "4e304316-386d-3409-af2e-78857eec5cfe", + "packaging-id": "ec27701a-4a22-37f4-bfac-6616e0f9750a", + "artist-credit-id": "84181a38-c258-32ae-99eb-5bc06592b736", + "count": 1, + "title": "Repeater", + "status": "Official", + "packaging": "Jewel Case", + "text-representation": { + "language": "eng", + "script": "Latn" + }, + "artist-credit": [ + { + "name": "Fugazi", + "artist": { + "id": "233fc3f3-6de2-465c-985e-e721dbabbace", + "name": "Fugazi", + "sort-name": "Fugazi" + } + } + ], + "release-group": { + "id": "c7c2de8e-3c98-3923-a4d9-54c4295d20b4", + "type-id": "f529b476-6e62-324f-b0aa-1f3e33d313fc", + "primary-type-id": "f529b476-6e62-324f-b0aa-1f3e33d313fc", + "title": "Repeater", + "primary-type": "Album" + }, + "date": "2005", + "country": "FR", + "release-events": [ + { + "date": "2005", + "area": { + "id": "08310658-51eb-3801-80de-5a0739207115", + "name": "France", + "sort-name": "France", + "iso-3166-1-codes": [ + "FR" + ] + } + } + ], + "barcode": "", + "label-info": [ + { + "catalog-number": "DISCHORD 45", + "label": { + "id": "2954d038-b2af-495a-b3b7-ab8028c672c4", + "name": "Dischord Records" + } + } + ], + "track-count": 14, + "media": [ + { + "id": "12f6cad0-e50c-3e25-9fab-e3fe898ff139", + "format": "CD", + "disc-count": 0, + "track-count": 14 + } + ] + } + ] +} diff --git a/htagcli.cabal b/htagcli.cabal index 0f45fa4..766396a 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -18,6 +18,7 @@ common defaults -Wredundant-constraints default-extensions: + DataKinds LambdaCase OverloadedStrings PackageImports @@ -40,6 +41,12 @@ library hs-source-dirs: lib + autogen-modules: + Paths_htagcli + + other-modules: + Paths_htagcli + exposed-modules: Check.Album Check.Artist @@ -56,12 +63,14 @@ library Model.Pattern Model.SetTagsOptions Model.Tag + MusicBrainz Path.IO.Extra Sound.HTagLib.Extra Toml.Extra build-depends: JuicyPixels, + aeson, extra, file-embed, filepath, @@ -70,6 +79,8 @@ library parser-combinators, path, path-io, + req, + string-interpolate, tomland, transformers, unliftio, @@ -131,8 +142,10 @@ test-suite tests Tests.Model.AudioTrack Tests.Model.Pattern Tests.Model.Tag + Tests.MusicBrainz build-depends: + aeson, hedgehog, hspec, hspec-expectations, @@ -145,6 +158,7 @@ test-suite tests path, path-io, resourcet, + string-interpolate, tasty, tasty-expected-failure, tasty-hedgehog, diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs new file mode 100644 index 0000000..1aff96d --- /dev/null +++ b/lib/MusicBrainz.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE QuasiQuotes #-} + +module MusicBrainz + ( ArtistCredit (..), + Media (..), + Recording (..), + Release (..), + ReleaseDetail (..), + Track (..), + SearchResponse (..), + search, + searchAlbum, + ) +where + +import Control.Concurrent qualified as Concurrent +import Data.Aeson ((.:), (.:?)) +import Data.Aeson qualified as Aeson +import Data.String.Interpolate (i, __i) +import Data.Text qualified as Text +import Data.Version qualified as Version +import Model.Album qualified as Album +import Network.HTTP.Req ((/:), (=:)) +import Network.HTTP.Req qualified as Req +import Paths_htagcli qualified as Paths +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib + +data ArtistCredit = ArtistCredit + { acName :: Text, + acJoinphrase :: Maybe Text + } + deriving (Show, Eq) + +-- | A release from MusicBrainz search results +data Release = Release + { reId :: Text, + reTitle :: Text, + reArtistCredit :: NonEmpty ArtistCredit, + -- | Year parsed from MusicBrainz date field (format: YYYY, YYYY-MM, or + -- YYYY-MM-DD); absent or empty on some releases + reDate :: Maybe Int, + reTrackCount :: Int, + -- | Lucene relevance score (0-100), higher means closer match to the query + reScore :: Int + } + deriving (Show, Eq) + +data Recording = Recording + { rcTitle :: Text, + rcArtistCredit :: NonEmpty ArtistCredit + } + deriving (Show, Eq) + +-- | A track from MusicBrainz release lookup +data Track = Track + { trPosition :: Int, + trRecording :: Recording + } + deriving (Show, Eq) + +data Media = Media + { mePosition :: Int, + meTracks :: NonEmpty Track + } + deriving (Show, Eq) + +-- | Full release details from lookup +data ReleaseDetail = ReleaseDetail + { rdId :: Text, + rdTitle :: Text, + rdArtistCredit :: NonEmpty ArtistCredit, + rdDate :: Maybe Int, + rdMedia :: NonEmpty Media + } + deriving (Show, Eq) + +parseDate :: Text -> Maybe Int +parseDate = readMaybe . toString . Text.take 4 + +instance Aeson.FromJSON ArtistCredit where + parseJSON = Aeson.withObject "ArtistCredit" $ \o -> do + acName <- o .: "name" + joinphrase <- o .:? "joinphrase" + let acJoinphrase = if joinphrase == Just "" then Nothing else joinphrase + pure ArtistCredit {..} + +instance Aeson.FromJSON Release where + parseJSON = Aeson.withObject "Release" $ \o -> do + reId <- o .: "id" + reTitle <- o .: "title" + reArtistCredit <- o .: "artist-credit" + dateText <- o .:? "date" + let reDate = dateText >>= parseDate + reTrackCount <- o .: "track-count" + reScore <- o .: "score" + pure Release {..} + +data SearchResponse = SearchResponse + { srReleases :: [Release] + } + deriving (Show, Eq) + +instance Aeson.FromJSON SearchResponse where + parseJSON = Aeson.withObject "SearchResponse" $ \o -> do + srReleases <- o .: "releases" + pure SearchResponse {..} + +instance Aeson.FromJSON ReleaseDetail where + parseJSON = Aeson.withObject "ReleaseDetail" $ \o -> do + rdId <- o .: "id" + rdTitle <- o .: "title" + rdArtistCredit <- o .: "artist-credit" + dateText <- o .:? "date" + let rdDate = dateText >>= parseDate + rdMedia <- o .: "media" + pure ReleaseDetail {..} + +instance Aeson.FromJSON Media where + parseJSON = Aeson.withObject "Media" $ \o -> do + mePosition <- o .: "position" + meTracks <- o .: "tracks" + pure Media {..} + +instance Aeson.FromJSON Track where + parseJSON = Aeson.withObject "Track" $ \o -> do + trPosition <- o .: "position" + trRecording <- o .: "recording" + pure Track {..} + +instance Aeson.FromJSON Recording where + parseJSON = Aeson.withObject "Recording" $ \o -> do + rcTitle <- o .: "title" + rcArtistCredit <- o .: "artist-credit" + pure Recording {..} + +baseUrl :: Req.Url Req.Https +baseUrl = Req.https "musicbrainz.org" /: "ws" /: "2" + +headers :: Req.Option scheme +headers = + Req.header "User-Agent" userAgent <> Req.header "Accept" "application/json" + where + userAgent :: ByteString + userAgent = [i|htagcli/#{version} ( #{url} )|] + version :: Text + version = fromString $ Version.showVersion Paths.version + url :: Text + url = "https://github.com/jecaro/htagcli" + +-- | Search for releases on MusicBrainz +searchReleases :: Int -> HTagLib.AlbumArtist -> HTagLib.Album -> IO [Release] +searchReleases limit albumArtist album = do + response <- + Req.runReq Req.defaultHttpConfig $ + Req.req + Req.GET + (baseUrl /: "release") + Req.NoReqBody + Req.bsResponse + ( headers + <> "query" =: query + <> "fmt" =: ("json" :: Text) + <> "limit" =: limit + ) + srReleases <$> Aeson.throwDecodeStrict (Req.responseBody response) + where + albumArtistText = HTagLib.unAlbumArtist albumArtist + albumText = HTagLib.unAlbum album + query :: Text + query = [i|artist:"#{albumArtistText}" AND release:"#{albumText}"|] + +-- | Lookup a release by MBID +lookupRelease :: Text -> IO ReleaseDetail +lookupRelease mbid = do + response <- + Req.runReq Req.defaultHttpConfig $ + Req.req + Req.GET + (baseUrl /: "release" /: mbid) + Req.NoReqBody + Req.bsResponse + ( headers + <> "inc" =: ("recordings+artist-credits" :: Text) + <> "fmt" =: ("json" :: Text) + ) + Aeson.throwDecodeStrict $ Req.responseBody response + +searchAlbum :: Int -> Album.Album -> IO () +searchAlbum maxResults album = + search maxResults (Album.albumArtist album) (Album.album album) + +search :: Int -> HTagLib.AlbumArtist -> HTagLib.Album -> IO () +search maxResults albumArtist album = do + putTextLn [i|Searching: "#{albumArtistText}" - "#{albumText}"|] + putTextLn "" + + releases <- searchReleases maxResults albumArtist album + let nbReleases = length releases + s :: Text + s = if nbReleases > 1 then "s" else "" + putTextLn [i|#{nbReleases} release#{s} found\n|] + + forM_ (zip [1 ..] releases) $ \(idx, release) -> do + -- Official MusicBrainz API rate limit + Concurrent.threadDelay 1_000_000 + detail <- lookupRelease $ reId release + displayRelease idx (release, detail) + putTextLn "" + where + albumArtistText = HTagLib.unAlbumArtist albumArtist + albumText = HTagLib.unAlbum album + +displayRelease :: Int -> (Release, ReleaseDetail) -> IO () +displayRelease idx (Release {..}, detail) = do + let artist = artistCreditToText reArtistCredit + date :: Text + date = maybe "unknown" show reDate + trackCount = sum $ fmap (length . meTracks) $ toList $ rdMedia detail + putTextLn + [__i| + #{idx}. #{reTitle} by #{artist} + ID: #{reId} + Date: #{date} + Tracks: #{trackCount} + |] + + forM_ (rdMedia detail) $ \Media {..} -> do + putTextLn [i| Disc #{mePosition}:|] + forM_ meTracks $ \Track {..} -> + putTextLn [i| #{trPosition}. #{rcTitle trRecording}|] + where + artistCreditToText :: NonEmpty ArtistCredit -> Text + artistCreditToText = + foldMap (\ArtistCredit {..} -> acName <> joinphraseToText acJoinphrase) + joinphraseToText :: Maybe Text -> Text + joinphraseToText = fromMaybe "" diff --git a/tests/Main.hs b/tests/Main.hs index 3cfd05c..ced7564 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -10,6 +10,7 @@ import Tests.Config as Config import Tests.Model.AudioTrack qualified as Model.AudioTrack import Tests.Model.Pattern qualified as Model.Pattern import Tests.Model.Tag qualified as Model.Tag +import Tests.MusicBrainz qualified as MusicBrainz main :: IO () main = @@ -24,5 +25,6 @@ main = Check.Disc.test, Check.Album.test, Check.Artist.test, - Check.Track.test + Check.Track.test, + MusicBrainz.test ] diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz.hs new file mode 100644 index 0000000..1f931e7 --- /dev/null +++ b/tests/Tests/MusicBrainz.hs @@ -0,0 +1,103 @@ +module Tests.MusicBrainz (test) where + +import Data.Aeson qualified as Aeson +import Data.List.NonEmpty qualified as NonEmpty +import MusicBrainz qualified +import Test.Hspec.Expectations (shouldBe) +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit qualified as Tasty + +test :: Tasty.TestTree +test = Tasty.testGroup "MusicBrainz" [testParseJSON] + +testParseJSON :: Tasty.TestTree +testParseJSON = + Tasty.testGroup + "JSON parsing" + [ -- curl "https://musicbrainz.org/ws/2/release?query=artist:%22fugazi%22+AND+release:%22repeater%22&fmt=json&limit=1" | jq > ./data/musicbrainz-repeater-search.json + Tasty.testCase "parse release from search" $ do + result <- Aeson.eitherDecodeFileStrict "data/musicbrainz-repeater-search.json" + result + `shouldBe` Right + MusicBrainz.SearchResponse + { MusicBrainz.srReleases = + [ MusicBrainz.Release + { MusicBrainz.reId = "37e6a462-1417-45dc-9d88-4ef9aff4bc19", + MusicBrainz.reTitle = "Repeater", + MusicBrainz.reArtistCredit = mkArtistCredit "Fugazi", + MusicBrainz.reDate = Just 2005, + MusicBrainz.reTrackCount = 14, + MusicBrainz.reScore = 100 + } + ] + }, + -- curl "https://musicbrainz.org/ws/2/release?query=release:%22Dischord+1981%3A+The+Year+in+Seven+Inches%22&fmt=json&limit=1" | jq > ./data/musicbrainz-dischord-search.json + Tasty.testCase "parse compilation release" $ do + result <- Aeson.eitherDecodeFileStrict "data/musicbrainz-dischord-search.json" + result + `shouldBe` Right + MusicBrainz.SearchResponse + { MusicBrainz.srReleases = + [ MusicBrainz.Release + { MusicBrainz.reId = "2b06e322-88e4-465c-b53d-1f82271e6131", + MusicBrainz.reTitle = "Dischord 1981: The Year in Seven Inches", + MusicBrainz.reArtistCredit = mkArtistCredit "Various Artists", + MusicBrainz.reDate = Just 1995, + MusicBrainz.reTrackCount = 48, + MusicBrainz.reScore = 100 + } + ] + }, + -- curl "https://musicbrainz.org/ws/2/release/00baa173-29db-33a9-af6d-fe109e53a211?inc=recordings+artist-credits&fmt=json" | jq > ./data/musicbrainz-repeater-detail.json + Tasty.testCase "parse release detail" $ do + result <- Aeson.eitherDecodeFileStrict "data/musicbrainz-repeater-detail.json" + result + `shouldBe` Right + MusicBrainz.ReleaseDetail + { MusicBrainz.rdId = "00baa173-29db-33a9-af6d-fe109e53a211", + MusicBrainz.rdTitle = "Repeater", + MusicBrainz.rdArtistCredit = mkArtistCredit "Fugazi", + MusicBrainz.rdDate = Just 1990, + MusicBrainz.rdMedia = + MusicBrainz.Media + { MusicBrainz.mePosition = 1, + MusicBrainz.meTracks = + NonEmpty.zipWith + mkTrack + (1 :| [2 ..]) + ( "Turnover" + :| [ "Repeater", + "Brendan #1", + "Merchandise", + "Blueprint", + "Sieve-Fisted Find", + "Greed", + "Two Beats Off", + "Styrofoam", + "Reprovisional", + "Shut the Door" + ] + ) + } + :| [] + } + ] + +mkArtistCredit :: Text -> NonEmpty MusicBrainz.ArtistCredit +mkArtistCredit name = + MusicBrainz.ArtistCredit + { MusicBrainz.acName = name, + MusicBrainz.acJoinphrase = Nothing + } + :| [] + +mkTrack :: Int -> Text -> MusicBrainz.Track +mkTrack n title = + MusicBrainz.Track + { MusicBrainz.trPosition = n, + MusicBrainz.trRecording = + MusicBrainz.Recording + { MusicBrainz.rcTitle = title, + MusicBrainz.rcArtistCredit = mkArtistCredit "Fugazi" + } + } From f3eec4dc026142d4378f23f18b7a70cfe3e9af81 Mon Sep 17 00:00:00 2001 From: jecaro Date: Fri, 26 Jun 2026 14:22:32 +0200 Subject: [PATCH 05/23] Sort albums by disc and discs by track --- lib/Model/Album.hs | 5 ++++- lib/Model/Disc.hs | 6 +++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lib/Model/Album.hs b/lib/Model/Album.hs index 0a90b84..cb9355b 100644 --- a/lib/Model/Album.hs +++ b/lib/Model/Album.hs @@ -16,6 +16,7 @@ import Model.Disc qualified as Disc import Model.Tag qualified as Tag import Sound.HTagLib qualified as HTagLib import Sound.HTagLib.Extra qualified as HTagLib +import "extra" Data.List.NonEmpty.Extra qualified as NonEmpty newtype Album = Album (NonEmpty Disc.Disc) deriving (Eq, Show) @@ -24,7 +25,9 @@ mkAlbum :: NonEmpty Disc.Disc -> Maybe Album mkAlbum discs'@(firstDisc :| otherDiscs) | allSameAlbum && (allSameAlbumArtist || allSameArtist) = - Just $ Album discs' + Just $ + Album $ + NonEmpty.sortOn (fmap HTagLib.unDiscNumber . Disc.disc) discs' | otherwise = Nothing where firstAlbum = Disc.album firstDisc diff --git a/lib/Model/Disc.hs b/lib/Model/Disc.hs index b42ec07..4f02e3a 100644 --- a/lib/Model/Disc.hs +++ b/lib/Model/Disc.hs @@ -34,7 +34,11 @@ mkDisc tracks'@(firstTrack :| otherTracks) ) || allSameArtist ) = - Just $ Disc tracks' + Just $ + Disc $ + NonEmpty.sortOn + (fmap HTagLib.unTrackNumber . AudioTrack.atTrack) + tracks' | otherwise = Nothing where firstAlbum = AudioTrack.atAlbum firstTrack From 96d3774ec3ca619d40a2bc01d27c02e628ffad02 Mon Sep 17 00:00:00 2001 From: jecaro Date: Thu, 25 Jun 2026 14:59:40 +0200 Subject: [PATCH 06/23] Add a similarity value when searching local data --- app/Main.hs | 4 +- htagcli.cabal | 1 + lib/Model/Album.hs | 5 ++ lib/Model/Disc.hs | 5 ++ lib/MusicBrainz.hs | 173 ++++++++++++++++++++++++++++++++++++++------- 5 files changed, 161 insertions(+), 27 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 259a4d7..fc53742 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -178,7 +178,7 @@ main = do album <- collectAlbum files MusicBrainz.searchAlbum seMaxResults album Options.SearchFromArgs albumArtist album -> - MusicBrainz.search seMaxResults albumArtist album + MusicBrainz.search seMaxResults albumArtist album Nothing where getTagsAsText filename = do content <- encodeUtf8 . AudioTrack.asText <$> AudioTrack.getTags filename @@ -210,6 +210,4 @@ exceptions someException Config.errorToText configException <> "\n" | Just commandsException <- fromException someException = Commands.errorToText commandsException <> "\n" - | Just mbException <- fromException someException = - MusicBrainz.errorToText mbException <> "\n" | otherwise = "Unknown exception: " <> show someException <> "\n" diff --git a/htagcli.cabal b/htagcli.cabal index 766396a..9d84cd3 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -81,6 +81,7 @@ library path-io, req, string-interpolate, + text-metrics, tomland, transformers, unliftio, diff --git a/lib/Model/Album.hs b/lib/Model/Album.hs index cb9355b..dfe3387 100644 --- a/lib/Model/Album.hs +++ b/lib/Model/Album.hs @@ -3,6 +3,7 @@ module Model.Album mkAlbum, addDisc, discs, + years, album, artist, albumArtist, @@ -11,6 +12,7 @@ module Model.Album ) where +import Data.List.Extra qualified as List import Data.List.NonEmpty ((<|)) import Model.Disc qualified as Disc import Model.Tag qualified as Tag @@ -43,6 +45,9 @@ addDisc d (Album discs') = mkAlbum (d <| discs') discs :: Album -> NonEmpty Disc.Disc discs (Album discs') = discs' +years :: Album -> [HTagLib.Year] +years (Album discs') = List.nubSort $ concatMap Disc.years $ toList discs' + album :: Album -> HTagLib.Album album (Album (d :| _)) = Disc.album d diff --git a/lib/Model/Disc.hs b/lib/Model/Disc.hs index 4f02e3a..3523518 100644 --- a/lib/Model/Disc.hs +++ b/lib/Model/Disc.hs @@ -3,6 +3,7 @@ module Model.Disc mkDisc, addTrack, tracks, + years, artist, album, albumArtist, @@ -14,6 +15,7 @@ module Model.Disc ) where +import Data.List.Extra qualified as List import Data.List.NonEmpty ((<|)) import Model.AudioTrack qualified as AudioTrack import Model.Tag qualified as Tag @@ -57,6 +59,9 @@ addTrack track (Disc tracks') = mkDisc (track <| tracks') tracks :: Disc -> NonEmpty AudioTrack.AudioTrack tracks (Disc tracks') = tracks' +years :: Disc -> [HTagLib.Year] +years (Disc tracks') = List.nubSort $ mapMaybe AudioTrack.atYear $ toList tracks' + albumArtistOrArtist :: Disc -> HTagLib.AlbumArtistOrArtist albumArtistOrArtist (Disc (track :| _)) = AudioTrack.albumArtistOrArtist track diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index 1aff96d..e85f0ea 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -18,8 +18,11 @@ import Data.Aeson ((.:), (.:?)) import Data.Aeson qualified as Aeson import Data.String.Interpolate (i, __i) import Data.Text qualified as Text +import Data.Text.Metrics qualified as Metrics import Data.Version qualified as Version import Model.Album qualified as Album +import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc import Network.HTTP.Req ((/:), (=:)) import Network.HTTP.Req qualified as Req import Paths_htagcli qualified as Paths @@ -78,6 +81,58 @@ data ReleaseDetail = ReleaseDetail parseDate :: Text -> Maybe Int parseDate = readMaybe . toString . Text.take 4 +artistCreditToText :: NonEmpty ArtistCredit -> Text +artistCreditToText = foldMap (\ArtistCredit {..} -> acName <> fromMaybe "" acJoinphrase) + +data Average = Average + { avSum :: Double, + avCount :: Int + } + +instance Semigroup Average where + Average s1 n1 <> Average s2 n2 = Average (s1 + s2) (n1 + n2) + +instance Monoid Average where + mempty = Average 0 0 + +averageToDouble :: Average -> Double +averageToDouble Average {..} + | avCount == 0 = 1 + | otherwise = avSum / fromIntegral avCount + +similarityDisc :: Media -> Disc.Disc -> Average +similarityDisc Media {..} disc = + Average + { avSum = sum (zipWith similarity lts found), + avCount = max (length lts) (length found) + } + where + found = toList $ rcTitle . trRecording <$> meTracks + lts = toList $ HTagLib.unTitle . AudioTrack.atTitle <$> Disc.tracks disc + +-- | Weighted similarity between a local album and a MusicBrainz release detail. +-- Weights: artist 20%, title 20%, tracks from discs 60%. +similarityAlbum :: ReleaseDetail -> Album.Album -> Double +similarityAlbum detail album = + 0.2 * artistSimilarity + 0.2 * titleSimilarity + 0.6 * discsSimilarity + where + artistSimilarity = + similarity + (HTagLib.unAlbumArtist $ Album.albumArtist album) + (artistCreditToText $ rdArtistCredit detail) + titleSimilarity = + similarity + (HTagLib.unAlbum $ Album.album album) + (rdTitle detail) + discsSimilarity = + averageToDouble $ + foldMap (uncurry similarityDisc) $ + zip (toList $ rdMedia detail) (toList $ Album.discs album) + +similarity :: Text -> Text -> Double +similarity a b = + realToFrac $ Metrics.jaroWinkler (Text.toLower a) (Text.toLower b) + instance Aeson.FromJSON ArtistCredit where parseJSON = Aeson.withObject "ArtistCredit" $ \o -> do acName <- o .: "name" @@ -188,10 +243,11 @@ lookupRelease mbid = do searchAlbum :: Int -> Album.Album -> IO () searchAlbum maxResults album = - search maxResults (Album.albumArtist album) (Album.album album) + search maxResults (Album.albumArtist album) (Album.album album) (Just album) -search :: Int -> HTagLib.AlbumArtist -> HTagLib.Album -> IO () -search maxResults albumArtist album = do +search :: + Int -> HTagLib.AlbumArtist -> HTagLib.Album -> Maybe Album.Album -> IO () +search maxResults albumArtist album mbLocalAlbum = do putTextLn [i|Searching: "#{albumArtistText}" - "#{albumText}"|] putTextLn "" @@ -205,33 +261,102 @@ search maxResults albumArtist album = do -- Official MusicBrainz API rate limit Concurrent.threadDelay 1_000_000 detail <- lookupRelease $ reId release - displayRelease idx (release, detail) - putTextLn "" + displayRelease idx (release, detail) mbLocalAlbum where albumArtistText = HTagLib.unAlbumArtist albumArtist albumText = HTagLib.unAlbum album -displayRelease :: Int -> (Release, ReleaseDetail) -> IO () -displayRelease idx (Release {..}, detail) = do - let artist = artistCreditToText reArtistCredit - date :: Text - date = maybe "unknown" show reDate - trackCount = sum $ fmap (length . meTracks) $ toList $ rdMedia detail +displayRelease :: Int -> (Release, ReleaseDetail) -> Maybe Album.Album -> IO () +displayRelease idx (Release {..}, detail) mbAlbum = do putTextLn [__i| - #{idx}. #{reTitle} by #{artist} - ID: #{reId} - Date: #{date} - Tracks: #{trackCount} + #{idx}. ID: #{reId} #{overallSuffix} + Artist: #{artist} #{artistSuffix} + Album: #{reTitle} #{titleSuffix} + Year: #{year} #{yearSuffix} + Discs: #{mediaCount} #{mediaCountSuffix} + Tracks: #{trackCount} #{trackCountSuffix} |] + putTextLn "" + + traverse_ (uncurry displayMedia) mediaAndDiscs + where + medias = toList $ rdMedia detail + discs = orMempty (fmap Just . toList . Album.discs) mbAlbum + mediaAndDiscs = zip medias (discs <> repeat Nothing) + + overallSuffix = inParensMaybe (percentage . similarityAlbum detail) mbAlbum + + artist = artistCreditToText reArtistCredit + localArtist = HTagLib.unAlbumArtist . Album.albumArtist <$> mbAlbum + artistSuffix = orMempty (similaritySuffix artist) localArtist + + localTitle = HTagLib.unAlbum . Album.album <$> mbAlbum + titleSuffix = orMempty (similaritySuffix reTitle) localTitle - forM_ (rdMedia detail) $ \Media {..} -> do - putTextLn [i| Disc #{mePosition}:|] - forM_ meTracks $ \Track {..} -> - putTextLn [i| #{trPosition}. #{rcTitle trRecording}|] + year :: Text + year = maybe "unknown" show reDate + localYears = orMempty (fmap HTagLib.unYear . Album.years) mbAlbum + yearSuffix + | null localYears || localYears == maybeToList reDate = "" + | otherwise = inParens $ Text.intercalate ", " $ show <$> localYears + + localDiscCount = length . Album.discs <$> mbAlbum + mediaCount = length $ rdMedia detail + mediaCountSuffix = orMempty (showIfDifferent mediaCount) localDiscCount + + trackCount = sum $ length . meTracks <$> toList (rdMedia detail) + localTrackCount = length . (Disc.tracks <=< Album.discs) <$> mbAlbum + trackCountSuffix = orMempty (showIfDifferent trackCount) localTrackCount + +displayMedia :: Media -> Maybe Disc.Disc -> IO () +displayMedia media@Media {..} mDisc = do + putTextLn [i| Disc #{mePosition}: #{discSimilarity} - Tracks: #{trackCount} #{trackCountSuffix}|] + putTextLn "" + + forM_ tracksAndLocalTracks $ \(Track {..}, mLocalTitle) -> do + let trackSuffix = orMempty (similaritySuffix (rcTitle trRecording)) mLocalTitle + putTextLn [i| #{trPosition}. #{rcTitle trRecording} #{trackSuffix}|] + + putTextLn "" where - artistCreditToText :: NonEmpty ArtistCredit -> Text - artistCreditToText = - foldMap (\ArtistCredit {..} -> acName <> joinphraseToText acJoinphrase) - joinphraseToText :: Maybe Text -> Text - joinphraseToText = fromMaybe "" + tracks = toList meTracks + tracksAndLocalTracks = zip tracks $ localTitles <> repeat Nothing + + discSimilarity = + inParensMaybe (percentage . averageToDouble . similarityDisc media) mDisc + + trackCount = length tracks + localTrackCount = length . Disc.tracks <$> mDisc + trackCountSuffix = orMempty (showIfDifferent trackCount) localTrackCount + + localTitles = + orMempty + (fmap (Just . HTagLib.unTitle . AudioTrack.atTitle) . toList . Disc.tracks) + mDisc + +percentage :: Double -> Text +percentage value = show (round (value * 100) :: Int) <> "%" + +displaySimilarity :: Double -> Text -> Text +displaySimilarity value text = + inParens $ + percentage value <> if value < 0.95 then " - " <> text else "" + +inParens :: Text -> Text +inParens text = "(" <> text <> ")" + +showIfDifferent :: (Show a, Eq a) => a -> a -> Text +showIfDifferent mbValue localValue + | localValue == mbValue = "" + | otherwise = inParens (show localValue) + +similaritySuffix :: Text -> Text -> Text +similaritySuffix searchText localText = + displaySimilarity (similarity searchText localText) localText + +inParensMaybe :: (a -> Text) -> Maybe a -> Text +inParensMaybe aToText mbText = orMempty (inParens . aToText) mbText + +orMempty :: (Monoid m) => (a -> m) -> Maybe a -> m +orMempty = maybe mempty From 684d1c0caf09c49d2281bb83ce0755fb264e6040 Mon Sep 17 00:00:00 2001 From: jecaro Date: Fri, 26 Jun 2026 22:43:48 +0200 Subject: [PATCH 07/23] Split MusicBrainz.hs into multiple modules --- htagcli.cabal | 4 + lib/MusicBrainz.hs | 280 ++++------------------------------ lib/MusicBrainz/Average.hs | 17 +++ lib/MusicBrainz/Req.hs | 70 +++++++++ lib/MusicBrainz/Similarity.hs | 52 +++++++ lib/MusicBrainz/Types.hs | 127 +++++++++++++++ tests/Tests/MusicBrainz.hs | 2 +- 7 files changed, 304 insertions(+), 248 deletions(-) create mode 100644 lib/MusicBrainz/Average.hs create mode 100644 lib/MusicBrainz/Req.hs create mode 100644 lib/MusicBrainz/Similarity.hs create mode 100644 lib/MusicBrainz/Types.hs diff --git a/htagcli.cabal b/htagcli.cabal index 9d84cd3..07ec42a 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -64,6 +64,10 @@ library Model.SetTagsOptions Model.Tag MusicBrainz + MusicBrainz.Average + MusicBrainz.Req + MusicBrainz.Similarity + MusicBrainz.Types Path.IO.Extra Sound.HTagLib.Extra Toml.Extra diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index e85f0ea..f8b2ec1 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -1,246 +1,20 @@ {-# LANGUAGE QuasiQuotes #-} -module MusicBrainz - ( ArtistCredit (..), - Media (..), - Recording (..), - Release (..), - ReleaseDetail (..), - Track (..), - SearchResponse (..), - search, - searchAlbum, - ) -where +module MusicBrainz (search, searchAlbum) where import Control.Concurrent qualified as Concurrent -import Data.Aeson ((.:), (.:?)) -import Data.Aeson qualified as Aeson import Data.String.Interpolate (i, __i) import Data.Text qualified as Text -import Data.Text.Metrics qualified as Metrics -import Data.Version qualified as Version import Model.Album qualified as Album import Model.AudioTrack qualified as AudioTrack import Model.Disc qualified as Disc -import Network.HTTP.Req ((/:), (=:)) -import Network.HTTP.Req qualified as Req -import Paths_htagcli qualified as Paths +import MusicBrainz.Average qualified as Average +import MusicBrainz.Req qualified as Req +import MusicBrainz.Similarity qualified as Similarity +import MusicBrainz.Types qualified as MusicBrainz import Sound.HTagLib qualified as HTagLib import Sound.HTagLib.Extra qualified as HTagLib -data ArtistCredit = ArtistCredit - { acName :: Text, - acJoinphrase :: Maybe Text - } - deriving (Show, Eq) - --- | A release from MusicBrainz search results -data Release = Release - { reId :: Text, - reTitle :: Text, - reArtistCredit :: NonEmpty ArtistCredit, - -- | Year parsed from MusicBrainz date field (format: YYYY, YYYY-MM, or - -- YYYY-MM-DD); absent or empty on some releases - reDate :: Maybe Int, - reTrackCount :: Int, - -- | Lucene relevance score (0-100), higher means closer match to the query - reScore :: Int - } - deriving (Show, Eq) - -data Recording = Recording - { rcTitle :: Text, - rcArtistCredit :: NonEmpty ArtistCredit - } - deriving (Show, Eq) - --- | A track from MusicBrainz release lookup -data Track = Track - { trPosition :: Int, - trRecording :: Recording - } - deriving (Show, Eq) - -data Media = Media - { mePosition :: Int, - meTracks :: NonEmpty Track - } - deriving (Show, Eq) - --- | Full release details from lookup -data ReleaseDetail = ReleaseDetail - { rdId :: Text, - rdTitle :: Text, - rdArtistCredit :: NonEmpty ArtistCredit, - rdDate :: Maybe Int, - rdMedia :: NonEmpty Media - } - deriving (Show, Eq) - -parseDate :: Text -> Maybe Int -parseDate = readMaybe . toString . Text.take 4 - -artistCreditToText :: NonEmpty ArtistCredit -> Text -artistCreditToText = foldMap (\ArtistCredit {..} -> acName <> fromMaybe "" acJoinphrase) - -data Average = Average - { avSum :: Double, - avCount :: Int - } - -instance Semigroup Average where - Average s1 n1 <> Average s2 n2 = Average (s1 + s2) (n1 + n2) - -instance Monoid Average where - mempty = Average 0 0 - -averageToDouble :: Average -> Double -averageToDouble Average {..} - | avCount == 0 = 1 - | otherwise = avSum / fromIntegral avCount - -similarityDisc :: Media -> Disc.Disc -> Average -similarityDisc Media {..} disc = - Average - { avSum = sum (zipWith similarity lts found), - avCount = max (length lts) (length found) - } - where - found = toList $ rcTitle . trRecording <$> meTracks - lts = toList $ HTagLib.unTitle . AudioTrack.atTitle <$> Disc.tracks disc - --- | Weighted similarity between a local album and a MusicBrainz release detail. --- Weights: artist 20%, title 20%, tracks from discs 60%. -similarityAlbum :: ReleaseDetail -> Album.Album -> Double -similarityAlbum detail album = - 0.2 * artistSimilarity + 0.2 * titleSimilarity + 0.6 * discsSimilarity - where - artistSimilarity = - similarity - (HTagLib.unAlbumArtist $ Album.albumArtist album) - (artistCreditToText $ rdArtistCredit detail) - titleSimilarity = - similarity - (HTagLib.unAlbum $ Album.album album) - (rdTitle detail) - discsSimilarity = - averageToDouble $ - foldMap (uncurry similarityDisc) $ - zip (toList $ rdMedia detail) (toList $ Album.discs album) - -similarity :: Text -> Text -> Double -similarity a b = - realToFrac $ Metrics.jaroWinkler (Text.toLower a) (Text.toLower b) - -instance Aeson.FromJSON ArtistCredit where - parseJSON = Aeson.withObject "ArtistCredit" $ \o -> do - acName <- o .: "name" - joinphrase <- o .:? "joinphrase" - let acJoinphrase = if joinphrase == Just "" then Nothing else joinphrase - pure ArtistCredit {..} - -instance Aeson.FromJSON Release where - parseJSON = Aeson.withObject "Release" $ \o -> do - reId <- o .: "id" - reTitle <- o .: "title" - reArtistCredit <- o .: "artist-credit" - dateText <- o .:? "date" - let reDate = dateText >>= parseDate - reTrackCount <- o .: "track-count" - reScore <- o .: "score" - pure Release {..} - -data SearchResponse = SearchResponse - { srReleases :: [Release] - } - deriving (Show, Eq) - -instance Aeson.FromJSON SearchResponse where - parseJSON = Aeson.withObject "SearchResponse" $ \o -> do - srReleases <- o .: "releases" - pure SearchResponse {..} - -instance Aeson.FromJSON ReleaseDetail where - parseJSON = Aeson.withObject "ReleaseDetail" $ \o -> do - rdId <- o .: "id" - rdTitle <- o .: "title" - rdArtistCredit <- o .: "artist-credit" - dateText <- o .:? "date" - let rdDate = dateText >>= parseDate - rdMedia <- o .: "media" - pure ReleaseDetail {..} - -instance Aeson.FromJSON Media where - parseJSON = Aeson.withObject "Media" $ \o -> do - mePosition <- o .: "position" - meTracks <- o .: "tracks" - pure Media {..} - -instance Aeson.FromJSON Track where - parseJSON = Aeson.withObject "Track" $ \o -> do - trPosition <- o .: "position" - trRecording <- o .: "recording" - pure Track {..} - -instance Aeson.FromJSON Recording where - parseJSON = Aeson.withObject "Recording" $ \o -> do - rcTitle <- o .: "title" - rcArtistCredit <- o .: "artist-credit" - pure Recording {..} - -baseUrl :: Req.Url Req.Https -baseUrl = Req.https "musicbrainz.org" /: "ws" /: "2" - -headers :: Req.Option scheme -headers = - Req.header "User-Agent" userAgent <> Req.header "Accept" "application/json" - where - userAgent :: ByteString - userAgent = [i|htagcli/#{version} ( #{url} )|] - version :: Text - version = fromString $ Version.showVersion Paths.version - url :: Text - url = "https://github.com/jecaro/htagcli" - --- | Search for releases on MusicBrainz -searchReleases :: Int -> HTagLib.AlbumArtist -> HTagLib.Album -> IO [Release] -searchReleases limit albumArtist album = do - response <- - Req.runReq Req.defaultHttpConfig $ - Req.req - Req.GET - (baseUrl /: "release") - Req.NoReqBody - Req.bsResponse - ( headers - <> "query" =: query - <> "fmt" =: ("json" :: Text) - <> "limit" =: limit - ) - srReleases <$> Aeson.throwDecodeStrict (Req.responseBody response) - where - albumArtistText = HTagLib.unAlbumArtist albumArtist - albumText = HTagLib.unAlbum album - query :: Text - query = [i|artist:"#{albumArtistText}" AND release:"#{albumText}"|] - --- | Lookup a release by MBID -lookupRelease :: Text -> IO ReleaseDetail -lookupRelease mbid = do - response <- - Req.runReq Req.defaultHttpConfig $ - Req.req - Req.GET - (baseUrl /: "release" /: mbid) - Req.NoReqBody - Req.bsResponse - ( headers - <> "inc" =: ("recordings+artist-credits" :: Text) - <> "fmt" =: ("json" :: Text) - ) - Aeson.throwDecodeStrict $ Req.responseBody response - searchAlbum :: Int -> Album.Album -> IO () searchAlbum maxResults album = search maxResults (Album.albumArtist album) (Album.album album) (Just album) @@ -251,7 +25,7 @@ search maxResults albumArtist album mbLocalAlbum = do putTextLn [i|Searching: "#{albumArtistText}" - "#{albumText}"|] putTextLn "" - releases <- searchReleases maxResults albumArtist album + releases <- Req.searchReleases maxResults albumArtist album let nbReleases = length releases s :: Text s = if nbReleases > 1 then "s" else "" @@ -260,14 +34,18 @@ search maxResults albumArtist album mbLocalAlbum = do forM_ (zip [1 ..] releases) $ \(idx, release) -> do -- Official MusicBrainz API rate limit Concurrent.threadDelay 1_000_000 - detail <- lookupRelease $ reId release + detail <- Req.lookupRelease $ MusicBrainz.reId release displayRelease idx (release, detail) mbLocalAlbum where albumArtistText = HTagLib.unAlbumArtist albumArtist albumText = HTagLib.unAlbum album -displayRelease :: Int -> (Release, ReleaseDetail) -> Maybe Album.Album -> IO () -displayRelease idx (Release {..}, detail) mbAlbum = do +displayRelease :: + Int -> + (MusicBrainz.Release, MusicBrainz.ReleaseDetail) -> + Maybe Album.Album -> + IO () +displayRelease idx (MusicBrainz.Release {..}, detail) mbAlbum = do putTextLn [__i| #{idx}. ID: #{reId} #{overallSuffix} @@ -281,13 +59,14 @@ displayRelease idx (Release {..}, detail) mbAlbum = do traverse_ (uncurry displayMedia) mediaAndDiscs where - medias = toList $ rdMedia detail + medias = toList $ MusicBrainz.rdMedia detail discs = orMempty (fmap Just . toList . Album.discs) mbAlbum mediaAndDiscs = zip medias (discs <> repeat Nothing) - overallSuffix = inParensMaybe (percentage . similarityAlbum detail) mbAlbum + overallSuffix = + inParensMaybe (percentage . Similarity.detailAndAlbum detail) mbAlbum - artist = artistCreditToText reArtistCredit + artist = MusicBrainz.artistCreditToText reArtistCredit localArtist = HTagLib.unAlbumArtist . Album.albumArtist <$> mbAlbum artistSuffix = orMempty (similaritySuffix artist) localArtist @@ -302,21 +81,26 @@ displayRelease idx (Release {..}, detail) mbAlbum = do | otherwise = inParens $ Text.intercalate ", " $ show <$> localYears localDiscCount = length . Album.discs <$> mbAlbum - mediaCount = length $ rdMedia detail + mediaCount = length $ MusicBrainz.rdMedia detail mediaCountSuffix = orMempty (showIfDifferent mediaCount) localDiscCount - trackCount = sum $ length . meTracks <$> toList (rdMedia detail) + trackCount = + sum $ length . MusicBrainz.meTracks <$> toList (MusicBrainz.rdMedia detail) localTrackCount = length . (Disc.tracks <=< Album.discs) <$> mbAlbum trackCountSuffix = orMempty (showIfDifferent trackCount) localTrackCount -displayMedia :: Media -> Maybe Disc.Disc -> IO () -displayMedia media@Media {..} mDisc = do +displayMedia :: MusicBrainz.Media -> Maybe Disc.Disc -> IO () +displayMedia media@MusicBrainz.Media {..} mDisc = do putTextLn [i| Disc #{mePosition}: #{discSimilarity} - Tracks: #{trackCount} #{trackCountSuffix}|] putTextLn "" - forM_ tracksAndLocalTracks $ \(Track {..}, mLocalTitle) -> do - let trackSuffix = orMempty (similaritySuffix (rcTitle trRecording)) mLocalTitle - putTextLn [i| #{trPosition}. #{rcTitle trRecording} #{trackSuffix}|] + forM_ tracksAndLocalTracks $ \(MusicBrainz.Track {..}, mLocalTitle) -> do + let trackSuffix = + orMempty + (similaritySuffix (MusicBrainz.rcTitle trRecording)) + mLocalTitle + title = MusicBrainz.rcTitle trRecording + putTextLn [i| #{trPosition}. #{title} #{trackSuffix}|] putTextLn "" where @@ -324,7 +108,9 @@ displayMedia media@Media {..} mDisc = do tracksAndLocalTracks = zip tracks $ localTitles <> repeat Nothing discSimilarity = - inParensMaybe (percentage . averageToDouble . similarityDisc media) mDisc + inParensMaybe + (percentage . Average.toDouble . Similarity.mediaAndDisc media) + mDisc trackCount = length tracks localTrackCount = length . Disc.tracks <$> mDisc @@ -353,7 +139,7 @@ showIfDifferent mbValue localValue similaritySuffix :: Text -> Text -> Text similaritySuffix searchText localText = - displaySimilarity (similarity searchText localText) localText + displaySimilarity (Similarity.text searchText localText) localText inParensMaybe :: (a -> Text) -> Maybe a -> Text inParensMaybe aToText mbText = orMempty (inParens . aToText) mbText diff --git a/lib/MusicBrainz/Average.hs b/lib/MusicBrainz/Average.hs new file mode 100644 index 0000000..8ea32c7 --- /dev/null +++ b/lib/MusicBrainz/Average.hs @@ -0,0 +1,17 @@ +module MusicBrainz.Average (Average (..), toDouble) where + +data Average = Average + { avSum :: Double, + avCount :: Int + } + +instance Semigroup Average where + Average s1 n1 <> Average s2 n2 = Average (s1 + s2) (n1 + n2) + +instance Monoid Average where + mempty = Average 0 0 + +toDouble :: Average -> Double +toDouble Average {..} + | avCount == 0 = 1 + | otherwise = avSum / fromIntegral avCount diff --git a/lib/MusicBrainz/Req.hs b/lib/MusicBrainz/Req.hs new file mode 100644 index 0000000..87b6210 --- /dev/null +++ b/lib/MusicBrainz/Req.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE QuasiQuotes #-} + +module MusicBrainz.Req + ( lookupRelease, + searchReleases, + ) +where + +import Data.Aeson qualified as Aeson +import Data.String.Interpolate (i) +import Data.Version qualified as Version +import MusicBrainz.Types qualified as MusicBrainz +import Network.HTTP.Req ((/:), (=:)) +import Network.HTTP.Req qualified as Req +import Paths_htagcli qualified as Paths +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib + +baseUrl :: Req.Url Req.Https +baseUrl = Req.https "musicbrainz.org" /: "ws" /: "2" + +headers :: Req.Option scheme +headers = + Req.header "User-Agent" userAgent <> Req.header "Accept" "application/json" + where + userAgent :: ByteString + userAgent = [i|htagcli/#{version} ( #{url} )|] + version :: Text + version = fromString $ Version.showVersion Paths.version + url :: Text + url = "https://github.com/jecaro/htagcli" + +-- | Search for releases on MusicBrainz +searchReleases :: + Int -> HTagLib.AlbumArtist -> HTagLib.Album -> IO [MusicBrainz.Release] +searchReleases limit albumArtist album = do + response <- + Req.runReq Req.defaultHttpConfig $ + Req.req + Req.GET + (baseUrl /: "release") + Req.NoReqBody + Req.bsResponse + ( headers + <> "query" =: query + <> "fmt" =: ("json" :: Text) + <> "limit" =: limit + ) + MusicBrainz.srReleases <$> Aeson.throwDecodeStrict (Req.responseBody response) + where + albumArtistText = HTagLib.unAlbumArtist albumArtist + albumText = HTagLib.unAlbum album + query :: Text + query = [i|artist:"#{albumArtistText}" AND release:"#{albumText}"|] + +-- | Lookup a release by MBID +lookupRelease :: Text -> IO MusicBrainz.ReleaseDetail +lookupRelease mbid = do + response <- + Req.runReq Req.defaultHttpConfig $ + Req.req + Req.GET + (baseUrl /: "release" /: mbid) + Req.NoReqBody + Req.bsResponse + ( headers + <> "inc" =: ("recordings+artist-credits" :: Text) + <> "fmt" =: ("json" :: Text) + ) + Aeson.throwDecodeStrict $ Req.responseBody response diff --git a/lib/MusicBrainz/Similarity.hs b/lib/MusicBrainz/Similarity.hs new file mode 100644 index 0000000..663a8ca --- /dev/null +++ b/lib/MusicBrainz/Similarity.hs @@ -0,0 +1,52 @@ +module MusicBrainz.Similarity + ( text, + mediaAndDisc, + detailAndAlbum, + ) +where + +import Data.List.NonEmpty qualified as NonEmpty +import Data.Text qualified as Text +import Data.Text.Metrics qualified as Metrics +import Model.Album qualified as Album +import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc +import MusicBrainz.Average qualified as Average +import MusicBrainz.Types qualified as MusicBrainz +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib + +text :: Text -> Text -> Double +text a b = + realToFrac $ Metrics.jaroWinkler (Text.toLower a) (Text.toLower b) + +mediaAndDisc :: MusicBrainz.Media -> Disc.Disc -> Average.Average +mediaAndDisc MusicBrainz.Media {..} disc = + Average.Average + { avSum = sum (zipWith text localTracks tracks), + avCount = max (length localTracks) (length tracks) + } + where + tracks = toList $ MusicBrainz.rcTitle . MusicBrainz.trRecording <$> meTracks + localTracks = + toList $ HTagLib.unTitle . AudioTrack.atTitle <$> Disc.tracks disc + +-- | Weighted similarity between a local album and a MusicBrainz release detail. +-- Weights: artist 20%, title 20%, tracks from discs 60%. +detailAndAlbum :: MusicBrainz.ReleaseDetail -> Album.Album -> Double +detailAndAlbum detail album = + 0.2 * artist + 0.2 * title + 0.6 * medias + where + artist = + text + (HTagLib.unAlbumArtist $ Album.albumArtist album) + (MusicBrainz.artistCreditToText $ MusicBrainz.rdArtistCredit detail) + title = + text + (HTagLib.unAlbum $ Album.album album) + (MusicBrainz.rdTitle detail) + medias = + Average.toDouble $ + foldMap (uncurry mediaAndDisc) $ + toList $ + NonEmpty.zip (MusicBrainz.rdMedia detail) (Album.discs album) diff --git a/lib/MusicBrainz/Types.hs b/lib/MusicBrainz/Types.hs new file mode 100644 index 0000000..c155ec4 --- /dev/null +++ b/lib/MusicBrainz/Types.hs @@ -0,0 +1,127 @@ +module MusicBrainz.Types + ( ArtistCredit (..), + Media (..), + Recording (..), + Release (..), + ReleaseDetail (..), + SearchResponse (..), + Track (..), + artistCreditToText, + ) +where + +import Data.Aeson ((.:), (.:?)) +import Data.Aeson qualified as Aeson +import Data.Text qualified as Text + +data ArtistCredit = ArtistCredit + { acName :: Text, + acJoinphrase :: Maybe Text + } + deriving (Show, Eq) + +-- | A release from MusicBrainz search results +data Release = Release + { reId :: Text, + reTitle :: Text, + reArtistCredit :: NonEmpty ArtistCredit, + -- | Year parsed from MusicBrainz date field (format: YYYY, YYYY-MM, or + -- YYYY-MM-DD); absent or empty on some releases + reDate :: Maybe Int, + reTrackCount :: Int, + -- | Lucene relevance score (0-100), higher means closer match to the query + reScore :: Int + } + deriving (Show, Eq) + +data Recording = Recording + { rcTitle :: Text, + rcArtistCredit :: NonEmpty ArtistCredit + } + deriving (Show, Eq) + +-- | A track from MusicBrainz release lookup +data Track = Track + { trPosition :: Int, + trRecording :: Recording + } + deriving (Show, Eq) + +data Media = Media + { mePosition :: Int, + meTracks :: NonEmpty Track + } + deriving (Show, Eq) + +-- | Full release details from lookup +data ReleaseDetail = ReleaseDetail + { rdId :: Text, + rdTitle :: Text, + rdArtistCredit :: NonEmpty ArtistCredit, + rdDate :: Maybe Int, + rdMedia :: NonEmpty Media + } + deriving (Show, Eq) + +data SearchResponse = SearchResponse + { srReleases :: [Release] + } + deriving (Show, Eq) + +instance Aeson.FromJSON ArtistCredit where + parseJSON = Aeson.withObject "ArtistCredit" $ \o -> do + acName <- o .: "name" + joinphrase <- o .:? "joinphrase" + let acJoinphrase = if joinphrase == Just "" then Nothing else joinphrase + pure ArtistCredit {..} + +instance Aeson.FromJSON Release where + parseJSON = Aeson.withObject "Release" $ \o -> do + reId <- o .: "id" + reTitle <- o .: "title" + reArtistCredit <- o .: "artist-credit" + dateText <- o .:? "date" + let reDate = dateText >>= parseDate + reTrackCount <- o .: "track-count" + reScore <- o .: "score" + pure Release {..} + +instance Aeson.FromJSON SearchResponse where + parseJSON = Aeson.withObject "SearchResponse" $ \o -> do + srReleases <- o .: "releases" + pure SearchResponse {..} + +instance Aeson.FromJSON ReleaseDetail where + parseJSON = Aeson.withObject "ReleaseDetail" $ \o -> do + rdId <- o .: "id" + rdTitle <- o .: "title" + rdArtistCredit <- o .: "artist-credit" + dateText <- o .:? "date" + let rdDate = dateText >>= parseDate + rdMedia <- o .: "media" + pure ReleaseDetail {..} + +instance Aeson.FromJSON Media where + parseJSON = Aeson.withObject "Media" $ \o -> do + mePosition <- o .: "position" + meTracks <- o .: "tracks" + pure Media {..} + +instance Aeson.FromJSON Track where + parseJSON = Aeson.withObject "Track" $ \o -> do + trPosition <- o .: "position" + trRecording <- o .: "recording" + pure Track {..} + +instance Aeson.FromJSON Recording where + parseJSON = Aeson.withObject "Recording" $ \o -> do + rcTitle <- o .: "title" + rcArtistCredit <- o .: "artist-credit" + pure Recording {..} + +parseDate :: Text -> Maybe Int +parseDate = readMaybe . toString . Text.take 4 + +artistCreditToText :: NonEmpty ArtistCredit -> Text +artistCreditToText = + foldMap (\ArtistCredit {..} -> acName <> fromMaybe "" acJoinphrase) diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz.hs index 1f931e7..979591a 100644 --- a/tests/Tests/MusicBrainz.hs +++ b/tests/Tests/MusicBrainz.hs @@ -2,7 +2,7 @@ module Tests.MusicBrainz (test) where import Data.Aeson qualified as Aeson import Data.List.NonEmpty qualified as NonEmpty -import MusicBrainz qualified +import MusicBrainz.Types qualified as MusicBrainz import Test.Hspec.Expectations (shouldBe) import Test.Tasty qualified as Tasty import Test.Tasty.HUnit qualified as Tasty From bf385f07ae74bbc3a093edd38155da0b8ddcd391 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 14:55:04 +0200 Subject: [PATCH 08/23] Remove an unecessary argument --- lib/MusicBrainz.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index f8b2ec1..e69e06e 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -35,22 +35,22 @@ search maxResults albumArtist album mbLocalAlbum = do -- Official MusicBrainz API rate limit Concurrent.threadDelay 1_000_000 detail <- Req.lookupRelease $ MusicBrainz.reId release - displayRelease idx (release, detail) mbLocalAlbum + displayRelease idx detail mbLocalAlbum where albumArtistText = HTagLib.unAlbumArtist albumArtist albumText = HTagLib.unAlbum album displayRelease :: Int -> - (MusicBrainz.Release, MusicBrainz.ReleaseDetail) -> + MusicBrainz.ReleaseDetail -> Maybe Album.Album -> IO () -displayRelease idx (MusicBrainz.Release {..}, detail) mbAlbum = do +displayRelease idx detail@(MusicBrainz.ReleaseDetail {..}) mbAlbum = do putTextLn [__i| - #{idx}. ID: #{reId} #{overallSuffix} + #{idx}. ID: #{rdId} #{overallSuffix} Artist: #{artist} #{artistSuffix} - Album: #{reTitle} #{titleSuffix} + Album: #{rdTitle} #{titleSuffix} Year: #{year} #{yearSuffix} Discs: #{mediaCount} #{mediaCountSuffix} Tracks: #{trackCount} #{trackCountSuffix} @@ -59,33 +59,33 @@ displayRelease idx (MusicBrainz.Release {..}, detail) mbAlbum = do traverse_ (uncurry displayMedia) mediaAndDiscs where - medias = toList $ MusicBrainz.rdMedia detail + medias = toList rdMedia discs = orMempty (fmap Just . toList . Album.discs) mbAlbum mediaAndDiscs = zip medias (discs <> repeat Nothing) overallSuffix = inParensMaybe (percentage . Similarity.detailAndAlbum detail) mbAlbum - artist = MusicBrainz.artistCreditToText reArtistCredit + artist = MusicBrainz.artistCreditToText rdArtistCredit localArtist = HTagLib.unAlbumArtist . Album.albumArtist <$> mbAlbum artistSuffix = orMempty (similaritySuffix artist) localArtist localTitle = HTagLib.unAlbum . Album.album <$> mbAlbum - titleSuffix = orMempty (similaritySuffix reTitle) localTitle + titleSuffix = orMempty (similaritySuffix rdTitle) localTitle year :: Text - year = maybe "unknown" show reDate + year = maybe "unknown" show rdDate localYears = orMempty (fmap HTagLib.unYear . Album.years) mbAlbum yearSuffix - | null localYears || localYears == maybeToList reDate = "" + | null localYears || localYears == maybeToList rdDate = "" | otherwise = inParens $ Text.intercalate ", " $ show <$> localYears localDiscCount = length . Album.discs <$> mbAlbum - mediaCount = length $ MusicBrainz.rdMedia detail + mediaCount = length medias mediaCountSuffix = orMempty (showIfDifferent mediaCount) localDiscCount trackCount = - sum $ length . MusicBrainz.meTracks <$> toList (MusicBrainz.rdMedia detail) + sum $ length . MusicBrainz.meTracks <$> medias localTrackCount = length . (Disc.tracks <=< Album.discs) <$> mbAlbum trackCountSuffix = orMempty (showIfDifferent trackCount) localTrackCount From bce3bbd6641b570e4cca08a8692cb6df9c34cb9d Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 10:19:58 +0200 Subject: [PATCH 09/23] Add the type AllChecks to replace a four tuple --- app/Main.hs | 27 +++++++++++++-------------- app/Options.hs | 4 +--- lib/Config.hs | 23 ++++++++++++++++------- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index fc53742..459ad44 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -99,14 +99,13 @@ main = do config <- Config.readConfig -- Get the checks from the CLI and fallback to the config file - let (trackChecks, discChecks, albumChecks, mbArtistCheck) = - Options.checks config options + let Config.AllChecks {..} = Options.checks config options when - ( null trackChecks - && null discChecks - && null albumChecks - && null mbArtistCheck + ( null alTrack + && null alDisc + && null alAlbum + && null alArtist ) $ Exception.throwIO NoCheckInConfig @@ -120,28 +119,28 @@ main = do ConduitUtils.runConduitWithProgress files $ Conduit.mapM AudioTrack.getTags .| Conduit.iterM - (addTrackErrors <=< Commands.checkTrack trackChecks) + (addTrackErrors <=< Commands.checkTrack alTrack) .| ConduitUtils.discC .| Conduit.iterM - (addDiscErrors <=< Commands.checkDisc discChecks) + (addDiscErrors <=< Commands.checkDisc alDisc) .| ConduitUtils.albumC .| Conduit.iterM - (addAlbumErrors <=< Commands.checkAlbum albumChecks) + (addAlbumErrors <=< Commands.checkAlbum alAlbum) .| ConduitUtils.artistC .| Conduit.mapM_C - (flip when incArtistErrors <=< Commands.checkArtist mbArtistCheck) + (flip when incArtistErrors <=< Commands.checkArtist alArtist) Stats.CheckErrors {..} <- readIORef stats - unless (null trackChecks) $ + unless (null alTrack) $ putTextLn $ "Track errors: " <> show ceTrackErrors - unless (null discChecks) $ + unless (null alDisc) $ putTextLn $ "Disc errors: " <> show ceDiscErrors - unless (null albumChecks) $ + unless (null alAlbum) $ putTextLn $ "Album errors: " <> show ceAlbumErrors - when (isJust mbArtistCheck) $ + when (isJust alArtist) $ putTextLn $ "Artist errors: " <> show ceArtistErrors diff --git a/app/Options.hs b/app/Options.hs index 5449900..52573cd 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -10,10 +10,8 @@ module Options ) where -import Check.Album qualified as Album import Check.Artist qualified as Artist import Check.Disc qualified as Disc -import Check.Track qualified as Track import Config qualified import Data.Text qualified as Text import Model.Cover qualified as Cover @@ -72,7 +70,7 @@ data Command checks :: Config.Config -> CheckOptions -> - ([Track.Check], [Disc.Check], [Album.Check], Maybe Artist.Check) + Config.AllChecks checks config@(Config.Config {coFilename = Config.Filename {..}}) (Options.CheckOptions {..}) diff --git a/lib/Config.hs b/lib/Config.hs index 6858fe6..1af5c4c 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -7,6 +7,7 @@ module Config Checks (..), Filename (..), FixPaths (..), + AllChecks (..), haveChecks, readConfig, createConfig, @@ -143,7 +144,14 @@ albumChecks (Checks {..}) = artistCheck :: Checks -> Maybe Artist.Check artistCheck (Checks {..}) = chArtistSameGenre -factorChecks :: Config -> ([Track.Check], [Disc.Check], [Album.Check], Maybe Artist.Check) +data AllChecks = AllChecks + { alTrack :: [Track.Check], + alDisc :: [Disc.Check], + alAlbum :: [Album.Check], + alArtist :: Maybe Artist.Check + } + +factorChecks :: Config -> AllChecks factorChecks Config {coFilename = Filename {..}, ..} = factorChecks' fiPattern fiFormatting coChecks @@ -151,13 +159,14 @@ factorChecks' :: Pattern.Pattern -> Pattern.Formatting -> Checks -> - ([Track.Check], [Disc.Check], [Album.Check], Maybe Artist.Check) + AllChecks factorChecks' pattern formatting checks = - ( trackChecks pattern formatting checks, - discChecks checks, - albumChecks checks, - artistCheck checks - ) + AllChecks + { alTrack = trackChecks pattern formatting checks, + alDisc = discChecks checks, + alAlbum = albumChecks checks, + alArtist = artistCheck checks + } errorToText :: Error -> Text errorToText (ErToml err) = "TOML error: \n" <> err From 4eda451e0f912f3df592b746e777339197f82fa1 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 10:32:37 +0200 Subject: [PATCH 10/23] Remove unecessary fromString --- app/Options.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/app/Options.hs b/app/Options.hs index 52573cd..e546005 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -395,20 +395,18 @@ filesP = filesOrDirectoriesP :: Options.Parser (NonEmpty Text) filesOrDirectoriesP = Options.some1 - ( fromString - <$> Options.argument - Options.str - (Options.metavar "FILE|DIRECTORY" <> Options.action "file") + ( Options.argument + Options.str + (Options.metavar "FILE|DIRECTORY" <> Options.action "file") ) extensionsP :: Options.Parser (NonEmpty Text) extensionsP = Options.some1 - ( fromString - <$> Options.strOption - ( Options.long "extension" - <> Options.metavar "EXTENSION" - ) + ( Options.strOption + ( Options.long "extension" + <> Options.metavar "EXTENSION" + ) ) -- Default to a sensitive set of common audio file extensions <|> pure (fromList ["m4a", "mp3", "flac", "ogg", "wma"]) From 1757b993075aeb20738eae73f5756441c791c221 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 12:42:58 +0200 Subject: [PATCH 11/23] SearchOptions -> SearchMany --- app/Main.hs | 6 +++--- app/Options.hs | 40 ++++++++++++++++++++-------------------- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 459ad44..8925771 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -172,11 +172,11 @@ main = do ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C $ Commands.fixFilePaths fixFilePathOptions - Options.Search Options.SearchOptions {..} -> case seSource of - Options.SearchFromFiles files -> do + Options.Search Options.SearchMany {..} -> case seSource of + Options.SearchManyFromFiles files -> do album <- collectAlbum files MusicBrainz.searchAlbum seMaxResults album - Options.SearchFromArgs albumArtist album -> + Options.SearchManyFromArgs albumArtist album -> MusicBrainz.search seMaxResults albumArtist album Nothing where getTagsAsText filename = do diff --git a/app/Options.hs b/app/Options.hs index e546005..f4555e7 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -3,8 +3,8 @@ module Options Command (..), Files (..), FixFilePathsOptions (..), - SearchOptions (..), - SearchSource (..), + SearchMany (..), + SearchManySource (..), optionsInfo, checks, ) @@ -44,15 +44,15 @@ data FixFilePathsOptions = FixFilePathsOptions } deriving (Show) -data SearchOptions = SearchOptions +data SearchMany = SearchMany { seMaxResults :: Int, - seSource :: SearchSource + seSource :: SearchManySource } deriving (Show) -data SearchSource - = SearchFromFiles Files - | SearchFromArgs HTagLib.AlbumArtist HTagLib.Album +data SearchManySource + = SearchManyFromFiles Files + | SearchManyFromArgs HTagLib.AlbumArtist HTagLib.Album deriving (Show) data Command @@ -62,7 +62,7 @@ data Command | Edit Files | Check CheckOptions Files | FixFilePaths FixFilePathsOptions Files - | Search SearchOptions + | Search SearchMany deriving (Show) -- | Get checks from the CLI, and fall back to the config file if none are @@ -109,9 +109,9 @@ fixFilePathsOptionsP = <*> optional baseDirectoryP <*> optional filematchesP -searchOptionsP :: Options.Parser SearchOptions -searchOptionsP = - SearchOptions +searchManyP :: Options.Parser SearchMany +searchManyP = + SearchMany <$> Options.option Options.auto ( Options.long "max-results" @@ -120,17 +120,17 @@ searchOptionsP = <> Options.showDefault <> Options.help "Maximum number of results to display" ) - <*> searchSourceP + <*> searchManySourceP -searchSourceP :: Options.Parser SearchSource -searchSourceP = searchFromArgsP <|> searchFromFilesP +searchManySourceP :: Options.Parser SearchManySource +searchManySourceP = searchManyFromArgsP <|> searchManyFromFilesP -searchFromFilesP :: Options.Parser SearchSource -searchFromFilesP = SearchFromFiles <$> filesP +searchManyFromFilesP :: Options.Parser SearchManySource +searchManyFromFilesP = SearchManyFromFiles <$> filesP -searchFromArgsP :: Options.Parser SearchSource -searchFromArgsP = - SearchFromArgs +searchManyFromArgsP :: Options.Parser SearchManySource +searchManyFromArgsP = + SearchManyFromArgs <$> Options.strOption ( Options.long "artist" <> Options.metavar "ARTIST" @@ -453,7 +453,7 @@ optionsP = <> Options.command "search" ( Options.info - (Search <$> searchOptionsP) + (Search <$> searchManyP) (Options.progDesc "Search MusicBrainz for releases") ) ) From c4f84a19d4f2aa1a06900a295f1bcf1806d9c519 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 14:51:51 +0200 Subject: [PATCH 12/23] Add search one album --- app/Main.hs | 18 ++++++++++++------ app/Options.hs | 34 ++++++++++++++++++++++++++++++---- lib/MusicBrainz.hs | 7 ++++++- 3 files changed, 48 insertions(+), 11 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 8925771..fe479fa 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -172,12 +172,18 @@ main = do ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C $ Commands.fixFilePaths fixFilePathOptions - Options.Search Options.SearchMany {..} -> case seSource of - Options.SearchManyFromFiles files -> do - album <- collectAlbum files - MusicBrainz.searchAlbum seMaxResults album - Options.SearchManyFromArgs albumArtist album -> - MusicBrainz.search seMaxResults albumArtist album Nothing + Options.Search options -> do + case options of + Options.SeSearchMany (Options.SearchMany {..}) -> + case smSource of + Options.SearchManyFromFiles files -> do + album <- collectAlbum files + MusicBrainz.searchAlbum smMaxResults album + Options.SearchManyFromArgs albumArtist album -> + MusicBrainz.search smMaxResults albumArtist album Nothing + Options.SeSearchOne (Options.SearchOne {..}) -> do + mbAlbum <- traverse collectAlbum soFiles + MusicBrainz.searchId soId mbAlbum where getTagsAsText filename = do content <- encodeUtf8 . AudioTrack.asText <$> AudioTrack.getTags filename diff --git a/app/Options.hs b/app/Options.hs index f4555e7..e23d2a6 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -3,8 +3,10 @@ module Options Command (..), Files (..), FixFilePathsOptions (..), + SearchOptions (..), SearchMany (..), SearchManySource (..), + SearchOne (..), optionsInfo, checks, ) @@ -44,9 +46,20 @@ data FixFilePathsOptions = FixFilePathsOptions } deriving (Show) +data SearchOptions + = SeSearchMany SearchMany + | SeSearchOne SearchOne + deriving (Show) + +data SearchOne = SearchOne + { soId :: Text, + soFiles :: Maybe Files + } + deriving (Show) + data SearchMany = SearchMany - { seMaxResults :: Int, - seSource :: SearchManySource + { smMaxResults :: Int, + smSource :: SearchManySource } deriving (Show) @@ -62,7 +75,7 @@ data Command | Edit Files | Check CheckOptions Files | FixFilePaths FixFilePathsOptions Files - | Search SearchMany + | Search SearchOptions deriving (Show) -- | Get checks from the CLI, and fall back to the config file if none are @@ -109,6 +122,9 @@ fixFilePathsOptionsP = <*> optional baseDirectoryP <*> optional filematchesP +searchOptionsP :: Options.Parser SearchOptions +searchOptionsP = SeSearchMany <$> searchManyP <|> SeSearchOne <$> searchOneP + searchManyP :: Options.Parser SearchMany searchManyP = SearchMany @@ -142,6 +158,16 @@ searchManyFromArgsP = <> Options.help "Album name to search for" ) +searchOneP :: Options.Parser SearchOne +searchOneP = + SearchOne + <$> Options.strOption + ( Options.long "id" + <> Options.metavar "ID" + <> Options.help "MusicBrainz release ID to search for" + ) + <*> Options.optional filesP + dryRunP :: Options.Parser Bool dryRunP = Options.switch @@ -453,7 +479,7 @@ optionsP = <> Options.command "search" ( Options.info - (Search <$> searchManyP) + (Search <$> searchOptionsP) (Options.progDesc "Search MusicBrainz for releases") ) ) diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index e69e06e..150549a 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -1,6 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} -module MusicBrainz (search, searchAlbum) where +module MusicBrainz (search, searchId, searchAlbum) where import Control.Concurrent qualified as Concurrent import Data.String.Interpolate (i, __i) @@ -40,6 +40,11 @@ search maxResults albumArtist album mbLocalAlbum = do albumArtistText = HTagLib.unAlbumArtist albumArtist albumText = HTagLib.unAlbum album +searchId :: Text -> Maybe Album.Album -> IO () +searchId releaseId mbLocalAlbum = do + detail <- Req.lookupRelease releaseId + displayRelease 1 detail mbLocalAlbum + displayRelease :: Int -> MusicBrainz.ReleaseDetail -> From 0b085f26ad7ec04fb1a0061bff4b8c0ee5205c6b Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 15:22:59 +0200 Subject: [PATCH 13/23] Use UUID type for the release id --- app/Options.hs | 6 ++++-- htagcli.cabal | 3 +++ lib/MusicBrainz.hs | 3 ++- lib/MusicBrainz/Req.hs | 7 ++++--- lib/MusicBrainz/Types.hs | 3 ++- tests/Tests/MusicBrainz.hs | 11 +++++++++-- 6 files changed, 24 insertions(+), 9 deletions(-) diff --git a/app/Options.hs b/app/Options.hs index e23d2a6..3f3e79f 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -16,6 +16,7 @@ import Check.Artist qualified as Artist import Check.Disc qualified as Disc import Config qualified import Data.Text qualified as Text +import Data.UUID qualified as UUID import Model.Cover qualified as Cover import Model.Pattern qualified as Pattern import Model.SetTagsOptions qualified as SetTagsOptions @@ -52,7 +53,7 @@ data SearchOptions deriving (Show) data SearchOne = SearchOne - { soId :: Text, + { soId :: UUID.UUID, soFiles :: Maybe Files } deriving (Show) @@ -161,7 +162,8 @@ searchManyFromArgsP = searchOneP :: Options.Parser SearchOne searchOneP = SearchOne - <$> Options.strOption + <$> Options.option + (Options.maybeReader UUID.fromString) ( Options.long "id" <> Options.metavar "ID" <> Options.help "MusicBrainz release ID to search for" diff --git a/htagcli.cabal b/htagcli.cabal index 07ec42a..60e6993 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -89,6 +89,7 @@ library tomland, transformers, unliftio, + uuid, validation-selective, executable htagcli @@ -122,6 +123,7 @@ executable htagcli text, typed-process, unliftio, + uuid, test-suite tests import: @@ -169,3 +171,4 @@ test-suite tests tasty-hedgehog, tasty-hunit-compat, unliftio, + uuid, diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index 150549a..0cfdc95 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -5,6 +5,7 @@ module MusicBrainz (search, searchId, searchAlbum) where import Control.Concurrent qualified as Concurrent import Data.String.Interpolate (i, __i) import Data.Text qualified as Text +import Data.UUID qualified as UUID import Model.Album qualified as Album import Model.AudioTrack qualified as AudioTrack import Model.Disc qualified as Disc @@ -40,7 +41,7 @@ search maxResults albumArtist album mbLocalAlbum = do albumArtistText = HTagLib.unAlbumArtist albumArtist albumText = HTagLib.unAlbum album -searchId :: Text -> Maybe Album.Album -> IO () +searchId :: UUID.UUID -> Maybe Album.Album -> IO () searchId releaseId mbLocalAlbum = do detail <- Req.lookupRelease releaseId displayRelease 1 detail mbLocalAlbum diff --git a/lib/MusicBrainz/Req.hs b/lib/MusicBrainz/Req.hs index 87b6210..82d5a64 100644 --- a/lib/MusicBrainz/Req.hs +++ b/lib/MusicBrainz/Req.hs @@ -8,6 +8,7 @@ where import Data.Aeson qualified as Aeson import Data.String.Interpolate (i) +import Data.UUID qualified as UUID import Data.Version qualified as Version import MusicBrainz.Types qualified as MusicBrainz import Network.HTTP.Req ((/:), (=:)) @@ -54,13 +55,13 @@ searchReleases limit albumArtist album = do query = [i|artist:"#{albumArtistText}" AND release:"#{albumText}"|] -- | Lookup a release by MBID -lookupRelease :: Text -> IO MusicBrainz.ReleaseDetail -lookupRelease mbid = do +lookupRelease :: UUID.UUID -> IO MusicBrainz.ReleaseDetail +lookupRelease releaseId = do response <- Req.runReq Req.defaultHttpConfig $ Req.req Req.GET - (baseUrl /: "release" /: mbid) + (baseUrl /: "release" /: UUID.toText releaseId) Req.NoReqBody Req.bsResponse ( headers diff --git a/lib/MusicBrainz/Types.hs b/lib/MusicBrainz/Types.hs index c155ec4..099b37c 100644 --- a/lib/MusicBrainz/Types.hs +++ b/lib/MusicBrainz/Types.hs @@ -13,6 +13,7 @@ where import Data.Aeson ((.:), (.:?)) import Data.Aeson qualified as Aeson import Data.Text qualified as Text +import Data.UUID qualified as UUID data ArtistCredit = ArtistCredit { acName :: Text, @@ -22,7 +23,7 @@ data ArtistCredit = ArtistCredit -- | A release from MusicBrainz search results data Release = Release - { reId :: Text, + { reId :: UUID.UUID, reTitle :: Text, reArtistCredit :: NonEmpty ArtistCredit, -- | Year parsed from MusicBrainz date field (format: YYYY, YYYY-MM, or diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz.hs index 979591a..a8936fe 100644 --- a/tests/Tests/MusicBrainz.hs +++ b/tests/Tests/MusicBrainz.hs @@ -2,7 +2,9 @@ module Tests.MusicBrainz (test) where import Data.Aeson qualified as Aeson import Data.List.NonEmpty qualified as NonEmpty +import Data.UUID qualified as UUID import MusicBrainz.Types qualified as MusicBrainz +import Relude.Unsafe qualified as Unsafe import Test.Hspec.Expectations (shouldBe) import Test.Tasty qualified as Tasty import Test.Tasty.HUnit qualified as Tasty @@ -22,7 +24,9 @@ testParseJSON = MusicBrainz.SearchResponse { MusicBrainz.srReleases = [ MusicBrainz.Release - { MusicBrainz.reId = "37e6a462-1417-45dc-9d88-4ef9aff4bc19", + { MusicBrainz.reId = + Unsafe.fromJust $ + UUID.fromString "37e6a462-1417-45dc-9d88-4ef9aff4bc19", MusicBrainz.reTitle = "Repeater", MusicBrainz.reArtistCredit = mkArtistCredit "Fugazi", MusicBrainz.reDate = Just 2005, @@ -39,7 +43,10 @@ testParseJSON = MusicBrainz.SearchResponse { MusicBrainz.srReleases = [ MusicBrainz.Release - { MusicBrainz.reId = "2b06e322-88e4-465c-b53d-1f82271e6131", + { MusicBrainz.reId = + Unsafe.fromJust $ + UUID.fromString $ + "2b06e322-88e4-465c-b53d-1f82271e6131", MusicBrainz.reTitle = "Dischord 1981: The Year in Seven Inches", MusicBrainz.reArtistCredit = mkArtistCredit "Various Artists", MusicBrainz.reDate = Just 1995, From 085cd5a2132c05d9f40659383251e08158001ac0 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 16:16:50 +0200 Subject: [PATCH 14/23] SetTagsOptions -> SetTags --- app/Main.hs | 4 ++-- app/Options.hs | 20 ++++++++++---------- htagcli.cabal | 2 +- lib/Commands.hs | 6 +++--- lib/Model/AudioTrack.hs | 8 ++++---- lib/Model/{SetTagsOptions.hs => SetTags.hs} | 18 +++++++++--------- 6 files changed, 29 insertions(+), 29 deletions(-) rename lib/Model/{SetTagsOptions.hs => SetTags.hs} (83%) diff --git a/app/Main.hs b/app/Main.hs index fe479fa..1bd3597 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -57,10 +57,10 @@ main = do Options.GetTags files -> ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C Commands.getTags - Options.SetTags setTagsOptions files -> + Options.SetTags setTags files -> ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C $ - Commands.setTags setTagsOptions + Commands.setTags setTags Options.Edit files -> do (editedContent, tempFilename) <- Temporary.withSystemTempFile "htagcli-edit-temp" $ \tempFilename tempHandle -> do diff --git a/app/Options.hs b/app/Options.hs index 3f3e79f..749016c 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -19,7 +19,7 @@ import Data.Text qualified as Text import Data.UUID qualified as UUID import Model.Cover qualified as Cover import Model.Pattern qualified as Pattern -import Model.SetTagsOptions qualified as SetTagsOptions +import Model.SetTags qualified as SetTags import Model.Tag qualified as Tag import Options.Applicative qualified as Options import Options.Applicative.NonEmpty qualified as Options @@ -72,7 +72,7 @@ data SearchManySource data Command = CreateConfig | GetTags Files - | SetTags SetTagsOptions.SetTagsOptions Files + | SetTags SetTags.SetTags Files | Edit Files | Check CheckOptions Files | FixFilePaths FixFilePathsOptions Files @@ -335,9 +335,9 @@ filematchesP = where parse = Megaparsec.parseMaybe Pattern.parser -setTagsOptionsP :: Options.Parser SetTagsOptions.SetTagsOptions -setTagsOptionsP = - SetTagsOptions.SetTagsOptions +setTagsP :: Options.Parser SetTags.SetTags +setTagsP = + SetTags.SetTags <$> optional ( Options.strOption ( Options.long "title" @@ -374,7 +374,7 @@ setTagsOptionsP = <> Options.help "Set the disc number" ) <|> Options.flag' - SetTagsOptions.Remove + SetTags.Remove (Options.long "nodisc" <> Options.help "Unset the disc") ) <*> optional @@ -392,7 +392,7 @@ setTagsOptionsP = <> Options.help "Set the year" ) <|> Options.flag' - SetTagsOptions.Remove + SetTags.Remove ( Options.long "noyear" <> Options.help "Unset the year" ) @@ -405,14 +405,14 @@ setTagsOptionsP = <> Options.help "Set the track number" ) <|> Options.flag' - SetTagsOptions.Remove + SetTags.Remove (Options.long "notrack" <> Options.help "Unset the track") ) where strToYear = strTo HTagLib.mkYear strToTrackNumber = strTo HTagLib.mkTrackNumber strToDiscNumber = strTo HTagLib.mkDiscNumber - strTo mkData = fmap SetTagsOptions.Set . mkData <=< readMaybe + strTo mkData = fmap SetTags.Set . mkData <=< readMaybe filesP :: Options.Parser Files filesP = @@ -457,7 +457,7 @@ optionsP = <> Options.command "set" ( Options.info - (SetTags <$> setTagsOptionsP <*> filesP) + (SetTags <$> setTagsP <*> filesP) (Options.progDesc "Set tags") ) <> Options.command diff --git a/htagcli.cabal b/htagcli.cabal index 60e6993..c266ea4 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -61,7 +61,7 @@ library Model.Cover Model.Disc Model.Pattern - Model.SetTagsOptions + Model.SetTags Model.Tag MusicBrainz MusicBrainz.Average diff --git a/lib/Commands.hs b/lib/Commands.hs index 0c0ddcd..e3ce51b 100644 --- a/lib/Commands.hs +++ b/lib/Commands.hs @@ -22,7 +22,7 @@ import Model.Artist qualified as Artist import Model.AudioTrack qualified as AudioTrack import Model.Disc qualified as Disc import Model.Pattern qualified as Pattern -import Model.SetTagsOptions qualified as SetTagsOptions +import Model.SetTags qualified as SetTags import Path (()) import Path qualified import Path.IO qualified as Path @@ -47,14 +47,14 @@ getTags = putTextLn . AudioTrack.asText <=< AudioTrack.getTags setTags :: (MonadIO m) => - SetTagsOptions.SetTagsOptions -> + SetTags.SetTags -> Path.Path Path.Abs Path.File -> m () setTags options filename = HTagLib.setTags (Path.toFilePath filename) Nothing - (SetTagsOptions.setter options) + (SetTags.setter options) countTrues :: [Bool] -> Int countTrues = length . filter id diff --git a/lib/Model/AudioTrack.hs b/lib/Model/AudioTrack.hs index b53ece9..91f3a95 100644 --- a/lib/Model/AudioTrack.hs +++ b/lib/Model/AudioTrack.hs @@ -12,7 +12,7 @@ where import Data.Set qualified as Set import Data.Text qualified as Text -import Model.SetTagsOptions qualified as SetTagsOptions +import Model.SetTags qualified as SetTags import Model.Tag qualified as Tag import Path qualified import Sound.HTagLib qualified as HTagLib @@ -134,8 +134,8 @@ setTags track@AudioTrack {..} = setter :: AudioTrack -> HTagLib.TagSetter setter AudioTrack {..} = - SetTagsOptions.setter $ - SetTagsOptions.SetTagsOptions + SetTags.setter $ + SetTags.SetTags { seTitle = Just atTitle, seArtist = Just atArtist, seAlbum = Just atAlbum, @@ -146,7 +146,7 @@ setter AudioTrack {..} = seDisc = setOrRemove atDisc } where - setOrRemove = Just . maybe SetTagsOptions.Remove SetTagsOptions.Set + setOrRemove = Just . maybe SetTags.Remove SetTags.Set haveTag :: Tag.Tag -> AudioTrack -> Bool haveTag Tag.Title = not . Text.null . HTagLib.unTitle . atTitle diff --git a/lib/Model/SetTagsOptions.hs b/lib/Model/SetTags.hs similarity index 83% rename from lib/Model/SetTagsOptions.hs rename to lib/Model/SetTags.hs index 180978d..daff6bc 100644 --- a/lib/Model/SetTagsOptions.hs +++ b/lib/Model/SetTags.hs @@ -1,7 +1,7 @@ -module Model.SetTagsOptions - ( SetTagsOptions (..), +module Model.SetTags + ( SetTags (..), SetOrRemove (..), - noSetTagsOptions, + noSetTags, setter, ) where @@ -12,7 +12,7 @@ import Sound.HTagLib.Extra qualified as HTagLib data SetOrRemove a = Set a | Remove deriving (Show) -data SetTagsOptions = SetTagsOptions +data SetTags = SetTags { seTitle :: Maybe HTagLib.Title, seArtist :: Maybe HTagLib.Artist, seAlbumArtist :: Maybe HTagLib.AlbumArtist, @@ -24,9 +24,9 @@ data SetTagsOptions = SetTagsOptions } deriving (Show) -noSetTagsOptions :: SetTagsOptions -noSetTagsOptions = - SetTagsOptions +noSetTags :: SetTags +noSetTags = + SetTags { seTitle = Nothing, seArtist = Nothing, seAlbum = Nothing, @@ -37,8 +37,8 @@ noSetTagsOptions = seDisc = Nothing } -setter :: SetTagsOptions -> HTagLib.TagSetter -setter SetTagsOptions {..} = +setter :: SetTags -> HTagLib.TagSetter +setter SetTags {..} = fold $ catMaybes [ HTagLib.titleSetter <$> seTitle, From 5208a314d2fee711fb192358f6757acec4d9832b Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 16:25:01 +0200 Subject: [PATCH 15/23] Remove dead code --- lib/Model/SetTags.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/lib/Model/SetTags.hs b/lib/Model/SetTags.hs index daff6bc..45e550a 100644 --- a/lib/Model/SetTags.hs +++ b/lib/Model/SetTags.hs @@ -1,7 +1,6 @@ module Model.SetTags ( SetTags (..), SetOrRemove (..), - noSetTags, setter, ) where @@ -24,19 +23,6 @@ data SetTags = SetTags } deriving (Show) -noSetTags :: SetTags -noSetTags = - SetTags - { seTitle = Nothing, - seArtist = Nothing, - seAlbum = Nothing, - seAlbumArtist = Nothing, - seGenre = Nothing, - seYear = Nothing, - seTrack = Nothing, - seDisc = Nothing - } - setter :: SetTags -> HTagLib.TagSetter setter SetTags {..} = fold $ From 57fff28dc91fdf2cf0ee8b1745eb152ddbebbc19 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 27 Jun 2026 17:02:14 +0200 Subject: [PATCH 16/23] Tag from MusicBrainz id --- app/Main.hs | 15 ++++++--- app/Options.hs | 34 +++++++++++++------- lib/MusicBrainz.hs | 78 +++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 110 insertions(+), 17 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 1bd3597..4343cc5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -57,10 +57,15 @@ main = do Options.GetTags files -> ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C Commands.getTags - Options.SetTags setTags files -> - ConduitUtils.runConduitWithProgress files $ - Conduit.mapM_C $ - Commands.setTags setTags + Options.SetTags fromOptions files -> + case fromOptions of + Options.SetTagsFromArgs options -> + ConduitUtils.runConduitWithProgress files $ + Conduit.mapM_C $ + Commands.setTags options + Options.SetTagsFromId releaseId -> do + album <- collectAlbum files + MusicBrainz.setTags releaseId album Options.Edit files -> do (editedContent, tempFilename) <- Temporary.withSystemTempFile "htagcli-edit-temp" $ \tempFilename tempHandle -> do @@ -215,4 +220,6 @@ exceptions someException Config.errorToText configException <> "\n" | Just commandsException <- fromException someException = Commands.errorToText commandsException <> "\n" + | Just musicBrainzException <- fromException someException = + MusicBrainz.errorToText musicBrainzException <> "\n" | otherwise = "Unknown exception: " <> show someException <> "\n" diff --git a/app/Options.hs b/app/Options.hs index 749016c..ce56eb9 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -3,10 +3,11 @@ module Options Command (..), Files (..), FixFilePathsOptions (..), - SearchOptions (..), SearchMany (..), SearchManySource (..), SearchOne (..), + SearchOptions (..), + SetTagsOptions (..), optionsInfo, checks, ) @@ -69,10 +70,15 @@ data SearchManySource | SearchManyFromArgs HTagLib.AlbumArtist HTagLib.Album deriving (Show) +data SetTagsOptions + = SetTagsFromArgs SetTags.SetTags + | SetTagsFromId UUID.UUID + deriving (Show) + data Command = CreateConfig | GetTags Files - | SetTags SetTags.SetTags Files + | SetTags SetTagsOptions Files | Edit Files | Check CheckOptions Files | FixFilePaths FixFilePathsOptions Files @@ -160,15 +166,7 @@ searchManyFromArgsP = ) searchOneP :: Options.Parser SearchOne -searchOneP = - SearchOne - <$> Options.option - (Options.maybeReader UUID.fromString) - ( Options.long "id" - <> Options.metavar "ID" - <> Options.help "MusicBrainz release ID to search for" - ) - <*> Options.optional filesP +searchOneP = SearchOne <$> musicBrainzIdP <*> Options.optional filesP dryRunP :: Options.Parser Bool dryRunP = @@ -335,6 +333,18 @@ filematchesP = where parse = Megaparsec.parseMaybe Pattern.parser +setTagsOptionsP :: Options.Parser SetTagsOptions +setTagsOptionsP = SetTagsFromArgs <$> setTagsP <|> SetTagsFromId <$> musicBrainzIdP + +musicBrainzIdP :: Options.Parser UUID.UUID +musicBrainzIdP = + Options.option + (Options.maybeReader UUID.fromString) + ( Options.long "id" + <> Options.metavar "ID" + <> Options.help "MusicBrainz release ID" + ) + setTagsP :: Options.Parser SetTags.SetTags setTagsP = SetTags.SetTags @@ -457,7 +467,7 @@ optionsP = <> Options.command "set" ( Options.info - (SetTags <$> setTagsP <*> filesP) + (SetTags <$> setTagsOptionsP <*> filesP) (Options.progDesc "Set tags") ) <> Options.command diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index 0cfdc95..4b4ca07 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -1,8 +1,17 @@ {-# LANGUAGE QuasiQuotes #-} -module MusicBrainz (search, searchId, searchAlbum) where +module MusicBrainz + ( Error (..), + errorToText, + search, + searchAlbum, + searchId, + setTags, + ) +where import Control.Concurrent qualified as Concurrent +import Data.List.NonEmpty qualified as NonEmpty import Data.String.Interpolate (i, __i) import Data.Text qualified as Text import Data.UUID qualified as UUID @@ -15,6 +24,73 @@ import MusicBrainz.Similarity qualified as Similarity import MusicBrainz.Types qualified as MusicBrainz import Sound.HTagLib qualified as HTagLib import Sound.HTagLib.Extra qualified as HTagLib +import UnliftIO.Exception qualified as Exception + +data Error + = MismatchedMediaCount + | MismatchedTrackCount Int + deriving (Show) + +instance Exception.Exception Error + +errorToText :: Error -> Text +errorToText MismatchedMediaCount = + "Number of discs doesn't match MusicBrainz release" +errorToText (MismatchedTrackCount discId) = + "Number of tracks on disc " + <> show discId + <> " doesn't match MusicBrainz release" + +tagAlbum :: + MusicBrainz.ReleaseDetail -> + Album.Album -> + Either Error (NonEmpty AudioTrack.AudioTrack) +tagAlbum detail@MusicBrainz.ReleaseDetail {..} album = do + when (length (Album.discs album) /= length rdMedia) $ + Left MismatchedMediaCount + listOfListOfAudioTracks <- + traverse (tagDisc detail) (NonEmpty.zip (Album.discs album) rdMedia) + pure $ join listOfListOfAudioTracks + +tagDisc :: + MusicBrainz.ReleaseDetail -> + (Disc.Disc, MusicBrainz.Media) -> + Either Error (NonEmpty AudioTrack.AudioTrack) +tagDisc detail (disc, media@MusicBrainz.Media {..}) = do + when (length (Disc.tracks disc) /= length meTracks) $ + Left (MismatchedTrackCount mePosition) + pure $ (tagTrack detail media) <$> NonEmpty.zip (Disc.tracks disc) meTracks + +tagTrack :: + MusicBrainz.ReleaseDetail -> + MusicBrainz.Media -> + (AudioTrack.AudioTrack, MusicBrainz.Track) -> + AudioTrack.AudioTrack +tagTrack + MusicBrainz.ReleaseDetail {..} + MusicBrainz.Media {..} + (audioTrack, MusicBrainz.Track {trRecording = MusicBrainz.Recording {..}, ..}) = + audioTrack + { AudioTrack.atTitle = HTagLib.mkTitle rcTitle, + AudioTrack.atArtist = HTagLib.mkArtist artist, + AudioTrack.atAlbumArtist = HTagLib.mkAlbumArtist albumArtist, + AudioTrack.atAlbum = HTagLib.mkAlbum rdTitle, + AudioTrack.atYear = HTagLib.mkYear =<< rdDate, + AudioTrack.atTrack = HTagLib.mkTrackNumber trPosition, + AudioTrack.atDisc = + if length rdMedia > 1 + then HTagLib.mkDiscNumber mePosition + else Nothing + } + where + artist = MusicBrainz.artistCreditToText rcArtistCredit + albumArtist = MusicBrainz.artistCreditToText rdArtistCredit + +setTags :: UUID.UUID -> Album.Album -> IO () +setTags releaseId album = do + details <- Req.lookupRelease releaseId + audioTracks <- Exception.fromEither $ tagAlbum details album + traverse_ AudioTrack.setTags audioTracks searchAlbum :: Int -> Album.Album -> IO () searchAlbum maxResults album = From c52cc29a883d7f2b3a97c9e7213b18953c05cb27 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sun, 28 Jun 2026 11:07:00 +0200 Subject: [PATCH 17/23] Move MusicBrainz tests to the right place --- htagcli.cabal | 2 +- tests/Main.hs | 8 ++++---- tests/Tests/{MusicBrainz.hs => MusicBrainz/Types.hs} | 4 ++-- 3 files changed, 7 insertions(+), 7 deletions(-) rename tests/Tests/{MusicBrainz.hs => MusicBrainz/Types.hs} (97%) diff --git a/htagcli.cabal b/htagcli.cabal index c266ea4..7f16d0a 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -149,7 +149,7 @@ test-suite tests Tests.Model.AudioTrack Tests.Model.Pattern Tests.Model.Tag - Tests.MusicBrainz + Tests.MusicBrainz.Types build-depends: aeson, diff --git a/tests/Main.hs b/tests/Main.hs index ced7564..9825394 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -10,7 +10,7 @@ import Tests.Config as Config import Tests.Model.AudioTrack qualified as Model.AudioTrack import Tests.Model.Pattern qualified as Model.Pattern import Tests.Model.Tag qualified as Model.Tag -import Tests.MusicBrainz qualified as MusicBrainz +import Tests.MusicBrainz.Types qualified as MusicBrainz.Types main :: IO () main = @@ -22,9 +22,9 @@ main = Model.AudioTrack.test, Model.Pattern.test, Model.Tag.test, - Check.Disc.test, - Check.Album.test, Check.Artist.test, + Check.Album.test, + Check.Disc.test, Check.Track.test, - MusicBrainz.test + MusicBrainz.Types.test ] diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz/Types.hs similarity index 97% rename from tests/Tests/MusicBrainz.hs rename to tests/Tests/MusicBrainz/Types.hs index a8936fe..ca24432 100644 --- a/tests/Tests/MusicBrainz.hs +++ b/tests/Tests/MusicBrainz/Types.hs @@ -1,4 +1,4 @@ -module Tests.MusicBrainz (test) where +module Tests.MusicBrainz.Types (test) where import Data.Aeson qualified as Aeson import Data.List.NonEmpty qualified as NonEmpty @@ -10,7 +10,7 @@ import Test.Tasty qualified as Tasty import Test.Tasty.HUnit qualified as Tasty test :: Tasty.TestTree -test = Tasty.testGroup "MusicBrainz" [testParseJSON] +test = Tasty.testGroup "MusicBrainz.Types" [testParseJSON] testParseJSON :: Tasty.TestTree testParseJSON = From 42585b09868a1d7d68c6757de979e1e3382d33ca Mon Sep 17 00:00:00 2001 From: jecaro Date: Sun, 28 Jun 2026 11:14:47 +0200 Subject: [PATCH 18/23] Test tagging with MusicBrainz data --- htagcli.cabal | 2 + lib/MusicBrainz.hs | 3 +- tests/Main.hs | 2 + tests/Tests/MusicBrainz.hs | 85 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 91 insertions(+), 1 deletion(-) create mode 100644 tests/Tests/MusicBrainz.hs diff --git a/htagcli.cabal b/htagcli.cabal index 7f16d0a..a4bca2d 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -149,10 +149,12 @@ test-suite tests Tests.Model.AudioTrack Tests.Model.Pattern Tests.Model.Tag + Tests.MusicBrainz Tests.MusicBrainz.Types build-depends: aeson, + extra, hedgehog, hspec, hspec-expectations, diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index 4b4ca07..64aa7fb 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -7,6 +7,7 @@ module MusicBrainz searchAlbum, searchId, setTags, + tagAlbum, ) where @@ -29,7 +30,7 @@ import UnliftIO.Exception qualified as Exception data Error = MismatchedMediaCount | MismatchedTrackCount Int - deriving (Show) + deriving (Eq, Show) instance Exception.Exception Error diff --git a/tests/Main.hs b/tests/Main.hs index 9825394..be6ef53 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -10,6 +10,7 @@ import Tests.Config as Config import Tests.Model.AudioTrack qualified as Model.AudioTrack import Tests.Model.Pattern qualified as Model.Pattern import Tests.Model.Tag qualified as Model.Tag +import Tests.MusicBrainz qualified as MusicBrainz import Tests.MusicBrainz.Types qualified as MusicBrainz.Types main :: IO () @@ -26,5 +27,6 @@ main = Check.Album.test, Check.Disc.test, Check.Track.test, + MusicBrainz.test, MusicBrainz.Types.test ] diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz.hs new file mode 100644 index 0000000..943881f --- /dev/null +++ b/tests/Tests/MusicBrainz.hs @@ -0,0 +1,85 @@ +module Tests.MusicBrainz (test) where + +import Data.Either.Extra qualified as Either +import Data.List.NonEmpty qualified as NonEmpty +import Model.Album qualified as Album +import Model.AudioTrack qualified as AudioTrack +import MusicBrainz qualified +import MusicBrainz.Types qualified as MusicBrainz +import Relude.Unsafe qualified as Unsafe +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib +import Test.Hspec.Expectations (shouldBe) +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit qualified as Tasty +import Tests.Common qualified as Common + +test :: Tasty.TestTree +test = + Tasty.testGroup + "MusicBrainz" + [ Tasty.testCase "happy path" $ do + let initialAlbum = Unsafe.fromJust $ Album.mkAlbum (Common.tenTracksDisc :| []) + detail = mkDetail 1 10 + taggedTracks = Either.fromRight' $ MusicBrainz.tagAlbum detail initialAlbum + forM_ (zip (toList taggedTracks) [1 ..]) $ \(track, n :: Int) -> do + let artist = HTagLib.unArtist (AudioTrack.atArtist track) + artist `shouldBe` "Test Track Artist" + + let albumArtist = HTagLib.unAlbumArtist (AudioTrack.atAlbumArtist track) + albumArtist `shouldBe` "Test Album Artist" + + let album = HTagLib.unAlbum (AudioTrack.atAlbum track) + album `shouldBe` "Test Album" + + let title = HTagLib.unTitle (AudioTrack.atTitle track) + title `shouldBe` "Test Track " <> show n, + Tasty.testCase "mismatched media count" $ do + let album = Unsafe.fromJust $ Album.mkAlbum (Common.tenTracksDisc :| []) + detail = mkDetail 2 10 + MusicBrainz.tagAlbum detail album + `shouldBe` Left MusicBrainz.MismatchedMediaCount, + Tasty.testCase "mismatched track count" $ do + let album = Unsafe.fromJust $ Album.mkAlbum (Common.tenTracksDisc :| []) + detail = mkDetail 1 9 + MusicBrainz.tagAlbum detail album + `shouldBe` Left (MusicBrainz.MismatchedTrackCount 1) + ] + +mkDetail :: Int -> Int -> MusicBrainz.ReleaseDetail +mkDetail nMedia nTracksPerMedia = + MusicBrainz.ReleaseDetail + { MusicBrainz.rdId = "test-id", + MusicBrainz.rdTitle = "Test Album", + MusicBrainz.rdArtistCredit = mkArtistCredit "Test Album Artist", + MusicBrainz.rdDate = Nothing, + MusicBrainz.rdMedia = + NonEmpty.fromList $ mkMedia nTracksPerMedia <$> [1 .. nMedia] + } + +mkMedia :: Int -> Int -> MusicBrainz.Media +mkMedia nTracks pos = + MusicBrainz.Media + { MusicBrainz.mePosition = pos, + MusicBrainz.meTracks = + NonEmpty.fromList $ mkTrack <$> [1 .. nTracks] + } + +mkArtistCredit :: Text -> NonEmpty MusicBrainz.ArtistCredit +mkArtistCredit name = + MusicBrainz.ArtistCredit + { MusicBrainz.acName = name, + MusicBrainz.acJoinphrase = Nothing + } + :| [] + +mkTrack :: Int -> MusicBrainz.Track +mkTrack n = + MusicBrainz.Track + { MusicBrainz.trPosition = n, + MusicBrainz.trRecording = + MusicBrainz.Recording + { MusicBrainz.rcTitle = "Test Track " <> show n, + MusicBrainz.rcArtistCredit = mkArtistCredit "Test Track Artist" + } + } From dffb1ff0a1cf05e72e30d465f13f27be2616a069 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 29 Jun 2026 10:34:14 +0200 Subject: [PATCH 19/23] Fix Artist, Album and Disc smart constructors The logic was wrong. If the tag album artist is present we should use it and not fallback on artist. --- lib/Model/Album.hs | 11 ++++++++--- lib/Model/Artist.hs | 13 +++++++------ lib/Model/Disc.hs | 16 +++++++++------- 3 files changed, 24 insertions(+), 16 deletions(-) diff --git a/lib/Model/Album.hs b/lib/Model/Album.hs index dfe3387..3e8051f 100644 --- a/lib/Model/Album.hs +++ b/lib/Model/Album.hs @@ -14,6 +14,7 @@ where import Data.List.Extra qualified as List import Data.List.NonEmpty ((<|)) +import Data.Text qualified as Text import Model.Disc qualified as Disc import Model.Tag qualified as Tag import Sound.HTagLib qualified as HTagLib @@ -25,8 +26,7 @@ newtype Album = Album (NonEmpty Disc.Disc) mkAlbum :: NonEmpty Disc.Disc -> Maybe Album mkAlbum discs'@(firstDisc :| otherDiscs) - | allSameAlbum - && (allSameAlbumArtist || allSameArtist) = + | allSameAlbum && allSameAlbumArtistOrArtist = Just $ Album $ NonEmpty.sortOn (fmap HTagLib.unDiscNumber . Disc.disc) discs' @@ -35,9 +35,14 @@ mkAlbum discs'@(firstDisc :| otherDiscs) firstAlbum = Disc.album firstDisc firstAlbumArtist = Disc.albumArtist firstDisc firstArtist = Disc.artist firstDisc + haveAlbumArtist = not $ Text.null $ HTagLib.unAlbumArtist firstAlbumArtist allSameAlbum = all ((== firstAlbum) . Disc.album) otherDiscs allSameAlbumArtist = all ((== firstAlbumArtist) . Disc.albumArtist) otherDiscs allSameArtist = all ((== firstArtist) . Disc.artist) otherDiscs + allSameAlbumArtistOrArtist = + if haveAlbumArtist + then allSameAlbumArtist + else allSameArtist addDisc :: Disc.Disc -> Album -> Maybe Album addDisc d (Album discs') = mkAlbum (d <| discs') @@ -46,7 +51,7 @@ discs :: Album -> NonEmpty Disc.Disc discs (Album discs') = discs' years :: Album -> [HTagLib.Year] -years (Album discs') = List.nubSort $ concatMap Disc.years $ toList discs' +years (Album discs') = List.nubSort $ foldMap Disc.years $ toList discs' album :: Album -> HTagLib.Album album (Album (d :| _)) = Disc.album d diff --git a/lib/Model/Artist.hs b/lib/Model/Artist.hs index bbdaa08..9fdf6d1 100644 --- a/lib/Model/Artist.hs +++ b/lib/Model/Artist.hs @@ -17,19 +17,20 @@ newtype Artist = Artist (NonEmpty Album.Album) mkArtist :: NonEmpty Album.Album -> Maybe Artist mkArtist albums'@(firstAlbum :| otherAlbums) - | ( allSameAlbumArtist - && not (Text.null $ HTagLib.unAlbumArtist firstAlbumArtist) - && (firstAlbumArtist /= "Various Artists") - ) - || allSameArtist = - Just $ Artist albums' + | allSameAlbumArtistOrArtist = Just $ Artist albums' | otherwise = Nothing where firstAlbumArtist = Album.albumArtist firstAlbum firstArtist = Album.artist firstAlbum + haveAlbumArtist = + not $ Text.null $ HTagLib.unAlbumArtist firstAlbumArtist allSameAlbumArtist = all ((== firstAlbumArtist) . Album.albumArtist) otherAlbums allSameArtist = all ((== firstArtist) . Album.artist) otherAlbums + allSameAlbumArtistOrArtist = + if haveAlbumArtist + then allSameAlbumArtist && firstAlbumArtist /= "Various Artists" + else allSameArtist addAlbum :: Album.Album -> Artist -> Maybe Artist addAlbum a (Artist albums') = mkArtist (a <| albums') diff --git a/lib/Model/Disc.hs b/lib/Model/Disc.hs index 3523518..1d3fffb 100644 --- a/lib/Model/Disc.hs +++ b/lib/Model/Disc.hs @@ -4,6 +4,7 @@ module Model.Disc addTrack, tracks, years, + genres, artist, album, albumArtist, @@ -29,13 +30,7 @@ newtype Disc = Disc (NonEmpty AudioTrack.AudioTrack) mkDisc :: NonEmpty AudioTrack.AudioTrack -> Maybe Disc mkDisc tracks'@(firstTrack :| otherTracks) - | allSameAlbum - && allSameDisc - && ( ( AudioTrack.haveTag Tag.AlbumArtist firstTrack - && allSameAlbumArtist - ) - || allSameArtist - ) = + | allSameAlbum && allSameDisc && allSameAlbumArtistOrArtist = Just $ Disc $ NonEmpty.sortOn @@ -52,6 +47,10 @@ mkDisc tracks'@(firstTrack :| otherTracks) allSameAlbumArtist = all ((== firstAlbumArtist) . AudioTrack.atAlbumArtist) otherTracks allSameArtist = all ((== firstArtist) . AudioTrack.atArtist) otherTracks + allSameAlbumArtistOrArtist = + if AudioTrack.haveTag Tag.AlbumArtist firstTrack + then allSameAlbumArtist + else allSameArtist addTrack :: AudioTrack.AudioTrack -> Disc -> Maybe Disc addTrack track (Disc tracks') = mkDisc (track <| tracks') @@ -77,6 +76,9 @@ disc (Disc (track :| _)) = AudioTrack.atDisc track album :: Disc -> HTagLib.Album album (Disc (track :| _)) = AudioTrack.atAlbum track +genres :: Disc -> NonEmpty HTagLib.Genre +genres (Disc tracks') = NonEmpty.nubOrd $ AudioTrack.atGenre <$> tracks' + -- | Return the directory if all tracks are in the same one directory :: Disc -> Maybe (Path.Path Path.Abs Path.Dir) directory (Disc tracks') From 16d6f42ae6ddb14e56fa5e4e1ad606c02a460f85 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 29 Jun 2026 10:30:11 +0200 Subject: [PATCH 20/23] Test the model invariants --- htagcli.cabal | 5 ++- tests/Main.hs | 20 ++++++---- tests/Tests/Model/Album.hs | 71 ++++++++++++++++++++++++++++++++++ tests/Tests/Model/Artist.hs | 77 +++++++++++++++++++++++++++++++++++++ tests/Tests/Model/Disc.hs | 61 +++++++++++++++++++++++++++++ 5 files changed, 226 insertions(+), 8 deletions(-) create mode 100644 tests/Tests/Model/Album.hs create mode 100644 tests/Tests/Model/Artist.hs create mode 100644 tests/Tests/Model/Disc.hs diff --git a/htagcli.cabal b/htagcli.cabal index a4bca2d..78aa4d9 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -8,8 +8,8 @@ maintainer: jeancharles.quillet@gmail.com common defaults default-language: GHC2021 ghc-options: + -- -Werror -Wall - -Werror -Wcompat -Widentities -Wincomplete-record-updates @@ -146,7 +146,10 @@ test-suite tests Tests.Commands Tests.Common Tests.Config + Tests.Model.Album + Tests.Model.Artist Tests.Model.AudioTrack + Tests.Model.Disc Tests.Model.Pattern Tests.Model.Tag Tests.MusicBrainz diff --git a/tests/Main.hs b/tests/Main.hs index be6ef53..da61ccc 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -7,7 +7,10 @@ import Tests.Check.Disc qualified as Check.Disc import Tests.Check.Track qualified as Check.Track import Tests.Commands as Commands import Tests.Config as Config +import Tests.Model.Album qualified as Model.Album +import Tests.Model.Artist qualified as Model.Artist import Tests.Model.AudioTrack qualified as Model.AudioTrack +import Tests.Model.Disc qualified as Model.Disc import Tests.Model.Pattern qualified as Model.Pattern import Tests.Model.Tag qualified as Model.Tag import Tests.MusicBrainz qualified as MusicBrainz @@ -18,15 +21,18 @@ main = defaultMain $ testGroup "Tests" - [ Commands.test, + [ Check.Album.test, + Check.Artist.test, + Check.Disc.test, + Check.Track.test, + Commands.test, Config.test, + Model.Album.test, + Model.Artist.test, Model.AudioTrack.test, + Model.Disc.test, Model.Pattern.test, Model.Tag.test, - Check.Artist.test, - Check.Album.test, - Check.Disc.test, - Check.Track.test, - MusicBrainz.test, - MusicBrainz.Types.test + MusicBrainz.Types.test, + MusicBrainz.test ] diff --git a/tests/Tests/Model/Album.hs b/tests/Tests/Model/Album.hs new file mode 100644 index 0000000..1b47363 --- /dev/null +++ b/tests/Tests/Model/Album.hs @@ -0,0 +1,71 @@ +module Tests.Model.Album (test) where + +import Model.Album qualified as Album +import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc +import Relude.Unsafe qualified as Unsafe +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib +import Test.Hspec.Expectations (shouldBe, shouldSatisfy) +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit qualified as Tasty +import Tests.Common qualified as Common + +test :: Tasty.TestTree +test = + Tasty.testGroup + "Model.Album" + [ Tasty.testCase "single disc succeeds" $ + Album.mkAlbum (Common.tenTracksDisc :| []) `shouldSatisfy` isJust, + Tasty.testCase "two discs with same album and artist succeed" $ + let disc1 = setDiscDisc (HTagLib.mkDiscNumber 1) Common.tenTracksDisc + disc2 = setDiscDisc (HTagLib.mkDiscNumber 2) disc1 + in Album.mkAlbum (disc1 :| [disc2]) `shouldSatisfy` isJust, + Tasty.testCase "different album names fail" $ + let disc1 = setDiscDisc (HTagLib.mkDiscNumber 1) Common.tenTracksDisc + disc2 = + setDiscDisc (HTagLib.mkDiscNumber 2) $ + setDiscAlbum (HTagLib.mkAlbum "Other Album") disc1 + in Album.mkAlbum (disc1 :| [disc2]) `shouldBe` Nothing, + Tasty.testCase "different album artists fails" $ + let disc1 = setDiscDisc (HTagLib.mkDiscNumber 1) Common.tenTracksDisc + disc2 = + setDiscAlbumArtist + (HTagLib.mkAlbumArtist "Other Album Artist") + disc1 + in Album.mkAlbum (disc1 :| [disc2]) `shouldBe` Nothing, + Tasty.testCase "no album artists but same artist succeeds" $ + let disc1 = + setDiscAlbumArtist + (HTagLib.mkAlbumArtist "") + $ setDiscDisc (HTagLib.mkDiscNumber 1) Common.tenTracksDisc + disc2 = setDiscDisc (HTagLib.mkDiscNumber 2) disc1 + in Album.mkAlbum (disc1 :| [disc2]) `shouldSatisfy` isJust, + Tasty.testCase "no album artists but different artist fails" $ + let disc1 = + setDiscAlbumArtist + (HTagLib.mkAlbumArtist "") + $ setDiscDisc (HTagLib.mkDiscNumber 1) Common.tenTracksDisc + disc2 = + setDiscDisc (HTagLib.mkDiscNumber 2) $ + setDiscArtist + (HTagLib.mkArtist "Other Artist") + disc1 + in Album.mkAlbum (disc1 :| [disc2]) `shouldBe` Nothing + ] + where + setDiscAlbum = modifyDisc . setTrackAlbum + setTrackAlbum album track = track {AudioTrack.atAlbum = album} + + setDiscAlbumArtist = modifyDisc . setTrackAlbumArtist + setTrackAlbumArtist albumArtist track = + track {AudioTrack.atAlbumArtist = albumArtist} + + setDiscArtist = modifyDisc . setTrackArtist + setTrackArtist artist track = track {AudioTrack.atArtist = artist} + + setDiscDisc = modifyDisc . setTrackDisc + setTrackDisc disc track = track {AudioTrack.atDisc = disc} + + modifyDisc modifyTrack disc = + Unsafe.fromJust $ Disc.mkDisc $ modifyTrack <$> Disc.tracks disc diff --git a/tests/Tests/Model/Artist.hs b/tests/Tests/Model/Artist.hs new file mode 100644 index 0000000..ec58f7a --- /dev/null +++ b/tests/Tests/Model/Artist.hs @@ -0,0 +1,77 @@ +module Tests.Model.Artist (test) where + +import Model.Album qualified as Album +import Model.Artist qualified as Artist +import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc +import Relude.Unsafe qualified as Unsafe +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib +import Test.Hspec.Expectations (shouldBe, shouldSatisfy) +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit qualified as Tasty +import Tests.Common qualified as Common + +test :: Tasty.TestTree +test = + Tasty.testGroup + "Model.Artist" + [ Tasty.testCase "single album succeeds" $ + Artist.mkArtist (tenTracksAlbum :| []) `shouldSatisfy` isJust, + Tasty.testCase "two albums same album artist succeeds" $ + let album1 = tenTracksAlbum + album2 = setAlbumAlbum (HTagLib.mkAlbum "Other Album") album1 + in Artist.mkArtist (album1 :| [album2]) `shouldSatisfy` isJust, + Tasty.testCase "two Various Artists albums fails" $ + let album1 = + setAlbumAlbumArtist + (HTagLib.mkAlbumArtist "Various Artists") + tenTracksAlbum + album2 = setAlbumAlbum (HTagLib.mkAlbum "Other Album") album1 + in Artist.mkArtist (album1 :| [album2]) `shouldBe` Nothing, + Tasty.testCase "Various Artists with different album artist fails" $ + let album1 = tenTracksAlbum + album2 = + setAlbumAlbumArtist + (HTagLib.mkAlbumArtist "Various Artists") + $ setAlbumAlbum (HTagLib.mkAlbum "Other Album") album1 + in Artist.mkArtist (album1 :| [album2]) `shouldBe` Nothing, + Tasty.testCase "no album artist but same artist succeeds" $ + let album1 = + setAlbumAlbumArtist + (HTagLib.mkAlbumArtist "") + tenTracksAlbum + album2 = setAlbumAlbum (HTagLib.mkAlbum "Other Album") album1 + in Artist.mkArtist (album1 :| [album2]) `shouldSatisfy` isJust, + Tasty.testCase "no album artist but different artist fails" $ + let album1 = + setAlbumAlbumArtist + (HTagLib.mkAlbumArtist "") + tenTracksAlbum + album2 = + setAlbumArtist (HTagLib.mkArtist "Other Artist") $ + setAlbumAlbum + (HTagLib.mkAlbum "Other Album") + album1 + in Artist.mkArtist (album1 :| [album2]) `shouldBe` Nothing + ] + where + tenTracksAlbum = Unsafe.fromJust $ Album.mkAlbum (Common.tenTracksDisc :| []) + + setAlbumAlbumArtist = modifyAlbum . setTrackAlbumArtist + + setAlbumArtist = modifyAlbum . setTrackArtist + setTrackArtist artist track = track {AudioTrack.atArtist = artist} + + setTrackAlbumArtist albumArtist track = + track {AudioTrack.atAlbumArtist = albumArtist} + setAlbumAlbum = modifyAlbum . setTrackAlbum + + setTrackAlbum album track = track {AudioTrack.atAlbum = album} + + modifyAlbum modifyTrack album = + Unsafe.fromJust $ + Album.mkAlbum $ + modifyDisc modifyTrack <$> Album.discs album + modifyDisc modifyTrack disc = + Unsafe.fromJust $ Disc.mkDisc $ modifyTrack <$> Disc.tracks disc diff --git a/tests/Tests/Model/Disc.hs b/tests/Tests/Model/Disc.hs new file mode 100644 index 0000000..e000d38 --- /dev/null +++ b/tests/Tests/Model/Disc.hs @@ -0,0 +1,61 @@ +module Tests.Model.Disc (test) where + +import Model.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc +import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib +import Test.Hspec.Expectations (shouldBe, shouldSatisfy) +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit qualified as Tasty +import Tests.Common qualified as Common + +test :: Tasty.TestTree +test = + Tasty.testGroup + "Model.Disc" + [ Tasty.testCase "valid tracks succeeds" $ + Disc.mkDisc (Disc.tracks Common.tenTracksDisc) `shouldSatisfy` isJust, + Tasty.testCase "different album names fails" $ + let tracks = + setFirstTrackAlbum (HTagLib.mkAlbum "Other Album") $ + Disc.tracks Common.tenTracksDisc + in Disc.mkDisc tracks `shouldBe` Nothing, + Tasty.testCase "different disc numbers fails" $ + let tracks = + setFirstTrackDisc (HTagLib.mkDiscNumber 2) $ + setTrackDisc (HTagLib.mkDiscNumber 1) + <$> Disc.tracks Common.tenTracksDisc + in Disc.mkDisc tracks `shouldBe` Nothing, + Tasty.testCase "different album artist fails" $ + let tracks = + setFirstTrackAlbumArtist + (HTagLib.mkAlbumArtist "Other Album Artist") + $ Disc.tracks Common.tenTracksDisc + in Disc.mkDisc tracks `shouldBe` Nothing, + Tasty.testCase "no album artist but same artist succeeds" $ + let tracks = + setTrackAlbumArtist (HTagLib.mkAlbumArtist "") + <$> Disc.tracks Common.tenTracksDisc + in Disc.mkDisc tracks `shouldSatisfy` isJust, + Tasty.testCase "no album artist but different artist fails" $ + let tracks = + setFirstTrackArtist (HTagLib.mkArtist "Other Artist") $ + setTrackAlbumArtist (HTagLib.mkAlbumArtist "") + <$> Disc.tracks Common.tenTracksDisc + in Disc.mkDisc tracks `shouldBe` Nothing + ] + where + setFirstTrackDisc = modifyFirstTrack . setTrackDisc + setTrackDisc disc track = track {AudioTrack.atDisc = disc} + + setFirstTrackAlbum = modifyFirstTrack . setTrackAlbum + setTrackAlbum album track = track {AudioTrack.atAlbum = album} + + setFirstTrackAlbumArtist = modifyFirstTrack . setTrackAlbumArtist + setTrackAlbumArtist albumArtist track = + track {AudioTrack.atAlbumArtist = albumArtist} + + setFirstTrackArtist = modifyFirstTrack . setTrackArtist + setTrackArtist artist track = track {AudioTrack.atArtist = artist} + + modifyFirstTrack changeTrack (track :| tracks) = changeTrack track :| tracks From ea6604f7081b530c8345345e105a1e1f912f5567 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 29 Jun 2026 15:10:51 +0200 Subject: [PATCH 21/23] Use the title/artist-credit from the track --- lib/MusicBrainz.hs | 10 +++++----- lib/MusicBrainz/Similarity.hs | 6 +++--- lib/MusicBrainz/Types.hs | 19 ++++--------------- tests/Tests/MusicBrainz.hs | 7 ++----- tests/Tests/MusicBrainz/Types.hs | 7 ++----- 5 files changed, 16 insertions(+), 33 deletions(-) diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index 64aa7fb..fdacf35 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -70,9 +70,9 @@ tagTrack :: tagTrack MusicBrainz.ReleaseDetail {..} MusicBrainz.Media {..} - (audioTrack, MusicBrainz.Track {trRecording = MusicBrainz.Recording {..}, ..}) = + (audioTrack, MusicBrainz.Track {..}) = audioTrack - { AudioTrack.atTitle = HTagLib.mkTitle rcTitle, + { AudioTrack.atTitle = HTagLib.mkTitle trTitle, AudioTrack.atArtist = HTagLib.mkArtist artist, AudioTrack.atAlbumArtist = HTagLib.mkAlbumArtist albumArtist, AudioTrack.atAlbum = HTagLib.mkAlbum rdTitle, @@ -84,7 +84,7 @@ tagTrack else Nothing } where - artist = MusicBrainz.artistCreditToText rcArtistCredit + artist = MusicBrainz.artistCreditToText trArtistCredit albumArtist = MusicBrainz.artistCreditToText rdArtistCredit setTags :: UUID.UUID -> Album.Album -> IO () @@ -180,9 +180,9 @@ displayMedia media@MusicBrainz.Media {..} mDisc = do forM_ tracksAndLocalTracks $ \(MusicBrainz.Track {..}, mLocalTitle) -> do let trackSuffix = orMempty - (similaritySuffix (MusicBrainz.rcTitle trRecording)) + (similaritySuffix trTitle) mLocalTitle - title = MusicBrainz.rcTitle trRecording + title = trTitle putTextLn [i| #{trPosition}. #{title} #{trackSuffix}|] putTextLn "" diff --git a/lib/MusicBrainz/Similarity.hs b/lib/MusicBrainz/Similarity.hs index 663a8ca..024854f 100644 --- a/lib/MusicBrainz/Similarity.hs +++ b/lib/MusicBrainz/Similarity.hs @@ -23,13 +23,13 @@ text a b = mediaAndDisc :: MusicBrainz.Media -> Disc.Disc -> Average.Average mediaAndDisc MusicBrainz.Media {..} disc = Average.Average - { avSum = sum (zipWith text localTracks tracks), + { avSum = sum (NonEmpty.zipWith text localTracks tracks), avCount = max (length localTracks) (length tracks) } where - tracks = toList $ MusicBrainz.rcTitle . MusicBrainz.trRecording <$> meTracks + tracks = MusicBrainz.trTitle <$> meTracks localTracks = - toList $ HTagLib.unTitle . AudioTrack.atTitle <$> Disc.tracks disc + HTagLib.unTitle . AudioTrack.atTitle <$> Disc.tracks disc -- | Weighted similarity between a local album and a MusicBrainz release detail. -- Weights: artist 20%, title 20%, tracks from discs 60%. diff --git a/lib/MusicBrainz/Types.hs b/lib/MusicBrainz/Types.hs index 099b37c..cfdc679 100644 --- a/lib/MusicBrainz/Types.hs +++ b/lib/MusicBrainz/Types.hs @@ -1,7 +1,6 @@ module MusicBrainz.Types ( ArtistCredit (..), Media (..), - Recording (..), Release (..), ReleaseDetail (..), SearchResponse (..), @@ -35,16 +34,11 @@ data Release = Release } deriving (Show, Eq) -data Recording = Recording - { rcTitle :: Text, - rcArtistCredit :: NonEmpty ArtistCredit - } - deriving (Show, Eq) - -- | A track from MusicBrainz release lookup data Track = Track { trPosition :: Int, - trRecording :: Recording + trTitle :: Text, + trArtistCredit :: NonEmpty ArtistCredit } deriving (Show, Eq) @@ -111,15 +105,10 @@ instance Aeson.FromJSON Media where instance Aeson.FromJSON Track where parseJSON = Aeson.withObject "Track" $ \o -> do trPosition <- o .: "position" - trRecording <- o .: "recording" + trTitle <- o .: "title" + trArtistCredit <- o .: "artist-credit" pure Track {..} -instance Aeson.FromJSON Recording where - parseJSON = Aeson.withObject "Recording" $ \o -> do - rcTitle <- o .: "title" - rcArtistCredit <- o .: "artist-credit" - pure Recording {..} - parseDate :: Text -> Maybe Int parseDate = readMaybe . toString . Text.take 4 diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz.hs index 943881f..34ca6bd 100644 --- a/tests/Tests/MusicBrainz.hs +++ b/tests/Tests/MusicBrainz.hs @@ -77,9 +77,6 @@ mkTrack :: Int -> MusicBrainz.Track mkTrack n = MusicBrainz.Track { MusicBrainz.trPosition = n, - MusicBrainz.trRecording = - MusicBrainz.Recording - { MusicBrainz.rcTitle = "Test Track " <> show n, - MusicBrainz.rcArtistCredit = mkArtistCredit "Test Track Artist" - } + MusicBrainz.trTitle = "Test Track " <> show n, + MusicBrainz.trArtistCredit = mkArtistCredit "Test Track Artist" } diff --git a/tests/Tests/MusicBrainz/Types.hs b/tests/Tests/MusicBrainz/Types.hs index ca24432..747e973 100644 --- a/tests/Tests/MusicBrainz/Types.hs +++ b/tests/Tests/MusicBrainz/Types.hs @@ -102,9 +102,6 @@ mkTrack :: Int -> Text -> MusicBrainz.Track mkTrack n title = MusicBrainz.Track { MusicBrainz.trPosition = n, - MusicBrainz.trRecording = - MusicBrainz.Recording - { MusicBrainz.rcTitle = title, - MusicBrainz.rcArtistCredit = mkArtistCredit "Fugazi" - } + MusicBrainz.trTitle = title, + MusicBrainz.trArtistCredit = mkArtistCredit "Fugazi" } From 735756f387aa914d202019102aa39f134a110ba1 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 29 Jun 2026 15:52:34 +0200 Subject: [PATCH 22/23] Hide the similarity to tracks separator --- lib/MusicBrainz.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs index fdacf35..e45f584 100644 --- a/lib/MusicBrainz.hs +++ b/lib/MusicBrainz.hs @@ -174,7 +174,7 @@ displayRelease idx detail@(MusicBrainz.ReleaseDetail {..}) mbAlbum = do displayMedia :: MusicBrainz.Media -> Maybe Disc.Disc -> IO () displayMedia media@MusicBrainz.Media {..} mDisc = do - putTextLn [i| Disc #{mePosition}: #{discSimilarity} - Tracks: #{trackCount} #{trackCountSuffix}|] + putTextLn [i| Disc #{mePosition}: #{discSimilarity}Tracks: #{trackCount} #{trackCountSuffix}|] putTextLn "" forM_ tracksAndLocalTracks $ \(MusicBrainz.Track {..}, mLocalTitle) -> do @@ -191,8 +191,11 @@ displayMedia media@MusicBrainz.Media {..} mDisc = do tracksAndLocalTracks = zip tracks $ localTitles <> repeat Nothing discSimilarity = - inParensMaybe - (percentage . Average.toDouble . Similarity.mediaAndDisc media) + orMempty + ( (<> " - ") + . inParens + . (percentage . Average.toDouble . Similarity.mediaAndDisc media) + ) mDisc trackCount = length tracks From 305a127b4b70b58259eb62ade49a4a180ac72fe9 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 29 Jun 2026 15:42:08 +0200 Subject: [PATCH 23/23] Add doc for using MusicBrainz DB --- README.md | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) diff --git a/README.md b/README.md index f50ce11..2cf2c06 100644 --- a/README.md +++ b/README.md @@ -65,6 +65,99 @@ accordingly. Delete the whole file content before quitting to cancel the operation. +## Setting tags with MusicBrainz + +`htagcli` can fetch tags from [MusicBrainz][musicbrainz] to automatically set +the tags of your files. To do this, one can search for an album/artist using +the `search` command: + +``` +$ htagcli search --album repeater --artist fugazi +Searching: "fugazi" - "repeater" + +3 releases found + +1. ID: 37e6a462-1417-45dc-9d88-4ef9aff4bc19 + Artist: Fugazi + Album: Repeater + Year: 2005 + Discs: 1 + Tracks: 14 + + Disc 1: Tracks: 14 + + 1. Turnover + 2. Repeater + 3. Brendan #1 +... +``` + +If the search is run against an existing album, `htagcli` will show similarity +values to help you choose the best match. In the following case, the first +result shows a low similarity because the number of tracks is different from +the actual album. The second result is a perfect match. + +``` +$ htagcli search ./repeater/ +Searching: "Fugazi" - "Repeater" + +3 releases found + +1. ID: 37e6a462-1417-45dc-9d88-4ef9aff4bc19 (87%) + Artist: Fugazi (100%) + Album: Repeater (100%) + Year: 2005 (1990) + Discs: 1 + Tracks: 14 (11) + + Disc 1: (79%) - Tracks: 14 (11) + + 1. Turnover (100%) + 2. Repeater (100%) + 3. Brendan #1 (100%) + 4. Merchandise (100%) + 5. Blueprint (100%) + 6. Sieve-Fisted Find (100%) + 7. Greed (100%) + 8. Two Beats Off (100%) + 9. Styrofoam (100%) + 10. Reprovisional (100%) + 11. Shut the Door (100%) + 12. Song #1 + 13. Joe #1 + 14. Break-In + +2. ID: 00baa173-29db-33a9-af6d-fe109e53a211 (100%) + Artist: Fugazi (100%) + Album: Repeater (100%) + Year: 1990 + Discs: 1 + Tracks: 11 + + Disc 1: (100%) - Tracks: 11 + + 1. Turnover (100%) + 2. Repeater (100%) + 3. Brendan #1 (100%) + 4. Merchandise (100%) + 5. Blueprint (100%) + 6. Sieve-Fisted Find (100%) + 7. Greed (100%) + 8. Two Beats Off (100%) + 9. Styrofoam (100%) + 10. Reprovisional (100%) + 11. Shut the Door (100%) + +... +``` + +Once you found a matching release, you can set the tags using the ID of the +release: + +``` +$ htagcli set --id 00baa173-29db-33a9-af6d-fe109e53a211 ./repeater/ +``` + ## Configuration The next commands require a configuration file. You can generate [a default @@ -96,6 +189,12 @@ collection clean and well-organized. Available checks include: - Cover file: Checks the presence of a cover image in the disc directory. Also verifies that the cover image size is within specified limits. - Disc tags: Checks that the tags from all files in a disc are the same + - Track numbers: Checks that the track numbers are sequential and start + from 1 +- Album level: + - Disc numbers: Checks that the disc numbers are sequential and start from + 1 + - Album tags: Checks that the tags from all files in an album are the same - Artist level: - Genre: Ensures that all tracks from an artist share the same genre @@ -158,6 +257,7 @@ This project uses [htaglib] as the underlying library to manipulate audio file. [demo]: ./demo.png [htaglib]: https://github.com/mrkkrp/htaglib +[musicbrainz]: https://musicbrainz.org/ [nix]: https://nixos.org/ [releases]: https://github.com/jecaro/htagcli/releases [status-nix-png]: https://github.com/jecaro/htagcli/workflows/nix/badge.svg