Compare commits

..

12 Commits

Author SHA1 Message Date
1455c2c175 Add darwin notarisation 2020-04-10 19:27:17 +02:00
c106dd3f65 Show curl progress bar 2020-04-10 19:08:02 +02:00
f6725fbf5f Add ghcup-0.0.1.json 2020-04-10 18:45:34 +02:00
c706a047ea Add tool-requirements subcommand 2020-04-10 18:45:33 +02:00
9602db31ab Bump version to 0.1.0 2020-04-09 20:37:03 +02:00
c2c47e1b7e Enable split-sections 2020-04-09 20:35:42 +02:00
34386680cc Remove stack.yaml 2020-04-09 20:08:29 +02:00
16a26d9881 Update Dockerfile 2020-04-09 20:08:29 +02:00
3496f24f6e Silence compiler warnings 2020-04-09 20:08:25 +02:00
1a5876a074 Update freeze file 2020-04-09 18:28:35 +02:00
c782bc44de Avoid unnecessary OpenSSL deps 2020-04-09 18:27:07 +02:00
f78e7b1cbc Small refactor and build fixes 2020-04-09 18:26:02 +02:00
23 changed files with 2510 additions and 375 deletions

View File

@@ -22,9 +22,6 @@ RUN apk add --no-cache \
## Package specific
RUN apk add --no-cache \
libbz2 \
bzip2-dev \
bzip2-static \
zlib \
zlib-dev \
zlib-static \
@@ -35,7 +32,7 @@ RUN apk add --no-cache \
xz \
xz-dev
RUN cabal v2-update
COPY . /app

View File

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

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -8,13 +9,16 @@
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
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) )
#endif
import Options.Applicative hiding ( style )
import System.Console.Pretty
import System.Exit
@@ -132,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
@@ -156,7 +160,7 @@ main = do
where
valAndExit f contents = do
av <- case eitherDecode contents of
(GHCupInfo _ av) <- case eitherDecode contents of
Right r -> pure r
Left e -> die (color Red $ show e)
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)

View File

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

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -12,12 +13,17 @@ 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
import GHCup.Utils.Prelude
import GHCup.Version
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
@@ -75,6 +81,7 @@ data Command
| Compile CompileCommand
| Upgrade UpgradeOpts
| NumericVersion
| ToolRequirements
data ToolVersion = ToolVersion Version
| ToolTag Tag
@@ -214,6 +221,11 @@ 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
)
@@ -576,11 +588,14 @@ main = do
@'[ AlreadyInstalled
, BuildFailed
, DigestError
, DistroNotFound
, DownloadFailed
, GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
, DownloadFailed
]
let runCompileCabal =
@@ -588,12 +603,15 @@ main = do
. flip runReaderT settings
. runResourceT
. runE
@'[ UnknownArchive
, NoDownload
@'[ BuildFailed
, DigestError
, BuildFailed
, PatchFailed
, DistroNotFound
, DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
]
let runUpgrade =
@@ -611,7 +629,7 @@ main = do
, DownloadFailed
]
dls <-
(GHCupInfo treq dls) <-
( runLogger
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed]
@@ -775,6 +793,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 ()

View File

@@ -1,19 +1,19 @@
packages: ./ghcup.cabal
with-compiler: ghc-8.8.3
optimization: 2
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 -split-sections
package tar-bytestring
ghc-options: -O2
package *
ghc-options: -split-sections
constraints: http-io-streams -brotli
allow-newer: base

View File

