Compare commits
21 Commits
34386680cc
...
v0.1.0
| Author | SHA1 | Date | |
|---|---|---|---|
| de66b92631 | |||
| fee3984bf7 | |||
| b953c8fd30 | |||
| 24e4c3a19b | |||
| d2efb504b9 | |||
| df9dd0e785 | |||
| 89c9699158 | |||
| 124ddcdfeb | |||
| 5c0a0fc155 | |||
| b11b74d2b4 | |||
| 5ac8f5b651 | |||
| 9032df97cf | |||
| 14e1077ad1 | |||
| b5648bdd6b | |||
| e7cd952970 | |||
| 1455c2c175 | |||
| c106dd3f65 | |||
| f6725fbf5f | |||
| c706a047ea | |||
| 9602db31ab | |||
| c2c47e1b7e |
42
.travis.yml
Normal file
42
.travis.yml
Normal 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
22
.travis/build.sh
Executable 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
29
HACKING.md
Normal 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
|
||||
@@ -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
11
RELEASING.md
Normal 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.
|
||||
@@ -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)])
|
||||
]
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
11
app/ghcup-gen/GHCupInfo.hs
Normal file
11
app/ghcup-gen/GHCupInfo.hs
Normal file
@@ -0,0 +1,11 @@
|
||||
module GHCupInfo where
|
||||
|
||||
import GHCupDownloads
|
||||
import ToolRequirements
|
||||
import GHCup.Types
|
||||
|
||||
|
||||
ghcupInfo :: GHCupInfo
|
||||
ghcupInfo = GHCupInfo { _toolRequirements = toolRequirements
|
||||
, _ghcupDownloads = ghcupDownloads
|
||||
}
|
||||
@@ -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)
|
||||
|
||||
94
app/ghcup-gen/ToolRequirements.hs
Normal file
94
app/ghcup-gen/ToolRequirements.hs
Normal 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"
|
||||
]
|
||||
""
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
@@ -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
190
bootstrap-haskell
Executable 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
|
||||
|
||||
2165
ghcup-0.0.1.json
Normal file
2165
ghcup-0.0.1.json
Normal file
File diff suppressed because it is too large
Load Diff
10
ghcup.cabal
10
ghcup.cabal
@@ -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
|
||||
|
||||
45
lib/GHCup.hs
45
lib/GHCup.hs
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
-------------------------
|
||||
|
||||
@@ -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
46
lib/GHCup/Requirements.hs
Normal 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
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -19,6 +19,7 @@ makeLenses ''DownloadInfo
|
||||
makeLenses ''Tag
|
||||
makeLenses ''VersionInfo
|
||||
|
||||
makeLenses ''GHCupInfo
|
||||
|
||||
uriSchemeL' :: Lens' (URIRef Absolute) Scheme
|
||||
uriSchemeL' = lensVL uriSchemeL
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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|]
|
||||
|
||||
Reference in New Issue
Block a user