Fixup rest of the PR

This reverts commit 300cfd3ba6.

.gitlab/script/ghcup_version.sh

@@ -116,7 +116,20 @@ else
 	if [ "${OS}" = "LINUX" ] ; then
 		eghcup --downloader=wget prefetch ghc 8.10.3
 		eghcup --offline install ghc 8.10.3
-	else # test wget a bit
+		if [ "${ARCH}" = "64" ] ; then
+			expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
+			actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
+			[ "${actual}" = "${expected}" ]
+			unset actual expected
+		fi
+	elif [ "${OS}" = "WINDOWS" ] ; then
+		eghcup prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
+		expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
+		actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
+		[ "${actual}" = "${expected}" ]
+		unset actual expected
+	else
 		eghcup prefetch ghc 8.10.3
 		eghcup --offline install ghc 8.10.3
 	fi
@@ -196,6 +209,21 @@ sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
 [ "${etag2}" = "${etag3}" ]
 [ "${sha2}" = "${sha3}" ]
 
+# test isolated installs
+eghcup install ghc -i "$(pwd)/isolated" 8.10.5
+[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
+! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
+if [ "${ARCH}" = "64" ] ; then
+	if [ "${OS}" = "LINUX" ] || [ "${OS}" = "WINDOWS" ] ; then
+		eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
+		[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
+		eghcup install stack -i "$(pwd)/isolated" 2.7.3
+		[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
+		eghcup install hls -i "$(pwd)/isolated" 1.3.0
+		[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
+			[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
+	fi
+fi
 
 eghcup upgrade
 eghcup upgrade -f

app/ghcup-gen/Validate.hs

@@ -237,7 +237,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
                   ($(logError) $ T.pack $ prettyShow e)
                 liftIO $ exitWith (ExitFailure 2)
 
-    let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
+    let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
 
     r <-
       runLogger

app/ghcup/BrickMain.hs

@@ -440,8 +440,10 @@ install' _ (_, ListResult {..}) = do
               , TagNotFound
               , DigestError
               , DownloadFailed
+              , DirNotEmpty
               , NoUpdate
               , TarDirDoesNotExist
+              , FileAlreadyExistsError
               ]
 
   run (do

app/ghcup/Main.hs

@@ -1469,6 +1469,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 #endif
                       , FileDoesNotExistError
                       , CopyError
+                      , NotInstalled
+                      , DirNotEmpty
                       , NoDownload
                       , NotInstalled
                       , BuildFailed
@@ -1478,6 +1480,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , TarDirDoesNotExist
                       , NextVerNotFound
                       , NoToolVersionSet
+                      , FileAlreadyExistsError
                       ]
 
           let runInstTool mInstPlatform action' = do
@@ -1579,6 +1582,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , NotInstalled
+                      , DirNotEmpty
 #if !defined(TAR)
                       , ArchiveResult
 #endif

bootstrap-haskell.ps1

@@ -371,7 +371,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
     Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
 
     Print-Msg -msg 'Installing Dependencies...'
-    Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl mingw-w64-x86_64-pkgconf'
+    Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf'
 
     Print-Msg -msg 'Updating SSL root certificate authorities...'
     Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'

lib/GHCup.hs

@@ -196,6 +196,7 @@ installGHCBindist :: ( MonadFail m
                         , NotInstalled
                         , UnknownArchive
                         , TarDirDoesNotExist
+                        , DirNotEmpty
 #if !defined(TAR)
                         , ArchiveResult
 #endif
@@ -218,12 +219,13 @@ installGHCBindist dlinfo ver isoFilepath = do
   -- prepare paths
   ghcdir <- lift $ ghcupGHCDir tver
 
+  toolchainSanityChecks
+  
   case isoFilepath of
     Just isoDir -> do                        -- isolated install
       lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
       liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
     Nothing -> do                            -- regular install
-      toolchainSanityChecks
       liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
 
       -- make symlinks & stuff when regular install,
@@ -261,6 +263,7 @@ installPackedGHC :: ( MonadMask m
                       '[ BuildFailed
                        , UnknownArchive
                        , TarDirDoesNotExist
+                       , DirNotEmpty
 #if !defined(TAR)
                        , ArchiveResult
 #endif
@@ -268,6 +271,8 @@ installPackedGHC :: ( MonadMask m
 installPackedGHC dl msubdir inst ver = do
   PlatformRequest {..} <- lift getPlatformReq
 
+  liftE $ installDestSanityCheck inst
+
   -- unpack
   tmpUnpack <- lift mkGhcupTmpDir
   liftE $ unpackToDir tmpUnpack dl
@@ -281,6 +286,22 @@ installPackedGHC dl msubdir inst ver = do
   liftE $ runBuildAction tmpUnpack
                          (Just inst)
                          (installUnpackedGHC workdir inst ver)
+ where
+  -- | Does basic checks for isolated installs
+  -- Isolated Directory:
+  --   1. if it doesn't exist -> proceed
+  --   2. if it exists and is empty -> proceed
+  --   3. if it exists and is non-empty -> panic and leave the house
+  installDestSanityCheck :: ( MonadIO m
+                            , MonadCatch m
+                            ) =>
+                            FilePath ->
+                            Excepts '[DirNotEmpty] m ()
+  installDestSanityCheck isoDir = do
+    hideErrorDef [doesNotExistErrorType] () $ do
+      contents <- liftIO $ getDirectoryContentsRecursive isoDir
+      unless (null contents) (throwE $ DirNotEmpty isoDir)
+
 
 
 -- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -311,10 +332,6 @@ installUnpackedGHC path inst ver = do
     setModificationTime dest mtime
 #else
   PlatformRequest {..} <- lift getPlatformReq
-  liftIO $ copyDirectoryRecursive path inst $ \source dest -> do
-    mtime <- getModificationTime source
-    copyFile source dest
-    setModificationTime dest mtime
 
   let alpineArgs
        | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
@@ -364,6 +381,7 @@ installGHCBin :: ( MonadFail m
                     , NotInstalled
                     , UnknownArchive
                     , TarDirDoesNotExist
+                    , DirNotEmpty
 #if !defined(TAR)
                     , ArchiveResult
 #endif
@@ -404,6 +422,7 @@ installCabalBindist :: ( MonadMask m
 #if !defined(TAR)
                           , ArchiveResult
 #endif
+                          , FileAlreadyExistsError
                           ]
                          m
                          ()
@@ -440,10 +459,10 @@ installCabalBindist dlinfo ver isoFilepath = do
   case isoFilepath of
     Just isoDir -> do             -- isolated install
       lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
-      liftE $ installCabalUnpacked workdir isoDir ver
+      liftE $ installCabalUnpacked workdir isoDir Nothing
 
     Nothing -> do                 -- regular install
-      liftE $ installCabalUnpacked workdir binDir ver
+      liftE $ installCabalUnpacked workdir binDir (Just ver)
 
       -- create symlink if this is the latest version for regular installs
       cVers <- lift $ fmap rights getInstalledCabals
@@ -454,13 +473,15 @@ installCabalBindist dlinfo ver isoFilepath = do
 installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
-              -> Version
-              -> Excepts '[CopyError] m ()
-installCabalUnpacked path inst ver = do
+              -> Maybe Version -- ^ Nothing for isolated install
+              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
+installCabalUnpacked path inst mver' = do
   lift $ $(logInfo) "Installing cabal"
   let cabalFile = "cabal"
   liftIO $ createDirRecursive' inst
-  let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
+  let destFileName = cabalFile
+        <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
+        <> exeExt
   let destPath = inst </> destFileName
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> cabalFile <> exeExt)
@@ -497,6 +518,7 @@ installCabalBin :: ( MonadMask m
 #if !defined(TAR)
                       , ArchiveResult
 #endif
+                      , FileAlreadyExistsError
                       ]
                      m
                      ()
@@ -565,10 +587,10 @@ installHLSBindist dlinfo ver isoFilepath = do
   case isoFilepath of
     Just isoDir -> do
       lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
-      liftE $ installHLSUnpacked workdir isoDir ver
+      liftE $ installHLSUnpacked workdir isoDir Nothing
 
     Nothing -> do
-      liftE $ installHLSUnpacked workdir binDir ver
+      liftE $ installHLSUnpacked workdir binDir (Just ver)
 
       -- create symlink if this is the latest version in a regular install
       hlsVers <- lift $ fmap rights getInstalledHLSs
@@ -580,9 +602,9 @@ installHLSBindist dlinfo ver isoFilepath = do
 installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
-              -> Version
+              -> Maybe Version -- ^ Nothing for isolated install
               -> Excepts '[CopyError] m ()
-installHLSUnpacked path inst ver = do
+installHLSUnpacked path inst mver' = do
   lift $ $(logInfo) "Installing HLS"
   liftIO $ createDirRecursive' inst
 
@@ -595,7 +617,8 @@ installHLSUnpacked path inst ver = do
     )
   forM_ bins $ \f -> do
     let toF = dropSuffix exeExt f
-              <> "~" <> T.unpack (prettyVer ver) <> exeExt
+              <> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
+              <> exeExt
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile
       (path </> f)
       (inst </> toF)
@@ -603,7 +626,9 @@ installHLSUnpacked path inst ver = do
 
   -- install haskell-language-server-wrapper
   let wrapper = "haskell-language-server-wrapper"
-      toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
+      toF = wrapper
+            <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
+            <> exeExt
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> wrapper <> exeExt)
     (inst </> toF)
@@ -743,9 +768,9 @@ installStackBindist dlinfo ver isoFilepath = do
   case isoFilepath of
     Just isoDir -> do                 -- isolated install
       lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
-      liftE $ installStackUnpacked workdir isoDir ver
+      liftE $ installStackUnpacked workdir isoDir Nothing
     Nothing -> do                     -- regular install
-      liftE $ installStackUnpacked workdir binDir ver
+      liftE $ installStackUnpacked workdir binDir (Just ver)
 
       -- create symlink if this is the latest version and a regular install
       sVers <- lift $ fmap rights getInstalledStacks
@@ -757,13 +782,15 @@ installStackBindist dlinfo ver isoFilepath = do
 installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
-              -> Version
+              -> Maybe Version -- ^ Nothing for isolated installs
               -> Excepts '[CopyError] m ()
-installStackUnpacked path inst ver = do
+installStackUnpacked path inst mver' = do
   lift $ $(logInfo) "Installing stack"
   let stackFile = "stack"
   liftIO $ createDirRecursive' inst
-  let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
+  let destFileName = stackFile
+                     <> maybe "" (("-" <>) .  T.unpack . prettyVer) mver'
+                     <> exeExt
   let destPath = inst </> destFileName
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> stackFile <> exeExt)
@@ -1763,6 +1790,7 @@ compileGHC :: ( MonadMask m
                  , UnknownArchive
                  , TarDirDoesNotExist
                  , NotInstalled
+                 , DirNotEmpty
 #if !defined(TAR)
                  , ArchiveResult
 #endif
@@ -2251,6 +2279,7 @@ upgradeGHCup mtarget force' = do
     -------------
 
 
+
 -- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
 -- both installing from source and bindist.
 postGHCInstall :: ( MonadReader env m

lib/GHCup/Download.hs

@@ -172,21 +172,31 @@ getBase :: ( MonadReader env m
         -> Excepts '[JSONError] m GHCupInfo
 getBase uri = do
   Settings { noNetwork } <- lift getSettings
-  yaml <- lift $ yamlFromCache uri
-  unless noNetwork $
-    handleIO (\e -> warnCache (displayException e))
-      . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e))
-      . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
-      . smartDl
-      $ uri
+
+  -- try to download yaml... usually this writes it into cache dir,
+  -- but in some cases not (e.g. when using file://), so we honour
+  -- the return filepath, if any
+  mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
+           then pure Nothing
+           else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
+               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
+               . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
+               . fmap Just
+               . smartDl
+               $ uri
+
+  -- if we didn't get a filepath from the download, use the cached yaml
+  actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
+  lift $ $(logDebug) [i|Decoding yaml at: #{actualYaml}|]
+
   liftE
-    . onE_ (onError yaml)
+    . onE_ (onError actualYaml)
     . lEM' @_ @_ @'[JSONError] JSONDecodeError
     . fmap (first (\e -> [i|#{displayException e}
-Consider removing "#{yaml}" manually.|]))
+Consider removing "#{actualYaml}" manually.|]))
     . liftIO
     . Y.decodeFileEither
-    $ yaml
+    $ actualYaml
  where
   -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
   -- may re-download and succeed.
@@ -221,28 +231,32 @@ Consider removing "#{yaml}" manually.|]))
                 , DigestError
                 ]
                m1
