Handle already existing files explicitly

tchoutri · Jul 7, 2024 · 8f9c77d · 8f9c77d
1 parent 5f14048
commit 8f9c77d
Show file tree

Hide file tree

Showing 4 changed files with 43 additions and 11 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -8,7 +8,9 @@ import Data.Version (showVersion)
 import Effectful
 import Effectful.Error.Static
 import Effectful.FileSystem
+import Effectful.Error.Static qualified as Error
 import Options.Applicative
+import Data.List.NonEmpty qualified as NE
 import Options.Applicative.Types
 import Paths_confer (version)
 import System.IO
@@ -101,9 +103,15 @@ runOptions (Options dryRun verbose configurationFile mArch mOs mHostname Check)
     then
       Cmd.check verbose deployments
         & runSymlinkPure Map.empty
-    else
-      Cmd.check verbose deployments
-        & runSymlinkIO
+    else do
+      result <-
+        Cmd.check verbose deployments
+          & runSymlinkIO
+          & runErrorNoCallStack
+      case result of
+        Left symlinkError -> Error.throwError (SymlinkErrors (NE.singleton symlinkError))
+        Right a -> pure a
+
 runOptions (Options dryRun verbose configurationFile mArch mOs mHostname Deploy) = do
   deploymentArch <- determineDeploymentArch verbose mArch
   deploymentOS <- determineDeploymentOS verbose mOs
@@ -112,9 +120,14 @@ runOptions (Options dryRun verbose configurationFile mArch mOs mHostname Deploy)
     then
       Cmd.deploy verbose deployments
         & runSymlinkPure Map.empty
-    else
-      Cmd.deploy verbose deployments
-        & runSymlinkIO
+    else do
+      result <-
+        Cmd.deploy verbose deployments
+          & runSymlinkIO
+          & runErrorNoCallStack
+      case result of
+        Left symlinkError -> Error.throwError (SymlinkErrors (NE.singleton symlinkError))
+        Right a -> pure a
 
 withInfo :: Parser a -> String -> ParserInfo a
 withInfo opts desc =

diff --git a/src/Confer/CLI/Cmd/Deploy.hs b/src/Confer/CLI/Cmd/Deploy.hs
@@ -35,8 +35,13 @@ deploy verbose deployments = do
     forM_ d.facts $ \fact -> do
       filepath <- liftIO $ OsPath.decodeFS fact.destination
       destinationPathExists <- FileSystem.doesPathExist filepath
-      unless destinationPathExists $ do
+      if destinationPathExists
+      then do
         liftIO $
           Text.putStrLn $
             "[🔗] " <> display fact
         createSymlink fact.source fact.destination
+      else
+       when verbose $ do
+         destination <- liftIO $ OsPath.decodeFS fact.destination
+         liftIO $ Text.putStrLn $ display destination <> "already exists "
diff --git a/src/Confer/CLI/Errors.hs b/src/Confer/CLI/Errors.hs
@@ -34,11 +34,12 @@ cliErrorToCode = \case
   NoDefaultConfigurationFile -> ErrorCode 156
   NoUserProvidedConfigurationFile{} -> ErrorCode 169
   NoDeploymentsAvailable{} -> ErrorCode 123
-  SymlinkErrors{} -> ErrorCode 192
+  SymlinkErrors{} -> ErrorCode 000
 
 symlinkErrorToCode :: SymlinkError -> ErrorCode
 symlinkErrorToCode = \case
   DoesNotExist{} -> ErrorCode 234
+  AlreadyExists{} -> ErrorCode 205
   IsNotSymlink{} -> ErrorCode 142
   WrongTarget{} -> ErrorCode 102
 
@@ -72,10 +73,17 @@ formatSymlinkError e@(DoesNotExist path) =
     <> " does not exist"
 formatSymlinkError e@(IsNotSymlink path) =
   display (symlinkErrorToCode e)
+    <> " "
     <> display (Text.pack . show $ path)
     <> " is not a symbolic link"
+formatSymlinkError e@(AlreadyExists path) =
+  display (symlinkErrorToCode e)
+    <> " "
+    <> display (Text.pack . show $ path)
+    <> " already exists"
 formatSymlinkError e@(WrongTarget linkPath expectedTarget actualTarget) =
   display (symlinkErrorToCode e)
+    <> " "
     <> display (Text.pack . show $ linkPath)
     <> " points to "
     <> display (Text.pack . show $ actualTarget)

diff --git a/src/Confer/Effect/Symlink.hs b/src/Confer/Effect/Symlink.hs
@@ -30,7 +30,10 @@ import System.OsPath qualified as OsPath
 
 data SymlinkError
   = DoesNotExist OsPath
+    -- ^ The expected path is not present
   | IsNotSymlink OsPath
+  | AlreadyExists OsPath
+    -- ^ The path is unexpectedly present
   | WrongTarget
       OsPath
       -- ^ Path to the symbolic link
@@ -62,7 +65,7 @@ testSymlink linkPath expectedLinkTarget =
   send (TestSymlink linkPath expectedLinkTarget)
 
 runSymlinkIO
-  :: (IOE :> es, FileSystem :> es)
+  :: (IOE :> es, FileSystem :> es, Error SymlinkError :> es)
   => Eff (Symlink : es) a
   -> Eff es a
 runSymlinkIO = interpret $ \_ -> \case
@@ -74,8 +77,11 @@ runSymlinkIO = interpret $ \_ -> \case
     sourcePath <- FileSystem.makeAbsolute sourceFilePath
     destinationPath <- liftIO $ OsPath.decodeFS destination
     case sourceType of
-      File ->
-        createFileLink sourcePath destinationPath
+      File -> do
+        destinationExists <- FileSystem.doesFileExist destinationPath
+        if destinationExists
+        then Error.throwError (AlreadyExists destination)
+        else createFileLink sourcePath destinationPath
       Directory ->
         createDirectoryLink sourcePath destinationPath
   DeleteSymlink linkOsPath -> do