Install autoconf in msys2 wrt #200

.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

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

@@ -448,19 +448,19 @@ install' _ (_, ListResult {..}) = do
       case lTool of
         GHC   -> do
           let vi = getVersionInfo lVer GHC dls
-          liftE $ installGHCBin lVer Nothing $> vi
+          liftE $ installGHCBin lVer $> vi
         Cabal -> do
           let vi = getVersionInfo lVer Cabal dls
-          liftE $ installCabalBin lVer Nothing $> vi
+          liftE $ installCabalBin lVer $> vi
         GHCup -> do
           let vi = snd <$> getLatest dls GHCup
           liftE $ upgradeGHCup Nothing False $> vi
         HLS   -> do
           let vi = getVersionInfo lVer HLS dls
-          liftE $ installHLSBin lVer Nothing $> vi
+          liftE $ installHLSBin lVer $> vi
         Stack -> do
           let vi = getVersionInfo lVer Stack dls
-          liftE $ installStackBin lVer Nothing $> vi
+          liftE $ installStackBin lVer $> vi
     )
     >>= \case
           VRight vi                         -> do

app/ghcup/Main.hs

@@ -138,7 +138,6 @@ data InstallOptions = InstallOptions
   , instPlatform :: Maybe PlatformRequest
   , instBindist  :: Maybe URI
   , instSet      :: Bool
-  , isolateDir   :: Maybe FilePath
   }
 
 data SetCommand = SetGHC SetOptions
@@ -186,7 +185,6 @@ data GHCCompileOptions = GHCCompileOptions
   , ovewrwiteVer :: Maybe Version
   , buildFlavour :: Maybe String
   , hadrian      :: Bool
-  , isolateDir   :: Maybe FilePath
   }
 
 data UpgradeOpts = UpgradeInplace
@@ -576,7 +574,7 @@ Examples:
 
 installOpts :: Maybe Tool -> Parser InstallOptions
 installOpts tool =
