[#145] Deploy from a different repository (#193)

* Add GitSetOrigin command

* Add new command tests

* Create second repository path for testing

Co-authored-by: Alexis Crespo <alexis-2cab@homail.com>

* Add tests for new command implementation

* Remove redundant imports in spec file

Co-authored-by: CristhianMotoche <cristhian.motoche@gmail.com>
Co-authored-by: Alexis Crespo <alexis-2cab@homail.com>

spec/System/HapistranoSpec.hs

@@ -17,7 +17,8 @@ import Path
 
 
 import Path.IO
-import System.Directory (getCurrentDirectory, listDirectory)
+import System.Directory
+    ( doesFileExist, getCurrentDirectory, listDirectory )
 import qualified System.Hapistrano as Hap
 import qualified System.Hapistrano.Commands as Hap
 import qualified System.Hapistrano.Core as Hap
@@ -25,16 +26,13 @@ import System.Hapistrano.Types
 import System.IO
 import System.IO.Silently (capture_)
 import System.Info (os)
-import Test.Hspec hiding (shouldBe, shouldReturn)
+import Test.Hspec hiding (shouldBe, shouldContain, shouldReturn)
 import qualified Test.Hspec as Hspec
 import Test.Hspec.QuickCheck
 import Test.QuickCheck hiding (Success)
 import System.Hapistrano (releasePath)
 import System.Hapistrano.Config (deployStateFilename)
-import System.Directory
 import System.Hapistrano.Maintenance
-import Path
-import Control.Monad.IO.Class
 
 testBranchName :: String
 testBranchName = "another_branch"
@@ -176,6 +174,19 @@ spec = do
             ("test `git rev-parse --abbrev-ref HEAD` = " ++ testBranchName)
         -- This fails if there are unstaged changes
           justExec rpath "git diff --exit-code"
+      it "updates the origin url when it's changed" $ \(deployPath, repoPath) ->
+        runHap $ do
+          let tempDirPrefix = "hap-test-repotwo"
+          withSystemTempDir tempDirPrefix $ \repoPathTwo -> do
+            let task1 = mkTask deployPath repoPath
+                task2 = mkTask deployPath repoPathTwo
+                repoConfigFile = deployPath </> $(mkRelDir "repo") </> $(mkRelFile "config")
+            liftIO $ populateTestRepo repoPathTwo
+            void $ Hap.pushRelease task1
+            void $ Hap.pushRelease task2
+
+            repoFile <- (liftIO . readFile . fromAbsFile) repoConfigFile 
+            repoFile `shouldContain` tempDirPrefix
     describe "createHapistranoDeployState" $ do
       it ("creates the " <> deployStateFilename <> " file correctly") $ \(deployPath, repoPath) ->
         runHap $ do
@@ -259,7 +270,7 @@ spec = do
             (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True
       context "when the --keep-one-failed flag is active" $
         it "should delete failed releases other than the most recent" $ \(deployPath, repoPath) ->
-          let successfulRelease = mkReleaseWithState deployPath repoPath Success 
+          let successfulRelease = mkReleaseWithState deployPath repoPath Success
               failedRelease = mkReleaseWithState deployPath repoPath Fail in
           runHap $ do
             rs <- sequence [successfulRelease, successfulRelease, failedRelease, failedRelease, failedRelease]
@@ -352,6 +363,10 @@ infix 1 `shouldBe`, `shouldReturn`
 shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m ()
 shouldBe x y = liftIO (x `Hspec.shouldBe` y)
 
+-- | Lifted 'Hspec.shouldContain'.
+shouldContain :: (MonadIO m, Show a, Eq a) => [a] -> [a] -> m ()
+shouldContain x y = liftIO (x `Hspec.shouldContain` y)
+
 -- | Lifted 'Hspec.shouldReturn'.
 shouldReturn :: (MonadIO m, Show a, Eq a) => m a -> a -> m ()
 shouldReturn m y = m >>= (`shouldBe` y)

src/System/Hapistrano.hs

@@ -216,6 +216,7 @@ ensureCacheInPlace repo deployPath maybeRelease = do
     `catchError` const (return False)
   unless exists $
     exec (GitClone True (Left repo) cpath) maybeRelease
+  exec (Cd cpath (GitSetOrigin repo)) maybeRelease
   exec (Cd cpath (GitFetch "origin")) maybeRelease -- TODO store this in task description?
 
 -- | Create a new release identifier based on current timestamp.

src/System/Hapistrano/Commands.hs

@@ -30,6 +30,7 @@ module System.Hapistrano.Commands
   , BasicWrite(..)
   , GitCheckout(..)
   , GitClone(..)
+  , GitSetOrigin(..)
   , GitFetch(..)
   , GitReset(..)
   , GenericCommand

src/System/Hapistrano/Commands/Internal.hs

@@ -281,6 +281,18 @@ instance Command GitFetch where
       [Just "fetch", Just remote, Just "+refs/heads/\\*:refs/heads/\\*"]
   parseResult Proxy _ = ()
 
+-- | Git set origin
+newtype GitSetOrigin =
+  GitSetOrigin String
+
+instance Command GitSetOrigin where
+  type Result GitSetOrigin = ()
+  renderCommand (GitSetOrigin remote) =
+    formatCmd
+      "git"
+      [Just "remote", Just "set-url", Just "origin", Just remote]
+  parseResult Proxy _ = ()
+
 -- | Git reset.
 newtype GitReset =
   GitReset String