diff --git a/htagcli.cabal b/htagcli.cabal index c8218ec..dcd8414 100644 --- a/htagcli.cabal +++ b/htagcli.cabal @@ -55,6 +55,7 @@ library Check.Track Commands Commands.FileSystem + Commands.Printer Config Data.List.NonEmpty.Extra Model.Album diff --git a/lib/Commands.hs b/lib/Commands.hs index b935b72..92c7fd6 100644 --- a/lib/Commands.hs +++ b/lib/Commands.hs @@ -8,6 +8,7 @@ module Commands checkArtist, FixFilePathsOptions (..), withFixFilePath, + withFixFilePathSilent, Error (..), errorToText, ) @@ -22,6 +23,7 @@ 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 Commands.Printer qualified as Printer import Data.List qualified as List import Model.Album qualified as Album import Model.Artist qualified as Artist @@ -157,15 +159,17 @@ data FixFilePathsOptions = FixFilePathsOptions deriving (Show) fixFilePath :: - (ex :> es, fs :> es) => + (ex :> es, fs :> es, pr :> es) => Bluefin.Exception Error ex -> FileSystem.FileSystem fs -> + Printer.Printer pr -> FixFilePathsOptions -> AudioTrack.AudioTrack -> Bluefin.Eff es () fixFilePath ex fileSystem + printer FixFilePathsOptions {..} track = do let fromFile = AudioTrack.atFile track @@ -180,7 +184,7 @@ fixFilePath TargetFileAlreadyExists toFileAbs FileSystem.ensureDir fileSystem $ Path.parent toFileAbs - FileSystem.printLine fileSystem $ + Printer.printLine printer $ fromString (Path.toFilePath fromFile) <> " -> " <> fromString (Path.toFilePath toFileAbs) @@ -192,29 +196,53 @@ fixFilePath whenM (FileSystem.doesFileExist fileSystem (parentDir cover)) $ do let coverFrom = parentDir cover coverTo = Path.parent toFileAbs cover - FileSystem.printLine fileSystem $ + Printer.printLine printer $ fromString (Path.toFilePath coverFrom) <> " -> " <> fromString (Path.toFilePath coverTo) FileSystem.renameFile fileSystem coverFrom coverTo - FileSystem.removeDirAndParentsIfEmpty fileSystem parentDir + FileSystem.removeDirAndParentsIfEmpty fileSystem printer 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 +withFixFilePath = withFixFilePath' False + +withFixFilePathSilent :: + Bool -> + ((FixFilePathsOptions -> AudioTrack.AudioTrack -> IO ()) -> IO r) -> + IO r +withFixFilePathSilent = withFixFilePath' True + +withFixFilePath' :: + Bool -> + Bool -> + ((FixFilePathsOptions -> AudioTrack.AudioTrack -> IO ()) -> IO r) -> + IO r +withFixFilePath' quiet dryRun cont = + Bluefin.runEff_ $ \io -> + withFileSystem io $ \fs -> + withPrinter io $ \pr -> + Bluefin.withEffToIO_ io $ \toIO -> + cont $ \opts track -> do + result <- toIO $ Bluefin.try $ \ex -> fixFilePath ex fs pr opts track + either Exception.throwIO pure result where - withFs :: + withFileSystem :: (io :> es) => Bluefin.IOE io -> (forall e. FileSystem.FileSystem e -> Bluefin.Eff (e :& es) r') -> Bluefin.Eff es r' - withFs + withFileSystem | dryRun = FileSystem.withOverlayFileSystem | otherwise = FileSystem.withRealFileSystem + withPrinter :: + (io :> es) => + Bluefin.IOE io -> + (forall e. Printer.Printer e -> Bluefin.Eff (e :& es) r') -> + Bluefin.Eff es r' + withPrinter + | quiet = \_ action -> Printer.withSilentPrinter action + | otherwise = Printer.withStdoutPrinter diff --git a/lib/Commands/FileSystem.hs b/lib/Commands/FileSystem.hs index dff8ed8..2c4c726 100644 --- a/lib/Commands/FileSystem.hs +++ b/lib/Commands/FileSystem.hs @@ -10,7 +10,6 @@ module Commands.FileSystem renameFile, isDirEmpty, removeDir, - printLine, removeDirAndParentsIfEmpty, ) where @@ -20,6 +19,7 @@ import Bluefin.Eff ((:&), (:>)) import Bluefin.Eff qualified as Bluefin import Bluefin.IO qualified as Bluefin import Bluefin.State qualified as Bluefin +import Commands.Printer qualified as Printer import Data.Set qualified as Set import Path qualified import Path.IO qualified as Path @@ -41,10 +41,7 @@ data FileSystem (es :: Bluefin.Effects) = MkFileSystem Path.Path Path.Abs Path.Dir -> Bluefin.Eff (e :& es) Bool, fiRemoveDirImpl :: forall e. - Path.Path Path.Abs Path.Dir -> Bluefin.Eff (e :& es) (), - fiPrintLineImpl :: - forall e. - Text -> Bluefin.Eff (e :& es) () + Path.Path Path.Abs Path.Dir -> Bluefin.Eff (e :& es) () } instance Bluefin.Handle FileSystem where @@ -55,8 +52,7 @@ instance Bluefin.Handle FileSystem where fiRenameFileImpl = \from to -> Bluefin.useImplUnder $ fiRenameFileImpl from to, fiIsDirEmptyImpl = Bluefin.useImplUnder . fiIsDirEmptyImpl, - fiRemoveDirImpl = Bluefin.useImplUnder . fiRemoveDirImpl, - fiPrintLineImpl = Bluefin.useImplUnder . fiPrintLineImpl + fiRemoveDirImpl = Bluefin.useImplUnder . fiRemoveDirImpl } doesFileExist :: @@ -96,13 +92,6 @@ removeDir :: Bluefin.Eff es () removeDir fs = Bluefin.makeOp . fiRemoveDirImpl (Bluefin.mapHandle fs) -printLine :: - (e :> es) => - FileSystem e -> - Text -> - Bluefin.Eff es () -printLine fs = Bluefin.makeOp . fiPrintLineImpl (Bluefin.mapHandle fs) - withRealFileSystem :: (io :> es) => Bluefin.IOE io -> @@ -117,7 +106,6 @@ withRealFileSystem ioe action = Bluefin.useImplIn action MkFileSystem {..} (dirs, files) <- Path.listDir dir pure $ null dirs && null files fiRemoveDirImpl = Bluefin.effIO ioe . Path.removeDir - fiPrintLineImpl = Bluefin.effIO ioe . putTextLn data Overlay = Overlay { ovAdded :: Set.Set (Path.Path Path.Abs Path.File), @@ -160,18 +148,18 @@ withOverlayFileSystem ioe action = overlay { ovDeletedDirs = Set.insert dir $ ovDeletedDirs overlay } - fiPrintLineImpl = Bluefin.effIO ioe . putTextLn Bluefin.useImplIn action MkFileSystem {..} removeDirAndParentsIfEmpty :: - (e :> es) => - FileSystem e -> + (fs :> es, pr :> es) => + FileSystem fs -> + Printer.Printer pr -> Path.Path Path.Abs Path.Dir -> Bluefin.Eff es () -removeDirAndParentsIfEmpty fs dir = +removeDirAndParentsIfEmpty fs pr dir = whenM (isDirEmpty fs dir) $ do - printLine fs $ fromString (Path.toFilePath dir) <> " (deleted)" + Printer.printLine pr $ fromString (Path.toFilePath dir) <> " (deleted)" removeDir fs dir let parent = Path.parent dir - when (parent /= dir) $ removeDirAndParentsIfEmpty fs parent + when (parent /= dir) $ removeDirAndParentsIfEmpty fs pr parent diff --git a/lib/Commands/Printer.hs b/lib/Commands/Printer.hs new file mode 100644 index 0000000..b1c1460 --- /dev/null +++ b/lib/Commands/Printer.hs @@ -0,0 +1,40 @@ +module Commands.Printer + ( Printer, + printLine, + withStdoutPrinter, + withSilentPrinter, + ) +where + +import Bluefin.Compound qualified as Bluefin +import Bluefin.Eff ((:&), (:>)) +import Bluefin.Eff qualified as Bluefin +import Bluefin.IO qualified as Bluefin + +newtype Printer (es :: Bluefin.Effects) = MkPrinter + {prPrintLineImpl :: forall e. Text -> Bluefin.Eff (e :& es) ()} + +instance Bluefin.Handle Printer where + mapHandle MkPrinter {..} = + MkPrinter {prPrintLineImpl = Bluefin.useImplUnder . prPrintLineImpl} + +printLine :: (e :> es) => Printer e -> Text -> Bluefin.Eff es () +printLine pr = Bluefin.makeOp . prPrintLineImpl (Bluefin.mapHandle pr) + +withStdoutPrinter :: + (io :> es) => + Bluefin.IOE io -> + (forall e. Printer e -> Bluefin.Eff (e :& es) r) -> + Bluefin.Eff es r +withStdoutPrinter ioe action = + Bluefin.useImplIn + action + MkPrinter {prPrintLineImpl = Bluefin.effIO ioe . putTextLn} + +withSilentPrinter :: + (forall e. Printer e -> Bluefin.Eff (e :& es) r) -> + Bluefin.Eff es r +withSilentPrinter action = + Bluefin.useImplIn + action + MkPrinter {prPrintLineImpl = const (pure ())} diff --git a/tests/Tests/Commands.hs b/tests/Tests/Commands.hs index 91d8a36..50f167e 100644 --- a/tests/Tests/Commands.hs +++ b/tests/Tests/Commands.hs @@ -31,7 +31,7 @@ testFixFilePaths = let inputDir = dir filenamesBefore <- snd <$> Path.listDir inputDir - Commands.withFixFilePath True $ \fixPath -> + Commands.withFixFilePathSilent True $ \fixPath -> forM_ filenamesBefore $ \file -> do track <- AudioTrack.getTags file fixPath (fixFilePathsOptions False inputDir) track @@ -44,7 +44,7 @@ testFixFilePaths = let inputDir = dir [reldir|input|] filenamesInCurrentDirBefore <- snd <$> Path.listDir inputDir - Commands.withFixFilePath False $ \fixPath -> + Commands.withFixFilePathSilent False $ \fixPath -> forM_ filenamesInCurrentDirBefore $ \file -> do track <- AudioTrack.getTags file fixPath (fixFilePathsOptions False dir) track @@ -68,7 +68,7 @@ testFixFilePaths = filenamesInCurrentDirBefore <- filter (/= dummy) . snd <$> Path.listDir inputDir - Commands.withFixFilePath False $ \fixPath -> + Commands.withFixFilePathSilent False $ \fixPath -> forM_ filenamesInCurrentDirBefore $ \file -> do track <- AudioTrack.getTags file fixPath (fixFilePathsOptions False dir) track @@ -84,7 +84,7 @@ testFixFilePaths = filenamesInCurrentDirBefore <- filter (/= cover) . snd <$> Path.listDir inputDir - Commands.withFixFilePath False $ \fixPath -> + Commands.withFixFilePathSilent False $ \fixPath -> forM_ filenamesInCurrentDirBefore $ \file -> do track <- AudioTrack.getTags file fixPath (fixFilePathsOptions False dir) track @@ -105,7 +105,7 @@ testFixFilePaths = filenamesInCurrentDirBefore <- filter (/= cover) . snd <$> Path.listDir inputDir - Commands.withFixFilePath False $ \fixPath -> + Commands.withFixFilePathSilent False $ \fixPath -> forM_ filenamesInCurrentDirBefore $ \file -> do track <- AudioTrack.getTags file fixPath (fixFilePathsOptions True dir) track @@ -179,7 +179,7 @@ testTargetAlreadyExists dryRun = System.writeFile (Path.toFilePath targetFile) "" result <- Exception.try $ - Commands.withFixFilePath dryRun $ \fixPath -> + Commands.withFixFilePathSilent dryRun $ \fixPath -> fixPath opts track result `shouldBe` Left (Commands.TargetFileAlreadyExists targetFile)