Compare commits

..

1 Commits

Author SHA1 Message Date
d67dafaf1b Skip binary stipping on mac due to code signing issues 2022-02-26 20:29:22 +01:00
16 changed files with 138 additions and 671 deletions

View File

@@ -36,7 +36,8 @@ mkdir out
binary=$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup') binary=$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')
ver=$("${binary}" --numeric-version) ver=$("${binary}" --numeric-version)
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
strip "${binary}" # due to some code signing issues on M1s, we just skip stripping altogether
:
else else
strip -s "${binary}" strip -s "${binary}"
fi fi

View File

@@ -1,11 +1,5 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.17.6 -- ????-??-??
* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
* Fix bad error message wrt [#323](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/323)
## 0.1.17.5 -- 2022-02-26 ## 0.1.17.5 -- 2022-02-26
* Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137) * Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)

View File

@@ -124,7 +124,6 @@ opts =
<> metavar "URL" <> metavar "URL"
<> help "Alternative ghcup download info url" <> help "Alternative ghcup download info url"
<> internal <> internal
<> completer fileUri
) )
) )
<*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)")) <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
@@ -135,7 +134,6 @@ opts =
<> help <> help
"Keep build directories? (default: errors)" "Keep build directories? (default: errors)"
<> hidden <> hidden
<> completer (listCompleter ["always", "errors", "never"])
)) ))
<*> optional (option <*> optional (option
(eitherReader downloaderParser) (eitherReader downloaderParser)
@@ -144,12 +142,10 @@ opts =
<> metavar "<internal|curl|wget>" <> metavar "<internal|curl|wget>"
<> help <> help
"Downloader to use (default: internal)" "Downloader to use (default: internal)"
<> completer (listCompleter ["internal", "curl", "wget"])
#else #else
<> metavar "<curl|wget>" <> metavar "<curl|wget>"
<> help <> help
"Downloader to use (default: curl)" "Downloader to use (default: curl)"
<> completer (listCompleter ["curl", "wget"])
#endif #endif
<> hidden <> hidden
)) ))
@@ -160,7 +156,6 @@ opts =
<> metavar "<strict|lax|none>" <> metavar "<strict|lax|none>"
<> help <> help
"GPG verification (default: none)" "GPG verification (default: none)"
<> completer (listCompleter ["strict", "lax", "none"])
)) ))
<*> com <*> com
where where

View File

@@ -76,7 +76,6 @@ changelogP =
) )
(short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
"Open changelog for given tool (default: ghc)" "Open changelog for given tool (default: ghc)"
<> completer toolCompleter
) )
) )
<*> optional (toolVersionArgument Nothing Nothing) <*> optional (toolVersionArgument Nothing Nothing)

View File

