Read the dispositon header when downloading

src/Main.hs

@@ -12,7 +12,7 @@ import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad.IO.Class (MonadIO(..))
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 import qualified Data.Map as Map
 import Options.Applicative (execParser)
 import SlackBuilder.CommandLine
@@ -61,7 +61,7 @@ import System.Console.ANSI
     , ConsoleLayer(..)
     )
 import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive)
-import Control.Monad (filterM, void)
+import Control.Monad (filterM)
 import Data.List (isPrefixOf, isSuffixOf, partition)
 import Conduit (runConduitRes, (.|), sourceFile)
 import Data.Functor ((<&>))
@@ -288,7 +288,7 @@ autoUpdatable =
                 dscannerURI = [uri|https://github.com/dlang-community/D-Scanner.git|]
              in Map.fromList
                 [ ("DUB", latestDub)
-                , ("DSCANNER", latestDscanner) 
+                , ("DSCANNER", latestDscanner)
                 , ("DCD", latestDcd)
                 ]
         }
@@ -381,7 +381,7 @@ cloneFromGit repo tagPrefix packagePath version = do
             $ NonEmpty.last $ snd $ fromJust $ URI.uriPath repo
         relativeTarball = Text.unpack packagePath
             </> (dropExtension (Text.unpack downloadFileName) <> "-" <> Text.unpack version)
-    (uri', checksum) <- fromJust <$> cloneAndUpload (URI.render repo) relativeTarball tagPrefix
+    (uri', checksum) <- cloneAndUpload (URI.render repo) relativeTarball tagPrefix
     pure $ Package.Download
         { md5sum = checksum
         , download = uri'
@@ -395,43 +395,52 @@ downloadWithTemplate downloadTemplate packagePath version = do
             $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
         relativeTarball = packagePath <> "/" <> downloadFileName
         tarball = repository' </> Text.unpack relativeTarball
-    checksum <- fromJust <$> download uri' tarball
-    pure $ Package.Download uri' checksum
+    checksum <- download uri' tarball
+    pure $ Package.Download uri' $ snd checksum
 
 reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download
 reuploadWithTemplate downloadTemplate commands packagePath version = do
     repository' <- SlackBuilderT $ asks repository
     uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
-    let downloadFileName = URI.unRText
+    let downloadFileName = Text.unpack
+            $ URI.unRText
             $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
-        relativeTarball = Text.unpack $ packagePath <> "/" <> downloadFileName
-        tarball = repository' </> relativeTarball
+        packagePathRelativeToCurrent = repository' </> Text.unpack packagePath
 
-    void $ extractRemote uri' packagePath
-    download' <- handleReupload relativeTarball downloadFileName
-    checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash
+    (checksum, relativeTarball') <- case commands of
+        [] -> do
+            let relativeTarball = packagePathRelativeToCurrent
+                    </> downloadFileName
+            (downloadedFileName, checksum) <- download uri'
+                $ repository' </> relativeTarball
+            pure (checksum, packagePathRelativeToCurrent </> downloadedFileName)
+        _ -> do
+            changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent
+            let relativeTarball = packagePathRelativeToCurrent
+                    </> fromMaybe downloadFileName changedArchiveRootName
+            prepareSource relativeTarball
+            checksum <- liftIO $ runConduitRes $ sourceFile relativeTarball .| sinkHash
 
+            pure (checksum, relativeTarball)
+
+    download' <- handleReupload relativeTarball' downloadFileName
     pure $ Package.Download download' checksum
   where
     name' = Text.pack $ takeBaseName $ Text.unpack packagePath
+    prepareSource tarballPath = do
+        let packedDirectory = dropExtension $ dropExtension tarballPath
+         in liftIO (traverse (defaultCreateProcess packedDirectory) commands)
+            >> liftIO
+                ( withCurrentDirectory (takeDirectory tarballPath)
+                $ callProcess "tar" ["Jcvf", takeFileName tarballPath, takeFileName packedDirectory]
+                )
+            >> liftIO (removeDirectoryRecursive packedDirectory)
     handleReupload relativeTarball downloadFileName = do
-        repository' <- SlackBuilderT $ asks repository
         downloadURL' <- SlackBuilderT $ asks downloadURL
 
         liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
-        case commands of
-            [] -> uploadCommand relativeTarball ("/" <> name')
-            _ ->
-                let tarballPath = repository' </> relativeTarball
-                    packedDirectory = dropExtension $ dropExtension tarballPath
-                 in liftIO (traverse (defaultCreateProcess packedDirectory) commands)
-                >> liftIO
-                    ( withCurrentDirectory (takeDirectory tarballPath)
-                    $ callProcess "tar" ["Jcvf", takeFileName tarballPath, takeFileName packedDirectory]
-                    )
-                >> liftIO (removeDirectoryRecursive packedDirectory)
-                >> uploadCommand relativeTarball ("/" <> name')
-        liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> downloadFileName
+        uploadCommand relativeTarball ("/" <> name')
+        liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> Text.pack downloadFileName
     defaultCreateProcess cwd' cmdSpec
         = flip withCreateProcess (const . const . const waitForProcess)
         $ CreateProcess