packages feed

hwm-0.5.0: src/HWM/Integrations/Toolchain/Cabal.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Integrations.Toolchain.Cabal
  ( validateHackage,
    validateCabalSourceInclusion,
    syncCabalProject,
    HasSourceDirs (..),
    CabalPackage,
    newCabalPackage,
    readCabalPackage,
    nativeSdist,
    setupCabalMatrixEnvironment,
  )
where

import Control.Exception (IOException)
import Control.Exception.Base (try)
import Control.Monad.Except (MonadError (throwError))
import qualified Data.ByteString as BS
import Data.Foldable (Foldable (..))
import qualified Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Package (packageVersion)
import Distribution.PackageDescription (Benchmark (..), Executable (..), ForeignLib (..), GenericPackageDescription (..), PackageDescription (..), PackageIdentifier (..), TestSuite (..), UnqualComponentName, emptyBuildInfo, emptyLibrary, emptyPackageDescription, mkPackageName, packageDescription)
import Distribution.PackageDescription.Check (PackageCheck (..), checkPackage)
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
import Distribution.PackageDescription.Parsec
import Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription)
import Distribution.Simple.Flag (toFlag)
import Distribution.Simple.PackageDescription (readGenericPackageDescription)
import Distribution.Simple.PreProcess (knownSuffixHandlers)
import Distribution.Simple.Setup (SDistFlags (..), defaultSDistFlags)
import Distribution.Simple.SrcDist (sdist)
import Distribution.Text (display)
import Distribution.Types.BuildInfo (BuildInfo (..))
import Distribution.Types.CondTree (CondBranch (..), CondTree (..))
import Distribution.Types.Library (Library (..))
import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath)
import Distribution.Verbosity (normal)
import qualified Distribution.Verbosity as Verbosity
import HWM.Core.Common (Name)
import HWM.Core.Formatting (Format (..), Status (..))
import HWM.Core.Options (Options (..))
import HWM.Core.Pkg (IsPkg (..), PackageIO, Pkg (..), PkgName)
import qualified HWM.Core.Pkg as P
import HWM.Core.Result (Issue (..), IssueDetails (..), MonadIssue (..), Severity (..))
import HWM.Core.Sync (SyncMode (..))
import HWM.Core.Version (Version, toCabalVersion)
import HWM.Domain.Build (Builder (CabalBuilder, NixBuilder))
import HWM.Domain.ConfigT (ConfigT)
import qualified HWM.Domain.ConfigT as CT
import HWM.Domain.Dependencies (Dependencies (..), HasDependencies (..), MapDeps (..), mkCabalDependency, toDependencyList)
import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment)
import HWM.Runtime.Files (syncFile)
import HWM.Runtime.Process (EnvVars)
import Hpack (Force (..), Options (..), Result (..), defaultOptions, hpackResult, setProgramName, setTarget)
import qualified Hpack as H
import Hpack.Config (ProgramName (..))
import Relude
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute, removePathForcibly, renameFile, withCurrentDirectory)
import System.FilePath (dropExtension, isExtensionOf, makeRelative, normalise, splitDirectories, takeDirectory, (</>))

toStatus :: PackageCheck -> Status
toStatus p
  | isError p = Invalid
  | otherwise = Warning

isError :: PackageCheck -> Bool
isError PackageDistInexcusable {} = True
isError PackageBuildImpossible {} = True
isError PackageBuildWarning {} = False
isError PackageDistSuspiciousWarn {} = False
isError PackageDistSuspicious {} = False

toIssue :: Pkg -> PackageCheck -> Issue
toIssue pkg check =
  Issue
    { issueMessage = "Invalid Package [Cabal check]: " <> show check,
      issueSeverity = if isError check then SeverityError else SeverityWarning,
      issueTopic = P.pkgMemberId pkg,
      issueDetails = Nothing
    }

validateHackage :: Pkg -> ConfigT Status
validateHackage pkg = do
  gpd <- liftIO $ readGenericPackageDescription normal (P.cabalFile pkg)
  let ls = checkPackage gpd Nothing
  for_ ls $ \l -> injectIssue (toIssue pkg l)
  pure (maximum (Checked : map toStatus ls))

