Merge branch 'ghcup-run-improvements'

2022-07-12 00:10:17 +02:00 · 2022-07-12 00:10:17 +02:00 · 823275363c
commit 823275363c
parent 2f299ee48d 7a2a5074fa
12 changed files with 238 additions and 162 deletions
--- a/app/ghcup/GHCup/OptParse/ChangeLog.hs
+++ b/app/ghcup/GHCup/OptParse/ChangeLog.hs
@ -58,7 +58,7 @@ data ChangeLogOptions = ChangeLogOptions
    --[ Parsers ]--
    ---------------

-          
+
 changelogP :: Parser ChangeLogOptions
 changelogP =
  (\x y -> ChangeLogOptions x y)
@ -71,15 +71,16 @@ changelogP =
                "cabal" -> Right Cabal
                "ghcup" -> Right GHCup
                "stack" -> Right Stack
+                "hls"   -> Right HLS
                e       -> Left e
              )
            )
-            (short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
+            (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
              "Open changelog for given tool (default: ghc)"
              <> completer toolCompleter
            )
          )
-    <*> optional (toolVersionArgument Nothing Nothing)
+    <*> optional (toolVersionTagArgument Nothing Nothing)



@ -116,7 +117,8 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
      ver' = maybe
        (Right Latest)
        (\case
-          ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
+          GHCVersion tv  -> Left (_tvVersion tv)
+          ToolVersion tv -> Left tv
          ToolTag     t  -> Right t
        )
        clToolVer
--- a/app/ghcup/GHCup/OptParse/Common.hs
+++ b/app/ghcup/GHCup/OptParse/Common.hs
@ -70,20 +70,24 @@ import Control.Exception (evaluate)
    --[ Types ]--
    -------------

-data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
+data ToolVersion = GHCVersion GHCTargetVersion
+                 | ToolVersion Version
                 | ToolTag Tag

 -- a superset of ToolVersion
-data SetToolVersion = SetToolVersion GHCTargetVersion
+data SetToolVersion = SetGHCVersion GHCTargetVersion
+                    | SetToolVersion Version
                    | SetToolTag Tag
                    | SetRecommended
                    | SetNext

 prettyToolVer :: ToolVersion -> String
-prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
+prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
+prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
 prettyToolVer (ToolTag t) = show t

 toSetToolVer :: Maybe ToolVersion -> SetToolVersion
+toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
 toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
 toSetToolVer (Just (ToolTag t')) = SetToolTag t'
 toSetToolVer Nothing = SetRecommended
@ -96,10 +100,9 @@ toSetToolVer Nothing = SetRecommended
    --------------


-- | same as toolVersionParser, except as an argument.
-toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
-toolVersionArgument criteria tool =
-  argument (eitherReader toolVersionEither)
+toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
+toolVersionTagArgument criteria tool =
+  argument (eitherReader (parser tool))
    (metavar (mv tool)
    <> completer (tagCompleter (fromMaybe GHC tool) [])
    <> foldMap (completer . versionCompleter criteria) tool)
@ -108,20 +111,19 @@ toolVersionArgument criteria tool =
  mv (Just HLS) = "HLS_VERSION|TAG"
  mv _          = "VERSION|TAG"

+  parser (Just GHC) = ghcVersionTagEither
+  parser Nothing    = ghcVersionTagEither
+  parser _          = toolVersionTagEither

-versionParser :: Parser GHCTargetVersion
-versionParser = option
-  (eitherReader tVersionEither)
-  (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
-  )

 versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
 versionParser' criteria tool = argument
  (eitherReader (first show . version . T.pack))
  (metavar "VERSION"  <> foldMap (completer . versionCompleter criteria) tool)

-versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
-versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
+ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
+ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
+                                            (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)


 -- https://github.com/pcapriotti/optparse-applicative/issues/148
@ -230,9 +232,15 @@ isolateParser f = case isValid f && isAbsolute f of
              True -> Right $ normalise f
              False -> Left "Please enter a valid filepath for isolate dir."

-toolVersionEither :: String -> Either String ToolVersion
-toolVersionEither s' =
-  second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
+-- this accepts cross prefix
+ghcVersionTagEither :: String -> Either String ToolVersion
+ghcVersionTagEither s' =
+  second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
+
+-- this ignores cross prefix
+toolVersionTagEither :: String -> Either String ToolVersion
+toolVersionTagEither s' =
+  second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')

 tagEither :: String -> Either String Tag
 tagEither s' = case fmap toLower s' of
@ -244,10 +252,14 @@ tagEither s' = case fmap toLower s' of
  other         -> Left $ "Unknown tag " <> other


-tVersionEither :: String -> Either String GHCTargetVersion
-tVersionEither =
+ghcVersionEither :: String -> Either String GHCTargetVersion
+ghcVersionEither =
  first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack

+toolVersionEither :: String -> Either String Version
+toolVersionEither =
+  first (const "Not a valid version") . MP.parse version' "" . T.pack
+

 toolParser :: String -> Either String Tool
 toolParser s' | t == T.pack "ghc"   = Right GHC
@ -665,7 +677,7 @@ fromVersion' SetRecommended tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
  bimap mkTVer Just <$> getRecommended dls tool
    ?? TagNotFound Recommended tool
-fromVersion' (SetToolVersion v) tool = do
+fromVersion' (SetGHCVersion v) tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
  let vi = getVersionInfo (_tvVersion v) tool dls
  case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
@ -677,6 +689,18 @@ fromVersion' (SetToolVersion v) tool = do
          when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
          pure (GHCTargetVersion (_tvTarget v) v', Just vi')
        Nothing -> pure (v, vi)
+fromVersion' (SetToolVersion v) tool = do
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+  let vi = getVersionInfo v tool dls
+  case pvp $ prettyVer v of -- need to be strict here
+    Left _ -> pure (mkTVer v, vi)
+    Right pvpIn ->
+      lift (getLatestToolFor tool pvpIn dls) >>= \case
+        Just (pvp_, vi') -> do
+          v' <- lift $ pvpToVersion pvp_ ""
+          when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
+          pure (GHCTargetVersion mempty v', Just vi')
+        Nothing -> pure (mkTVer v, vi)
 fromVersion' (SetToolTag Latest) tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
  bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
--- a/app/ghcup/GHCup/OptParse/Compile.hs
+++ b/app/ghcup/GHCup/OptParse/Compile.hs
@ -401,7 +401,7 @@ hlsCompileOpts =
          )
        )
    <*> some (
-          option (eitherReader toolVersionEither)
+          option (eitherReader ghcVersionTagEither)
            (  long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
            <> completer (tagCompleter GHC [])
            <> completer (versionCompleter Nothing GHC))
--- a/app/ghcup/GHCup/OptParse/Install.hs
+++ b/app/ghcup/GHCup/OptParse/Install.hs
@ -196,7 +196,7 @@ installOpts tool =
                      <> completer (toolDlCompleter (fromMaybe GHC tool))
                    )
                  )
-            <*> (Just <$> toolVersionArgument Nothing tool)
+            <*> (Just <$> toolVersionTagArgument Nothing tool)
            )
        <|> pure (Nothing, Nothing)
        )
