From 30ed7f02269775dc680e9dace0d5c0d2a39aaef0 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Mon, 24 Feb 2020 15:09:38 +0100
Subject: [PATCH] Oh yeah

---
 TODO.md      |  2 ++
 app/Main.hs  | 36 ++++++++++++++++++++++--------------
 lib/GHCup.hs | 10 ++++++++--
 3 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/TODO.md b/TODO.md
index 96345f8..ad8068c 100644
--- a/TODO.md
+++ b/TODO.md
@@ -2,6 +2,8 @@
 
 ## New
 
+* download progress
+
 * Downloads from URL
 * set                Set currently active GHC version
 * list               Show available GHCs and other tools
diff --git a/app/Main.hs b/app/Main.hs
index a199f99..428884a 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -35,7 +35,7 @@ import           System.Exit
 
 data Options = Options
   { optVerbose :: Bool
-  , optCache :: Bool
+  , optCache   :: Bool
   , optCommand :: Command
   }
 
@@ -44,13 +44,11 @@ data Command
   | InstallCabal InstallCabalOptions
 
 data InstallGHCOptions = InstallGHCOptions
-  {
-    ghcVer          :: Maybe Version
+  { ghcVer :: Maybe Version
   }
 
 data InstallCabalOptions = InstallCabalOptions
-  {
-    cabalVer        :: Maybe Version
+  { cabalVer :: Maybe Version
   }
 
 
@@ -120,17 +118,27 @@ main = do
     >>= \opt@Options {..} -> do
           let settings = toSettings opt
           -- wrapper to run effects with settings
-          let
-            runInstTool =
-              runLogger
-                . flip runReaderT settings
-                . runE
-                  @'[FileError, ArchiveError, ProcessError, URLException, PlatformResultError, NoDownload, NoCompatibleArch, DistroNotFound, TagNotFound, AlreadyInstalled]
+          let runInstTool =
+                runLogger
+                  . flip runReaderT settings
+                  . runE
+                    @'[ FileError
+                      , ArchiveError
+                      , ProcessError
+                      , URLException
+                      , PlatformResultError
+                      , NoDownload
+                      , NoCompatibleArch
+                      , DistroNotFound
+                      , TagNotFound
+                      , AlreadyInstalled
+                      , NotInstalled
+                      ]
 
           case optCommand of
             InstallGHC (InstallGHCOptions {..}) ->
               void
-                $ (runInstTool $ do
+                $   (runInstTool $ do
                       v <- maybe
                         (  getRecommended availableDownloads GHC
                         ?? TagNotFound Recommended GHC
@@ -142,7 +150,7 @@ main = do
                                           (OwnSpec availableDownloads)
                     )
                 >>= \case
-                      VRight _ -> pure ()
+                      VRight _ -> runLogger $ $(logInfo) ([s|GHC installation successful|])
                       VLeft (V (AlreadyInstalled treq)) ->
                         runLogger $ $(logWarn)
                           (T.pack (show treq) <> [s| already installed|])
@@ -161,7 +169,7 @@ main = do
                                           (OwnSpec availableDownloads)
                     )
                 >>= \case
-                      VRight _ -> pure ()
+                      VRight _ -> runLogger $ $(logInfo) ([s|Cabal installation successful|])
                       VLeft (V (AlreadyInstalled treq)) ->
                         runLogger $ $(logWarn)
                           (T.pack (show treq) <> [s| already installed|])
diff --git a/lib/GHCup.hs b/lib/GHCup.hs
index e8c0044..6f57fe2 100644
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -556,6 +556,7 @@ installTool :: ( MonadThrow m
                , MonadLogger m
                , MonadCatch m
                , MonadIO m
+               , MonadFail m
                )
             => ToolRequest
             -> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
@@ -570,6 +571,7 @@ installTool :: ( MonadThrow m
                   , NoDownload
                   , NoCompatibleArch
                   , DistroNotFound
+                  , NotInstalled
                   ]
                  m
                  ()
@@ -607,7 +609,9 @@ installTool treq mpfReq urlSource = do
 
   -- TODO: test if tool is already installed
   case treq of
-    (ToolRequest GHC   ver) -> liftE $ installGHC archiveSubdir ghcdir
+    (ToolRequest GHC   ver) -> do
+      liftE $ installGHC archiveSubdir ghcdir
+      liftE $ setGHC ver SetGHCOnly
     (ToolRequest Cabal ver) -> liftE $ installCabal archiveSubdir bindir
   pure ()
 
@@ -619,7 +623,7 @@ toolAlreadyInstalled ToolRequest {..} = case _tool of
 
 
 
--- | Install an unpacked GHC distribution.
+-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
 installGHC :: (MonadLogger m, MonadIO m)
            => Path Abs      -- ^ Path to the unpacked GHC bindist (where the configure script resides)
            -> Path Abs      -- ^ Path to install to
@@ -642,6 +646,7 @@ installCabal :: (MonadLogger m, MonadCatch m, MonadIO m)
 installCabal path inst = do
   lift $ $(logInfo) ([s|Installing cabal|])
   let cabalFile = [rel|cabal|] :: Path Rel
+  liftIO $ createDirIfMissing newDirPerms inst
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> cabalFile)
     (inst </> cabalFile)
@@ -667,6 +672,7 @@ setGHC ver sghc = do
 
   -- symlink destination
   destdir  <- liftIO $ ghcupBinDir
+  liftIO $ createDirIfMissing newDirPerms destdir
 
   -- for ghc tools (ghc, ghci, haddock, ...)
   verfiles <- ghcToolFiles ghcdir