-  (\p (u, v) b is -> InstallOptions v p u b is)
+  (\p (u, v) b -> InstallOptions v p u b)
     <$> optional
           (option
             (eitherReader platformParser)
@@ -605,15 +603,6 @@ installOpts tool =
           (long "set" <> help
             "Set as active version after install"
           )
-    <*> optional
-          (option
-           (eitherReader isolateParser)
-           (  short 'i'
-           <> long "isolate"
-           <> metavar "DIR"
-           <> help "install in an isolated dir instead of the default one"
-           )
-          )
 
 
 setParser :: Parser (Either SetCommand SetOptions)
@@ -1011,15 +1000,6 @@ ghcCompileOpts =
     <*> switch
           (long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
           )
-    <*> optional
-          (option
-            (eitherReader isolateParser)
-            (  short 'i'
-            <> long "isolate"
-            <> metavar "DIR"
-            <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
-            )
-           )
 
 
 toolVersionParser :: Parser ToolVersion
@@ -1235,10 +1215,6 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
 bindistParser :: String -> Either String URI
 bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
 
-isolateParser :: FilePath -> Either String FilePath
-isolateParser f = case isValid f of
-              True -> Right $ normalise f
-              False -> Left "Please enter a valid filepath for isolate dir."
 
 toSettings :: Options -> IO (Settings, KeyBindings)
 toSettings options = do
@@ -1641,23 +1617,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           -----------------------
 
           let installGHC InstallOptions{..} =
-                (case instBindist of
+                  (case instBindist of
-                   Nothing -> runInstTool instPlatform $ do
+                     Nothing -> runInstTool instPlatform $ do
-                     (v, vi) <- liftE $ fromVersion instVer GHC
-                     liftE $ installGHCBin (_tvVersion v) isolateDir
-                     when instSet $ void $ liftE $ setGHC v SetGHCOnly
-                     pure vi
-                   Just uri -> do
-                     s' <- liftIO appState
-                     runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
                        (v, vi) <- liftE $ fromVersion instVer GHC
-                       liftE $ installGHCBindist
+                       liftE $ installGHCBin (_tvVersion v)
-                         (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
-                         (_tvVersion v)
-                         isolateDir
                        when instSet $ void $ liftE $ setGHC v SetGHCOnly
                        pure vi
-                  )
+                     Just uri -> do
+                       s' <- liftIO appState
+                       runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
+                         (v, vi) <- liftE $ fromVersion instVer GHC
+                         liftE $ installGHCBindist
+                           (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
+                           (_tvVersion v)
+                         when instSet $ void $ liftE $ setGHC v SetGHCOnly
+                         pure vi
+                    )
                     >>= \case
                           VRight vi -> do
                             runLogger $ $(logInfo) "GHC installation successful"
@@ -1686,7 +1661,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 (case instBindist of
                    Nothing -> runInstTool instPlatform $ do
                      (v, vi) <- liftE $ fromVersion instVer Cabal
-                     liftE $ installCabalBin (_tvVersion v) isolateDir
+                     liftE $ installCabalBin (_tvVersion v)
                      pure vi
                    Just uri -> do
                      s' <- appState
@@ -1695,7 +1670,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                        liftE $ installCabalBindist
                            (DownloadInfo uri Nothing "")
                            (_tvVersion v)
-                           isolateDir
                        pure vi
                   )
                   >>= \case
@@ -1715,10 +1689,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           pure $ ExitFailure 4
 
           let installHLS InstallOptions{..} =
-                 (case instBindist of
+                (case instBindist of
                    Nothing -> runInstTool instPlatform $ do
                      (v, vi) <- liftE $ fromVersion instVer HLS
-                     liftE $ installHLSBin (_tvVersion v) isolateDir
+                     liftE $ installHLSBin (_tvVersion v)
                      pure vi
                    Just uri -> do
                      s' <- appState
@@ -1727,7 +1701,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                        liftE $ installHLSBindist
                            (DownloadInfo uri Nothing "")
                            (_tvVersion v)
-                           isolateDir
                        pure vi
                   )
                   >>= \case
@@ -1747,20 +1720,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           pure $ ExitFailure 4
 
           let installStack InstallOptions{..} =
-                 (case instBindist of
+                (case instBindist of
-                    Nothing -> runInstTool instPlatform $ do
+                   Nothing -> runInstTool instPlatform $ do
-                      (v, vi) <- liftE $ fromVersion instVer Stack
+                     (v, vi) <- liftE $ fromVersion instVer Stack
-                      liftE $ installStackBin (_tvVersion v) isolateDir
+                     liftE $ installStackBin (_tvVersion v)
-                      pure vi
+                     pure vi
-                    Just uri -> do
+                   Just uri -> do
-                      s' <- appState
+                     s' <- appState
-                      runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
+                     runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
-                        (v, vi) <- liftE $ fromVersion instVer Stack
+                       (v, vi) <- liftE $ fromVersion instVer Stack
-                        liftE $ installStackBindist
+                       liftE $ installStackBindist
-                            (DownloadInfo uri Nothing "")
+                           (DownloadInfo uri Nothing "")
-                            (_tvVersion v)
+                           (_tvVersion v)
-                            isolateDir
+                       pure vi
-                        pure vi
                   )
                   >>= \case
                         VRight vi -> do
@@ -1989,7 +1961,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             addConfArgs
                             buildFlavour
                             hadrian
-                            isolateDir
                 GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
                 let vi = getVersionInfo (_tvVersion targetVer) GHC dls
                 when setCompile $ void $ liftE $

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

@@ -186,7 +186,6 @@ installGHCBindist :: ( MonadFail m
                      )
                   => DownloadInfo    -- ^ where/how to download
                   -> Version         -- ^ the version to install
-                  -> Maybe FilePath  -- ^ isolated filepath if user passed any
                   -> Excepts
                        '[ AlreadyInstalled
                         , BuildFailed
@@ -202,15 +201,10 @@ installGHCBindist :: ( MonadFail m
                         ]
                        m
                        ()
-installGHCBindist dlinfo ver isoFilepath = do
+installGHCBindist dlinfo ver = do
   let tver = mkTVer ver
-
   lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
-
+  whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
-  case isoFilepath of
-    -- we only care for already installed errors in regular (non-isolated) installs
-    Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
-    _ -> pure ()
 
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
@@ -218,16 +212,11 @@ installGHCBindist dlinfo ver isoFilepath = do
   -- prepare paths
   ghcdir <- lift $ ghcupGHCDir tver
 
-  case isoFilepath of
+  toolchainSanityChecks
-    Just isoDir -> do                        -- isolated install
+  
-      lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
+  liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
-      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,
+  liftE $ postGHCInstall tver
-      liftE $ postGHCInstall tver
 
  where
   toolchainSanityChecks = do
@@ -311,10 +300,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
@@ -354,7 +339,6 @@ installGHCBin :: ( MonadFail m
                  , MonadUnliftIO m
                  )
               => Version         -- ^ the version to install
-              -> Maybe FilePath  -- ^ isolated install filepath, if user passed any
               -> Excepts
                    '[ AlreadyInstalled
                     , BuildFailed
@@ -370,9 +354,9 @@ installGHCBin :: ( MonadFail m
                     ]
                    m
                    ()
-installGHCBin ver isoFilepath = do
+installGHCBin ver = do
   dlinfo <- liftE $ getDownloadInfo GHC ver
-  installGHCBindist dlinfo ver isoFilepath
+  installGHCBindist dlinfo ver
 
 
 -- | Like 'installCabalBin', except takes the 'DownloadInfo' as
@@ -391,7 +375,6 @@ installCabalBindist :: ( MonadMask m
                        )
                     => DownloadInfo
                     -> Version
-                    -> Maybe FilePath -- ^ isolated install filepath, if user provides any.
                     -> Excepts
                          '[ AlreadyInstalled
                           , CopyError
@@ -407,24 +390,20 @@ installCabalBindist :: ( MonadMask m
                           ]
                          m
                          ()
-installCabalBindist dlinfo ver isoFilepath = do
+installCabalBindist dlinfo ver = do
   lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
 
-  case isoFilepath of
+  whenM
-    Nothing -> -- for regular install check if any previous versions installed
+      (lift (cabalInstalled ver) >>= \a -> liftIO $
-      whenM
+        handleIO (\_ -> pure False)
-        (lift (cabalInstalled ver) >>= \a -> liftIO $
+          $ fmap (\x -> a && x)
-          handleIO (\_ -> pure False)
+          -- ignore when the installation is a legacy cabal (binary, not symlink)
-            $ fmap (\x -> a && x)
+          $ pathIsLink (binDir </> "cabal" <> exeExt)
-            -- ignore when the installation is a legacy cabal (binary, not symlink)
+      )
-            $ pathIsLink (binDir </> "cabal" <> exeExt)
+      (throwE $ AlreadyInstalled Cabal ver)
-        )
-        (throwE $ AlreadyInstalled Cabal ver)
-
-    _ -> pure () -- check isn't required in isolated installs
 
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
@@ -437,35 +416,30 @@ installCabalBindist dlinfo ver isoFilepath = do
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
 
-  case isoFilepath of
+  liftE $ installCabal' workdir binDir
-    Just isoDir -> do             -- isolated install
-      lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
-      liftE $ installCabalUnpacked workdir isoDir ver
 
-    Nothing -> do                 -- regular install
+  -- create symlink if this is the latest version
-      liftE $ installCabalUnpacked workdir binDir ver
+  cVers <- lift $ fmap rights getInstalledCabals
+  let lInstCabal = headMay . reverse . sort $ cVers
+  when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
 
-      -- create symlink if this is the latest version for regular installs
+ where
-      cVers <- lift $ fmap rights getInstalledCabals
+  -- | Install an unpacked cabal distribution.
-      let lInstCabal = headMay . reverse . sort $ cVers
+  installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
-      when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
+                => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
+                -> FilePath      -- ^ Path to install to
+                -> Excepts '[CopyError] m ()
+  installCabal' path inst = do
+    lift $ $(logInfo) "Installing cabal"
+    let cabalFile = "cabal"
+    liftIO $ createDirRecursive' inst
+    let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
+    let destPath = inst </> destFileName
+    handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+      (path </> cabalFile <> exeExt)
+      destPath
+    lift $ chmod_755 destPath
 
--- | Install an unpacked cabal distribution.
-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
-  lift $ $(logInfo) "Installing cabal"
-  let cabalFile = "cabal"
-  liftIO $ createDirRecursive' inst
-  let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
-  let destPath = inst </> destFileName
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-    (path </> cabalFile <> exeExt)
-    destPath
-  lift $ chmod_755 destPath
 
 -- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
 -- creates a default @cabal -> cabal-x.y.z.q@ symlink for
@@ -484,7 +458,6 @@ installCabalBin :: ( MonadMask m
                    , MonadFail m
                    )
                 => Version
-                -> Maybe FilePath -- isolated install Path, if user provided any
                 -> Excepts
                      '[ AlreadyInstalled
                       , CopyError
@@ -500,9 +473,9 @@ installCabalBin :: ( MonadMask m
                       ]
                      m
                      ()
-installCabalBin ver isoFilepath = do
+installCabalBin ver = do
   dlinfo <- liftE $ getDownloadInfo Cabal ver
-  installCabalBindist dlinfo ver isoFilepath
+  installCabalBindist dlinfo ver
 
 
 -- | Like 'installHLSBin, except takes the 'DownloadInfo' as
@@ -521,7 +494,6 @@ installHLSBindist :: ( MonadMask m
                      )
                   => DownloadInfo
                   -> Version
-                  -> Maybe FilePath -- ^ isolated install path, if user passed any
                   -> Excepts
                        '[ AlreadyInstalled
                         , CopyError
@@ -537,19 +509,14 @@ installHLSBindist :: ( MonadMask m
                         ]
                        m
                        ()
-installHLSBindist dlinfo ver isoFilepath = do
+installHLSBindist dlinfo ver = do
   lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
 
-  case isoFilepath of
+  whenM (lift (hlsInstalled ver))
-    Nothing ->
+    (throwE $ AlreadyInstalled HLS ver)
-      -- we only check for already installed in regular (non-isolated) installs
-      whenM (lift (hlsInstalled ver))
-      (throwE $ AlreadyInstalled HLS ver)
-
-    _ -> pure ()
 
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
@@ -562,52 +529,46 @@ installHLSBindist dlinfo ver isoFilepath = do
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
 
-  case isoFilepath of
+  liftE $ installHLS' workdir binDir
-    Just isoDir -> do
-      lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
-      liftE $ installHLSUnpacked workdir isoDir ver
 
-    Nothing -> do
+  -- create symlink if this is the latest version
-      liftE $ installHLSUnpacked workdir binDir ver
+  hlsVers <- lift $ fmap rights getInstalledHLSs
+  let lInstHLS = headMay . reverse . sort $ hlsVers
+  when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
 
-      -- create symlink if this is the latest version in a regular install
+ where
-      hlsVers <- lift $ fmap rights getInstalledHLSs
+  -- | Install an unpacked hls distribution.
-      let lInstHLS = headMay . reverse . sort $ hlsVers
+  installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
-      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
+                => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
+                -> FilePath      -- ^ Path to install to
+                -> Excepts '[CopyError] m ()
+  installHLS' path inst = do
+    lift $ $(logInfo) "Installing HLS"
+    liftIO $ createDirRecursive' inst
 
+    -- install haskell-language-server-<ghcver>
+    bins@(_:_) <- liftIO $ findFiles
+      path
+      (makeRegexOpts compExtended
+                     execBlank
+                     ([s|^haskell-language-server-[0-9].*$|] :: ByteString)
+      )
+    forM_ bins $ \f -> do
+      let toF = dropSuffix exeExt f
+                <> "~" <> T.unpack (prettyVer ver) <> exeExt
+      handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+        (path </> f)
+        (inst </> toF)
+      lift $ chmod_755 (inst </> toF)
 
--- | Install an unpacked hls distribution.
+    -- install haskell-language-server-wrapper
-installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
+    let wrapper = "haskell-language-server-wrapper"
-              => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
+        toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
-              -> FilePath      -- ^ Path to install to
-              -> Version
-              -> Excepts '[CopyError] m ()
-installHLSUnpacked path inst ver = do
-  lift $ $(logInfo) "Installing HLS"
-  liftIO $ createDirRecursive' inst
-
-  -- install haskell-language-server-<ghcver>
-  bins@(_:_) <- liftIO $ findFiles
-    path
-    (makeRegexOpts compExtended
-                   execBlank
-                   ([s|^haskell-language-server-[0-9].*$|] :: ByteString)
-    )
-  forM_ bins $ \f -> do
-    let toF = dropSuffix exeExt f
-              <> "~" <> T.unpack (prettyVer ver) <> exeExt
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-      (path </> f)
+      (path </> wrapper <> exeExt)
       (inst </> toF)
     lift $ chmod_755 (inst </> toF)
 
-  -- install haskell-language-server-wrapper
-  let wrapper = "haskell-language-server-wrapper"
-      toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-    (path </> wrapper <> exeExt)
-    (inst </> toF)
-  lift $ chmod_755 (inst </> toF)
 
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -625,7 +586,6 @@ installHLSBin :: ( MonadMask m
                  , MonadFail m
                  )
               => Version
-              -> Maybe FilePath
               -> Excepts
                    '[ AlreadyInstalled
                     , CopyError
@@ -641,9 +601,9 @@ installHLSBin :: ( MonadMask m
                     ]
                    m
                    ()
-installHLSBin ver isoFilepath = do
+installHLSBin ver = do
   dlinfo <- liftE $ getDownloadInfo HLS ver
-  installHLSBindist dlinfo ver isoFilepath
+  installHLSBindist dlinfo ver
 
 
 -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
@@ -663,7 +623,6 @@ installStackBin :: ( MonadMask m
                    , MonadFail m
                    )
                 => Version
-                -> Maybe FilePath
                 -> Excepts
                      '[ AlreadyInstalled
                       , CopyError
@@ -679,9 +638,9 @@ installStackBin :: ( MonadMask m
                       ]
                      m
                      ()
-installStackBin ver isoFilepath = do
+installStackBin ver = do
   dlinfo <- liftE $ getDownloadInfo Stack ver
-  installStackBindist dlinfo ver isoFilepath
+  installStackBindist dlinfo ver
 
 
 -- | Like 'installStackBin', except takes the 'DownloadInfo' as
@@ -700,7 +659,6 @@ installStackBindist :: ( MonadMask m
                        )
                     => DownloadInfo
                     -> Version
-                    -> Maybe FilePath
                     -> Excepts
                          '[ AlreadyInstalled
                           , CopyError
@@ -716,18 +674,14 @@ installStackBindist :: ( MonadMask m
                           ]
                          m
                          ()
-installStackBindist dlinfo ver isoFilepath = do
+installStackBindist dlinfo ver = do
   lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
 
-  case isoFilepath of
+  whenM (lift (stackInstalled ver))
-    Nothing ->             -- check previous versions in case of regular installs
+    (throwE $ AlreadyInstalled Stack ver)
-      whenM (lift (stackInstalled ver))
-      (throwE $ AlreadyInstalled Stack ver)
-
-    _ -> pure ()           -- don't do shit for isolates
 
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
@@ -740,35 +694,31 @@ installStackBindist dlinfo ver isoFilepath = do
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
 
-  case isoFilepath of
+  liftE $ installStack' workdir binDir
-    Just isoDir -> do                 -- isolated install
-      lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
-      liftE $ installStackUnpacked workdir isoDir ver
-    Nothing -> do                     -- regular install
-      liftE $ installStackUnpacked workdir binDir ver
 
-      -- create symlink if this is the latest version and a regular install
+  -- create symlink if this is the latest version
-      sVers <- lift $ fmap rights getInstalledStacks
+  sVers <- lift $ fmap rights getInstalledStacks
-      let lInstStack = headMay . reverse . sort $ sVers
+  let lInstStack = headMay . reverse . sort $ sVers
-      when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
+  when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
+
+ where
+  -- | Install an unpacked stack distribution.
+  installStack' :: (MonadLogger m, MonadCatch m, MonadIO m)
+                => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
+                -> FilePath      -- ^ Path to install to
+                -> Excepts '[CopyError] m ()
+  installStack' path inst = do
+    lift $ $(logInfo) "Installing stack"
+    let stackFile = "stack"
+    liftIO $ createDirRecursive' inst
+    let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
+    let destPath = inst </> destFileName
+    handleIO (throwE . CopyError . show) $ liftIO $ copyFile
+      (path </> stackFile <> exeExt)
+      destPath
+    lift $ chmod_755 destPath
 
 
--- | Install an unpacked stack distribution.
-installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
-              => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
-              -> FilePath      -- ^ Path to install to
-              -> Version
-              -> Excepts '[CopyError] m ()
-installStackUnpacked path inst ver = do
-  lift $ $(logInfo) "Installing stack"
-  let stackFile = "stack"
-  liftIO $ createDirRecursive' inst
-  let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
-  let destPath = inst </> destFileName
-  handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-    (path </> stackFile <> exeExt)
-    destPath
-  lift $ chmod_755 destPath
 
 
     ---------------------
@@ -1750,7 +1700,6 @@ compileGHC :: ( MonadMask m
            -> [Text]                   -- ^ additional args to ./configure
            -> Maybe String             -- ^ build flavour
            -> Bool
-           -> Maybe FilePath           -- ^ isolate dir
            -> Excepts
                 '[ AlreadyInstalled
                  , BuildFailed
@@ -1769,7 +1718,7 @@ compileGHC :: ( MonadMask m
                  ]
                 m
                 GHCTargetVersion
-compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
+compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian
   = do
     PlatformRequest { .. } <- lift getPlatformReq
     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -1839,18 +1788,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
     alreadyInstalled <- lift $ ghcInstalled installVer
     alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
     when alreadyInstalled $ do
-      case isolateDir of
+      lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
-        Just isoDir ->
-          lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
-        Nothing ->
-          lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
       lift $ $(logWarn)
         "...waiting for 10 seconds before continuing, you can still abort..."
       liftIO $ threadDelay 10000000 -- give the user a sec to intervene
 
-    ghcdir <- case isolateDir of
+    ghcdir         <- lift $ ghcupGHCDir installVer
-      Just isoDir -> pure isoDir
-      Nothing -> lift $ ghcupGHCDir installVer
 
     bghc <- case bstrap of
       Right g    -> pure $ Right g
@@ -1867,14 +1810,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         pure (b, bmk)
       )
 
-    case isolateDir of
+    when alreadyInstalled $ do
-      Nothing ->
+      lift $ $(logInfo) [i|Deleting existing installation|]
-        -- only remove old ghc in regular installs
+      liftE $ rmGHCVer tver
-        when alreadyInstalled $ do
-          lift $ $(logInfo) [i|Deleting existing installation|]
-          liftE $ rmGHCVer tver
-          
-      _ -> pure ()
 
     forM_ mBindist $ \bindist -> do
       liftE $ installPackedGHC bindist
@@ -1883,15 +1821,11 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
                                (tver ^. tvVersion)
 
     liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
-    
+
-    case isolateDir of
+    reThrowAll GHCupSetError $ postGHCInstall tver
-      -- set and make symlinks for regular (non-isolated) installs
+
-      Nothing -> do
+    -- restore
-        reThrowAll GHCupSetError $ postGHCInstall tver
+    when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
-        -- restore
-        when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
-        
-      _ -> pure ()
 
     pure tver
 

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 $
+  -- try to download yaml... usually this writes it into cache dir,
-    handleIO (\e -> warnCache (displayException e))
+  -- but in some cases not (e.g. when using file://), so we honour
-      . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e))
+  -- the return filepath, if any
-      . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
+  mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
-      . smartDl
+           then pure Nothing
-      $ uri
+           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
+    Dirs { cacheDir } <- lift getDirs
-      then do
-        accessTime <- liftIO $ getAccessTime json_file
 
-        -- access time won't work on most linuxes, but we can try regardless
+       -- for local files, let's short-circuit and ignore access time
-        when ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) $
+    if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
-          -- no access in last 5 minutes, re-check upstream mod time
+       | e -> do
-          dlWithMod currentTime json_file
+          accessTime <- liftIO $ getAccessTime json_file
-      else
+
-        dlWithMod currentTime 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)
+    destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
-    lift $ $(logInfo) [i|downloading: #{uri'}|]
+    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
+  getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
-  destFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
+  getDestFile = 
-                  (dest </>)
+    case mfn of
-                  mfn
+        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 :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
-  writeEtags getTags = do
+  writeEtags destFile getTags = do
     getTags >>= \case
       Just t -> do
         $logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]

lib/GHCup/Errors.hs

@@ -327,6 +327,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
+
 
 
     ------------------------