Remove the source directory after repackaing

1 files changed, 20 insertions, 41 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 899cfd8..24f52c6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,7 +6,6 @@ module Main
     ( main
     ) where
 
-import qualified Data.ByteString.Char8 as Char8
 import Data.Char (isNumber)
 import Control.Applicative (Applicative(liftA2))
 import Data.List.NonEmpty (NonEmpty(..))
@@ -31,9 +30,9 @@ import SlackBuilder.Package (Package(..))
 import qualified SlackBuilder.Package as Package
 import Text.URI (URI(..), mkURI)
 import Text.URI.QQ (uri)
-import Data.Foldable (Foldable(..), for_, find, traverse_)
+import Data.Foldable (Foldable(..), for_, find)
 import qualified Text.URI as URI
-import System.FilePath ((</>), (<.>), dropExtension, takeBaseName, makeRelative, splitFileName)
+import System.FilePath ((</>), (<.>), dropExtension, takeBaseName, makeRelative, splitFileName, takeDirectory, takeFileName)
 import SlackBuilder.Info
 import Text.Megaparsec (parse, errorBundlePretty)
 import GHC.Records (HasField(..))
@@ -52,21 +51,10 @@ import System.Console.ANSI
     , Color(..)
     , ConsoleLayer(..)
     )
-import System.Directory (listDirectory, doesDirectoryExist, createDirectory)
+import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive)
 import Control.Monad (filterM)
 import Data.List (isPrefixOf, isSuffixOf, partition)
-import Network.HTTP.Client (Response, BodyReader)
-import Network.HTTP.Req
-    ( runReq
-    , defaultHttpConfig
-    , useHttpsURI
-    , GET(..)
-    , reqBr
-    , NoReqBody(..)
-    )
-import Conduit (runConduitRes, (.|), sinkFile, sourceFile)
-import Data.Conduit.Tar (untar, FileInfo(..))
-import qualified Data.Conduit.Lzma as Lzma
+import Conduit (runConduitRes, (.|), sourceFile)
 
 autoUpdatable :: [Package]
 autoUpdatable =
@@ -407,11 +395,11 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
     uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
     let downloadFileName = URI.unRText
             $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
-        relativeTarball = packagePath <> "/" <> downloadFileName
-        tarball = repository' </> Text.unpack relativeTarball
+        relativeTarball = Text.unpack $ packagePath <> "/" <> downloadFileName
+        tarball = repository' </> relativeTarball
 
-    extractRemote uri'
-    download' <- handleReupload (Text.unpack relativeTarball) downloadFileName
+    extractRemote uri' packagePath
+    download' <- handleReupload relativeTarball downloadFileName
     checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash
 
     pure $ Package.Download download' checksum
@@ -419,18 +407,22 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
     name' = Text.pack $ takeBaseName $ Text.unpack packagePath
     handleReupload relativeTarball downloadFileName = do
         repository' <- SlackBuilderT $ asks repository
+        downloadURL' <- SlackBuilderT $ asks downloadURL
+
+        liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
         case commands of
-            [] -> uploadTarball relativeTarball downloadFileName
+            [] -> uploadCommand relativeTarball ("/" <> name')
             _ ->
                 let tarballPath = repository' </> relativeTarball
-                    packedDirectory = takeBaseName $ dropExtension tarballPath
+                    packedDirectory = dropExtension $ dropExtension tarballPath
                  in liftIO (traverse (defaultCreateProcess packedDirectory) commands)
-                >> liftIO (callProcess "tar" ["Jcvf", tarballPath, packedDirectory])
-                >> uploadTarball relativeTarball downloadFileName
-    uploadTarball relativeTarball downloadFileName
-        = liftIO (putStrLn $ "Upload the source tarball " <> relativeTarball)
-        >> uploadCommand relativeTarball ("/" <> name')
-        >> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name' <> "/" <> downloadFileName)
+                >> liftIO
+                    ( withCurrentDirectory (takeDirectory tarballPath)
+                    $ callProcess "tar" ["Jcvf", takeFileName tarballPath, takeFileName packedDirectory]
+                    )
+                >> liftIO (removeDirectoryRecursive packedDirectory)
+                >> uploadCommand relativeTarball ("/" <> name')
+        liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> downloadFileName
     defaultCreateProcess cwd' cmdSpec
         = flip withCreateProcess (const . const . const waitForProcess)
         $ CreateProcess
@@ -450,19 +442,6 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
             , child_user = Nothing
             , child_group = Nothing
             }
-    extractRemote :: URI -> SlackBuilderT ()
-    extractRemote uri' = traverse_ (runReq defaultHttpConfig . go . fst)
-        $ useHttpsURI uri'
-    go uri' = reqBr GET uri' NoReqBody mempty readResponse
-    readResponse :: Response BodyReader -> IO ()
-    readResponse response = runConduitRes
-        $ responseBodySource response
-        .| Lzma.decompress Nothing
-        .| untar withDecompressedFile
-    withDecompressedFile FileInfo{..}
-        | Char8.last filePath /= '/' =
-            sinkFile (Char8.unpack filePath)
-        | otherwise = liftIO (createDirectory (Char8.unpack filePath))
 
 updatePackage :: Package -> Text -> PackageInfo -> SlackBuilderT ()
 updatePackage Package{..} version info = do