Drop no-longer useful completion tokens

CHANGELOG.md

@@ -1,8 +1,8 @@
 ## 0.3.1.0
 
 * Fixed a bug with repos not being fetched properly.
-
 * Implemented concurrent deployment to multiple hosts.
+* Now completion tokens are dropped automatically like old releases.
 
 ## 0.3.0.1
 

spec/System/HapistranoSpec.hs

@@ -84,8 +84,10 @@ spec = do
 
     describe "dropOldReleases" $
       it "works" $ \(deployPath, repoPath) -> runHap $ do
-        let task  = mkTask deployPath repoPath
-        rs <- replicateM 7 (Hap.pushRelease task)
+        rs <- replicateM 7 $ do
+          r <- Hap.pushRelease (mkTask deployPath repoPath)
+          Hap.registerReleaseAsComplete deployPath r
+          return r
         Hap.dropOldReleases deployPath 5
         -- two oldest releases should not survive:
         forM_ (take 2 rs) $ \r ->
@@ -95,6 +97,14 @@ spec = do
         forM_ (drop 2 rs) $ \r ->
           (Hap.releasePath deployPath r >>= doesDirExist)
             `shouldReturn` True
+        -- two oldest completion tokens should not survive:
+        forM_ (take 2 rs) $ \r ->
+          (Hap.ctokenPath deployPath r >>= doesFileExist)
+            `shouldReturn` False
+        -- 5 most recent completion tokens should stay alive:
+        forM_ (drop 2 rs) $ \r ->
+          (Hap.ctokenPath deployPath r >>= doesFileExist)
+            `shouldReturn` True
 
 ----------------------------------------------------------------------------
 -- Helpers

src/System/Hapistrano.hs

@@ -105,10 +105,14 @@ dropOldReleases
   -> Natural           -- ^ How many releases to keep
   -> Hapistrano ()     -- ^ Deleted Releases
 dropOldReleases deployPath n = do
-  releases <- deployedReleases deployPath
-  forM_ (genericDrop n releases) $ \release -> do
+  dreleases <- deployedReleases deployPath
+  forM_ (genericDrop n dreleases) $ \release -> do
     rpath <- releasePath deployPath release
     exec (Rm rpath)
+  creleases <- completedReleases deployPath
+  forM_ (genericDrop n creleases) $ \release -> do
+    cpath <- ctokenPath  deployPath release
+    exec (Rm cpath)
 
 -- | Play the given script switching to diroctory of given release.