@@ -3,8 +3,6 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
module GHCup.OptParse.Common where module GHCup.OptParse.Common where
@@ -16,55 +14,36 @@ import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.DeepSeq
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception.Safe import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Reader import Control.Monad.Reader
import Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as KM
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif
import Data.ByteString.Lazy ( ByteString )
import Data.Bifunctor import Data.Bifunctor
import Data.Char import Data.Char
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix ) import Data.List ( nub, sort, sortBy )
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Data.Void import Data.Void
import qualified Data.Vector as V
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import Safe import Safe
import System.Directory
import System.Process ( readProcess )
import System.FilePath import System.FilePath
import Text.HTML.TagSoup hiding ( Tag )
import URI.ByteString import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified System.FilePath.Posix as FP
import GHCup.Version import GHCup.Version
import Control.Exception (evaluate)
------------- -------------
@@ -298,126 +277,6 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
--[ Completers ]-- --[ Completers ]--
------------------ ------------------
toolCompleter :: Completer
toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
gitFileUri :: [String] -> Completer
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
fileUri :: Completer
fileUri = mkCompleter $ fileUri' []
fileUri' :: [String] -> String -> IO [String]
fileUri' add = \case
"" -> do
pwd <- getCurrentDirectory
pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
xs
| "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
case stripPrefix "file://" xs of
Nothing -> pure []
Just r -> do
pwd <- getCurrentDirectory
dirs <- compgen "directory" r ["-S", "/"]
files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
| xs `isPrefixOf` "file:///" -> pure ["file:///"]
| xs `isPrefixOf` "https://" -> pure ["https://"]
| xs `isPrefixOf` "http://" -> pure ["http://"]
| otherwise -> pure []
where
compgen :: String -> String -> [String] -> IO [String]
compgen action' r opts = do
let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
result <- tryIO $ readProcess "bash" ["-c", cmd] ""
return . lines . either (const []) id $ result
-- | Strongly quote the string we pass to compgen.
--
-- We need to do this so bash doesn't expand out any ~ or other
-- chars we want to complete on, or emit an end of line error
-- when seeking the close to the quote.
--
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
requote :: String -> String
requote s =
let
-- Bash doesn't appear to allow "mixed" escaping
-- in bash completions. So we don't have to really
-- worry about people swapping between strong and
-- weak quotes.
unescaped =
case s of
-- It's already strongly quoted, so we
-- can use it mostly as is, but we must
-- ensure it's closed off at the end and
-- there's no single quotes in the
-- middle which might confuse bash.
('\'': rs) -> unescapeN rs
-- We're weakly quoted.
('"': rs) -> unescapeD rs
-- We're not quoted at all.
-- We need to unescape some characters like
-- spaces and quotation marks.
elsewise -> unescapeU elsewise
in
strong unescaped
where
strong ss = '\'' : foldr go "'" ss
where
-- If there's a single quote inside the
-- command: exit from the strong quote and
-- emit it the quote escaped, then resume.
go '\'' t = "'\\''" ++ t
go h t = h : t
-- Unescape a strongly quoted string
-- We have two recursive functions, as we
-- can enter and exit the strong escaping.
unescapeN = goX
where
goX ('\'' : xs) = goN xs
goX (x : xs) = x : goX xs
goX [] = []
goN ('\\' : '\'' : xs) = '\'' : goN xs
goN ('\'' : xs) = goX xs
goN (x : xs) = x : goN xs
goN [] = []
-- Unescape an unquoted string
unescapeU = goX
where
goX [] = []
goX ('\\' : x : xs) = x : goX xs
goX (x : xs) = x : goX xs
-- Unescape a weakly quoted string
unescapeD = goX
where
-- Reached an escape character
goX ('\\' : x : xs)
-- If it's true escapable, strip the
-- slashes, as we're going to strong
-- escape instead.
| x `elem` ("$`\"\\\n" :: String) = x : goX xs
| otherwise = '\\' : x : goX xs
-- We've ended quoted section, so we
-- don't recurse on goX, it's done.
goX ('"' : xs)
= xs
-- Not done, but not a special character
-- just continue the fold.
goX (x : xs)
= x : goX xs
goX []
= []
tagCompleter :: Tool -> [String] -> Completer tagCompleter :: Tool -> [String] -> Completer
tagCompleter tool add = listIOCompleter $ do tagCompleter tool add = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
@@ -475,150 +334,6 @@ versionCompleter criteria tool = listIOCompleter $ do
return $ T.unpack . prettyVer . lVer <$> installedVersions return $ T.unpack . prettyVer . lVer <$> installedVersions
toolDlCompleter :: Tool -> Completer
toolDlCompleter tool = mkCompleter $ \case
"" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
word
| "file://" `isPrefixOf` word -> fileUri' [] word
-- downloads.haskell.org
| "https://downloads.haskell.org/" `isPrefixOf` word ->
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
-- github releases
| "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
, let xs = splitPath word
, (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "haskell" "haskell-language-server"
| "https://github.com/commercialhaskell/stack/releases/download/" == word
, let xs = splitPath word
, (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "commercialhaskell" "stack"
-- github release assets
| "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
, let xs = splitPath word
, (length xs == 7 && last word == '/') || length xs == 8
, let rel = xs !! 6
, length rel > 1 -> do
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "haskell" "haskell-language-server" (init rel)
| "https://github.com/commercialhaskell/stack/releases/download/" `isPrefixOf` word
, let xs = splitPath word
, (length xs == 7 && last word == '/') || length xs == 8
, let rel = xs !! 6
, length rel > 1 -> do
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "commercialhaskell" "stack" (init rel)
-- github
| "https://github.com/c" `isPrefixOf` word -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
| "https://github.com/h" `isPrefixOf` word -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
| "https://g" `isPrefixOf` word
, tool == Stack -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
| "https://g" `isPrefixOf` word
, tool == HLS -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
| "https://d" `isPrefixOf` word -> pure $ filter ("https://downloads.haskell.org/" `isPrefixOf`) $ initUrl tool
| "h" `isPrefixOf` word -> pure $ initUrl tool
| word `isPrefixOf` "file:///" -> pure ["file:///"]
| word `isPrefixOf` "https://" -> pure ["https://"]
| word `isPrefixOf` "http://" -> pure ["http://"]
| otherwise -> pure []
where
initUrl :: Tool -> [String]
initUrl GHC = [ "https://downloads.haskell.org/~ghc/"
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/"
]
initUrl Cabal = [ "https://downloads.haskell.org/~cabal/"
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/"
]
initUrl GHCup = [ "https://downloads.haskell.org/~ghcup/" ]
initUrl HLS = [ "https://github.com/haskell/haskell-language-server/releases/download/"
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/haskell-language-server/"
]
initUrl Stack = [ "https://github.com/commercialhaskell/stack/releases/download/"
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/stack/"
]
completePrefix :: String -- ^ url, e.g. 'https://github.com/haskell/haskell-languag'
-> String -- ^ match, e.g. 'haskell-language-server'
-> String -- ^ result, e.g. 'https://github.com/haskell/haskell-language-server'
completePrefix url match =
let base = FP.takeDirectory url
fn = FP.takeFileName url
in if fn `isPrefixOf` match then base <> "/" <> match else url
prefixMatch :: String -> [String] -> [String]
prefixMatch pref = filter (pref `isPrefixOf`)
fromHRef :: String -> IO [String]
fromHRef url = withCurl (FP.takeDirectory url) 2_000_000 $ \stdout ->
pure
. fmap (T.unpack . decUTF8Safe' . fromAttrib "href")
. filter isTagOpen
. filter (~== ("<a href>" :: String))
. parseTags
$ stdout
withCurl :: String -- ^ url
-> Int -- ^ delay
-> (ByteString -> IO [String]) -- ^ callback
-> IO [String]
withCurl url delay cb = do
let limit = threadDelay delay
race limit (executeOut "curl" ["-fL", url] Nothing) >>= \case
Right (CapturedProcess {_exitCode, _stdOut}) -> do
case _exitCode of
ExitSuccess ->
(try @_ @SomeException . cb $ _stdOut) >>= \case
Left _ -> pure []
Right r' -> do
r <- try @_ @SomeException
. evaluate
. force
$ r'
either (\_ -> pure []) pure r
ExitFailure _ -> pure []
Left _ -> pure []
getGithubReleases :: String
-> String
-> IO [String]
getGithubReleases owner repo = withCurl url 3_000_000 $ \stdout -> do
Just xs <- pure $ decode' @Array stdout
fmap V.toList $ forM xs $ \x -> do
(Object r) <- pure x
Just (String name) <- pure $ KM.lookup (mkval "tag_name") r
pure $ T.unpack name
where
url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases"
getGithubAssets :: String
-> String
-> String
-> IO [String]
getGithubAssets owner repo tag = withCurl url 3_000_000 $ \stdout -> do
Just xs <- pure $ decode' @Object stdout
Just (Array assets) <- pure $ KM.lookup (mkval "assets") xs
as <- fmap V.toList $ forM assets $ \val -> do
(Object asset) <- pure val
Just (String name) <- pure $ KM.lookup (mkval "name") asset
pure $ T.unpack name
pure as
where
url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases/tags/" <> tag
#if MIN_VERSION_aeson(2,0,0)
mkval = KM.fromString
#else
mkval = id
#endif
----------------- -----------------

View File

@@ -165,7 +165,6 @@ ghcCompileOpts =
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
<> (completer $ versionCompleter Nothing GHC)
) )
) <|> ) <|>
(Right <$> (GitBranch <$> option (Right <$> (GitBranch <$> option
@@ -173,10 +172,7 @@ ghcCompileOpts =
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from" "The git commit/branch/ref to build from"
) <*> ) <*>
optional (option str ( optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
<> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
))
))) )))
<*> option <*> option
(eitherReader (eitherReader
@@ -189,14 +185,12 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC" <> metavar "BOOTSTRAP_GHC"
<> help <> help
"The GHC version (or full path) to bootstrap with (must be installed)" "The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter Nothing GHC)
) )
<*> optional <*> optional
(option (option
(eitherReader (readEither @Int)) (eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help (short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make" "How many jobs to use for make"
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
) )
) )
<*> optional <*> optional
@@ -204,7 +198,6 @@ ghcCompileOpts =
str str
(short 'c' <> long "config" <> metavar "CONFIG" <> help (short 'c' <> long "config" <> metavar "CONFIG" <> help
"Absolute path to build config file" "Absolute path to build config file"
<> completer (bashCompleter "file")
) )
) )
<*> (optional <*> (optional
@@ -213,7 +206,6 @@ ghcCompileOpts =
(eitherReader uriParser) (eitherReader uriParser)
(long "patch" <> metavar "PATCH_URI" <> help (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)" "URI to a patch (https/http/file)"
<> completer fileUri
) )
) )
<|> <|>
@@ -221,7 +213,6 @@ ghcCompileOpts =
str str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)" "Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
<> completer (bashCompleter "directory")
) )
) )
) )
@@ -247,7 +238,6 @@ ghcCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'" "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing GHC)
) )
) )
<*> optional <*> optional
@@ -267,7 +257,6 @@ ghcCompileOpts =
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made" <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
) )
) )
@@ -280,7 +269,6 @@ hlsCompileOpts =
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
<> (completer $ versionCompleter Nothing HLS)
) )
) <|> ) <|>
(Right <$> (GitBranch <$> option (Right <$> (GitBranch <$> option
@@ -288,16 +276,13 @@ hlsCompileOpts =
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from" "The git commit/branch/ref to build from"
) <*> ) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)" optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
))
))) )))
<*> optional <*> optional
(option (option
(eitherReader (readEither @Int)) (eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help (short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make" "How many jobs to use for make"
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
) )
) )
<*> flag <*> flag
@@ -313,7 +298,6 @@ hlsCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'" "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing HLS)
) )
) )
<*> optional <*> optional
@@ -323,7 +307,6 @@ hlsCompileOpts =
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made" <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
) )
) )
<*> optional <*> optional
@@ -331,7 +314,6 @@ hlsCompileOpts =
((fmap Right $ eitherReader uriParser) <|> (fmap Left str)) ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
"If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme." "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
<> completer fileUri
) )
) )
<*> optional <*> optional
@@ -339,7 +321,6 @@ hlsCompileOpts =
(eitherReader uriParser) (eitherReader uriParser)
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
"URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over." "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
<> completer fileUri
) )
) )
<*> (optional <*> (optional
@@ -348,7 +329,6 @@ hlsCompileOpts =
(eitherReader uriParser) (eitherReader uriParser)
(long "patch" <> metavar "PATCH_URI" <> help (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)" "URI to a patch (https/http/file)"
<> completer fileUri
) )
) )
<|> <|>
@@ -356,7 +336,6 @@ hlsCompileOpts =
str str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
<> completer (bashCompleter "directory")
) )
) )
) )

