Make local paths relative to cwd

.gitea/workflows/build.yml

@@ -7,25 +7,19 @@ on:
 
 jobs:
   audit:
-    runs-on: alpine
+    runs-on: haskell
     steps:
       - name: Set up environment
-        shell: ash {0}
         run: |
-          apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
-      - name: Prepare system
-        run: |
-          curl --create-dirs --output-dir \
-            ~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
-          chmod +x ~/.ghcup/bin/ghcup
-          ~/.ghcup/bin/ghcup install ghc 9.4.8
-          ~/.ghcup/bin/ghcup install cabal 3.6.2.0
+          apt-get update -y
+          apt-get upgrade -y
+          apt-get install -y nodejs pkg-config liblzma-dev
       - uses: actions/checkout@v4
       - name: Install dependencies
         run: |
-          ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
-          ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal install hlint --constraint="hlint ==3.6.1"
-      - run: ~/.cabal/bin/hlint -- src lib tests
+          cabal update
+          cabal install hlint "--constraint=hlint ==3.6.1"
+      - run: cabal exec hlint -- src lib tests
 
   test:
     runs-on: alpine

lib/SlackBuilder/Download.hs

@@ -142,16 +142,6 @@ remoteFileExists url = hostedSources url
         }
     go uri = req HEAD uri NoReqBody ignoreResponse mempty
 
-uploadCommand :: FilePath -> Text -> SlackBuilderT ()
-uploadCommand localPath remotePath' = do
-    remoteRoot <- SlackBuilderT $ asks remotePath
-    localPathFromRepository <- relativeToRepository localPath
-
-    liftIO $ callProcess "scp"
-        [ localPathFromRepository
-        , Text.unpack $ remoteRoot <> remotePath'
-        ]
-
 cloneAndArchive :: Text -> FilePath -> Text -> SlackBuilderT ()
 cloneAndArchive repo tarballPath tagPrefix = do
     let version = snd $ Text.breakOnEnd "-"
@@ -217,6 +207,19 @@ cloneAndUpload repo tarballPath tagPrefix = do
             >> uploadCommand localPath remoteArchivePath
             >> liftIO (runConduitRes go) <&> (remoteResultURI,)
 
+-- | Given a path to a local file and a remote path uploads the file using
+-- the settings given in the configuration file.
+--
+-- The remote path is given relative to the path in the configuration.
+uploadCommand :: FilePath -> Text -> SlackBuilderT ()
+uploadCommand localPath remotePath' = do
+    remoteRoot <- SlackBuilderT $ asks remotePath
+
+    liftIO $ callProcess "scp"
+        [ localPath
+        , Text.unpack $ remoteRoot <> remotePath'
+        ]
+
 -- | Downlaods a file into the directory. Returns name of the downloaded file
 -- and checksum.
 --

src/Main.hs

@@ -391,11 +391,7 @@ downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilder
 downloadWithTemplate downloadTemplate packagePath version = do
     repository' <- SlackBuilderT $ asks repository
     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
-    checksum <- download uri' tarball
+    checksum <- download uri' $ repository' </> Text.unpack packagePath
     pure $ Package.Download uri' $ snd checksum
 
 reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download
@@ -409,10 +405,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
 
     (checksum, relativeTarball') <- case commands of
         [] -> do
-            let relativeTarball = packagePathRelativeToCurrent
-                    </> downloadFileName
-            (downloadedFileName, checksum) <- download uri'
-                $ repository' </> relativeTarball
+            (downloadedFileName, checksum) <- download uri' packagePathRelativeToCurrent
             pure (checksum, packagePathRelativeToCurrent </> downloadedFileName)
         _ -> do
             changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent