diff --git a/README.md b/README.md index 4af4f3e..5c3496a 100644 --- a/README.md +++ b/README.md @@ -121,6 +121,9 @@ and album. Use the `--dry-run` option to preview the planned changes without modifying any files. It’s a good idea to use it first to confirm everything looks right. +Warning: `htagcli` will remove empty directories after moving the files to +their new location. + # Hacking The project can be built with [nix]. diff --git a/app/Main.hs b/app/Main.hs index 2f70a9a..b1325ad 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,6 +8,7 @@ import Data.Either.Extra qualified as Either import Data.Text qualified as Text import Data.Text.IO qualified as Text import Model.AudioTrack qualified as AudioTrack +import Model.Cover qualified as Cover import Options qualified import Options.Applicative qualified as Options import Path.IO qualified as Path @@ -24,6 +25,7 @@ import "conduit" Conduit qualified data Error = NoCheckInConfig + | MoveCoverWithoutCheck | EditorExitError | ParseError (Megaparsec.ParseErrorBundle Text.Text Void) deriving (Show) @@ -36,6 +38,8 @@ errorToText EditorExitError = "The editor process exited with an error" 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." main :: IO () main = do @@ -125,16 +129,26 @@ main = do let total = ceTrackErrors + ceAlbumErrors + ceArtistErrors when (total > 0) $ System.exitWith $ System.ExitFailure total Options.FixFilePaths Options.FixFilePathsOptions {..} files -> do - Config.Config {coFilename = Config.Filename {..}, ..} <- Config.readConfig + Config.Config + { coFilename = Config.Filename {..}, + coFixPaths = Config.FixPaths {..}, + coChecks = Config.Checks {..} + } <- + Config.readConfig let pattern = fromMaybe fiPattern foPattern + coverImages = guard fiMoveCover *> (Cover.coPaths <$> chAlbumHaveCover) + when (fiMoveCover && isNothing chAlbumHaveCover) $ + Exception.throwIO MoveCoverWithoutCheck + -- Get the base directory from the cli and fallback to the config file - baseDir <- maybe (pure coFixPaths) Path.makeAbsolute foBaseDirectory + baseDir <- maybe (pure fiBaseDir) Path.makeAbsolute foBaseDirectory let fixFilePathOptions = Commands.FixFilePathsOptions { Commands.fiDryRun = foDryRun, Commands.fiBaseDirectory = baseDir, Commands.fiFormatting = fiFormatting, - Commands.fiPattern = pattern + Commands.fiPattern = pattern, + Commands.fiCoverImages = coverImages } ConduitUtils.runConduitWithProgress files $ diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..079a13b --- /dev/null +++ b/cabal.project @@ -0,0 +1,2 @@ +packages: . +multi-repl: true diff --git a/data/htagcli.toml b/data/htagcli.toml index e4016b2..2694147 100644 --- a/data/htagcli.toml +++ b/data/htagcli.toml @@ -58,6 +58,12 @@ 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` +# must be enabled for this to work. +# Any file that matches `checks.album_cover.filenames` in the same directory as +# the current audio file will be moved along with it. +move_cover = true + # Configuration for validation checks [checks] diff --git a/htagcli.cabal b/htagcli.cabal index cf2dbd9..ea36d64 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -9,6 +9,7 @@ common defaults default-language: GHC2021 ghc-options: -Wall + -Werror -Wcompat -Widentities -Wincomplete-record-updates diff --git a/lib/Commands.hs b/lib/Commands.hs index 6739bf3..fdf891a 100644 --- a/lib/Commands.hs +++ b/lib/Commands.hs @@ -111,7 +111,8 @@ data FixFilePathsOptions = FixFilePathsOptions { fiDryRun :: Bool, fiBaseDirectory :: Path.Path Path.Abs Path.Dir, fiFormatting :: Pattern.Formatting, - fiPattern :: Pattern.Pattern + fiPattern :: Pattern.Pattern, + fiCoverImages :: Maybe (NonEmpty (Path.Path Path.Rel Path.File)) } deriving (Show) @@ -133,8 +134,19 @@ fixFilePaths' FixFilePathsOptions {..} fromFile = do else do unless fiDryRun $ do Path.ensureDir $ Path.parent toFileAbs + Path.renameFile fromFile toFileAbs - Path.removeDirAndParentsIfEmpty $ Path.parent fromFile + + -- Move the cover if there + let parentDir = Path.parent fromFile + whenJust fiCoverImages $ \covers -> do + forM_ covers $ \cover -> do + whenM (Path.doesFileExist (parentDir cover)) $ do + Path.renameFile + (parentDir cover) + (Path.parent toFileAbs cover) + + Path.removeDirAndParentsIfEmpty parentDir pure (Just toFileAbs) diff --git a/lib/Config.hs b/lib/Config.hs index 757eb8e..7f01416 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -6,6 +6,7 @@ module Config Config (..), Checks (..), Filename (..), + FixPaths (..), haveChecks, readConfig, createConfig, @@ -48,9 +49,15 @@ data Error instance Exception.Exception Error +data FixPaths = FixPaths + { fiBaseDir :: Path.Path Path.Abs Path.Dir, + fiMoveCover :: Bool + } + deriving (Show) + data Config = Config { coFilename :: Filename, - coFixPaths :: Path.Path Path.Abs Path.Dir, + coFixPaths :: FixPaths, coChecks :: Checks } deriving (Show) @@ -197,9 +204,15 @@ configC :: Toml.TomlCodec Config configC = Config <$> Toml.table filenameC "filename" .= coFilename - <*> Toml.table (absDirC "base_dir") "fix_paths" .= coFixPaths + <*> Toml.table fixPathsC "fix_paths" .= coFixPaths <*> Toml.table checksC "checks" .= coChecks +fixPathsC :: Toml.TomlCodec FixPaths +fixPathsC = + FixPaths + <$> absDirC "base_dir" .= fiBaseDir + <*> Toml.bool "move_cover" .= fiMoveCover + absDirC :: Toml.Key -> Toml.TomlCodec (Path.Path Path.Abs Path.Dir) absDirC = Toml.textBy (toText . Path.toFilePath) parse diff --git a/tests/Tests/Commands.hs b/tests/Tests/Commands.hs index 7707823..c971ab2 100644 --- a/tests/Tests/Commands.hs +++ b/tests/Tests/Commands.hs @@ -16,6 +16,7 @@ import Model.Tag qualified as Tag import Path (reldir, relfile, ()) import Path qualified import Path.IO qualified as Path +import Relude.Unsafe qualified as Unsafe import System.IO qualified as System import Test.Hspec.Expectations (shouldBe) import Test.Tasty qualified as Tasty @@ -33,7 +34,7 @@ test = result <- traverse - (Commands.fixFilePaths' $ fixFilePathsOptions True inputDir) + (Commands.fixFilePaths' $ fixFilePathsOptions True False inputDir) filenamesBefore -- All files would be renamed @@ -48,7 +49,7 @@ test = filenamesInCurrentDirBefore <- snd <$> Path.listDir inputDir listMbPaths <- traverse - (Commands.fixFilePaths' $ fixFilePathsOptions False dir) + (Commands.fixFilePaths' $ fixFilePathsOptions False False dir) filenamesInCurrentDirBefore all isJust listMbPaths `shouldBe` True @@ -76,13 +77,53 @@ test = listMbPaths <- traverse - (Commands.fixFilePaths' $ fixFilePathsOptions False dir) + (Commands.fixFilePaths' $ fixFilePathsOptions False False dir) filenamesInCurrentDirBefore all isJust listMbPaths `shouldBe` True exists <- Path.doesDirExist inputDir - exists `shouldBe` True + exists `shouldBe` True, + Tasty.testCase "rename but dont move the cover image" $ do + Common.withTenTracksFilesInSubdir [reldir|./input|] $ \dir _ -> do + let inputDir = dir [reldir|input|] + cover = inputDir [relfile|cover.jpg|] + System.writeFile (Path.toFilePath cover) "cover image content" + + filenamesInCurrentDirBefore <- + filter (/= cover) . snd + <$> Path.listDir inputDir + + traverse_ + (Commands.fixFilePaths' $ fixFilePathsOptions False False dir) + filenamesInCurrentDirBefore + + exists <- Path.doesFileExist cover + exists `shouldBe` True, + Tasty.testCase "rename and move the cover image" $ + Common.withTenTracksFilesInSubdir [reldir|./input|] $ \dir _ -> do + let inputDir = dir [reldir|input|] + relCover = [relfile|cover.jpg|] + cover = inputDir relCover + System.writeFile (Path.toFilePath cover) "cover image content" + + filenamesInCurrentDirBefore <- + filter (/= cover) . snd + <$> Path.listDir inputDir + + listMbPaths <- + traverse + (Commands.fixFilePaths' $ fixFilePathsOptions False True dir) + filenamesInCurrentDirBefore + + oldCoverExists <- Path.doesFileExist cover + oldCoverExists `shouldBe` False + + let firstRenamedFile = Unsafe.fromJust $ asum listMbPaths + firstDir = Path.parent firstRenamedFile + + newCoverExists <- Path.doesFileExist (firstDir relCover) + newCoverExists `shouldBe` True ] check :: (MonadIO m) => Path.Path Path.Abs Path.File -> m (Either Track.Error ()) @@ -105,11 +146,12 @@ pattern = ] fixFilePathsOptions :: - Bool -> Path.Path Path.Abs Path.Dir -> Commands.FixFilePathsOptions -fixFilePathsOptions dryRun baseDir = + Bool -> Bool -> Path.Path Path.Abs Path.Dir -> Commands.FixFilePathsOptions +fixFilePathsOptions dryRun moveCover baseDir = Commands.FixFilePathsOptions { fiDryRun = dryRun, fiBaseDirectory = baseDir [reldir|output|], fiFormatting = Pattern.noFormatting, - fiPattern = pattern + fiPattern = pattern, + fiCoverImages = guard moveCover *> Just (fromList [[relfile|cover.jpg|]]) }