View File

@@ -6,7 +6,6 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Install where module GHCup.OptParse.Install where
@@ -190,7 +189,6 @@ installOpts tool =
(eitherReader uriParser) (eitherReader uriParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist" "Install the specified version from this bindist"
<> completer (toolDlCompleter (fromMaybe GHC tool))
) )
) )
<*> (Just <$> toolVersionArgument Nothing tool) <*> (Just <$> toolVersionArgument Nothing tool)
@@ -210,7 +208,6 @@ installOpts tool =
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated dir instead of the default one" <> help "install in an isolated dir instead of the default one"
<> completer (bashCompleter "directory")
) )
) )
<*> switch <*> switch
@@ -256,48 +253,6 @@ type InstallEffects = '[ AlreadyInstalled
, NoToolVersionSet , NoToolVersionSet
, FileAlreadyExistsError , FileAlreadyExistsError
, ProcessError , ProcessError
, (AlreadyInstalled, ())
, (UnknownArchive, ())
, (ArchiveResult, ())
, (FileDoesNotExistError, ())
, (CopyError, ())
, (NotInstalled, ())
, (DirNotEmpty, ())
, (NoDownload, ())
, (NotInstalled, ())
, (BuildFailed, ())
, (TagNotFound, ())
, (DigestError, ())
, (GPGError, ())
, (DownloadFailed, ())
, (TarDirDoesNotExist, ())
, (NextVerNotFound, ())
, (NoToolVersionSet, ())
, (FileAlreadyExistsError, ())
, (ProcessError, ())
, (AlreadyInstalled, NotInstalled)
, (UnknownArchive, NotInstalled)
, (ArchiveResult, NotInstalled)
, (FileDoesNotExistError, NotInstalled)
, (CopyError, NotInstalled)
, (NotInstalled, NotInstalled)
, (DirNotEmpty, NotInstalled)
, (NoDownload, NotInstalled)
, (NotInstalled, NotInstalled)
, (BuildFailed, NotInstalled)
, (TagNotFound, NotInstalled)
, (DigestError, NotInstalled)
, (GPGError, NotInstalled)
, (DownloadFailed, NotInstalled)
, (TarDirDoesNotExist, NotInstalled)
, (NextVerNotFound, NotInstalled)
, (NoToolVersionSet, NotInstalled)
, (FileAlreadyExistsError, NotInstalled)
, (ProcessError, NotInstalled)
, ((), NotInstalled)
] ]
@@ -463,22 +418,20 @@ install installCommand settings getAppState' runLogger = case installCommand of
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do Nothing -> runInstTool s' instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
void $ liftE $ sequenceE (installCabalBin liftE $ installCabalBin
v (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
) $ when instSet $ void $ setCabal v
pure vi pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
void $ liftE $ sequenceE (installCabalBindist liftE $ installCabalBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
v (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
) $ when instSet $ void $ setCabal v
pure vi pure vi
) )
>>= \case >>= \case
@@ -495,14 +448,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp, ())) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -514,23 +459,21 @@ install installCommand settings getAppState' runLogger = case installCommand of
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do Nothing -> runInstTool s' instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (v, vi) <- liftE $ fromVersion instVer HLS
void $ liftE $ sequenceE (installHLSBin liftE $ installHLSBin
v (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
pure vi pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy -- TODO: support legacy
void $ liftE $ sequenceE (installHLSBindist liftE $ installHLSBindist
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "") (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
v (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
pure vi pure vi
) )
>>= \case >>= \case
@@ -551,18 +494,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $
"HLS ver "
<> prettyVer v
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
<> prettyVer v
<> "'"
pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp, ())) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -574,22 +505,20 @@ install installCommand settings getAppState' runLogger = case installCommand of
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do Nothing -> runInstTool s' instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
void $ liftE $ sequenceE (installStackBin liftE $ installStackBin
v (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
) $ when instSet $ void $ setStack v
pure vi pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
void $ liftE $ sequenceE (installStackBindist liftE $ installStackBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
v (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
) $ when instSet $ void $ setStack v
pure vi pure vi
) )
>>= \case >>= \case
@@ -606,14 +535,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp, ())) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e

