Compare commits

..

21 Commits

Author SHA1 Message Date
de66b92631 Fix upgradeGHCup 2020-04-12 20:22:16 +02:00
fee3984bf7 Update Downloads 2020-04-12 20:12:36 +02:00
b953c8fd30 Add RELEASING.md 2020-04-12 20:01:42 +02:00
24e4c3a19b Add HACKING.md 2020-04-12 19:48:26 +02:00
d2efb504b9 Fix upgradeGHCup
File needs to be unlinked first, because it might
potentially be in use.
2020-04-12 18:54:03 +02:00
df9dd0e785 Update download info and bootstrap script 2020-04-12 18:31:07 +02:00
89c9699158 Clean up help texts 2020-04-12 15:38:01 +02:00
124ddcdfeb Mimic the old ghcup cli options
So we don't break scripts.
2020-04-12 15:38:01 +02:00
5c0a0fc155 Update travis secret api key 2020-04-12 15:37:57 +02:00
b11b74d2b4 Only use major version for Darwin 2020-04-11 22:15:09 +02:00
5ac8f5b651 Add new bootstrap-haskell 2020-04-11 21:40:01 +02:00
9032df97cf Add travis support 2020-04-11 21:36:34 +02:00
14e1077ad1 Add linux and freebsd ghcup executables to download info 2020-04-11 00:50:15 +02:00
b5648bdd6b Improve error in compileGHC 2020-04-10 22:44:43 +02:00
e7cd952970 Fix missing version detection for darwin and freebsd 2020-04-10 21:11:15 +02:00
1455c2c175 Add darwin notarisation 2020-04-10 19:27:17 +02:00
c106dd3f65 Show curl progress bar 2020-04-10 19:08:02 +02:00
f6725fbf5f Add ghcup-0.0.1.json 2020-04-10 18:45:34 +02:00
c706a047ea Add tool-requirements subcommand 2020-04-10 18:45:33 +02:00
9602db31ab Bump version to 0.1.0 2020-04-09 20:37:03 +02:00
c2c47e1b7e Enable split-sections 2020-04-09 20:35:42 +02:00
24 changed files with 2919 additions and 148 deletions

42
.travis.yml Normal file
View File

@@ -0,0 +1,42 @@
jobs:
include:
- os: osx
osx_image: xcode10.1
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.13-ghcup
addons:
homebrew:
packages:
- curl
- libffi
- libiconv
- make
- ncurses
- xz
- os: osx
osx_image: xcode11.3
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.14-ghcup
addons:
homebrew:
packages:
- curl
- libffi
- libiconv
- make
- ncurses
- xz
script: ".travis/build.sh"
deploy:
provider: releases
api_key:
secure: GEQR+HIwMUql+tFU0LoKCCzG+IG1s5XVA4yp8xMFk0IPsNjHEMh6djYgNqsS6MnujzRulinZe69RyJMZHW3UbtVKWd1D5nsCKmAVfnU8VRbubaL55Bz7C2WI9UCYtKY0isVIQu3KkY+0a6LhdjSkbatO2hl9v0nFmN28q/RpEzsJTI4kyVhmCBflH4fL/QvXzfLuyOae7qsiZBVQXEhmySYktKifNMANSI1aU+kyZ3JgykqZogMK+g/fmcxxTe9MPYMsRQxae/xqdf87IQpmK8v9BRShvF0wq1gO8NY+/fEemAVIHi5CYhPgiLntUD/HFr6AT04LcHnaGryDn/PhkvHuDuZ4INYgBrdNMeGVTjT93N7OtXyh7c+AP3/51E8nM0SkSWCeP4P2fMMksdeOnKtPbhzlqgEM9tbRMILOj1LcjcqurU5ku+WEwZ7d1osTyNug7FVCO5Vb0q3NYnDF4UPXc/d5/2SB+SjJSMxRc52+BiKskHmOa96TXirL3eo6KVNaokQRKvbLw1fEjZvqYJuhPWBRDMalyYjc77poj4kzfVL9CYjtP7h6N5wFR7AtPsMz2n2fQf7J3N4+oqHK+83fOPGyy4FYPZojKNw+L2X/XYrfVscsY/1KbBjULgGIrdr4euYz+rRrTHixUYIvGclKOx+g3SHAOXFWhXlldvI=
file: $ARTIFACT
on:
repo: hasufell/ghcup-hs
tags: true
skip_cleanup: true
draft: true

22
.travis/build.sh Executable file
View File

@@ -0,0 +1,22 @@
#/bin/sh
set -ex
## install ghc via old ghcup
mkdir -p ~/.ghcup/bin
curl https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > ~/.ghcup/bin/ghcup
chmod +x ~/.ghcup/bin/ghcup
export PATH="$HOME/.ghcup/bin:$PATH"
ghcup install 8.8.3
ghcup install-cabal 3.2.0.0
ghcup set 8.8.3
## install ghcup
cabal update
cabal build -fcurl
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" "./${ARTIFACT}"

