diff --git a/README.md b/README.md index 5c3496a..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 @@ -90,11 +183,17 @@ 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. + - 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 diff --git a/app/ConduitUtils.hs b/app/ConduitUtils.hs index a267007..20f3a14 100644 --- a/app/ConduitUtils.hs +++ b/app/ConduitUtils.hs @@ -1,4 +1,12 @@ -module ConduitUtils (runConduitWithProgress, albumC, artistC) where +module ConduitUtils + ( runConduitWithProgress, + filesC, + discC, + albumC, + artistC, + oneC, + ) +where import Conduit ((.|)) import Conduit qualified @@ -6,11 +14,13 @@ 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 import Progress qualified import System.FilePath qualified as FilePath +import UnliftIO.Exception qualified as Exception runConduitWithProgress :: Options.Files -> @@ -41,10 +51,34 @@ filesC Options.Files {..} = do ) .| Conduit.mapMC Path.parseAbsFile +discC :: + (Monad m) => + Conduit.ConduitT AudioTrack.AudioTrack Disc.Disc m () +discC = clusterC Disc.mkDisc Disc.addTrack + albumC :: (Monad m) => - Conduit.ConduitT AudioTrack.AudioTrack Album.Album m () -albumC = clusterC Album.mkAlbum Album.addTrack + 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) => diff --git a/app/Main.hs b/app/Main.hs index b1325ad..4343cc5 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 @@ -39,7 +43,9 @@ 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." +errorToText NoAudioFiles = "No audio files found" +errorToText NotSameAlbum = "Input files are not from the same album" main :: IO () main = do @@ -51,10 +57,15 @@ main = do Options.GetTags files -> ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C Commands.getTags - Options.SetTags setTagsOptions files -> - ConduitUtils.runConduitWithProgress files $ - Conduit.mapM_C $ - Commands.setTags setTagsOptions + 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 @@ -93,40 +104,52 @@ 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 Config.AllChecks {..} = Options.checks config options - when (null trackChecks && null albumChecks && null mbArtistCheck) $ - Exception.throwIO NoCheckInConfig + when + ( null alTrack + && null alDisc + && null alAlbum + && null alArtist + ) + $ 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 $ Conduit.mapM AudioTrack.getTags .| Conduit.iterM - (addTrackErrors <=< Commands.checkTrack trackChecks) + (addTrackErrors <=< Commands.checkTrack alTrack) + .| ConduitUtils.discC + .| Conduit.iterM + (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 albumChecks) $ + unless (null alDisc) $ + putTextLn $ + "Disc errors: " <> show ceDiscErrors + unless (null alAlbum) $ putTextLn $ "Album errors: " <> show ceAlbumErrors - when (isJust mbArtistCheck) $ + when (isJust alArtist) $ putTextLn $ "Artist errors: " <> show ceArtistErrors - let total = ceTrackErrors + ceAlbumErrors + ceArtistErrors + let total = ceTrackErrors + ceDiscErrors + ceAlbumErrors + ceArtistErrors when (total > 0) $ System.exitWith $ System.ExitFailure total Options.FixFilePaths Options.FixFilePathsOptions {..} files -> do Config.Config @@ -136,8 +159,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 @@ -154,11 +177,33 @@ main = do ConduitUtils.runConduitWithProgress files $ Conduit.mapM_C $ Commands.fixFilePaths fixFilePathOptions + 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 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 @@ -175,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 658240b..ce56eb9 100644 --- a/app/Options.hs +++ b/app/Options.hs @@ -3,19 +3,24 @@ module Options Command (..), Files (..), FixFilePathsOptions (..), + SearchMany (..), + SearchManySource (..), + SearchOne (..), + SearchOptions (..), + SetTagsOptions (..), optionsInfo, checks, ) where -import Check.Album qualified as Album import Check.Artist qualified as Artist -import Check.Track qualified as Track +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 +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 @@ -43,13 +48,41 @@ data FixFilePathsOptions = FixFilePathsOptions } deriving (Show) +data SearchOptions + = SeSearchMany SearchMany + | SeSearchOne SearchOne + deriving (Show) + +data SearchOne = SearchOne + { soId :: UUID.UUID, + soFiles :: Maybe Files + } + deriving (Show) + +data SearchMany = SearchMany + { smMaxResults :: Int, + smSource :: SearchManySource + } + deriving (Show) + +data SearchManySource + = SearchManyFromFiles Files + | SearchManyFromArgs HTagLib.AlbumArtist HTagLib.Album + deriving (Show) + +data SetTagsOptions + = SetTagsFromArgs SetTags.SetTags + | SetTagsFromId UUID.UUID + deriving (Show) + data Command = CreateConfig | GetTags Files - | SetTags SetTagsOptions.SetTagsOptions Files + | SetTags SetTagsOptions Files | 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 @@ -57,7 +90,7 @@ data Command checks :: Config.Config -> CheckOptions -> - ([Track.Check], [Album.Check], Maybe Artist.Check) + Config.AllChecks checks config@(Config.Config {coFilename = Config.Filename {..}}) (Options.CheckOptions {..}) @@ -81,10 +114,12 @@ checksP = <$> optional trackTagsP <*> optional trackGenreAmongP <*> trackFilenameP - <*> optional albumHaveCoverP - <*> albumSameDirP + <*> optional discHaveCoverP + <*> discSameDirP + <*> optional discSameTagsP + <*> discTracksSequentialP + <*> albumDiscsSequentialP <*> optional albumSameTagsP - <*> albumTracksSequentialP <*> artistSameGenreP fixFilePathsOptionsP :: Options.Parser FixFilePathsOptions @@ -94,6 +129,45 @@ fixFilePathsOptionsP = <*> optional baseDirectoryP <*> optional filematchesP +searchOptionsP :: Options.Parser SearchOptions +searchOptionsP = SeSearchMany <$> searchManyP <|> SeSearchOne <$> searchOneP + +searchManyP :: Options.Parser SearchMany +searchManyP = + SearchMany + <$> Options.option + Options.auto + ( Options.long "max-results" + <> Options.metavar "N" + <> Options.value 3 + <> Options.showDefault + <> Options.help "Maximum number of results to display" + ) + <*> searchManySourceP + +searchManySourceP :: Options.Parser SearchManySource +searchManySourceP = searchManyFromArgsP <|> searchManyFromFilesP + +searchManyFromFilesP :: Options.Parser SearchManySource +searchManyFromFilesP = SearchManyFromFiles <$> filesP + +searchManyFromArgsP :: Options.Parser SearchManySource +searchManyFromArgsP = + SearchManyFromArgs + <$> 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" + ) + +searchOneP :: Options.Parser SearchOne +searchOneP = SearchOne <$> musicBrainzIdP <*> Options.optional filesP + dryRunP :: Options.Parser Bool dryRunP = Options.switch @@ -121,19 +195,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 +232,55 @@ 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" + ) + +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) @@ -237,9 +333,21 @@ filematchesP = where parse = Megaparsec.parseMaybe Pattern.parser -setTagsOptionsP :: Options.Parser SetTagsOptions.SetTagsOptions -setTagsOptionsP = - SetTagsOptions.SetTagsOptions +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 <$> optional ( Options.strOption ( Options.long "title" @@ -276,7 +384,7 @@ setTagsOptionsP = <> Options.help "Set the disc number" ) <|> Options.flag' - SetTagsOptions.Remove + SetTags.Remove (Options.long "nodisc" <> Options.help "Unset the disc") ) <*> optional @@ -294,7 +402,7 @@ setTagsOptionsP = <> Options.help "Set the year" ) <|> Options.flag' - SetTagsOptions.Remove + SetTags.Remove ( Options.long "noyear" <> Options.help "Unset the year" ) @@ -307,14 +415,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 = @@ -325,20 +433,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"]) @@ -382,4 +488,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/app/Stats.hs b/app/Stats.hs index d0cfeb5..3eb2b17 100644 --- a/app/Stats.hs +++ b/app/Stats.hs @@ -2,6 +2,7 @@ module Stats ( CheckErrors (..), Stats.empty, addTrackErrors, + addDiscErrors, addAlbumErrors, incArtistErrors, ) @@ -9,16 +10,20 @@ 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} +addDiscErrors :: Int -> CheckErrors -> CheckErrors +addDiscErrors n errors = errors {ceDiscErrors = ceDiscErrors errors + n} + addAlbumErrors :: Int -> CheckErrors -> CheckErrors addAlbumErrors n errors = errors {ceAlbumErrors = ceAlbumErrors errors + n} diff --git a/data/htagcli.toml b/data/htagcli.toml index 2694147..30d5f0c 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,20 +101,29 @@ 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 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/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 f717da2..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 @@ -18,6 +18,7 @@ common defaults -Wredundant-constraints default-extensions: + DataKinds LambdaCase OverloadedStrings PackageImports @@ -40,9 +41,16 @@ library hs-source-dirs: lib + autogen-modules: + Paths_htagcli + + other-modules: + Paths_htagcli + exposed-modules: Check.Album Check.Artist + Check.Disc Check.Track Commands Config @@ -51,15 +59,22 @@ library Model.Artist Model.AudioTrack Model.Cover + Model.Disc Model.Pattern - Model.SetTagsOptions + Model.SetTags Model.Tag + MusicBrainz + MusicBrainz.Average + MusicBrainz.Req + MusicBrainz.Similarity + MusicBrainz.Types Path.IO.Extra Sound.HTagLib.Extra Toml.Extra build-depends: JuicyPixels, + aeson, extra, file-embed, filepath, @@ -68,9 +83,13 @@ library parser-combinators, path, path-io, + req, + string-interpolate, + text-metrics, tomland, transformers, unliftio, + uuid, validation-selective, executable htagcli @@ -104,6 +123,7 @@ executable htagcli text, typed-process, unliftio, + uuid, test-suite tests import: @@ -121,15 +141,23 @@ test-suite tests other-modules: Tests.Check.Album Tests.Check.Artist + Tests.Check.Disc Tests.Check.Track 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 + Tests.MusicBrainz.Types build-depends: + aeson, + extra, hedgehog, hspec, hspec-expectations, @@ -142,8 +170,10 @@ test-suite tests path, path-io, resourcet, + string-interpolate, tasty, tasty-expected-failure, tasty-hedgehog, tasty-hunit-compat, unliftio, + uuid, diff --git a/lib/Check/Album.hs b/lib/Check/Album.hs index 26ffdb9..d2f87c7 100644 --- a/lib/Check/Album.hs +++ b/lib/Check/Album.hs @@ -1,104 +1,48 @@ module Check.Album ( Check (..), - Cover (..), - Size (..), - check, Error (..), errorToText, + check, ) where -import Codec.Picture qualified as Picture -import Control.Monad.Extra qualified as Monad -import Control.Monad.Trans.Except qualified as Except +import Data.List qualified as List 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 -import Path.IO qualified as Path -import Sound.HTagLib qualified as HTagLib +import Sound.HTagLib.Extra qualified as HTagLib data Check - = HaveCover Cover.Cover - | InSameDir + = DiscsSequential | SameTags (NonEmpty Tag.Tag) - | TracksSequential deriving (Eq, Show) data Error - = NotInSameDir - | MissingCover (Path.Path Path.Abs Path.Dir) - | BadCoverSize (Path.Path Path.Abs Path.File) Size - | UnableToReadCover (Path.Path Path.Abs Path.File) Text + = DiscsNotSequential | SameTagsError (NonEmpty Tag.Tag) - | TracksNotSequential deriving (Eq, Show) errorToText :: Error -> Text -errorToText NotInSameDir = - "Audio tracks are not all in the same directory" -errorToText (MissingCover directory) = - "Missing cover in directory: " <> Text.pack (Path.toFilePath directory) -errorToText (BadCoverSize file size) = - "Cover file " - <> toText (Path.toFilePath file) - <> " has size out of range: " - <> Cover.sizeToText size -errorToText (UnableToReadCover file err) = - "Unable to read cover file " - <> toText (Path.toFilePath file) - <> ": " - <> err +errorToText DiscsNotSequential = + "Disc numbers are not sequentially numbered" errorToText (SameTagsError tags) = - "These tags are not the same for all tracks in the album: " + "These tags are not the same for all discs in the album: " <> Text.intercalate ", " (Tag.asText <$> toList tags) -errorToText TracksNotSequential = "Tracks are not sequentially numbered" - -check :: - (MonadIO m) => - Check -> - Album.Album -> - m (Either Error ()) -check InSameDir album - | isJust $ Album.directory album = pure $ Right () - | otherwise = pure $ Left NotInSameDir -check (HaveCover cover@Cover {..}) album - | Just dir <- Album.directory album = runExceptT $ do - let absFiles = (dir ) <$> coPaths - coverFile <- - maybeToExceptT (MissingCover dir) $ - MaybeT $ - Monad.findM Path.doesFileExist (toList absFiles) - -- Reading the image is very slow, so only do it if we have size - -- constraints - when (Cover.haveRange cover) $ do - picture <- - Except.withExceptT (UnableToReadCover coverFile . toText) $ - ExceptT $ - readImage coverFile - - let size = Cover.pictureSize picture - unless (Cover.withinRange cover size) $ - Except.throwE $ - BadCoverSize coverFile size - | otherwise = pure $ Left NotInSameDir +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 - readImage = liftIO . Picture.readImage . Path.toFilePath -check (SameTags tagsToCheck) album = pure $ case checkedTags of + 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) -check TracksSequential album = 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) - sequential list = and $ zipWith (==) (sort list) [1 ..] diff --git a/lib/Check/Artist.hs b/lib/Check/Artist.hs index a77c124..07dd0cf 100644 --- a/lib/Check/Artist.hs +++ b/lib/Check/Artist.hs @@ -11,6 +11,7 @@ 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 +38,10 @@ check (SameGenre artistToAllowedGenres) artist Right () | otherwise = Left $ SameGenreError genres where - albums = Artist.albums artist genres = - NonEmpty.nubOrd $ AudioTrack.atGenre <$> (Album.tracks =<< albums) + NonEmpty.nubOrd $ + AudioTrack.atGenre + <$> (Disc.tracks =<< Album.discs =<< Artist.albums artist) albumArtistOrArtist = Artist.albumArtistOrArtist artist mbAllowedGenres = Map.lookup diff --git a/lib/Check/Disc.hs b/lib/Check/Disc.hs new file mode 100644 index 0000000..c627d12 --- /dev/null +++ b/lib/Check/Disc.hs @@ -0,0 +1,104 @@ +module Check.Disc + ( Check (..), + Cover (..), + Size (..), + check, + Error (..), + errorToText, + ) +where + +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.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 +import Path.IO qualified as Path +import Sound.HTagLib qualified as HTagLib + +data Check + = HaveCover Cover.Cover + | InSameDir + | SameTags (NonEmpty Tag.Tag) + | TracksSequential + deriving (Eq, Show) + +data Error + = NotInSameDir + | MissingCover (Path.Path Path.Abs Path.Dir) + | BadCoverSize (Path.Path Path.Abs Path.File) Size + | UnableToReadCover (Path.Path Path.Abs Path.File) Text + | SameTagsError (NonEmpty Tag.Tag) + | TracksNotSequential + deriving (Eq, Show) + +errorToText :: Error -> Text +errorToText NotInSameDir = + "Audio tracks are not all in the same directory" +errorToText (MissingCover directory) = + "Missing cover in directory: " <> Text.pack (Path.toFilePath directory) +errorToText (BadCoverSize file size) = + "Cover file " + <> toText (Path.toFilePath file) + <> " has size out of range: " + <> Cover.sizeToText size +errorToText (UnableToReadCover file err) = + "Unable to read cover file " + <> toText (Path.toFilePath file) + <> ": " + <> err +errorToText (SameTagsError tags) = + "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 -> + Disc.Disc -> + m (Either Error ()) +check InSameDir d + | isJust $ Disc.directory d = pure $ Right () + | otherwise = pure $ Left NotInSameDir +check (HaveCover cover@Cover {..}) d + | Just dir <- Disc.directory d = runExceptT $ do + let absFiles = (dir ) <$> coPaths + + coverFile <- + maybeToExceptT (MissingCover dir) $ + MaybeT $ + Monad.findM Path.doesFileExist (toList absFiles) + -- Reading the image is very slow, so only do it if we have size + -- constraints + when (Cover.haveRange cover) $ do + picture <- + Except.withExceptT (UnableToReadCover coverFile . toText) $ + ExceptT $ + readImage coverFile + + let size = Cover.pictureSize picture + unless (Cover.withinRange cover size) $ + Except.throwE $ + BadCoverSize coverFile size + | otherwise = pure $ Left NotInSameDir + where + readImage = liftIO . Picture.readImage . Path.toFilePath +check (SameTags tagsToCheck) d = pure $ case checkedTags of + [] -> Right () + (tag : tags) -> Left (SameTagsError (tag :| tags)) + where + 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 (Disc.tracks d) + sequential list = and $ zipWith (==) (sort list) [1 ..] diff --git a/lib/Commands.hs b/lib/Commands.hs index 3ac2f0e..e3ce51b 100644 --- a/lib/Commands.hs +++ b/lib/Commands.hs @@ -2,6 +2,7 @@ module Commands ( getTags, setTags, checkTrack, + checkDisc, checkAlbum, checkArtist, FixFilePathsOptions (..), @@ -14,12 +15,14 @@ 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 Model.SetTags qualified as SetTags import Path (()) import Path qualified import Path.IO qualified as Path @@ -44,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 @@ -70,28 +73,45 @@ 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 = "" +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 7f01416..1af5c4c 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -7,6 +7,7 @@ module Config Checks (..), Filename (..), FixPaths (..), + AllChecks (..), haveChecks, readConfig, createConfig, @@ -19,6 +20,7 @@ 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 +82,19 @@ 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 + 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), - -- | The tracks of the album have sequential track numbers - chAlbumTracksSequential :: Bool, -- | All the tracks from the artist have the same genre chArtistSameGenre :: Maybe Artist.Check } @@ -100,10 +106,12 @@ haveChecks (Checks {..}) = [ isJust chTrackTags, isJust chTrackGenreAmong, chTrackFilename, - isJust chAlbumHaveCover, - chAlbumSameDir, + isJust chDiscHaveCover, + chDiscSameDir, + isJust chDiscSameTags, + chDiscTracksSequential, + chAlbumDiscsSequential, isJust chAlbumSameTags, - chAlbumTracksSequential, isJust chArtistSameGenre ] @@ -117,19 +125,33 @@ trackChecks pattern formatting Checks {..} = else Just $ Track.FilenameMatches pattern formatting ] +discChecks :: Checks -> [Disc.Check] +discChecks (Checks {..}) = + catMaybes + [ Disc.HaveCover <$> chDiscHaveCover, + guarded (const chDiscSameDir) Disc.InSameDir, + Disc.SameTags <$> chDiscSameTags, + guarded (const chDiscTracksSequential) Disc.TracksSequential + ] + albumChecks :: Checks -> [Album.Check] albumChecks (Checks {..}) = catMaybes - [ Album.HaveCover <$> chAlbumHaveCover, - guarded (const chAlbumSameDir) Album.InSameDir, - Album.SameTags <$> chAlbumSameTags, - guarded (const chAlbumTracksSequential) Album.TracksSequential + [ guarded (const chAlbumDiscsSequential) Album.DiscsSequential, + Album.SameTags <$> chAlbumSameTags ] artistCheck :: Checks -> Maybe Artist.Check artistCheck (Checks {..}) = chArtistSameGenre -factorChecks :: Config -> ([Track.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 @@ -137,12 +159,14 @@ factorChecks' :: Pattern.Pattern -> Pattern.Formatting -> Checks -> - ([Track.Check], [Album.Check], Maybe Artist.Check) + AllChecks factorChecks' pattern formatting checks = - ( trackChecks pattern formatting 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 @@ -242,17 +266,21 @@ checksC = <$> maybeValidatedC "track_tags" tagsC chTrackTags <*> maybeValidatedC "track_genre" amongC chTrackGenreAmong <*> trackFilenameC .= chTrackFilename - <*> maybeValidatedC "album_cover" albumHaveCoverC chAlbumHaveCover - <*> albumSameDirC .= chAlbumSameDir + <*> maybeValidatedC "disc_cover" discHaveCoverC chDiscHaveCover + <*> discSameDirC .= chDiscSameDir + <*> maybeValidatedC "disc_tags" tagsC chDiscSameTags + <*> discTracksSequentialC .= chDiscTracksSequential + <*> albumDiscsSequentialC .= chAlbumDiscsSequential <*> maybeValidatedC "album_tags" tagsC chAlbumSameTags - <*> albumTracksSequentialC .= chAlbumTracksSequential <*> 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" + albumDiscsSequentialC = + Toml.table (Toml.bool "enable") "album_discs_sequential" artistSameGenreC = Toml.diwrap $ Toml.map @@ -260,7 +288,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 index dea209f..3e8051f 100644 --- a/lib/Model/Album.hs +++ b/lib/Model/Album.hs @@ -1,100 +1,72 @@ module Model.Album ( Album, mkAlbum, - addTrack, - tracks, - artist, + addDisc, + discs, + years, album, + artist, albumArtist, albumArtistOrArtist, - disc, - directory, - haveSameTag, haveSameTag', ) where +import Data.List.Extra qualified as List import Data.List.NonEmpty ((<|)) -import Model.AudioTrack qualified as AudioTrack +import Data.Text qualified as Text +import Model.Disc qualified as Disc 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) +newtype Album = Album (NonEmpty Disc.Disc) 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' +mkAlbum :: NonEmpty Disc.Disc -> Maybe Album +mkAlbum discs'@(firstDisc :| otherDiscs) + | allSameAlbum && allSameAlbumArtistOrArtist = + Just $ + Album $ + NonEmpty.sortOn (fmap HTagLib.unDiscNumber . Disc.disc) discs' | 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 + 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 -addTrack :: AudioTrack.AudioTrack -> Album -> Maybe Album -addTrack track (Album tracks') = mkAlbum (track <| tracks') +addDisc :: Disc.Disc -> Album -> Maybe Album +addDisc d (Album discs') = mkAlbum (d <| discs') -tracks :: Album -> NonEmpty AudioTrack.AudioTrack -tracks (Album tracks') = tracks' +discs :: Album -> NonEmpty Disc.Disc +discs (Album discs') = discs' -albumArtistOrArtist :: Album -> HTagLib.AlbumArtistOrArtist -albumArtistOrArtist (Album (track :| _)) = AudioTrack.albumArtistOrArtist track +years :: Album -> [HTagLib.Year] +years (Album discs') = List.nubSort $ foldMap Disc.years $ toList discs' + +album :: Album -> HTagLib.Album +album (Album (d :| _)) = Disc.album d artist :: Album -> HTagLib.Artist -artist (Album (track :| _)) = AudioTrack.atArtist track +artist (Album (d :| _)) = Disc.artist d albumArtist :: Album -> HTagLib.AlbumArtist -albumArtist (Album (track :| _)) = AudioTrack.atAlbumArtist track - -disc :: Album -> Maybe HTagLib.DiscNumber -disc (Album (track :| _)) = AudioTrack.atDisc track +albumArtist (Album (d :| _)) = Disc.albumArtist d -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' +albumArtistOrArtist :: Album -> HTagLib.AlbumArtistOrArtist +albumArtistOrArtist (Album (d :| _)) = Disc.albumArtistOrArtist d haveSameTag' :: Album -> Tag.Tag -> Maybe Tag.Tag -haveSameTag' album' = guarded (not . haveSameTag album') +haveSameTag' a = guarded (not . haveSameTag a) 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' +haveSameTag (Album discs') tag = all (`Disc.haveSameTag` tag) discs' diff --git a/lib/Model/Artist.hs b/lib/Model/Artist.hs index b234d0f..9fdf6d1 100644 --- a/lib/Model/Artist.hs +++ b/lib/Model/Artist.hs @@ -17,27 +17,26 @@ 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 + 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 album (Artist albums') = mkArtist (album <| albums') +addAlbum a (Artist albums') = mkArtist (a <| albums') albumArtistOrArtist :: Artist -> HTagLib.AlbumArtistOrArtist -albumArtistOrArtist (Artist (album :| _)) = Album.albumArtistOrArtist album +albumArtistOrArtist (Artist (a :| _)) = Album.albumArtistOrArtist a albums :: Artist -> NonEmpty Album.Album albums (Artist albums') = albums' 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/Disc.hs b/lib/Model/Disc.hs new file mode 100644 index 0000000..1d3fffb --- /dev/null +++ b/lib/Model/Disc.hs @@ -0,0 +1,111 @@ +module Model.Disc + ( Disc, + mkDisc, + addTrack, + tracks, + years, + genres, + artist, + album, + albumArtist, + albumArtistOrArtist, + disc, + directory, + haveSameTag, + haveSameTag', + ) +where + +import Data.List.Extra qualified as List +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 && allSameAlbumArtistOrArtist = + Just $ + Disc $ + NonEmpty.sortOn + (fmap HTagLib.unTrackNumber . AudioTrack.atTrack) + 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 + allSameAlbumArtistOrArtist = + if AudioTrack.haveTag Tag.AlbumArtist firstTrack + then allSameAlbumArtist + else allSameArtist + +addTrack :: AudioTrack.AudioTrack -> Disc -> Maybe Disc +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 + +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 + +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') + | 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/lib/Model/SetTagsOptions.hs b/lib/Model/SetTags.hs similarity index 70% rename from lib/Model/SetTagsOptions.hs rename to lib/Model/SetTags.hs index 180978d..45e550a 100644 --- a/lib/Model/SetTagsOptions.hs +++ b/lib/Model/SetTags.hs @@ -1,7 +1,6 @@ -module Model.SetTagsOptions - ( SetTagsOptions (..), +module Model.SetTags + ( SetTags (..), SetOrRemove (..), - noSetTagsOptions, setter, ) where @@ -12,7 +11,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,21 +23,8 @@ data SetTagsOptions = SetTagsOptions } deriving (Show) -noSetTagsOptions :: SetTagsOptions -noSetTagsOptions = - SetTagsOptions - { seTitle = Nothing, - seArtist = Nothing, - seAlbum = Nothing, - seAlbumArtist = Nothing, - seGenre = Nothing, - seYear = Nothing, - seTrack = Nothing, - seDisc = Nothing - } - -setter :: SetTagsOptions -> HTagLib.TagSetter -setter SetTagsOptions {..} = +setter :: SetTags -> HTagLib.TagSetter +setter SetTags {..} = fold $ catMaybes [ HTagLib.titleSetter <$> seTitle, diff --git a/lib/MusicBrainz.hs b/lib/MusicBrainz.hs new file mode 100644 index 0000000..e45f584 --- /dev/null +++ b/lib/MusicBrainz.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE QuasiQuotes #-} + +module MusicBrainz + ( Error (..), + errorToText, + search, + searchAlbum, + searchId, + setTags, + tagAlbum, + ) +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 +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.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 +import UnliftIO.Exception qualified as Exception + +data Error + = MismatchedMediaCount + | MismatchedTrackCount Int + deriving (Eq, 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 {..}) = + audioTrack + { AudioTrack.atTitle = HTagLib.mkTitle trTitle, + 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 trArtistCredit + 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 = + search maxResults (Album.albumArtist album) (Album.album album) (Just album) + +search :: + Int -> HTagLib.AlbumArtist -> HTagLib.Album -> Maybe Album.Album -> IO () +search maxResults albumArtist album mbLocalAlbum = do + putTextLn [i|Searching: "#{albumArtistText}" - "#{albumText}"|] + putTextLn "" + + releases <- Req.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 <- Req.lookupRelease $ MusicBrainz.reId release + displayRelease idx detail mbLocalAlbum + where + albumArtistText = HTagLib.unAlbumArtist albumArtist + albumText = HTagLib.unAlbum album + +searchId :: UUID.UUID -> Maybe Album.Album -> IO () +searchId releaseId mbLocalAlbum = do + detail <- Req.lookupRelease releaseId + displayRelease 1 detail mbLocalAlbum + +displayRelease :: + Int -> + MusicBrainz.ReleaseDetail -> + Maybe Album.Album -> + IO () +displayRelease idx detail@(MusicBrainz.ReleaseDetail {..}) mbAlbum = do + putTextLn + [__i| + #{idx}. ID: #{rdId} #{overallSuffix} + Artist: #{artist} #{artistSuffix} + Album: #{rdTitle} #{titleSuffix} + Year: #{year} #{yearSuffix} + Discs: #{mediaCount} #{mediaCountSuffix} + Tracks: #{trackCount} #{trackCountSuffix} + |] + putTextLn "" + + traverse_ (uncurry displayMedia) mediaAndDiscs + where + 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 rdArtistCredit + localArtist = HTagLib.unAlbumArtist . Album.albumArtist <$> mbAlbum + artistSuffix = orMempty (similaritySuffix artist) localArtist + + localTitle = HTagLib.unAlbum . Album.album <$> mbAlbum + titleSuffix = orMempty (similaritySuffix rdTitle) localTitle + + year :: Text + year = maybe "unknown" show rdDate + localYears = orMempty (fmap HTagLib.unYear . Album.years) mbAlbum + yearSuffix + | null localYears || localYears == maybeToList rdDate = "" + | otherwise = inParens $ Text.intercalate ", " $ show <$> localYears + + localDiscCount = length . Album.discs <$> mbAlbum + mediaCount = length medias + mediaCountSuffix = orMempty (showIfDifferent mediaCount) localDiscCount + + trackCount = + sum $ length . MusicBrainz.meTracks <$> medias + localTrackCount = length . (Disc.tracks <=< Album.discs) <$> mbAlbum + trackCountSuffix = orMempty (showIfDifferent trackCount) localTrackCount + +displayMedia :: MusicBrainz.Media -> Maybe Disc.Disc -> IO () +displayMedia media@MusicBrainz.Media {..} mDisc = do + putTextLn [i| Disc #{mePosition}: #{discSimilarity}Tracks: #{trackCount} #{trackCountSuffix}|] + putTextLn "" + + forM_ tracksAndLocalTracks $ \(MusicBrainz.Track {..}, mLocalTitle) -> do + let trackSuffix = + orMempty + (similaritySuffix trTitle) + mLocalTitle + title = trTitle + putTextLn [i| #{trPosition}. #{title} #{trackSuffix}|] + + putTextLn "" + where + tracks = toList meTracks + tracksAndLocalTracks = zip tracks $ localTitles <> repeat Nothing + + discSimilarity = + orMempty + ( (<> " - ") + . inParens + . (percentage . Average.toDouble . Similarity.mediaAndDisc 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.text 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 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..82d5a64 --- /dev/null +++ b/lib/MusicBrainz/Req.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE QuasiQuotes #-} + +module MusicBrainz.Req + ( lookupRelease, + searchReleases, + ) +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 ((/:), (=:)) +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 :: UUID.UUID -> IO MusicBrainz.ReleaseDetail +lookupRelease releaseId = do + response <- + Req.runReq Req.defaultHttpConfig $ + Req.req + Req.GET + (baseUrl /: "release" /: UUID.toText releaseId) + 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..024854f --- /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 (NonEmpty.zipWith text localTracks tracks), + avCount = max (length localTracks) (length tracks) + } + where + tracks = MusicBrainz.trTitle <$> meTracks + localTracks = + 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..cfdc679 --- /dev/null +++ b/lib/MusicBrainz/Types.hs @@ -0,0 +1,117 @@ +module MusicBrainz.Types + ( ArtistCredit (..), + Media (..), + Release (..), + ReleaseDetail (..), + SearchResponse (..), + Track (..), + artistCreditToText, + ) +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, + acJoinphrase :: Maybe Text + } + deriving (Show, Eq) + +-- | A release from MusicBrainz search results +data Release = Release + { reId :: UUID.UUID, + 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) + +-- | A track from MusicBrainz release lookup +data Track = Track + { trPosition :: Int, + trTitle :: Text, + trArtistCredit :: NonEmpty ArtistCredit + } + 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" + trTitle <- o .: "title" + trArtistCredit <- o .: "artist-credit" + pure Track {..} + +parseDate :: Text -> Maybe Int +parseDate = readMaybe . toString . Text.take 4 + +artistCreditToText :: NonEmpty ArtistCredit -> Text +artistCreditToText = + foldMap (\ArtistCredit {..} -> acName <> fromMaybe "" acJoinphrase) diff --git a/tests/Main.hs b/tests/Main.hs index e2b375a..da61ccc 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -3,24 +3,36 @@ 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 +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 +import Tests.MusicBrainz.Types qualified as MusicBrainz.Types main :: IO () 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.Album.test, - Check.Artist.test, - Check.Track.test + MusicBrainz.Types.test, + MusicBrainz.test ] diff --git a/tests/Tests/Check/Album.hs b/tests/Tests/Check/Album.hs index 7bcee49..5ef6976 100644 --- a/tests/Tests/Check/Album.hs +++ b/tests/Tests/Check/Album.hs @@ -3,17 +3,16 @@ module Tests.Check.Album (test) where import Check.Album qualified as Album -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 (absdir, ()) import Path qualified -import Path.IO qualified as Path +import Relude.Unsafe qualified as Unsafe import Sound.HTagLib qualified as HTagLib -import Test.Hspec.Expectations (shouldBe, shouldSatisfy) +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 @@ -22,121 +21,79 @@ test :: Tasty.TestTree test = Tasty.testGroup "Check.Album" - [ testCheckCover, - testCheckDirectory, - testCheckSameTags, - testCheckSequential + [ testCheckDiscsSequential, + testCheckSameTags ] -testCheckCover :: Tasty.TestTree -testCheckCover = +testCheckDiscsSequential :: Tasty.TestTree +testCheckDiscsSequential = Tasty.testGroup - "check cover" - [ Tasty.testCase "check an album 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" $ - Common.withTenTracksFiles $ - \dir album -> do - let coverFile = [relfile|./data/cover.png|] - Path.copyFile coverFile $ dir Path.filename coverFile - - result <- Album.check (Album.HaveCover coverNoSize) album - result `shouldBe` Right (), - Tasty.testCase "check an album with a cover.png but too small" $ - Common.withTenTracksFiles $ - \dir album -> do - let coverFile = [relfile|./data/cover.png|] - Path.copyFile coverFile $ dir Path.filename coverFile - - result <- Album.check (Album.HaveCover coverTooSmall) album - result `shouldSatisfy` isBadCoverSize, - Tasty.testCase "check an album with a cover.png but too big" $ - Common.withTenTracksFiles $ - \dir album -> do - let coverFile = [relfile|./data/cover.png|] - Path.copyFile coverFile $ dir Path.filename coverFile - - result <- Album.check (Album.HaveCover coverTooBig) album - result `shouldSatisfy` isBadCoverSize - ] - where - isBadCoverSize (Left (Album.BadCoverSize _ _)) = True - isBadCoverSize _ = False - coverNoSize = - Album.Cover - { Album.coPaths = covers, - Album.coMinSize = Nothing, - Album.coMaxSize = Nothing - } - coverTooSmall = - Album.Cover - { Album.coPaths = covers, - Album.coMinSize = Just (Album.Size 200 200), - Album.coMaxSize = Nothing - } - coverTooBig = - Album.Cover - { Album.coPaths = covers, - Album.coMinSize = Nothing, - Album.coMaxSize = Just (Album.Size 50 50) - } - covers = fromList [[relfile|cover.jpg|], [relfile|cover.png|]] - -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 - result `shouldBe` Right (), - Tasty.testCase "an album is in multiple directories" $ do - let album = Common.tenTracksAlbum - tracksDir = Maybe.fromJust $ Album.directory album - otherDir = Path.parent tracksDir [reldir|other|] - (firstHalf, secondHalf) = NonEmpty.splitAt 5 (Album.tracks album) - secondHalfMoved = moveTo otherDir <$> secondHalf - album' = - Maybe.fromJust $ - Album.mkAlbum (fromList $ firstHalf <> secondHalfMoved) - result <- Album.check Album.InSameDir album' - result `shouldBe` Left Album.NotInSameDir + "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 - moveTo newDir track = - track - { AudioTrack.atFile = newDir Path.filename (AudioTrack.atFile track) - } + 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 have the same tags" $ do - result <- Album.check (Album.SameTags commonTags) Common.tenTracksAlbum - 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]) + [ 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]) ] - where - commonTags = fromList [Tag.Genre, Tag.Year, Tag.Artist, Tag.AlbumArtist] -testCheckSequential :: Tasty.TestTree -testCheckSequential = - Tasty.testGroup - "check sequential tracks" - [ Tasty.testCase "the tracks are sequential" $ do - result <- Album.check Album.TracksSequential Common.tenTracksAlbum - result `shouldBe` Right (), - Tasty.testCase "there are two tracks number 10" $ do - let (track :| tracks) = Album.tracks Common.tenTracksAlbum - 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 - ] +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 diff --git a/tests/Tests/Check/Artist.hs b/tests/Tests/Check/Artist.hs index 82e8317..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 @@ -50,7 +51,10 @@ test = `shouldBe` Right () ] where - tenTracksAlbum = Common.tenTracksAlbum' [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] diff --git a/tests/Tests/Check/Disc.hs b/tests/Tests/Check/Disc.hs new file mode 100644 index 0000000..98e0f62 --- /dev/null +++ b/tests/Tests/Check/Disc.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Tests.Check.Disc (test) where + +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.AudioTrack qualified as AudioTrack +import Model.Disc qualified as Disc +import Model.Tag qualified as Tag +import Path (reldir, relfile, ()) +import Path qualified +import Path.IO qualified as Path +import Sound.HTagLib 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 + "Check.Disc" + [ testCheckCover, + testCheckDirectory, + testCheckSameTags, + testCheckSequential + ] + +testCheckCover :: Tasty.TestTree +testCheckCover = + Tasty.testGroup + "check cover" + [ Tasty.testCase "check a disc without a cover.png" $ + Common.withTenTracksFiles $ + \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 disc -> do + let coverFile = [relfile|./data/cover.png|] + Path.copyFile coverFile $ dir Path.filename coverFile + + result <- Disc.check (Disc.HaveCover coverNoSize) disc + result `shouldBe` Right (), + Tasty.testCase "check a disc with a cover.png but too small" $ + Common.withTenTracksFiles $ + \dir disc -> do + let coverFile = [relfile|./data/cover.png|] + Path.copyFile coverFile $ dir Path.filename coverFile + + result <- Disc.check (Disc.HaveCover coverTooSmall) disc + result `shouldSatisfy` isBadCoverSize, + Tasty.testCase "check a disc with a cover.png but too big" $ + Common.withTenTracksFiles $ + \dir disc -> do + let coverFile = [relfile|./data/cover.png|] + Path.copyFile coverFile $ dir Path.filename coverFile + + result <- Disc.check (Disc.HaveCover coverTooBig) disc + result `shouldSatisfy` isBadCoverSize + ] + where + isBadCoverSize (Left (Disc.BadCoverSize _ _)) = True + isBadCoverSize _ = False + coverNoSize = + Disc.Cover + { Disc.coPaths = covers, + Disc.coMinSize = Nothing, + Disc.coMaxSize = Nothing + } + coverTooSmall = + Disc.Cover + { Disc.coPaths = covers, + Disc.coMinSize = Just (Disc.Size 200 200), + Disc.coMaxSize = Nothing + } + coverTooBig = + Disc.Cover + { Disc.coPaths = covers, + Disc.coMinSize = Nothing, + Disc.coMaxSize = Just (Disc.Size 50 50) + } + covers = fromList [[relfile|cover.jpg|], [relfile|cover.png|]] + +testCheckDirectory :: Tasty.TestTree +testCheckDirectory = + Tasty.testGroup + "check directory" + [ Tasty.testCase "a disc is in a single directory" $ do + result <- Disc.check Disc.InSameDir Common.tenTracksDisc + result `shouldBe` Right (), + 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 (Disc.tracks d) + secondHalfMoved = moveTo otherDir <$> secondHalf + d' = + Maybe.fromJust $ + Disc.mkDisc (fromList $ firstHalf <> secondHalfMoved) + result <- Disc.check Disc.InSameDir d' + result `shouldBe` Left Disc.NotInSameDir + ] + where + moveTo newDir track = + track + { AudioTrack.atFile = newDir Path.filename (AudioTrack.atFile track) + } + +testCheckSameTags :: Tasty.TestTree +testCheckSameTags = + Tasty.testGroup + "check same tags" + [ Tasty.testCase "all tracks have the same tags" $ do + result <- Disc.check (Disc.SameTags commonTags) Common.tenTracksDisc + result `shouldBe` Right (), + Tasty.testCase "some tracks have a different tag" $ do + 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] + +testCheckSequential :: Tasty.TestTree +testCheckSequential = + Tasty.testGroup + "check sequential tracks" + [ Tasty.testCase "the tracks are sequential" $ do + result <- Disc.check Disc.TracksSequential Common.tenTracksDisc + result `shouldBe` Right (), + Tasty.testCase "there are two tracks number 10" $ do + let (track :| tracks) = Disc.tracks Common.tenTracksDisc + otherTen = track {AudioTrack.atTrack = HTagLib.mkTrackNumber 10} + tracks' = otherTen :| tracks + 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 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 diff --git a/tests/Tests/MusicBrainz.hs b/tests/Tests/MusicBrainz.hs new file mode 100644 index 0000000..34ca6bd --- /dev/null +++ b/tests/Tests/MusicBrainz.hs @@ -0,0 +1,82 @@ +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.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 new file mode 100644 index 0000000..747e973 --- /dev/null +++ b/tests/Tests/MusicBrainz/Types.hs @@ -0,0 +1,107 @@ +module Tests.MusicBrainz.Types (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 + +test :: Tasty.TestTree +test = Tasty.testGroup "MusicBrainz.Types" [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 = + Unsafe.fromJust $ + UUID.fromString "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 = + 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, + 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.trTitle = title, + MusicBrainz.trArtistCredit = mkArtistCredit "Fugazi" + }