validateCabalSourceInclusion :: Pkg -> ConfigT Status
validateCabalSourceInclusion pkg = do
  gpd <- liftIO $ readGenericPackageDescription normal (P.cabalFile pkg)
  issues <- liftIO $ sourceInclusionIssues pkg gpd
  for_ issues injectIssue
  pure $ if null issues then Checked else Warning

sourceInclusionIssues :: Pkg -> GenericPackageDescription -> IO [Issue]
sourceInclusionIssues pkg gpd = do
  expected <- syncGenericPackageDescription (takeDirectory (P.cabalFile pkg)) gpd
  let declared = declaredModules gpd
  let target = declaredModules expected
  pure (mkSourceIssues pkg declared target)

declaredModules :: GenericPackageDescription -> Map Text (Set.Set ModuleName)
declaredModules GenericPackageDescription {..} =
  Map.fromList
    $ maybeToList ((\tree -> ("library", moduleSetLibrary (condTreeData tree))) <$> condLibrary)
    <> map (\(name, tree) -> ("library:" <> format name, moduleSetLibrary (condTreeData tree))) condSubLibraries
    <> map (\(name, tree) -> ("foreign:" <> format name, moduleSetForeign (condTreeData tree))) condForeignLibs
    <> map (\(name, tree) -> ("exe:" <> format name, moduleSetExecutable (condTreeData tree))) condExecutables
    <> map (\(name, tree) -> ("test:" <> format name, moduleSetTest (condTreeData tree))) condTestSuites
    <> map (\(name, tree) -> ("bench:" <> format name, moduleSetBenchmark (condTreeData tree))) condBenchmarks

moduleSetLibrary :: Library -> Set.Set ModuleName
moduleSetLibrary Library {..} = Set.fromList (exposedModules <> otherModules libBuildInfo)

moduleSetForeign :: ForeignLib -> Set.Set ModuleName
moduleSetForeign ForeignLib {..} = Set.fromList (otherModules foreignLibBuildInfo)

moduleSetExecutable :: Executable -> Set.Set ModuleName
moduleSetExecutable Executable {..} = Set.fromList (otherModules buildInfo)

moduleSetTest :: TestSuite -> Set.Set ModuleName
moduleSetTest TestSuite {..} = Set.fromList (otherModules testBuildInfo)

moduleSetBenchmark :: Benchmark -> Set.Set ModuleName
moduleSetBenchmark Benchmark {..} = Set.fromList (otherModules benchmarkBuildInfo)

mkSourceIssues :: Pkg -> Map Text (Set.Set ModuleName) -> Map Text (Set.Set ModuleName) -> [Issue]
mkSourceIssues pkg declared target = concatMap toIssues (Set.toList labels)
  where
    labels = Set.union (Map.keysSet declared) (Map.keysSet target)
    toIssues label =
      let current = Map.findWithDefault Set.empty label declared
          expected = Map.findWithDefault Set.empty label target
          missingInCabal = map moduleToFile (Set.toList (Set.difference expected current))
          missingInCode = map moduleToFile (Set.toList (Set.difference current expected))
       in catMaybes
            [ mkIssue SeverityWarning "Source files exist in codebase but are missing in .cabal" label missingInCabal,
              mkIssue SeverityError "Modules/files declared in .cabal are missing in codebase" label missingInCode
            ]

    mkIssue severity message component targets =
      if null targets
        then Nothing
        else
          Just
            Issue
              { issueTopic = P.pkgMemberId pkg,
                issueSeverity = severity,
                issueMessage = message,
                issueDetails = Just (SourceInclusionIssue component targets)
              }

moduleToFile :: ModuleName -> Text
moduleToFile m = toText (ModuleName.toFilePath m <> ".hs")

instance PackageIO CabalPackage ConfigT where
  rewritePackage = rewriteCabalPackage
  readPackage = readCabalPackage