29
HACKING.md Normal file
View File

@@ -0,0 +1,29 @@
# HACKING
## Design decisions
### Using [Excepts](https://hackage.haskell.org/package/haskus-utils-variant-3.0/docs/Haskus-Utils-Variant-Excepts.html) as a beefed up ExceptT
This is an open variant, similar to [plucky](https://hackage.haskell.org/package/plucky) or [oops](https://github.com/i-am-tom/oops) and allows us to combine different error types. Maybe it is too much and it's a little bit [unergonomic](https://github.com/haskus/packages/issues/32) at times. If it really hurts maintenance, it will be removed. It was more of an experiment.
### No use of filepath or directory
Filepath and directory have two fundamental problems: 1. they use String as filepath (see [AFPP](https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/abstract-file-path) as to why this is wrong) and 2. they try very hard to be cross-platform at the expense of low-level correctness. Instead, we use the [hpath](https://github.com/hasufell/hpath) libraries for file and filepath related stuff, which also gives us stronger filepath types.
### No use of haskell-TLS
I consider haskell-TLS an interesting experiment, but not a battle-tested and peer-reviewed crypto implementation. There is little to no research about what the intricacies of using haskell for low-level crypto are and how vulnerable such binaries are. Instead, we use either curl the binary (for FreeBSD and mac) or http-io-streams, which works with OpenSSL bindings.
### Optics instead of lens
They're a little safer (less Monoid weirdness with view) and have better error messages. Consider: `view (_Just . to (++ "abc")) Nothing` (lens) vs `view (_Just % to (++ "abc")) Nothing` (optics). The latter does not compile (good).
### Strict and StrictData on by default
Kazu Yamamoto [explained it in his PR](https://github.com/yesodweb/wai/pull/752#issuecomment-501531386) very well. I like to agree with him. The instances where we need non-strict behavior, we annotate it.
## Code style and formatting
1. Brittany
2. mtl-style preferred
3. no overly pointfree style

View File

@@ -45,16 +45,16 @@ Common use cases are:
ghcup list
# install the recommended GHC version
ghcup install ghc
ghcup install
# install a specific GHC version
ghcup install ghc -v 8.2.2
ghcup install 8.2.2
# set the currently "active" GHC version
ghcup set -v 8.4.4
ghcup set 8.4.4
# install cabal-install
ghcup install cabal
ghcup install-cabal
# update ghcup itself
ghcup upgrade

11
RELEASING.md Normal file
View File

@@ -0,0 +1,11 @@
# RELEASING
1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the JSON representation of it. The version of the json represents the change increments. `ghcUpVer` is the current application version.
2. Add/fix downloads to `GHCupDownloads` module, then run `ghcup-gen gen` to generate the new json and validate it via `ghcup-gen check`.
3. Commit and git push with tag. Wait for tests to succeed.
4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
5. Build ghcup releases for Linux (fully static), mac (with `-fcurl`) and FreeBSD (with `-fcurl`). Upload to `webhost.haskell.org/ghcup/bin/` and update symlinks.

View File

@@ -984,11 +984,32 @@ cabal_3200_64_darwin = DownloadInfo
-------------
ghcup_001_64_linux :: DownloadInfo
ghcup_001_64_linux = DownloadInfo
[uri|file:///home/maerwald/tmp/ghcup-exe|]
ghcup_010_64_linux :: DownloadInfo
ghcup_010_64_linux = DownloadInfo
[uri|https://github.com/hasufell/ghcup-hs/releases/download/v0.1.0/x86_64-linux-ghcup-0.1.0|]
Nothing
"558126339252788a3d44a3f910417277c7ab656f0796b68bdc58afe73296b8cd"
"b2dc576926c74336805a30c647056eeb1b4204742bcfc5c51680d4e7c34b87a1"
ghcup_010_64_freebsd :: DownloadInfo
ghcup_010_64_freebsd = DownloadInfo
[uri|https://github.com/hasufell/ghcup-hs/releases/download/v0.1.0/x86_64-portbld-freebsd-ghcup-0.1.0|]
Nothing
"d300e36beb63eb5199169b669cc0550e581d871f404f2ce1a2581829c1d2f431"
ghcup_010_64_darwin10_13 :: DownloadInfo
ghcup_010_64_darwin10_13 = DownloadInfo
[uri|https://github.com/hasufell/ghcup-hs/releases/download/v0.1.0/x86_64-apple-darwin-10.13-ghcup-0.1.0|]
Nothing
"3f8fd787c25f6b9b990c968f79c423036155733d7ec8531a84e2cda874e26a32"
ghcup_010_64_darwin10_14 :: DownloadInfo
ghcup_010_64_darwin10_14 = DownloadInfo
[uri|https://github.com/hasufell/ghcup-hs/releases/download/v0.1.0/x86_64-apple-darwin-10.14-ghcup-0.1.0|]
Nothing
"f89fadbecabae0aeb97ed33687c133845dffc0530a9a71a408024e6bbebf46c9"
@@ -1855,11 +1876,21 @@ ghcupDownloads = M.fromList
)
, ( GHCup
, M.fromList
[ ( [vver|0.0.1|]
[ ( [vver|0.1.0|]
, VersionInfo [Recommended, Latest] Nothing $ M.fromList
[ ( A_64
, M.fromList
[(Linux UnknownLinux, M.fromList [(Nothing, ghcup_001_64_linux)])]
[ (Linux UnknownLinux, M.fromList [(Nothing, ghcup_010_64_linux)])
, ( Darwin
, M.fromList
[ (Nothing , ghcup_010_64_darwin10_13)
, (Just [vers|10.13|], ghcup_010_64_darwin10_13)
, (Just [vers|10.14|], ghcup_010_64_darwin10_14)
, (Just [vers|10.15|], ghcup_010_64_darwin10_14)
]
)
, (FreeBSD, M.fromList [(Nothing, ghcup_010_64_freebsd)])
]
)
]
)

View File

@@ -0,0 +1,11 @@
module GHCupInfo where
import GHCupDownloads
import ToolRequirements
import GHCup.Types
ghcupInfo :: GHCupInfo
ghcupInfo = GHCupInfo { _toolRequirements = toolRequirements
, _ghcupDownloads = ghcupDownloads
}

View File

@@ -9,9 +9,10 @@
module Main where
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import GHCupDownloads
import GHCupInfo
import Data.Aeson ( eitherDecode )
import Data.Aeson.Encode.Pretty
@@ -135,7 +136,7 @@ main = do
GenJSON gopts -> do
let
bs = encodePretty' (defConfig { confIndent = Spaces 2 })
ghcupDownloads
ghcupInfo
case gopts of
GenJSONOpts { output = Nothing } -> L.hPutStr stdout bs
GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs
@@ -159,7 +160,7 @@ main = do
where
valAndExit f contents = do
av <- case eitherDecode contents of
(GHCupInfo _ av) <- case eitherDecode contents of
Right r -> pure r
Left e -> die (color Red $ show e)
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)

View File

@@ -0,0 +1,94 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module ToolRequirements where
import GHCup.Types
import GHCup.Utils.String.QQ
import qualified Data.Map as M
-- | Currently 'GHC' is used for both GHC and cabal to simplify
-- this, until we need actual separation.
toolRequirements :: ToolRequirements
toolRequirements = M.fromList
[ ( GHC
, M.fromList
[ ( Nothing
, M.fromList
[ ( Linux UnknownLinux
, M.fromList
[ ( Nothing
, Requirements
[]
[s|You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.|]
)
]
)
, ( Linux Alpine
, M.fromList
[ ( Nothing
, Requirements
[ "curl"
, "gcc"
, "g++"
, "gmp-dev"
, "ncurses-dev"
, "libffi-dev"
, "make"
, "xz"
, "tar"
, "perl"
]
""
)
]
)
, ( Linux Ubuntu
, M.fromList
[ ( Nothing
, Requirements
[ "build-essential"
, "curl"
, "libgmp-dev"
, "libffi-dev"
, "libncurses-dev"
, "libtinfo5"
]
""
)
]
)
, ( Darwin
, M.fromList
[ ( Nothing
, Requirements
[]
"On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again."
)
]
)
, ( FreeBSD
, M.fromList
[ ( Nothing
, Requirements
[ "curl"
, "gcc"
, "gmp"
, "gmake"
, "ncurses"
, "perl5"
, "libffi"
, "libiconv"
]
""
)
]
)
]
)
]
)
]

View File

@@ -13,6 +13,8 @@ module Main where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Platform
import GHCup.Requirements
import GHCup.Types
import GHCup.Utils
import GHCup.Utils.Logger
@@ -71,7 +73,8 @@ data Options = Options
}
data Command
= Install InstallCommand
= Install InstallOptions
| InstallCabal InstallOptions
| SetGHC SetGHCOptions
| List ListOptions
| Rm RmOptions
@@ -79,14 +82,12 @@ data Command
| Compile CompileCommand
| Upgrade UpgradeOpts
| NumericVersion
| ToolRequirements
data ToolVersion = ToolVersion Version
| ToolTag Tag
data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest
@@ -129,11 +130,11 @@ opts =
Options
<$> switch
(short 'v' <> long "verbose" <> help
"Whether to enable verbosity (default: False)"
"Enable verbosity"
)
<*> switch
(short 'c' <> long "cache" <> help
"Whether to cache downloads (default: False)"
"Cache downloads in ~/.ghcup/cache"
)
<*> (optional
(option
@@ -148,7 +149,7 @@ opts =
)
<*> switch
(short 'n' <> long "no-verify" <> help
"Skip tarball checksum verification (default: False)"
"Skip tarball checksum verification"
)
<*> com
where
@@ -161,11 +162,29 @@ com =
subparser
( command
"install"
( Install
<$> (info (installP <**> helper)
(progDesc "Install or update GHC/cabal")
)
((info ((Install <$> installOpts) <**> helper)
(progDesc "Install or update GHC")
)
)
<> command
"set"
( SetGHC
<$> (info (setGHCOpts <**> helper)
(progDesc "Set currently active GHC version")
)
)
<> command
"rm"
( Rm
<$> (info (rmOpts <**> helper) (progDesc "Remove a GHC version"))
)
<> command
"install-cabal"
((info ((InstallCabal <$> installOpts) <**> helper)
(progDesc "Install or update cabal")
)
)
<> command
"list"
( List
@@ -176,10 +195,7 @@ com =
<> command
"upgrade"
( Upgrade
<$> (info
(upgradeOptsP <**> helper)
(progDesc "Upgrade ghcup (per default in ~/.ghcup/bin/)")
)
<$> (info (upgradeOptsP <**> helper) (progDesc "Upgrade ghcup"))
)
<> command
"compile"
@@ -190,25 +206,6 @@ com =
)
<> commandGroup "Main commands:"
)
<|> subparser
( command
"set"
( SetGHC
<$> (info (setGHCOpts <**> helper)
(progDesc "Set the currently active GHC version")
)
)
<> command
"rm"
( Rm
<$> (info
(rmOpts <**> helper)
(progDesc "Remove a GHC version installed by ghcup")
)
)
<> commandGroup "GHC commands:"
<> hidden
)
<|> subparser
( command
"debug-info"
@@ -218,32 +215,22 @@ com =
( (\_ -> NumericVersion)
<$> (info (helper) (progDesc "Show the numeric version"))
)
<> command
"tool-requirements"
( (\_ -> ToolRequirements)
<$> (info (helper)
(progDesc "Show the requirements for ghc/cabal")
)
)
<> commandGroup "Other commands:"
<> hidden
)
installP :: Parser InstallCommand
installP = subparser
( command
"ghc"
( InstallGHC
<$> (info (installOpts <**> helper) (progDesc "Install a GHC version"))
)
<> command
"cabal"
( InstallCabal
<$> (info (installOpts <**> helper)
(progDesc "Install or update a Cabal version")
)
)
)
installOpts :: Parser InstallOptions
installOpts =
InstallOptions
<$> optional toolVersionParser
<*> (optional
(flip InstallOptions)
<$> (optional
(option
(eitherReader platformParser)
( short 'p'
@@ -254,10 +241,11 @@ installOpts =
)
)
)
<*> optional toolVersionArgument
setGHCOpts :: Parser SetGHCOptions
setGHCOpts = SetGHCOptions <$> optional toolVersionParser
setGHCOpts = SetGHCOptions <$> optional toolVersionArgument
listOpts :: Parser ListOptions
listOpts =
@@ -281,7 +269,7 @@ listOpts =
)
rmOpts :: Parser RmOptions
rmOpts = RmOptions <$> versionParser
rmOpts = RmOptions <$> versionArgument
compileP :: Parser CompileCommand
@@ -362,13 +350,6 @@ compileOpts =
)
versionParser :: Parser Version
versionParser = option
(eitherReader (bimap (const "Not a valid version") id . version . T.pack))
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
)
toolVersionParser :: Parser ToolVersion
toolVersionParser = verP <|> toolP
where
@@ -376,16 +357,44 @@ toolVersionParser = verP <|> toolP
toolP =
ToolTag
<$> (option
(eitherReader
(\s' -> case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
other -> Left ([i|Unknown tag #{other}|])
)
)
(eitherReader tagEither)
(short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
)
-- | same as toolVersionParser, except as an argument.
toolVersionArgument :: Parser ToolVersion
toolVersionArgument =
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG")
versionArgument :: Parser Version
versionArgument = argument
(eitherReader versionEither)
(metavar "VERSION")
versionParser :: Parser Version
versionParser = option
(eitherReader versionEither)
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
)
tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
other -> Left ([i|Unknown tag #{other}|])
versionEither :: String -> Either String Version
versionEither s' =
-- 'version' is a bit too lax and will parse typoed tags
case readMaybe ((:[]) . head $ s') :: Maybe Int of
Just _ -> bimap (const "Not a valid version") id . version . T.pack $ s'
Nothing -> Left "Not a valid version"
toolVersionEither :: String -> Either String ToolVersion
toolVersionEither s' =
bimap id ToolTag (tagEither s') <|> bimap id ToolVersion (versionEither s')
toolParser :: String -> Either String Tool
toolParser s' | t == T.pack "ghc" = Right GHC
@@ -580,11 +589,15 @@ main = do
@'[ AlreadyInstalled
, BuildFailed
, DigestError
, DistroNotFound
, DownloadFailed
, GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, DownloadFailed
]
let runCompileCabal =
@@ -592,12 +605,15 @@ main = do
. flip runReaderT settings
. runResourceT
. runE
@'[ UnknownArchive
, NoDownload
@'[ BuildFailed
, DigestError
, BuildFailed
, PatchFailed
, DistroNotFound
, DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
]
let runUpgrade =
@@ -615,7 +631,7 @@ main = do
, DownloadFailed
]
dls <-
(GHCupInfo treq dls) <-
( runLogger
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed]
@@ -631,7 +647,7 @@ main = do
runLogger $ checkForUpdates dls
case optCommand of
Install (InstallGHC InstallOptions {..}) ->
Install (InstallOptions {..}) ->
void
$ (runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC
@@ -654,7 +670,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
$(logError) [i|#{e}|]
$(logError) [i|Also check the logs in ~/.ghcup/logs|]
exitFailure
Install (InstallCabal InstallOptions {..}) ->
InstallCabal (InstallOptions {..}) ->
void
$ (runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal
@@ -779,6 +795,21 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
runLogger ($(logError) [i|#{e}|]) >> exitFailure
NumericVersion -> T.hPutStr stdout (prettyPVP ghcUpVer)
ToolRequirements -> (runLogger $ runE
@'[ NoCompatiblePlatform
, DistroNotFound
, NoToolRequirements
] $ do
platform <- liftE $ getPlatform
req <- (getCommonRequirements platform $ treq)
?? NoToolRequirements
liftIO $ T.hPutStr stdout (prettyRequirements req))
>>= \case
VRight r -> pure r
VLeft e ->
runLogger
($(logError) [i|Error getting tool requirements: #{e}|])
>> exitFailure
pure ()

190
bootstrap-haskell Executable file
View File

@@ -0,0 +1,190 @@
#!/bin/sh
# safety subshell to avoid executing anything in case this script is not downloaded properly
(
: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
die() {
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
exit 2
}
edo()
{
"$@" || die "\"$*\" failed!"
}
eghcup() {
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
edo ghcup "$@"
else
edo ghcup --verbose "$@"
fi
}
download_ghcup() {
_plat="$(uname -s)"
_arch=$(uname -m)
case "${_arch}" in
x86_64|amd64)
;;
i*86)
die "i386 currently not supported!"
;;
*) die "Unknown architecture: ${_arch}"
;;
esac
case "${_plat}" in
"linux"|"Linux")
_url=https://www.haskell.org/ghcup/bin/x86_64-linux-ghcup
;;
"FreeBSD"|"freebsd")
_url=https://www.haskell.org/ghcup/bin/x86_64-portbld-freebsd-ghcup
;;
"Darwin"|"darwin")
case "$(sw_vers -productVersion || echo "none")" in
10.15.*) _url=https://www.haskell.org/ghcup/bin/x86_64-apple-darwin-10.14-ghcup ;;
10.14.*) _url=https://www.haskell.org/ghcup/bin/x86_64-apple-darwin-10.14-ghcup ;;
10.13.*) _url=https://www.haskell.org/ghcup/bin/x86_64-apple-darwin-10.13-ghcup ;;
*) _url=https://www.haskell.org/ghcup/bin/x86_64-apple-darwin-10.13-ghcup ;;
esac
;;
*) die "Unknown platform: ${_plat}"
;;
esac
edo curl -Lf "${_url}" > "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
unset _plat _arch _url
}
echo
echo "Welcome to Haskell!"
echo
echo "This will download and install the Glasgow Haskell Compiler (GHC)"
echo "and the Cabal build tool."
echo
echo "ghcup installs only into the following directory, which can be removed anytime:"
echo " $GHCUP_INSTALL_BASE_PREFIX/.ghcup"
echo
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed"
printf "\\033[0;35m%s\\033[0m\\n" "or ctrl-c to abort."
printf "\\033[0;35m%s\\033[0m\\n" "Note that this script can be re-run at any given time."
echo
# Wait for user input to continue.
# shellcheck disable=SC2034
read -r answer </dev/tty
fi
edo mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
if command -V "ghcup" >/dev/null 2>&1 ; then
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
eghcup upgrade
fi
else
download_ghcup
edo chmod +x "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
cat <<-EOF > "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/bin:\$PATH"
EOF
# shellcheck disable=SC1090
edo . "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/env
fi
echo
echo "$(ghcup tool-requirements)"
echo
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed"
printf "\\033[0;35m%s\\033[0m\\n" "or ctrl-c to abort."
printf "\\033[0;35m%s\\033[0m\\n" "Installation may take a while."
echo
# Wait for user input to continue.
# shellcheck disable=SC2034
read -r answer </dev/tty
fi
eghcup --cache install
eghcup set
eghcup --cache install-cabal
edo cabal new-update
printf "\\033[0;35m%s\\033[0m\\n" ""
printf "\\033[0;35m%s\\033[0m\\n" "Installation done!"
printf "\\033[0;35m%s\\033[0m\\n" ""
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
echo "In order to run ghc and cabal, you need to adjust your PATH variable."
echo "You may want to source '$GHCUP_INSTALL_BASE_PREFIX/.ghcup/env' in your shell"
echo "configuration to do so (e.g. ~/.bashrc)."
case $SHELL in
*/zsh) # login shell is zsh
GHCUP_PROFILE_FILE="$HOME/.zshrc"
MY_SHELL="zsh" ;;
*/bash) # login shell is bash
if [ -f "$HOME/.bashrc" ] ; then # bashrc is not sourced by default, so assume it isn't if file does not exist
GHCUP_PROFILE_FILE="$HOME/.bashrc"
else
GHCUP_PROFILE_FILE="$HOME/.bash_profile"
fi
MY_SHELL="bash" ;;
*/sh) # login shell is sh, but might be a symlink to bash or zsh
if [ -n "${BASH}" ] ; then
if [ -f "$HOME/.bashrc" ] ; then # bashrc is not sourced by default, so assume it isn't if file does not exist
GHCUP_PROFILE_FILE="$HOME/.bashrc"
else
GHCUP_PROFILE_FILE="$HOME/.bash_profile"
fi
MY_SHELL="bash"
elif [ -n "${ZSH_VERSION}" ] ; then
GHCUP_PROFILE_FILE="$HOME/.zshrc"
MY_SHELL="zsh"
else
exit 0
fi
;;
*) exit 0 ;;
esac
printf "\\033[0;35m%s\\033[0m\\n" ""
printf "\\033[0;35m%s\\033[0m\\n" "Detected ${MY_SHELL} shell on your system..."
printf "\\033[0;35m%s\\033[0m\\n" "If you want ghcup to automatically add the required PATH variable to \"${GHCUP_PROFILE_FILE}\""
printf "\\033[0;35m%s\\033[0m\\n" "answer with YES, otherwise with NO and press ENTER."
printf "\\033[0;35m%s\\033[0m\\n" ""
while true; do
read -r next_answer </dev/tty
case $next_answer in
[Yy]*)
echo "[ -f \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\" ] && source \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\"" >> "${GHCUP_PROFILE_FILE}"
printf "\\033[0;35m%s\\033[0m\\n" "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
printf "\\033[0;35m%s\\033[0m\\n" "or type \"source ${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/env\" to apply them in your current terminal session."
exit 0;;
[Nn]*)
exit 0;;
*)
echo "Please type YES or NO and press enter.";;
esac
done
fi
)
# vim: tabstop=4 shiftwidth=4 expandtab