-               ()
+               FilePath
   smartDl uri' = do
     json_file <- lift $ yamlFromCache uri'
+    let scheme = view (uriSchemeL' % schemeBSL') uri'
     e <- liftIO $ doesFileExist json_file
     currentTime <- liftIO getCurrentTime
-    if e
-      then do
-        accessTime <- liftIO $ getAccessTime json_file
+    Dirs { cacheDir } <- lift getDirs
 
-        -- access time won't work on most linuxes, but we can try regardless
-        when ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) $
-          -- no access in last 5 minutes, re-check upstream mod time
-          dlWithMod currentTime json_file
-      else
-        dlWithMod currentTime json_file
+       -- for local files, let's short-circuit and ignore access time
+    if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
+       | e -> do
+          accessTime <- liftIO $ getAccessTime json_file
+
+          -- access time won't work on most linuxes, but we can try regardless
+          if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) ->
+                -- no access in last 5 minutes, re-check upstream mod time
+                dlWithMod currentTime json_file
+             | otherwise -> pure json_file
+       | otherwise -> dlWithMod currentTime json_file
    where
     dlWithMod modTime json_file = do
       let (dir, fn) = splitFileName json_file
       f <- liftE $ download uri' Nothing dir (Just fn) True
       liftIO $ setModificationTime f modTime
       liftIO $ setAccessTime f modTime
