Add a printer eff for tests not to write to stdout

htagcli.cabal

@@ -55,6 +55,7 @@ library
     Check.Track
     Commands
     Commands.FileSystem
+    Commands.Printer
     Config
     Data.List.NonEmpty.Extra
     Model.Album

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

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

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

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)