Prepare 0.1.17.6

app/ghcup/GHCup/OptParse/Run.hs

@@ -15,7 +15,7 @@ import           GHCup.Utils.File
 import           GHCup.OptParse.Common
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Types.Optics
+import           GHCup.Types.Optics             ( getDirs )
 import           GHCup.Utils.Logger
 import           GHCup.Utils.String.QQ
 
@@ -187,16 +187,14 @@ runLeanRUN leanAppstate =
       @RunEffects
 
 runRUN :: MonadUnliftIO m
-      => IO AppState
+      => (ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
       -> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
       -> m (VEither RunEffects a)
-runRUN appState action' = do
+runRUN runAppState =
-  s' <- liftIO appState
+  runAppState
-  flip runReaderT s'
     . runResourceT
     . runE
       @RunEffects
-    $ action'
 
 
 
@@ -214,77 +212,52 @@ run :: forall m.
        , MonadUnliftIO m
        )
    => RunOptions
-   -> IO AppState
+   -> (forall a. ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
    -> LeanAppState
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
-run RunOptions{..} runAppState leanAppstate runLogger = do
+run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
-   r <- if or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool'
+   toolchain <- Excepts resolveToolchain
-        then runRUN runAppState $ do
+   tmp <- case runBinDir of
-         toolchain <- liftE resolveToolchainFull
+     Just bindir -> do
-         tmp <- case runBinDir of
+       liftIO $ createDirRecursive' bindir
-           Just bindir -> do
+       liftIO $ canonicalizePath bindir
-             liftIO $ createDirRecursive' bindir
+     Nothing -> do
-             liftIO $ canonicalizePath bindir
+       d <- liftIO $ predictableTmpDir toolchain
-           Nothing -> do
+       liftIO $ createDirRecursive' d
-             d <- liftIO $ predictableTmpDir toolchain
+       liftIO $ canonicalizePath d
-             liftIO $ createDirRecursive' d
+   Excepts $ installToolChain toolchain tmp
-             liftIO $ canonicalizePath d
+   pure tmp
-         liftE $ installToolChainFull toolchain tmp
+   ) >>= \case
-         pure tmp
+     VRight tmp -> do
-        else runLeanRUN leanAppstate $ do
+       case runCOMMAND of
-         toolchain <- resolveToolchain
+         [] -> do
-         tmp <- case runBinDir of
+           liftIO $ putStr tmp
-           Just bindir -> do
+           pure ExitSuccess
-             liftIO $ createDirRecursive' bindir
+         (cmd:args) -> do
-             liftIO $ canonicalizePath bindir
+           newEnv <- liftIO $ addToPath tmp
-           Nothing -> do
-             d <- liftIO $ predictableTmpDir toolchain
-             liftIO $ createDirRecursive' d
-             liftIO $ canonicalizePath d
-         liftE $ installToolChain toolchain tmp
-         pure tmp
-   case r of
-         VRight tmp -> do
-           case runCOMMAND of
-             [] -> do
-               liftIO $ putStr tmp
-               pure ExitSuccess
-             (cmd:args) -> do
-               newEnv <- liftIO $ addToPath tmp
 #ifndef IS_WINDOWS
-               void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
+           void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
-               pure ExitSuccess
+           pure ExitSuccess
 #else
-               r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
+           r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
-               case r' of
+           case r' of
-                 VRight _ -> pure ExitSuccess
+             VRight _ -> pure ExitSuccess
-                 VLeft e -> do
+             VLeft e -> do
-                   runLogger $ logError $ T.pack $ prettyShow e
+               runLogger $ logError $ T.pack $ prettyShow e
-                   pure $ ExitFailure 28
+               pure $ ExitFailure 28
 #endif
-         VLeft e -> do
+     VLeft e -> do
-           runLogger $ logError $ T.pack $ prettyShow e
+       runLogger $ logError $ T.pack $ prettyShow e
-           pure $ ExitFailure 27
+       pure $ ExitFailure 27
-
   where
-
    isToolTag :: ToolVersion -> Bool
    isToolTag (ToolTag _) = True
    isToolTag _           = False
 
    -- TODO: doesn't work for cross
-   resolveToolchainFull :: ( MonadFail m
+   resolveToolchain
-                           , MonadThrow m
+     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
-                           , MonadIO m
-                           , MonadCatch m
-                           )
-                        => Excepts
-                             '[ TagNotFound
-                              , NextVerNotFound
-                              , NoToolVersionSet
-                              ] (ResourceT (ReaderT AppState m)) Toolchain
-   resolveToolchainFull = do
          ghcVer <- forM runGHCVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) GHC
            pure v
@@ -298,8 +271,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
            pure v
          pure Toolchain{..}
