Push qulnznkuuxlp

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].

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 $

cabal.project

@@ -0,0 +1,2 @@
+packages: .
+multi-repl: true

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]
 

htagcli.cabal

@@ -9,6 +9,7 @@ common defaults
   default-language: GHC2021
   ghc-options:
     -Wall
+    -Werror
     -Wcompat
     -Widentities
     -Wincomplete-record-updates

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)
 

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

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|]])
     }