rewriteCabalPackage :: (CabalPackage -> ConfigT (Maybe CabalPackage)) -> Pkg -> ConfigT Status
rewriteCabalPackage mapCabal pkg = do
  original <- readCabalPackage pkg
  synced <- runCabalSync mapCabal pkg original
  let changed = cbContent synced /= cbContent original
  update <-
    if changed
      then case hpackFile pkg of
        Just path -> hpackForceUpdate pkg path
        Nothing -> liftIO (writeGenericPackageDescription (P.cabalFile pkg) (cbContent synced)) $> Updated
      else pure Checked
  validation <- validateHackage pkg
  pure $ max validation update

runCabalSync :: (CabalPackage -> ConfigT (Maybe CabalPackage)) -> Pkg -> CabalPackage -> ConfigT CabalPackage
runCabalSync mapCabal pkg original = do
  mapped <- fromMaybe original <$> mapCabal original
  case hpackFile pkg of
    Just _ -> pure mapped
    Nothing -> liftIO (syncDiscoveredModules mapped)

hpackForceUpdate :: (MonadIO m) => Pkg -> FilePath -> m Status
hpackForceUpdate pkg path = do
  let programName = ProgramName $ toString $ P.pkgName pkg
  let ops = setTarget path $ setProgramName programName defaultOptions {optionsForce = Force}
  Result {..} <- liftIO $ hpackResult ops
  case resultStatus of
    H.OutputUnchanged -> pure Checked
    _ -> pure Updated

generateCabalProject :: Text -> BuildEnvironment -> Text
generateCabalProject prefix BuildEnvironment {..} =
  T.unlines
    $ ["with-compiler: ghc-" <> format buildGHC | not dependsOnNix]
    <> ("packages:" : map printPkg buildPkgs)
  where
    printPkg pkg = "  " <> prefix <> format (P.pkgDirPath pkg)
    dependsOnNix = buildBuilder == CabalBuilder True || buildBuilder == NixBuilder

setupCabalMatrixEnvironment :: BuildEnvironment -> ConfigT EnvVars
setupCabalMatrixEnvironment env = do
  matrixDir <- liftIO $ makeAbsolute ".hwm/matrix/"
  liftIO $ createDirectoryIfMissing True matrixDir
  let projectPath = matrixDir <> "cabal-" <> toString (buildName env) <> ".project"
  _ <- syncFile projectPath (generateCabalProject "../../" env)
  pure [("CABAL_PROJECT_FILE", projectPath)]

syncCabalProject :: SyncMode -> ConfigT Status
syncCabalProject SyncModeSync = do
  cabalFilePath <- asks (optionsCabal . CT.options)
  env <- getBuildEnvironment Nothing
  syncFile cabalFilePath (generateCabalProject "" env)
syncCabalProject SyncModeCheck = do
  cabalFilePath <- asks (optionsCabal . CT.options)
  exists <- liftIO $ doesFileExist cabalFilePath
  pure $ if exists then Checked else Warning
syncCabalProject SyncModeIgnore = pure Ignored

data CabalPackage = CabalPackage
  { cbDirectory :: FilePath,
    cbContent :: GenericPackageDescription
  }
  deriving (Show)

readCabalFile :: (MonadIO m, MonadError Issue m) => Pkg -> m GenericPackageDescription
readCabalFile pkg = do
  let path = P.cabalFile pkg
  content <- liftIO $ BS.readFile path
  case runParseResult (parseGenericPackageDescription content) of
    (_, Right gpd) -> pure gpd
    (_, Left (_, errors)) ->
      throwError $ fromString $ "Cabal parsing failed: " ++ show errors

readCabalPackage :: (MonadIO m, MonadError Issue m) => Pkg -> m CabalPackage
readCabalPackage pkg = do
  gpd <- readCabalFile pkg
  pure
    CabalPackage
      { cbDirectory = takeDirectory (P.cabalFile pkg),
        cbContent = gpd
      }

syncDiscoveredModules :: CabalPackage -> IO CabalPackage
syncDiscoveredModules pkg@CabalPackage {..} = do
  nextContent <- syncGenericPackageDescription cbDirectory cbContent
  pure pkg {cbContent = nextContent}

syncGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO GenericPackageDescription
syncGenericPackageDescription dir gpd@GenericPackageDescription {..} = do
  nextLibrary <- traverse (mapCondTree syncLibraryModules dir) condLibrary
  nextSubLibraries <- traverse (syncNamedCondTree syncLibraryModules dir) condSubLibraries
  nextForeignLibs <- traverse (syncNamedCondTree syncForeignLibraryModules dir) condForeignLibs
  nextExecutables <- traverse (syncNamedCondTree syncExecutableModules dir) condExecutables
  nextTests <- traverse (syncNamedCondTree syncTestModules dir) condTestSuites
  nextBenches <- traverse (syncNamedCondTree syncBenchmarkModules dir) condBenchmarks
  pure
    gpd
      { condLibrary = nextLibrary,
        condSubLibraries = nextSubLibraries,
        condForeignLibs = nextForeignLibs,
        condExecutables = nextExecutables,
        condTestSuites = nextTests,
        condBenchmarks = nextBenches
      }

syncNamedCondTree :: (FilePath -> a -> IO a) -> FilePath -> (k, CondTree v c a) -> IO (k, CondTree v c a)
syncNamedCondTree syncComponent dir (name, tree) = do
  nextTree <- mapCondTree syncComponent dir tree
  pure (name, nextTree)

mapCondTree :: (FilePath -> a -> IO a) -> FilePath -> CondTree v c a -> IO (CondTree v c a)
mapCondTree syncComponent dir tree@CondNode {..} = do
  nextData <- syncComponent dir condTreeData
  nextComponents <-
    forM condTreeComponents $ \CondBranch {..} -> do
      nextIf <- mapCondTree syncComponent dir condBranchIfTrue
      nextElse <- traverse (mapCondTree syncComponent dir) condBranchIfFalse
      pure CondBranch {condBranchCondition = condBranchCondition, condBranchIfTrue = nextIf, condBranchIfFalse = nextElse}
  pure tree {condTreeData = nextData, condTreeComponents = nextComponents}

syncLibraryModules :: FilePath -> Library -> IO Library
syncLibraryModules dir lib@Library {..} = do
  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs libBuildInfo))
  let generated = filter isGeneratedModule (otherModules libBuildInfo)
  let expected = sort (Data.List.nub (generated <> discovered))
  let declared = sort (Data.List.nub (exposedModules <> otherModules libBuildInfo))
  if moduleListsEqual declared expected
    then pure lib
    else
      pure
        lib
          { exposedModules = discovered,
            libBuildInfo = libBuildInfo {otherModules = sort (Data.List.nub generated)}
          }

syncForeignLibraryModules :: FilePath -> ForeignLib -> IO ForeignLib
syncForeignLibraryModules dir foreignLib@ForeignLib {..} = do
  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs foreignLibBuildInfo))
  let generated = filter isGeneratedModule (otherModules foreignLibBuildInfo)
  let expected = sort (Data.List.nub (generated <> discovered))
  let declared = sort (Data.List.nub (otherModules foreignLibBuildInfo))
  if moduleListsEqual declared expected
    then pure foreignLib
    else pure foreignLib {foreignLibBuildInfo = foreignLibBuildInfo {otherModules = expected}}

syncExecutableModules :: FilePath -> Executable -> IO Executable
syncExecutableModules dir exe@Executable {..} = do
  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs buildInfo))
  let mainModule = toModuleName modulePath
  let generated = filter isGeneratedModule (otherModules buildInfo)
  let discoveredWithoutMain = maybe discovered (`Data.List.delete` discovered) mainModule
  let expected = sort (Data.List.nub (generated <> discoveredWithoutMain))
  let declared = sort (Data.List.nub (otherModules buildInfo))
  if moduleListsEqual declared expected
    then pure exe
    else pure exe {buildInfo = buildInfo {otherModules = expected}}

syncTestModules :: FilePath -> TestSuite -> IO TestSuite
syncTestModules dir test@TestSuite {..} = do
  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs testBuildInfo))
  let generated = filter isGeneratedModule (otherModules testBuildInfo)
  let expected = sort (Data.List.nub (generated <> discovered))
  let declared = sort (Data.List.nub (otherModules testBuildInfo))
  if moduleListsEqual declared expected
    then pure test
    else pure test {testBuildInfo = testBuildInfo {otherModules = expected}}

