Compare commits
1 Commits
0.1.0-pre
...
experiment
| Author | SHA1 | Date | |
|---|---|---|---|
| 1810bb27a8 |
45
Dockerfile
45
Dockerfile
@@ -1,45 +0,0 @@
|
|||||||
FROM alpine:edge
|
|
||||||
|
|
||||||
# ghc and cabal
|
|
||||||
RUN apk add --no-cache \
|
|
||||||
curl \
|
|
||||||
gcc \
|
|
||||||
g++ \
|
|
||||||
gmp-dev \
|
|
||||||
ncurses-dev \
|
|
||||||
libffi-dev \
|
|
||||||
make \
|
|
||||||
xz \
|
|
||||||
tar \
|
|
||||||
perl \
|
|
||||||
\
|
|
||||||
cabal \
|
|
||||||
ghc
|
|
||||||
|
|
||||||
# utils
|
|
||||||
RUN apk add --no-cache \
|
|
||||||
bash
|
|
||||||
|
|
||||||
## Package specific
|
|
||||||
RUN apk add --no-cache \
|
|
||||||
libbz2 \
|
|
||||||
bzip2-dev \
|
|
||||||
bzip2-static \
|
|
||||||
zlib \
|
|
||||||
zlib-dev \
|
|
||||||
zlib-static \
|
|
||||||
gmp \
|
|
||||||
gmp-dev \
|
|
||||||
openssl-dev \
|
|
||||||
openssl-libs-static \
|
|
||||||
xz \
|
|
||||||
xz-dev
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
COPY . /app
|
|
||||||
|
|
||||||
WORKDIR /app
|
|
||||||
|
|
||||||
RUN chmod +x /app/docker/build.sh
|
|
||||||
|
|
||||||
43
TODO.md
43
TODO.md
@@ -1,43 +0,0 @@
|
|||||||
# TODOs and Remarks
|
|
||||||
|
|
||||||
## Now
|
|
||||||
|
|
||||||
* travis
|
|
||||||
|
|
||||||
* requirements
|
|
||||||
* for ghcup (bootstrap script)
|
|
||||||
* per tool
|
|
||||||
* mac build: xattr -cr .
|
|
||||||
* static binaries
|
|
||||||
* upgrade plan from old ghcup
|
|
||||||
|
|
||||||
* bootstrap-haskell with new ghcup
|
|
||||||
* add warning to ghcup script about new binary
|
|
||||||
|
|
||||||
* make sure smart-dl is not broken
|
|
||||||
|
|
||||||
* handle SIGINT better (remove dirs)
|
|
||||||
|
|
||||||
* review symlink handling (maybe fixed set of tools?)
|
|
||||||
|
|
||||||
## Maybe
|
|
||||||
|
|
||||||
* maybe: changelog Show the changelog of a GHC release (online)
|
|
||||||
* sign the JSON? (Or check gpg keys?)
|
|
||||||
* testing (especially distro detection -> unit tests)
|
|
||||||
|
|
||||||
## Later
|
|
||||||
|
|
||||||
* add support for RC/alpha/HEAD versions
|
|
||||||
|
|
||||||
## Cleanups
|
|
||||||
|
|
||||||
* avoid alternative for IO
|
|
||||||
* use plucky or oops instead of Excepts
|
|
||||||
|
|
||||||
## Questions
|
|
||||||
|
|
||||||
* fully static musl builds for linux?
|
|
||||||
* mirror support
|
|
||||||
* interactive handling when distro doesn't exist and we know the tarball is incompatible?
|
|
||||||
* ghcup-with wrapper to execute a command with a given ghc in PATH?
|
|
||||||
@@ -832,64 +832,6 @@ ghc_883_32_musl = DownloadInfo
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
|
||||||
--[ GHC 8.10.1 ]--
|
|
||||||
-----------------
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_32_deb9 :: DownloadInfo
|
|
||||||
ghc_8101_32_deb9 = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-i386-deb9-linux.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"8b53eef2c827b5f634d72920a93c0c9dd66ea288691a2bfe28def45d3c686ee2"
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_64_deb9 :: DownloadInfo
|
|
||||||
ghc_8101_64_deb9 = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-deb9-linux.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"d1cf7886f27af070f3b7dbe1975a78b43ef2d32b86362cbe953e79464fe70761"
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_64_deb10 :: DownloadInfo
|
|
||||||
ghc_8101_64_deb10 = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-deb10-linux.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"c1e31d798b013699b3c0de4fda27fb4cda47f572df0e75e3bd598a3012060615"
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_64_fedora :: DownloadInfo
|
|
||||||
ghc_8101_64_fedora = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-fedora27-linux.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"3c4cd72b4806045779739e8f5d1658e30e57123d88c2c8966422cdbcae448470"
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_64_centos :: DownloadInfo
|
|
||||||
ghc_8101_64_centos = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-centos7-linux.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"0618b94854edc6be5302489df905e627820b71be6b66c950f5e3088fe92df0a1"
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_64_darwin :: DownloadInfo
|
|
||||||
ghc_8101_64_darwin = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-apple-darwin.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"65b1ca361093de4804a7e40b3e68178e1ef720f84f743641ec8d95e56a45b3a8"
|
|
||||||
|
|
||||||
|
|
||||||
ghc_8101_64_alpine :: DownloadInfo
|
|
||||||
ghc_8101_64_alpine = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-alpine3.10-linux-integer-simple.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"cb13b645d103e2fba2eb8dfcc4e5f2fbd9550c00c4df42f342b4210436dcb8a8"
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
--[ Cabal-2.4.1.0 ]--
|
--[ Cabal-2.4.1.0 ]--
|
||||||
---------------------
|
---------------------
|
||||||
@@ -953,39 +895,13 @@ cabal_3000_64_darwin = DownloadInfo
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
|
||||||
--[ Cabal-3.2.0.0 ]--
|
|
||||||
---------------------
|
|
||||||
|
|
||||||
|
|
||||||
cabal_3200_32_linux :: DownloadInfo
|
|
||||||
cabal_3200_32_linux = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz|]
|
|
||||||
Nothing
|
|
||||||
"2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93"
|
|
||||||
|
|
||||||
cabal_3200_64_linux :: DownloadInfo
|
|
||||||
cabal_3200_64_linux = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-linux.tar.xz|]
|
|
||||||
Nothing
|
|
||||||
"32d1f7cf1065c37cb0ef99a66adb405f409b9763f14c0926f5424ae408c738ac"
|
|
||||||
|
|
||||||
cabal_3200_64_darwin :: DownloadInfo
|
|
||||||
cabal_3200_64_darwin = DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-apple-darwin17.7.0.tar.xz|]
|
|
||||||
Nothing
|
|
||||||
"9197c17d2ece0f934f5b33e323cfcaf486e4681952687bc3d249488ce3cbe0e9"
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
--[ GHCup ]--
|
--[ GHCup ]--
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
|
|
||||||
ghcup_001_64_linux :: DownloadInfo
|
ghcup_010_64_linux :: DownloadInfo
|
||||||
ghcup_001_64_linux = DownloadInfo
|
ghcup_010_64_linux = DownloadInfo
|
||||||
[uri|file:///home/maerwald/tmp/ghcup-exe|]
|
[uri|file:///home/maerwald/tmp/ghcup-exe|]
|
||||||
Nothing
|
Nothing
|
||||||
"558126339252788a3d44a3f910417277c7ab656f0796b68bdc58afe73296b8cd"
|
"558126339252788a3d44a3f910417277c7ab656f0796b68bdc58afe73296b8cd"
|
||||||
@@ -1504,7 +1420,7 @@ ghcupDownloads = M.fromList
|
|||||||
)
|
)
|
||||||
, ( [vver|8.6.5|]
|
, ( [vver|8.6.5|]
|
||||||
, VersionInfo
|
, VersionInfo
|
||||||
[]
|
[Recommended]
|
||||||
(Just $ DownloadInfo
|
(Just $ DownloadInfo
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|]
|
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|]
|
||||||
(Just [rel|ghc-8.6.5|])
|
(Just [rel|ghc-8.6.5|])
|
||||||
@@ -1654,7 +1570,7 @@ ghcupDownloads = M.fromList
|
|||||||
)
|
)
|
||||||
, ( [vver|8.8.3|]
|
, ( [vver|8.8.3|]
|
||||||
, VersionInfo
|
, VersionInfo
|
||||||
[Recommended]
|
[Latest]
|
||||||
(Just $ DownloadInfo
|
(Just $ DownloadInfo
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz|]
|
[uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz|]
|
||||||
(Just [rel|ghc-8.8.3|])
|
(Just [rel|ghc-8.8.3|])
|
||||||
@@ -1702,71 +1618,6 @@ ghcupDownloads = M.fromList
|
|||||||
)
|
)
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
, ( [vver|8.10.1|]
|
|
||||||
, VersionInfo
|
|
||||||
[Latest]
|
|
||||||
(Just $ DownloadInfo
|
|
||||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz|]
|
|
||||||
(Just [rel|ghc-8.10.1|])
|
|
||||||
"4e3b07f83a266b3198310f19f71e371ebce97c769b14f0d688f4cbf2a2a1edf5"
|
|
||||||
)
|
|
||||||
$ M.fromList
|
|
||||||
[ ( A_64
|
|
||||||
, M.fromList
|
|
||||||
[ ( Linux UnknownLinux
|
|
||||||
, M.fromList [(Nothing, ghc_8101_64_fedora)]
|
|
||||||
)
|
|
||||||
, ( Linux Fedora
|
|
||||||
, M.fromList
|
|
||||||
[ (Nothing , ghc_8101_64_fedora)
|
|
||||||
, (Just [vers|27|], ghc_8101_64_fedora)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, ( Linux CentOS
|
|
||||||
, M.fromList
|
|
||||||
[ (Nothing , ghc_8101_64_centos)
|
|
||||||
, (Just [vers|7|], ghc_8101_64_centos)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, ( Linux AmazonLinux
|
|
||||||
, M.fromList [(Nothing, ghc_8101_64_centos)]
|
|
||||||
)
|
|
||||||
, ( Linux Ubuntu
|
|
||||||
, M.fromList
|
|
||||||
[ (Nothing , ghc_8101_64_fedora)
|
|
||||||
, (Just [vers|16.04|], ghc_8101_64_deb9)
|
|
||||||
, (Just [vers|18.04|], ghc_8101_64_deb9)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, (Linux Mint, M.fromList [(Nothing, ghc_8101_64_deb10)])
|
|
||||||
, ( Linux Debian
|
|
||||||
, M.fromList
|
|
||||||
[ (Nothing , ghc_8101_64_deb9)
|
|
||||||
, (Just [vers|9|] , ghc_8101_64_deb9)
|
|
||||||
, (Just [vers|10|], ghc_8101_64_deb10)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, (Darwin , M.fromList [(Nothing, ghc_8101_64_darwin)])
|
|
||||||
, (Linux Alpine, M.fromList [(Nothing, ghc_8101_64_alpine)])
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, ( A_32
|
|
||||||
, M.fromList
|
|
||||||
[ ( Linux UnknownLinux
|
|
||||||
, M.fromList [(Nothing, ghc_8101_32_deb9)]
|
|
||||||
)
|
|
||||||
, (Linux Ubuntu, M.fromList [(Nothing, ghc_8101_32_deb9)])
|
|
||||||
, (Linux Mint , M.fromList [(Nothing, ghc_8101_32_deb9)])
|
|
||||||
, ( Linux Debian
|
|
||||||
, M.fromList
|
|
||||||
[ (Nothing , ghc_8101_32_deb9)
|
|
||||||
, (Just [vers|9|], ghc_8101_32_deb9)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
, ( Cabal
|
, ( Cabal
|
||||||
@@ -1801,7 +1652,7 @@ ghcupDownloads = M.fromList
|
|||||||
)
|
)
|
||||||
, ( [vver|3.0.0.0|]
|
, ( [vver|3.0.0.0|]
|
||||||
, VersionInfo
|
, VersionInfo
|
||||||
[]
|
[Recommended, Latest]
|
||||||
(Just $ DownloadInfo
|
(Just $ DownloadInfo
|
||||||
[uri|https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz|]
|
[uri|https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz|]
|
||||||
(Just [rel|cabal-cabal-install-v3.0.0.0/cabal-install|])
|
(Just [rel|cabal-cabal-install-v3.0.0.0/cabal-install|])
|
||||||
@@ -1825,41 +1676,15 @@ ghcupDownloads = M.fromList
|
|||||||
)
|
)
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
, ( [vver|3.2.0.0|]
|
|
||||||
, VersionInfo
|
|
||||||
[Recommended, Latest]
|
|
||||||
(Just $ DownloadInfo
|
|
||||||
[uri|https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz|]
|
|
||||||
(Just [rel|cabal-cabal-install-v3.2.0.0/cabal-install|])
|
|
||||||
"77202358bdf0b481c09326268ce18880df14194c5aaa840f99510bdd1a124b75"
|
|
||||||
)
|
|
||||||
$ M.fromList
|
|
||||||
[ ( A_64
|
|
||||||
, M.fromList
|
|
||||||
[ ( Linux UnknownLinux
|
|
||||||
, M.fromList [(Nothing, cabal_3200_64_linux)]
|
|
||||||
)
|
|
||||||
, (Darwin, M.fromList [(Nothing, cabal_3200_64_darwin)])
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, ( A_32
|
|
||||||
, M.fromList
|
|
||||||
[ ( Linux UnknownLinux
|
|
||||||
, M.fromList [(Nothing, cabal_3200_32_linux)]
|
|
||||||
)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
, ( GHCup
|
, ( GHCup
|
||||||
, M.fromList
|
, M.fromList
|
||||||
[ ( [vver|0.0.1|]
|
[ ( [vver|0.0.0|]
|
||||||
, VersionInfo [Recommended, Latest] Nothing $ M.fromList
|
, VersionInfo [Recommended, Latest] Nothing $ M.fromList
|
||||||
[ ( A_64
|
[ ( A_64
|
||||||
, M.fromList
|
, M.fromList
|
||||||
[(Linux UnknownLinux, M.fromList [(Nothing, ghcup_001_64_linux)])]
|
[(Linux UnknownLinux, M.fromList [(Nothing, ghcup_010_64_linux)])]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -18,6 +18,7 @@ import GHCup.Utils.Logger
|
|||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
|
|
||||||
|
import Control.Monad.Fail ( MonadFail )
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
@@ -26,6 +27,7 @@ import Data.Char
|
|||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.List ( intercalate )
|
import Data.List ( intercalate )
|
||||||
|
import Data.Semigroup ( (<>) )
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
@@ -108,10 +110,9 @@ data CompileCommand = CompileGHC CompileOptions
|
|||||||
|
|
||||||
data CompileOptions = CompileOptions
|
data CompileOptions = CompileOptions
|
||||||
{ targetVer :: Version
|
{ targetVer :: Version
|
||||||
, bootstrapGhc :: Either Version (Path Abs)
|
, bootstrapVer :: Version
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, buildConfig :: Maybe (Path Abs)
|
, buildConfig :: Maybe (Path Abs)
|
||||||
, patchDir :: Maybe (Path Abs)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
data UpgradeOpts = UpgradeInplace
|
data UpgradeOpts = UpgradeInplace
|
||||||
@@ -311,16 +312,12 @@ compileOpts =
|
|||||||
)
|
)
|
||||||
<*> (option
|
<*> (option
|
||||||
(eitherReader
|
(eitherReader
|
||||||
(\x ->
|
(bimap (const "Not a valid version") id . version . T.pack)
|
||||||
(bimap (const "Not a valid version") Left . version . T.pack $ x)
|
|
||||||
<|> (bimap show Right . parseAbs . E.encodeUtf8 . T.pack $ x)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
( short 'b'
|
( short 'b'
|
||||||
<> long "bootstrap-ghc"
|
<> long "bootstrap-version"
|
||||||
<> metavar "BOOTSTRAP_GHC"
|
<> metavar "BOOTSTRAP_VERSION"
|
||||||
<> help
|
<> help "The GHC version to bootstrap with (must be installed)"
|
||||||
"The GHC version (or full path) to bootstrap with (must be installed)"
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -343,19 +340,6 @@ compileOpts =
|
|||||||
"Absolute path to build config file"
|
"Absolute path to build config file"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
|
||||||
(option
|
|
||||||
(eitherReader
|
|
||||||
(\x ->
|
|
||||||
bimap show id . parseAbs . E.encodeUtf8 . T.pack $ x :: Either
|
|
||||||
String
|
|
||||||
(Path Abs)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
|
||||||
"Absolute path to patch directory (applied in order, uses -p1)"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
versionParser :: Parser Version
|
versionParser :: Parser Version
|
||||||
@@ -578,7 +562,6 @@ main = do
|
|||||||
, DigestError
|
, DigestError
|
||||||
, GHCupSetError
|
, GHCupSetError
|
||||||
, NoDownload
|
, NoDownload
|
||||||
, PatchFailed
|
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
]
|
]
|
||||||
@@ -592,7 +575,6 @@ main = do
|
|||||||
, NoDownload
|
, NoDownload
|
||||||
, DigestError
|
, DigestError
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
, PatchFailed
|
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -714,7 +696,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
|
|||||||
void
|
void
|
||||||
$ (runCompileGHC $ do
|
$ (runCompileGHC $ do
|
||||||
liftE
|
liftE
|
||||||
$ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir
|
$ compileGHC dls targetVer bootstrapVer jobs buildConfig
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight _ ->
|
VRight _ ->
|
||||||
@@ -735,7 +717,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
|
|||||||
Compile (CompileCabal CompileOptions {..}) ->
|
Compile (CompileCabal CompileOptions {..}) ->
|
||||||
void
|
void
|
||||||
$ (runCompileCabal $ do
|
$ (runCompileCabal $ do
|
||||||
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir
|
liftE $ compileCabal dls targetVer bootstrapVer jobs
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight _ ->
|
VRight _ ->
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
packages: ./ghcup.cabal
|
packages: ./ghcup.cabal
|
||||||
|
|
||||||
with-compiler: ghc-8.8.3
|
with-compiler: ghc-8.6.5
|
||||||
|
|
||||||
optimization: 2
|
optimization: 2
|
||||||
|
|
||||||
@@ -15,5 +15,4 @@ package tar-bytestring
|
|||||||
|
|
||||||
constraints: http-io-streams -brotli
|
constraints: http-io-streams -brotli
|
||||||
|
|
||||||
allow-newer: base
|
index-state: 2020-03-09T18:53:34Z
|
||||||
|
|
||||||
|
|||||||
@@ -1,33 +1,34 @@
|
|||||||
constraints: any.Cabal ==3.0.1.0,
|
constraints: any.Cabal ==2.4.0.1,
|
||||||
any.HsOpenSSL ==0.11.4.18,
|
any.Glob ==0.10.0,
|
||||||
|
any.HsOpenSSL ==0.11.4.17,
|
||||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -old-locale,
|
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -old-locale,
|
||||||
any.IfElse ==0.85,
|
any.IfElse ==0.85,
|
||||||
any.QuickCheck ==2.14,
|
any.Only ==0.1,
|
||||||
|
any.QuickCheck ==2.13.2,
|
||||||
QuickCheck +templatehaskell,
|
QuickCheck +templatehaskell,
|
||||||
any.StateVar ==1.2,
|
any.StateVar ==1.2,
|
||||||
any.abstract-deque ==0.3,
|
any.abstract-deque ==0.3,
|
||||||
abstract-deque -usecas,
|
abstract-deque -usecas,
|
||||||
any.aeson ==1.4.7.1,
|
any.abstract-par ==0.3.3,
|
||||||
|
any.aeson ==1.4.6.0,
|
||||||
aeson -bytestring-builder -cffi -developer -fast,
|
aeson -bytestring-builder -cffi -developer -fast,
|
||||||
any.aeson-pretty ==0.8.8,
|
any.aeson-pretty ==0.8.8,
|
||||||
aeson-pretty -lib-only,
|
aeson-pretty -lib-only,
|
||||||
any.alex ==3.2.5,
|
|
||||||
alex +small_base,
|
|
||||||
any.ansi-terminal ==0.10.3,
|
any.ansi-terminal ==0.10.3,
|
||||||
ansi-terminal -example,
|
ansi-terminal -example,
|
||||||
any.ansi-wl-pprint ==0.6.9,
|
any.ansi-wl-pprint ==0.6.9,
|
||||||
ansi-wl-pprint -example,
|
ansi-wl-pprint -example,
|
||||||
any.array ==0.5.4.0,
|
any.array ==0.5.3.0,
|
||||||
any.ascii-string ==1.0.1.4,
|
any.ascii-string ==1.0.1.4,
|
||||||
any.assoc ==1.0.1,
|
any.assoc ==1.0.1,
|
||||||
any.async ==2.2.2,
|
any.async ==2.2.2,
|
||||||
async -bench,
|
async -bench,
|
||||||
any.atomic-primops ==0.8.3,
|
any.atomic-primops ==0.8.3,
|
||||||
atomic-primops -debug,
|
atomic-primops -debug,
|
||||||
any.attoparsec ==0.13.2.4,
|
any.attoparsec ==0.13.2.3,
|
||||||
attoparsec -developer,
|
attoparsec -developer,
|
||||||
any.auto-update ==0.1.6,
|
any.auto-update ==0.1.6,
|
||||||
any.base ==4.13.0.0,
|
any.base ==4.12.0.0,
|
||||||
any.base-compat ==0.11.1,
|
any.base-compat ==0.11.1,
|
||||||
any.base-compat-batteries ==0.11.1,
|
any.base-compat-batteries ==0.11.1,
|
||||||
any.base-orphans ==0.8.2,
|
any.base-orphans ==0.8.2,
|
||||||
@@ -36,53 +37,59 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
any.base64-bytestring ==1.0.0.3,
|
any.base64-bytestring ==1.0.0.3,
|
||||||
any.bifunctors ==5.5.7,
|
any.bifunctors ==5.5.7,
|
||||||
bifunctors +semigroups +tagged,
|
bifunctors +semigroups +tagged,
|
||||||
any.binary ==0.8.7.0,
|
any.binary ==0.8.6.0,
|
||||||
|
any.binary-orphans ==1.0.1,
|
||||||
any.blaze-builder ==0.4.1.0,
|
any.blaze-builder ==0.4.1.0,
|
||||||
any.bytestring ==0.10.10.0,
|
any.bytestring ==0.10.8.2,
|
||||||
any.bytestring-builder ==0.10.8.2.0,
|
any.bytestring-builder ==0.10.8.2.0,
|
||||||
bytestring-builder +bytestring_has_builder,
|
bytestring-builder +bytestring_has_builder,
|
||||||
any.bz2 ==1.0.0.2,
|
any.bytestring-handle ==0.1.0.6,
|
||||||
bz2 -cross +with-bzlib,
|
any.bzlib ==0.5.0.5,
|
||||||
any.c2hs ==0.28.6,
|
|
||||||
c2hs +base3 -regression,
|
|
||||||
any.cabal-doctest ==1.0.8,
|
any.cabal-doctest ==1.0.8,
|
||||||
any.case-insensitive ==1.2.1.0,
|
any.case-insensitive ==1.2.1.0,
|
||||||
|
any.cassava ==0.5.2.0,
|
||||||
|
cassava -bytestring--lt-0_10_4,
|
||||||
any.cereal ==0.5.8.1,
|
any.cereal ==0.5.8.1,
|
||||||
cereal -bytestring-builder,
|
cereal -bytestring-builder,
|
||||||
any.clock ==0.8,
|
any.clock ==0.8,
|
||||||
clock -llvm,
|
clock -llvm,
|
||||||
any.cmdargs ==0.10.20,
|
any.cmdargs ==0.10.20,
|
||||||
cmdargs +quotation -testprog,
|
cmdargs +quotation -testprog,
|
||||||
|
any.code-page ==0.2,
|
||||||
any.colour ==2.3.5,
|
any.colour ==2.3.5,
|
||||||
any.comonad ==5.0.6,
|
any.comonad ==5.0.6,
|
||||||
comonad +containers +distributive +test-doctests,
|
comonad +containers +distributive +test-doctests,
|
||||||
any.concurrent-output ==1.10.11,
|
any.conduit ==1.3.1.2,
|
||||||
any.conduit ==1.3.2,
|
any.conduit-extra ==1.3.4,
|
||||||
any.conduit-extra ==1.3.5,
|
any.containers ==0.6.0.1,
|
||||||
any.containers ==0.6.2.1,
|
|
||||||
any.contravariant ==1.5.2,
|
any.contravariant ==1.5.2,
|
||||||
contravariant +semigroups +statevar +tagged,
|
contravariant +semigroups +statevar +tagged,
|
||||||
|
any.criterion ==1.5.6.2,
|
||||||
|
criterion -embed-data-files -fast,
|
||||||
|
any.criterion-measurement ==0.1.2.0,
|
||||||
|
criterion-measurement -fast,
|
||||||
any.data-default-class ==0.1.2.0,
|
any.data-default-class ==0.1.2.0,
|
||||||
any.data-default-instances-base ==0.1.0.1,
|
any.data-default-instances-base ==0.1.0.1,
|
||||||
any.deepseq ==1.4.4.0,
|
any.deepseq ==1.4.4.0,
|
||||||
any.deferred-folds ==0.9.10.1,
|
any.deferred-folds ==0.9.10.1,
|
||||||
any.directory ==1.3.6.0,
|
any.dense-linear-algebra ==0.1.0.0,
|
||||||
|
any.directory ==1.3.3.0 || ==1.3.6.0,
|
||||||
any.distributive ==0.6.1,
|
any.distributive ==0.6.1,
|
||||||
distributive +semigroups +tagged,
|
distributive +semigroups +tagged,
|
||||||
any.dlist ==0.8.0.8,
|
any.dlist ==0.8.0.7,
|
||||||
any.easy-file ==0.2.2,
|
any.easy-file ==0.2.2,
|
||||||
any.errors ==2.3.0,
|
any.errors ==2.3.0,
|
||||||
any.exceptions ==0.10.4,
|
any.exceptions ==0.10.4,
|
||||||
exceptions +transformers-0-4,
|
exceptions +transformers-0-4,
|
||||||
any.extra ==1.7.1,
|
any.extra ==1.7,
|
||||||
any.fast-logger ==3.0.1,
|
any.fast-logger ==3.0.1,
|
||||||
any.filepath ==1.4.2.1,
|
any.filepath ==1.4.2.1,
|
||||||
any.focus ==1.0.1.3,
|
any.focus ==1.0.1.3,
|
||||||
any.foldl ==1.4.6,
|
any.foldl ==1.4.6,
|
||||||
any.free ==5.1.3,
|
any.free ==5.1.3,
|
||||||
any.fusion-plugin-types ==0.1.0,
|
any.fusion-plugin-types ==0.1.0,
|
||||||
any.generics-sop ==0.5.1.0,
|
any.generics-sop ==0.5.0.0,
|
||||||
any.ghc-boot-th ==8.8.3,
|
any.ghc-boot-th ==8.6.5,
|
||||||
any.ghc-prim ==0.5.3,
|
any.ghc-prim ==0.5.3,
|
||||||
any.happy ==1.19.12,
|
any.happy ==1.19.12,
|
||||||
happy +small_base,
|
happy +small_base,
|
||||||
@@ -101,7 +108,7 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
any.hpath-filepath ==0.10.4,
|
any.hpath-filepath ==0.10.4,
|
||||||
any.hpath-io ==0.13.1,
|
any.hpath-io ==0.13.1,
|
||||||
any.hpath-posix ==0.13.1,
|
any.hpath-posix ==0.13.1,
|
||||||
any.hsc2hs ==0.68.7,
|
any.hsc2hs ==0.68.6,
|
||||||
hsc2hs -in-ghc-tree,
|
hsc2hs -in-ghc-tree,
|
||||||
any.http-io-streams ==0.1.2.0,
|
any.http-io-streams ==0.1.2.0,
|
||||||
http-io-streams -brotli,
|
http-io-streams -brotli,
|
||||||
@@ -111,9 +118,9 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
integer-logarithms -check-bounds +integer-gmp,
|
integer-logarithms -check-bounds +integer-gmp,
|
||||||
any.io-streams ==1.5.1.0,
|
any.io-streams ==1.5.1.0,
|
||||||
io-streams -nointeractivetests,
|
io-streams -nointeractivetests,
|
||||||
|
any.js-flot ==0.8.3,
|
||||||
|
any.js-jquery ==3.3.1,
|
||||||
any.language-bash ==0.9.0,
|
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.lifted-base ==0.2.3.12,
|
||||||
any.list-t ==1.0.4,
|
any.list-t ==1.0.4,
|
||||||
any.lockfree-queue ==0.2.3.1,
|
any.lockfree-queue ==0.2.3.1,
|
||||||
@@ -122,12 +129,16 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
math-functions +system-erf +system-expm1,
|
math-functions +system-erf +system-expm1,
|
||||||
any.megaparsec ==8.0.0,
|
any.megaparsec ==8.0.0,
|
||||||
megaparsec -dev,
|
megaparsec -dev,
|
||||||
|
any.microstache ==1.0.1.1,
|
||||||
any.mmorph ==1.1.3,
|
any.mmorph ==1.1.3,
|
||||||
any.monad-control ==1.0.2.3,
|
any.monad-control ==1.0.2.3,
|
||||||
any.monad-logger ==0.3.32,
|
any.monad-logger ==0.3.32,
|
||||||
monad-logger +template_haskell,
|
monad-logger +template_haskell,
|
||||||
any.monad-loops ==0.4.3,
|
any.monad-loops ==0.4.3,
|
||||||
monad-loops +base4,
|
monad-loops +base4,
|
||||||
|
any.monad-par ==0.3.5,
|
||||||
|
monad-par -chaselev -newgeneric,
|
||||||
|
any.monad-par-extras ==0.3.3,
|
||||||
any.mono-traversable ==1.0.15.1,
|
any.mono-traversable ==1.0.15.1,
|
||||||
any.mtl ==2.2.2,
|
any.mtl ==2.2.2,
|
||||||
any.mwc-random ==0.14.0.0,
|
any.mwc-random ==0.14.0.0,
|
||||||
@@ -142,7 +153,8 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
any.optics-th ==0.2,
|
any.optics-th ==0.2,
|
||||||
any.optics-vl ==0.2,
|
any.optics-vl ==0.2,
|
||||||
any.optparse-applicative ==0.15.1.0,
|
any.optparse-applicative ==0.15.1.0,
|
||||||
any.parsec ==3.1.14.0,
|
any.parallel ==3.2.2.0,
|
||||||
|
any.parsec ==3.1.13.0,
|
||||||
any.parser-combinators ==1.2.1,
|
any.parser-combinators ==1.2.1,
|
||||||
parser-combinators -dev,
|
parser-combinators -dev,
|
||||||
any.pretty ==1.1.3.6,
|
any.pretty ==1.1.3.6,
|
||||||
@@ -152,7 +164,7 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
any.primitive ==0.7.0.1,
|
any.primitive ==0.7.0.1,
|
||||||
any.primitive-extras ==0.8,
|
any.primitive-extras ==0.8,
|
||||||
any.primitive-unlifted ==0.1.3.0,
|
any.primitive-unlifted ==0.1.3.0,
|
||||||
any.process ==1.6.8.0,
|
any.process ==1.6.5.0 || ==1.6.8.0,
|
||||||
any.profunctors ==5.5.2,
|
any.profunctors ==5.5.2,
|
||||||
any.random ==1.1,
|
any.random ==1.1,
|
||||||
any.recursion-schemes ==5.1.3,
|
any.recursion-schemes ==5.1.3,
|
||||||
@@ -170,10 +182,11 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
semigroupoids +comonad +containers +contravariant +distributive +doctests +tagged +unordered-containers,
|
semigroupoids +comonad +containers +contravariant +distributive +doctests +tagged +unordered-containers,
|
||||||
any.semigroups ==0.19.1,
|
any.semigroups ==0.19.1,
|
||||||
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
|
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
|
||||||
any.sop-core ==0.5.0.1,
|
any.sop-core ==0.5.0.0,
|
||||||
any.split ==0.2.3.4,
|
any.split ==0.2.3.4,
|
||||||
any.splitmix ==0.0.4,
|
any.splitmix ==0.0.4,
|
||||||
splitmix -optimised-mixer +random,
|
splitmix -optimised-mixer +random,
|
||||||
|
any.statistics ==0.15.2.0,
|
||||||
any.stm ==2.5.0.0,
|
any.stm ==2.5.0.0,
|
||||||
any.stm-chans ==3.0.0.4,
|
any.stm-chans ==3.0.0.4,
|
||||||
any.streaming-commons ==0.2.1.2,
|
any.streaming-commons ==0.2.1.2,
|
||||||
@@ -189,23 +202,26 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
any.tagged ==0.8.6,
|
any.tagged ==0.8.6,
|
||||||
tagged +deepseq +transformers,
|
tagged +deepseq +transformers,
|
||||||
any.tar-bytestring ==0.6.3.1,
|
any.tar-bytestring ==0.6.3.1,
|
||||||
any.template-haskell ==2.15.0.0,
|
any.tasty ==1.2.3,
|
||||||
|
tasty +clock,
|
||||||
|
any.tasty-quickcheck ==0.10.1.1,
|
||||||
|
any.template-haskell ==2.14.0.0,
|
||||||
any.terminal-progress-bar ==0.4.1,
|
any.terminal-progress-bar ==0.4.1,
|
||||||
any.terminal-size ==0.3.2.1,
|
any.terminal-size ==0.3.2.1,
|
||||||
any.text ==1.2.4.0,
|
any.text ==1.2.3.1,
|
||||||
any.text-conversions ==0.3.0,
|
any.text-conversions ==0.3.0,
|
||||||
any.text-short ==0.1.3,
|
any.text-short ==0.1.3,
|
||||||
text-short -asserts,
|
text-short -asserts,
|
||||||
any.th-abstraction ==0.3.2.0,
|
any.th-abstraction ==0.3.2.0,
|
||||||
any.th-expand-syns ==0.4.6.0,
|
any.th-expand-syns ==0.4.5.0,
|
||||||
any.th-lift ==0.8.1,
|
any.th-lift ==0.8.1,
|
||||||
any.th-lift-instances ==0.1.14,
|
any.th-lift-instances ==0.1.14,
|
||||||
any.th-orphans ==0.13.9,
|
any.th-orphans ==0.13.9,
|
||||||
any.th-reify-many ==0.1.9,
|
any.th-reify-many ==0.1.9,
|
||||||
any.these ==1.0.1,
|
any.these ==1.0.1,
|
||||||
these +aeson +assoc +quickcheck +semigroupoids,
|
these +aeson +assoc +quickcheck +semigroupoids,
|
||||||
any.time ==1.9.3,
|
any.time ==1.8.0.2 || ==1.9.3,
|
||||||
any.time-compat ==1.9.3,
|
any.time-compat ==1.9.2.2,
|
||||||
time-compat -old-locale,
|
time-compat -old-locale,
|
||||||
any.transformers ==0.5.6.2,
|
any.transformers ==0.5.6.2,
|
||||||
any.transformers-base ==0.4.5.2,
|
any.transformers-base ==0.4.5.2,
|
||||||
@@ -213,6 +229,7 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
any.transformers-compat ==0.6.5,
|
any.transformers-compat ==0.6.5,
|
||||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||||
any.typed-process ==0.2.6.0,
|
any.typed-process ==0.2.6.0,
|
||||||
|
any.unbounded-delays ==0.1.1.0,
|
||||||
any.unix ==2.7.2.2,
|
any.unix ==2.7.2.2,
|
||||||
any.unix-bytestring ==0.3.7.3,
|
any.unix-bytestring ==0.3.7.3,
|
||||||
any.unix-compat ==0.5.2,
|
any.unix-compat ==0.5.2,
|
||||||
@@ -229,9 +246,12 @@ constraints: any.Cabal ==3.0.1.0,
|
|||||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||||
any.vector-algorithms ==0.8.0.3,
|
any.vector-algorithms ==0.8.0.3,
|
||||||
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
||||||
|
any.vector-binary-instances ==0.2.5.1,
|
||||||
any.vector-builder ==0.3.8,
|
any.vector-builder ==0.3.8,
|
||||||
any.vector-th-unbox ==0.2.1.7,
|
any.vector-th-unbox ==0.2.1.7,
|
||||||
any.versions ==3.5.3,
|
any.versions ==3.5.3,
|
||||||
|
any.wcwidth ==0.0.2,
|
||||||
|
wcwidth -cli +split-base,
|
||||||
any.word8 ==0.1.3,
|
any.word8 ==0.1.3,
|
||||||
any.zlib ==0.6.2.1,
|
any.zlib ==0.6.2.1,
|
||||||
zlib -non-blocking-ffi -pkg-config,
|
zlib -non-blocking-ffi -pkg-config,
|
||||||
|
|||||||
@@ -1,14 +0,0 @@
|
|||||||
#!/bin/sh
|
|
||||||
|
|
||||||
set -ex
|
|
||||||
|
|
||||||
cd /app
|
|
||||||
|
|
||||||
cabal v2-update
|
|
||||||
|
|
||||||
cabal v2-install \
|
|
||||||
--install-method=copy \
|
|
||||||
--overwrite-policy=always \
|
|
||||||
--installdir="/bin" \
|
|
||||||
--ghc-options='-optl-static'
|
|
||||||
|
|
||||||
49
ghcup.cabal
49
ghcup.cabal
@@ -21,13 +21,8 @@ source-repository head
|
|||||||
type: git
|
type: git
|
||||||
location: https://github.com/hasufell/ghcup-hs
|
location: https://github.com/hasufell/ghcup-hs
|
||||||
|
|
||||||
flag Curl
|
|
||||||
description: Use curl instead of http-io-streams for download
|
|
||||||
default: False
|
|
||||||
manual: True
|
|
||||||
|
|
||||||
common HsOpenSSL
|
common HsOpenSSL
|
||||||
build-depends: HsOpenSSL >=0.11.4.18
|
build-depends: HsOpenSSL >=0.11
|
||||||
|
|
||||||
common aeson
|
common aeson
|
||||||
build-depends: aeson >=1.4
|
build-depends: aeson >=1.4
|
||||||
@@ -53,8 +48,8 @@ common binary
|
|||||||
common bytestring
|
common bytestring
|
||||||
build-depends: bytestring >=0.10
|
build-depends: bytestring >=0.10
|
||||||
|
|
||||||
common bz2
|
common bzlib
|
||||||
build-depends: bz2 >=0.5.0.5
|
build-depends: bzlib >=0.5.0.5
|
||||||
|
|
||||||
common case-insensitive
|
common case-insensitive
|
||||||
build-depends: case-insensitive >=1.2.1.0
|
build-depends: case-insensitive >=1.2.1.0
|
||||||
@@ -230,7 +225,7 @@ library
|
|||||||
, attoparsec
|
, attoparsec
|
||||||
, binary
|
, binary
|
||||||
, bytestring
|
, bytestring
|
||||||
, bz2
|
, bzlib
|
||||||
, case-insensitive
|
, case-insensitive
|
||||||
, concurrent-output
|
, concurrent-output
|
||||||
, containers
|
, containers
|
||||||
@@ -243,6 +238,8 @@ library
|
|||||||
, hpath-filepath
|
, hpath-filepath
|
||||||
, hpath-io
|
, hpath-io
|
||||||
, hpath-posix
|
, hpath-posix
|
||||||
|
, http-io-streams
|
||||||
|
, io-streams
|
||||||
, language-bash
|
, language-bash
|
||||||
, lzma
|
, lzma
|
||||||
, monad-logger
|
, monad-logger
|
||||||
@@ -262,6 +259,7 @@ library
|
|||||||
, string-interpolate
|
, string-interpolate
|
||||||
, tar-bytestring
|
, tar-bytestring
|
||||||
, template-haskell
|
, template-haskell
|
||||||
|
, terminal-progress-bar
|
||||||
, text
|
, text
|
||||||
, time
|
, time
|
||||||
, transformers
|
, transformers
|
||||||
@@ -279,7 +277,6 @@ library
|
|||||||
exposed-modules:
|
exposed-modules:
|
||||||
GHCup
|
GHCup
|
||||||
GHCup.Download
|
GHCup.Download
|
||||||
GHCup.Download.Utils
|
|
||||||
GHCup.Errors
|
GHCup.Errors
|
||||||
GHCup.Platform
|
GHCup.Platform
|
||||||
GHCup.Types
|
GHCup.Types
|
||||||
@@ -299,15 +296,6 @@ library
|
|||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
hs-source-dirs: lib
|
hs-source-dirs: lib
|
||||||
|
|
||||||
if !flag(curl)
|
|
||||||
import:
|
|
||||||
, http-io-streams
|
|
||||||
, io-streams
|
|
||||||
, terminal-progress-bar
|
|
||||||
exposed-modules: GHCup.Download.IOStreams
|
|
||||||
else
|
|
||||||
cpp-options: -DCURL
|
|
||||||
|
|
||||||
executable ghcup
|
executable ghcup
|
||||||
import:
|
import:
|
||||||
config
|
config
|
||||||
@@ -315,20 +303,20 @@ executable ghcup
|
|||||||
, bytestring
|
, bytestring
|
||||||
, containers
|
, containers
|
||||||
, haskus-utils-variant
|
, haskus-utils-variant
|
||||||
, hpath
|
|
||||||
, hpath-io
|
|
||||||
, megaparsec
|
|
||||||
, monad-logger
|
, monad-logger
|
||||||
|
, megaparsec
|
||||||
, mtl
|
, mtl
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
|
, text
|
||||||
|
, versions
|
||||||
|
, hpath
|
||||||
|
, hpath-io
|
||||||
, pretty-terminal
|
, pretty-terminal
|
||||||
, resourcet
|
, resourcet
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, table-layout
|
, table-layout
|
||||||
, text
|
|
||||||
, uri-bytestring
|
, uri-bytestring
|
||||||
, utf8-string
|
, utf8-string
|
||||||
, versions
|
|
||||||
|
|
||||||
--
|
--
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
@@ -347,27 +335,28 @@ executable ghcup-gen
|
|||||||
, aeson-pretty
|
, aeson-pretty
|
||||||
, bytestring
|
, bytestring
|
||||||
, containers
|
, containers
|
||||||
|
, safe-exceptions
|
||||||
, haskus-utils-variant
|
, haskus-utils-variant
|
||||||
, hpath
|
|
||||||
, monad-logger
|
, monad-logger
|
||||||
, mtl
|
, mtl
|
||||||
, optics
|
, optics
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
|
, text
|
||||||
|
, versions
|
||||||
|
, hpath
|
||||||
, pretty-terminal
|
, pretty-terminal
|
||||||
, resourcet
|
, resourcet
|
||||||
, safe-exceptions
|
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, table-layout
|
, table-layout
|
||||||
, text
|
|
||||||
, transformers
|
, transformers
|
||||||
, uri-bytestring
|
, uri-bytestring
|
||||||
, utf8-string
|
, utf8-string
|
||||||
, versions
|
|
||||||
|
|
||||||
--
|
--
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules: GHCupDownloads
|
other-modules:
|
||||||
Validate
|
GHCupDownloads
|
||||||
|
Validate
|
||||||
|
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: ghcup
|
build-depends: ghcup
|
||||||
|
|||||||
90
lib/GHCup.hs
90
lib/GHCup.hs
@@ -28,8 +28,10 @@ import GHCup.Version
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.Fail ( MonadFail )
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
@@ -49,6 +51,8 @@ import Prelude hiding ( abs
|
|||||||
)
|
)
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.Posix.FilePath ( getSearchPath )
|
import System.Posix.FilePath ( getSearchPath )
|
||||||
|
import System.Posix.RawFilePath.Directory.Errors
|
||||||
|
( hideError )
|
||||||
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
@@ -431,11 +435,10 @@ compileGHC :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> GHCupDownloads
|
=> GHCupDownloads
|
||||||
-> Version -- ^ version to install
|
-> Version -- ^ version to install
|
||||||
-> Either Version (Path Abs) -- ^ version to bootstrap with
|
-> Version -- ^ version to bootstrap with
|
||||||
-> Maybe Int -- ^ jobs
|
-> Maybe Int -- ^ jobs
|
||||||
-> Maybe (Path Abs) -- ^ build config
|
-> Maybe (Path Abs) -- ^ build config
|
||||||
-> Maybe (Path Abs)
|
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -443,13 +446,12 @@ compileGHC :: ( MonadMask m
|
|||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
, GHCupSetError
|
, GHCupSetError
|
||||||
, NoDownload
|
, NoDownload
|
||||||
, PatchFailed
|
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
|
compileGHC dls tver bver jobs mbuildConfig = do
|
||||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
|
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bver}|]
|
||||||
whenM (liftIO $ toolAlreadyInstalled GHC tver)
|
whenM (liftIO $ toolAlreadyInstalled GHC tver)
|
||||||
(throwE $ AlreadyInstalled GHC tver)
|
(throwE $ AlreadyInstalled GHC tver)
|
||||||
|
|
||||||
@@ -461,9 +463,7 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
|
|||||||
tmpUnpack <- lift mkGhcupTmpDir
|
tmpUnpack <- lift mkGhcupTmpDir
|
||||||
liftE $ unpackToDir tmpUnpack dl
|
liftE $ unpackToDir tmpUnpack dl
|
||||||
|
|
||||||
bghc <- case bstrap of
|
bghc <- parseRel ("ghc-" <> verToBS bver)
|
||||||
Right g -> pure $ Right g
|
|
||||||
Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver)
|
|
||||||
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
|
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
|
||||||
ghcdir <- liftIO $ ghcupGHCDir tver
|
ghcdir <- liftIO $ ghcupGHCDir tver
|
||||||
|
|
||||||
@@ -495,32 +495,23 @@ HADDOCK_DOCS = YES
|
|||||||
GhcWithLlvmCodeGen = YES|]
|
GhcWithLlvmCodeGen = YES|]
|
||||||
|
|
||||||
compile :: (MonadCatch m, MonadLogger m, MonadIO m)
|
compile :: (MonadCatch m, MonadLogger m, MonadIO m)
|
||||||
=> Either (Path Rel) (Path Abs)
|
=> Path Rel
|
||||||
-> Path Abs
|
-> Path Abs
|
||||||
-> Path Abs
|
-> Path Abs
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ NoDownload
|
'[NoDownload , FileDoesNotExistError , ProcessError]
|
||||||
, FileDoesNotExistError
|
|
||||||
, PatchFailed
|
|
||||||
, ProcessError
|
|
||||||
]
|
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
compile bghc ghcdir workdir = do
|
compile bghc ghcdir workdir = do
|
||||||
lift $ $(logInfo) [i|configuring build|]
|
lift $ $(logInfo) [i|configuring build|]
|
||||||
|
|
||||||
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
|
|
||||||
|
|
||||||
-- force ld.bfd for build (others seem to misbehave, like lld from FreeBSD)
|
-- force ld.bfd for build (others seem to misbehave, like lld from FreeBSD)
|
||||||
newEnv <- addToCurrentEnv [("LD", "ld.bfd")]
|
newEnv <- addToCurrentEnv [("LD", "ld.bfd")]
|
||||||
|
|
||||||
if
|
if
|
||||||
| tver >= [vver|8.8.0|] -> do
|
| tver >= [vver|8.8.0|] -> do
|
||||||
bghcPath <- case bghc of
|
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
|
||||||
Right ghc' -> pure ghc'
|
bghcPath <- (liftIO $ searchPath spaths bghc) !? NoDownload
|
||||||
Left bver -> do
|
|
||||||
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
|
|
||||||
(liftIO $ searchPath spaths bver) !? NoDownload
|
|
||||||
lEM $ liftIO $ execLogged
|
lEM $ liftIO $ execLogged
|
||||||
"./configure"
|
"./configure"
|
||||||
False
|
False
|
||||||
@@ -532,9 +523,7 @@ GhcWithLlvmCodeGen = YES|]
|
|||||||
lEM $ liftIO $ execLogged
|
lEM $ liftIO $ execLogged
|
||||||
"./configure"
|
"./configure"
|
||||||
False
|
False
|
||||||
[ "--prefix=" <> toFilePath ghcdir
|
["--prefix=" <> toFilePath ghcdir, "--with-ghc=" <> toFilePath bghc]
|
||||||
, "--with-ghc=" <> either toFilePath toFilePath bghc
|
|
||||||
]
|
|
||||||
[rel|ghc-conf|]
|
[rel|ghc-conf|]
|
||||||
(Just workdir)
|
(Just workdir)
|
||||||
(Just newEnv)
|
(Just newEnv)
|
||||||
@@ -547,7 +536,9 @@ GhcWithLlvmCodeGen = YES|]
|
|||||||
Nothing ->
|
Nothing ->
|
||||||
liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
|
liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
lift
|
||||||
|
$ $(logInfo)
|
||||||
|
[i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/ghc-make.log' to see the progress.|]
|
||||||
lEM $ liftIO $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
|
lEM $ liftIO $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
|
||||||
(Just workdir)
|
(Just workdir)
|
||||||
|
|
||||||
@@ -569,21 +560,19 @@ compileCabal :: ( MonadReader Settings m
|
|||||||
)
|
)
|
||||||
=> GHCupDownloads
|
=> GHCupDownloads
|
||||||
-> Version -- ^ version to install
|
-> Version -- ^ version to install
|
||||||
-> Either Version (Path Abs) -- ^ version to bootstrap with
|
-> Version -- ^ GHC version to build with
|
||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Maybe (Path Abs)
|
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ BuildFailed
|
'[ BuildFailed
|
||||||
, DigestError
|
, DigestError
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
, NoDownload
|
, NoDownload
|
||||||
, PatchFailed
|
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
compileCabal dls tver bghc jobs patchdir = do
|
compileCabal dls tver bver jobs = do
|
||||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
|
lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bver}|]
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload
|
dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload
|
||||||
@@ -603,33 +592,22 @@ compileCabal dls tver bghc jobs patchdir = do
|
|||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
where
|
where
|
||||||
compile :: (MonadThrow m, MonadLogger m, MonadIO m)
|
compile :: (MonadLogger m, MonadIO m)
|
||||||
=> Path Abs
|
=> Path Abs
|
||||||
-> Excepts '[ProcessError , PatchFailed] m ()
|
-> Excepts '[ProcessError] m ()
|
||||||
compile workdir = do
|
compile workdir = do
|
||||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
lift
|
||||||
|
$ $(logInfo)
|
||||||
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
|
[i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/cabal-bootstrap.log' to see the progress.|]
|
||||||
|
|
||||||
ghcEnv <- case bghc of
|
|
||||||
Right path -> do
|
|
||||||
-- recover the version from /foo/ghc-6.5.4
|
|
||||||
bn <- basename path
|
|
||||||
let dn = toFilePath $ dirname path
|
|
||||||
let ver = snd . B.break (== _hyphen) . toFilePath $ bn
|
|
||||||
|
|
||||||
pure
|
|
||||||
[ ("GHC" , toFilePath path)
|
|
||||||
, ("GHC_PKG", dn <> "/" <> "ghc-pkg" <> ver)
|
|
||||||
]
|
|
||||||
Left bver -> do
|
|
||||||
let v' = verToBS bver
|
|
||||||
pure [("GHC", "ghc-" <> v'), ("GHC_PKG", "ghc-pkg-" <> v')]
|
|
||||||
|
|
||||||
|
let v' = verToBS bver
|
||||||
cabal_bin <- liftIO $ ghcupBinDir
|
cabal_bin <- liftIO $ ghcupBinDir
|
||||||
newEnv <- lift
|
newEnv <- lift $ addToCurrentEnv
|
||||||
$ addToCurrentEnv (("PREFIX", toFilePath cabal_bin) : ghcEnv)
|
[ ("GHC" , "ghc-" <> v')
|
||||||
lift $ $(logDebug) [i|Environment: #{newEnv}|]
|
, ("GHC_PKG", "ghc-pkg-" <> v')
|
||||||
|
, ("GHC_VER", v')
|
||||||
|
, ("PREFIX" , toFilePath cabal_bin)
|
||||||
|
]
|
||||||
|
|
||||||
lEM $ liftIO $ execLogged "./bootstrap.sh"
|
lEM $ liftIO $ execLogged "./bootstrap.sh"
|
||||||
False
|
False
|
||||||
|
|||||||
@@ -1,4 +1,3 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
@@ -11,34 +10,33 @@
|
|||||||
|
|
||||||
module GHCup.Download where
|
module GHCup.Download where
|
||||||
|
|
||||||
#if !defined(CURL)
|
|
||||||
import GHCup.Download.IOStreams
|
|
||||||
import GHCup.Download.Utils
|
|
||||||
#endif
|
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Platform
|
import GHCup.Platform
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Types.JSON ( )
|
import GHCup.Types.JSON ( )
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
#if defined(CURL)
|
|
||||||
import GHCup.Utils.File
|
import GHCup.Utils.File
|
||||||
#endif
|
|
||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
import GHCup.Version
|
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.Fail ( MonadFail )
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
|
import Data.ByteString.Builder
|
||||||
import Data.CaseInsensitive ( CI )
|
import Data.CaseInsensitive ( CI )
|
||||||
|
import Data.IORef
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
|
import Data.Text.Read
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import Data.Time.Format
|
import Data.Time.Format
|
||||||
@@ -47,6 +45,7 @@ import GHC.IO.Exception
|
|||||||
import HPath
|
import HPath
|
||||||
import HPath.IO as HIO
|
import HPath.IO as HIO
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
|
import Network.Http.Client hiding ( URL )
|
||||||
import OpenSSL.Digest
|
import OpenSSL.Digest
|
||||||
import Optics
|
import Optics
|
||||||
import Prelude hiding ( abs
|
import Prelude hiding ( abs
|
||||||
@@ -54,19 +53,32 @@ import Prelude hiding ( abs
|
|||||||
, writeFile
|
, writeFile
|
||||||
)
|
)
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
|
import "unix" System.Posix.IO.ByteString
|
||||||
|
hiding ( fdWrite )
|
||||||
|
import "unix-bytestring" System.Posix.IO.ByteString
|
||||||
|
( fdWrite )
|
||||||
|
import System.Posix.RawFilePath.Directory.Errors
|
||||||
|
( hideError )
|
||||||
|
import System.ProgressBar
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
import URI.ByteString.QQ
|
||||||
|
|
||||||
|
import qualified Data.Binary.Builder as B
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
|
import qualified System.IO.Streams as Streams
|
||||||
import qualified System.Posix.Files.ByteString as PF
|
import qualified System.Posix.Files.ByteString as PF
|
||||||
import qualified System.Posix.RawFilePath.Directory
|
import qualified System.Posix.RawFilePath.Directory
|
||||||
as RD
|
as RD
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
ghcupURL :: URI
|
||||||
|
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -118,7 +130,6 @@ getDownloads urlSource = do
|
|||||||
, UnsupportedScheme
|
, UnsupportedScheme
|
||||||
, NoLocationHeader
|
, NoLocationHeader
|
||||||
, TooManyRedirs
|
, TooManyRedirs
|
||||||
, ProcessError
|
|
||||||
]
|
]
|
||||||
m1
|
m1
|
||||||
L.ByteString
|
L.ByteString
|
||||||
@@ -147,7 +158,7 @@ getDownloads urlSource = do
|
|||||||
pure bs
|
pure bs
|
||||||
else liftIO $ readFile json_file
|
else liftIO $ readFile json_file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
|
||||||
liftIO $ deleteFile json_file
|
liftIO $ deleteFile json_file
|
||||||
liftE $ downloadBS uri'
|
liftE $ downloadBS uri'
|
||||||
else -- access in less than 5 minutes, re-use file
|
else -- access in less than 5 minutes, re-use file
|
||||||
@@ -160,14 +171,11 @@ getDownloads urlSource = do
|
|||||||
liftIO $ writeFileWithModTime modTime json_file bs
|
liftIO $ writeFileWithModTime modTime json_file bs
|
||||||
pure bs
|
pure bs
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
|
||||||
liftE $ downloadBS uri'
|
liftE $ downloadBS uri'
|
||||||
|
|
||||||
where
|
where
|
||||||
getModTime = do
|
getModTime = do
|
||||||
#if defined(CURL)
|
|
||||||
pure Nothing
|
|
||||||
#else
|
|
||||||
headers <-
|
headers <-
|
||||||
handleIO (\_ -> pure mempty)
|
handleIO (\_ -> pure mempty)
|
||||||
$ liftE
|
$ liftE
|
||||||
@@ -178,7 +186,7 @@ getDownloads urlSource = do
|
|||||||
$ getHead uri'
|
$ getHead uri'
|
||||||
)
|
)
|
||||||
pure $ parseModifiedHeader headers
|
pure $ parseModifiedHeader headers
|
||||||
#endif
|
|
||||||
|
|
||||||
parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
|
parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
|
||||||
parseModifiedHeader headers =
|
parseModifiedHeader headers =
|
||||||
@@ -281,25 +289,25 @@ download dli dest mfn
|
|||||||
let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli))
|
let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli))
|
||||||
lift $ $(logInfo) [i|downloading: #{uri'}|]
|
lift $ $(logInfo) [i|downloading: #{uri'}|]
|
||||||
|
|
||||||
|
(https, host, fullPath, port) <- reThrowAll DownloadFailed
|
||||||
|
$ uriToQuadruple (view dlUri dli)
|
||||||
|
|
||||||
-- destination dir must exist
|
-- destination dir must exist
|
||||||
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
|
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
|
||||||
destFile <- getDestFile
|
destFile <- getDestFile
|
||||||
|
|
||||||
-- download
|
-- download
|
||||||
|
fd <- liftIO $ createRegularFileFd newFilePerms destFile
|
||||||
|
let stepper = fdWrite fd
|
||||||
flip onException
|
flip onException
|
||||||
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
||||||
$ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
|
$ flip finally (liftIO $ closeFd fd)
|
||||||
|
$ catchAllE
|
||||||
(\e ->
|
(\e ->
|
||||||
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
||||||
>> (throwE . DownloadFailed $ e)
|
>> (throwE . DownloadFailed $ e)
|
||||||
) $ do
|
)
|
||||||
#if defined(CURL)
|
$ downloadInternal True https host fullPath port stepper
|
||||||
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
|
||||||
["-sSfL", "-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
|
|
||||||
#endif
|
|
||||||
|
|
||||||
liftE $ checkDigest dli destFile
|
liftE $ checkDigest dli destFile
|
||||||
pure destFile
|
pure destFile
|
||||||
@@ -348,8 +356,6 @@ downloadCached dli mfn = do
|
|||||||
------------------
|
------------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | This is used for downloading the JSON.
|
-- | This is used for downloading the JSON.
|
||||||
downloadBS :: (MonadCatch m, MonadIO m)
|
downloadBS :: (MonadCatch m, MonadIO m)
|
||||||
=> URI
|
=> URI
|
||||||
@@ -360,7 +366,6 @@ downloadBS :: (MonadCatch m, MonadIO m)
|
|||||||
, UnsupportedScheme
|
, UnsupportedScheme
|
||||||
, NoLocationHeader
|
, NoLocationHeader
|
||||||
, TooManyRedirs
|
, TooManyRedirs
|
||||||
, ProcessError
|
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
L.ByteString
|
L.ByteString
|
||||||
@@ -379,17 +384,220 @@ downloadBS uri'
|
|||||||
scheme = view (uriSchemeL' % schemeBSL') uri'
|
scheme = view (uriSchemeL' % schemeBSL') uri'
|
||||||
path = view pathL' uri'
|
path = view pathL' uri'
|
||||||
dl https = do
|
dl https = do
|
||||||
#if defined(CURL)
|
|
||||||
let exe = [rel|curl|]
|
|
||||||
args = ["-sSfL", serializeURIRef' uri']
|
|
||||||
liftIO (executeOut exe args Nothing) >>= \case
|
|
||||||
CapturedProcess ExitSuccess stdout _ -> do
|
|
||||||
pure $ L.fromStrict stdout
|
|
||||||
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
|
|
||||||
#else
|
|
||||||
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||||
liftE $ downloadBS' https host' fullPath' port'
|
liftE $ downloadBS' https host' fullPath' port'
|
||||||
#endif
|
|
||||||
|
|
||||||
|
-- | Load the result of this download into memory at once.
|
||||||
|
downloadBS' :: MonadIO m
|
||||||
|
=> Bool -- ^ https?
|
||||||
|
-> ByteString -- ^ host (e.g. "www.example.com")
|
||||||
|
-> ByteString -- ^ path (e.g. "/my/file") including query
|
||||||
|
-> Maybe Int -- ^ optional port (e.g. 3000)
|
||||||
|
-> Excepts
|
||||||
|
'[ HTTPStatusError
|
||||||
|
, URIParseError
|
||||||
|
, UnsupportedScheme
|
||||||
|
, NoLocationHeader
|
||||||
|
, TooManyRedirs
|
||||||
|
]
|
||||||
|
m
|
||||||
|
(L.ByteString)
|
||||||
|
downloadBS' https host path port = do
|
||||||
|
bref <- liftIO $ newIORef (mempty :: Builder)
|
||||||
|
let stepper bs = modifyIORef bref (<> byteString bs)
|
||||||
|
downloadInternal False https host path port stepper
|
||||||
|
liftIO (readIORef bref <&> toLazyByteString)
|
||||||
|
|
||||||
|
|
||||||
|
downloadInternal :: MonadIO m
|
||||||
|
=> Bool -- ^ whether to show a progress bar
|
||||||
|
-> Bool -- ^ https?
|
||||||
|
-> ByteString -- ^ host
|
||||||
|
-> ByteString -- ^ path with query
|
||||||
|
-> Maybe Int -- ^ optional port
|
||||||
|
-> (ByteString -> IO a) -- ^ the consuming step function
|
||||||
|
-> Excepts
|
||||||
|
'[ HTTPStatusError
|
||||||
|
, URIParseError
|
||||||
|
, UnsupportedScheme
|
||||||
|
, NoLocationHeader
|
||||||
|
, TooManyRedirs
|
||||||
|
]
|
||||||
|
m
|
||||||
|
()
|
||||||
|
downloadInternal = go (5 :: Int)
|
||||||
|
|
||||||
|
where
|
||||||
|
go redirs progressBar https host path port consumer = do
|
||||||
|
r <- liftIO $ withConnection' https host port action
|
||||||
|
veitherToExcepts r >>= \case
|
||||||
|
Just r' ->
|
||||||
|
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
|
||||||
|
Nothing -> pure ()
|
||||||
|
where
|
||||||
|
action c = do
|
||||||
|
let q = buildRequest1 $ http GET path
|
||||||
|
|
||||||
|
sendRequest c q emptyBody
|
||||||
|
|
||||||
|
receiveResponse
|
||||||
|
c
|
||||||
|
(\r i' -> runE $ do
|
||||||
|
let scode = getStatusCode r
|
||||||
|
if
|
||||||
|
| scode >= 200 && scode < 300 -> downloadStream r i' >> pure Nothing
|
||||||
|
| scode >= 300 && scode < 400 -> case getHeader r "Location" of
|
||||||
|
Just r' -> pure $ Just $ r'
|
||||||
|
Nothing -> throwE NoLocationHeader
|
||||||
|
| otherwise -> throwE $ HTTPStatusError scode
|
||||||
|
)
|
||||||
|
|
||||||
|
followRedirectURL bs = case parseURI strictURIParserOptions bs of
|
||||||
|
Right uri' -> do
|
||||||
|
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||||
|
go (redirs - 1) progressBar https' host' fullPath' port' consumer
|
||||||
|
Left e -> throwE e
|
||||||
|
|
||||||
|
downloadStream r i' = do
|
||||||
|
let size = case getHeader r "Content-Length" of
|
||||||
|
Just x' -> case decimal $ E.decodeUtf8 x' of
|
||||||
|
Left _ -> 0
|
||||||
|
Right (r', _) -> r'
|
||||||
|
Nothing -> 0
|
||||||
|
|
||||||
|
mpb <- if progressBar
|
||||||
|
then Just <$> (liftIO $ newProgressBar defStyle 10 (Progress 0 size ()))
|
||||||
|
else pure Nothing
|
||||||
|
|
||||||
|
outStream <- liftIO $ Streams.makeOutputStream
|
||||||
|
(\case
|
||||||
|
Just bs -> do
|
||||||
|
forM_ mpb $ \pb -> incProgress pb (BS.length bs)
|
||||||
|
void $ consumer bs
|
||||||
|
Nothing -> pure ()
|
||||||
|
)
|
||||||
|
liftIO $ Streams.connect i' outStream
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
getHead :: (MonadCatch m, MonadIO m)
|
||||||
|
=> URI
|
||||||
|
-> Excepts
|
||||||
|
'[ HTTPStatusError
|
||||||
|
, URIParseError
|
||||||
|
, UnsupportedScheme
|
||||||
|
, NoLocationHeader
|
||||||
|
, TooManyRedirs
|
||||||
|
]
|
||||||
|
m
|
||||||
|
(M.Map (CI ByteString) ByteString)
|
||||||
|
getHead uri' | scheme == "https" = head' True
|
||||||
|
| scheme == "http" = head' False
|
||||||
|
| otherwise = throwE UnsupportedScheme
|
||||||
|
|
||||||
|
where
|
||||||
|
scheme = view (uriSchemeL' % schemeBSL') uri'
|
||||||
|
head' https = do
|
||||||
|
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||||
|
liftE $ headInternal https host' fullPath' port'
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
headInternal :: MonadIO m
|
||||||
|
=> Bool -- ^ https?
|
||||||
|
-> ByteString -- ^ host
|
||||||
|
-> ByteString -- ^ path with query
|
||||||
|
-> Maybe Int -- ^ optional port
|
||||||
|
-> Excepts
|
||||||
|
'[ HTTPStatusError
|
||||||
|
, URIParseError
|
||||||
|
, UnsupportedScheme
|
||||||
|
, TooManyRedirs
|
||||||
|
, NoLocationHeader
|
||||||
|
]
|
||||||
|
m
|
||||||
|
(M.Map (CI ByteString) ByteString)
|
||||||
|
headInternal = go (5 :: Int)
|
||||||
|
|
||||||
|
where
|
||||||
|
go redirs https host path port = do
|
||||||
|
r <- liftIO $ withConnection' https host port action
|
||||||
|
veitherToExcepts r >>= \case
|
||||||
|
Left r' ->
|
||||||
|
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
|
||||||
|
Right hs -> pure hs
|
||||||
|
where
|
||||||
|
|
||||||
|
action c = do
|
||||||
|
let q = buildRequest1 $ http HEAD path
|
||||||
|
|
||||||
|
sendRequest c q emptyBody
|
||||||
|
|
||||||
|
unsafeReceiveResponse
|
||||||
|
c
|
||||||
|
(\r _ -> runE $ do
|
||||||
|
let scode = getStatusCode r
|
||||||
|
if
|
||||||
|
| scode >= 200 && scode < 300 -> do
|
||||||
|
let headers = getHeaderMap r
|
||||||
|
pure $ Right $ headers
|
||||||
|
| scode >= 300 && scode < 400 -> case getHeader r "Location" of
|
||||||
|
Just r' -> pure $ Left $ r'
|
||||||
|
Nothing -> throwE NoLocationHeader
|
||||||
|
| otherwise -> throwE $ HTTPStatusError scode
|
||||||
|
)
|
||||||
|
|
||||||
|
followRedirectURL bs = case parseURI strictURIParserOptions bs of
|
||||||
|
Right uri' -> do
|
||||||
|
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||||
|
go (redirs - 1) https' host' fullPath' port'
|
||||||
|
Left e -> throwE e
|
||||||
|
|
||||||
|
|
||||||
|
withConnection' :: Bool
|
||||||
|
-> ByteString
|
||||||
|
-> Maybe Int
|
||||||
|
-> (Connection -> IO a)
|
||||||
|
-> IO a
|
||||||
|
withConnection' https host port action = bracket acquire closeConnection action
|
||||||
|
|
||||||
|
where
|
||||||
|
acquire = case https of
|
||||||
|
True -> do
|
||||||
|
ctx <- baselineContextSSL
|
||||||
|
openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
|
||||||
|
False -> openConnection host (fromIntegral $ fromMaybe 80 port)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Extracts from a URI type: (https?, host, path+query, port)
|
||||||
|
uriToQuadruple :: Monad m
|
||||||
|
=> URI
|
||||||
|
-> Excepts
|
||||||
|
'[UnsupportedScheme]
|
||||||
|
m
|
||||||
|
(Bool, ByteString, ByteString, Maybe Int)
|
||||||
|
uriToQuadruple URI {..} = do
|
||||||
|
let scheme = view schemeBSL' uriScheme
|
||||||
|
|
||||||
|
host <-
|
||||||
|
preview (_Just % authorityHostL' % hostBSL') uriAuthority
|
||||||
|
?? UnsupportedScheme
|
||||||
|
|
||||||
|
https <- if
|
||||||
|
| scheme == "https" -> pure True
|
||||||
|
| scheme == "http" -> pure False
|
||||||
|
| otherwise -> throwE UnsupportedScheme
|
||||||
|
|
||||||
|
let queryBS =
|
||||||
|
BS.intercalate "&"
|
||||||
|
. fmap (\(x, y) -> encodeQuery x <> "=" <> encodeQuery y)
|
||||||
|
$ (queryPairs uriQuery)
|
||||||
|
port =
|
||||||
|
preview (_Just % authorityPortL' % _Just % portNumberL') uriAuthority
|
||||||
|
fullpath = if BS.null queryBS then uriPath else uriPath <> "?" <> queryBS
|
||||||
|
pure (https, host, fullpath, port)
|
||||||
|
where encodeQuery = L.toStrict . B.toLazyByteString . urlEncodeQuery
|
||||||
|
|
||||||
|
|
||||||
checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m)
|
checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m)
|
||||||
@@ -405,4 +613,3 @@ checkDigest dli file = do
|
|||||||
let cDigest = E.decodeUtf8 . toHex . digest (digestByName "sha256") $ c
|
let cDigest = E.decodeUtf8 . toHex . digest (digestByName "sha256") $ c
|
||||||
eDigest = view dlHash dli
|
eDigest = view dlHash dli
|
||||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
||||||
|
|
||||||
|
|||||||
@@ -1,253 +0,0 @@
|
|||||||
{-# LANGUAGE DataKinds #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
|
|
||||||
|
|
||||||
module GHCup.Download.IOStreams where
|
|
||||||
|
|
||||||
|
|
||||||
import GHCup.Download.Utils
|
|
||||||
import GHCup.Errors
|
|
||||||
import GHCup.Types.JSON ( )
|
|
||||||
import GHCup.Utils.File
|
|
||||||
import GHCup.Utils.Prelude
|
|
||||||
|
|
||||||
import Control.Applicative
|
|
||||||
import Control.Exception.Safe
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Reader
|
|
||||||
import Data.ByteString ( ByteString )
|
|
||||||
import Data.ByteString.Builder
|
|
||||||
import Data.CaseInsensitive ( CI )
|
|
||||||
import Data.IORef
|
|
||||||
import Data.Maybe
|
|
||||||
import Data.Text.Read
|
|
||||||
import HPath
|
|
||||||
import HPath.IO as HIO
|
|
||||||
import Haskus.Utils.Variant.Excepts
|
|
||||||
import Network.Http.Client hiding ( URL )
|
|
||||||
import Optics
|
|
||||||
import Prelude hiding ( abs
|
|
||||||
, readFile
|
|
||||||
, writeFile
|
|
||||||
)
|
|
||||||
import "unix" System.Posix.IO.ByteString
|
|
||||||
hiding ( fdWrite )
|
|
||||||
import "unix-bytestring" System.Posix.IO.ByteString
|
|
||||||
( fdWrite )
|
|
||||||
import System.ProgressBar
|
|
||||||
import URI.ByteString
|
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
|
||||||
import qualified Data.Map.Strict as M
|
|
||||||
import qualified Data.Text.Encoding as E
|
|
||||||
import qualified System.IO.Streams as Streams
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
----------------------------
|
|
||||||
--[ Low-level (non-curl) ]--
|
|
||||||
----------------------------
|
|
||||||
|
|
||||||
|
|
||||||
-- | Load the result of this download into memory at once.
|
|
||||||
downloadBS' :: MonadIO m
|
|
||||||
=> Bool -- ^ https?
|
|
||||||
-> ByteString -- ^ host (e.g. "www.example.com")
|
|
||||||
-> ByteString -- ^ path (e.g. "/my/file") including query
|
|
||||||
-> Maybe Int -- ^ optional port (e.g. 3000)
|
|
||||||
-> Excepts
|
|
||||||
'[ HTTPStatusError
|
|
||||||
, URIParseError
|
|
||||||
, UnsupportedScheme
|
|
||||||
, NoLocationHeader
|
|
||||||
, TooManyRedirs
|
|
||||||
]
|
|
||||||
m
|
|
||||||
(L.ByteString)
|
|
||||||
downloadBS' https host path port = do
|
|
||||||
bref <- liftIO $ newIORef (mempty :: Builder)
|
|
||||||
let stepper bs = modifyIORef bref (<> byteString bs)
|
|
||||||
downloadInternal False https host path port stepper
|
|
||||||
liftIO (readIORef bref <&> toLazyByteString)
|
|
||||||
|
|
||||||
|
|
||||||
downloadToFile :: (MonadMask m, MonadIO m)
|
|
||||||
=> Bool -- ^ https?
|
|
||||||
-> ByteString -- ^ host (e.g. "www.example.com")
|
|
||||||
-> ByteString -- ^ path (e.g. "/my/file") including query
|
|
||||||
-> Maybe Int -- ^ optional port (e.g. 3000)
|
|
||||||
-> Path Abs -- ^ destination file to create and write to
|
|
||||||
-> Excepts '[DownloadFailed] m ()
|
|
||||||
downloadToFile https host fullPath port destFile = do
|
|
||||||
fd <- liftIO $ createRegularFileFd newFilePerms destFile
|
|
||||||
let stepper = fdWrite fd
|
|
||||||
flip finally (liftIO $ closeFd fd)
|
|
||||||
$ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper
|
|
||||||
|
|
||||||
|
|
||||||
downloadInternal :: MonadIO m
|
|
||||||
=> Bool -- ^ whether to show a progress bar
|
|
||||||
-> Bool -- ^ https?
|
|
||||||
-> ByteString -- ^ host
|
|
||||||
-> ByteString -- ^ path with query
|
|
||||||
-> Maybe Int -- ^ optional port
|
|
||||||
-> (ByteString -> IO a) -- ^ the consuming step function
|
|
||||||
-> Excepts
|
|
||||||
'[ HTTPStatusError
|
|
||||||
, URIParseError
|
|
||||||
, UnsupportedScheme
|
|
||||||
, NoLocationHeader
|
|
||||||
, TooManyRedirs
|
|
||||||
]
|
|
||||||
m
|
|
||||||
()
|
|
||||||
downloadInternal = go (5 :: Int)
|
|
||||||
|
|
||||||
where
|
|
||||||
go redirs progressBar https host path port consumer = do
|
|
||||||
r <- liftIO $ withConnection' https host port action
|
|
||||||
veitherToExcepts r >>= \case
|
|
||||||
Just r' ->
|
|
||||||
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
|
|
||||||
Nothing -> pure ()
|
|
||||||
where
|
|
||||||
action c = do
|
|
||||||
let q = buildRequest1 $ http GET path
|
|
||||||
|
|
||||||
sendRequest c q emptyBody
|
|
||||||
|
|
||||||
receiveResponse
|
|
||||||
c
|
|
||||||
(\r i' -> runE $ do
|
|
||||||
let scode = getStatusCode r
|
|
||||||
if
|
|
||||||
| scode >= 200 && scode < 300 -> downloadStream r i' >> pure Nothing
|
|
||||||
| scode >= 300 && scode < 400 -> case getHeader r "Location" of
|
|
||||||
Just r' -> pure $ Just $ r'
|
|
||||||
Nothing -> throwE NoLocationHeader
|
|
||||||
| otherwise -> throwE $ HTTPStatusError scode
|
|
||||||
)
|
|
||||||
|
|
||||||
followRedirectURL bs = case parseURI strictURIParserOptions bs of
|
|
||||||
Right uri' -> do
|
|
||||||
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
|
||||||
go (redirs - 1) progressBar https' host' fullPath' port' consumer
|
|
||||||
Left e -> throwE e
|
|
||||||
|
|
||||||
downloadStream r i' = do
|
|
||||||
let size = case getHeader r "Content-Length" of
|
|
||||||
Just x' -> case decimal $ E.decodeUtf8 x' of
|
|
||||||
Left _ -> 0
|
|
||||||
Right (r', _) -> r'
|
|
||||||
Nothing -> 0
|
|
||||||
|
|
||||||
mpb <- if progressBar
|
|
||||||
then Just <$> (liftIO $ newProgressBar defStyle 10 (Progress 0 size ()))
|
|
||||||
else pure Nothing
|
|
||||||
|
|
||||||
outStream <- liftIO $ Streams.makeOutputStream
|
|
||||||
(\case
|
|
||||||
Just bs -> do
|
|
||||||
forM_ mpb $ \pb -> incProgress pb (BS.length bs)
|
|
||||||
void $ consumer bs
|
|
||||||
Nothing -> pure ()
|
|
||||||
)
|
|
||||||
liftIO $ Streams.connect i' outStream
|
|
||||||
|
|
||||||
|
|
||||||
getHead :: (MonadCatch m, MonadIO m)
|
|
||||||
=> URI
|
|
||||||
-> Excepts
|
|
||||||
'[ HTTPStatusError
|
|
||||||
, URIParseError
|
|
||||||
, UnsupportedScheme
|
|
||||||
, NoLocationHeader
|
|
||||||
, TooManyRedirs
|
|
||||||
, ProcessError
|
|
||||||
]
|
|
||||||
m
|
|
||||||
(M.Map (CI ByteString) ByteString)
|
|
||||||
getHead uri' | scheme == "https" = head' True
|
|
||||||
| scheme == "http" = head' False
|
|
||||||
| otherwise = throwE UnsupportedScheme
|
|
||||||
|
|
||||||
where
|
|
||||||
scheme = view (uriSchemeL' % schemeBSL') uri'
|
|
||||||
head' https = do
|
|
||||||
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
|
||||||
liftE $ headInternal https host' fullPath' port'
|
|
||||||
|
|
||||||
|
|
||||||
headInternal :: MonadIO m
|
|
||||||
=> Bool -- ^ https?
|
|
||||||
-> ByteString -- ^ host
|
|
||||||
-> ByteString -- ^ path with query
|
|
||||||
-> Maybe Int -- ^ optional port
|
|
||||||
-> Excepts
|
|
||||||
'[ HTTPStatusError
|
|
||||||
, URIParseError
|
|
||||||
, UnsupportedScheme
|
|
||||||
, TooManyRedirs
|
|
||||||
, NoLocationHeader
|
|
||||||
]
|
|
||||||
m
|
|
||||||
(M.Map (CI ByteString) ByteString)
|
|
||||||
headInternal = go (5 :: Int)
|
|
||||||
|
|
||||||
where
|
|
||||||
go redirs https host path port = do
|
|
||||||
r <- liftIO $ withConnection' https host port action
|
|
||||||
veitherToExcepts r >>= \case
|
|
||||||
Left r' ->
|
|
||||||
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
|
|
||||||
Right hs -> pure hs
|
|
||||||
where
|
|
||||||
|
|
||||||
action c = do
|
|
||||||
let q = buildRequest1 $ http HEAD path
|
|
||||||
|
|
||||||
sendRequest c q emptyBody
|
|
||||||
|
|
||||||
unsafeReceiveResponse
|
|
||||||
c
|
|
||||||
(\r _ -> runE $ do
|
|
||||||
let scode = getStatusCode r
|
|
||||||
if
|
|
||||||
| scode >= 200 && scode < 300 -> do
|
|
||||||
let headers = getHeaderMap r
|
|
||||||
pure $ Right $ headers
|
|
||||||
| scode >= 300 && scode < 400 -> case getHeader r "Location" of
|
|
||||||
Just r' -> pure $ Left $ r'
|
|
||||||
Nothing -> throwE NoLocationHeader
|
|
||||||
| otherwise -> throwE $ HTTPStatusError scode
|
|
||||||
)
|
|
||||||
|
|
||||||
followRedirectURL bs = case parseURI strictURIParserOptions bs of
|
|
||||||
Right uri' -> do
|
|
||||||
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
|
||||||
go (redirs - 1) https' host' fullPath' port'
|
|
||||||
Left e -> throwE e
|
|
||||||
|
|
||||||
|
|
||||||
withConnection' :: Bool
|
|
||||||
-> ByteString
|
|
||||||
-> Maybe Int
|
|
||||||
-> (Connection -> IO a)
|
|
||||||
-> IO a
|
|
||||||
withConnection' https host port action = bracket acquire closeConnection action
|
|
||||||
|
|
||||||
where
|
|
||||||
acquire = case https of
|
|
||||||
True -> do
|
|
||||||
ctx <- baselineContextSSL
|
|
||||||
openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
|
|
||||||
False -> openConnection host (fromIntegral $ fromMaybe 80 port)
|
|
||||||
@@ -1,64 +0,0 @@
|
|||||||
{-# LANGUAGE DataKinds #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
|
|
||||||
|
|
||||||
module GHCup.Download.Utils where
|
|
||||||
|
|
||||||
|
|
||||||
import GHCup.Errors
|
|
||||||
import GHCup.Types.Optics
|
|
||||||
import GHCup.Types.JSON ( )
|
|
||||||
import GHCup.Utils.Prelude
|
|
||||||
|
|
||||||
import Control.Applicative
|
|
||||||
import Control.Monad
|
|
||||||
import Data.ByteString ( ByteString )
|
|
||||||
import Data.Maybe
|
|
||||||
import Haskus.Utils.Variant.Excepts
|
|
||||||
import Optics
|
|
||||||
import Prelude hiding ( abs
|
|
||||||
, readFile
|
|
||||||
, writeFile
|
|
||||||
)
|
|
||||||
import URI.ByteString
|
|
||||||
|
|
||||||
import qualified Data.Binary.Builder as B
|
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
|
||||||
|
|
||||||
|
|
||||||
-- | Extracts from a URI type: (https?, host, path+query, port)
|
|
||||||
uriToQuadruple :: Monad m
|
|
||||||
=> URI
|
|
||||||
-> Excepts
|
|
||||||
'[UnsupportedScheme]
|
|
||||||
m
|
|
||||||
(Bool, ByteString, ByteString, Maybe Int)
|
|
||||||
uriToQuadruple URI {..} = do
|
|
||||||
let scheme = view schemeBSL' uriScheme
|
|
||||||
|
|
||||||
host <-
|
|
||||||
preview (_Just % authorityHostL' % hostBSL') uriAuthority
|
|
||||||
?? UnsupportedScheme
|
|
||||||
|
|
||||||
https <- if
|
|
||||||
| scheme == "https" -> pure True
|
|
||||||
| scheme == "http" -> pure False
|
|
||||||
| otherwise -> throwE UnsupportedScheme
|
|
||||||
|
|
||||||
let queryBS =
|
|
||||||
BS.intercalate "&"
|
|
||||||
. fmap (\(x, y) -> encodeQuery x <> "=" <> encodeQuery y)
|
|
||||||
$ (queryPairs uriQuery)
|
|
||||||
port =
|
|
||||||
preview (_Just % authorityPortL' % _Just % portNumberL') uriAuthority
|
|
||||||
fullpath = if BS.null queryBS then uriPath else uriPath <> "?" <> queryBS
|
|
||||||
pure (https, host, fullpath, port)
|
|
||||||
where encodeQuery = L.toStrict . B.toLazyByteString . urlEncodeQuery
|
|
||||||
|
|
||||||
@@ -88,10 +88,6 @@ data NoLocationHeader = NoLocationHeader
|
|||||||
data TooManyRedirs = TooManyRedirs
|
data TooManyRedirs = TooManyRedirs
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
-- | A patch could not be applied.
|
|
||||||
data PatchFailed = PatchFailed
|
|
||||||
deriving Show
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
|
|||||||
@@ -22,6 +22,7 @@ import Control.Exception.Safe
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|||||||
@@ -18,6 +18,7 @@ import GHCup.Utils.Prelude
|
|||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.TH
|
import Data.Aeson.TH
|
||||||
import Data.Aeson.Types
|
import Data.Aeson.Types
|
||||||
|
import Data.Text.Encoding ( decodeUtf8 )
|
||||||
import Data.Text.Encoding as E
|
import Data.Text.Encoding as E
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Data.Word8
|
import Data.Word8
|
||||||
|
|||||||
@@ -22,8 +22,10 @@ import GHCup.Utils.Prelude
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.Fail ( MonadFail )
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Data.Attoparsec.ByteString
|
import Data.Attoparsec.ByteString
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.List
|
import Data.List
|
||||||
@@ -334,23 +336,3 @@ make args workdir = do
|
|||||||
has_gmake <- isJust <$> searchPath spaths [rel|gmake|]
|
has_gmake <- isJust <$> searchPath spaths [rel|gmake|]
|
||||||
let mymake = if has_gmake then "gmake" else "make"
|
let mymake = if has_gmake then "gmake" else "make"
|
||||||
execLogged mymake True args [rel|ghc-make|] workdir Nothing
|
execLogged mymake True args [rel|ghc-make|] workdir Nothing
|
||||||
|
|
||||||
|
|
||||||
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
|
||||||
-- on first failure.
|
|
||||||
applyPatches :: (MonadLogger m, MonadIO m)
|
|
||||||
=> Path Abs -- ^ dir containing patches
|
|
||||||
-> Path Abs -- ^ dir to apply patches in
|
|
||||||
-> Excepts '[PatchFailed] m ()
|
|
||||||
applyPatches pdir ddir = do
|
|
||||||
patches <- liftIO $ getDirsFiles pdir
|
|
||||||
forM_ (sort patches) $ \patch' -> do
|
|
||||||
lift $ $(logInfo) [i|Applying patch #{patch'}|]
|
|
||||||
(fmap (either (const Nothing) Just) $ liftIO $ exec
|
|
||||||
"patch"
|
|
||||||
True
|
|
||||||
["-p1", "-i", toFilePath patch']
|
|
||||||
(Just ddir)
|
|
||||||
Nothing
|
|
||||||
)
|
|
||||||
!? PatchFailed
|
|
||||||
|
|||||||
@@ -6,9 +6,10 @@ module GHCup.Utils.File where
|
|||||||
|
|
||||||
import GHCup.Utils.Dirs
|
import GHCup.Utils.Dirs
|
||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
|
import GHCup.Utils.String.QQ
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception ( evaluate )
|
import Control.Concurrent.MVar
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
@@ -18,6 +19,8 @@ import Data.Foldable
|
|||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Word8
|
||||||
|
import GHC.Conc hiding ( threadWaitRead )
|
||||||
import GHC.Foreign ( peekCStringLen )
|
import GHC.Foreign ( peekCStringLen )
|
||||||
import GHC.IO.Encoding ( getLocaleEncoding )
|
import GHC.IO.Encoding ( getLocaleEncoding )
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
@@ -27,6 +30,7 @@ import Optics
|
|||||||
import Streamly
|
import Streamly
|
||||||
import Streamly.External.ByteString
|
import Streamly.External.ByteString
|
||||||
import Streamly.External.ByteString.Lazy
|
import Streamly.External.ByteString.Lazy
|
||||||
|
import System.Console.Concurrent
|
||||||
import System.Console.Pretty
|
import System.Console.Pretty
|
||||||
import System.Console.Regions
|
import System.Console.Regions
|
||||||
import System.IO
|
import System.IO
|
||||||
@@ -44,7 +48,6 @@ import System.Posix.Types
|
|||||||
import qualified Control.Exception as EX
|
import qualified Control.Exception as EX
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Data.Text.Encoding.Error as E
|
|
||||||
import qualified System.Posix.Process.ByteString
|
import qualified System.Posix.Process.ByteString
|
||||||
as SPPB
|
as SPPB
|
||||||
import Streamly.External.Posix.DirStream
|
import Streamly.External.Posix.DirStream
|
||||||
@@ -146,8 +149,8 @@ execLogged exe spath args lfile chdir env = do
|
|||||||
done <- newEmptyMVar
|
done <- newEmptyMVar
|
||||||
tid <-
|
tid <-
|
||||||
forkIO
|
forkIO
|
||||||
$ EX.handle (\(_ :: StopThread) -> pure ())
|
$ EX.handle (\(e :: StopThread) -> pure ())
|
||||||
$ EX.handle (\(_ :: IOException) -> pure ())
|
$ EX.handle (\(e :: IOException) -> pure ())
|
||||||
$ flip finally (putMVar done ())
|
$ flip finally (putMVar done ())
|
||||||
$ printToRegion fd stdoutRead 6
|
$ printToRegion fd stdoutRead 6
|
||||||
|
|
||||||
@@ -184,33 +187,32 @@ execLogged exe spath args lfile chdir env = do
|
|||||||
ref <- newIORef ([] :: [ByteString])
|
ref <- newIORef ([] :: [ByteString])
|
||||||
displayConsoleRegions $ do
|
displayConsoleRegions $ do
|
||||||
rs <- sequence . replicate size . openConsoleRegion $ Linear
|
rs <- sequence . replicate size . openConsoleRegion $ Linear
|
||||||
flip finally (readTilEOF (lineAction ref rs) fdIn) -- make sure the last few lines don't get cut off
|
EX.handle
|
||||||
$ handle
|
(\(StopThread b) -> do
|
||||||
(\(StopThread b) -> do
|
when b (forM_ rs closeConsoleRegion)
|
||||||
when b (forM_ rs closeConsoleRegion)
|
EX.throw (StopThread b)
|
||||||
EX.throw (StopThread b)
|
)
|
||||||
|
$ readForever
|
||||||
|
(\bs -> do
|
||||||
|
modifyIORef' ref (swapRegs bs)
|
||||||
|
regs <- readIORef ref
|
||||||
|
forM (zip regs rs) $ \(bs, r) -> do
|
||||||
|
setConsoleRegion r $ do
|
||||||
|
w <- consoleWidth
|
||||||
|
return
|
||||||
|
. T.pack
|
||||||
|
. color Blue
|
||||||
|
. T.unpack
|
||||||
|
. E.decodeUtf8
|
||||||
|
. trim w
|
||||||
|
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
|
||||||
|
$ bs
|
||||||
|
SPIB.fdWrite fileFd (bs <> "\n")
|
||||||
)
|
)
|
||||||
$ readForever (lineAction ref rs) fdIn
|
fdIn
|
||||||
|
|
||||||
|
|
||||||
where
|
where
|
||||||
-- action to perform line by line
|
|
||||||
lineAction ref rs bs' = do
|
|
||||||
modifyIORef' ref (swapRegs bs')
|
|
||||||
regs <- readIORef ref
|
|
||||||
forM (zip regs rs) $ \(bs, r) -> do
|
|
||||||
setConsoleRegion r $ do
|
|
||||||
w <- consoleWidth
|
|
||||||
return
|
|
||||||
. T.pack
|
|
||||||
. color Blue
|
|
||||||
. T.unpack
|
|
||||||
. E.decodeUtf8With E.lenientDecode
|
|
||||||
. trim w
|
|
||||||
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
|
|
||||||
$ bs
|
|
||||||
SPIB.fdWrite fileFd (bs <> "\n")
|
|
||||||
|
|
||||||
|
|
||||||
swapRegs bs regs | length regs < size = regs ++ [bs]
|
swapRegs bs regs | length regs < size = regs ++ [bs]
|
||||||
| otherwise = tail regs ++ [bs]
|
| otherwise = tail regs ++ [bs]
|
||||||
|
|
||||||
@@ -220,12 +222,8 @@ execLogged exe spath args lfile chdir env = do
|
|||||||
|
|
||||||
-- read an entire line from the file descriptor (removes the newline char)
|
-- read an entire line from the file descriptor (removes the newline char)
|
||||||
readLine fd' = do
|
readLine fd' = do
|
||||||
bs <-
|
threadWaitRead fd'
|
||||||
handle
|
bs <- SPIB.fdRead fd' 1
|
||||||
(\(e :: IOError) -> do
|
|
||||||
if isEOFError e then threadDelay 1000 >> pure "" else throw e
|
|
||||||
)
|
|
||||||
$ SPIB.fdRead fd' 1
|
|
||||||
if
|
if
|
||||||
| bs == "\n" -> pure ""
|
| bs == "\n" -> pure ""
|
||||||
| bs == "" -> pure ""
|
| bs == "" -> pure ""
|
||||||
@@ -237,10 +235,6 @@ execLogged exe spath args lfile chdir env = do
|
|||||||
then action' bs >> readForever action' fd'
|
then action' bs >> readForever action' fd'
|
||||||
else readForever action' fd'
|
else readForever action' fd'
|
||||||
|
|
||||||
readTilEOF action' fd' = do
|
|
||||||
bs <- readLine fd'
|
|
||||||
when (not $ BS.null bs) (action' bs >> readTilEOF action' fd')
|
|
||||||
|
|
||||||
|
|
||||||
-- | Capture the stdout and stderr of the given action, which
|
-- | Capture the stdout and stderr of the given action, which
|
||||||
-- is run in a subprocess. Stdin is closed. You might want to
|
-- is run in a subprocess. Stdin is closed. You might want to
|
||||||
@@ -248,7 +242,7 @@ execLogged exe spath args lfile chdir env = do
|
|||||||
captureOutStreams :: IO a
|
captureOutStreams :: IO a
|
||||||
-- ^ the action to execute in a subprocess
|
-- ^ the action to execute in a subprocess
|
||||||
-> IO CapturedProcess
|
-> IO CapturedProcess
|
||||||
captureOutStreams action = do
|
captureOutStreams action =
|
||||||
actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
|
actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
|
||||||
actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
|
actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
|
||||||
pid <- SPPB.forkProcess $ do
|
pid <- SPPB.forkProcess $ do
|
||||||
@@ -263,60 +257,23 @@ captureOutStreams action = do
|
|||||||
closeFd parentStderrRead
|
closeFd parentStderrRead
|
||||||
|
|
||||||
-- execute the action
|
-- execute the action
|
||||||
a <- action
|
void $ action
|
||||||
void $ evaluate a
|
|
||||||
|
|
||||||
-- close everything we don't need
|
-- close everything we don't need
|
||||||
closeFd childStdoutWrite
|
closeFd childStdoutWrite
|
||||||
closeFd childStderrWrite
|
closeFd childStderrWrite
|
||||||
|
|
||||||
-- start thread that writes the output
|
SPPB.getProcessStatus True True pid >>= \case
|
||||||
refOut <- newIORef BS.empty
|
|
||||||
refErr <- newIORef BS.empty
|
|
||||||
done <- newEmptyMVar
|
|
||||||
_ <-
|
|
||||||
forkIO
|
|
||||||
$ EX.handle (\(_ :: StopThread) -> pure ())
|
|
||||||
$ EX.handle (\(_ :: IOException) -> pure ())
|
|
||||||
$ flip finally (putMVar done ())
|
|
||||||
$ writeStds parentStdoutRead parentStderrRead refOut refErr
|
|
||||||
|
|
||||||
status <- SPPB.getProcessStatus True True pid
|
|
||||||
takeMVar done
|
|
||||||
|
|
||||||
case status of
|
|
||||||
-- readFd will take care of closing the fd
|
-- readFd will take care of closing the fd
|
||||||
Just (SPPB.Exited es) -> do
|
Just (SPPB.Exited es) -> do
|
||||||
stdout' <- readIORef refOut
|
stdout' <- L.toStrict <$> readFd parentStdoutRead
|
||||||
stderr' <- readIORef refErr
|
stderr' <- L.toStrict <$> readFd parentStderrRead
|
||||||
pure $ CapturedProcess { _exitCode = es
|
pure $ CapturedProcess { _exitCode = es
|
||||||
, _stdOut = stdout'
|
, _stdOut = stdout'
|
||||||
, _stdErr = stderr'
|
, _stdErr = stderr'
|
||||||
}
|
}
|
||||||
|
|
||||||
_ -> throwIO $ userError $ ("No such PID " ++ show pid)
|
_ -> throwIO $ userError $ ("No such PID " ++ show pid)
|
||||||
|
|
||||||
where
|
|
||||||
writeStds pout perr rout rerr = do
|
|
||||||
doneOut <- newEmptyMVar
|
|
||||||
void
|
|
||||||
$ forkIO
|
|
||||||
$ EX.handle (\(_ :: IOException) -> pure ())
|
|
||||||
$ flip finally (putMVar doneOut ())
|
|
||||||
$ readTilEOF (\x -> modifyIORef' rout (<> x)) pout
|
|
||||||
doneErr <- newEmptyMVar
|
|
||||||
void
|
|
||||||
$ forkIO
|
|
||||||
$ EX.handle (\(_ :: IOException) -> pure ())
|
|
||||||
$ flip finally (putMVar doneErr ())
|
|
||||||
$ readTilEOF (\x -> modifyIORef' rerr (<> x)) perr
|
|
||||||
takeMVar doneOut
|
|
||||||
takeMVar doneErr
|
|
||||||
|
|
||||||
readTilEOF action' fd' = do
|
|
||||||
bs <- SPIB.fdRead fd' 512
|
|
||||||
when (not $ BS.null bs) (action' bs >> readTilEOF action' fd')
|
|
||||||
|
|
||||||
|
|
||||||
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
|
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
|
||||||
actionWithPipes a =
|
actionWithPipes a =
|
||||||
|
|||||||
@@ -17,6 +17,7 @@ import Control.Monad.IO.Class
|
|||||||
import Control.Monad.Trans.Class ( lift )
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
|
import Data.Monoid ( (<>) )
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
|
|||||||
@@ -11,9 +11,11 @@ module GHCup.Utils.Version.QQ where
|
|||||||
import Data.Data
|
import Data.Data
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
|
import GHC.Base
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH
|
||||||
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
|
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
|
||||||
import Language.Haskell.TH.Syntax ( Lift
|
import Language.Haskell.TH.Syntax ( Exp(..)
|
||||||
|
, Lift
|
||||||
, dataToExpQ
|
, dataToExpQ
|
||||||
)
|
)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
@@ -31,10 +33,12 @@ deriving instance Data Mess
|
|||||||
deriving instance Lift Mess
|
deriving instance Lift Mess
|
||||||
deriving instance Data PVP
|
deriving instance Data PVP
|
||||||
deriving instance Lift PVP
|
deriving instance Lift PVP
|
||||||
|
deriving instance Lift (NonEmpty Word)
|
||||||
deriving instance Lift VSep
|
deriving instance Lift VSep
|
||||||
deriving instance Data VSep
|
deriving instance Data VSep
|
||||||
deriving instance Lift VUnit
|
deriving instance Lift VUnit
|
||||||
deriving instance Data VUnit
|
deriving instance Data VUnit
|
||||||
|
instance Lift Text
|
||||||
|
|
||||||
qq :: (Text -> Q Exp) -> QuasiQuoter
|
qq :: (Text -> Q Exp) -> QuasiQuoter
|
||||||
qq quoteExp' = QuasiQuoter
|
qq quoteExp' = QuasiQuoter
|
||||||
|
|||||||
@@ -6,11 +6,6 @@ module GHCup.Version where
|
|||||||
import GHCup.Utils.Version.QQ
|
import GHCup.Utils.Version.QQ
|
||||||
|
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import URI.ByteString
|
|
||||||
import URI.ByteString.QQ
|
|
||||||
|
|
||||||
ghcupURL :: URI
|
|
||||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
|
|
||||||
|
|
||||||
ghcUpVer :: PVP
|
ghcUpVer :: PVP
|
||||||
ghcUpVer = [pver|0.0.1|]
|
ghcUpVer = [pver|0.0.0|]
|
||||||
|
|||||||
Reference in New Issue
Block a user