From a269131e2d6f02c018e720dc0c76e95959b9ace6 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Thu, 17 Sep 2020 21:21:16 +0200
Subject: [PATCH] Allow to compile over existing version, fixes #59

---
 app/ghcup/Main.hs  |  1 +
 lib/GHCup.hs       | 12 ++++++++++--
 lib/GHCup/Utils.hs |  4 ++--
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index 067016e..6f6f2b9 100644
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -992,6 +992,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , PatchFailed
                       , UnknownArchive
                       , TarDirDoesNotExist
+                      , NotInstalled
 #if !defined(TAR)
                       , ArchiveResult
 #endif
diff --git a/lib/GHCup.hs b/lib/GHCup.hs
index 820edb2..48cdcc1 100644
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -807,6 +807,7 @@ compileGHC :: ( MonadMask m
                  , PatchFailed
                  , UnknownArchive
                  , TarDirDoesNotExist
+                 , NotInstalled
 #if !defined(TAR)
                  , ArchiveResult
 #endif
@@ -816,8 +817,9 @@ compileGHC :: ( MonadMask m
 compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformRequest {..})
   = do
     lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
-    whenM (lift $ ghcInstalled tver)
-          (throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
+
+    alreadyInstalled <- lift $ ghcInstalled tver
+    alreadySet <- fmap (maybe False (==tver)) $ lift $ ghcSet (_tvTarget tver)
 
     -- download source tarball
     dlInfo <-
@@ -847,6 +849,9 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformReque
         pure (b, bmk)
       )
 
+    when alreadyInstalled $ do
+      lift $ $(logInfo) [i|Deleting existing installation|]
+      liftE $ rmGHCVer tver
     liftE $ installPackedGHC bindist
                              (view dlSubdir dlInfo)
                              ghcdir
@@ -856,6 +861,9 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformReque
     liftIO $ writeFile (ghcdir </> ghcUpSrcBuiltFile) (Just newFilePerms) bmk
 
     reThrowAll GHCupSetError $ postGHCInstall tver
+
+    -- restore
+    when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
     pure ()
 
  where
diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs
index ea88dcb..f8ccc3a 100644
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -596,8 +596,8 @@ getChangeLog dls tool (Right tag) =
 --   1. the build directory, depending on the KeepDirs setting
 --   2. the install destination, depending on whether the build failed
 runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m)
-               => Path Abs          -- ^ build directory
-               -> Maybe (Path Abs)  -- ^ install location (e.g. for GHC)
+               => Path Abs          -- ^ build directory (cleaned up depending on Settings)
+               -> Maybe (Path Abs)  -- ^ dir to *always* clean up on exception
                -> Excepts e m a
                -> Excepts '[BuildFailed] m a
 runBuildAction bdir instdir action = do