@@ -1,238 +0,0 @@
constraints: any.Cabal ==3.0.1.0,
any.HsOpenSSL ==0.11.4.18,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -old-locale,
any.IfElse ==0.85,
any.QuickCheck ==2.14,
QuickCheck +templatehaskell,
any.StateVar ==1.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==1.4.7.1,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only,
any.alex ==3.2.5,
alex +small_base,
any.ansi-terminal ==0.10.3,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.ascii-string ==1.0.1.4,
any.assoc ==1.0.1,
any.async ==2.2.2,
async -bench,
any.atomic-primops ==0.8.3,
atomic-primops -debug,
any.attoparsec ==0.13.2.4,
attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.13.0.0,
any.base-compat ==0.11.1,
any.base-compat-batteries ==0.11.1,
any.base-orphans ==0.8.2,
any.base-prelude ==1.3,
any.base16-bytestring ==0.1.1.6,
any.base64-bytestring ==1.0.0.3,
any.bifunctors ==5.5.7,
bifunctors +semigroups +tagged,
any.binary ==0.8.7.0,
any.blaze-builder ==0.4.1.0,
any.bytestring ==0.10.10.0,
any.bytestring-builder ==0.10.8.2.0,
bytestring-builder +bytestring_has_builder,
any.bz2 ==1.0.0.2,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.6,
c2hs +base3 -regression,
any.cabal-doctest ==1.0.8,
any.case-insensitive ==1.2.1.0,
any.cereal ==0.5.8.1,
cereal -bytestring-builder,
any.clock ==0.8,
clock -llvm,
any.cmdargs ==0.10.20,
cmdargs +quotation -testprog,
any.colour ==2.3.5,
any.comonad ==5.0.6,
comonad +containers +distributive +test-doctests,
any.concurrent-output ==1.10.11,
any.conduit ==1.3.2,
any.conduit-extra ==1.3.5,
any.containers ==0.6.2.1,
any.contravariant ==1.5.2,
contravariant +semigroups +statevar +tagged,
any.data-default-class ==0.1.2.0,
any.data-default-instances-base ==0.1.0.1,
any.deepseq ==1.4.4.0,
any.deferred-folds ==0.9.10.1,
any.directory ==1.3.6.0,
any.distributive ==0.6.1,
distributive +semigroups +tagged,
any.dlist ==0.8.0.8,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4,
exceptions +transformers-0-4,
any.extra ==1.7.1,
any.fast-logger ==3.0.1,
any.filepath ==1.4.2.1,
any.focus ==1.0.1.3,
any.foldl ==1.4.6,
any.free ==5.1.3,
any.fusion-plugin-types ==0.1.0,
any.generics-sop ==0.5.1.0,
any.ghc-boot-th ==8.8.3,
any.ghc-prim ==0.5.3,
any.happy ==1.19.12,
happy +small_base,
any.hashable ==1.3.0.0,
hashable -examples +integer-gmp +sse2 -sse41,
any.haskell-src-exts ==1.23.0,
any.haskell-src-meta ==0.8.5,
any.haskus-utils-data ==1.2,
any.haskus-utils-types ==1.5,
any.haskus-utils-variant ==3.0,
any.heaps ==0.3.6.1,
any.hopenssl ==2.2.4,
hopenssl -link-libz,
any.hpath ==0.11.0,
any.hpath-directory ==0.13.2,
any.hpath-filepath ==0.10.4,
any.hpath-io ==0.13.1,
any.hpath-posix ==0.13.1,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.http-io-streams ==0.1.2.0,
http-io-streams -brotli,
any.indexed-profunctors ==0.1,
any.integer-gmp ==1.0.2.0,
any.integer-logarithms ==1.0.3,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.1.0,
io-streams -nointeractivetests,
any.language-bash ==0.9.0,
any.language-c ==0.8.3,
language-c -allwarnings +iecfpextension +separatesyb +usebytestrings,
any.lifted-base ==0.2.3.12,
any.list-t ==1.0.4,
any.lockfree-queue ==0.2.3.1,
any.lzma ==0.0.0.3,
any.math-functions ==0.3.3.0,
math-functions +system-erf +system-expm1,
any.megaparsec ==8.0.0,
megaparsec -dev,
any.mmorph ==1.1.3,
any.monad-control ==1.0.2.3,
any.monad-logger ==0.3.32,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2,
any.mwc-random ==0.14.0.0,
any.network ==3.1.1.1,
any.network-uri ==2.6.3.0,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.openssl-streams ==1.2.2.0,
any.optics ==0.2,
any.optics-core ==0.2,
any.optics-extra ==0.2,
any.optics-th ==0.2,
any.optics-vl ==0.2,
any.optparse-applicative ==0.15.1.0,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.2.1,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.prettyprinter ==1.6.1,
prettyprinter -buildreadme,
any.primitive ==0.7.0.1,
any.primitive-extras ==0.8,
any.primitive-unlifted ==0.1.3.0,
any.process ==1.6.8.0,
any.profunctors ==5.5.2,
any.random ==1.1,
any.recursion-schemes ==5.1.3,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.0,
any.regex-posix ==0.96.0.0,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.3,
any.rts ==1.0,
any.safe ==0.3.18,
any.safe-exceptions ==0.1.7.0,
any.scientific ==0.3.6.2,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.4,
semigroupoids +comonad +containers +contravariant +distributive +doctests +tagged +unordered-containers,
any.semigroups ==0.19.1,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
any.sop-core ==0.5.0.1,
any.split ==0.2.3.4,
any.splitmix ==0.0.4,
splitmix -optimised-mixer +random,
any.stm ==2.5.0.0,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.1.2,
streaming-commons -use-bytestring-builder,
any.streamly ==0.7.1,
streamly -debug -dev -examples -examples-sdl -fusion-plugin -has-llvm -inspection -no-charts -no-fusion -streamk,
any.streamly-bytestring ==0.1.2,
any.streamly-posix ==0.1.0.0,
any.strict-base ==0.4.0.0,
any.string-interpolate ==0.2.0.0,
any.syb ==0.7.1,
any.table-layout ==0.8.0.5,
any.tagged ==0.8.6,
tagged +deepseq +transformers,
any.tar-bytestring ==0.6.3.1,
any.template-haskell ==2.15.0.0,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.text ==1.2.4.0,
any.text-conversions ==0.3.0,
any.text-short ==0.1.3,
text-short -asserts,
any.th-abstraction ==0.3.2.0,
any.th-expand-syns ==0.4.6.0,
any.th-lift ==0.8.1,
any.th-lift-instances ==0.1.14,
any.th-orphans ==0.13.9,
any.th-reify-many ==0.1.9,
any.these ==1.0.1,
these +aeson +assoc +quickcheck +semigroupoids,
any.time ==1.9.3,
any.time-compat ==1.9.3,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances,
any.transformers-compat ==0.6.5,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.2,
unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.10.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.2.2,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.1.1,
any.uuid-types ==1.0.3,
any.vector ==0.12.1.2,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.3,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-builder ==0.3.8,
any.vector-th-unbox ==0.2.1.7,
any.versions ==3.5.3,
any.word8 ==0.1.3,
any.zlib ==0.6.2.1,
zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5

