Remove the source directory after repackaing

1 files changed, 24 insertions, 1 deletions

diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs
index 3e22b22..bf89a40 100644
--- a/lib/SlackBuilder/Download.hs
+++ b/lib/SlackBuilder/Download.hs
@@ -4,7 +4,7 @@
 
 module SlackBuilder.Download
     ( cloneAndUpload
-    , cloneAndArchive
+    , extractRemote
     , commit
     , download
     , hostedSources
@@ -17,6 +17,8 @@ module SlackBuilder.Download
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Char8 as Char8
+import Data.Foldable (traverse_)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Text (Text)
@@ -26,6 +28,7 @@ import SlackBuilder.Config
 import SlackBuilder.Trans
 import Control.Monad.Trans.Reader (asks)
 import Control.Monad.IO.Class (MonadIO(liftIO))
+import System.Directory (createDirectory)
 import System.IO (IOMode(..), withFile)
 import System.FilePath ((</>), (<.>), takeFileName, takeDirectory)
 import System.Process
@@ -63,8 +66,10 @@ import Conduit
     , await
     , sourceFile
     )
+import Data.Conduit.Tar (untar, FileInfo(..))
 import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
 import Data.Void (Void)
+import qualified Data.Conduit.Lzma as Lzma
 
 updateSlackBuildVersion :: Text -> Text -> Map Text Text -> SlackBuilderT ()
 updateSlackBuildVersion packagePath version additionalDownloads = do
@@ -215,3 +220,21 @@ cloneAndUpload repo tarballPath tagPrefix = do
          in cloneAndArchive repo tarballPath tagPrefix
             >> uploadCommand localPath remoteArchivePath
             >> liftIO (runConduitRes go) <&> Just . (remoteResultURI,)
+
+extractRemote :: URI -> Text -> SlackBuilderT ()
+extractRemote uri' packagePath = do
+    repository' <- SlackBuilderT $ asks repository
+    let localToRepository = repository' </> Text.unpack packagePath
+    traverse_ (runReq defaultHttpConfig . go localToRepository . fst)
+        $ useHttpsURI uri'
+  where
+    go toTarget url' = reqBr GET url' NoReqBody mempty $ readResponse toTarget
+    readResponse :: FilePath -> Response BodyReader -> IO ()
+    readResponse toTarget response = runConduitRes
+        $ responseBodySource response
+        .| Lzma.decompress Nothing
+        .| untar (withDecompressedFile toTarget)
+    withDecompressedFile toTarget FileInfo{..}
+        | Char8.last filePath /= '/' =
+            sinkFile (toTarget </> Char8.unpack filePath)
+        | otherwise = liftIO (createDirectory (toTarget </> Char8.unpack filePath))