Compare commits

...

44 Commits

Author SHA1 Message Date
5da5fabfef Use alpine:3.12 instead of edge 2020-09-21 12:23:14 +02:00
05cc55c52d Improve brick UI 2020-09-21 10:40:06 +02:00
571df1349c Update hie.yaml 2020-09-20 23:09:09 +02:00
cbbb75062c Bump version to 0.1.11 2020-09-20 23:09:09 +02:00
bb7c4205db Allow to install haskell-language-server wrt #65 2020-09-20 23:09:09 +02:00
b2027f1625 Simplify installing GHC from custom bindist wrt #60 2020-09-19 11:52:12 +02:00
65945c87df Update CHANGELOG 2020-09-19 11:51:48 +02:00
081582d3e1 Merge branch 'compile-overwrite' into master 2020-09-18 09:31:14 +02:00
bf240af518 Fix build
https://github.com/cjdev/text-conversions/pull/10
2020-09-17 22:18:03 +02:00
a269131e2d Allow to compile over existing version, fixes #59 2020-09-17 21:21:16 +02:00
59ece98fdc Fix bug in compileGHC cleanup logic 2020-09-17 21:20:38 +02:00
563924ff26 Fix gitlab CI 2020-09-15 22:22:15 +02:00
8ee3f55428 Fix test on i386 2020-09-15 21:59:56 +02:00
93c17607b5 Fix haddock build, fixes #62 2020-09-15 17:44:30 +02:00
8b4c239444 Add changelog entry for cabal-3.4.0.0-rc3 2020-09-15 15:43:07 +02:00
8bef17bf59 Add cabal-3.4.0.0-rc3 2020-09-15 15:38:10 +02:00
a649146a39 Add hspec tests to gitlab CI 2020-09-13 21:13:42 +02:00
9d6a5313ab Add JSON roundtrip specs 2020-09-13 21:10:13 +02:00
de09c950d5 Improve requirements wording, fixes #56 2020-09-13 15:38:51 +02:00
47838b1bd9 Merge branch 'compile-bindist' into master 2020-09-13 13:30:28 +02:00
02b360e2a9 Create bindists when compiling GHC wrt #51 2020-09-12 23:47:12 +02:00
c10ab15e0c Update cabal pre-release ot 3.4.0.0-rc2 2020-09-04 10:16:28 +02:00
46f3da1a94 Merge branch 'fix-symlink-support' into master 2020-09-01 21:07:42 +02:00
7ec9d90aab Fix build with libarchive-3.0.0.0 2020-09-01 19:55:48 +02:00
326bf510c9 Fix Error when ~/.ghcup is a valid symlink
Fixes #49
2020-08-31 13:03:12 +02:00
ce3d1f4309 Add GHC-9.0.1-alpha1 2020-08-27 23:41:07 +02:00
b31ba883e4 Add vim integration section to README 2020-08-23 14:07:49 +02:00
e5d1c04616 Fix bootstrap-haskell for fish shell, fixes #48 2020-08-20 15:51:37 +02:00
34ff0ed9cf Fix dlSubDir for GHC-8.10.2 on alpine wrt #47 2020-08-20 15:49:28 +02:00
85bd87d5f3 Clarify 2020-08-19 19:40:59 +02:00
8b274214af Fix typo 2020-08-19 19:38:36 +02:00
069e3102f4 Fix anchor 2020-08-19 19:36:13 +02:00
8623b32721 Add "Install custom bindists" to README 2020-08-19 19:34:04 +02:00
6342e8edf0 Use 8.10.2 in gitlab CI 2020-08-15 23:54:50 +02:00
bbd8f0c84c Add GHC-8.10.2 for alpine 32big 2020-08-15 23:34:05 +02:00
873c951d6e Refactor chmod +x 2020-08-14 22:27:05 +02:00
d9c864d3c5 Make sure cabal is executable wrt #46 2020-08-14 22:07:39 +02:00
4280d7109a Fix 3.4.0.0-rc1 urls wrt #46 2020-08-14 21:49:01 +02:00
c8855c068f Update version in bootstrap-haskell 2020-08-14 20:36:14 +02:00
90503061e9 Add ghcup-0.1.10 2020-08-14 20:22:27 +02:00
672ebf6426 Bump version 2020-08-14 16:57:15 +02:00
fd76fde23a Add cabal-3.4.0.0-rc1 2020-08-14 16:54:27 +02:00
e24c9a3ffe Show stray cabals, fixes #45 2020-08-14 16:53:32 +02:00
2641d50c21 Update ghcup binaries 2020-08-14 09:42:41 +02:00
28 changed files with 12196 additions and 215 deletions

View File

@@ -17,7 +17,7 @@ variables:
BIT: "64"
.alpine:64bit:
image: "alpine:edge"
image: "alpine:3.12"
tags:
- x86_64-linux
variables:
@@ -25,7 +25,7 @@ variables:
BIT: "64"
.alpine:32bit:
image: "i386/alpine:edge"
image: "i386/alpine:3.12"
tags:
- x86_64-linux
variables:
@@ -113,7 +113,7 @@ test:linux:recommended:
test:linux:latest:
extends: .test_ghcup_version:linux
variables:
GHC_VERSION: "8.10.1"
GHC_VERSION: "8.10.2"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
@@ -136,7 +136,7 @@ test:mac:recommended:
test:mac:latest:
extends: .test_ghcup_version:darwin
variables:
GHC_VERSION: "8.10.1"
GHC_VERSION: "8.10.2"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
@@ -152,7 +152,7 @@ test:freebsd:recommended:
test:freebsd:latest:
extends: .test_ghcup_version:freebsd
variables:
GHC_VERSION: "8.10.1"
GHC_VERSION: "8.10.2"
CABAL_VERSION: "3.2.0.0"
allow_failure: true

View File

