Print deleted dirs, covers moved with fix-paths

app/Main.hs

@@ -1,4 +1,4 @@
-module Main where
+module Main (main) where
 
 import Commands qualified
 import ConduitUtils qualified
@@ -167,16 +167,17 @@ main = do
         baseDir <- maybe (pure fiBaseDir) Path.makeAbsolute foBaseDirectory
         let fixFilePathOptions =
               Commands.FixFilePathsOptions
-                { Commands.fiDryRun = foDryRun,
-                  Commands.fiBaseDirectory = baseDir,
+                { Commands.fiBaseDirectory = baseDir,
                   Commands.fiFormatting = fiFormatting,
                   Commands.fiPattern = pattern,
                   Commands.fiCoverImages = coverImages
                 }
 
-        ConduitUtils.runConduitWithProgress files $
-          Conduit.mapM_C $
-            Commands.fixFilePaths fixFilePathOptions
+        Commands.withFixFilePath foDryRun $ \fixFilePath ->
+          ConduitUtils.runConduitWithProgress files $
+            Conduit.mapM_C $ \file -> liftIO $ do
+              track <- AudioTrack.getTags file
+              fixFilePath fixFilePathOptions track
       Options.Search options -> do
         case options of
           Options.SeSearchMany (Options.SearchMany {..}) ->

htagcli.cabal

@@ -20,6 +20,7 @@ common defaults
   default-extensions:
     DataKinds
     LambdaCase
+    MultiWayIf
     OverloadedStrings
     PackageImports
     RecordWildCards
@@ -53,6 +54,7 @@ library
     Check.Disc
     Check.Track
     Commands
+    Commands.FileSystem
     Config
     Data.List.NonEmpty.Extra
     Model.Album
@@ -68,13 +70,14 @@ library
     MusicBrainz.Req
     MusicBrainz.Similarity
     MusicBrainz.Types
-    Path.IO.Extra
     Sound.HTagLib.Extra
     Toml.Extra
 
   build-depends:
     JuicyPixels,
     aeson,
+    bluefin,
+    containers,
     extra,
     file-embed,
     filepath,
@@ -111,6 +114,7 @@ executable htagcli
 
   build-depends:
     ansi-terminal,
+    bluefin,
     conduit,
     extra,
     filepath,
@@ -157,6 +161,7 @@ test-suite tests
 
   build-depends:
     aeson,
+    bluefin,
     extra,
     hedgehog,
     hspec,

lib/Commands.hs

@@ -6,17 +6,21 @@ module Commands
     checkAlbum,
     checkArtist,
     FixFilePathsOptions (..),
-    fixFilePaths,
-    fixFilePaths',
+    withFixFilePath,
     Error (..),
     errorToText,
   )
 where
 
+import Bluefin.Eff ((:&), (:>))
+import Bluefin.Eff qualified as Bluefin
+import Bluefin.Exception qualified as Bluefin
+import Bluefin.IO qualified as Bluefin
 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 Commands.FileSystem qualified as FileSystem
 import Model.Album qualified as Album
 import Model.Artist qualified as Artist
 import Model.AudioTrack qualified as AudioTrack
@@ -25,8 +29,6 @@ import Model.Pattern qualified as Pattern
 import Model.SetTags qualified as SetTags
 import Path ((</>))
 import Path qualified
-import Path.IO qualified as Path
-import Path.IO.Extra qualified as Path
 import Sound.HTagLib qualified as HTagLib
 import Sound.HTagLib.Extra qualified as HTagLib
 import UnliftIO.Exception qualified as Exception
@@ -132,61 +134,72 @@ checkArtist (Just check) artist = do
       HTagLib.unAlbumArtistOrArtist $ Artist.albumArtistOrArtist artist
 
 data FixFilePathsOptions = FixFilePathsOptions