2136
ghcup-0.0.1.json Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
version: 0.1.0.0
version: 0.1.0
synopsis: ghc toolchain installer as an exe/library
description:
A rewrite of the shell script ghcup, for providing
@@ -47,6 +47,9 @@ common attoparsec
common base
build-depends: base >=4.12 && <5
common base16-bytestring
build-depends: base16-bytestring >= 0.1.1.6
common binary
build-depends: binary >=0.8.6.0
@@ -65,6 +68,9 @@ common concurrent-output
common containers
build-depends: containers >=0.6
common cryptohash-sha256
build-depends: cryptohash-sha256 >= 0.11.101.0
common generics-sop
build-depends: generics-sop >=0.5
@@ -74,9 +80,6 @@ common haskus-utils-types
common haskus-utils-variant
build-depends: haskus-utils-variant >=3.0
common hopenssl
build-depends: hopenssl >=2.2.4
common hpath
build-depends: hpath >=0.11
@@ -223,7 +226,7 @@ library
import:
config
, base
, HsOpenSSL
, base16-bytestring
, aeson
, ascii-string
, async
@@ -234,10 +237,10 @@ library
, case-insensitive
, concurrent-output
, containers
, cryptohash-sha256
, generics-sop
, haskus-utils-types
, haskus-utils-variant
, hopenssl
, hpath
, hpath-directory
, hpath-filepath
@@ -274,14 +277,13 @@ library
, word8
, zlib
-- deps
-- cabal-fmt: expand lib
exposed-modules:
GHCup
GHCup.Download
GHCup.Download.Utils
GHCup.Errors
GHCup.Platform
GHCup.Requirements
GHCup.Types
GHCup.Types.JSON
GHCup.Types.Optics
@@ -301,6 +303,7 @@ library
if !flag(curl)
import:
, HsOpenSSL
, http-io-streams
, io-streams
, terminal-progress-bar
@@ -366,8 +369,11 @@ executable ghcup-gen
--
main-is: Main.hs
other-modules: GHCupDownloads
Validate
other-modules:
GHCupDownloads
GHCupInfo
ToolRequirements
Validate
-- other-extensions:
build-depends: ghcup

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -28,6 +29,9 @@ import GHCup.Version
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
@@ -92,14 +96,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
@@ -166,14 +172,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
@@ -440,8 +448,11 @@ compileGHC :: ( MonadMask m
'[ AlreadyInstalled
, BuildFailed
, DigestError
, DistroNotFound
, DownloadFailed
, GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
@@ -460,6 +471,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
@@ -575,7 +588,10 @@ compileCabal :: ( MonadReader Settings m
-> Excepts
'[ BuildFailed
, DigestError
, DistroNotFound
, DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
@@ -592,6 +608,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
@@ -670,7 +688,8 @@ 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
pfreq <- liftE platformRequest
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|]
p <- liftE $ download dli tmp (Just fn)

View File

@@ -16,38 +16,41 @@ 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
import GHCup.Utils
#if defined(CURL)
import GHCup.Utils.File
#endif
import GHCup.Utils.Prelude
import GHCup.Version
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Aeson
#if !defined(CURL)
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
#endif
import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
import Data.Time.Clock.POSIX
#if !defined(CURL)
import Data.Time.Format
#endif
import Data.Versions
import GHC.IO.Exception
import HPath
import HPath.IO as HIO
import Haskus.Utils.Variant.Excepts
import OpenSSL.Digest
import Optics
import Prelude hiding ( abs
, readFile
@@ -56,10 +59,14 @@ import Prelude hiding ( abs
import System.IO.Error
import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L
#if !defined(CURL)
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as M
import qualified Data.Text as T
#endif
import qualified Data.Text.Encoding as E
import qualified System.Posix.Files.ByteString as PF
import qualified System.Posix.RawFilePath.Directory
@@ -86,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
@@ -178,7 +185,6 @@ getDownloads urlSource = do
$ getHead uri'
)
pure $ parseModifiedHeader headers
#endif
parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
parseModifiedHeader headers =
@@ -188,6 +194,8 @@ getDownloads urlSource = do
"%a, %d %b %Y %H:%M:%S %Z"
(T.unpack . E.decodeUtf8 $ h)
#endif
writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO ()
writeFileWithModTime utctime path content = do
let mod_time = utcTimeToPOSIXSeconds utctime
@@ -195,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)
@@ -295,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
@@ -378,8 +356,8 @@ downloadBS uri'
where
scheme = view (uriSchemeL' % schemeBSL') uri'
path = view pathL' uri'
dl https = do
#if defined(CURL)
dl _ = do
let exe = [rel|curl|]
args = ["-sSfL", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
@@ -387,6 +365,7 @@ downloadBS uri'
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
#else
dl https = do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
liftE $ downloadBS' https host' fullPath' port'
#endif
@@ -402,7 +381,7 @@ checkDigest dli file = do
let p' = toFilePath file
lift $ $(logInfo) [i|verifying digest of: #{p'}|]
c <- liftIO $ readFile file
let cDigest = E.decodeUtf8 . toHex . digest (digestByName "sha256") $ c
let cDigest = E.decodeUtf8 . B16.encode . SHA256.hashlazy $ c
eDigest = view dlHash dli
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)

View File

@@ -13,6 +13,7 @@ module GHCup.Download.IOStreams where
import GHCup.Download.Utils
import GHCup.Errors
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.File
import GHCup.Utils.Prelude

View File

@@ -92,6 +92,9 @@ data TooManyRedirs = TooManyRedirs
data PatchFailed = PatchFailed
deriving Show
-- | The tool requirements could not be found.
data NoToolRequirements = NoToolRequirements
deriving Show
-------------------------

View File

@@ -46,6 +46,21 @@ import qualified Data.Text.Encoding as E
--------------------------
-- | Get the full platform request, consisting of architecture, distro, ...
platformRequest :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Excepts
'[ NoCompatiblePlatform
, NoCompatibleArch
, DistroNotFound
]
m
PlatformRequest
platformRequest = do
(PlatformResult rp rv) <- liftE getPlatform
ar <- lE getArchitecture
pure $ PlatformRequest ar rp rv
getArchitecture :: Either NoCompatibleArch Architecture
getArchitecture = case arch of
"x86_64" -> Right A_64

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

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

View File

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

View File

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

View File

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

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -22,6 +23,9 @@ import GHCup.Utils.Prelude
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Attoparsec.ByteString
@@ -293,7 +297,7 @@ urlBaseName :: MonadThrow m
urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
-- Get tool files from ~/.ghcup/bin/ghc/<ver>/bin/*
-- Get tool files from '~/.ghcup/bin/ghc/<ver>/bin/*'
-- while ignoring *-<ver> symlinks.
--
-- Returns unversioned relative files, e.g.:
@@ -354,3 +358,13 @@ applyPatches pdir ddir = do
Nothing
)
!? PatchFailed
darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Darwin path = exec
"xattr"
True
["-r", "-d", "com.apple.quarantine", toFilePath path]
Nothing
Nothing
darwinNotarization _ _ = pure $ Right ()

View File

@@ -59,6 +59,7 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
-- | Bool signals whether the regions should be cleaned.
data StopThread = StopThread Bool
deriving Show
@@ -190,7 +191,10 @@ execLogged exe spath args lfile chdir env = do
when b (forM_ rs closeConsoleRegion)
EX.throw (StopThread b)
)
$ readForever (lineAction ref rs) fdIn
$ do
hideError eofErrorType $ readTilEOF (lineAction ref rs) fdIn
-- wait for explicit stop from the parent to signal what cleanup to run
forever (threadDelay 5000)
where
-- action to perform line by line
@@ -220,26 +224,16 @@ execLogged exe spath args lfile chdir env = do
-- read an entire line from the file descriptor (removes the newline char)
readLine fd' = do
bs <-
handle
(\(e :: IOError) -> do
if isEOFError e then threadDelay 1000 >> pure "" else throw e
)
$ SPIB.fdRead fd' 1
bs <- SPIB.fdRead fd' 1
if
| bs == "\n" -> pure ""
| bs == "" -> pure ""
| otherwise -> fmap (bs <>) $ readLine fd'
readForever action' fd' = do
bs <- readLine fd'
if not $ BS.null bs
then action' bs >> readForever action' fd'
else readForever action' fd'
readTilEOF action' fd' = do
bs <- readLine fd'
when (not $ BS.null bs) (action' bs >> readTilEOF action' fd')
void $ action' bs
readTilEOF action' fd'
-- | Capture the stdout and stderr of the given action, which
@@ -274,7 +268,7 @@ captureOutStreams action = do
refOut <- newIORef BS.empty
refErr <- newIORef BS.empty
done <- newEmptyMVar
_ <-
_ <-
forkIO
$ EX.handle (\(_ :: StopThread) -> pure ())
$ EX.handle (\(_ :: IOException) -> pure ())
@@ -301,21 +295,22 @@ captureOutStreams action = do
doneOut <- newEmptyMVar
void
$ forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ hideError eofErrorType
$ flip finally (putMVar doneOut ())
$ readTilEOF (\x -> modifyIORef' rout (<> x)) pout
doneErr <- newEmptyMVar
void
$ forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ hideError eofErrorType
$ flip finally (putMVar doneErr ())
$ readTilEOF (\x -> modifyIORef' rerr (<> x)) perr
takeMVar doneOut
takeMVar doneErr
readTilEOF action' fd' = do
readTilEOF ~action' fd' = do
bs <- SPIB.fdRead fd' 512
when (not $ BS.null bs) (action' bs >> readTilEOF action' fd')
void $ action' bs
readTilEOF action' fd'
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b

View File

@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -11,6 +12,9 @@ module GHCup.Utils.Version.QQ where
import Data.Data
import Data.Text ( Text )
import Data.Versions
#if !MIN_VERSION_base(4,13,0)
import GHC.Base
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( Lift
@@ -36,6 +40,11 @@ deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
instance Lift Text
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter
qq quoteExp' = QuasiQuoter
{ quoteExp = (\s -> quoteExp' . T.pack $ s)

View File

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

View File

@@ -1,39 +0,0 @@
resolver: lts-14.27
packages:
- .
extra-deps:
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2
- ascii-string-1.0.1.3
- brotli-0.0.0.0@sha256:448061ceabdcaa752bbaf208f255bbb7e90bbcf8ea8a913d26ffa7887636823b
- brotli-streams-0.0.0.0@sha256:c75a1d5d33420cbc9399c315e9b50a1976a5370f4fa8a40c71e11d011c2fedd6
- case-insensitive-1.2.1.0
- data-default-instances-base-0.1.0.1@sha256:985a13d7103e45a65f06f277b735ef025636014f0d29dd6de998bc7628e09be9
- fusion-plugin-types-0.1.0@sha256:0f11bbc445ab8ae3dbbb3d5d2ea198bdb1ac020518b7f4f7579035dc89182438
- generics-sop-0.5.0.0
- haskus-utils-data-1.2@sha256:48f62aa23d84b94edd0338379d3b3d74a34d3c2dbabf8c448a774a89ca70ea5d
- haskus-utils-types-1.5
- haskus-utils-variant-3.0
- hpath-0.11.0
- hpath-directory-0.13.2
- hpath-filepath-0.10.4
- hpath-io-0.13.1
- hpath-posix-0.13.1
- http-io-streams-0.1.2.0
- indexed-profunctors-0.1@sha256:ddf618d0d4c58319c1e735e746bc69a1021f13b6f475dc9614b80af03432e6d4
- language-bash-0.9.0
- optics-0.2
- optics-core-0.2@sha256:cfdf39871553769b59fcc54863a3521d262ea25d8d05d0f41ab87296c560cfa6
- optics-extra-0.2@sha256:211ce1dfd1b3ffd95c1158d8c8beb53cbd17c4d477169e226b1831607f6789eb
- optics-th-0.2@sha256:b4f6c5a3f134c697837190ed6da969dd284aefe79e43c3ef793093b607bb83b9
- optics-vl-0.2
- optparse-applicative-0.15.1.0
- pretty-terminal-0.1.0.0
- sop-core-0.5.0.0@sha256:8734ab38b8c84837094eec657da0b58942e481e20166131f34cf6c7fe9787b07
- streamly-0.7.1
- streamly-bytestring-0.1.2
- streamly-posix-0.1.0.0
- strict-base-0.4.0.0
- string-interpolate-0.2.0.0
- table-layout-0.8.0.5
- tar-bytestring-0.6.3.0
- time-1.9.3