stack-clean-old-0.4.8: src/GHCTarball.hs

module GHCTarball (
  listGhcTarballs,
  removeGhcMinorTarball,
  removeGhcVersionTarball
  )
where

import Control.Monad.Extra
import Data.Char (isDigit)
import Data.List.Extra
import Data.Version.Extra
import SimpleCmd
import System.FilePath (dropExtension)
import System.FilePath.Glob

import Directories (getStackProgramsDir, traversePlatforms)
import qualified Remove
import Types
import Versions

-- setStackProgramsDir :: Maybe String -> IO ()
-- setStackProgramsDir msystem =
--   getStackProgramsDir >>= switchToSystemDirUnder msystem

getGhcTarballs :: Maybe Version -> IO [FilePath]
getGhcTarballs mghcver = do
  sortOn ghcTarballVersion . map (dropPrefix "./") <$> namesMatching ("ghc" ++ matchVersion ++ ".tar.*")
  where
    matchVersion =
      case mghcver of
        Nothing -> "*"
        Just ver ->
          "*-" ++ showVersion ver ++ if isMajorVersion ver then "*" else ""

ghcTarballVersion :: FilePath -> Version
ghcTarballVersion =
  readVersion . checkChars . takeWhileEnd (/= '-') .  dropSuffix ".tar" . dropExtension
  where
    checkChars vs =
      let isVerChar c = isDigit c || c == '.'
      in if all isVerChar vs
         then vs
         else error $ "unknown version:" +-+ vs

listGhcTarballs :: Maybe Version -> Maybe String -> IO ()
listGhcTarballs mghcver msystem = do
  traversePlatforms getStackProgramsDir msystem $ do
    files <- getGhcTarballs mghcver
    mapM_ putStrLn $
      case mghcver of
        Nothing -> files
        Just ghcver -> filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . ghcTarballVersion) files

removeGhcVersionTarball :: Deletion -> Version -> Maybe String -> IO ()
removeGhcVersionTarball deletion ghcver msystem = do
  traversePlatforms getStackProgramsDir msystem $ do
    files <- getGhcTarballs (Just ghcver)
    case files of
      [] -> putStrLn $ "Tarball for " ++ showVersion ghcver ++ " not found"
      [g] | not (isMajorVersion ghcver) -> doRemoveGhcTarballVersion deletion g
      gs -> if isMajorVersion ghcver then do
        Remove.prompt deletion ("all stack ghc " ++ showVersion ghcver ++ " tarballs: ")
        mapM_ (doRemoveGhcTarballVersion deletion) gs
        else error' "more than one match found!!"

removeGhcMinorTarball :: Deletion -> Maybe Version -> Maybe String
                           -> IO ()
removeGhcMinorTarball deletion mghcver msystem = do
  traversePlatforms getStackProgramsDir msystem $ do
    files <- getGhcTarballs (majorVersion <$> mghcver)
    case mghcver of
      Nothing -> do
        let majors = groupOn (majorVersion . ghcTarballVersion) files
        forM_ majors $ \ minors ->
          forM_ (init minors) $ doRemoveGhcTarballVersion deletion
      Just ghcver -> do
        let minors = filter ((< ghcver) . ghcTarballVersion) files
        forM_ minors $ doRemoveGhcTarballVersion deletion

doRemoveGhcTarballVersion :: Deletion -> FilePath -> IO ()
doRemoveGhcTarballVersion deletion ghctarball = do
  Remove.removeFile deletion ghctarball
  putStrLn $ ghctarball ++ " tarball " ++ (if isDelete deletion then "" else "would be ") ++ "removed"