View File

@@ -69,7 +69,6 @@ listOpts =
(eitherReader toolParser) (eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all" "Tool to list versions for. Default is all"
<> completer (toolCompleter)
) )
) )
<*> optional <*> optional
@@ -79,7 +78,6 @@ listOpts =
<> long "show-criteria" <> long "show-criteria"
<> metavar "<installed|set|available>" <> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions" <> help "Show only installed/set/available tool versions"
<> completer (listCompleter ["installed", "set", "available"])
) )
) )
<*> switch <*> switch

View File

@@ -83,7 +83,7 @@ prefetchP = subparser
(PrefetchGHC (PrefetchGHC
<$> (PrefetchGHCOptions <$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper ) <$> ( 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 (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> optional (toolVersionArgument Nothing (Just GHC)) ) <*> optional (toolVersionArgument Nothing (Just GHC)) )
( progDesc "Download GHC assets for installation") ( progDesc "Download GHC assets for installation")
) )
@@ -92,7 +92,7 @@ prefetchP = subparser
"cabal" "cabal"
(info (info
(PrefetchCabal (PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )) <*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation") ( progDesc "Download cabal assets for installation")
) )
@@ -101,7 +101,7 @@ prefetchP = subparser
"hls" "hls"
(info (info
(PrefetchHLS (PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )) <*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation") ( progDesc "Download HLS assets for installation")
) )
@@ -110,7 +110,7 @@ prefetchP = subparser
"stack" "stack"
(info (info
(PrefetchStack (PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )) <*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation") ( progDesc "Download stack assets for installation")
) )