0
foo Normal file
View File

2165
ghcup-0.0.1.json Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
version: 0.1.0.0
version: 0.1.0
synopsis: ghc toolchain installer as an exe/library
description:
A rewrite of the shell script ghcup, for providing
@@ -283,6 +283,7 @@ library
GHCup.Download.Utils
GHCup.Errors
GHCup.Platform
GHCup.Requirements
GHCup.Types
GHCup.Types.JSON
GHCup.Types.Optics
@@ -368,8 +369,11 @@ executable ghcup-gen
--
main-is: Main.hs
other-modules: GHCupDownloads
Validate
other-modules:
GHCupDownloads
GHCupInfo
ToolRequirements
Validate
-- other-extensions:
build-depends: ghcup

View File

@@ -53,6 +53,7 @@ import Prelude hiding ( abs
)
import System.IO.Error
import System.Posix.FilePath ( getSearchPath )
import System.Posix.Files.ByteString
import qualified Data.ByteString as B
import qualified Data.Map.Strict as Map
@@ -96,14 +97,16 @@ installGHCBin bDls ver mpfReq = do
whenM (liftIO $ toolAlreadyInstalled GHC ver)
$ (throwE $ AlreadyInstalled GHC ver)
Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version)
dlinfo <- liftE $ getDownloadInfo bDls GHC ver mpfReq
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- prepare paths
ghcdir <- liftIO $ ghcupGHCDir ver
@@ -170,14 +173,16 @@ installCabalBin :: ( MonadMask m
installCabalBin bDls ver mpfReq = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version)
dlinfo <- liftE $ getDownloadInfo bDls Cabal ver mpfReq
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- prepare paths
bindir <- liftIO ghcupBinDir
@@ -444,9 +449,13 @@ compileGHC :: ( MonadMask m
'[ AlreadyInstalled
, BuildFailed
, DigestError
, DistroNotFound
, DownloadFailed
, GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
]
@@ -464,6 +473,8 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
(PlatformRequest {..}) <- liftE $ platformRequest
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
bghc <- case bstrap of
Right g -> pure $ Right g
@@ -503,10 +514,10 @@ GhcWithLlvmCodeGen = YES|]
-> Path Abs
-> Path Abs
-> Excepts
'[ NoDownload
, FileDoesNotExistError
'[ FileDoesNotExistError
, PatchFailed
, ProcessError
, NotFoundInPATH
]
m
()
@@ -524,7 +535,7 @@ GhcWithLlvmCodeGen = YES|]
Right ghc' -> pure ghc'
Left bver -> do
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
(liftIO $ searchPath spaths bver) !? NoDownload
(liftIO $ searchPath spaths bver) !? NotFoundInPATH bver
lEM $ liftIO $ execLogged
"./configure"
False
@@ -579,7 +590,10 @@ compileCabal :: ( MonadReader Settings m
-> Excepts
'[ BuildFailed
, DigestError
, DistroNotFound
, DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
@@ -596,6 +610,8 @@ compileCabal dls tver bghc jobs patchdir = do
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
(PlatformRequest {..}) <- liftE $ platformRequest
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
@@ -674,17 +690,30 @@ upgradeGHCup :: ( MonadMask m
upgradeGHCup dls mtarget = do
lift $ $(logInfo) [i|Upgrading GHCup...|]
let latestVer = fromJust $ getLatest dls GHCup
dli <- liftE $ getDownloadInfo dls GHCup latestVer Nothing
tmp <- lift withGHCupTmpDir
pfreq <- liftE platformRequest
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|]
p <- liftE $ download dli tmp (Just fn)
let fileMode' =
newFilePerms
`unionFileModes` ownerExecuteMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherExecuteMode
case mtarget of
Nothing -> do
dest <- liftIO $ ghcupBinDir
liftIO $ hideError NoSuchThing $ deleteFile (dest </> fn)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
(dest </> fn)
Overwrite
Just fullDest -> liftIO $ copyFile p fullDest Overwrite
liftIO $ setFileMode (toFilePath (dest </> fn)) fileMode'
Just fullDest -> do
liftIO $ hideError NoSuchThing $ deleteFile fullDest
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
fullDest
Overwrite
liftIO $ setFileMode (toFilePath fullDest) fileMode'
pure latestVer

View File

@@ -16,7 +16,6 @@ import GHCup.Download.IOStreams
import GHCup.Download.Utils
#endif
import GHCup.Errors
import GHCup.Platform
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
@@ -94,7 +93,7 @@ getDownloads :: ( FromJSONKey Tool
, MonadFail m
)
=> URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupDownloads
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
getDownloads urlSource = do
lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
case urlSource of
@@ -204,43 +203,13 @@ getDownloads urlSource = do
setModificationTimeHiRes path mod_time
getDownloadInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
=> GHCupDownloads
-> Tool
getDownloadInfo :: Tool
-> Version
-> Maybe PlatformRequest
-> Excepts
'[ DistroNotFound
, NoCompatiblePlatform
, NoCompatibleArch
, NoDownload
]
m
DownloadInfo
getDownloadInfo bDls t v mpfReq = do
(PlatformRequest arch' plat ver) <- case mpfReq of
Just x -> pure x
Nothing -> do
(PlatformResult rp rv) <- liftE getPlatform
ar <- lE getArchitecture
pure $ PlatformRequest ar rp rv
lE $ getDownloadInfo' t v arch' plat ver bDls
getDownloadInfo' :: Tool
-> Version
-- ^ tool version
-> Architecture
-- ^ user arch
-> Platform
-- ^ user platform
-> Maybe Versioning
-- ^ optional version of the platform
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo' t v a p mv dls = maybe
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
(Left NoDownload)
Right
(with_distro <|> without_distro_ver <|> without_distro)
@@ -304,7 +273,7 @@ download dli dest mfn
) $ do
#if defined(CURL)
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
["-sSfL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
#else
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
liftE $ downloadToFile https host fullPath port destFile

View File

@@ -63,6 +63,10 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
data NotInstalled = NotInstalled Tool Version
deriving Show
-- | An executable was expected to be in PATH, but was not found.
data NotFoundInPATH = NotFoundInPATH (Path Rel)
deriving Show
-- | JSON decoding failed.
data JSONError = JSONDecodeError String
deriving Show
@@ -92,6 +96,9 @@ data TooManyRedirs = TooManyRedirs
data PatchFailed = PatchFailed
deriving Show
-- | The tool requirements could not be found.
data NoToolRequirements = NoToolRequirements
deriving Show
-------------------------

View File

@@ -46,6 +46,21 @@ import qualified Data.Text.Encoding as E
--------------------------
-- | Get the full platform request, consisting of architecture, distro, ...
platformRequest :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Excepts
'[ NoCompatiblePlatform
, NoCompatibleArch
, DistroNotFound
]
m
PlatformRequest
platformRequest = do
(PlatformResult rp rv) <- liftE getPlatform
ar <- lE getArchitecture
pure $ PlatformRequest ar rp rv
getArchitecture :: Either NoCompatibleArch Architecture
getArchitecture = case arch of
"x86_64" -> Right A_64
@@ -64,16 +79,30 @@ getPlatform = do
"linux" -> do
(distro, ver) <- liftE getLinuxDistro
pure $ PlatformResult { _platform = Linux distro, _distroVersion = ver }
-- TODO: these are not verified
"darwin" ->
pure $ PlatformResult { _platform = Darwin, _distroVersion = Nothing }
"darwin" -> do
ver <-
( either (const Nothing) Just
. versioning
. getMajorVersion
. E.decodeUtf8
)
<$> getDarwinVersion
pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
"freebsd" -> do
ver <- getFreeBSDVersion
ver <-
(either (const Nothing) Just . versioning . E.decodeUtf8)
<$> getFreeBSDVersion
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
what -> throwE $ NoCompatiblePlatform what
lift $ $(logDebug) [i|Identified Platform as: #{pfr}|]
pure pfr
where getFreeBSDVersion = pure Nothing
where
getMajorVersion = T.intercalate "." . take 2 . T.split (== '.')
getFreeBSDVersion =
liftIO $ fmap _stdOut $ executeOut [rel|freebsd-version|] [] Nothing
getDarwinVersion = liftIO $ fmap _stdOut $ executeOut [rel|sw_vers|]
["-productVersion"]
Nothing
getLinuxDistro :: (MonadCatch m, MonadIO m)

46
lib/GHCup/Requirements.hs Normal file
View File

@@ -0,0 +1,46 @@
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Requirements where
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import Control.Applicative
import Data.Maybe
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import qualified Data.Text as T
-- | Get the requirements. Right now this combines GHC and cabal
-- and doesn't do fine-grained distinction. However, the 'ToolRequirements'
-- type allows it.
getCommonRequirements :: PlatformResult
-> ToolRequirements
-> Maybe Requirements
getCommonRequirements pr tr =
preview (ix GHC % ix Nothing % ix (_platform pr) % ix (_distroVersion pr)) tr
<|> preview (ix GHC % ix Nothing % ix (_platform pr) % ix Nothing) tr
<|> preview
( ix GHC
% ix Nothing
% ix (set _Linux UnknownLinux $ _platform pr)
% ix Nothing
)
tr
prettyRequirements :: Requirements -> T.Text
prettyRequirements Requirements {..} =
let d = if not . null $ _distroPKGs
then
"\n Install the following distro packages: "
<> T.intercalate " " _distroPKGs
else ""
n = if not . T.null $ _notes then "\n Note: " <> _notes else ""
in "System requirements " <> d <> n

View File

@@ -12,6 +12,39 @@ import qualified GHC.Generics as GHC
--------------------
--[ GHCInfo Tree ]--
--------------------
data GHCupInfo = GHCupInfo
{ _toolRequirements :: ToolRequirements
, _ghcupDownloads :: GHCupDownloads
}
deriving (Show, GHC.Generic)
-------------------------
--[ Requirements Tree ]--
-------------------------
type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe Versioning) Requirements
data Requirements = Requirements
{ _distroPKGs :: [Text]
, _notes :: Text
}
deriving (Show, GHC.Generic)
---------------------
--[ Download Tree ]--
@@ -99,7 +132,7 @@ data DownloadInfo = DownloadInfo
-- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL
| OwnSource URI
| OwnSpec GHCupDownloads
| OwnSpec GHCupInfo
deriving Show

