Remove the source directory after repackaing
This commit is contained in:
@ -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))
|
||||
|
Reference in New Issue
Block a user