@@ -20,22 +20,28 @@ git describe --always
ecabal update
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION} -ftui
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
elif [ "${OS}" = "LINUX" ] ; then
if [ "${BIT}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ghcup-test
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
fi
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
fi
ecabal haddock -w ghc-${GHC_VERSION} -ftar
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" .
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" .
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" .
cp ./ghcup "$CI_PROJECT_DIR"/.local/bin/ghcup
cp ./ghcup-gen "$CI_PROJECT_DIR"/.local/bin/ghcup-gen
@@ -87,6 +93,18 @@ eghcup set ${GHC_VERSION}
eghcup rm 8.4.4
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
# install hls
if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls
haskell-language-server-wrapper --version
elif [ "${OS}" = "LINUX" ] ; then
if [ "${BIT}" = "64" ] ; then
eghcup install hls
haskell-language-server-wrapper --version
fi
fi
eghcup rm $(ghc --numeric-version)
eghcup upgrade

View File

@@ -1,8 +1,24 @@
# Revision history for ghcup
## 0.1.9 -- yyyy-mm-dd
## 0.1.11 -- ????-??-??
* Add support for installing haskell-language-server, wrt #65
* When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51
* Allow to compile over existing version (`ghcup compile ghc -v 8.6.5 -b 8.6.5`) and replace it wrt #59
* simplify installing from custom bindist wrt #60
- `ghcup install ghc -u <url> <version>`
* fix bug when cabal isn't marked executable in bindist
* fix bug when `~/.ghcup` is a valid symlink wrt #49
* Add JSON roundtrip tests
## 0.1.10 -- 2020-08-14
* Show stray Cabals (useful for pre-releases or compiled ones)
## 0.1.9 -- 2020-08-14
* Fix bug when uninstalling all cabal versions
* Fix bug when setting a non-installed ghc version as current default
* Use yaml instead of generated json for download info for ease of adding new GHC versions #44
* Allow pre-release versions of GHC/cabal
* Add XDG dirs support (set `GHCUP_USE_XDG_DIRS`) wrt #39

View File

@@ -9,11 +9,15 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
## Table of Contents
* [Installation](#installation)
* [Simple bootstrap](#simple-bootstrap)
* [Manual install](#manual-install)
* [Vim integration](#vim-integration)
* [Usage](#usage)
* [Manpages](#manpages)
* [Shell-completion](#shell-completion)
* [Cross support](#cross-support)
* [XDG support](#xdg-support)
* [Installing custom bindists](#installing-custom-bindists)
* [Design goals](#design-goals)
* [How](#how)
* [Known users](#known-users)
@@ -37,6 +41,10 @@ Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) lik
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
```
### Vim integration
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
## Usage
See `ghcup --help`.
@@ -107,6 +115,22 @@ Then you can control the locations via XDG environment variables as such:
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
### Installing custom bindists
There are a couple of good use cases to install custom bindists:
1. manually built bindists (e.g. with patches)
- example: `ghcup install ghc -u 'file:///home/mearwald/tmp/ghc-eff-patches/ghc-8.10.2-x86_64-deb10-linux.tar.xz' 8.10.2-eff`
2. GHC head CI bindists
- example: `ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
3. DWARF bindists
- example: `ghcup install ghc -u 'https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux-dwarf.tar.xz' 8.10.2-dwarf`
Since the version parser is pretty lax, `8.10.2-eff` and `head` are both valid versions
and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected).
## Design goals
1. simplicity

View File

@@ -55,7 +55,7 @@ validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m)
validate dls = do
ref <- liftIO $ newIORef 0
-- * verify binary downloads * --
-- verify binary downloads --
flip runReaderT ref $ do
-- unique tags
forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t

View File

@@ -71,19 +71,26 @@ ui AppState {..} =
( padBottom Max
$ ( withBorderStyle unicode
$ borderWithLabel (str "GHCup")
$ (center $ renderList renderItem True lr)
$ (center $ (header <=> hBorder <=> renderList renderItem True lr))
)
)
<=> ( withAttr "help"
. txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
. (++ ["↑↓:Navigation"])
$ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
)
<=> footer
where
renderItem b ListResult {..} =
footer =
withAttr "help"
. txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
. (++ ["↑↓:Navigation"])
$ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
header =
(minHSize 2 $ emptyWidget)
<+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
<+> (minHSize 15 $ str "Version")
<+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
<+> (padLeft (Pad 5) $ str "Notes")
renderItem b listResult@(ListResult {..}) =
let marks = if
| lSet -> (withAttr "set" $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "")
@@ -94,20 +101,28 @@ ui AppState {..} =
dim = if lNoBindist
then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
else id
active = if b then withAttr "active" else id
in dim
( marks
<+> ( padLeft (Pad 2)
$ minHSize 20
$ ((if b then withAttr "active" else id)
(str $ (fmap toLower . show $ lTool) <> " " <> ver)
)
<+> (( padLeft (Pad 2)
$ active
$ minHSize 6
$ (str (fmap toLower . show $ lTool))
)
)
<+> (padLeft (Pad 1) $ if null lTag
<+> (minHSize 15 $ active $ (str ver))
<+> (padLeft (Pad 1) $ minHSize 25 $ if null lTag
then emptyWidget
else
foldr1 (\x y -> x <+> str "," <+> y)
$ (fmap printTag $ sort lTag)
)
<+> ( padLeft (Pad 5)
$ let notes = printNotes listResult
in if null notes
then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) $ notes
)
)
printTag Recommended = withAttr "recommended" $ str "recommended"
@@ -116,6 +131,13 @@ ui AppState {..} =
printTag (Base pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag (UnknownTag t ) = str t
printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
)
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
minHSize :: Int -> Widget n -> Widget n
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
@@ -137,8 +159,11 @@ defaultAttributes = attrMap
, ("set" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("installed" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("recommended" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("hls-powered" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("latest" , Vty.defAttr `Vty.withForeColor` Vty.yellow)
, ("prerelease" , Vty.defAttr `Vty.withForeColor` Vty.red)
, ("compiled" , Vty.defAttr `Vty.withForeColor` Vty.blue)
, ("stray" , Vty.defAttr `Vty.withForeColor` Vty.blue)
, ("help" , Vty.defAttr `Vty.withStyle` Vty.italic)
]
@@ -223,6 +248,7 @@ install' AppState {..} (_, ListResult {..}) = do
GHC -> liftE $ installGHCBin dls lVer pfreq
Cabal -> liftE $ installCabalBin dls lVer pfreq
GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
HLS -> liftE $ installHLSBin dls lVer pfreq $> ()
)
>>= \case
VRight _ -> pure $ Right ()
@@ -251,6 +277,7 @@ set' _ (_, ListResult {..}) = do
case lTool of
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
Cabal -> liftE $ setCabal lVer $> ()
HLS -> liftE $ setHLS lVer $> ()
GHCup -> pure ()
)
>>= \case
@@ -270,6 +297,7 @@ del' _ (_, ListResult {..}) = do
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> ()
Cabal -> liftE $ rmCabalVer lVer $> ()
HLS -> liftE $ rmHLSVer lVer $> ()
GHCup -> pure ()
)
>>= \case

View File

@@ -39,7 +39,6 @@ import Control.Monad.Fail ( MonadFail )
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Aeson ( eitherDecode )
import Data.Bifunctor
import Data.Char
import Data.Either
@@ -70,7 +69,6 @@ import URI.ByteString
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Lazy.UTF8 as BLU
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
@@ -118,15 +116,17 @@ prettyToolVer (ToolTag t) = show t
data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe DownloadInfo
, instBindist :: Maybe URI
}
data SetCommand = SetGHC SetOptions
| SetCabal SetOptions
| SetHLS SetOptions
data SetOptions = SetOptions
{ sToolVer :: Maybe ToolVersion
@@ -140,6 +140,7 @@ data ListOptions = ListOptions
data RmCommand = RmGHC RmOptions
| RmCabal Version
| RmHLS Version
data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion
@@ -207,8 +208,8 @@ opts =
( long "keep"
<> metavar "<always|errors|never>"
<> help
"Keep build directories? (default: never)"
<> value Never
"Keep build directories? (default: errors)"
<> value Errors
<> hidden
)
<*> option
@@ -396,10 +397,29 @@ installParser =
)
)
)
<> command
"hls"
( InstallHLS
<$> (info
(installOpts <**> helper)
( progDesc "Install haskell-languge-server"
<> footerDoc (Just $ text installHLSFooter)
)
)
)
)
)
<|> (Right <$> installOpts)
where
installHLSFooter :: String
installHLSFooter = [s|Discussion:
Installs haskell-language-server binaries and wrapper
into "~/.ghcup/bin"
Examples:
# install recommended GHC
ghcup install hls|]
installGHCFooter :: String
installGHCFooter = [s|Discussion:
Installs the specified GHC version (or a recommended default one) into
@@ -407,13 +427,22 @@ installParser =
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
Examples:
# install GHC head
ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": { "RegexDir": "ghc-.*"}, "dlUri": "https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27" }' head|]
# install recommended GHC
ghcup install ghc
# install latest GHC
ghcup install ghc latest
# install GHC 8.10.2
ghcup install ghc 8.10.2
# install GHC head fedora bindist
ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
installOpts :: Parser InstallOptions
installOpts =
(\p u v -> InstallOptions v p u)
(\p (u, v) -> InstallOptions v p u)
<$> (optional
(option
(eitherReader platformParser)
@@ -425,18 +454,19 @@ installOpts =
)
)
)
<*> (optional
(option
(eitherReader bindistParser)
( short 'u'
<> long "url"
<> metavar "BINDIST_URL"
<> help
"Provide DownloadInfo as json string, e.g.: '{ \"dlHash\": \"<sha256 hash>\", \"dlSubdir\": { \"RegexDir\": \"ghc-.*\"}, \"dlUri\": \"<uri>\" }'"
<*> ( ( (,)
<$> (optional
(option
(eitherReader bindistParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist"
)
)
)
<*> (Just <$> toolVersionArgument)
)
)
<|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
)
<*> optional toolVersionArgument
setParser :: Parser (Either SetCommand SetOptions)
@@ -462,6 +492,16 @@ setParser =
)
)
)
<> command
"hls"
( SetHLS
<$> (info
(setOpts <**> helper)
( progDesc "Set haskell-language-server version"
<> footerDoc (Just $ text setHLSFooter)
)
)
)
)
)
<|> (Right <$> setOpts)
@@ -476,6 +516,10 @@ setParser =
setCabalFooter = [s|Discussion:
Sets the the current Cabal version.|]
setHLSFooter :: String
setHLSFooter = [s|Discussion:
Sets the the current haskell-language-server version.|]
setOpts :: Parser SetOptions
setOpts = SetOptions <$> optional toolVersionArgument
@@ -518,6 +562,13 @@ rmParser =
(progDesc "Remove Cabal version")
)
)
<> command
"hls"
( RmHLS
<$> (info (versionParser' <**> helper)
(progDesc "Remove haskell-language-server version")
)
)
)
)
<|> (Right <$> rmOpts)
@@ -819,8 +870,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
pure v
bindistParser :: String -> Either String DownloadInfo
bindistParser = eitherDecode . BLU.fromString
bindistParser :: String -> Either String URI
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
toSettings :: Options -> IO Settings
@@ -910,7 +961,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
settings@Settings{dirs = Dirs{..}, ..} <- toSettings opt
-- create ~/.ghcup dir
createDirRecursive newDirPerms baseDir
createDirRecursive' baseDir
-- logger interpreter
logfile <- flip runReaderT settings $ initGHCupFileLogging [rel|ghcup.log|]
@@ -926,9 +977,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-- Effect interpreters --
-------------------------
let runInstTool =
let runInstTool' settings' =
runLogger
. flip runReaderT settings
. flip runReaderT settings'
. runResourceT
. runE
@'[ AlreadyInstalled
@@ -947,6 +998,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TarDirDoesNotExist
]
let runInstTool = runInstTool' settings
let
runSetGHC =
runLogger
@@ -966,6 +1019,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TagNotFound
]
let
runSetHLS =
runLogger
. flip runReaderT settings
. runE
@'[ NotInstalled
, TagNotFound
]
let runListGHC = runLogger . flip runReaderT settings
let runRm =
@@ -992,6 +1054,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
#if !defined(TAR)
, ArchiveResult
#endif
@@ -1070,11 +1133,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-----------------------
let installGHC InstallOptions{..} =
(runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC
case instBindist of
Nothing -> liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> liftE $ installGHCBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
(case instBindist of
Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> runInstTool' settings{noVerify = True} $ do
v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
(fromMaybe pfreq instPlatform)
)
>>= \case
VRight _ -> do
@@ -1082,7 +1150,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed|]
[i|GHC ver #{prettyVer v} already installed, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do
case keepDirs of
@@ -1106,11 +1174,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installCabal InstallOptions{..} =
(runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal
case instBindist of
Nothing -> liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> liftE $ installCabalBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
(case instBindist of
Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> runInstTool' settings{noVerify = True} $ do
v <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
(fromMaybe pfreq instPlatform)
)
>>= \case
VRight _ -> do
@@ -1118,7 +1191,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn)
[i|Cabal ver #{prettyVer v} already installed|]
[i|Cabal ver #{prettyVer v} already installed, you may want to run 'ghcup rm cabal #{prettyVer v}' first|]
pure ExitSuccess
VLeft (V NoDownload) -> do
@@ -1133,6 +1206,40 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
$(logError) [i|Also check the logs in #{logsDir}|]
pure $ ExitFailure 4
let installHLS InstallOptions{..} =
(case instBindist of
Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer HLS
liftE $ installHLSBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> runInstTool' settings{noVerify = True} $ do
v <- liftE $ fromVersion dls instVer HLS
liftE $ installHLSBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
(fromMaybe pfreq instPlatform)
)
>>= \case
VRight _ -> do
runLogger $ $(logInfo) ("HLS installation successful")
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn)
[i|HLS ver #{prettyVer v} already installed, you may want to run 'ghcup rm hls #{prettyVer v}' first|]
pure ExitSuccess
VLeft (V NoDownload) -> do
runLogger $ do
case instVer of
Just iver -> $(logError) [i|No available HLS version for #{prettyToolVer iver}|]
Nothing -> $(logError) [i|No available recommended HLS version|]
pure $ ExitFailure 4
VLeft e -> do
runLogger $ do
$(logError) [i|#{e}|]
$(logError) [i|Also check the logs in #{logsDir}|]
pure $ ExitFailure 4
let setGHC' SetOptions{..} =
(runSetGHC $ do
v <- liftE $ fromVersion dls sToolVer GHC
@@ -1159,6 +1266,17 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 14
let setHLS' SetOptions{..} =
(runSetHLS $ do
v <- liftE $ fromVersion dls sToolVer HLS
liftE $ setHLS (_tvVersion v)
)
>>= \case
VRight _ -> pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 14
let rmGHC' RmOptions{..} =
(runRm $ do
liftE $ rmGHCVer ghcVer
@@ -1179,6 +1297,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 15
let rmHLS' tv =
(runRm $ do
liftE $ rmHLSVer tv
)
>>= \case
VRight _ -> pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 15
res <- case optCommand of
@@ -1190,6 +1317,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
installGHC iopts
Install (Left (InstallGHC iopts)) -> installGHC iopts
Install (Left (InstallCabal iopts)) -> installCabal iopts
Install (Left (InstallHLS iopts)) -> installHLS iopts
InstallCabalLegacy iopts -> do
runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
installCabal iopts
@@ -1199,6 +1327,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
setGHC' sopts
Set (Left (SetGHC sopts)) -> setGHC' sopts
Set (Left (SetCabal sopts)) -> setCabal' sopts
Set (Left (SetHLS sopts)) -> setHLS' sopts
List (ListOptions {..}) ->
(runListGHC $ do
@@ -1212,6 +1341,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
rmGHC' rmopts
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts
DInfo ->
do
@@ -1241,7 +1371,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed|]
[i|GHC ver #{prettyVer v} already installed, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do
case keepDirs of
@@ -1419,7 +1549,8 @@ printListResult raw lr = do
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
, intercalate "," $ (fmap printTag $ sort lTag)
, intercalate ","
$ (if fromSrc then [color' Blue "compiled"] else mempty)
$ (if hlsPowered then [color' Green "hls-powered"] else mempty)
++ (if fromSrc then [color' Blue "compiled"] else mempty)
++ (if lStray then [color' Yellow "stray"] else mempty)
++ (if lNoBindist then [color' Red "no-bindist"] else mempty)
]
@@ -1461,6 +1592,13 @@ checkForUpdates dls pfreq = do
$ $(logWarn)
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
forM_ (getLatest dls HLS) $ \l -> do
mcabal_ver <- latestInstalled HLS
forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver)
$ $(logWarn)
[i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
where
latestInstalled tool = (fmap lVer . lastMay)
<$> (listVersions dls (Just tool) (Just ListInstalled) pfreq)
@@ -1476,20 +1614,4 @@ GHCup cache directory: #{toFilePath diCacheDir}
Architecture: #{prettyArch diArch}
Platform: #{prettyPlatform diPlatform}
Version: #{describe_result}|]
where
prettyArch :: Architecture -> String
prettyArch A_64 = "amd64"
prettyArch A_32 = "i386"
prettyArch A_PowerPC = "PowerPC"
prettyArch A_PowerPC64 = "PowerPC64"
prettyArch A_Sparc = "Sparc"
prettyArch A_Sparc64 = "Sparc64"
prettyArch A_ARM = "ARM"
prettyArch A_ARM64 = "ARM64"
prettyPlatform :: PlatformResult -> String
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> show v'
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat

View File

@@ -59,7 +59,7 @@ _done() {
download_ghcup() {
_plat="$(uname -s)"
_arch=$(uname -m)
_ghver="0.1.8"
_ghver="0.1.10"
_base_url="https://downloads.haskell.org/~ghcup"
case "${_plat}" in
@@ -235,7 +235,7 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
echo "# ghcup-env" >> "${GHCUP_PROFILE_FILE}"
echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME" >> "${GHCUP_PROFILE_FILE}"
echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN/bin \$PATH" >> "${GHCUP_PROFILE_FILE}"
echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH" >> "${GHCUP_PROFILE_FILE}"
fi
break ;;
*)

View File

@@ -8,6 +8,24 @@ source-repository-package
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdir: haskus-utils-types
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-io
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory
-- https://github.com/cjdev/text-conversions/pull/10
source-repository-package
type: git
location: https://github.com/hasufell/text-conversions.git
tag: 9abf0e5e5664a3178367597c32db19880477a53c
optimization: 2
package streamly
@@ -19,6 +37,6 @@ package ghcup
constraints: http-io-streams -brotli
package libarchive
flags: +static
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell

View File

@@ -1159,7 +1159,7 @@ ghcupDownloads:
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-8.10.2
dlSubdir: ghc-8.10.2-x86_64-unknown-linux
dlHash: 14d09a508f2a3a11875c140be8e6c5f6982ac5cd448f089ca10b7adc955fec76
Linux_AmazonLinux:
unknown_versioning: *ghc-8102-64-centos
@@ -1188,6 +1188,83 @@ ghcupDownloads:
unknown_versioning: *ghc-8102-32-deb9
Linux_UnknownLinux:
unknown_versioning: *ghc-8102-32-deb9
Linux_Alpine:
unknown_versioning:
dlUri: https://files.hasufell.de/ghc/ghc-8.10.2-i386-alpine-linux.tar.xz
dlSubdir: ghc-8.10.2
dlHash: 9ee1cf1e85e9536088b3c9e80e975074e525ea378cd4eb156071bbc4b7b38327
9.0.1-alpha1:
viTags:
- Prerelease
- base-4.15.0.0
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-src.tar.xz
dlSubdir: ghc-9.0.0.20200821
dlHash: 8a3a36a0d770dbe678dbc084c3cc9a426749ac9d695f34fa30dc4da1564be6cb
viArch:
A_64:
Linux_Debian:
'9': &ghc-901a1-64-deb9
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-deb9-linux.tar.xz
dlSubdir: ghc-9.0.0
dlHash: a58b508e5d9f85a5831c7e451766105c4b2188987b3110ac62c8182e3e6ed0f6
'10': &ghc-901a1-64-deb10
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-deb10-linux-dwarf.tar.xz
dlSubdir: ghc-9.0.0
dlHash: 963d4cef71780f24d23cd947d33f61e9ee338f85e2aed06ec588fdb8be339a04
unknown_versioning: *ghc-901a1-64-deb9
Linux_Ubuntu:
unknown_versioning: &ghc-901a1-64-fedora
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-fedora27-linux.tar.xz
dlSubdir: ghc-9.0.0
dlHash: e6c241d7945fe84e03501c8a9b947a5f50ad489cdf2b6e286d5de76046a8a6f3
'16.04': *ghc-901a1-64-deb9
'18.04': *ghc-901a1-64-deb9
Linux_Mint:
unknown_versioning: *ghc-901a1-64-deb10
Linux_Fedora:
'27': *ghc-901a1-64-fedora
unknown_versioning: *ghc-901a1-64-fedora
Linux_CentOS:
'7': &ghc-901a1-64-centos
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-centos7-linux.tar.xz
dlSubdir: ghc-9.0.0
dlHash: e9be471727d6753514667781335018be0fed91483bf80da3f24d21c2e49086e9
unknown_versioning: *ghc-901a1-64-centos
Linux_RedHat:
unknown_versioning: *ghc-901a1-64-centos
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-9.0.0
dlHash: 8a73cbcebe8aac004dda4411873b6cd57169af9af74cbeb636d695852da1f10c
Linux_AmazonLinux:
unknown_versioning: *ghc-901a1-64-centos
Linux_UnknownLinux:
unknown_versioning: *ghc-901a1-64-fedora
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-apple-darwin.tar.xz
dlSubdir: ghc-9.0.0
dlHash: 5bb43fe34997222ae092f3c255d0545dd8ff17409d00f56a356aece9042ace2a
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-x86_64-unknown-freebsd.tar.xz
dlSubdir: ghc-9.0.0
dlHash: 2cb2763fa59bff4c045b7012170132a7a49f09e4f0f894c5367f990b60c38830
A_32:
Linux_Debian:
'9': &ghc-901a1-32-deb9
dlUri: https://downloads.haskell.org/~ghc/9.0.1-alpha1/ghc-9.0.0.20200821-i386-deb9-linux.tar.xz
dlSubdir: ghc-9.0.0
dlHash: 8b025e0c66bb4e21c050755d4c77b7cea66d0269f00f5206c3cef51861aa360f
unknown_versioning: *ghc-901a1-32-deb9
Linux_Ubuntu:
unknown_versioning: *ghc-901a1-32-deb9
Linux_Mint:
unknown_versioning: *ghc-901a1-32-deb9
Linux_UnknownLinux:
unknown_versioning: *ghc-901a1-32-deb9
Cabal:
2.4.1.0:
viTags: []
@@ -1294,8 +1371,32 @@ ghcupDownloads:
unknown_versioning:
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz
dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93
3.4.0.0-rc3:
viTags:
- Prerelease
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
viArch:
A_64:
Linux_Ubuntu:
unknown_versioning: &cabal-3400rc3-ubuntu
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz
dlHash: a97f0362b8cdc78ba4a7891f8b288082dc11e20c64b1b3c8e6c2bd3766446d10
Linux_Alpine:
unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-alpine-3.11.6-static-noofd.tar.xz
dlHash: a82c7dc7e46da823f6a982465b9b29e0640a5ce2e5b573d3dd55a47e20740305
Linux_UnknownLinux:
unknown_versioning: *cabal-3400rc3-ubuntu
Darwin:
unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-darwin-sierra.tar.xz
dlHash: 4553eaea3031c09ab5156af8d4a62bf1ecbbea2c3b57a876f267cbf4b5a15658
FreeBSD:
unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
dlHash: 44e25e0b0d15361acb369f4bf2206a39d2432a08fb922cc40a9b8a045d0a3a6f
GHCup:
0.1.8:
0.1.10:
viTags:
- Recommended
- Latest
@@ -1305,22 +1406,39 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.8/x86_64-linux-ghcup-0.1.8
dlHash: 7ffcd4c3de156e895b648c75a36c762be2a4932883f3cd598f7a483c97d4a8a9
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-linux-ghcup-0.1.10
dlHash: 87661bd127f857b990174ac8d96ad4bd629865306b2058c8cc64d3b36ed317c9
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.8/x86_64-apple-darwin-ghcup-0.1.8
dlHash: b6efc25013a20734e93ad7ae4ecf319f19eeee2129d515d568ccf0003f26615f
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-apple-darwin-ghcup-0.1.10
dlHash: e71666fde6a7700f307e1a55720859d3a042fe27c68ff32f3d1181f4436b7391
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.8/x86_64-portbld-freebsd-ghcup-0.1.8
dlHash: 442cdfe1b4525a327d9566e6270f909f7deba21c16dd4c7912537cf67e6cd521
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-portbld-freebsd-ghcup-0.1.10
dlHash: b5ef1b0454f1a9c5a62b378c1e9c48c2b794d64a22086adf482b064dfb34e68d
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.8/i386-linux-ghcup-0.1.8
dlHash: 18ab162920cea662feae4b08f39d3879e9e416fde7b734afd8072c39d3c43cde
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/i386-linux-ghcup-0.1.10
dlHash: 50ac43199b64bc0724400b0a3db674bef3ec53cf6d41acc04a2c4ca8557e534f
Linux_Alpine:
unknown_versioning: *ghcup-32
HLS:
0.4.0:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#040
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://files.hasufell.de/hls/haskell-language-server-Linux-0.4.0.tar.gz
dlHash: a132365554a1bfcbdfef7403366854f09e6f05376c6aec6562500f09e32af9ed
Darwin:
unknown_versioning:
dlUri: https://files.hasufell.de/hls/haskell-language-server-macOS-0.4.0.tar.gz
dlHash: 8f7ceaf1150774029d45420895546b50fd70605c0ef0b055344a3600e54721ce

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
version: 0.1.9
version: 0.1.11
synopsis: ghc toolchain installer as an exe/library
description:
A rewrite of the shell script ghcup, for providing
@@ -81,6 +81,9 @@ common containers
common cryptohash-sha256
build-depends: cryptohash-sha256 >= 0.11.101.0
common generic-arbitrary
build-depends: generic-arbitrary >=0.1.0
common generics-sop
build-depends: generics-sop >=0.5
@@ -94,13 +97,13 @@ common hpath
build-depends: hpath >=0.11
common hpath-directory
build-depends: hpath-directory >=0.14
build-depends: hpath-directory >=0.14.1
common hpath-filepath
build-depends: hpath-filepath >=0.10.3
common hpath-io
build-depends: hpath-io >=0.14
build-depends: hpath-io >=0.14.1
common hpath-posix
build-depends: hpath-posix >=0.13.2
@@ -108,11 +111,17 @@ common hpath-posix
common http-io-streams
build-depends: http-io-streams >=0.1.2.0
common hspec
build-depends: hspec >=2.7.4
common hspec-golden-aeson
build-depends: hspec-golden-aeson >=0.7
common io-streams
build-depends: io-streams >=1.5
common libarchive
build-depends: libarchive >= 2.2.5.0
build-depends: libarchive >= 3.0.0.0
common lzma
build-depends: lzma >=0.0.0.3
@@ -195,6 +204,12 @@ common transformers
common os-release
build-depends: os-release >=1.0.0
common QuickCheck
build-depends: QuickCheck >=2.14.1
common quickcheck-arbitrary-adt
build-depends: quickcheck-arbitrary-adt >=0.3.1.0
common unix
build-depends: unix >=2.7
@@ -240,8 +255,6 @@ common config
PackageImports
RecordWildCards
ScopedTypeVariables
Strict
StrictData
TupleSections
library
@@ -321,6 +334,10 @@ library
GHCup.Utils.Version.QQ
GHCup.Version
default-extensions:
Strict
StrictData
-- other-modules:
-- other-extensions:
hs-source-dirs: lib
@@ -377,6 +394,10 @@ executable ghcup
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
Strict
StrictData
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
@@ -431,8 +452,25 @@ executable ghcup-gen
default-language: Haskell2010
test-suite ghcup-test
default-language: Haskell2010
import:
config
, base
, bytestring
, containers
, QuickCheck
, generic-arbitrary
, hpath
, hspec
, hspec-golden-aeson
, quickcheck-arbitrary-adt
, text
, uri-bytestring
, versions
type: exitcode-stdio-1.0
build-depends: ghcup
hs-source-dirs: test
main-is: MyLibTest.hs
build-depends: base >=4.12.0.0
main-is: Main.hs
other-modules:
GHCup.ArbitraryTypes
GHCup.Types.JSONSpec
Spec

10767
golden/GHCupInfo.json Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -2,3 +2,5 @@ cradle:
cabal:
- path: "."
component: "ghcup:lib:ghcup"
- path: "."
component: "ghcup:exe:ghcup"

View File

@@ -75,9 +75,12 @@ import Prelude hiding ( abs
import Safe hiding ( at )
import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment )
import System.Posix.FilePath ( getSearchPath )
import System.Posix.FilePath ( getSearchPath, takeExtension )
import System.Posix.Files.ByteString
import Text.Regex.Posix
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
@@ -119,7 +122,7 @@ installGHCBindist :: ( MonadFail m
]
m
()
installGHCBindist dlinfo ver (PlatformRequest {..}) = do
installGHCBindist dlinfo ver pfreq = do
let tver = (mkTVer ver)
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
whenM (lift $ ghcInstalled tver)
@@ -128,42 +131,79 @@ installGHCBindist dlinfo ver (PlatformRequest {..}) = do
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
-- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
liftE $ runBuildAction tmpUnpack (Just ghcdir) (installGHC' workdir ghcdir)
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver pfreq
liftE $ postGHCInstall tver
where
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
installGHC' :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> Path Abs -- ^ Path to install to
-> Excepts '[ProcessError] m ()
installGHC' path inst = do
lift $ $(logInfo) "Installing GHC (this may take a while)"
lEM $ execLogged "./configure"
False
(["--prefix=" <> toFilePath inst] ++ alpineArgs)
[rel|ghc-configure|]
(Just path)
Nothing
lEM $ make ["install"] (Just path)
pure ()
-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
-- build system and nothing else.
installPackedGHC :: ( MonadMask m
, MonadCatch m
, MonadReader Settings m
, MonadThrow m
, MonadLogger m
, MonadIO m
)
=> Path Abs -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive
-> Path Abs -- ^ Path to install to
-> Version -- ^ The GHC version
-> PlatformRequest
-> Excepts
'[ BuildFailed
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
] m ()
installPackedGHC dl msubdir inst ver pfreq@(PlatformRequest {..}) = do
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
(msubdir)
liftE $ runBuildAction tmpUnpack
(Just inst)
(installUnpackedGHC workdir inst ver pfreq)
-- | Install an unpacked GHC distribution. This only deals with the GHC
-- build system and nothing else.
installUnpackedGHC :: ( MonadReader Settings m
, MonadThrow m
, MonadLogger m
, MonadIO m
)
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> Path Abs -- ^ Path to install to
-> Version -- ^ The GHC version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
installUnpackedGHC path inst ver (PlatformRequest {..}) = do
lift $ $(logInfo) "Installing GHC (this may take a while)"
lEM $ execLogged "./configure"
False
(["--prefix=" <> toFilePath inst] ++ alpineArgs)
[rel|ghc-configure|]
(Just path)
Nothing
lEM $ make ["install"] (Just path)
pure ()
where
alpineArgs
| ver >= [vver|8.2.2|]
, Linux Alpine <- _rPlatform = ["--disable-ld-override"]
| otherwise = []
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
= ["--disable-ld-override"]
| otherwise
= []
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
@@ -273,12 +313,14 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do
installCabal' path inst = do
lift $ $(logInfo) "Installing cabal"
let cabalFile = [rel|cabal|]
liftIO $ createDirRecursive newDirPerms inst
liftIO $ createDirRecursive' inst
destFileName <- lift $ parseRel (toFilePath cabalFile <> "-" <> verToBS ver)
let destPath = inst </> destFileName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile)
(inst </> destFileName)
(destPath)
Overwrite
lift $ chmod_777 destPath
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
@@ -315,6 +357,130 @@ installCabalBin bDls ver pfreq = do
installCabalBindist dlinfo ver pfreq
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installHLSBindist :: ( MonadMask m
, MonadCatch m
, MonadReader Settings m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installHLSBindist dlinfo ver (PlatformRequest {..}) = do
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
Settings {dirs = Dirs {..}} <- lift ask
whenM (lift (hlsInstalled ver))
$ (throwE $ AlreadyInstalled HLS ver)
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
liftE $ installHLS' workdir binDir
-- create symlink if this is the latest version
hlsVers <- lift $ fmap rights $ getInstalledHLSs
let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
pure ()
where
-- | Install an unpacked hls distribution.
installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked hls bindist (where the executable resides)
-> Path Abs -- ^ Path to install to
-> Excepts '[CopyError] m ()
installHLS' path inst = do
lift $ $(logInfo) "Installing HLS"
liftIO $ createDirRecursive' inst
-- install haskell-language-server-<ghcver>
bins@(_:_) <- liftIO $ findFiles
path
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
)
forM_ bins $ \f -> do
toF <- parseRel (toFilePath f <> "~" <> verToBS ver)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> f)
(inst </> toF)
Overwrite
lift $ chmod_777 (inst </> toF)
-- install haskell-language-server-wrapper
let wrapper = [rel|haskell-language-server-wrapper|]
toF <- parseRel (toFilePath wrapper <> "-" <> verToBS ver)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> wrapper)
(inst </> toF)
Overwrite
lift $ chmod_777 (inst </> toF)
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m
, MonadCatch m
, MonadReader Settings m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installHLSBin bDls ver pfreq = do
dlinfo <- lE $ getDownloadInfo HLS ver pfreq bDls
installHLSBindist dlinfo ver pfreq
---------------------
@@ -350,7 +516,7 @@ setGHC ver sghc = do
-- symlink destination
Settings { dirs = Dirs {..} } <- lift ask
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms binDir
liftIO $ createDirRecursive' binDir
-- first delete the old symlinks (this fixes compatibility issues
-- with old ghcup)
@@ -422,7 +588,7 @@ setCabal ver = do
-- symlink destination
Settings {dirs = Dirs {..}} <- lift ask
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms binDir
liftIO $ createDirRecursive' binDir
whenM (liftIO $ fmap not $ doesFileExist (binDir </> targetFile))
$ throwE
@@ -445,6 +611,55 @@ setCabal ver = do
-- | Set the haskell-language-server symlinks.
setHLS :: ( MonadCatch m
, MonadReader Settings m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
)
=> Version
-> Excepts '[NotInstalled] m ()
setHLS ver = do
Settings { dirs = Dirs {..} } <- lift ask
liftIO $ createDirRecursive' binDir
-- Delete old symlinks, since these might have different ghc versions than the
-- selected version, so we could end up with stray or incorrect symlinks.
oldSyms <- lift hlsSymlinks
forM_ oldSyms $ \f -> do
lift $ $(logDebug) [i|rm #{toFilePath (binDir </> f)}|]
liftIO $ deleteFile (binDir </> f)
-- set haskell-language-server-<ghcver> symlinks
bins <- lift $ hlsServerBinaries ver
when (bins == []) $ throwE $ NotInstalled HLS (prettyVer ver)
forM_ bins $ \f -> do
let destL = toFilePath f
target <- parseRel . head . B.split _tilde . toFilePath $ f
lift $ $(logDebug) [i|rm -f #{toFilePath (binDir </> target)}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir </> target)
lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath (binDir </> target)}|]
liftIO $ createSymlink (binDir </> target) destL
-- set haskell-language-server-wrapper symlink
let destL = "haskell-language-server-wrapper-" <> verToBS ver
let wrapper = binDir </> [rel|haskell-language-server-wrapper|]
lift $ $(logDebug) [i|rm -f #{toFilePath wrapper}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile wrapper
lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath wrapper}|]
liftIO $ createSymlink wrapper destL
pure ()
------------------
@@ -469,6 +684,7 @@ data ListResult = ListResult
, fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
, hlsPowered :: Bool
}
deriving (Eq, Ord, Show)
@@ -502,19 +718,25 @@ listVersions av lt criteria pfreq = do
lr <- filter' <$> forM (Map.toList avTools) (toListResult t)
case t of
-- append stray GHCs
GHC -> do
slr <- strayGHCs avTools
pure $ (sort (slr ++ lr))
_ -> pure lr
Cabal -> do
slr <- strayCabals avTools
pure $ (sort (slr ++ lr))
HLS -> do
slr <- strayHLS avTools
pure $ (sort (slr ++ lr))
GHCup -> pure lr
Nothing -> do
ghcvers <- listVersions av (Just GHC) criteria pfreq
cabalvers <- listVersions av (Just Cabal) criteria pfreq
hlsvers <- listVersions av (Just HLS) criteria pfreq
ghcupvers <- listVersions av (Just GHCup) criteria pfreq
pure (ghcvers <> cabalvers <> ghcupvers)
pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers)
where
strayGHCs :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
strayGHCs :: (MonadCatch m, MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayGHCs avTools = do
@@ -526,6 +748,7 @@ listVersions av lt criteria pfreq = do
Nothing -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) $ hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
@@ -539,6 +762,7 @@ listVersions av lt criteria pfreq = do
Right tver@GHCTargetVersion{ .. } -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) $ hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
@@ -554,6 +778,62 @@ listVersions av lt criteria pfreq = do
[i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing
strayCabals :: (MonadReader Settings m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayCabals avTools = do
cabals <- getInstalledCabals
fmap catMaybes $ forM cabals $ \case
Right ver ->
case Map.lookup ver avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (== ver)) $ cabalSet
pure $ Just $ ListResult
{ lTool = Cabal
, lVer = ver
, lCross = Nothing
, lTag = []
, lInstalled = True
, lStray = maybe True (const False) (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, ..
}
Left e -> do
$(logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing
strayHLS :: (MonadReader Settings m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayHLS avTools = do
hlss <- getInstalledHLSs
fmap catMaybes $ forM hlss $ \case
Right ver ->
case Map.lookup ver avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (== ver)) $ hlsSet
pure $ Just $ ListResult
{ lTool = HLS
, lVer = ver
, lCross = Nothing
, lTag = []
, lInstalled = True
, lStray = maybe True (const False) (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, ..
}
Left e -> do
$(logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing
-- NOTE: this are not cross ones, because no bindists
toListResult :: (MonadReader Settings m, MonadIO m, MonadCatch m) => Tool -> (Version, [Tag]) -> m ListResult
toListResult t (v, tags) = case t of
@@ -563,6 +843,7 @@ listVersions av lt criteria pfreq = do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem v) $ hlsGHCVersions
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
Cabal -> do
let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq av
@@ -574,6 +855,7 @@ listVersions av lt criteria pfreq = do
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, ..
}
GHCup -> do
@@ -586,6 +868,20 @@ listVersions av lt criteria pfreq = do
, fromSrc = False
, lStray = False
, lNoBindist = False
, hlsPowered = False
, ..
}
HLS -> do
let lNoBindist = isLeft $ getDownloadInfo HLS v pfreq av
lSet <- fmap (maybe False (== v)) $ hlsSet
lInstalled <- hlsInstalled v
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, ..
}
@@ -677,6 +973,35 @@ rmCabalVer ver = do
(binDir </> [rel|cabal|])
-- | Delete a hls version. Will try to fix the hls symlinks
-- after removal (e.g. setting it to an older version).
rmHLSVer :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
=> Version
-> Excepts '[NotInstalled] m ()
rmHLSVer ver = do
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (prettyVer ver))
isHlsSet <- lift $ hlsSet
Settings {dirs = Dirs {..}} <- lift ask
bins <- lift $ hlsAllBinaries ver
forM_ bins $ \f -> liftIO $ deleteFile (binDir </> f)
when (maybe False (== ver) isHlsSet) $ do
-- delete all set symlinks
oldSyms <- lift hlsSymlinks
forM_ oldSyms $ \f -> do
lift $ $(logDebug) [i|rm #{toFilePath (binDir </> f)}|]
liftIO $ deleteFile (binDir </> f)
-- set latest hls
hlsVers <- lift $ fmap rights $ getInstalledHLSs
case headMay . reverse . sort $ hlsVers of
Just latestver -> setHLS latestver
Nothing -> pure ()
------------------
--[ Debug info ]--
@@ -735,51 +1060,74 @@ compileGHC :: ( MonadMask m
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs PlatformRequest {..} = do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
whenM (lift $ ghcInstalled tver)
(throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformRequest {..})
= do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
-- download source tarball
dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
alreadyInstalled <- lift $ ghcInstalled tver
alreadySet <- fmap (maybe False (==tver)) $ lift $ ghcSet (_tvTarget tver)
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- download source tarball
dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
bghc <- case bstrap of
Right g -> pure $ Right g
Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver)
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlInfo)
ghcdir <- lift $ ghcupGHCDir tver
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
liftE $ runBuildAction
tmpUnpack
(Just ghcdir)
(compile bghc ghcdir workdir >> markSrcBuilt ghcdir workdir)
bghc <- case bstrap of
Right g -> pure $ Right g
Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver)
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
ghcdir <- lift $ ghcupGHCDir tver
reThrowAll GHCupSetError $ postGHCInstall tver
pure ()
(bindist, bmk) <- liftE $ runBuildAction
tmpUnpack
Nothing
(do
b <- compileBindist bghc ghcdir workdir
bmk <- liftIO $ readFileStrict (build_mk workdir)
pure (b, bmk)
)
when alreadyInstalled $ do
lift $ $(logInfo) [i|Deleting existing installation|]
liftE $ rmGHCVer tver
liftE $ installPackedGHC bindist
(view dlSubdir dlInfo)
ghcdir
(tver ^. tvVersion)
pfreq
liftIO $ writeFile (ghcdir </> ghcUpSrcBuiltFile) (Just newFilePerms) bmk
reThrowAll GHCupSetError $ postGHCInstall tver
-- restore
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
pure ()
where
defaultConf = case _tvTarget tver of
Nothing -> [s|
Nothing -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES|]
Just _ -> [s|
Just _ -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
@@ -787,23 +1135,26 @@ BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO
Stage1Only = YES|]
compile :: (MonadReader Settings m, MonadThrow m, MonadCatch m, MonadLogger m, MonadIO m)
=> Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
'[ FileDoesNotExistError
, InvalidBuildConfig
, PatchFailed
, ProcessError
, NotFoundInPATH
]
m
()
compile bghc ghcdir workdir = do
compileBindist :: ( MonadReader Settings m
, MonadThrow m
, MonadCatch m
, MonadLogger m
, MonadIO m
, MonadFail m
)
=> Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs) -- ^ output path of bindist
compileBindist bghc ghcdir workdir = do
lift $ $(logInfo) [i|configuring build|]
liftE $ checkBuildConfig
Settings { dirs = Dirs {..} } <- lift ask
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
cEnv <- liftIO $ getEnvironment
@@ -854,29 +1205,49 @@ Stage1Only = YES|]
liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
lift $ $(logInfo) [i|Building (this may take a while)...|]
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
(Just workdir)
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
lift $ $(logInfo) [i|Installing...|]
lEM $ make ["install"] (Just workdir)
markSrcBuilt ghcdir workdir = do
let dest = (ghcdir </> ghcUpSrcBuiltFile)
liftIO $ copyFile (build_mk workdir) dest Overwrite
lift $ $(logInfo) [i|Creating bindist...|]
lEM $ make ["binary-dist"] (Just workdir)
[tar] <- liftIO $ findFiles
workdir
(makeRegexOpts compExtended
execBlank
([s|^ghc-.*\.tar\..*$|] :: ByteString)
)
c <- liftIO $ readFile (workdir </> tar)
cDigest <-
fmap (T.take 8)
. lift
. throwEither
. E.decodeUtf8'
. B16.encode
. SHA256.hashlazy
$ c
tarName <-
parseRel
[i|ghc-#{prettyTVer tver}-#{prettyPfReq pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
let tarPath = cacheDir </> tarName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
tarPath
Strict
lift $ $(logInfo) [i|Copied bindist to #{tarPath}|]
pure tarPath
build_mk workdir = workdir </> [rel|mk/build.mk|]
checkBuildConfig :: (MonadCatch m, MonadIO m)
=> Excepts
'[FileDoesNotExistError , InvalidBuildConfig]
'[FileDoesNotExistError, InvalidBuildConfig]
m
()
checkBuildConfig = do
c <- case mbuildConfig of
Just bc -> do
BL.toStrict <$> liftIOException doesNotExistErrorType
(FileDoesNotExistError $ toFilePath bc)
(liftIO $ readFile bc)
BL.toStrict <$> liftIOException
doesNotExistErrorType
(FileDoesNotExistError $ toFilePath bc)
(liftIO $ readFile bc)
Nothing -> pure defaultConf
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
@@ -992,7 +1363,7 @@ compileCabal dls tver bghc jobs patchdir PlatformRequest{..} = do
]
tmp <- lift withGHCupTmpDir
liftIO $ createDirRecursive newDirPerms (tmp </> [rel|bin|])
liftIO $ createDirRecursive' (tmp </> [rel|bin|])
newEnv <- lift $ addToCurrentEnv (("PREFIX", toFilePath tmp) : ghcEnv)
lift $ $(logDebug) [i|Environment: #{newEnv}|]
@@ -1045,17 +1416,12 @@ upgradeGHCup dls mtarget force pfreq = do
tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|]
p <- liftE $ download dli tmp (Just fn)
let fileMode' =
newFilePerms
`unionFileModes` ownerExecuteMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherExecuteMode
let fullDest = fromMaybe (binDir </> fn) mtarget
liftIO $ hideError NoSuchThing $ deleteFile fullDest
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
fullDest
Overwrite
liftIO $ setFileMode (toFilePath fullDest) fileMode'
lift $ chmod_777 fullDest
pure latestVer

View File

@@ -226,7 +226,7 @@ getDownloads urlSource = do
else -- access in less than 5 minutes, re-use file
liftIO $ readFile json_file
else do
liftIO $ createDirRecursive newDirPerms cacheDir
liftIO $ createDirRecursive' cacheDir
getModTime >>= \case
Just modTime -> dlWithMod modTime json_file
Nothing -> do
@@ -330,7 +330,7 @@ download dli dest mfn
scheme = view (dlUri % uriSchemeL' % schemeBSL') dli
cp = do
-- destination dir must exist
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
liftIO $ createDirRecursive' dest
destFile <- getDestFile
fromFile <- parseAbs path
liftIO $ copyFile fromFile destFile Strict
@@ -340,7 +340,7 @@ download dli dest mfn
lift $ $(logInfo) [i|downloading: #{uri'}|]
-- destination dir must exist
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
liftIO $ createDirRecursive' dest
destFile <- getDestFile
-- download

View File

@@ -152,3 +152,10 @@ data ParseError = ParseError String
deriving Show
instance Exception ParseError
data UnexpectedListLength = UnexpectedListLength String
deriving Show
instance Exception UnexpectedListLength

View File

@@ -48,7 +48,7 @@ prettyRequirements :: Requirements -> T.Text
prettyRequirements Requirements {..} =
let d = if not . null $ _distroPKGs
then
"\n Install the following distro packages: "
"\n Please install the following distro packages: "
<> T.intercalate " " _distroPKGs
else ""
n = if not . T.null $ _notes then "\n Note: " <> _notes else ""

View File

@@ -19,6 +19,7 @@ import Data.Versions
import HPath
import URI.ByteString
import qualified Data.Text as T
import qualified GHC.Generics as GHC
@@ -75,6 +76,7 @@ type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
data Tool = GHC
| Cabal
| GHCup
| HLS
deriving (Eq, GHC.Generic, Ord, Show)
@@ -86,7 +88,7 @@ data VersionInfo = VersionInfo
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
}
deriving (Eq, Show)
deriving (Eq, GHC.Generic, Show)
-- | A tag. These are currently attached to a version of a tool.
@@ -95,7 +97,7 @@ data Tag = Latest
| Prerelease
| Base PVP
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, Show) -- FIXME: manual JSON instance
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
data Architecture = A_64
@@ -108,6 +110,15 @@ data Architecture = A_64
| A_ARM64
deriving (Eq, GHC.Generic, Ord, Show)
prettyArch :: Architecture -> String
prettyArch A_64 = "x86_64"
prettyArch A_32 = "i386"
prettyArch A_PowerPC = "powerpc"
prettyArch A_PowerPC64 = "powerpc64"
prettyArch A_Sparc = "sparc"
prettyArch A_Sparc64 = "sparc64"
prettyArch A_ARM = "arm"
prettyArch A_ARM64 = "aarch64"
data Platform = Linux LinuxDistro
-- ^ must exit
@@ -116,6 +127,11 @@ data Platform = Linux LinuxDistro
| FreeBSD
deriving (Eq, GHC.Generic, Ord, Show)
prettyPlatfrom :: Platform -> String
prettyPlatfrom (Linux distro) = "linux-" ++ prettyDistro distro
prettyPlatfrom Darwin = "darwin"
prettyPlatfrom FreeBSD = "freebsd"
data LinuxDistro = Debian
| Ubuntu
| Mint
@@ -132,6 +148,19 @@ data LinuxDistro = Debian
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show)
prettyDistro :: LinuxDistro -> String
prettyDistro Debian = "debian"
prettyDistro Ubuntu = "ubuntu"
prettyDistro Mint= "mint"
prettyDistro Fedora = "fedora"
prettyDistro CentOS = "centos"
prettyDistro RedHat = "redhat"
prettyDistro Alpine = "alpine"
prettyDistro AmazonLinux = "amazon"
prettyDistro Gentoo = "gentoo"
prettyDistro Exherbo = "exherbo"
prettyDistro UnknownLinux = "unknown"
-- | An encapsulation of a download. This can be used
-- to download, extract and install a tool.
@@ -140,7 +169,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir
, _dlHash :: Text
}
deriving (Eq, Show)
deriving (Eq, GHC.Generic, Show)
@@ -153,14 +182,14 @@ data DownloadInfo = DownloadInfo
-- | How to descend into a tar archive.
data TarDir = RealDir (Path Rel)
| RegexDir String -- ^ will be compiled to regex, the first match will "win"
deriving (Eq, Show)
deriving (Eq, GHC.Generic, Show)
-- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL
| OwnSource URI
| OwnSpec GHCupInfo
deriving Show
deriving (GHC.Generic, Show)
data Settings = Settings
@@ -219,6 +248,12 @@ data PlatformResult = PlatformResult
}
deriving (Eq, Show)
prettyPlatform :: PlatformResult -> String
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> show v'
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat
data PlatformRequest = PlatformRequest
{ _rArch :: Architecture
, _rPlatform :: Platform
@@ -226,6 +261,13 @@ data PlatformRequest = PlatformRequest
}
deriving (Eq, Show)
prettyPfReq :: PlatformRequest -> String
prettyPfReq (PlatformRequest arch plat ver) =
prettyArch arch ++ "-" ++ prettyPlatfrom plat ++ pver
where
pver = case ver of
Just v' -> "-" ++ (T.unpack $ prettyV v')
Nothing -> ""
-- | A GHC identified by the target platform triple
-- and the version.

View File

@@ -36,7 +36,7 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
#if !defined(TAR)
import Codec.Archive
import Codec.Archive hiding ( Directory )
#endif
import Control.Applicative
import Control.Exception.Safe
@@ -301,6 +301,150 @@ cabalSet = do
-- | Get all installed hls, by matching on
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
getInstalledHLSs :: (MonadReader Settings m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version]
getInstalledHLSs = do
Settings { dirs = Dirs {..} } <- ask
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
)
vs <- forM bins $ \f ->
case
fmap
version
(fmap decUTF8Safe . B.stripPrefix "haskell-language-server-wrapper-" . toFilePath $ f)
of
Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f
pure $ vs
-- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader Settings m, MonadCatch m) => Version -> m Bool
hlsInstalled ver = do
vers <- fmap rights $ getInstalledHLSs
pure $ elem ver $ vers
-- Return the currently set hls version, if any.
hlsSet :: (MonadReader Settings m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do
Settings {dirs = Dirs {..}} <- ask
let hlsBin = binDir </> [rel|haskell-language-server-wrapper|]
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
broken <- isBrokenSymlink hlsBin
if broken
then pure Nothing
else do
link <- readSymbolicLink $ toFilePath hlsBin
Just <$> linkVersion link
where
linkVersion :: MonadThrow m => ByteString -> m Version
linkVersion bs = do
t <- throwEither $ E.decodeUtf8' bs
throwEither $ MP.parse parser "" t
where
parser =
MP.chunk "haskell-language-server-wrapper-" *> version'
-- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader Settings m
, MonadIO m
, MonadThrow m
, MonadCatch m
)
=> m [Version]
hlsGHCVersions = do
h <- hlsSet
vers <- forM h $ \h' -> do
bins <- hlsServerBinaries h'
pure $ fmap
(\bin ->
version
. decUTF8Safe
. fromJust
. B.stripPrefix "haskell-language-server-"
. head
. B.split _tilde
. toFilePath
$ bin
)
bins
pure . rights . concat . maybeToList $ vers
-- | Get all server binaries for an hls version, if any.
hlsServerBinaries :: (MonadReader Settings m, MonadIO m)
=> Version
-> m [Path Rel]
hlsServerBinaries ver = do
Settings { dirs = Dirs {..} } <- ask
liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
compExtended
execBlank
([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> [s|$|] :: ByteString
)
)
-- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader Settings m, MonadThrow m, MonadIO m)
=> Version
-> m (Maybe (Path Rel))
hlsWrapperBinary ver = do
Settings { dirs = Dirs {..} } <- ask
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
compExtended
execBlank
([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> [s|$|] :: ByteString
)
)
case wrapper of
[] -> pure $ Nothing
[x] -> pure $ Just x
_ -> throwM $ UnexpectedListLength
"There were multiple hls wrapper binaries for a single version"
-- | Get all binaries for an hls version, if any.
hlsAllBinaries :: (MonadReader Settings m, MonadIO m, MonadThrow m) => Version -> m [Path Rel]
hlsAllBinaries ver = do
hls <- hlsServerBinaries ver
wrapper <- hlsWrapperBinary ver
pure (maybeToList wrapper ++ hls)
-- | Get the active symlinks for hls.
hlsSymlinks :: (MonadReader Settings m, MonadIO m, MonadCatch m) => m [Path Rel]
hlsSymlinks = do
Settings { dirs = Dirs {..} } <- ask
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-.*$|] :: ByteString)
)
filterM
( fmap (== SymbolicLink)
. liftIO
. getFileType
. (binDir </>)
)
oldSyms
-----------------------------------------
@@ -596,8 +740,8 @@ getChangeLog dls tool (Right tag) =
-- 1. the build directory, depending on the KeepDirs setting
-- 2. the install destination, depending on whether the build failed
runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m)
=> Path Abs -- ^ build directory
-> Maybe (Path Abs) -- ^ install location (e.g. for GHC)
=> Path Abs -- ^ build directory (cleaned up depending on Settings)
-> Maybe (Path Abs) -- ^ dir to *always* clean up on exception
-> Excepts e m a
-> Excepts '[BuildFailed] m a
runBuildAction bdir instdir action = do
@@ -621,3 +765,25 @@ runBuildAction bdir instdir action = do
when (keepDirs == Never || keepDirs == Errors) $ liftIO $ deleteDirRecursive
bdir
pure v
-- | More permissive version of 'createDirRecursive'. This doesn't
-- error when the destination is a symlink to a directory.
createDirRecursive' :: Path b -> IO ()
createDirRecursive' p =
handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e)
. createDirRecursive newDirPerms
$ p
where
isSymlinkDir e = do
ft <- getFileType p
case ft of
SymbolicLink -> do
rp <- canonicalizePath p
rft <- getFileType rp
case rft of
Directory -> pure ()
_ -> throwIO e
_ -> throwIO e