--- a/app/ghcup/GHCup/OptParse/Prefetch.hs
+++ b/app/ghcup/GHCup/OptParse/Prefetch.hs
@ -74,44 +74,44 @@ data PrefetchGHCOptions = PrefetchGHCOptions {
    --[ Parsers ]--
    ---------------

-          
+
 prefetchP :: Parser PrefetchCommand
 prefetchP = subparser
  (  command
      "ghc"
-      (info 
+      (info
        (PrefetchGHC
          <$> (PrefetchGHCOptions
                <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
                <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*>  optional (toolVersionArgument Nothing (Just GHC)) )
+          <*>  optional (toolVersionTagArgument Nothing (Just GHC)) )
        ( progDesc "Download GHC assets for installation")
      )
      <>
     command
      "cabal"
-      (info 
+      (info
        (PrefetchCabal
          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
+          <*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
        ( progDesc "Download cabal assets for installation")
      )
      <>
     command
      "hls"
-      (info 
+      (info
        (PrefetchHLS
          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
+          <*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
        ( progDesc "Download HLS assets for installation")
      )
      <>
     command
      "stack"
-      (info 
+      (info
        (PrefetchStack
          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
+          <*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
        ( progDesc "Download stack assets for installation")
      )
      <>
--- a/app/ghcup/GHCup/OptParse/Rm.hs
+++ b/app/ghcup/GHCup/OptParse/Rm.hs
@ -71,7 +71,7 @@ data RmOptions = RmOptions
    --[ Parsers ]--
    ---------------

-          
+
 rmParser :: Parser (Either RmCommand RmOptions)
 rmParser =
  (Left <$> subparser
@ -103,7 +103,7 @@ rmParser =


 rmOpts :: Maybe Tool -> Parser RmOptions
-rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
+rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool



--- a/app/ghcup/GHCup/OptParse/Run.hs
+++ b/app/ghcup/GHCup/OptParse/Run.hs
@ -5,6 +5,7 @@
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE ViewPatterns      #-}
 module GHCup.OptParse.Run where


@ -46,6 +47,7 @@ import qualified Data.Text                     as T
 #ifndef IS_WINDOWS
 import qualified System.Posix.Process          as SPP
 #endif
+import Data.Versions ( prettyVer, Version )



@ -88,7 +90,7 @@ runOpts =
          (short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
    <*> optional
          (option
-            (eitherReader toolVersionEither)
+            (eitherReader ghcVersionTagEither)
            (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
            <> completer (tagCompleter GHC [])
            <> (completer $ versionCompleter Nothing GHC)
@ -96,7 +98,7 @@ runOpts =
          )
    <*> optional
          (option
-            (eitherReader toolVersionEither)
+            (eitherReader toolVersionTagEither)
            (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
            <> completer (tagCompleter Cabal [])
            <> (completer $ versionCompleter Nothing Cabal)
@ -104,7 +106,7 @@ runOpts =
          )
    <*> optional
          (option
-            (eitherReader toolVersionEither)
+            (eitherReader toolVersionTagEither)
            (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
            <> completer (tagCompleter HLS [])
            <> (completer $ versionCompleter Nothing HLS)
@ -112,7 +114,7 @@ runOpts =
          )
    <*> optional
          (option
-            (eitherReader toolVersionEither)
+            (eitherReader toolVersionTagEither)
            (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
            <> completer (tagCompleter Stack [])
            <> (completer $ versionCompleter Nothing Stack)
@ -217,7 +219,7 @@ runRUN appState action' = do



-run :: forall m. 
+run :: forall m .
       ( MonadFail m
       , MonadMask m
       , MonadCatch m
@ -233,12 +235,16 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
   r <- if not runQuick
        then runRUN runAppState $ do
         toolchain <- liftE resolveToolchainFull
-         tmp <- liftIO $ createTmpDir toolchain
+
+         -- oh dear
+         r <- lift ask
+         tmp <- lift . lift . lift . flip runReaderT (fromAppState r) $ createTmpDir toolchain
+
         liftE $ installToolChainFull toolchain tmp
         pure tmp
        else runLeanRUN leanAppstate $ do
         toolchain <- resolveToolchain
-         tmp <- liftIO $ createTmpDir toolchain
+         tmp <- lift $ createTmpDir toolchain
         liftE $ installToolChain toolchain tmp
         pure tmp
   case r of
@ -268,17 +274,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do

  where

-   createTmpDir :: Toolchain -> IO FilePath
-   createTmpDir toolchain =
-     case runBinDir of
-           Just bindir -> do
-             createDirRecursive' bindir
-             canonicalizePath bindir
-           Nothing -> do
-             d <- predictableTmpDir toolchain
-             createDirRecursive' d
-             canonicalizePath d
-
   -- TODO: doesn't work for cross
   resolveToolchainFull :: ( MonadFail m
                           , MonadThrow m
@ -296,29 +291,33 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
           pure v
         cabalVer <- forM runCabalVer $ \ver -> do
           (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           pure v
+           pure (_tvVersion v)
         hlsVer <- forM runHLSVer $ \ver -> do
           (v, _) <- liftE $ fromVersion (Just ver) HLS
-           pure v
+           pure (_tvVersion v)
         stackVer <- forM runStackVer $ \ver -> do
           (v, _) <- liftE $ fromVersion (Just ver) Stack
-           pure v
+           pure (_tvVersion v)
         pure Toolchain{..}

   resolveToolchain = do
         ghcVer <- case runGHCVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (GHCVersion v) -> pure $ Just v
+            Just (ToolVersion v) -> pure $ Just (mkTVer v)
            Nothing -> pure Nothing
            _ -> fail "Internal error"
         cabalVer <- case runCabalVer of
+            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
            Just (ToolVersion v) -> pure $ Just v
            Nothing -> pure Nothing
            _ -> fail "Internal error"
         hlsVer <- case runHLSVer of
+            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
            Just (ToolVersion v) -> pure $ Just v
            Nothing -> pure Nothing
            _ -> fail "Internal error"
         stackVer <- case runStackVer of
+            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
            Just (ToolVersion v) -> pure $ Just v
            Nothing -> pure Nothing
            _ -> fail "Internal error"
@ -353,35 +352,43 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                              , MergeFileTreeError
                              ] (ResourceT (ReaderT AppState m)) ()
   installToolChainFull Toolchain{..} tmp = do
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
-           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
-           case mt of
-             Just (GHC, v) -> do
-               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
-                 (_tvVersion v)
-                 GHCupInternal
-                 False
-                 []
-               setTool GHC v tmp
-             Just (Cabal, v) -> do
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
-                 (_tvVersion v)
-                 GHCupInternal
-                 False
-               setTool Cabal v tmp
-             Just (Stack, v) -> do
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
-                 (_tvVersion v)
-                 GHCupInternal
-                 False
-               setTool Stack v tmp
-             Just (HLS, v) -> do
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
-                 (_tvVersion v)
-                 GHCupInternal
-                 False
-               setTool HLS v tmp
-             _ -> pure ()
+         case ghcVer of
+           Just v -> do
+             isInstalled <- lift $ checkIfToolInstalled' GHC v
+             unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+               (_tvVersion v)
+               GHCupInternal
+               False
+               []
+             setGHC' v tmp
+           _ -> pure ()
+         case cabalVer of
+           Just v -> do
+             isInstalled <- lift $ checkIfToolInstalled' Cabal (mkTVer v)
+             unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+               v
+               GHCupInternal
+               False
+             setCabal' v tmp
+           _ -> pure ()
+         case stackVer of
+           Just v -> do
+             isInstalled <- lift $ checkIfToolInstalled' Stack (mkTVer v)
+             unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+               v
+               GHCupInternal
+               False
+             setStack' v tmp
+           _ -> pure ()
+         case hlsVer of
+           Just v -> do
+             isInstalled <- lift $ checkIfToolInstalled' HLS (mkTVer v)
+             unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+               v
+               GHCupInternal
+               False
+             setHLS' v tmp
+           _ -> pure ()

   installToolChain :: ( MonadFail m
                       , MonadThrow m
@ -392,46 +399,47 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                    -> FilePath
                    -> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
   installToolChain Toolchain{..} tmp = do
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
-           case mt of
-             Just (GHC, v)   -> setTool GHC v tmp
-             Just (Cabal, v) -> setTool Cabal v tmp
-             Just (Stack, v) -> setTool Stack v tmp
-             Just (HLS, v)   -> setTool HLS v tmp
-             _ -> pure ()
+         case ghcVer of
+           Just v -> setGHC' v tmp
+           _ -> pure ()
+         case cabalVer of
+           Just v -> setCabal' v tmp
+           _ -> pure ()
+         case stackVer of
+           Just v -> setStack' v tmp
+           _ -> pure ()
+         case hlsVer of
+           Just v -> setHLS' v tmp
+           _ -> pure ()

-   setTool tool v tmp =
-      case tool of
-        GHC -> do
+   setGHC' v tmp = do
          void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
          void $ liftE $ setGHC v SetGHCOnly (Just tmp)
-        Cabal -> do
-          bin  <- liftE $ whereIsTool Cabal v
+   setCabal' v tmp = do
+          bin  <- liftE $ whereIsTool Cabal (mkTVer v)
          cbin <- liftIO $ canonicalizePath bin
          lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
-        Stack -> do
-          bin  <- liftE $ whereIsTool Stack v
+   setStack' v tmp = do
+          bin  <- liftE $ whereIsTool Stack (mkTVer v)
          cbin <- liftIO $ canonicalizePath bin
          lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
-        HLS -> do
+   setHLS' v tmp = do
          Dirs {..}  <- getDirs
-          let v' = _tvVersion v
-          legacy <- isLegacyHLS v'
+          legacy <- isLegacyHLS v
          if legacy
          then do
            -- TODO: factor this out
-            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
+            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? (NotInstalled HLS (mkTVer v))
            cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
            lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
-            hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
+            hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
            forM_ hlsBins $ \bin ->
              lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
-            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
+            liftE $ setHLS v SetHLSOnly (Just tmp)
          else do
-            liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
-            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
-        GHCup -> pure ()
-       
+            liftE $ setHLS v SetHLS_XYZ (Just tmp)
+            liftE $ setHLS v SetHLSOnly (Just tmp)
+
   addToPath path = do
    cEnv <- Map.fromList <$> getEnvironment
    let paths          = ["PATH", "Path"]
@ -443,16 +451,38 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
    liftIO $ setEnv pathVar newPath
    return envWithNewPath

-   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
-     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
+   createTmpDir :: ( MonadUnliftIO m
+                   , MonadCatch m
+                   , MonadThrow m
+                   , MonadMask m
+                   , MonadIO m
+                   )
+                => Toolchain
+                -> ReaderT LeanAppState m FilePath
+   createTmpDir toolchain =
+     case runBinDir of
+           Just bindir -> do
+             liftIO $ createDirRecursive' bindir
+             liftIO $ canonicalizePath bindir
+           Nothing -> do
+             d <- predictableTmpDir toolchain
+             liftIO $ createDirRecursive' d
+             liftIO $ canonicalizePath d
+
+   predictableTmpDir :: Monad m
+                     => Toolchain
+                     -> ReaderT LeanAppState m FilePath
+   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) = do
+     Dirs { tmpDir } <- getDirs
+     pure (fromGHCupPath tmpDir </> "ghcup-none")
   predictableTmpDir Toolchain{..} = do
-      tmp <- getTemporaryDirectory
-      pure $ tmp
+      Dirs { tmpDir } <- getDirs
+      pure $ fromGHCupPath tmpDir
        </> ("ghcup-" <> intercalate "_"
              (  maybe [] ( (:[]) . ("ghc-"   <>) . T.unpack . tVerToText) ghcVer
-              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
-              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . tVerToText) hlsVer
-              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
+              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . prettyVer) cabalVer
+              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . prettyVer) hlsVer
+              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . prettyVer) stackVer
              )
            )

@ -466,7 +496,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do

 data Toolchain = Toolchain
  { ghcVer     :: Maybe GHCTargetVersion
-  , cabalVer   :: Maybe GHCTargetVersion
-  , hlsVer     :: Maybe GHCTargetVersion
-  , stackVer   :: Maybe GHCTargetVersion
-  }
+  , cabalVer   :: Maybe Version
+  , hlsVer     :: Maybe Version
+  , stackVer   :: Maybe Version
+  } deriving Show
--- a/app/ghcup/GHCup/OptParse/Set.hs
+++ b/app/ghcup/GHCup/OptParse/Set.hs
@ -74,7 +74,7 @@ data SetOptions = SetOptions
    --[ Parsers ]--
    ---------------

-          
+
 setParser :: Parser (Either SetCommand SetOptions)
 setParser =
  (Left <$> subparser
@ -82,7 +82,7 @@ setParser =
          "ghc"
          (   SetGHC
          <$> info
-                (setOpts (Just GHC) <**> helper)
+                (setOpts GHC <**> helper)
                (  progDesc "Set GHC version"
                <> footerDoc (Just $ text setGHCFooter)
                )
@ -91,7 +91,7 @@ setParser =
           "cabal"
           (   SetCabal
           <$> info
-                 (setOpts (Just Cabal) <**> helper)
+                 (setOpts Cabal <**> helper)
                 (  progDesc "Set Cabal version"
                 <> footerDoc (Just $ text setCabalFooter)
                 )
@ -100,7 +100,7 @@ setParser =
           "hls"
           (   SetHLS
           <$> info
-                 (setOpts (Just HLS) <**> helper)
+                 (setOpts HLS <**> helper)
                 (  progDesc "Set haskell-language-server version"
                 <> footerDoc (Just $ text setHLSFooter)
                 )
@ -109,14 +109,14 @@ setParser =
           "stack"
           (   SetStack
           <$> info
-                 (setOpts (Just Stack) <**> helper)
+                 (setOpts Stack <**> helper)
                 (  progDesc "Set stack version"
                 <> footerDoc (Just $ text setStackFooter)
                 )
           )
      )
    )
-    <|> (Right <$> setOpts Nothing)
+    <|> (Right <$> setOpts GHC)
 where
  setGHCFooter :: String
  setGHCFooter = [s|Discussion:
@ -137,22 +137,25 @@ setParser =
    Sets the the current haskell-language-server version.|]


-setOpts :: Maybe Tool -> Parser SetOptions
+setOpts :: Tool -> Parser SetOptions
 setOpts tool = SetOptions <$>
    (fromMaybe SetRecommended <$>
      optional (setVersionArgument (Just ListInstalled) tool))

-setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
+setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
 setVersionArgument criteria tool =
  argument (eitherReader setEither)
    (metavar "VERSION|TAG|next"
-    <> completer (tagCompleter (fromMaybe GHC tool) ["next"])
-    <> foldMap (completer . versionCompleter criteria) tool)
+    <> completer (tagCompleter tool ["next"])
+    <> (completer . versionCompleter criteria) tool)
 where
  setEither s' =
        parseSet s'
    <|> second SetToolTag (tagEither s')
-    <|> second SetToolVersion (tVersionEither s')
+    <|> se s'
+  se s' = case tool of
+           GHC -> second SetGHCVersion (ghcVersionEither s')
+           _   -> second SetToolVersion (toolVersionEither s')
  parseSet s' = case fmap toLower s' of
                  "next" -> Right SetNext
                  other  -> Left $ "Unknown tag/version " <> other
@ -261,9 +264,9 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
  (Right sopts) -> do
    runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
    setGHC' sopts
-  (Left (SetGHC sopts)) -> setGHC' sopts
+  (Left (SetGHC sopts))   -> setGHC'   sopts
  (Left (SetCabal sopts)) -> setCabal' sopts
-  (Left (SetHLS sopts)) -> setHLS' sopts
+  (Left (SetHLS sopts))   -> setHLS'   sopts
  (Left (SetStack sopts)) -> setStack' sopts

 where
@ -271,7 +274,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
          -> m ExitCode
  setGHC' SetOptions{ sToolVer } =
    case sToolVer of
-      (SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
+      (SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
      _ -> runSetGHC runAppState (do
          v <- liftE $ fst <$> fromVersion' sToolVer GHC
          liftE $ setGHC v SetGHCOnly Nothing
@ -291,17 +294,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
            -> m ExitCode
  setCabal' SetOptions{ sToolVer } =
    case sToolVer of
-      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v)
+      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
      _ -> runSetCabal runAppState (do
          v <- liftE $ fst <$> fromVersion' sToolVer Cabal
          liftE $ setCabal (_tvVersion v)
          pure v
        )
      >>= \case
-            VRight GHCTargetVersion{..} -> do
+            VRight v -> do
              runLogger
                $ logInfo $
-                    "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
+                    "Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
              pure ExitSuccess
            VLeft  e -> do
              runLogger $ logError $ T.pack $ prettyShow e
@ -311,17 +314,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
          -> m ExitCode
  setHLS' SetOptions{ sToolVer } =
    case sToolVer of
-      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
+      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
      _ -> runSetHLS runAppState (do
          v <- liftE $ fst <$> fromVersion' sToolVer HLS
          liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
          pure v
        )
      >>= \case
-            VRight GHCTargetVersion{..} -> do
+            VRight v -> do
              runLogger
                $ logInfo $
-                    "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
+                    "HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
              pure ExitSuccess
            VLeft  e -> do
              runLogger $ logError $ T.pack $ prettyShow e
@ -332,17 +335,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
            -> m ExitCode
  setStack' SetOptions{ sToolVer } =
    case sToolVer of
-      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v)
+      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
      _ -> runSetStack runAppState (do
            v <- liftE $ fst <$> fromVersion' sToolVer Stack
            liftE $ setStack (_tvVersion v)
            pure v
          )
      >>= \case
-            VRight GHCTargetVersion{..} -> do
+            VRight v -> do
              runLogger
                $ logInfo $
-                    "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
+                    "Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
              pure ExitSuccess
            VLeft  e -> do
              runLogger $ logError $ T.pack $ prettyShow e
--- a/app/ghcup/GHCup/OptParse/Whereis.hs
+++ b/app/ghcup/GHCup/OptParse/Whereis.hs
@ -75,14 +75,14 @@ data WhereisOptions = WhereisOptions {
    --[ Parsers ]--
    ---------------

-          
+
 whereisP :: Parser WhereisCommand
 whereisP = subparser
-  (commandGroup "Tools locations:" <> 
+  (commandGroup "Tools locations:" <>
    command
      "ghc"
      (WhereisTool GHC <$> info
-        ( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
        ( progDesc "Get GHC location"
        <> footerDoc (Just $ text whereisGHCFooter ))
      )
@ -90,7 +90,7 @@ whereisP = subparser
     command
      "cabal"
      (WhereisTool Cabal <$> info
-        ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
        ( progDesc "Get cabal location"
        <> footerDoc (Just $ text whereisCabalFooter ))
      )
@ -98,7 +98,7 @@ whereisP = subparser
     command
      "hls"
      (WhereisTool HLS <$> info
-        ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
        ( progDesc "Get HLS location"
        <> footerDoc (Just $ text whereisHLSFooter ))
      )
@ -106,7 +106,7 @@ whereisP = subparser
     command
      "stack"
      (WhereisTool Stack <$> info
-        ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
        ( progDesc "Get stack location"
        <> footerDoc (Just $ text whereisStackFooter ))
      )
@ -268,7 +268,7 @@ whereis :: ( Monad m
 whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
  Dirs{ .. }  <- runReaderT getDirs leanAppstate
  case (whereisCommand, whereisOptions) of
-    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
+    (WhereisTool tool (Just (GHCVersion v)), WhereisOptions{..}) ->
      runLeanWhereIs leanAppstate (do
        loc <- liftE $ whereIsTool tool v
        if directory
@ -282,6 +282,20 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
              VLeft e -> do
                runLogger $ logError $ T.pack $ prettyShow e
                pure $ ExitFailure 30
+    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
+      runLeanWhereIs leanAppstate (do
+        loc <- liftE $ whereIsTool tool (mkTVer v)
+        if directory
+        then pure $ takeDirectory loc
+        else pure loc
+        )
+        >>= \case
+              VRight r -> do
+                liftIO $ putStr r
+                pure ExitSuccess
+              VLeft e -> do
+                runLogger $ logError $ T.pack $ prettyShow e
+                pure $ ExitFailure 30

    (WhereisTool tool whereVer, WhereisOptions{..}) -> do
      runWhereIs runAppState (do
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@ -238,7 +238,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                    | Just False <- optVerbose -> pure ()
                    | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
                         Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
-                           newTools <- lift checkForUpdates 
+                           newTools <- lift checkForUpdates
                           forM_ newTools $ \newTool@(t, l) -> do
                             -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
                             alreadyInstalling' <- alreadyInstalling optCommand newTool
@ -279,7 +279,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
              runAppState action' = do
                s' <- liftIO appState
                runReaderT action' s'
-                  
+

          -----------------
          -- Run command --
@ -339,16 +339,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
  alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)   = cmp' HLS instVer ver
  alreadyInstalling (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver) = cmp' Stack instVer ver
  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
-    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
+    (GHC, ver)   = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
-    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion tver) ver
  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion over) ver
  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
-  alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
+  alreadyInstalling (Upgrade {}) (GHCup, _) = pure True
  alreadyInstalling _ _ = pure False

  cmp' :: ( HasLog env
--- a/lib/GHCup/Errors.hs
+++ b/lib/GHCup/Errors.hs
@ -137,7 +137,7 @@ data AlreadyInstalled = AlreadyInstalled Tool Version

 instance Pretty AlreadyInstalled where
  pPrint (AlreadyInstalled tool ver') =
-    pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed;"
+    (pPrint tool <> text "-" <> pPrint ver') <+> text "is already installed;"
    <+> text "if you really want to reinstall it, you may want to run 'ghcup install cabal --force" <+> (pPrint ver' <> text "'")


--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -407,6 +407,9 @@ data AppState = AppState

 instance NFData AppState

+fromAppState :: AppState -> LeanAppState
+fromAppState AppState {..} = LeanAppState {..}
+
 data LeanAppState = LeanAppState
  { settings :: Settings
  , dirs :: Dirs