- 
+      pure f
 
 
 getDownloadInfo :: ( MonadReader env m
@@ -304,27 +318,25 @@ download :: ( MonadReader env m
             )
          => URI
          -> Maybe T.Text      -- ^ expected hash
-         -> FilePath          -- ^ destination dir
+         -> FilePath          -- ^ destination dir (ignored for file:// scheme)
          -> Maybe FilePath    -- ^ optional filename
          -> Bool              -- ^ whether to read an write etags
          -> Excepts '[DigestError , DownloadFailed] m FilePath
 download uri eDigest dest mfn etags
   | scheme == "https" = dl
   | scheme == "http"  = dl
-  | scheme == "file"  = cp
+  | scheme == "file"  = do
+      let destFile' = T.unpack . decUTF8Safe $ path
+      lift $ $(logDebug) [i|using local file: #{destFile'}|]
+      forM_ eDigest (liftE . flip checkDigest destFile')
+      pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
   scheme = view (uriSchemeL' % schemeBSL') uri
-  cp     = do
-    -- destination dir must exist
-    liftIO $ createDirRecursive' dest
-    let fromFile = T.unpack . decUTF8Safe $ path
-    liftIO $ copyFile fromFile destFile
-    pure destFile
   dl = do
-    let uri' = decUTF8Safe (serializeURIRef' uri)
-    lift $ $(logInfo) [i|downloading: #{uri'}|]
+    destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
+    lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|]
 
     -- destination dir must exist
     liftIO $ createDirRecursive' dest
@@ -366,7 +378,7 @@ download uri eDigest dest mfn etags
                             _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
                               :: V '[MalformedHeaders]))
 
-                          writeEtags (parseEtags headers)
+                          writeEtags destFile (parseEtags headers)
                     else
                       liftE $ lEM @_ @'[ProcessError] $ exec "curl" 
                         (o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
@@ -383,13 +395,13 @@ download uri eDigest dest mfn etags
                         case _exitCode of
                           ExitSuccess -> do
                             liftIO $ copyFile destFileTemp destFile
-                            writeEtags (parseEtags (decUTF8Safe' _stdErr))
+                            writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
                           ExitFailure i'
                             | i' == 8
                             , Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
                                      -> do
                                           $logDebug "Not modified, skipping download"
-                                          writeEtags (parseEtags (decUTF8Safe' _stdErr))
+                                          writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
                             | otherwise -> throwE (NonZeroExit i' "wget" opts)
                       else do
                         let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
@@ -404,10 +416,10 @@ download uri eDigest dest mfn etags
                       let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
                                                                          , E.encodeUtf8 etag)]) metag
                       liftE
-                        $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags (pure $ Just etag))
+                        $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
                         $ do
                           r <- downloadToFile https host fullPath port destFile addHeaders
-                          writeEtags (pure $ decUTF8Safe <$> getHeader r "etag")
+                          writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
                     else void $ liftE $ catchE @HTTPNotModified
                                         @'[DownloadFailed]
                                    (\e@(HTTPNotModified _) ->
@@ -420,12 +432,18 @@ download uri eDigest dest mfn etags
 
 
   -- Manage to find a file we can write the body into.
-  destFile :: FilePath
-  destFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
-                  (dest </>)
-                  mfn
+  getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
+  getDestFile = 
+    case mfn of
+        Just fn -> pure (dest </> fn)
+        Nothing
+          | let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
+          , not (null urlBase) -> pure (dest </> urlBase)
+          -- TODO: remove this once we use hpath again
+          | otherwise -> throwE $ NoUrlBase uri'
 
   path = view pathL' uri
+  uri' = decUTF8Safe (serializeURIRef' uri)
 
   parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
   parseEtags stderr = do
@@ -444,8 +462,8 @@ download uri eDigest dest mfn etags
         $logDebug "No etags header found"
         pure Nothing
 
-  writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => m (Maybe T.Text) -> m ()
-  writeEtags getTags = do
+  writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
+  writeEtags destFile getTags = do
     getTags >>= \case
       Just t -> do
         $logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]

lib/GHCup/Errors.hs

@@ -134,6 +134,13 @@ instance Pretty AlreadyInstalled where
   pPrint (AlreadyInstalled tool ver') =
     text [i|#{tool}-#{prettyShow ver'} is already installed|]
 
+-- | The Directory is supposed to be empty, but wasn't.
+data DirNotEmpty = DirNotEmpty {path :: FilePath}
+
+instance Pretty DirNotEmpty where
+  pPrint (DirNotEmpty path) = do
+    text [i|The directory was expected to be empty, but isn't: #{path}|]
+
 -- | The tool is not installed. Some operations rely on a tool
 -- to be installed (such as setting the current GHC version).
 data NotInstalled = NotInstalled Tool GHCTargetVersion
@@ -168,6 +175,16 @@ instance Pretty FileDoesNotExistError where
   pPrint (FileDoesNotExistError file) =
     text [i|File "#{file}" does not exist.|]
 
+-- | The file already exists
+-- (e.g. when we use isolated installs with the same path).
+-- (e.g. This is done to prevent any overwriting)
+data FileAlreadyExistsError = FileAlreadyExistsError FilePath
+  deriving Show
+
+instance Pretty FileAlreadyExistsError where
+  pPrint (FileAlreadyExistsError file) =
+    text [i|File "#{file}" Already exists.|]
+
 data TarDirDoesNotExist = TarDirDoesNotExist TarDir
   deriving Show
 
@@ -327,6 +344,15 @@ instance Pretty UnexpectedListLength where
 
 instance Exception UnexpectedListLength
 
+data NoUrlBase = NoUrlBase Text
+  deriving Show
+
+instance Pretty NoUrlBase where
+  pPrint (NoUrlBase url) =
+    text [i|Couldn't get a base filename from url #{url}|]
+
+instance Exception NoUrlBase
+
 
 
     ------------------------