View File

@@ -39,6 +39,8 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
instance ToJSON URI where
@@ -69,11 +71,11 @@ instance FromJSONKey Versioning where
instance ToJSONKey (Maybe Versioning) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyV x
Nothing -> T.pack "unknown_version"
Nothing -> T.pack "unknown_versioning"
instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else pure $ just t
if t == T.pack "unknown_versioning" then pure Nothing else pure $ just t
where
just t = case versioning t of
Right x -> pure x
@@ -112,6 +114,19 @@ instance ToJSONKey Architecture where
instance FromJSONKey Architecture where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey (Maybe Version) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyVer x
Nothing -> T.pack "unknown_version"
instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else pure $ just t
where
just t = case version t of
Right x -> pure x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where
toJSON = toJSON . prettyVer

View File

@@ -19,6 +19,7 @@ makeLenses ''DownloadInfo
makeLenses ''Tag
makeLenses ''VersionInfo
makeLenses ''GHCupInfo
uriSchemeL' :: Lens' (URIRef Absolute) Scheme
uriSchemeL' = lensVL uriSchemeL

View File

@@ -358,3 +358,13 @@ applyPatches pdir ddir = do
Nothing
)
!? PatchFailed
darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Darwin path = exec
"xattr"
True
["-r", "-d", "com.apple.quarantine", toFilePath path]
Nothing
Nothing
darwinNotarization _ _ = pure $ Right ()

View File

@@ -9,8 +9,9 @@ import Data.Versions
import URI.ByteString
import URI.ByteString.QQ
-- | This reflects the API version of the JSON.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
ghcUpVer :: PVP
ghcUpVer = [pver|0.0.1|]
ghcUpVer = [pver|0.1.0|]