-
+     | otherwise = runLeanRUN leanAppstate $ do
-   resolveToolchain = do
          ghcVer <- case runGHCVer of
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
@@ -318,33 +290,8 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
             _ -> fail "Internal error"
          pure Toolchain{..}
 
-   installToolChainFull :: ( MonadFail m
+   installToolChain Toolchain{..} tmp
-                           , MonadThrow m
+     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
-                           , MonadIO m
-                           , MonadCatch m
-                           )
-                        => Toolchain
-                        -> FilePath
-                        -> Excepts
-                             '[ TagNotFound
-                              , NextVerNotFound
-                              , NoToolVersionSet
-                              , UnknownArchive
-                              , TarDirDoesNotExist
-                              , ProcessError
-                              , NotInstalled
-                              , NoDownload
-                              , GPGError
-                              , DownloadFailed
-                              , DirNotEmpty
-                              , DigestError
-                              , BuildFailed
-                              , ArchiveResult
-                              , AlreadyInstalled
-                              , FileAlreadyExistsError
-                              , CopyError
-                              ] (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
@@ -373,16 +320,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                  False
                setTool HLS v tmp
              _ -> pure ()
-
+     | otherwise = runLeanRUN leanAppstate $ do
-   installToolChain :: ( MonadFail m
-                       , MonadThrow m
-                       , MonadIO m
-                       , MonadCatch m
-                       )
-                    => Toolchain
-                    -> 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

app/ghcup/Main.hs

@@ -315,7 +315,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Nuke                     -> nuke appState runLogger
             Prefetch pfCom           -> prefetch pfCom runAppState runLogger
             GC gcOpts                -> gc gcOpts runAppState runLogger
-            Run runCommand           -> run runCommand appState leanAppstate runLogger
+            Run runCommand           -> run runCommand runAppState leanAppstate runLogger
 
           case res of
             ExitSuccess        -> pure ()

scripts/bootstrap/bootstrap-haskell

@@ -181,48 +181,6 @@ _done() {
 	exit 0
 }
 
-# @FUNCTION: posix_realpath
-# @USAGE: <file>
-# @DESCRIPTION:
-# Portably gets the realpath and prints it to stdout.
-# This was initially inspired by
-#   https://gist.github.com/tvlooy/cbfbdb111a4ebad8b93e
-#   and
-#   https://stackoverflow.com/a/246128
-#
-# If the file does not exist, just prints it appended to the current directory.
-# @STDOUT: realpath of the given file
-posix_realpath() {
-    [ -z "$1" ] && die "Internal error: no argument given to posix_realpath"
-    current_loop=0
-    max_loops=50
-    mysource=$1
-
-    while [ -h "${mysource}" ]; do
-        current_loop=$((current_loop+1))
-        mydir="$( cd -P "$( dirname "${mysource}" )" > /dev/null 2>&1 && pwd )"
-        mysource="$(readlink "${mysource}")"
-        [ "${mysource%${mysource#?}}"x != '/x' ] && mysource="${mydir}/${mysource}"
-
-        if [ ${current_loop} -gt ${max_loops} ] ; then
-            (>&2 echo "${1}: Too many levels of symbolic links")
-			echo "$1"
-            return
-        fi
-    done
-    mydir="$( cd -P "$( dirname "${mysource}" )" > /dev/null 2>&1 && pwd )"
-
-    # TODO: better distinguish between "does not exist" and "permission denied"
-    if [ -z "${mydir}" ] ; then
-        (>&2 echo "${1}: Permission denied")
-		echo "$(pwd)/$1"
-    else
-        echo "${mydir%/}/$(basename "${mysource}")"
-    fi
-
-    unset current_loop max_loops mysource mydir
-}
-
 download_ghcup() {
 
     case "${plat}" in
@@ -469,23 +427,23 @@ adjust_bashrc() {
 					;;
 				fish)
 					mkdir -p "${GHCUP_PROFILE_FILE%/*}"
-					sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
+					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
 					case $1 in
 						1)
-							printf "\n%s" "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+							echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 							;;
 						2)
-							printf "\n%s" "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin \$PATH $GHCUP_BIN # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+							echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin \$PATH $GHCUP_BIN # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 							;;
 					esac
 					;;
 				bash)
-					sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
+					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
-					printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+					echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 					case "${plat}" in
 						"Darwin"|"darwin")
 							if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
-								printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
+								echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
 							fi
 							;;
 						MSYS*|MINGW*)
@@ -499,8 +457,8 @@ adjust_bashrc() {
 					;;
 
 				zsh)
-					sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
+					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
-					printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+					echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 					;;
 			esac
 			echo