View File

@@ -35,6 +35,7 @@ import Prelude hiding ( appendFile )
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import System.Environment import System.Environment
import System.IO.Temp
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -71,7 +72,6 @@ data RunOptions = RunOptions
--------------- ---------------
runOpts :: Parser RunOptions runOpts :: Parser RunOptions
runOpts = runOpts =
RunOptions RunOptions
@@ -82,34 +82,22 @@ runOpts =
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version" (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version")
<> completer (tagCompleter GHC [])
<> (completer $ versionCompleter Nothing GHC)
)
) )
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version" (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version")
<> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter Nothing Cabal)
)
) )
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version" (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version")
<> completer (tagCompleter HLS [])
<> (completer $ versionCompleter Nothing HLS)
)
) )
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version" (metavar "STACK_VERSION" <> long "stack" <> help "The stack version")
<> completer (tagCompleter Stack [])
<> (completer $ versionCompleter Nothing Stack)
)
) )
<*> optional <*> optional
(option (option
@@ -118,7 +106,6 @@ runOpts =
<> long "bindir" <> long "bindir"
<> metavar "DIR" <> metavar "DIR"
<> help "directory where to create the tool symlinks (default: newly created system temp dir)" <> help "directory where to create the tool symlinks (default: newly created system temp dir)"
<> completer (bashCompleter "directory")
) )
) )
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits.")) <*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@@ -216,20 +203,16 @@ run :: forall m.
-> LeanAppState -> LeanAppState
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do run RunOptions{..} runAppState leanAppstate runLogger = do
toolchain <- Excepts resolveToolchain
tmp <- case runBinDir of tmp <- case runBinDir of
Just bindir -> do Just bdir -> do
liftIO $ createDirRecursive' bindir liftIO $ createDirRecursive' bdir
liftIO $ canonicalizePath bindir liftIO $ canonicalizePath bdir
Nothing -> do Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
d <- liftIO $ predictableTmpDir toolchain r <- do
liftIO $ createDirRecursive' d addToolsToDir tmp
liftIO $ canonicalizePath d case r of
Excepts $ installToolChain toolchain tmp VRight _ -> do
pure tmp
) >>= \case
VRight tmp -> do
case runCOMMAND of case runCOMMAND of
[] -> do [] -> do
liftIO $ putStr tmp liftIO $ putStr tmp
@@ -256,78 +239,70 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
isToolTag _ = False isToolTag _ = False
-- TODO: doesn't work for cross -- TODO: doesn't work for cross
resolveToolchain addToolsToDir tmp
| or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
ghcVer <- forM runGHCVer $ \ver -> do forM_ runGHCVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) GHC (v, _) <- liftE $ fromVersion (Just ver) GHC
pure v installTool GHC v
cabalVer <- forM runCabalVer $ \ver -> do setTool GHC v tmp
forM_ runCabalVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Cabal (v, _) <- liftE $ fromVersion (Just ver) Cabal
pure v installTool Cabal v
hlsVer <- forM runHLSVer $ \ver -> do setTool Cabal v tmp
forM_ runHLSVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) HLS (v, _) <- liftE $ fromVersion (Just ver) HLS
pure v installTool HLS v
stackVer <- forM runStackVer $ \ver -> do setTool HLS v tmp
forM_ runStackVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Stack (v, _) <- liftE $ fromVersion (Just ver) Stack
pure v installTool Stack v
pure Toolchain{..} setTool Stack v tmp
| otherwise = runLeanRUN leanAppstate $ do | otherwise = runLeanRUN leanAppstate $ do
ghcVer <- case runGHCVer of case runGHCVer of
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) ->
Nothing -> pure Nothing setTool GHC v tmp
Nothing -> pure ()
_ -> fail "Internal error" _ -> fail "Internal error"
cabalVer <- case runCabalVer of case runCabalVer of
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) ->
Nothing -> pure Nothing setTool Cabal v tmp
Nothing -> pure ()
_ -> fail "Internal error" _ -> fail "Internal error"
hlsVer <- case runHLSVer of case runHLSVer of
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) ->
Nothing -> pure Nothing setTool HLS v tmp
Nothing -> pure ()
_ -> fail "Internal error" _ -> fail "Internal error"
stackVer <- case runStackVer of case runStackVer of
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) ->
Nothing -> pure Nothing setTool Stack v tmp
Nothing -> pure ()
_ -> fail "Internal error" _ -> fail "Internal error"
pure Toolchain{..}
installToolChain Toolchain{..} tmp installTool tool v = do
| or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do isInstalled <- checkIfToolInstalled' tool v
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do case tool of
isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt GHC -> do
case mt of unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
Just (GHC, v) -> do (_tvVersion v)
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin Nothing
(_tvVersion v) False
Nothing Cabal -> do
False unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
setTool GHC v tmp (_tvVersion v)
Just (Cabal, v) -> do Nothing
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin False
(_tvVersion v) Stack -> do
Nothing unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
False (_tvVersion v)
setTool Cabal v tmp Nothing
Just (Stack, v) -> do False
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin HLS -> do
(_tvVersion v) unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
Nothing (_tvVersion v)
False Nothing
setTool Stack v tmp False
Just (HLS, v) -> do GHCup -> pure ()
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
(_tvVersion v)
Nothing
False
setTool HLS v tmp
_ -> pure ()
| otherwise = runLeanRUN leanAppstate $ 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 ()
setTool tool v tmp = setTool tool v tmp =
case tool of case tool of
@@ -349,7 +324,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
if legacy if legacy
then do then do
-- TODO: factor this out -- TODO: factor this out
hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v')) (Just hlsWrapper) <- hlsWrapperBinary v'
cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper) cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw) lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>)) hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
@@ -371,30 +346,3 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
liftIO $ setEnv pathVar newPath liftIO $ setEnv pathVar newPath
return envWithNewPath return envWithNewPath
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
predictableTmpDir Toolchain{..} = do
tmp <- getTemporaryDirectory
pure $ tmp
</> ("ghcup"
<> maybe "" (("_ghc-" <>) . T.unpack . tVerToText) ghcVer
<> maybe "" (("_cabal-" <>) . T.unpack . tVerToText) cabalVer
<> maybe "" (("_hls-" <>) . T.unpack . tVerToText) hlsVer
<> maybe "" (("_stack-" <>) . T.unpack . tVerToText) stackVer
)
-------------------------
--[ Other local types ]--
-------------------------
data Toolchain = Toolchain
{ ghcVer :: Maybe GHCTargetVersion
, cabalVer :: Maybe GHCTargetVersion
, hlsVer :: Maybe GHCTargetVersion
, stackVer :: Maybe GHCTargetVersion
}