syncBenchmarkModules :: FilePath -> Benchmark -> IO Benchmark
syncBenchmarkModules dir bench@Benchmark {..} = do
  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs benchmarkBuildInfo))
  let generated = filter isGeneratedModule (otherModules benchmarkBuildInfo)
  let expected = sort (Data.List.nub (generated <> discovered))
  let declared = sort (Data.List.nub (otherModules benchmarkBuildInfo))
  if moduleListsEqual declared expected
    then pure bench
    else pure bench {benchmarkBuildInfo = benchmarkBuildInfo {otherModules = expected}}

discoverModules :: FilePath -> [FilePath] -> IO [ModuleName]
discoverModules dir sourceDirs = do
  files <- concat <$> traverse (discoverModulesInDir dir) sourceDirs
  pure (sort (Data.List.nub files))

discoverModulesInDir :: FilePath -> FilePath -> IO [ModuleName]
discoverModulesInDir base sourceDir = do
  let root = normalise (base </> sourceDir)
  exists <- doesDirectoryExist root
  if not exists
    then pure []
    else do
      hsFiles <- walkHsFiles root
      pure (mapMaybe (toModuleName . makeRelative root) hsFiles)

walkHsFiles :: FilePath -> IO [FilePath]
walkHsFiles dir = do
  children <- listDirectory dir
  paths <-
    forM children $ \name -> do
      let path = dir </> name
      isDir <- doesDirectoryExist path
      if isDir
        then walkHsFiles path
        else pure [path | ".hs" `isExtensionOf` path]
  pure (concat paths)

toModuleName :: FilePath -> Maybe ModuleName
toModuleName path =
  if ".hs" `isExtensionOf` path
    then
      let parts = splitDirectories (dropExtension path)
          cleaned = filter (not . null) parts
       in if null cleaned then Nothing else Just (ModuleName.fromString (Data.List.intercalate "." cleaned))
    else Nothing

isGeneratedModule :: ModuleName -> Bool
isGeneratedModule moduleName = "Paths_" `isPrefixOf` ModuleName.toFilePath moduleName

moduleListsEqual :: [ModuleName] -> [ModuleName] -> Bool
moduleListsEqual a b = Set.fromList a == Set.fromList b

class HasSourceDirs a where
  getSourceDirs :: [Text] -> a -> [(Text, Name)]

instance (HasSourceDirs a) => HasSourceDirs (Maybe a) where
  getSourceDirs tag (Just l) = getSourceDirs tag l
  getSourceDirs _ Nothing = []

instance (HasSourceDirs a) => HasSourceDirs (Map Text a) where
  getSourceDirs tags libs = concatMap (\(name, lib) -> getSourceDirs (tags <> [name]) lib) (Map.toList libs)

instance HasSourceDirs CabalPackage where
  getSourceDirs p CabalPackage {..} = getSourceDirs p cbContent

instance HasSourceDirs GenericPackageDescription where
  getSourceDirs p GenericPackageDescription {..} =
    getSourceDirs (p <> ["lib"]) condLibrary
      <> getSourceDirs (p <> ["exe"]) condExecutables
      <> getSourceDirs (p <> ["test"]) condTestSuites
      <> getSourceDirs (p <> ["bench"]) condBenchmarks

instance (HasSourceDirs a) => HasSourceDirs (CondTree v c a) where
  getSourceDirs path condTree = getSourceDirs path (condTreeData condTree)

instance (HasSourceDirs a) => HasSourceDirs [(UnqualComponentName, a)] where
  getSourceDirs path = concatMap (\(name, info) -> getSourceDirs (path <> [format name]) info)

instance HasSourceDirs Library where
  getSourceDirs path Library {..} = getSourceDirs path libBuildInfo

instance HasSourceDirs Executable where
  getSourceDirs path Executable {..} = getSourceDirs path buildInfo

instance HasSourceDirs TestSuite where
  getSourceDirs path TestSuite {..} = getSourceDirs path testBuildInfo

instance HasSourceDirs Benchmark where
  getSourceDirs path Benchmark {..} = getSourceDirs path benchmarkBuildInfo