View File

@@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-|
Module : GHCup.Utils.File
@@ -25,6 +26,7 @@ import Control.Concurrent.Async
import Control.Exception ( evaluate )
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.State.Strict
import Data.ByteString ( ByteString )
@@ -33,6 +35,7 @@ import Data.Functor
import Data.IORef
import Data.Maybe
import Data.Sequence ( Seq, (|>) )
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Void
import Data.Word8
@@ -46,6 +49,7 @@ import System.IO.Error
import System.Posix.Directory.ByteString
import System.Posix.FD as FD
import System.Posix.FilePath hiding ( (</>) )
import System.Posix.Files.ByteString
import System.Posix.Foreign ( oExcl )
import "unix" System.Posix.IO.ByteString
hiding ( openFd )
@@ -375,7 +379,7 @@ toProcessError :: ByteString
-> Maybe ProcessStatus
-> Either ProcessError ()
toProcessError exe args mps = case mps of
Just (SPPB.Exited (ExitFailure i)) -> Left $ NonZeroExit i exe args
Just (SPPB.Exited (ExitFailure xi)) -> Left $ NonZeroExit xi exe args
Just (SPPB.Exited ExitSuccess ) -> Right ()
Just (Terminated _ _ ) -> Left $ PTerminated exe args
Just (Stopped _ ) -> Left $ PStopped exe args
@@ -434,3 +438,15 @@ isBrokenSymlink p =
$ do
_ <- canonicalizePath p
pure False
chmod_777 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_777 (toFilePath -> fp) = do
let exe_mode =
newFilePerms
`unionFileModes` ownerExecuteMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherExecuteMode
$(logDebug) [i|chmod 777 #{fp}|]
liftIO $ setFileMode fp exe_mode

View File

@@ -15,6 +15,7 @@ Here we define our main logger.
module GHCup.Utils.Logger where
import GHCup.Types
import GHCup.Utils
import Control.Monad
import Control.Monad.IO.Class
@@ -69,7 +70,7 @@ initGHCupFileLogging context = do
Settings {dirs = Dirs {..}} <- ask
let logfile = logsDir </> context
liftIO $ do
createDirRecursive newDirPerms logsDir
createDirRecursive' logsDir
hideError doesNotExistErrorType $ deleteFile logfile
createRegularFile newFilePerms logfile
pure logfile

View File

@@ -31,11 +31,13 @@ import Data.ByteString ( ByteString )
import Data.String
import Data.Text ( Text )
import Data.Versions
import Data.Word8
import Haskus.Utils.Types.List
import Haskus.Utils.Variant.Excepts
import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S
import qualified Data.Text as T
@@ -275,3 +277,13 @@ decUTF8Safe = E.decodeUtf8With E.lenientDecode
decUTF8Safe' :: L.ByteString -> Text
decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode
-- | Escape a version for use in regex
escapeVerRex :: Version -> ByteString
escapeVerRex = B.pack . go . B.unpack . verToBS
where
go [] = []
go (x : xs) | x == _period = [_backslash, _period] ++ go xs
| otherwise = x : go xs

View File

@@ -26,7 +26,7 @@ ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.yaml|]
-- | The current ghcup version.
ghcUpVer :: PVP
ghcUpVer = [pver|0.1.9|]
ghcUpVer = [pver|0.1.11|]
-- | ghcup version as numeric string.
numericVer :: String