View File

@@ -72,7 +72,6 @@ upgradeOptsP =
str str
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
"Absolute filepath to write ghcup into" "Absolute filepath to write ghcup into"
<> completer (bashCompleter "file")
) )
) )
<|> pure UpgradeGHCupDir <|> pure UpgradeGHCupDir

View File

@@ -1,8 +1,5 @@
:root { :root {
--theme-purple: #5E5184; --theme-purple: #5E5184;
--theme-purple-dark: rgba(69, 59, 97, 0.5);
--ukraine-top: #0057B8;
--ukraine-bottom: #FFD700;
--link-pink: #9E358F; --link-pink: #9E358F;
} }
@@ -111,12 +108,12 @@ body.homepage>div.container div.col-md-9 {
.bg-primary { .bg-primary {
background-image: none; background-image: none;
background-color: var(--ukraine-top) !important; background-color: var(--theme-purple) !important;
} }
body .bg-primary { body .bg-primary {
background-image: none; background-image: none;
background-color: var(--ukraine-top); background-color: var(--theme-purple);
border: 0px; border: 0px;
} }
@@ -128,8 +125,8 @@ body .btn-primary {
.navbar.fixed-top { .navbar.fixed-top {
background-image: none; background-image: none;
background-color: var(--ukraine-top); background-color: var(--theme-purple);
border-bottom: 40px solid var(--ukraine-bottom); border-bottom: 5px solid rgba(69, 59, 97, 0.5);
padding: 0px; padding: 0px;
} }

View File

@@ -50,90 +50,10 @@ On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on you
GHCup supports the following tools, which are also known as the **Haskell Toolchain**: GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
<details> 1. [GHC](https://www.haskell.org/ghc/)
<summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary> 2. [cabal-install](https://cabal.readthedocs.io/en/stable/)
3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/stable/)
<table> 4. [stack](https://docs.haskellstack.org/en/stable/README/)
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
</tbody>
</table>
</details>
<details>
<summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
<table>
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.4.1.0</td><td></td></tr>
<tr><td>3.0.0.0</td><td></td></tr>
<tr><td>3.2.0.0</td><td></td></tr>
<tr><td>3.4.0.0</td><td></td></tr>
<tr><td>3.4.1.0</td><td></td></tr>
<tr><td>3.6.0.0</td><td></td></tr>
<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
</tbody>
</table>
</details>
<details>
<summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
<table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>1.1.0</td><td></td></tr>
<tr><td>1.2.0</td><td></td></tr>
<tr><td>1.3.0</td><td></td></tr>
<tr><td>1.4.0</td><td></td></tr>
<tr><td>1.5.0</td><td></td></tr>
<tr><td>1.5.1</td><td></td></tr>
<tr><td>1.6.0.0</td><td></td></tr>
<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
</tbody>
</table>
</details>
<details>
<summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
<table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.5.1</td><td></td></tr>
<tr><td>2.7.1</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr>
<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
</tbody>
</table>
</details>
## Supported platforms ## Supported platforms

View File

@@ -121,7 +121,7 @@ library
, haskus-utils-variant ^>=3.2.1 , haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0 , libarchive ^>=3.0.3.0
, lzma-static ^>=5.2.5.3 , lzma-static ^>=5.2.5.3
, megaparsec >=8.0.0 && <9.3 , megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2 , mtl ^>=2.2
, optics ^>=0.4 , optics ^>=0.4
, os-release ^>=1.0.0 , os-release ^>=1.0.0
@@ -236,23 +236,19 @@ executable ghcup
, ghcup , ghcup
, haskus-utils-variant ^>=3.2.1 , haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0 , libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3 , megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2 , mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18 , optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1 , pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0 , pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.18
, temporary ^>=1.3 , temporary ^>=1.3
, template-haskell >=2.7 && <2.18
, text ^>=1.2.4.0 , text ^>=1.2.4.0
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
@@ -266,22 +262,23 @@ executable ghcup
, brick ^>=0.64 , brick ^>=0.64
, transformers ^>=0.5 , transformers ^>=0.5
, unix ^>=2.7 , unix ^>=2.7
, vector ^>=0.12
, vty >=5.28.2 && <5.34 , vty >=5.28.2 && <5.34
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
else else
build-depends: unix ^>=2.7 build-depends:
, unix ^>=2.7
if flag(no-exe) if flag(no-exe)
buildable: False buildable: False
if flag(disable-upgrade) if (flag(disable-upgrade))
cpp-options: -DDISABLE_UPGRADE cpp-options: -DDISABLE_UPGRADE
else else
other-modules: GHCup.OptParse.Upgrade other-modules:
GHCup.OptParse.Upgrade
test-suite ghcup-test test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@@ -310,9 +307,9 @@ test-suite ghcup-test
, base >=4.12 && <5 , base >=4.12 && <5
, bytestring ^>=0.10 , bytestring ^>=0.10
, containers ^>=0.6 , containers ^>=0.6
, generic-arbitrary >=0.1.0 && <0.3 , generic-arbitrary ^>=0.1.0
, ghcup , ghcup
, hspec >=2.7.10 && <2.10 , hspec ^>=2.7.10
, hspec-golden-aeson ^>=0.9 , hspec-golden-aeson ^>=0.9
, QuickCheck ^>=2.14.1 , QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0 , quickcheck-arbitrary-adt ^>=0.3.1.0

View File

@@ -1,4 +1,4 @@
resolver: lts-18.27 resolver: lts-18.25
packages: packages:
- . - .
@@ -16,7 +16,6 @@ extra-deps:
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216 - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466 - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298 - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340 - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615 - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
@@ -40,6 +39,11 @@ extra-deps:
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- yaml-streamly-0.12.0 - yaml-streamly-0.12.0
- git: https://github.com/hasufell/packages.git
commit: cc0b4688f8bb374fa92f17c856949de795b56291
subdirs:
- haskus-utils-variant
flags: flags:
http-io-streams: http-io-streams:
brotli: false brotli: false