Replace extern rm rf call with a function
This commit is contained in:
parent
3b7b15f381
commit
c81cabfcbf
@ -7,6 +7,7 @@ module SlackBuilder.Download
|
||||
( cloneAndUpload
|
||||
, extractRemote
|
||||
, commit
|
||||
, createLzmaTarball
|
||||
, download
|
||||
, hostedSources
|
||||
, remoteFileExists
|
||||
@ -32,7 +33,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.Directory (createDirectory, removePathForcibly)
|
||||
import System.IO (IOMode(..), withFile)
|
||||
import System.FilePath ((</>), (<.>), takeFileName, takeDirectory, stripExtension)
|
||||
import System.Process
|
||||
@ -43,7 +44,7 @@ import System.Process
|
||||
, callProcess
|
||||
)
|
||||
import System.Exit (ExitCode(..))
|
||||
import Control.Monad (unless)
|
||||
import Control.Monad (unless, void)
|
||||
import Text.URI (URI(..))
|
||||
import qualified Text.URI as URI
|
||||
import Network.HTTP.Req
|
||||
@ -55,23 +56,25 @@ import Network.HTTP.Req
|
||||
, defaultHttpConfig
|
||||
, ignoreResponse
|
||||
, responseStatusCode
|
||||
, MonadHttp
|
||||
, HttpConfig(..)
|
||||
, GET(..)
|
||||
, reqBr, MonadHttp
|
||||
, reqBr
|
||||
)
|
||||
import Data.Functor ((<&>))
|
||||
import Network.HTTP.Client (BodyReader, Response(..), brRead)
|
||||
import Conduit
|
||||
( ConduitT
|
||||
, MonadResource
|
||||
, yield
|
||||
, runConduitRes
|
||||
, sinkFile
|
||||
, (.|)
|
||||
, ZipSink(..)
|
||||
, await
|
||||
, sourceFile, MonadResource
|
||||
, sourceFile
|
||||
)
|
||||
import Data.Conduit.Tar (untar, FileInfo(..))
|
||||
import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar)
|
||||
import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
|
||||
import Data.Void (Void)
|
||||
import qualified Data.Conduit.Lzma as Lzma
|
||||
@ -160,7 +163,7 @@ cloneAndArchive repo tarballPath tagPrefix = do
|
||||
repositoryTarballPath <- relativeToRepository tarballPath
|
||||
repositoryArchivePath <- relativeToRepository $ tarballPath <.> "tar.xz"
|
||||
liftIO
|
||||
$ callProcess "rm" ["-rf", repositoryTarballPath]
|
||||
$ removePathForcibly repositoryTarballPath
|
||||
>> callProcess "git"
|
||||
[ "clone"
|
||||
, Text.unpack repo
|
||||
@ -180,12 +183,14 @@ cloneAndArchive repo tarballPath tagPrefix = do
|
||||
, "--init"
|
||||
, "--recursive"
|
||||
]
|
||||
>> callProcess "tar"
|
||||
["Jcvf"
|
||||
, repositoryArchivePath
|
||||
, repositoryTarballPath
|
||||
]
|
||||
>> callProcess "rm" ["-rf", repositoryTarballPath]
|
||||
>> createLzmaTarball repositoryTarballPath repositoryArchivePath
|
||||
>> removePathForcibly repositoryTarballPath
|
||||
|
||||
createLzmaTarball :: FilePath -> FilePath -> IO (Digest MD5)
|
||||
createLzmaTarball input output = runConduitRes $ yield input
|
||||
.| void tarFilePath
|
||||
.| Lzma.compress Nothing
|
||||
.| sinkFileAndHash output
|
||||
|
||||
responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m ()
|
||||
responseBodySource = bodyReaderSource . responseBody
|
||||
|
@ -61,13 +61,10 @@ import System.Console.ANSI
|
||||
, Color(..)
|
||||
, ConsoleLayer(..)
|
||||
)
|
||||
import Control.Monad (filterM, void)
|
||||
import Control.Monad (filterM)
|
||||
import Data.List (isPrefixOf, isSuffixOf, partition)
|
||||
import Conduit (runConduitRes, (.|), yield)
|
||||
import Data.Functor ((<&>))
|
||||
import Data.Bifunctor (Bifunctor(..))
|
||||
import Data.Conduit.Tar (tarFilePath)
|
||||
import qualified Data.Conduit.Lzma as Lzma
|
||||
|
||||
getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData)
|
||||
getAndLogLatest description = do
|
||||
@ -182,10 +179,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
|
||||
appendTarExtension = (<.> "tar.xz")
|
||||
in fmap (appendTarExtension tarballPath,)
|
||||
$ withCurrentDirectory (takeDirectory tarballPath)
|
||||
$ runConduitRes $ yield archiveBaseFilename
|
||||
.| void tarFilePath
|
||||
.| Lzma.compress Nothing
|
||||
.| sinkFileAndHash (appendTarExtension archiveBaseFilename)
|
||||
$ createLzmaTarball archiveBaseFilename archiveBaseFilename
|
||||
handleReupload relativeTarball = do
|
||||
liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
|
||||
uploadSource relativeTarball category'
|
||||
|
Loading…
Reference in New Issue
Block a user