View File

@@ -0,0 +1,193 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module GHCup.ArbitraryTypes where
import GHCup.Types
import Data.ByteString ( ByteString )
import Data.Versions
import Data.List.NonEmpty
import HPath
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
import Test.QuickCheck.Arbitrary.Generic
import URI.ByteString
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Lazy as T
( toStrict )
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B
-----------------
--[ utilities ]--
-----------------
intToText :: Integral a => a -> T.Text
intToText = T.toStrict . B.toLazyText . B.decimal
genVer :: Gen (Int, Int, Int)
genVer =
(\x y z -> (getPositive x, getPositive y, getPositive z))
<$> arbitrary
<*> arbitrary
<*> arbitrary
instance ToADTArbitrary GHCupInfo
----------------------
--[ base arbitrary ]--
----------------------
instance Arbitrary T.Text where
arbitrary = fmap T.pack $ listOf $ elements ['a' .. 'z']
shrink xs = T.pack <$> shrink (T.unpack xs)
instance Arbitrary (NonEmpty Word) where
arbitrary = fmap fromList $ listOf1 $ arbitrary
-- utf8 encoded bytestring
instance Arbitrary ByteString where
arbitrary = fmap (E.encodeUtf8 . T.pack) $ listOf $ elements ['a' .. 'z']
---------------------
--[ uri arbitrary ]--
---------------------
instance Arbitrary Scheme where
arbitrary = oneof [ Scheme <$> pure "http", Scheme <$> pure "https" ]
instance Arbitrary Host where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Port where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (URIRef Absolute) where
arbitrary =
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> (Query <$> pure []) <*> pure Nothing
-------------------------
--[ version arbitrary ]--
-------------------------
instance Arbitrary Mess where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ mess
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary Version where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ version
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary SemVer where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ semver
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary PVP where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ pvp
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary Versioning where
arbitrary = Ideal <$> arbitrary
-----------------------
--[ ghcup arbitrary ]--
-----------------------
instance Arbitrary Requirements where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary DownloadInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary LinuxDistro where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Platform where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Tag where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Architecture where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (Path Rel) where
arbitrary =
(either (error . show) id . parseRel . E.encodeUtf8 . T.pack)
<$> (listOf1 $ elements ['a' .. 'z'])
instance Arbitrary TarDir where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Tool where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary GHCupInfo where
arbitrary = genericArbitrary
shrink = genericShrink
-- our maps are nested... the default size easily blows up most ppls ram
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Tool v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Version) v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Platform v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Versioning) v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary

View File

@@ -0,0 +1,17 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
module GHCup.Types.JSONSpec where
import GHCup.ArbitraryTypes ()
import GHCup.Types
import GHCup.Types.JSON ()
import Test.Aeson.GenericSpecs
import Test.Hspec
spec :: Spec
spec = do
roundtripAndGoldenSpecs (Proxy @GHCupInfo)

12
test/Main.hs Normal file
View File

@@ -0,0 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
import Test.Hspec.Runner
import Test.Hspec.Formatters
import qualified Spec
main :: IO ()
main =
hspecWith
defaultConfig { configFormatter = Just progress }
$ Spec.spec

View File

@@ -1,4 +0,0 @@
module Main (main) where
main :: IO ()
main = putStrLn "Test suite not yet implemented."

2
test/Spec.hs Normal file
View File

@@ -0,0 +1,2 @@
-- file test/Spec.hs
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}