Copy instead of move during codd add to be more editor friendly

mzabani · Mar 14, 2024 · 593edfa · 593edfa
1 parent 1567a8e
commit 593edfa
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 17 deletions.
diff --git a/src/Codd/AppCommands.hs b/src/Codd/AppCommands.hs
@@ -1,5 +1,5 @@
 module Codd.AppCommands
-    ( timestampAndMoveMigrationFile
+    ( timestampAndCopyMigrationFile
     ) where
 
 import           Codd.Parsing                   ( toMigrationTimestamp )
@@ -11,27 +11,24 @@ import           System.FilePath                ( (</>)
                                                 , takeFileName
                                                 )
 import           UnliftIO                       ( MonadIO(..) )
-import           UnliftIO.Directory             ( copyFile
-                                                , removeFile
-                                                )
+import           UnliftIO.Directory             ( copyFile )
 
-timestampAndMoveMigrationFile
+timestampAndCopyMigrationFile
     :: MonadIO m => SqlFilePath -> FilePath -> m FilePath
-timestampAndMoveMigrationFile (unSqlFilePath -> migrationPath) folderToMoveTo =
+timestampAndCopyMigrationFile (unSqlFilePath -> migrationPath) folderToCopyTo =
     do
     -- The only important invariants for naming SQL migrations are:
-    --   1. Migrations added by the same developer consecutively are such that the first is alphabetically lesser than the second.
+    --   1. Migrations added by a developer is such that it should come after all existing migrations on disk
     --   2. Chance of naming conflicts with migrations added by other developers is small.
     -- One desirable property, however, is that filenames are human-readable
     -- and convey more or less an idea of when they were added.
         (migTimestamp, _) <- toMigrationTimestamp <$> liftIO getCurrentTime
         let finalName =
-                folderToMoveTo
+                folderToCopyTo
                     </> nicerTimestampFormat (iso8601Show migTimestamp)
                     ++  "-"
                     ++  takeFileName migrationPath
         copyFile migrationPath finalName
-        removeFile migrationPath
         return finalName
   where
         -- Replaces 'T' and colons by a dash and removes 'Z' from UTC timestamps.

diff --git a/src/Codd/AppCommands/AddMigration.hs b/src/Codd/AppCommands/AddMigration.hs
@@ -7,7 +7,7 @@ import qualified Codd
 import           Codd.Analysis                  ( MigrationCheck(..)
                                                 , checkMigration
                                                 )
-import           Codd.AppCommands               ( timestampAndMoveMigrationFile
+import           Codd.AppCommands               ( timestampAndCopyMigrationFile
                                                 )
 import           Codd.Environment               ( CoddSettings(..) )
 import           Codd.Internal                  ( delayedOpenStreamFile
@@ -42,8 +42,7 @@ import           UnliftIO                       ( MonadUnliftIO
                                                 , liftIO
                                                 , stderr
                                                 )
-import           UnliftIO.Directory             ( copyFile
-                                                , doesDirectoryExist
+import           UnliftIO.Directory             ( doesDirectoryExist
                                                 , doesFileExist
                                                 , removeFile
                                                 )
@@ -130,7 +129,7 @@ addMigration [email protected] { onDiskReps, migsConnString, sqlMigration
                                 (printSuggestedFirstMigration migsConnString)
                             liftIO $ exitWith $ ExitFailure 95
 
-            finalMigFile <- timestampAndMoveMigrationFile sqlFp finalDir
+            finalMigFile <- timestampAndCopyMigrationFile sqlFp finalDir
             addE         <- try $ do
                 unless dontApply $ do
                     databaseSchemas <- Codd.applyMigrationsNoCheck
@@ -152,11 +151,19 @@ addMigration [email protected] { onDiskReps, migsConnString, sqlMigration
                     $  "Migration was NOT applied, but was added to "
                     <> Text.pack finalMigFile
             case addE of
-                Right _                    -> pure ()
-                Left  (e :: SomeException) -> liftIO $ do
-                    -- Print error and move file back to its original directory
+                Right _ -> do
+                    -- Remove original file
+                    fileRemoved <- try $ removeFile (unSqlFilePath sqlFp)
+                    case fileRemoved of
+                        Left (_ :: SomeException) ->
+                            logError
+                                $  "Could not remove "
+                                <> Text.pack (show sqlFp)
+                                <> ", but it has been added successfully"
+                        Right _ -> pure ()
+                Left (e :: SomeException) -> liftIO $ do
+                    -- Print error and delete file from migrations directory
                     Text.hPutStrLn stderr $ Text.pack $ show e
-                    copyFile finalMigFile fp
                     removeFile finalMigFile
 
                     when isFirstMigration