diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## 0.4.2.0 +### Added +* Add support for working directory + +### Removed +* GHC support for versions older than 8.0. Bounds for base corrected + ## 0.4.1.4 ### Changed * Bump path version upper constraint to 0.9 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -139,7 +139,7 @@ release <- if configVcAction then Hap.pushRelease (task releaseFormat) else Hap.pushReleaseWithoutVc (task releaseFormat) - rpath <- Hap.releasePath configDeployPath release + rpath <- Hap.releasePath configDeployPath release configWorkingDir forM_ (toMaybePath configSource) $ \src -> Hap.scpDir src rpath forM_ configCopyFiles $ \(C.CopyThing src dest) -> do @@ -158,7 +158,7 @@ (Hap.linkToShared configTargetSystem rpath configDeployPath) forM_ configLinkedDirs (Hap.linkToShared configTargetSystem rpath configDeployPath) - forM_ configBuildScript (Hap.playScript configDeployPath release) + forM_ configBuildScript (Hap.playScript configDeployPath release configWorkingDir) Hap.registerReleaseAsComplete configDeployPath release Hap.activateRelease configTargetSystem configDeployPath release Hap.dropOldReleases configDeployPath keepReleases diff --git a/hapistrano.cabal b/hapistrano.cabal --- a/hapistrano.cabal +++ b/hapistrano.cabal @@ -1,5 +1,5 @@ name: hapistrano -version: 0.4.1.4 +version: 0.4.2.0 synopsis: A deployment library for Haskell applications description: . @@ -28,7 +28,7 @@ bug-reports: https://github.com/stackbuilders/hapistrano/issues build-type: Simple cabal-version: >=1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.1 +tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.1 extra-source-files: CHANGELOG.md , README.md , Dockerfile @@ -55,7 +55,7 @@ , System.Hapistrano.Commands.Internal build-depends: aeson >= 0.11 && < 1.6 , ansi-terminal >= 0.9 && < 0.12 - , base >= 4.8 && < 5.0 + , base >= 4.9 && < 5.0 , filepath >= 1.2 && < 1.5 , gitrev >= 1.2 && < 1.4 , mtl >= 2.0 && < 3.0 @@ -78,7 +78,7 @@ other-modules: Paths_hapistrano build-depends: aeson >= 0.11 && < 1.6 , async >= 2.0.1.6 && < 2.4 - , base >= 4.8 && < 5.0 + , base >= 4.9 && < 5.0 , formatting >= 6.2 && < 8.0 , gitrev >= 1.2 && < 1.4 , hapistrano @@ -103,7 +103,7 @@ other-modules: System.HapistranoSpec , System.HapistranoConfigSpec , System.HapistranoPropsSpec - build-depends: base >= 4.8 && < 5.0 + build-depends: base >= 4.9 && < 5.0 , directory >= 1.2.5 && < 1.4 , filepath >= 1.2 && < 1.5 , hapistrano diff --git a/spec/System/HapistranoConfigSpec.hs b/spec/System/HapistranoConfigSpec.hs --- a/spec/System/HapistranoConfigSpec.hs +++ b/spec/System/HapistranoConfigSpec.hs @@ -56,4 +56,5 @@ , configTargetSystem = GNULinux , configReleaseFormat = Nothing , configKeepReleases = Nothing + , configWorkingDir = Nothing } diff --git a/spec/System/HapistranoSpec.hs b/spec/System/HapistranoSpec.hs --- a/spec/System/HapistranoSpec.hs +++ b/spec/System/HapistranoSpec.hs @@ -12,6 +12,7 @@ import Data.Maybe (mapMaybe) import Numeric.Natural import Path +import Path.Internal (Path(..)) import Path.IO import System.Directory (getCurrentDirectory, listDirectory) import qualified System.Hapistrano as Hap @@ -29,6 +30,12 @@ testBranchName :: String testBranchName = "another_branch" +workingDir :: Path Rel Dir +workingDir = $(mkRelDir "working_dir") + +releaseDir :: Path Rel Dir +releaseDir = $(mkRelDir "releases") + spec :: Spec spec = do describe "execWithInheritStdout" $ @@ -93,12 +100,33 @@ it "returns the default value" $ fromMaybeKeepReleases Nothing Nothing `Hspec.shouldBe` 5 around withSandbox $ do + describe "releasePath" $ do + context "when the configWorkingDir is Nothing" $ + it "should return the release path" $ \(deployPath, repoPath) -> do + (rpath, release) <- runHap $ do + release <- Hap.pushRelease $ mkTask deployPath repoPath + (,) <$> Hap.releasePath deployPath release Nothing + <*> pure release + + rel <- parseRelDir $ renderRelease release + rpath `shouldBe` deployPath releaseDir rel + + context "when the configWorkingDir is Just" $ + it "should return the release path with WorkingDir" $ \(deployPath, repoPath) -> do + (rpath, release) <- runHap $ do + release <- Hap.pushRelease $ mkTask deployPath repoPath + (,) <$> Hap.releasePath deployPath release (Just workingDir) + <*> pure release + + rel <- parseRelDir $ renderRelease release + rpath `shouldBe` deployPath releaseDir rel workingDir + describe "pushRelease" $ do it "sets up repo all right in Zsh" $ \(deployPath, repoPath) -> runHapWithShell Zsh $ do let task = mkTask deployPath repoPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing -- let's check that the dir exists and contains the right files (liftIO . readFile . fromAbsFile) (rpath $(mkRelFile "foo.txt")) `shouldReturn` "Foo!\n" @@ -106,7 +134,7 @@ runHap $ do let task = mkTask deployPath repoPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing -- let's check that the dir exists and contains the right files (liftIO . readFile . fromAbsFile) (rpath $(mkRelFile "foo.txt")) `shouldReturn` "Foo!\n" @@ -114,7 +142,7 @@ runHap $ do let task = mkTaskWithCustomRevision deployPath repoPath testBranchName release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing -- let's check that the dir exists and contains the right files (liftIO . readFile . fromAbsFile) (rpath $(mkRelFile "bar.txt")) `shouldReturn` "Bar!\n" @@ -138,7 +166,7 @@ let task = mkTask deployPath repoPath release <- Hap.pushRelease task Hap.activateRelease currentSystem deployPath release - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing let rc :: Hap.Readlink Dir rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath) @@ -171,7 +199,7 @@ let task = mkTask deployPath repoPath rs <- replicateM 5 (Hap.pushRelease task) Hap.rollback currentSystem deployPath 2 - rpath <- Hap.releasePath deployPath (rs !! 2) + rpath <- Hap.releasePath deployPath (rs !! 2) Nothing let rc :: Hap.Readlink Dir rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath) @@ -184,7 +212,7 @@ rs <- replicateM 5 (Hap.pushRelease task) forM_ (take 3 rs) (Hap.registerReleaseAsComplete deployPath) Hap.rollback currentSystem deployPath 2 - rpath <- Hap.releasePath deployPath (rs !! 0) + rpath <- Hap.releasePath deployPath (rs !! 0) Nothing let rc :: Hap.Readlink Dir rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath) @@ -201,10 +229,10 @@ Hap.dropOldReleases deployPath 5 -- two oldest releases should not survive: forM_ (take 2 rs) $ \r -> - (Hap.releasePath deployPath r >>= doesDirExist) `shouldReturn` False + (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` False -- 5 most recent releases should stay alive: forM_ (drop 2 rs) $ \r -> - (Hap.releasePath deployPath r >>= doesDirExist) `shouldReturn` True + (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True -- two oldest completion tokens should not survive: forM_ (take 2 rs) $ \r -> (Hap.ctokenPath deployPath r >>= doesFileExist) `shouldReturn` False @@ -218,7 +246,7 @@ let task = mkTask deployPath repoPath sharedDir = Hap.sharedPath deployPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing Hap.exec $ Hap.Rm sharedDir Hap.linkToShared currentSystem rpath deployPath "thing" `shouldReturn` () @@ -227,7 +255,7 @@ runHap (do let task = mkTask deployPath repoPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing Hap.linkToShared currentSystem rpath deployPath "foo.txt") `shouldThrow` anyException context "when it attemps to link a file" $ do @@ -237,7 +265,7 @@ (do let task = mkTask deployPath repoPath sharedDir = Hap.sharedPath deployPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing justExec sharedDir "mkdir foo/" justExec sharedDir "echo 'Bar!' > foo/bar.txt" Hap.linkToShared currentSystem rpath deployPath "foo/bar.txt") `shouldThrow` @@ -248,7 +276,7 @@ let task = mkTask deployPath repoPath sharedDir = Hap.sharedPath deployPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing justExec sharedDir "echo 'Bar!' > bar.txt" Hap.linkToShared currentSystem rpath deployPath "bar.txt" (liftIO . readFile . fromAbsFile) @@ -261,7 +289,7 @@ (do let task = mkTask deployPath repoPath sharedDir = Hap.sharedPath deployPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing justExec sharedDir "mkdir foo/" justExec sharedDir "echo 'Bar!' > foo/bar.txt" justExec sharedDir "echo 'Baz!' > foo/baz.txt" @@ -272,7 +300,7 @@ let task = mkTask deployPath repoPath sharedDir = Hap.sharedPath deployPath release <- Hap.pushRelease task - rpath <- Hap.releasePath deployPath release + rpath <- Hap.releasePath deployPath release Nothing justExec sharedDir "mkdir foo/" justExec sharedDir "echo 'Bar!' > foo/bar.txt" justExec sharedDir "echo 'Baz!' > foo/baz.txt" diff --git a/src/System/Hapistrano.hs b/src/System/Hapistrano.hs --- a/src/System/Hapistrano.hs +++ b/src/System/Hapistrano.hs @@ -96,7 +96,7 @@ -> Release -- ^ Release identifier to activate -> Hapistrano () activateRelease ts deployPath release = do - rpath <- releasePath deployPath release + rpath <- releasePath deployPath release Nothing let tpath = tempSymlinkPath deployPath cpath = currentSymlinkPath deployPath exec (Ln ts rpath tpath) -- create a symlink for the new candidate @@ -129,7 +129,7 @@ dropOldReleases deployPath n = do dreleases <- deployedReleases deployPath forM_ (genericDrop n dreleases) $ \release -> do - rpath <- releasePath deployPath release + rpath <- releasePath deployPath release Nothing exec (Rm rpath) creleases <- completedReleases deployPath forM_ (genericDrop n creleases) $ \release -> do @@ -139,12 +139,13 @@ -- | Play the given script switching to directory of given release. playScript - :: Path Abs Dir -- ^ Deploy path - -> Release -- ^ Release identifier - -> [GenericCommand] -- ^ Commands to execute + :: Path Abs Dir -- ^ Deploy path + -> Release -- ^ Release identifier + -> Maybe (Path Rel Dir) -- ^ Working directory + -> [GenericCommand] -- ^ Commands to execute -> Hapistrano () -playScript deployDir release cmds = do - rpath <- releasePath deployDir release +playScript deployDir release mWorkingDir cmds = do + rpath <- releasePath deployDir release mWorkingDir forM_ cmds (execWithInheritStdout . Cd rpath) -- | Plays the given script on your machine locally. @@ -201,7 +202,7 @@ -> Release -- ^ 'Release' to create -> Hapistrano () cloneToRelease deployPath release = do - rpath <- releasePath deployPath release + rpath <- releasePath deployPath release Nothing let cpath = cacheRepoPath deployPath exec (GitClone False (Right cpath) rpath) @@ -214,7 +215,7 @@ -> String -- ^ Revision to checkout -> Hapistrano () setReleaseRevision deployPath release revision = do - rpath <- releasePath deployPath release + rpath <- releasePath deployPath release Nothing exec (Cd rpath (GitCheckout revision)) -- | Return a list of all currently deployed releases sorted newest first. @@ -277,14 +278,18 @@ -- | Construct path to a particular 'Release'. releasePath - :: Path Abs Dir -- ^ Deploy path - -> Release -- ^ 'Release' identifier + :: Path Abs Dir -- ^ Deploy path + -> Release -- ^ 'Release' identifier + -> Maybe (Path Rel Dir) -- ^ Working directory -> Hapistrano (Path Abs Dir) -releasePath deployPath release = do +releasePath deployPath release mWorkingDir = let rendered = renderRelease release - case parseRelDir rendered of + in case parseRelDir rendered of Nothing -> failWith 1 (Just $ "Could not append path: " ++ rendered) - Just rpath -> return (releasesPath deployPath rpath) + Just rpath -> + return $ case mWorkingDir of + Nothing -> releasesPath deployPath rpath + Just workingDir -> releasesPath deployPath rpath workingDir -- | Return the full path to the git repo used for cache purposes on the -- target host filesystem. diff --git a/src/System/Hapistrano/Config.hs b/src/System/Hapistrano/Config.hs --- a/src/System/Hapistrano/Config.hs +++ b/src/System/Hapistrano/Config.hs @@ -62,6 +62,7 @@ -- ^ The number of releases to keep, the '--keep-releases' argument passed via -- the CLI takes precedence over this value. If neither CLI or configuration -- file value is specified, it defaults to 5 + , configWorkingDir :: !(Maybe (Path Rel Dir)) } deriving (Eq, Ord, Show) -- | Information about source and destination locations of a file\/directory @@ -115,6 +116,7 @@ configTargetSystem <- o .:? "linux" .!= GNULinux configReleaseFormat <- o .:? "release_format" configKeepReleases <- o .:? "keep_releases" + configWorkingDir <- o .:? "working_directory" return Config {..} instance FromJSON CopyThing where