instance HasSourceDirs BuildInfo where
  getSourceDirs path buildInfo = map (withKey . getSymbolicPath) (hsSourceDirs buildInfo)
    where
      withKey dir = (T.intercalate ":" path, format dir)

instance IsPkg CabalPackage where
  getPkgName = getPkgName . cbContent
  getPkgVersion = getPkgVersion . cbContent
  setVersion version pkg = pkg {cbContent = setVersion version (cbContent pkg)}

instance HasDependencies CabalPackage where
  collectDependencies xs gpd = collectDependencies xs (cbContent gpd)

instance MapDeps CabalPackage where
  mapDeps ctx f cabalPkg = do
    newGpd <- mapDeps ctx f (cbContent cabalPkg)
    pure cabalPkg {cbContent = newGpd}

newCabalPackage :: (MonadError Issue m, MonadIO m) => FilePath -> PkgName -> Version -> Dependencies -> m Status
newCabalPackage dir name version deps = do
  let package = emptyPackage name version deps
  liftIO $ writeGenericPackageDescription (dir </> (toString name <> ".cabal")) package
  pure Updated

emptyPackage :: PkgName -> Version -> Dependencies -> GenericPackageDescription
emptyPackage (P.PkgName name) version dependencies =
  let lib =
        emptyLibrary
          { libBuildInfo =
              emptyBuildInfo
                { targetBuildDepends = map mkCabalDependency (toDependencyList dependencies),
                  hsSourceDirs = [unsafeMakeSymbolicPath "src"]
                }
          }
   in GenericPackageDescription
        { packageDescription =
            emptyPackageDescription
              { package = PackageIdentifier (mkPackageName (toString name)) (toCabalVersion version),
                library = Just lib
              },
          condLibrary = Just (CondNode lib [] []),
          condExecutables = [],
          condTestSuites = [],
          condBenchmarks = [],
          gpdScannedVersion = Nothing,
          genPackageFlags = [],
          condSubLibraries = [],
          condForeignLibs = []
        }

err :: Pkg -> Text -> Issue
err pkg msg = Issue (P.pkgMemberId pkg) SeverityError msg Nothing

nativeSdist :: Pkg -> ConfigT ((Pkg, Maybe FilePath), [Issue])
nativeSdist pkg = do
  gpkg <- readCabalFile pkg
  outDir <- liftIO (makeAbsolute $ "./.hwm/sdist" </> toString (P.pkgName pkg))
  (filePath, issues) <- runNativeSDist pkg (flattenPackageDescription gpkg) outDir
  pure ((pkg, filePath), issues <> map (toIssue pkg) (checkPackage gpkg Nothing))

runNativeSDist :: Pkg -> PackageDescription -> FilePath -> ConfigT (Maybe FilePath, [Issue])
runNativeSDist pkg pkgDesc outDir = do
  let tarName = toString (P.pkgName pkg) <> "-" <> display (packageVersion (package pkgDesc)) <> ".tar.gz"
      -- We'll look for it here: package_dir/dist/package-version.tar.gz
      localDistDir = P.pkgDirPath pkg </> "dist"
      tempTarPath = localDistDir </> tarName
      finalPath = outDir </> tarName

  result <- liftIO $ try $ do
    -- Setup the HWM output dir
    removePathForcibly outDir
    createDirectoryIfMissing True outDir
    -- prepare the 'dist' folder inside the package dir and run sdist
    removePathForcibly localDistDir
    createDirectoryIfMissing True localDistDir
    withCurrentDirectory (P.pkgDirPath pkg) $ sdist pkgDesc (defaultSDistFlags {sDistVerbosity = toFlag Verbosity.silent}) (const "") knownSuffixHandlers
    exists <- doesFileExist tempTarPath
    if exists
      then renameFile tempTarPath finalPath >> pure (Just finalPath)
      else pure Nothing

  case result of
    Right (Just path) -> pure (Just path, [])
    Right Nothing ->
      pure (Nothing, [err pkg $ "Cabal sdist ran, but " <> toText tarName <> " was not found."])
    Left (e :: IOException) ->
      pure (Nothing, [err pkg $ "Cabal sdist IO Error: " <> show e])