-  { fiDryRun :: Bool,
-    fiBaseDirectory :: Path.Path Path.Abs Path.Dir,
+  { fiBaseDirectory :: Path.Path Path.Abs Path.Dir,
     fiFormatting :: Pattern.Formatting,
     fiPattern :: Pattern.Pattern,
     fiCoverImages :: Maybe (NonEmpty (Path.Path Path.Rel Path.File))
   }
   deriving (Show)
 
--- | Version for testing that returns the new path if changed
-fixFilePaths' ::
-  (MonadIO m) =>
+fixFilePath ::
+  (ex :> es, fs :> es) =>
+  Bluefin.Exception Error ex ->
+  FileSystem.FileSystem fs ->
   FixFilePathsOptions ->
-  Path.Path Path.Abs Path.File ->
-  m (Maybe (Path.Path Path.Abs Path.File))
-fixFilePaths' FixFilePathsOptions {..} fromFile = do
-  track <- AudioTrack.getTags fromFile
-  toFile <-
-    Exception.fromEither $
-      maybeToRight (UnableToFormatFile fromFile) $
-        Pattern.toPath fiFormatting track fiPattern
-  let toFileAbs = fiBaseDirectory </> toFile
-  if toFileAbs == fromFile
-    then pure Nothing
-    else do
-      whenM (Path.doesFileExist toFileAbs) $
-        Exception.throwIO $
+  AudioTrack.AudioTrack ->
+  Bluefin.Eff es ()
+fixFilePath
+  ex
+  fileSystem
+  FixFilePathsOptions {..}
+  track = do
+    let fromFile = AudioTrack.atFile track
+    toFile <-
+      either (Bluefin.throw ex) pure $
+        maybeToRight (UnableToFormatFile fromFile) $
+          Pattern.toPath fiFormatting track fiPattern
+    let toFileAbs = fiBaseDirectory </> toFile
+    unless (toFileAbs == fromFile) $ do
+      whenM (FileSystem.doesFileExist fileSystem toFileAbs) $
+        Bluefin.throw ex $
           TargetFileAlreadyExists toFileAbs
 
-      unless fiDryRun $ do
-        Path.ensureDir $ Path.parent toFileAbs
-
-        Path.renameFile fromFile toFileAbs
-
-        -- 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)
-
-fixFilePaths ::
-  (MonadIO m) =>
-  FixFilePathsOptions ->
-  Path.Path Path.Abs Path.File ->
-  m ()
-fixFilePaths options fromFile = do
-  mbNewPath <- fixFilePaths' options fromFile
-  whenJust mbNewPath $ \toFile ->
-    putTextLn $
-      fromString (Path.toFilePath fromFile)
-        <> " -> "
-        <> fromString (Path.toFilePath toFile)
+      FileSystem.ensureDir fileSystem $ Path.parent toFileAbs
+      FileSystem.printLine fileSystem $
+        fromString (Path.toFilePath fromFile)
+          <> " -> "
+          <> fromString (Path.toFilePath toFileAbs)
+      FileSystem.renameFile fileSystem fromFile toFileAbs
+
+      let parentDir = Path.parent fromFile
+      whenJust fiCoverImages $ \covers ->
+        forM_ covers $ \cover ->
+          whenM (FileSystem.doesFileExist fileSystem (parentDir </> cover)) $ do
+            let coverFrom = parentDir </> cover
+                coverTo = Path.parent toFileAbs </> cover
+            FileSystem.printLine fileSystem $
+              fromString (Path.toFilePath coverFrom)
+                <> " -> "
+                <> fromString (Path.toFilePath coverTo)
+            FileSystem.renameFile fileSystem coverFrom coverTo
+
+      FileSystem.removeDirAndParentsIfEmpty fileSystem parentDir
+
+withFixFilePath ::
+  Bool ->
+  ((FixFilePathsOptions -> AudioTrack.AudioTrack -> IO ()) -> IO r) ->
+  IO r
+withFixFilePath dryRun cont =
+  Bluefin.runEff_ $ \io -> withFs io $ \fs -> Bluefin.withEffToIO_ io $ \toIO ->
+    cont $ \opts track -> do
+      result <- toIO $ Bluefin.try $ \ex -> fixFilePath ex fs opts track
+      either Exception.throwIO pure result
+  where
+    withFs ::
+      (io :> es) =>
+      Bluefin.IOE io ->
+      (forall e. FileSystem.FileSystem e -> Bluefin.Eff (e :& es) r') ->
+      Bluefin.Eff es r'
+    withFs
+      | dryRun = FileSystem.withOverlayFileSystem
+      | otherwise = FileSystem.withRealFileSystem