commit a93aaf9a5fc9f2b77e9c947f2303d64eae7ac610 Author: Julian Ospald Date: Sat Jan 11 21:15:05 2020 +0100 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c33954f --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +dist-newstyle/ diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..0d0ff85 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for ghcup + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..31afd6d --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/README.md b/README.md new file mode 100644 index 0000000..255a6bc --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +# ghcup + +A rewrite of ghcup in haskell. + +## TODO + +* create static ghcup binaries + * adjust url in GHCupDownloads +* add print-system-reqs command + +## Motivation + +Maintenance problems: + +* platform incompatibilities regularly causing breaking bugs: + * [Mktemp not working properly on macOS](https://gitlab.haskell.org/haskell/ghcup/issues/130) + * [ln: illegal option -- T on macOS Catalina](https://gitlab.haskell.org/haskell/ghcup/issues/123) + * [Wrong tar flag on darwin](https://gitlab.haskell.org/haskell/ghcup/issues/119)) +* refactoring being difficult due to POSIX sh + +Benefits of a rewrite: + +* Features such as installing [release candidates](https://gitlab.haskell.org/haskell/ghcup/issues/94) or [HEAD builds](https://gitlab.haskell.org/haskell/ghcup/issues/65) can be more conveniently implemented in a rewrite +* Refactoring will be easier +* Better tool support (such as linting the downloads file) +* saner downloads file format (such as JSON) + +Downsides: + +* building static binaries for all platforms (and possibly causing SSL/DNS problems) +* still bootstrapping those binaries via a POSIX sh script + +## Goals + +* Correct low-level code +* Good exception handling +* Cleaner user interface diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/ghcup-gen/GHCupDownloads.hs b/app/ghcup-gen/GHCupDownloads.hs new file mode 100644 index 0000000..32d170e --- /dev/null +++ b/app/ghcup-gen/GHCupDownloads.hs @@ -0,0 +1,1693 @@ +{-# LANGUAGE QuasiQuotes #-} + + +module GHCupDownloads where + +import GHCup.Types +import GHCup.Utils.String.QQ +import GHCup.Utils.Version.QQ + +import HPath +import URI.ByteString.QQ + +import qualified Data.Map as M + + + ------------------ + --[ GHC 7.10.3 ]-- + ------------------ + +ghc_7103_64_cenots67 :: DownloadInfo +ghc_7103_64_cenots67 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-centos67-linux.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|a8957f7a2fd81720c5d3dc403571d77d31115ff5f42edb2917c36d8e714220d4|] + +ghc_7103_32_cenots67 :: DownloadInfo +ghc_7103_32_cenots67 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-i386-centos67-linux.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|c50aa20275e8d1ba9148f380eb7598bc148143281fc17c9acd38ea7b325852bd|] + +ghc_7103_64_deb8 :: DownloadInfo +ghc_7103_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5|] + +ghc_7103_32_deb8 :: DownloadInfo +ghc_7103_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-i386-deb8-linux.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|d2ccf072457fb100503f6f5430a1e3589ca525a97424263d036b0550bc277f0c|] + +ghc_7103_64_darwin :: DownloadInfo +ghc_7103_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-apple-darwin.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|80893e367e8318105f7db2064adf202e3d96b1f014e792b73e92f2cacf0b757a|] + +ghc_7103_64_freebsd :: DownloadInfo +ghc_7103_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-portbld-freebsd.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|2aa396edd2bb651f4bc7eef7a396913ea24923de5aafdc76df6295333e487e48|] + +ghc_7103_32_freebsd :: DownloadInfo +ghc_7103_32_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-i386-portbld-freebsd.tar.bz2|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|3dde05577c6f94dcb0ba201ebd53ab88553bbc9a3aa8e72237162ed7a9d588a3|] + +ghc_7103_64_musl :: DownloadInfo +ghc_7103_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-7.10.3-musl/ghc-7.10.3-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|8b83dfa8b85ba45e24768337254e6eb23c0855df1a5168671a3a8090b6d0964e|] + + + + + ----------------- + --[ GHC 8.0.2 ]-- + ----------------- + + +ghc_802_64_deb7 :: DownloadInfo +ghc_802_64_deb7 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-deb7-linux.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|b2f5c304b57ac5840a0d2ef763a3c6fa858c70840f749cfad12ed227da973c0a|] + +ghc_802_32_deb7 :: DownloadInfo +ghc_802_32_deb7 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-i386-deb7-linux.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|07ead3a49f8c9df4b429e7a2f96f6f31bcab8d3ff8277a9aed0201d13ddad448|] + +ghc_802_64_deb8 :: DownloadInfo +ghc_802_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|5ee68290db00ca0b79d57bc3a5bdce470de9ce9da0b098a7ce6c504605856c8f|] + +ghc_802_32_deb8 :: DownloadInfo +ghc_802_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|818621342a2161b8afcc995a0765816bb40aefbfa1db2c8a7d59c04d8b18228a|] + +ghc_802_64_freebsd :: DownloadInfo +ghc_802_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-portbld-freebsd.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|b36a20e5cae24d70bbb6116ae486f21811e9384f15d3892d260f02fba3e3bb8c|] + +ghc_802_64_darwin :: DownloadInfo +ghc_802_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|ff50a2df9f002f33b9f09717ebf5ec5a47906b9b65cc57b1f9849f8b2e06788d|] + +ghc_802_64_musl :: DownloadInfo +ghc_802_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.0.2-musl/ghc-8.0.2-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|7f9ef3e048ca6f2a2a589e6c168d8c7699fbe32b1b39a9d7c72eff9b26e90c67|] + +ghc_802_32_musl :: DownloadInfo +ghc_802_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.0.2-musl/ghc-8.0.2-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|815c68181013cd3f4dc748ddb5502a5e7a1a4011ba57d8eff6d66da411c72e84|] + + + + + ----------------- + --[ GHC 8.2.2 ]-- + ----------------- + + +ghc_822_64_deb7 :: DownloadInfo +ghc_822_64_deb7 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-deb7-linux.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|cd7afbca54edf9890da9f432c63366556246c85c1198e40c99df5af01c555834|] + +ghc_822_32_deb7 :: DownloadInfo +ghc_822_32_deb7 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-i386-deb7-linux.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|cd18766b1a9b74fc6c90003a719ecab158f281f9a755d8b1bd3fd764ba6947b5|] + +ghc_822_64_deb8 :: DownloadInfo +ghc_822_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|48e205c62b9dc1ccf6739a4bc15a71e56dde2f891a9d786a1b115f0286111b2a|] + +ghc_822_32_deb8 :: DownloadInfo +ghc_822_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|9e67d72d76482e0ba91c718e727b00386a1a12a32ed719714976dc56ca8c8223|] + +ghc_822_64_unknown :: DownloadInfo +ghc_822_64_unknown = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-unknown-linux.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|cd7afbca54edf9890da9f432c63366556246c85c1198e40c99df5af01c555834|] + +ghc_822_64_darwin :: DownloadInfo +ghc_822_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|f90fcf62f7e0936a6dfc3601cf663729bfe9bbf85097d2d75f0a16f8c2e95c27|] + +ghc_822_64_freebsd10 :: DownloadInfo +ghc_822_64_freebsd10 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-portbld10_3-freebsd.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|9e99aaeaec4b2c6d660d80246c0d4dbd41fda88f1eb7a908b29dc8fa8d663949|] + +ghc_822_64_freebsd11 :: DownloadInfo +ghc_822_64_freebsd11 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-portbld11-freebsd.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|cd351c704b92b9af23994024df07de8ca7090ea7675d5c8b14b2be857a46d804|] + + + + + ----------------- + --[ GHC 8.4.1 ]-- + ----------------- + + + +ghc_841_64_deb8 :: DownloadInfo +ghc_841_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|427c77a934b30c3f1de992c38c072afb4323fe6fb30dbac919ca8cb6ae98fbd9|] + +ghc_841_32_deb8 :: DownloadInfo +ghc_841_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|c56c589c76c7ddcb77cdbef885a811761e669d3e76868b723d5be56dedcd4f69|] + +ghc_841_64_fedora :: DownloadInfo +ghc_841_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|89328a013e64b9b56825a9071fea5616ddd623d37fd41e8fb913dfebc609e7ea|] + +ghc_841_64_darwin :: DownloadInfo +ghc_841_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|d774e39f3a0105843efd06709b214ee332c30203e6c5902dd6ed45e36285f9b7|] + +ghc_841_64_freebsd :: DownloadInfo +ghc_841_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-portbld11-freebsd.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|e748daec098445c6190090fe32bb2817a1140553be5acd2188e1af05ad24e5aa|] + +ghc_841_64_musl :: DownloadInfo +ghc_841_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.1-musl/ghc-8.4.1-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|82d4ea6247a91e7e76065c0cdf66eec813ab679c1f24de0fb92c89bba3ef27f2|] + +ghc_841_32_musl :: DownloadInfo +ghc_841_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.1-musl/ghc-8.4.1-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|e5feee34b58c1a1cd6c270fbe696c178a4649675398f4e0d56a4bfad9641b736|] + + + + ----------------- + --[ GHC 8.4.2 ]-- + ----------------- + + + +ghc_842_64_deb8 :: DownloadInfo +ghc_842_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|246f66eb56f4ad0f1c7755502cfc8f9972f2d067dede17e151f6f479c1f76fbd|] + +ghc_842_32_deb8 :: DownloadInfo +ghc_842_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|2d849c30b4c1eac25dc74333501920921e22fa483153f404993808bbda93df05|] + +ghc_842_64_deb9 :: DownloadInfo +ghc_842_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|3f4f5bbd2cdab4e7015ada9196d8d9b3a1ad274293cef011f85c46854596cb57|] + +ghc_842_64_fedora :: DownloadInfo +ghc_842_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|d057b5c833596dbe4ae5d0dc2994f6cc5d0f4c2a21ea1d7900821d165fd4e846|] + +ghc_842_64_darwin :: DownloadInfo +ghc_842_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|87469222042b9ac23f9db216a8d4e5107297bdbbb99df71eb4d9e7208455def2|] + +ghc_842_64_freebsd :: DownloadInfo +ghc_842_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-portbld-freebsd.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|e9ed417fdf94c2ff2c6e344ed16f332bf6b591511f6442c0d9ea94854882b66c|] + +ghc_842_64_musl :: DownloadInfo +ghc_842_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.2-musl/ghc-8.4.2-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|3ebdb6e8001679e8722bd75a47805f1b3c1b25b37c4d237a7aaa4d66162f699f|] + +ghc_842_32_musl :: DownloadInfo +ghc_842_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.2-musl/ghc-8.4.2-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|a43ac57214764717f0ffe515ef47b84e938f0a4fa8ff875773d6ba315b940835|] + + + + ----------------- + --[ GHC 8.4.3 ]-- + ----------------- + + +ghc_843_64_deb8 :: DownloadInfo +ghc_843_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|30a402c6d4754a6c020e0547f19ae3ac42e907e35349aa932d347f73e421a8e2|] + +ghc_843_32_deb8 :: DownloadInfo +ghc_843_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|f5763983a26dedd88b65a0b17267359a3981b83a642569b26334423f684f8b8c|] + +ghc_843_64_deb9 :: DownloadInfo +ghc_843_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|2e4f53afb872ad9c640f31aea283b3ff4c5028b65808a1920739900aef7d15c9|] + +ghc_843_64_fedora :: DownloadInfo +ghc_843_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|269e7a4d3f336491b88409a020998122b30a3a729af78d33be86d3b3f8000c3e|] + +ghc_843_64_darwin :: DownloadInfo +ghc_843_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|af0b455f6c46b9802b4b48dad996619cfa27cc6e2bf2ce5532387b4a8c00aa64|] + +ghc_843_64_musl :: DownloadInfo +ghc_843_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.3-musl/ghc-8.4.3-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|0f05c67e3fd29a3f505abb77e9c39349d312cdc1a566263b8f4b227d085906bc|] + +ghc_843_32_musl :: DownloadInfo +ghc_843_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.3-musl/ghc-8.4.3-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|3a9a1ceb8eef234023fc36600245a03772bcb46b2abac41f6394104feaec8c43|] + + + + + ----------------- + --[ GHC 8.4.4 ]-- + ----------------- + + +ghc_844_64_deb8 :: DownloadInfo +ghc_844_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|4c2a8857f76b7f3e34ecba0b51015d5cb8b767fe5377a7ec477abde10705ab1a|] + +ghc_844_32_deb8 :: DownloadInfo +ghc_844_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|678bafaabea6af70ba71ccf0210bb437f9f5591ec28ac1cbbbd5f7aa6894e450|] + +ghc_844_64_deb9 :: DownloadInfo +ghc_844_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|47c80a32d8f02838a2401414c94ba260d1fe82b7d090479994522242c767cc83|] + +ghc_844_64_centos :: DownloadInfo +ghc_844_64_centos = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-centos70-linux.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|83a96650f5a92b1e4d7651d256d6438624342d40e780e68125033435a54cd674|] + +ghc_844_64_fedora :: DownloadInfo +ghc_844_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|8ab2befddc14d1434d0aad0c5d3c7e0c2b78ff84caa3429fa62527bfc6b86095|] + +ghc_844_64_darwin :: DownloadInfo +ghc_844_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|28dc89ebd231335337c656f4c5ead2ae2a1acc166aafe74a14f084393c5ef03a|] + +ghc_844_64_freebsd :: DownloadInfo +ghc_844_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-portbld-freebsd11.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|44fbd142d1c355d6110595c59c760e2c73866ff9259ec85ebf814edb244d1940|] + +ghc_844_64_musl :: DownloadInfo +ghc_844_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.4-musl/ghc-8.4.4-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|e15f1cf02adb2cfb77a202050300a92f61456c6e1e90b543fec82d99da893a69|] + +ghc_844_32_musl :: DownloadInfo +ghc_844_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.4.4-musl/ghc-8.4.4-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|356f49b1acee0b0267fd8ca687aede14d43cee1f231d7f8a37525d50f07e1428|] + + + + ----------------- + --[ GHC 8.6.1 ]-- + ----------------- + + +ghc_861_64_deb8 :: DownloadInfo +ghc_861_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|6d8784401b7dd80c90fa17306ec0539920e3987399a2c7ef247989e53197dc42|] + +ghc_861_32_deb8 :: DownloadInfo +ghc_861_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|83573af96e3dec8f67c1a844512f92cbf7d51ae7ceca53d948fc2a3300abd05c|] + +ghc_861_64_deb9 :: DownloadInfo +ghc_861_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|97d44f303868d74e4d13a2e99c82ffce3d25fd54c704675e5a1939e0d824dbf0|] + +ghc_861_64_fedora :: DownloadInfo +ghc_861_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|da903fbcf11ee6c977a8b7dac3f04dbc098d674def587880b6624b8f32588beb|] + +ghc_861_64_darwin :: DownloadInfo +ghc_861_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|9692cdfd202b0e039ea0c3dde5dbf653736c836ca1df46504b179b572100808c|] + +ghc_861_64_freebsd :: DownloadInfo +ghc_861_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-portbld-freebsd.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|51403b054a3a649039ac988e1d1112561f96750bfced63df864091a3fab36f08|] + +ghc_861_64_musl :: DownloadInfo +ghc_861_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.1-musl/ghc-8.6.1-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|2668e12facfa9083150b01b1137693cb3de266a6f8ac8c6b44a2be3826c73177|] + +ghc_861_32_musl :: DownloadInfo +ghc_861_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.1-musl/ghc-8.6.1-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|12b9b5b78be94b57d301b2a31eda145928110fd103fbbcc1e6e6966237a30ed2|] + + + + ----------------- + --[ GHC 8.6.2 ]-- + ----------------- + + +ghc_862_64_deb8 :: DownloadInfo +ghc_862_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|13f96e8b83bb5bb60f955786ff9085744c24927a33be8a17773f84c7c248533a|] + +ghc_862_32_deb8 :: DownloadInfo +ghc_862_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|a288026d9ef22f7ac387edab6b29ef7dcb3b28945c8ea532a15c1fa35d4733ed|] + +ghc_862_64_fedora :: DownloadInfo +ghc_862_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|702aa5dfa1639c37953ceb7571a5057d9fb0562aecb197b277953a037d78047d|] + +ghc_862_64_darwin :: DownloadInfo +ghc_862_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|8ec46a25872226dd7e5cf7271e3f3450c05f32144b96e6b9cb44cc4079db50dc|] + +ghc_862_64_musl :: DownloadInfo +ghc_862_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.2-musl/ghc-8.6.2-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|5be9f98c25c49dbfb65223e2642335d4a45220f0c4044c8af70bbcaebe688467|] + +ghc_862_32_musl :: DownloadInfo +ghc_862_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.2-musl/ghc-8.6.2-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|a1add75822258fbb6e57ad049919ef5f757bac10d3c7a6eaeee50d2521ffeb4e|] + + + + + ----------------- + --[ GHC 8.6.3 ]-- + ----------------- + + +ghc_863_64_deb8 :: DownloadInfo +ghc_863_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|291ca565374f4d51cc311488581f3279d3167a064fabfd4a6722fe2bd4532fd5|] + +ghc_863_32_deb8 :: DownloadInfo +ghc_863_32_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-i386-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|b57070ba8c70b1333a3e47ce124baf791be39c20a592954772532fd6dd51882f|] + +ghc_863_64_deb9 :: DownloadInfo +ghc_863_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|e7954c8ed9b422a09c6ab737e4a0865a2725d034ba0e272bd5c70db910797f99|] + +ghc_863_64_fedora :: DownloadInfo +ghc_863_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|52ae92f4e8bb2ac0b7847287ea3da37081f5f7bf8bbb7c78ac35fde537d1a89f|] + +ghc_863_64_centos :: DownloadInfo +ghc_863_64_centos = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-centos7-linux.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|355bd85c69933c31bbe99b4269ce719acfd0aad0b45e359ac39b9bb13996acc6|] + +ghc_863_64_darwin :: DownloadInfo +ghc_863_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|79d069a1a7d74cfdd7ac2a2711c45d3ddc6265b988a0cefa342714b24f997fc1|] + +ghc_863_64_freebsd :: DownloadInfo +ghc_863_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-portbld-freebsd.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|bc2419fa180f8a7808c49775987866435995df9bdd9ce08bcd38352d63ba6031|] + +ghc_863_64_musl :: DownloadInfo +ghc_863_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.3-musl/ghc-8.6.3-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|274f7ea959e6f1c830b33efd462ab9d0ff32d1cb5be051a2a318464d05d674dd|] + +ghc_863_32_musl :: DownloadInfo +ghc_863_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.3-musl/ghc-8.6.3-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|dc0b53a7f0e52232930abcfad427ccd0917c90797203fbc7b5d72f5335d85a7d|] + + + + + ----------------- + --[ GHC 8.6.4 ]-- + ----------------- + + +ghc_864_64_deb8 :: DownloadInfo +ghc_864_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|34ef5fc8ddf2fc32a027180bea5b1c8a81ea840c87faace2977a572188d4b42d|] + +ghc_864_64_deb9 :: DownloadInfo +ghc_864_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|ef74222ef3c01c3fc5b926f67e8b4ef612fe8efa40ac937317cff9b0eed8d863|] + +ghc_864_32_deb9 :: DownloadInfo +ghc_864_32_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-i386-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|5e2ce88f4d13d23ac37e278e0c7b51c801008931359b9fa8a631d804d2da552c|] + +ghc_864_64_fedora :: DownloadInfo +ghc_864_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|e0b1ada7a679d6c35f9d7a1192ed35fde054f3650bb0bd2570d103729ad3b846|] + +ghc_864_64_darwin :: DownloadInfo +ghc_864_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|cccb58f142fe41b601d73690809f6089f7715b6a50a09aa3d0104176ab4db09e|] + +ghc_864_64_musl :: DownloadInfo +ghc_864_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.4-musl/ghc-8.6.4-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|ec73167bae1a173a9af07612df5fa1289e924f13ed9241339cb5617337cb2979|] + +ghc_864_32_musl :: DownloadInfo +ghc_864_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.4-musl/ghc-8.6.4-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|21b39b89edadbb6ab5b98d46dfacc0fd0799f9b16465a05c64e48f41dcbb1f7a|] + + + + ----------------- + --[ GHC 8.6.5 ]-- + ----------------- + + + +ghc_865_64_deb8 :: DownloadInfo +ghc_865_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|c419fd0aa9065fe4d2eb9a248e323860c696ddf3859749ca96a84938aee49107|] + +ghc_865_64_deb9 :: DownloadInfo +ghc_865_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|bc75f5601a9f41d58b2ba161b9e28fad52143a7229060f1e084168d9b2e914df|] + +ghc_865_32_deb9 :: DownloadInfo +ghc_865_32_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-i386-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|1cddb907393a669342b1a922dd16d505d9d93d50bd9433a54a8162f8701250dc|] + +ghc_865_64_fedora :: DownloadInfo +ghc_865_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|cf78b53eaf336083e7a05f4a3000afbae4abe5bbc77ef80cc40e09d04ac5b4a1|] + +ghc_865_64_centos :: DownloadInfo +ghc_865_64_centos = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-centos7-linux.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|80ab566f4411299f9e5922d60749ca80f989d697db19e03ed875619d699f0edf|] + +ghc_865_64_darwin :: DownloadInfo +ghc_865_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|dfc1bdb1d303a87a8552aa17f5b080e61351f2823c2b99071ec23d0837422169|] + +ghc_865_64_musl :: DownloadInfo +ghc_865_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.5-musl/ghc-8.6.5-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|ec6d0417822c3bfafc7aea0b0402294901231bc5d72dd17a2b849e3f44850695|] + +ghc_865_32_musl :: DownloadInfo +ghc_865_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.5-musl/ghc-8.6.5-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|db13ff894faf431f9c64db21c090a1e4e42803794d56720a704c50166c7ca05d|] + + + + ----------------- + --[ GHC 8.8.1 ]-- + ----------------- + + + +ghc_881_64_deb8 :: DownloadInfo +ghc_881_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|fd96eb851971fbc3332bf2fa7821732cfa8b37e5a076a69f6a06f83f0ea7ccc5|] + +ghc_881_64_deb9 :: DownloadInfo +ghc_881_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|620fd560535b63cac5f8c97354ccddf93fa940cca78e2d19f6f98b7e67c6a723|] + +ghc_881_32_deb9 :: DownloadInfo +ghc_881_32_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-i386-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|3d3bb75aff2dd79ec87ace10483368681fbc328ff00ebf15edad33420f00f7f5|] + +ghc_881_64_fedora :: DownloadInfo +ghc_881_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|851a78df620bc056c34b252c97040d5755e294993fa8afa5429708b5229204d6|] + +ghc_881_64_centos :: DownloadInfo +ghc_881_64_centos = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-centos7-linux.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|6cdd34e4dbaeb801e805811f91cf43a2d5f64b22f884718ffbd3542a2f4dd14f|] + +ghc_881_64_darwin :: DownloadInfo +ghc_881_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|38c8917b47c31bedf58c9305dfca3abe198d8d35570366f0773c4e2948bd8abe|] + +ghc_881_64_musl :: DownloadInfo +ghc_881_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.1-musl/ghc-8.8.1-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|029163c42a219983f4220d73c26b910c3ecf6eda45a3e5e27236e8a66b080890|] + +ghc_881_32_musl :: DownloadInfo +ghc_881_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.1-musl/ghc-8.8.1-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|3f5462341a455a5677fba5cb24da8938878261069da5ee4234b1c6ac2d2ef77e|] + + + + ----------------- + --[ GHC 8.8.2 ]-- + ----------------- + + + +ghc_882_64_deb8 :: DownloadInfo +ghc_882_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|fbe69652eba75dadb758d00292247d17fb018c29cac5acd79843e56311256c9f|] + +ghc_882_64_deb9 :: DownloadInfo +ghc_882_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|7b2d66c2d5d8c15750da5833d3018634a5eb792a5662282e3abfeb112c2a1cc3|] + +ghc_882_32_deb9 :: DownloadInfo +ghc_882_32_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-i386-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|ad1c628082c32635a436905a7ff83eaa4246347d869be5ef6b33c3bf85e8f00c|] + +ghc_882_64_fedora :: DownloadInfo +ghc_882_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|dbe2db717b33460f790e155e487d2a31c9b21a9d245f0c9490ad65844c3ea21f|] + +ghc_882_64_centos :: DownloadInfo +ghc_882_64_centos = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-centos7-linux.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|f065a017d7a38f235f186ffe32d8261a4fd39c7e945d5cde85c0984c2569db99|] + +ghc_882_64_darwin :: DownloadInfo +ghc_882_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|25c5c1a70036abf3f22b2b19c10d26adfdb08e8f8574f89d4b2042de5947f990|] + +ghc_882_64_musl :: DownloadInfo +ghc_882_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.2-musl/ghc-8.8.2-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|09d49c75b5626606409c982b23f70dec241a944928243f32d1b59b2005de6dea|] + +ghc_882_32_musl :: DownloadInfo +ghc_882_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.2-musl/ghc-8.8.2-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|4ea4a81b6b5ba807c93b21b3cddf1f1b4b0fc1ce018cf6aa255a9ee40137b278|] + + + + ----------------- + --[ GHC 8.8.3 ]-- + ----------------- + + + +ghc_883_64_deb8 :: DownloadInfo +ghc_883_64_deb8 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-deb8-linux.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|92b9fadc442976968d2c190c14e000d737240a7d721581cda8d8741b7bd402f0|] + +ghc_883_64_deb9 :: DownloadInfo +ghc_883_64_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|42fde2ef5a143e1e6b47ae8875162ea2d4d54b06f0f7fa32ee4f0eb86f2be7ad|] + +ghc_883_32_deb9 :: DownloadInfo +ghc_883_32_deb9 = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-i386-deb9-linux.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|441e2c7a4fc83ebf179712bd939b555cda7c6633545b7c8ac38049f9d85003ae|] + +ghc_883_64_fedora :: DownloadInfo +ghc_883_64_fedora = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-fedora27-linux.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|45ee1de3bfc98cbcc4886b65fc7651ade2d3820aa85eac2dbe9bc7bf91e7c818|] + +ghc_883_64_centos :: DownloadInfo +ghc_883_64_centos = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-centos7-linux.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|4b2b5313f7c12b81e54efcb26705fa9e4ad5b98f2b58bfc76fb0c9ba1d55eb1f|] + +ghc_883_64_darwin :: DownloadInfo +ghc_883_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-apple-darwin.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|7016de90dd226b06fc79d0759c5d4c83c2ab01d8c678905442c28bd948dbb782|] + +ghc_883_64_musl :: DownloadInfo +ghc_883_64_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.3-musl/ghc-8.8.3-x86_64-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|77a990d76dc10abe2ed19e5fcfef4095f0e9819d4ab84bec6d82f00dd85812a7|] + +ghc_883_32_musl :: DownloadInfo +ghc_883_32_musl = DownloadInfo + [uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.3-musl/ghc-8.8.3-i386-unknown-linux-musl.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec|] + + + + + --------------------- + --[ Cabal-2.4.1.0 ]-- + --------------------- + + +cabal_2410_32_linux :: DownloadInfo +cabal_2410_32_linux = DownloadInfo + [uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-i386-unknown-linux.tar.xz|] + Nothing + [s|b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198|] + +cabal_2410_64_linux :: DownloadInfo +cabal_2410_64_linux = DownloadInfo + [uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-linux.tar.xz|] + Nothing + [s|6136c189ffccaa39916f9cb5788f757166444a2d0c473b987856a79ecbf0c714|] + +cabal_2410_64_darwin :: DownloadInfo +cabal_2410_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz|] + Nothing + [s|56361cf4b0d920fe23174751fea1fb82a8e1ce522bd9706a3fbe47a72e458c9c|] + +cabal_2410_64_alpine :: DownloadInfo +cabal_2410_64_alpine = DownloadInfo + [uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-alpine-linux-musl.tar.xz|] + Nothing + [s|720bef015f834a03deb7180be2952a44e7c2e6c8429137570404c3de4f46b984|] + +cabal_2410_64_freebsd :: DownloadInfo +cabal_2410_64_freebsd = DownloadInfo + [uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-portbld-freebsd.tar.xz|] + Nothing + [s|33b7d37ea0688c93436eac9ec139d9967687875aa1fa13f2bb73bf05a9a59a1d|] + + + + + --------------------- + --[ Cabal-3.0.0.0 ]-- + --------------------- + + +cabal_3000_32_linux :: DownloadInfo +cabal_3000_32_linux = DownloadInfo + [uri|https://downloads.haskell.org/cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-unknown-linux.tar.xz|] + Nothing + [s|6898ccd6e6dc0872999c06daaf61d546164e12f60a1880d09852c9f0c59c5cf6|] + +cabal_3000_64_linux :: DownloadInfo +cabal_3000_64_linux = DownloadInfo + [uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-unknown-linux.tar.xz|] + Nothing + [s|ee911ba67a70756eedeac662955b896d7e89432a99372aa45d2c6e71fa95a5e4|] + +cabal_3000_64_darwin :: DownloadInfo +cabal_3000_64_darwin = DownloadInfo + [uri|https://downloads.haskell.org/cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-apple-darwin17.7.0.tar.xz|] + Nothing + [s|d4857e068560515e4cbb0e8ca124c370e07892f2a28804d87152834e5fe2b845|] + + + + ------------- + --[ GHCup ]-- + ------------- + + +ghcup_010_64_linux :: DownloadInfo +ghcup_010_64_linux = DownloadInfo + [uri|file:///home/maerwald/tmp/ghcup-exe|] + Nothing + [s|558126339252788a3d44a3f910417277c7ab656f0796b68bdc58afe73296b8cd|] + + + + + ----------------------- + --[ Tarball mapping ]-- + ----------------------- + + +ghcupDownloads :: GHCupDownloads +ghcupDownloads = M.fromList + [ ( GHC + , M.fromList + [ ( [vver|7.10.3|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz|] + (Just ([rel|ghc-7.10.3|] :: Path Rel)) + [s|cf90cedce1c28fd0e2b9e72fe8a938756668d18ea1fcc884a19f698658ac4fef|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_7103_64_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_7103_64_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_7103_64_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_7103_64_deb8)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_7103_64_cenots67)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_7103_64_cenots67)] + ) + , (Darwin , M.fromList [(Nothing, ghc_7103_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_7103_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_7103_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_7103_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_7103_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_7103_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_7103_32_deb8)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_7103_32_cenots67)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_7103_32_cenots67)] + ) + , (FreeBSD, M.fromList [(Nothing, ghc_7103_32_freebsd)]) + ] + ) + ] + ) + , ( [vver|8.0.2|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz|] + (Just ([rel|ghc-8.0.2|] :: Path Rel)) + [s|11625453e1d0686b3fa6739988f70ecac836cadc30b9f0c8b49ef9091d6118b1|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_802_64_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_802_64_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_802_64_deb8)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_802_64_deb8) + , (Just [vers|7|], ghc_802_64_deb7) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_802_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_802_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_802_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_802_32_deb8)] + ) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_802_32_deb8) + , (Just [vers|7|], ghc_802_32_deb7) + ] + ) + , (Linux Alpine, M.fromList [(Nothing, ghc_802_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.2.2|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz|] + (Just ([rel|ghc-8.2.2|] :: Path Rel)) + [s|bb8ec3634aa132d09faa270bbd604b82dfa61f04855655af6f9d14a9eedc05fc|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_822_64_unknown)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_822_64_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_822_64_deb8)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_822_64_deb8) + , (Just [vers|7|], ghc_822_64_deb7) + ] + ) + , (Darwin, M.fromList [(Nothing, ghc_822_64_darwin)]) + , ( FreeBSD + , M.fromList + [ (Nothing , ghc_822_64_freebsd11) + , (Just [vers|10|], ghc_822_64_freebsd10) + , (Just [vers|11|], ghc_822_64_freebsd11) + ] + ) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_822_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_822_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_822_32_deb8)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_822_32_deb8) + , (Just [vers|7|], ghc_822_32_deb7) + ] + ) + ] + ) + ] + ) + , ( [vver|8.4.1|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz|] + (Just ([rel|ghc-8.4.1|] :: Path Rel)) + [s|39ae2f25192408f355693e5a3c8b6ff613ddb7c4da998fdf26210143a61839d2|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_841_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_841_64_fedora)]) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_841_64_fedora)]) + , (Linux Mint , M.fromList [(Nothing, ghc_841_64_fedora)]) + , (Linux Debian, M.fromList [(Nothing, ghc_841_64_deb8)]) + , (Darwin , M.fromList [(Nothing, ghc_841_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_841_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_841_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_841_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_841_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_841_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_841_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_841_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.4.2|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz|] + (Just ([rel|ghc-8.4.2|] :: Path Rel)) + [s|01cc32f24a06bf3b2428351b6d7fec791e82d042426d29ad9e5a245b35f0047b|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_842_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_842_64_fedora)]) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_842_64_fedora) + , (Just [vers|16.04|], ghc_842_64_deb9) + , (Just [vers|18.04|], ghc_842_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_842_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_842_64_deb9) + , (Just [vers|8|], ghc_842_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_842_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_842_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_842_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_842_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_842_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_842_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_842_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_842_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.4.3|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz|] + (Just ([rel|ghc-8.4.3|] :: Path Rel)) + [s|ae47afda985830de8811243255aa3744dfb9207cb980af74393298b2b62160d6|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_843_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_843_64_fedora)]) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_843_64_fedora) + , (Just [vers|16.04|], ghc_843_64_deb9) + , (Just [vers|18.04|], ghc_843_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_843_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_843_64_deb9) + , (Just [vers|8|], ghc_843_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_843_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_843_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_843_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_843_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_843_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_843_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_843_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.4.4|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz|] + (Just ([rel|ghc-8.4.4|] :: Path Rel)) + [s|11117735a58e507c481c09f3f39ae5a314e9fbf49fc3109528f99ea7959004b2|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_844_64_fedora)] + ) + , (Linux CentOS, M.fromList [(Nothing, ghc_844_64_centos)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_844_64_centos)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_844_64_fedora)]) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_844_64_fedora) + , (Just [vers|16.04|], ghc_844_64_deb9) + , (Just [vers|18.04|], ghc_844_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_844_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_844_64_deb9) + , (Just [vers|8|], ghc_844_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_844_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_844_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_844_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_844_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_844_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_844_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_844_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_844_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.6.1|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz|] + (Just ([rel|ghc-8.6.1|] :: Path Rel)) + [s|2c25c26d1e5c47c7cbb2a1d8e6456524033e7a71409184dd3125e3fc5a3c7036|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_861_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_861_64_fedora)]) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_861_64_fedora) + , (Just [vers|16.04|], ghc_861_64_deb9) + , (Just [vers|18.04|], ghc_861_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_861_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_861_64_deb9) + , (Just [vers|8|], ghc_861_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_861_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_861_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_861_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_861_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_861_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_861_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_861_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_861_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.6.2|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz|] + (Just ([rel|ghc-8.6.2|] :: Path Rel)) + [s|caaa819d21280ecde90a4773143dee188711e9ff175a27cfbaee56eb851d76d5|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_862_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_862_64_fedora)]) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_862_64_fedora) + , (Just [vers|16.04|], ghc_862_64_deb8) + , (Just [vers|18.04|], ghc_862_64_deb8) + ] + ) + , (Linux Mint , M.fromList [(Nothing, ghc_862_64_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_862_64_deb8)]) + , (Darwin , M.fromList [(Nothing, ghc_862_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_862_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_862_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_862_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_862_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_862_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_862_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.6.3|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz|] + (Just ([rel|ghc-8.6.3|] :: Path Rel)) + [s|9f9e37b7971935d88ba80426c36af14b1e0b3ec1d9c860f44a4391771bc07f23|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_863_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_863_64_fedora)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_863_64_centos)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_863_64_centos)] + ) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_863_64_fedora) + , (Just [vers|16.04|], ghc_863_64_deb9) + , (Just [vers|18.04|], ghc_863_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_863_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_863_64_deb9) + , (Just [vers|8|], ghc_863_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_863_64_darwin)]) + , (FreeBSD , M.fromList [(Nothing, ghc_863_64_freebsd)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_863_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_863_32_deb8)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_863_32_deb8)]) + , (Linux Mint , M.fromList [(Nothing, ghc_863_32_deb8)]) + , (Linux Debian, M.fromList [(Nothing, ghc_863_32_deb8)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_863_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.6.4|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz|] + (Just ([rel|ghc-8.6.4|] :: Path Rel)) + [s|5b5d07e4463203a433c3ed3df461ba6cce11b6d2b9b264db31f3429075d0303a|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_864_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_864_64_fedora)]) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_864_64_fedora) + , (Just [vers|16.04|], ghc_864_64_deb9) + , (Just [vers|18.04|], ghc_864_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_864_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_864_64_deb9) + , (Just [vers|8|], ghc_864_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_864_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_864_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_864_32_deb9)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_864_32_deb9)]) + , (Linux Mint , M.fromList [(Nothing, ghc_864_32_deb9)]) + , (Linux Debian, M.fromList [(Nothing, ghc_864_32_deb9)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_864_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.6.5|] + , VersionInfo + [Recommended] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|] + (Just ([rel|ghc-8.6.5|] :: Path Rel)) + [s|4d4aa1e96f4001b934ac6193ab09af5d6172f41f5a5d39d8e43393b9aafee361|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_865_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_865_64_fedora)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_865_64_centos)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_865_64_centos)] + ) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_865_64_fedora) + , (Just [vers|16.04|], ghc_865_64_deb9) + , (Just [vers|18.04|], ghc_865_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_865_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_865_64_deb9) + , (Just [vers|8|], ghc_865_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_865_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_865_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_865_32_deb9)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_865_32_deb9)]) + , (Linux Mint , M.fromList [(Nothing, ghc_865_32_deb9)]) + , (Linux Debian, M.fromList [(Nothing, ghc_865_32_deb9)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_865_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.8.1|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz|] + (Just ([rel|ghc-8.8.1|] :: Path Rel)) + [s|908a83d9b814da74585de9d39687189e6260ec3848131f9d9236cab8a123721a|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_881_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_881_64_fedora)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_881_64_centos)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_881_64_centos)] + ) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_881_64_fedora) + , (Just [vers|16.04|], ghc_881_64_deb9) + , (Just [vers|18.04|], ghc_881_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_881_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_881_64_deb9) + , (Just [vers|8|], ghc_881_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_881_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_881_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_881_32_deb9)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_881_32_deb9)]) + , (Linux Mint , M.fromList [(Nothing, ghc_881_32_deb9)]) + , (Linux Debian, M.fromList [(Nothing, ghc_881_32_deb9)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_881_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.8.2|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz|] + (Just ([rel|ghc-8.8.2|] :: Path Rel)) + [s|01cea54d90686b97bcc9960b108beaffccd4336dee930dcf9beaf52b1f370a0b|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_882_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_882_64_fedora)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_882_64_centos)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_882_64_centos)] + ) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_882_64_fedora) + , (Just [vers|16.04|], ghc_882_64_deb9) + , (Just [vers|18.04|], ghc_882_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_882_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_882_64_deb9) + , (Just [vers|8|], ghc_882_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_882_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_882_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_882_32_deb9)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_882_32_deb9)]) + , (Linux Mint , M.fromList [(Nothing, ghc_882_32_deb9)]) + , (Linux Debian, M.fromList [(Nothing, ghc_882_32_deb9)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_882_32_musl)]) + ] + ) + ] + ) + , ( [vver|8.8.3|] + , VersionInfo + [Latest] + (Just $ DownloadInfo + [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz|] + (Just ([rel|ghc-8.8.3|] :: Path Rel)) + [s|e0dcc0aaf3e234c5978f29e6df62947e97720ab404ec0158343df211c5480f89|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_883_64_fedora)] + ) + , (Linux Fedora, M.fromList [(Nothing, ghc_883_64_fedora)]) + , (Linux CentOS, M.fromList [(Nothing, ghc_883_64_centos)]) + , ( Linux AmazonLinux + , M.fromList [(Nothing, ghc_883_64_centos)] + ) + , ( Linux Ubuntu + , M.fromList + [ (Nothing , ghc_883_64_fedora) + , (Just [vers|16.04|], ghc_883_64_deb9) + , (Just [vers|18.04|], ghc_883_64_deb9) + ] + ) + , (Linux Mint, M.fromList [(Nothing, ghc_883_64_deb9)]) + , ( Linux Debian + , M.fromList + [ (Nothing , ghc_883_64_deb9) + , (Just [vers|8|], ghc_883_64_deb8) + ] + ) + , (Darwin , M.fromList [(Nothing, ghc_883_64_darwin)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_883_64_musl)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, ghc_883_32_deb9)] + ) + , (Linux Ubuntu, M.fromList [(Nothing, ghc_883_32_deb9)]) + , (Linux Mint , M.fromList [(Nothing, ghc_883_32_deb9)]) + , (Linux Debian, M.fromList [(Nothing, ghc_883_32_deb9)]) + , (Linux Alpine, M.fromList [(Nothing, ghc_883_32_musl)]) + ] + ) + ] + ) + ] + ) + , ( Cabal + , M.fromList + [ ( [vver|2.4.1.0|] + , VersionInfo + [] + (Just $ DownloadInfo + [uri|https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz|] + (Just [rel|cabal-cabal-install-v2.4.1.0/cabal-install|]) + [s|61eb64a5addafca026aff9277291f4643fe07e83886f76d059d42c734fed829c|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, cabal_2410_64_linux)] + ) + , (Linux Alpine, M.fromList [(Nothing, cabal_2410_64_alpine)]) + , (Darwin , M.fromList [(Nothing, cabal_2410_64_darwin)]) + , (FreeBSD, M.fromList [(Nothing, cabal_2410_64_freebsd)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, cabal_2410_32_linux)] + ) + ] + ) + ] + ) + , ( [vver|3.0.0.0|] + , VersionInfo + [Recommended, Latest] + (Just $ DownloadInfo + [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|]) + [s|c0b26817a7b7c2907e45cb38235ce1157e732211880f62e92eaff4066202e674|] + ) + $ M.fromList + [ ( A_64 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, cabal_3000_64_linux)] + ) + , (Darwin, M.fromList [(Nothing, cabal_3000_64_darwin)]) + ] + ) + , ( A_32 + , M.fromList + [ ( Linux UnknownLinux + , M.fromList [(Nothing, cabal_3000_32_linux)] + ) + ] + ) + ] + ) + ] + ) + , ( GHCup + , M.fromList + [ ( [vver|0.1.0|] + , VersionInfo [Recommended, Latest] Nothing $ M.fromList + [ ( A_64 + , M.fromList + [(Linux UnknownLinux, M.fromList [(Nothing, ghcup_010_64_linux)])] + ) + ] + ) + ] + ) + ] diff --git a/app/ghcup-gen/Main.hs b/app/ghcup-gen/Main.hs new file mode 100644 index 0000000..feab6ec --- /dev/null +++ b/app/ghcup-gen/Main.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DuplicateRecordFields #-} + + +module Main where + +import GHCup.Types.JSON ( ) +import GHCup.Utils.Logger +import GHCupDownloads + +import Data.Aeson ( eitherDecode ) +import Data.Aeson.Encode.Pretty +import Data.Semigroup ( (<>) ) +import Options.Applicative hiding ( style ) +import System.Console.Pretty +import System.Exit +import System.IO ( stdout ) +import Validate + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + + +data Options = Options + { optCommand :: Command + } + +data Command = GenJSON GenJSONOpts + | ValidateJSON ValidateJSONOpts + | ValidateTarballs ValidateJSONOpts + +data Output + = FileOutput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway + | StdOutput + +fileOutput :: Parser Output +fileOutput = + FileOutput + <$> (strOption + (long "file" <> short 'f' <> metavar "FILENAME" <> help + "Output to a file" + ) + ) + +stdOutput :: Parser Output +stdOutput = flag' + StdOutput + (short 'o' <> long "stdout" <> help "Print to stdout (default)") + +outputP :: Parser Output +outputP = fileOutput <|> stdOutput + + +data GenJSONOpts = GenJSONOpts + { output :: Maybe Output + } + +genJSONOpts :: Parser GenJSONOpts +genJSONOpts = GenJSONOpts <$> optional outputP + + +data Input + = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway + | StdInput + +fileInput :: Parser Input +fileInput = + FileInput + <$> (strOption + (long "file" <> short 'f' <> metavar "FILENAME" <> help + "Input file to validate" + ) + ) + +stdInput :: Parser Input +stdInput = flag' + StdInput + (short 'i' <> long "stdin" <> help "Validate from stdin (default)") + +inputP :: Parser Input +inputP = fileInput <|> stdInput + +data ValidateJSONOpts = ValidateJSONOpts + { input :: Maybe Input + } + +validateJSONOpts :: Parser ValidateJSONOpts +validateJSONOpts = ValidateJSONOpts <$> optional inputP + +opts :: Parser Options +opts = Options <$> com + +com :: Parser Command +com = subparser + ( (command + "gen" + ( GenJSON + <$> (info (genJSONOpts <**> helper) + (progDesc "Generate the json downloads file") + ) + ) + ) + <> (command + "check" + ( ValidateJSON + <$> (info (validateJSONOpts <**> helper) + (progDesc "Validate the JSON") + ) + ) + ) + <> (command + "check-tarballs" + ( ValidateTarballs + <$> (info + (validateJSONOpts <**> helper) + (progDesc "Validate all tarballs (download and checksum)") + ) + ) + ) + ) + + + +main :: IO () +main = do + customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) + >>= \Options {..} -> case optCommand of + GenJSON gopts -> do + let + bs = encodePretty' (defConfig { confIndent = Spaces 2 }) + ghcupDownloads + case gopts of + GenJSONOpts { output = Nothing } -> L.hPutStr stdout bs + GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs + GenJSONOpts { output = Just (FileOutput file) } -> + L.writeFile file bs + ValidateJSON vopts -> case vopts of + ValidateJSONOpts { input = Nothing } -> + L.getContents >>= valAndExit validate + ValidateJSONOpts { input = Just StdInput } -> + L.getContents >>= valAndExit validate + ValidateJSONOpts { input = Just (FileInput file) } -> + L.readFile file >>= valAndExit validate + ValidateTarballs vopts -> case vopts of + ValidateJSONOpts { input = Nothing } -> + L.getContents >>= valAndExit validateTarballs + ValidateJSONOpts { input = Just StdInput } -> + L.getContents >>= valAndExit validateTarballs + ValidateJSONOpts { input = Just (FileInput file) } -> + L.readFile file >>= valAndExit validateTarballs + pure () + + where + valAndExit f contents = do + 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) + >>= exitWith + diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs new file mode 100644 index 0000000..2f43571 --- /dev/null +++ b/app/ghcup-gen/Validate.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} + +module Validate where + +import GHCup +import GHCup.Download +import GHCup.Types +import GHCup.Utils.Logger + +import Control.Exception.Safe +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Logger +import Control.Monad.Reader.Class +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.Reader ( runReaderT ) +import Control.Monad.Trans.Resource ( runResourceT + , MonadUnliftIO + ) +import Data.IORef +import Data.List +import Data.String.Interpolate +import Data.Versions +import Haskus.Utils.Variant.Excepts +import Optics +import System.Exit +import System.IO + +import qualified Data.ByteString as B +import qualified Data.Map.Strict as M + + +data ValidationError = InternalError String + deriving Show + +instance Exception ValidationError + + +addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m () +addError = do + ref <- ask + liftIO $ modifyIORef ref (+ 1) + + +validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m) + => GHCupDownloads + -> m ExitCode +validate dls = do + ref <- liftIO $ newIORef 0 + + -- * verify binary downloads * -- + flip runReaderT ref $ do + -- unique tags + forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t + + -- required platforms + forM_ (M.toList dls) $ \(t, versions) -> + forM_ (M.toList versions) $ \(v, vi) -> + forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do + checkHasRequiredPlatforms t v arch (M.keys pspecs) + + checkGHCisSemver + forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t + + -- exit + e <- liftIO $ readIORef ref + if e > 0 + then pure $ ExitFailure e + else do + lift $ $(logInfo) [i|All good|] + pure ExitSuccess + where + checkHasRequiredPlatforms t v arch pspecs = do + let v' = prettyVer v + when (not $ any (== Linux UnknownLinux) pspecs) $ do + lift $ $(logError) + [i|Linux UnknownLinux missing for for #{t} #{v'} #{arch}|] + addError + when ((not $ any (== Darwin) pspecs) && arch == A_64) $ do + lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch}|] + addError + when ((not $ any (== FreeBSD) pspecs) && arch == A_64) $ lift $ $(logWarn) + [i|FreeBSD missing for #{t} #{v'} #{arch}|] + + checkUniqueTags tool = do + let allTags = join $ fmap snd $ availableToolVersions dls tool + let nonUnique = + fmap fst + . filter (\(_, b) -> not b) + <$> ( mapM + (\case + [] -> throwM $ InternalError "empty inner list" + (t : ts) -> + pure $ (t, ) $ if isUniqueTag t then ts == [] else True + ) + . group + . sort + $ allTags + ) + case join nonUnique of + [] -> pure () + xs -> do + lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|] + addError + where + isUniqueTag Latest = True + isUniqueTag Recommended = True + + checkGHCisSemver = do + let ghcVers = toListOf (ix GHC % to M.keys % folded) dls + forM_ ghcVers $ \v -> case semver (prettyVer v) of + Left _ -> do + lift $ $(logError) [i|GHC version #{v} is not valid semver|] + addError + Right _ -> pure () + + -- a tool must have at least one of each mandatory tags + checkMandatoryTags tool = do + let allTags = join $ fmap snd $ availableToolVersions dls tool + forM_ [Latest, Recommended] $ \t -> case elem t allTags of + False -> do + lift $ $(logError) [i|Tag #{t} missing from #{tool}|] + addError + True -> pure () + + +validateTarballs :: ( Monad m + , MonadLogger m + , MonadThrow m + , MonadIO m + , MonadUnliftIO m + , MonadMask m + ) + => GHCupDownloads + -> m ExitCode +validateTarballs dls = do + ref <- liftIO $ newIORef 0 + + flip runReaderT ref $ do + -- download/verify all binary tarballs + let + dlbis = nub $ join $ (M.elems dls) <&> \versions -> + join $ (M.elems versions) <&> \vi -> + join $ (M.elems $ _viArch vi) <&> \pspecs -> + join $ (M.elems pspecs) <&> \pverspecs -> (M.elems pverspecs) + forM_ dlbis $ downloadAll + + let dlsrc = nub $ join $ (M.elems dls) <&> \versions -> + join $ (M.elems versions) <&> maybe [] (: []) . _viSourceDL + forM_ dlsrc $ downloadAll + + -- exit + e <- liftIO $ readIORef ref + if e > 0 + then pure $ ExitFailure e + else do + lift $ $(logInfo) [i|All good|] + pure ExitSuccess + + where + downloadAll dli = do + let settings = Settings True GHCupURL False + let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True + , colorOutter = B.hPut stderr + , rawOutter = (\_ -> pure ()) + } + + r <- + runLogger + . flip runReaderT settings + . runResourceT + . runE + $ downloadCached dli Nothing + case r of + VRight _ -> pure () + VLeft e -> do + lift $ $(logError) + [i|Could not download (or verify hash) of #{dli}, Error was: #{e}|] + addError diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs new file mode 100644 index 0000000..0047693 --- /dev/null +++ b/app/ghcup/Main.hs @@ -0,0 +1,702 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DuplicateRecordFields #-} + + +module Main where + +import GHCup +import GHCup.Download +import GHCup.Errors +import GHCup.Types +import GHCup.Utils +import GHCup.Utils.Logger +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ +import GHCup.Version + +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.Bifunctor +import Data.Char +import Data.List ( intercalate ) +import Data.Semigroup ( (<>) ) +import Data.String.Interpolate +import Data.Versions +import Haskus.Utils.Variant.Excepts +import HPath +import HPath.IO +import Options.Applicative hiding ( style ) +import Prelude hiding ( appendFile ) +import System.Console.Pretty +import System.Environment +import System.Exit +import System.IO hiding ( appendFile ) +import Text.Read +import Text.Layout.Table +import URI.ByteString + +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Text.Encoding as E + + + + + +data Options = Options + { + -- global options + optVerbose :: Bool + , optCache :: Bool + , optUrlSource :: Maybe URI + , optNoVerify :: Bool + -- commands + , optCommand :: Command + } + +data Command + = Install InstallCommand + | SetGHC SetGHCOptions + | List ListOptions + | Rm RmOptions + | DInfo + | Compile CompileCommand + | Upgrade UpgradeOpts + | NumericVersion + +data ToolVersion = ToolVersion Version + | ToolTag Tag + + +data InstallCommand = InstallGHC InstallOptions + | InstallCabal InstallOptions + +data InstallOptions = InstallOptions + { instVer :: Maybe ToolVersion + } + +data SetGHCOptions = SetGHCOptions + { ghcVer :: Maybe ToolVersion + } + +data ListOptions = ListOptions + { lTool :: Maybe Tool + , lCriteria :: Maybe ListCriteria + } + +data RmOptions = RmOptions + { ghcVer :: Version + } + + +data CompileCommand = CompileGHC CompileOptions + | CompileCabal CompileOptions + + +data CompileOptions = CompileOptions + { targetVer :: Version + , bootstrapVer :: Version + , jobs :: Maybe Int + , buildConfig :: Maybe (Path Abs) + } + +data UpgradeOpts = UpgradeInplace + | UpgradeAt (Path Abs) + | UpgradeGHCupDir + deriving Show + + +opts :: Parser Options +opts = + Options + <$> switch + (short 'v' <> long "verbose" <> help + "Whether to enable verbosity (default: False)" + ) + <*> switch + (short 'c' <> long "cache" <> help + "Whether to cache downloads (default: False)" + ) + <*> (optional + (option + (eitherReader parseUri) + (short 's' <> long "url-source" <> metavar "URL" <> help + "Alternative ghcup download info url" <> internal + ) + ) + ) + <*> switch + (short 'n' <> long "no-verify" <> help + "Skip tarball checksum verification (default: False)" + ) + <*> com + where + parseUri s' = + bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s') + + +com :: Parser Command +com = + subparser + ( command + "install" + ( Install + <$> (info (installP <**> helper) + (progDesc "Install or update GHC/cabal") + ) + ) + <> command + "list" + ( List + <$> (info (listOpts <**> helper) + (progDesc "Show available GHCs and other tools") + ) + ) + <> command + "upgrade" + ( Upgrade + <$> (info + (upgradeOptsP <**> helper) + (progDesc "Upgrade ghcup (per default in ~/.ghcup/bin/)") + ) + ) + <> command + "compile" + ( Compile + <$> (info (compileP <**> helper) + (progDesc "Compile a tool from source") + ) + ) + <> commandGroup "Main commands:" + ) + <|> subparser + ( command + "set" + ( SetGHC + <$> (info (setGHCOpts <**> helper) + (progDesc "Set the currently active GHC version") + ) + ) + <> command + "rm" + ( Rm + <$> (info + (rmOpts <**> helper) + (progDesc "Remove a GHC version installed by ghcup") + ) + ) + <> commandGroup "GHC commands:" + <> hidden + ) + <|> subparser + ( command + "debug-info" + ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info"))) + <> command + "numeric-version" + ( (\_ -> NumericVersion) + <$> (info (helper) (progDesc "Show the numeric version")) + ) + <> commandGroup "Other commands:" + <> hidden + ) + + +installP :: Parser InstallCommand +installP = subparser + ( command + "ghc" + ( InstallGHC + <$> (info (installOpts <**> helper) (progDesc "Install a GHC version")) + ) + <> command + "cabal" + ( InstallCabal + <$> (info (installOpts <**> helper) + (progDesc "Install or update a Cabal version") + ) + ) + ) + +installOpts :: Parser InstallOptions +installOpts = InstallOptions <$> optional toolVersionParser + +setGHCOpts :: Parser SetGHCOptions +setGHCOpts = SetGHCOptions <$> optional toolVersionParser + +listOpts :: Parser ListOptions +listOpts = + ListOptions + <$> optional + (option + (eitherReader toolParser) + (short 't' <> long "tool" <> metavar "" <> help + "Tool to list versions for. Default is all" + ) + ) + <*> (optional + (option + (eitherReader criteriaParser) + ( short 'c' + <> long "show-criteria" + <> metavar "" + <> help "Show only installed or set tool versions" + ) + ) + ) + +rmOpts :: Parser RmOptions +rmOpts = RmOptions <$> versionParser + + +compileP :: Parser CompileCommand +compileP = subparser + ( command + "ghc" + ( CompileGHC + <$> (info (compileOpts <**> helper) (progDesc "Compile GHC from source") + ) + ) + <> command + "cabal" + ( CompileCabal + <$> (info (compileOpts <**> helper) + (progDesc "Compile Cabal from source") + ) + ) + ) + + +compileOpts :: Parser CompileOptions +compileOpts = + CompileOptions + <$> (option + (eitherReader + (bimap (const "Not a valid version") id . version . T.pack) + ) + (short 'v' <> long "version" <> metavar "VERSION" <> help + "The tool version to compile" + ) + ) + <*> (option + (eitherReader + (bimap (const "Not a valid version") id . version . T.pack) + ) + ( short 'b' + <> long "bootstrap-version" + <> metavar "BOOTSTRAP_VERSION" + <> help "The GHC version to bootstrap with (must be installed)" + ) + ) + <*> optional + (option + (eitherReader (readEither @Int)) + (short 'j' <> long "jobs" <> metavar "JOBS" <> help + "How many jobs to use for make" + ) + ) + <*> optional + (option + (eitherReader + (\x -> + bimap show id . parseAbs . E.encodeUtf8 . T.pack $ x :: Either + String + (Path Abs) + ) + ) + (short 'c' <> long "config" <> metavar "CONFIG" <> help + "Absolute path to build config file" + ) + ) + + +versionParser :: Parser Version +versionParser = option + (eitherReader (bimap (const "Not a valid version") id . version . T.pack)) + (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version" + ) + + +toolVersionParser :: Parser ToolVersion +toolVersionParser = verP <|> toolP + where + verP = ToolVersion <$> versionParser + toolP = + ToolTag + <$> (option + (eitherReader + (\s' -> case fmap toLower s' of + "recommended" -> Right Recommended + "latest" -> Right Latest + other -> Left ([i|Unknown tag #{other}|]) + ) + ) + (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag") + ) + + +toolParser :: String -> Either String Tool +toolParser s' | t == T.pack "ghc" = Right GHC + | t == T.pack "cabal" = Right Cabal + | otherwise = Left ("Unknown tool: " <> s') + where t = T.toLower (T.pack s') + + +criteriaParser :: String -> Either String ListCriteria +criteriaParser s' | t == T.pack "installed" = Right ListInstalled + | t == T.pack "set" = Right ListSet + | otherwise = Left ("Unknown criteria: " <> s') + where t = T.toLower (T.pack s') + + +toSettings :: Options -> Settings +toSettings Options {..} = + let cache = optCache + urlSource = maybe GHCupURL OwnSource optUrlSource + noVerify = optNoVerify + in Settings { .. } + + +upgradeOptsP :: Parser UpgradeOpts +upgradeOptsP = + flag' + UpgradeInplace + (short 'i' <> long "inplace" <> help + "Upgrade ghcup in-place (wherever it's at)" + ) + <|> ( UpgradeAt + <$> (option + (eitherReader + (\x -> + bimap show id . parseAbs . E.encodeUtf8 . T.pack $ x :: Either + String + (Path Abs) + ) + ) + (short 't' <> long "target" <> metavar "TARGET_DIR" <> help + "Absolute filepath to write ghcup into" + ) + ) + ) + <|> (pure UpgradeGHCupDir) + + + + +main :: IO () +main = do + + customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) + >>= \opt@Options {..} -> do + let settings = toSettings opt + + -- logger interpreter + logfile <- initGHCupFileLogging ([rel|ghcup.log|] :: Path Rel) + let runLogger = myLoggerT LoggerConfig + { lcPrintDebug = optVerbose + , colorOutter = B.hPut stderr + , rawOutter = appendFile logfile + } + + -- wrapper to run effects with settings + let runInstTool = + runLogger + . flip runReaderT settings + . runResourceT + . runE + @'[ AlreadyInstalled + , UnknownArchive + , DistroNotFound + , FileDoesNotExistError + , CopyError + , JSONError + , NoCompatibleArch + , NoDownload + , NotInstalled + , NoCompatiblePlatform + , BuildFailed + , TagNotFound + , DigestError + , DownloadFailed + ] + + let runSetGHC = + runLogger + . flip runReaderT settings + . runE + @'[ FileDoesNotExistError + , NotInstalled + , TagNotFound + , JSONError + , TagNotFound + , DownloadFailed + ] + + let runListGHC = + runLogger + . flip runReaderT settings + . runE @'[FileDoesNotExistError , JSONError , DownloadFailed] + + let runRmGHC = + runLogger . flip runReaderT settings . runE @'[NotInstalled] + + let runDebugInfo = + runLogger + . flip runReaderT settings + . runE + @'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] + + let runCompileGHC = + runLogger + . flip runReaderT settings + . runResourceT + . runE + @'[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , GHCupSetError + , NoDownload + , UnknownArchive + -- + , JSONError + ] + + let runCompileCabal = + runLogger + . flip runReaderT settings + . runResourceT + . runE + @'[ JSONError + , UnknownArchive + , NoDownload + , DigestError + , DownloadFailed + , BuildFailed + ] + + let runUpgrade = + runLogger + . flip runReaderT settings + . runResourceT + . runE + @'[ DigestError + , DistroNotFound + , NoCompatiblePlatform + , NoCompatibleArch + , NoDownload + , FileDoesNotExistError + , JSONError + , DownloadFailed + , CopyError + ] + + + case optCommand of + Install (InstallGHC InstallOptions {..}) -> + void + $ (runInstTool $ do + dls <- liftE getDownloads + v <- liftE $ fromVersion dls instVer GHC + liftE $ installGHCBin dls v Nothing + ) + >>= \case + VRight _ -> runLogger + $ $(logInfo) ([s|GHC installation successful|]) + VLeft (V (AlreadyInstalled _ v)) -> + runLogger $ $(logWarn) + [i|GHC ver #{prettyVer v} already installed|] + VLeft (V (BuildFailed tmpdir e)) -> + runLogger + ($(logError) [i|Build failed with #{e} +Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.|] + ) + >> exitFailure + VLeft e -> do + runLogger $ do + $(logError) [i|#{e}|] + $(logError) [i|Also check the logs in ~/.ghcup/logs|] + exitFailure + Install (InstallCabal InstallOptions {..}) -> + void + $ (runInstTool $ do + dls <- liftE getDownloads + v <- liftE $ fromVersion dls instVer Cabal + liftE $ installCabalBin dls v Nothing + ) + >>= \case + VRight _ -> runLogger + $ $(logInfo) ([s|Cabal installation successful|]) + VLeft (V (AlreadyInstalled _ v)) -> + runLogger $ $(logWarn) + [i|Cabal ver #{prettyVer v} already installed|] + VLeft e -> do + runLogger $ do + $(logError) [i|#{e}|] + $(logError) [i|Also check the logs in ~/.ghcup/logs|] + exitFailure + + SetGHC (SetGHCOptions {..}) -> + void + $ (runSetGHC $ do + dls <- liftE getDownloads + v <- liftE $ fromVersion dls ghcVer GHC + liftE $ setGHC v SetGHCOnly + ) + >>= \case + VRight _ -> + runLogger $ $(logInfo) ([s|GHC successfully set|]) + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + List (ListOptions {..}) -> + void + $ (runListGHC $ do + dls <- liftE getDownloads + liftIO $ listVersions dls lTool lCriteria + ) + >>= \case + VRight r -> liftIO $ printListResult r + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + Rm (RmOptions {..}) -> + void + $ (runRmGHC $ do + liftE $ rmGHCVer ghcVer + ) + >>= \case + VRight _ -> pure () + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + DInfo -> do + void + $ (runDebugInfo $ do + liftE $ getDebugInfo + ) + >>= \case + VRight dinfo -> putStrLn $ show dinfo + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + Compile (CompileGHC CompileOptions {..}) -> + void + $ (runCompileGHC $ do + dls <- liftE getDownloads + liftE + $ compileGHC dls targetVer bootstrapVer jobs buildConfig + ) + >>= \case + VRight _ -> + runLogger $ $(logInfo) + ([s|GHC successfully compiled and installed|]) + VLeft (V (AlreadyInstalled _ v)) -> + runLogger $ $(logWarn) + [i|GHC ver #{prettyVer v} already installed|] + VLeft (V (BuildFailed tmpdir e)) -> + runLogger + ($(logError) [i|Build failed with #{e} +Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.|] + ) + >> exitFailure + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + Compile (CompileCabal CompileOptions {..}) -> + void + $ (runCompileCabal $ do + dls <- liftE getDownloads + liftE $ compileCabal dls + targetVer + bootstrapVer + jobs + ) + >>= \case + VRight _ -> + runLogger $ $(logInfo) + ([s|Cabal successfully compiled and installed|]) + VLeft (V (BuildFailed tmpdir e)) -> + runLogger + ($(logError) [i|Build failed with #{e} +Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.|] + ) + >> exitFailure + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + Upgrade (uOpts) -> do + target <- case uOpts of + UpgradeInplace -> do + efp <- liftIO $ getExecutablePath + p <- parseAbs . E.encodeUtf8 . T.pack $ efp + pure $ Just p + (UpgradeAt p) -> pure $ Just p + UpgradeGHCupDir -> do + bdir <- liftIO $ ghcupBinDir + pure (Just (bdir ([rel|ghcup|] :: Path Rel))) + + void + $ (runUpgrade $ do + dls <- liftE getDownloads + liftE $ upgradeGHCup dls target + ) + >>= \case + VRight v' -> do + let pretty_v = prettyVer v' + runLogger + $ $(logInfo) + [i|Successfully upgraded GHCup to version #{pretty_v}|] + VLeft e -> + runLogger ($(logError) [i|#{e}|]) >> exitFailure + + NumericVersion -> T.hPutStr stdout (prettyPVP ghcUpVer) + pure () + + +fromVersion :: Monad m + => GHCupDownloads + -> Maybe ToolVersion + -> Tool + -> Excepts '[TagNotFound] m Version +fromVersion av Nothing tool = + getRecommended av tool ?? TagNotFound Recommended tool +fromVersion _ (Just (ToolVersion v)) _ = pure v +fromVersion av (Just (ToolTag Latest)) tool = + getLatest av tool ?? TagNotFound Latest tool +fromVersion av (Just (ToolTag Recommended)) tool = + getRecommended av tool ?? TagNotFound Recommended tool + + +printListResult :: [ListResult] -> IO () +printListResult lr = do + let + formatted = + gridString + [ column expand left def def + , column expand left def def + , column expand left def def + , column expand left def def + , column expand left def def + ] + $ fmap + (\ListResult {..} -> + [ if + | lSet -> (color Green "✔✔") + | lInstalled -> (color Green "✓") + | otherwise -> (color Red "✗") + , fmap toLower . show $ lTool + , T.unpack . prettyVer $ lVer + , intercalate "," $ ((fmap . fmap) toLower . fmap show $ lTag) + , if fromSrc then (color Blue "compiled") else mempty + ] + ) + lr + putStrLn $ formatted diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..14254cc --- /dev/null +++ b/cabal.project @@ -0,0 +1,15 @@ +packages: ./ghcup.cabal + +with-compiler: ghc-8.6.5 + +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 + +package tar-bytestring + ghc-options: -O2 + diff --git a/cabal.project.freeze b/cabal.project.freeze new file mode 100644 index 0000000..6d9c3b5 --- /dev/null +++ b/cabal.project.freeze @@ -0,0 +1,229 @@ +constraints: any.Cabal ==2.4.0.1, + any.HsOpenSSL ==0.11.4.17, + HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -old-locale, + any.IfElse ==0.85, + any.QuickCheck ==2.13.2, + QuickCheck +templatehaskell, + any.StateVar ==1.2, + any.abstract-deque ==0.3, + abstract-deque -usecas, + any.aeson ==1.4.6.0, + aeson -bytestring-builder -cffi -developer -fast, + any.aeson-pretty ==0.8.8, + aeson-pretty -lib-only, + any.ansi-terminal ==0.10.3, + ansi-terminal -example, + any.ansi-wl-pprint ==0.6.9, + ansi-wl-pprint -example, + any.array ==0.5.3.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.3, + attoparsec -developer, + any.auto-update ==0.1.6, + any.base ==4.12.0.0, + any.base-compat ==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.6.0, + any.blaze-builder ==0.4.1.0, + any.brotli ==0.0.0.0, + any.brotli-streams ==0.0.0.0, + any.bytestring ==0.10.8.2, + any.bytestring-builder ==0.10.8.2.0, + bytestring-builder +bytestring_has_builder, + any.bzlib ==0.5.0.5, + 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.conduit ==1.3.1.2, + any.conduit-extra ==1.3.4, + any.containers ==0.6.0.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.3.0 || ==1.3.6.0, + any.distributive ==0.6.1, + distributive +semigroups +tagged, + any.dlist ==0.8.0.7, + any.easy-file ==0.2.2, + any.errors ==2.3.0, + any.exceptions ==0.10.4, + exceptions +transformers-0-4, + any.extra ==1.7, + 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.0.0, + any.ghc-boot-th ==8.6.5, + 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.6, + 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.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.13.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.5.0 || ==1.6.8.0, + any.profunctors ==5.5.2, + any.random ==1.1, + any.recursion-schemes ==5.1.3, + recursion-schemes +template-haskell, + 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.0, + 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.0, + any.template-haskell ==2.14.0.0, + any.terminal-progress-bar ==0.4.1, + any.terminal-size ==0.3.2.1, + any.text ==1.2.3.1, + any.text-conversions ==0.3.0, + any.text-icu ==0.7.0.1, + any.text-short ==0.1.3, + text-short -asserts, + any.th-abstraction ==0.3.2.0, + any.th-expand-syns ==0.4.5.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.8.0.2 || ==1.9.3, + any.time-compat ==1.9.2.2, + 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 diff --git a/ghcup.cabal b/ghcup.cabal new file mode 100644 index 0000000..0f7dcf0 --- /dev/null +++ b/ghcup.cabal @@ -0,0 +1,234 @@ +cabal-version: 2.2 + +name: ghcup +version: 0.1.0.0 +synopsis: ghc toolchain installer as an exe/library +description: A rewrite of the shell script ghcup, for providing + a more stable user experience and exposing an API. +homepage: https://github.com/hasufell/ghcup-hs +bug-reports: https://github.com/hasufell/ghcup-hs/issues +license: LGPL-3.0-only +license-file: LICENSE +author: Julian Ospald +maintainer: hasufell@posteo.de +copyright: Julian Ospald 2020 +category: System +build-type: Simple +extra-source-files: CHANGELOG.md + +source-repository head + type: git + location: https://github.com/hasufell/ghcup-hs + +common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 } +common aeson { build-depends: aeson >= 1.4 } +common aeson-pretty { build-depends: aeson-pretty >= 0.8.8 } +common ascii-string { build-depends: ascii-string >= 1.0 } +common async { build-depends: async >= 0.8 } +common attoparsec { build-depends: attoparsec >= 0.13 } +common base { build-depends: base >= 4.12 && < 5 } +common binary { build-depends: binary >= 0.8.6.0 } +common bytestring { build-depends: bytestring >= 0.10 } +common bzlib { build-depends: bzlib >= 0.5.0.5 } +common case-insensitive { build-depends: case-insensitive >= 1.2.1.0 } +common containers { build-depends: containers >= 0.6 } +common generics-sop { build-depends: generics-sop >= 0.5 } +common haskus-utils-types { build-depends: haskus-utils-types >= 1.5 } +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 } +common hpath-directory { build-depends: hpath-directory >= 0.13.2 } +common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 } +common hpath-io { build-depends: hpath-io >= 0.13.1 } +common hpath-posix { build-depends: hpath-posix >= 0.11.1 } +common http-io-streams { build-depends: http-io-streams >= 0.1.2.0 } +common io-streams { build-depends: io-streams >= 1.5 } +common language-bash { build-depends: language-bash >= 0.9 } +common lzma { build-depends: lzma >= 0.0.0.3 } +common monad-logger { build-depends: monad-logger >= 0.3.31 } +common mtl { build-depends: mtl >= 2.2 } +common optics { build-depends: optics >= 0.2 } +common optics-vl { build-depends: optics-vl >= 0.2 } +common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 } +common parsec { build-depends: parsec >= 3.1 } +common pretty-terminal { build-depends: pretty-terminal >= 0.1.0.0 } +common resourcet { build-depends: resourcet >= 1.2.2 } +common safe { build-depends: safe >= 0.3.18 } +common safe-exceptions { build-depends: safe-exceptions >= 0.1 } +common streamly { build-depends: streamly >= 0.7.1 } +common streamly-posix { build-depends: streamly-posix >= 0.1.0.0 } +common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 } +common strict-base { build-depends: strict-base >= 0.4 } +common string-interpolate { build-depends: string-interpolate >= 0.2.0.0 } +common table-layout { build-depends: table-layout >= 0.8 } +common tar-bytestring { build-depends: tar-bytestring >= 0.6.3.0 } +common template-haskell { build-depends: template-haskell >= 2.7 } +common terminal-progress-bar { build-depends: terminal-progress-bar >= 0.4.1 } +common text { build-depends: text >= 1.2 } +common text-icu { build-depends: text-icu >= 0.7 } +common time { build-depends: time >= 1.9.3 } +common transformers { build-depends: transformers >= 0.5 } +common unix { build-depends: unix >= 2.7 } +common unix-bytestring { build-depends: unix-bytestring >= 0.3 } +common uri-bytestring { build-depends: uri-bytestring >= 0.3.2.2 } +common utf8-string { build-depends: utf8-string >= 1.0 } +common vector { build-depends: vector >= 0.12 } +common versions { build-depends: versions >= 3.5 } +common waargonaut { build-depends: waargonaut >= 0.8 } +common word8 { build-depends: word8 >= 0.1.3 } +common zlib { build-depends: zlib >= 0.6.2.1 } + + +common config + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded + default-extensions: LambdaCase + , MultiWayIf + , PackageImports + , RecordWildCards + , ScopedTypeVariables + , StrictData + , Strict + , TupleSections + +library + import: config + , base + -- deps + , HsOpenSSL + , aeson + , ascii-string + , async + , attoparsec + , binary + , bytestring + , bzlib + , case-insensitive + , containers + , generics-sop + , haskus-utils-types + , haskus-utils-variant + , hopenssl + , hpath + , hpath-directory + , hpath-filepath + , hpath-io + , hpath-posix + , http-io-streams + , io-streams + , language-bash + , lzma + , monad-logger + , mtl + , optics + , optics-vl + , parsec + , pretty-terminal + , resourcet + , safe + , safe-exceptions + , streamly + , streamly-posix + , streamly-bytestring + , strict-base + , string-interpolate + , tar-bytestring + , template-haskell + , terminal-progress-bar + , text + , text-icu + , time + , transformers + , unix + , unix-bytestring + , uri-bytestring + , utf8-string + , vector + , versions + , word8 + , zlib + exposed-modules: GHCup + GHCup.Download + GHCup.Errors + GHCup.Platform + GHCup.Types + GHCup.Types.JSON + GHCup.Types.Optics + GHCup.Utils + GHCup.Utils.Bash + GHCup.Utils.Dirs + GHCup.Utils.File + GHCup.Utils.Logger + GHCup.Utils.Prelude + GHCup.Utils.String.QQ + GHCup.Utils.Version.QQ + GHCup.Version + -- other-modules: + -- other-extensions: + hs-source-dirs: lib + +executable ghcup + import: config + , base + -- + , bytestring + , containers + , haskus-utils-variant + , monad-logger + , mtl + , optparse-applicative + , text + , versions + , hpath + , hpath-io + , pretty-terminal + , resourcet + , string-interpolate + , table-layout + , uri-bytestring + , utf8-string + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: ghcup + hs-source-dirs: app/ghcup + default-language: Haskell2010 + +executable ghcup-gen + import: config + , base + -- + , aeson + , aeson-pretty + , bytestring + , containers + , safe-exceptions + , haskus-utils-variant + , monad-logger + , mtl + , optics + , optparse-applicative + , text + , versions + , hpath + , pretty-terminal + , resourcet + , string-interpolate + , table-layout + , transformers + , uri-bytestring + , utf8-string + main-is: Main.hs + other-modules: GHCupDownloads + Validate + -- other-extensions: + build-depends: ghcup + hs-source-dirs: app/ghcup-gen + default-language: Haskell2010 + +test-suite ghcup-test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: MyLibTest.hs + build-depends: base ^>=4.12.0.0 diff --git a/lib/GHCup.hs b/lib/GHCup.hs new file mode 100644 index 0000000..1f8d27e --- /dev/null +++ b/lib/GHCup.hs @@ -0,0 +1,686 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} + +module GHCup where + + +import GHCup.Download +import GHCup.Errors +import GHCup.Platform +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Types.Optics +import GHCup.Utils +import GHCup.Utils.File +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ +import GHCup.Utils.Version.QQ +import GHCup.Version + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Fail ( MonadFail ) +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.Resource + hiding ( throwM ) +import Data.ByteString ( ByteString ) +import Data.List +import Data.Maybe +import Data.String.Interpolate +import Data.Versions +import Data.Word8 +import GHC.IO.Exception +import HPath +import HPath.IO +import Haskus.Utils.Variant.Excepts +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import System.IO.Error +import System.Posix.FilePath ( getSearchPath ) +import System.Posix.RawFilePath.Directory.Errors + ( hideError ) + +import qualified Data.ByteString as B +import qualified Data.Map.Strict as Map +import qualified Data.Text.Encoding as E + + + + ------------------------- + --[ Tool installation ]-- + ------------------------- + + + +installGHCBin :: ( MonadFail m + , MonadMask m + , MonadCatch m + , MonadReader Settings m + , MonadLogger m + , MonadResource m + , MonadIO m + ) + => GHCupDownloads + -> Version + -> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DistroNotFound + , DownloadFailed + , NoCompatibleArch + , NoCompatiblePlatform + , NoDownload + , NotInstalled + , UnknownArchive + ] + m + () +installGHCBin bDls ver mpfReq = do + lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] + whenM (liftIO $ toolAlreadyInstalled GHC ver) + $ (throwE $ AlreadyInstalled GHC ver) + Settings {..} <- lift ask + + -- download (or use cached version) + dlinfo <- liftE $ getDownloadInfo bDls GHC ver mpfReq + dl <- liftE $ downloadCached dlinfo Nothing + + -- unpack + tmpUnpack <- lift mkGhcupTmpDir + liftE $ unpackToDir tmpUnpack dl + + -- prepare paths + ghcdir <- liftIO $ ghcupGHCDir ver + + -- the subdir of the archive where we do the work + let archiveSubdir = maybe tmpUnpack (tmpUnpack ) (view dlSubdir dlinfo) + + catchAllE + (\es -> + liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir) + >> throwE (BuildFailed archiveSubdir es) + ) + $ installGHC' archiveSubdir ghcdir + + -- only clean up dir if the build succeeded + liftIO $ deleteDirRecursive tmpUnpack + + liftE $ postGHCInstall ver + + where + -- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else. + installGHC' :: (MonadLogger m, MonadIO m) + => Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides) + -> Path Abs -- ^ Path to install to + -> Excepts '[ProcessError] m () + installGHC' path inst = do + lift $ $(logInfo) [s|Installing GHC (this may take a while)|] + lEM $ liftIO $ execLogged [s|./configure|] + False + [[s|--prefix=|] <> toFilePath inst] + ([rel|ghc-configure.log|] :: Path Rel) + (Just path) + Nothing + lEM $ liftIO $ execLogged [s|make|] + True + [[s|install|]] + ([rel|ghc-make.log|] :: Path Rel) + (Just path) + Nothing + pure () + + +installCabalBin :: ( MonadMask m + , MonadCatch m + , MonadReader Settings m + , MonadLogger m + , MonadResource m + , MonadIO m + ) + => GHCupDownloads + -> Version + -> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform + -> Excepts + '[ CopyError + , DigestError + , DistroNotFound + , DownloadFailed + , NoCompatibleArch + , NoCompatiblePlatform + , NoDownload + , UnknownArchive + ] + m + () +installCabalBin bDls ver mpfReq = do + lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] + Settings {..} <- lift ask + + -- download (or use cached version) + dlinfo <- liftE $ getDownloadInfo bDls Cabal ver mpfReq + dl <- liftE $ downloadCached dlinfo Nothing + + -- unpack + tmpUnpack <- lift withGHCupTmpDir + liftE $ unpackToDir tmpUnpack dl + + -- prepare paths + bindir <- liftIO ghcupBinDir + + -- the subdir of the archive where we do the work + let archiveSubdir = maybe tmpUnpack (tmpUnpack ) (view dlSubdir dlinfo) + + liftE $ installCabal' archiveSubdir bindir + pure () + + where + -- | Install an unpacked cabal distribution. + installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) + => Path Abs -- ^ Path to the unpacked cabal bindist (where the executable resides) + -> Path Abs -- ^ Path to install to + -> Excepts '[CopyError] m () + installCabal' path inst = do + lift $ $(logInfo) [s|Installing cabal|] + let cabalFile = [rel|cabal|] :: Path Rel + liftIO $ createDirIfMissing newDirPerms inst + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path cabalFile) + (inst cabalFile) + Overwrite + + + + --------------- + --[ Set GHC ]-- + --------------- + + + +-- | Set GHC symlinks in ~/.ghcup/bin for the requested GHC version. The behavior depends +-- on `SetGHC`: +-- +-- * SetGHCOnly: ~/.ghcup/bin/ghc -> ~/.ghcup/ghc//bin/ghc +-- * SetGHC_XY: ~/.ghcup/bin/ghc-X.Y -> ~/.ghcup/ghc//bin/ghc +-- * SetGHC_XYZ: ~/.ghcup/bin/ghc- -> ~/.ghcup/ghc//bin/ghc +-- +-- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc//share symlink +-- for `SetGHCOnly` constructor. +setGHC :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) + => Version + -> SetGHC + -> Excepts '[NotInstalled] m () +setGHC ver sghc = do + let verBS = verToBS ver + ghcdir <- liftIO $ ghcupGHCDir ver + + -- symlink destination + bindir <- liftIO $ ghcupBinDir + liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms bindir + + -- first delete the old symlinks (this fixes compatibility issues + -- with old ghcup) + case sghc of + SetGHCOnly -> liftE $ rmPlain ver + SetGHC_XY -> lift $ rmMajorSymlinks ver + SetGHC_XYZ -> lift $ rmMinorSymlinks ver + + -- for ghc tools (ghc, ghci, haddock, ...) + verfiles <- ghcToolFiles ver + forM_ verfiles $ \file -> do + liftIO $ hideError doesNotExistErrorType $ deleteFile (bindir file) + targetFile <- case sghc of + SetGHCOnly -> pure file + SetGHC_XY -> do + major' <- + (\(mj, mi) -> E.encodeUtf8 $ intToText mj <> [s|.|] <> intToText mi) + <$> getGHCMajor ver + parseRel (toFilePath file <> B.singleton _hyphen <> major') + SetGHC_XYZ -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS) + + -- create symlink + let fullF = bindir targetFile + let destL = ghcLinkDestination (toFilePath file) ver + lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath fullF}|] + liftIO $ createSymlink fullF destL + + -- create symlink for share dir + lift $ symlinkShareDir ghcdir verBS + + pure () + + where + + symlinkShareDir :: (MonadIO m, MonadLogger m) + => Path Abs + -> ByteString + -> m () + symlinkShareDir ghcdir verBS = do + destdir <- liftIO $ ghcupBaseDir + case sghc of + SetGHCOnly -> do + let sharedir = [rel|share|] :: Path Rel + let fullsharedir = ghcdir sharedir + whenM (liftIO $ doesDirectoryExist fullsharedir) $ do + let fullF = destdir sharedir + let targetF = [s|./ghc/|] <> verBS <> [s|/|] <> toFilePath sharedir + $(logDebug) [i|rm -f #{fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + $(logDebug) [i|ln -s #{targetF} #{fullF}|] + liftIO $ createSymlink fullF targetF + _ -> pure () + + + + + ------------------ + --[ List tools ]-- + ------------------ + + +data ListCriteria = ListInstalled + | ListSet + deriving Show + +data ListResult = ListResult + { lTool :: Tool + , lVer :: Version + , lTag :: [Tag] + , lInstalled :: Bool + , lSet :: Bool + , fromSrc :: Bool + } + deriving Show + + +availableToolVersions :: GHCupDownloads -> Tool -> [(Version, [Tag])] +availableToolVersions av tool = toListOf + (ix tool % to (fmap (\(v, vi) -> (v, (_viTags vi))) . Map.toList) % folded) + av + + +listVersions :: GHCupDownloads + -> Maybe Tool + -> Maybe ListCriteria + -> IO [ListResult] +listVersions av lt criteria = case lt of + Just t -> do + filter' <$> forM (availableToolVersions av t) (toListResult t) + Nothing -> do + ghcvers <- listVersions av (Just GHC) criteria + cabalvers <- listVersions av (Just Cabal) criteria + ghcupvers <- listVersions av (Just GHCup) criteria + pure (ghcvers <> cabalvers <> ghcupvers) + + where + toListResult :: Tool -> (Version, [Tag]) -> IO ListResult + toListResult t (v, tags) = case t of + GHC -> do + lSet <- fmap (maybe False (== v)) $ ghcSet + lInstalled <- ghcInstalled v + fromSrc <- ghcSrcInstalled v + pure ListResult { lVer = v, lTag = tags, lTool = t, .. } + Cabal -> do + lSet <- fmap (== v) $ cabalSet + lInstalled <- cabalInstalled v + pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. } + GHCup -> do + let lSet = prettyPVP ghcUpVer == prettyVer v + let lInstalled = True + pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. } + + + filter' :: [ListResult] -> [ListResult] + filter' lr = case criteria of + Nothing -> lr + Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr + Just ListSet -> filter (\ListResult {..} -> lSet) lr + + + + -------------- + --[ GHC rm ]-- + -------------- + + +-- | This function may throw and crash in various ways. +rmGHCVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m) + => Version + -> Excepts '[NotInstalled] m () +rmGHCVer ver = do + isSetGHC <- fmap (maybe False (== ver)) $ ghcSet + dir <- liftIO $ ghcupGHCDir ver + let d' = toFilePath dir + exists <- liftIO $ doesDirectoryExist dir + + + if exists + then do + -- this isn't atomic, order matters + lift $ $(logInfo) [i|Removing directory recursively: #{d'}|] + liftIO $ deleteDirRecursive dir + + lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|] + lift $ rmMinorSymlinks ver + + lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|] + -- first remove + lift $ rmMajorSymlinks ver + -- then fix them (e.g. with an earlier version) + (mj, mi) <- getGHCMajor ver + getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) + + + when isSetGHC $ do + lift $ $(logInfo) [i|Removing ghc symlinks|] + liftE $ rmPlain ver + + liftIO + $ ghcupBaseDir + >>= hideError doesNotExistErrorType + . deleteFile + . ( ([rel|share|] :: Path Rel)) + else throwE (NotInstalled GHC ver) + + + + + ------------------ + --[ Debug info ]-- + ------------------ + + +getDebugInfo :: (MonadLogger m, MonadCatch m, MonadReader Settings m, MonadIO m) + => Excepts + '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] + m + DebugInfo +getDebugInfo = do + diBaseDir <- liftIO $ ghcupBaseDir + diBinDir <- liftIO $ ghcupBinDir + diGHCDir <- liftIO $ ghcupGHCBaseDir + diCacheDir <- liftIO $ ghcupCacheDir + diURLSource <- lift $ getUrlSource + diArch <- lE getArchitecture + diPlatform <- liftE $ getPlatform + pure $ DebugInfo { .. } + + + + + --------------- + --[ Compile ]-- + --------------- + + +compileGHC :: ( MonadMask m + , MonadReader Settings m + , MonadThrow m + , MonadResource m + , MonadLogger m + , MonadIO m + , MonadFail m + ) + => GHCupDownloads + -> Version -- ^ version to install + -> Version -- ^ version to bootstrap with + -> Maybe Int -- ^ jobs + -> Maybe (Path Abs) -- ^ build config + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , GHCupSetError + , NoDownload + , UnknownArchive + ] + m + () +compileGHC dls tver bver jobs mbuildConfig = do + lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bver}|] + whenM (liftIO $ toolAlreadyInstalled GHC tver) + (throwE $ AlreadyInstalled GHC tver) + + -- download source tarball + dlInfo <- preview (ix GHC % ix tver % viSourceDL % _Just) dls ?? NoDownload + dl <- liftE $ downloadCached dlInfo Nothing + + -- unpack + tmpUnpack <- lift mkGhcupTmpDir + liftE $ unpackToDir tmpUnpack dl + + bghc <- parseRel ([s|ghc-|] <> verToBS bver) + let workdir = maybe id (flip ()) (view dlSubdir dlInfo) $ tmpUnpack + ghcdir <- liftIO $ ghcupGHCDir tver + + catchAllE + (\es -> + liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir) + >> throwE (BuildFailed workdir es) + ) + $ compile bghc ghcdir workdir + markSrcBuilt ghcdir workdir + + -- only clean up dir if the build succeeded + liftIO $ deleteDirRecursive tmpUnpack + + reThrowAll GHCupSetError $ postGHCInstall tver + pure () + + where + defaultConf = [s| +V=0 +BUILD_MAN = NO +BUILD_SPHINX_HTML = NO +BUILD_SPHINX_PDF = NO +HADDOCK_DOCS = YES +GhcWithLlvmCodeGen = YES|] + + compile :: (MonadCatch m, MonadLogger m, MonadIO m) + => Path Rel + -> Path Abs + -> Path Abs + -> Excepts + '[NoDownload , FileDoesNotExistError , ProcessError] + m + () + compile bghc ghcdir workdir = do + lift $ $(logInfo) [i|configuring build|] + if + | tver >= [vver|8.8.0|] -> do + spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath + bghcPath <- (liftIO $ searchPath spaths bghc) !? NoDownload + newEnv <- addToCurrentEnv [([s|GHC|], toFilePath bghcPath)] + lEM $ liftIO $ execLogged [s|./configure|] + False + [[s|--prefix=|] <> toFilePath ghcdir] + ([rel|ghc-configure.log|] :: Path Rel) + (Just workdir) + (Just newEnv) + | otherwise -> do + lEM $ liftIO $ execLogged + [s|./configure|] + False + [ [s|--prefix=|] <> toFilePath ghcdir + , [s|--with-ghc=|] <> toFilePath bghc + ] + ([rel|ghc-configure.log|] :: Path Rel) + (Just workdir) + Nothing + + case mbuildConfig of + Just bc -> liftIOException + doesNotExistErrorType + (FileDoesNotExistError $ toFilePath bc) + (liftIO $ copyFile bc (build_mk workdir) Overwrite) + Nothing -> + liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf + + lift + $ $(logInfo) + [i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/ghc-make.log' to see the progress.|] + lEM $ liftIO $ execLogged [s|make|] + True + (maybe [] (\j -> [[s|-j|] <> fS (show j)]) jobs) + ([rel|ghc-make.log|] :: Path Rel) + (Just workdir) + Nothing + + lift $ $(logInfo) [i|Installing...|] + lEM $ liftIO $ execLogged [s|make|] + True + [[s|install|]] + ([rel|ghc-make.log|] :: Path Rel) + (Just workdir) + Nothing + + markSrcBuilt ghcdir workdir = do + let dest = (ghcdir ghcUpSrcBuiltFile) + liftIO $ copyFile (build_mk workdir) dest Overwrite + + build_mk workdir = workdir ([rel|mk/build.mk|] :: Path Rel) + + +compileCabal :: ( MonadReader Settings m + , MonadResource m + , MonadMask m + , MonadLogger m + , MonadIO m + ) + => GHCupDownloads + -> Version -- ^ version to install + -> Version -- ^ GHC version to build with + -> Maybe Int + -> Excepts + '[ BuildFailed + , DigestError + , DownloadFailed + , NoDownload + , UnknownArchive + ] + m + () +compileCabal dls tver bver jobs = do + lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bver}|] + + -- download source tarball + dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload + dl <- liftE $ downloadCached dlInfo Nothing + + -- unpack + tmpUnpack <- lift mkGhcupTmpDir + liftE $ unpackToDir tmpUnpack dl + + let workdir = maybe id (flip ()) (view dlSubdir dlInfo) $ tmpUnpack + + reThrowAll (BuildFailed workdir) $ compile workdir + + -- only clean up dir if the build succeeded + liftIO $ deleteDirRecursive tmpUnpack + + pure () + + where + compile :: (MonadLogger m, MonadIO m) + => Path Abs + -> Excepts '[ProcessError] m () + compile workdir = do + lift + $ $(logInfo) + [i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/cabal-bootstrap.log' to see the progress.|] + + let v' = verToBS bver + cabal_bin <- liftIO $ ghcupBinDir + newEnv <- lift $ addToCurrentEnv + [ ([s|GHC|] , [s|ghc-|] <> v') + , ([s|GHC_PKG|], [s|ghc-pkg-|] <> v') + , ([s|GHC_VER|], v') + , ([s|PREFIX|] , toFilePath cabal_bin) + ] + + lEM $ liftIO $ execLogged [s|./bootstrap.sh|] + False + (maybe [] (\j -> [[s|-j|], fS (show j)]) jobs) + ([rel|cabal-bootstrap.log|] :: Path Rel) + (Just workdir) + (Just newEnv) + + + + + --------------------- + --[ Upgrade GHCup ]-- + --------------------- + + +upgradeGHCup :: ( MonadMask m + , MonadReader Settings m + , MonadCatch m + , MonadLogger m + , MonadThrow m + , MonadResource m + , MonadIO m + ) + => GHCupDownloads + -> Maybe (Path Abs) -- ^ full file destination to write ghcup into + -> Excepts + '[ CopyError + , DigestError + , DistroNotFound + , DownloadFailed + , NoCompatibleArch + , NoCompatiblePlatform + , NoDownload + ] + m + Version +upgradeGHCup dls mtarget = do + lift $ $(logInfo) [i|Upgrading GHCup...|] + let latestVer = head $ getTagged dls GHCup Latest + dli <- liftE $ getDownloadInfo dls GHCup latestVer Nothing + tmp <- lift withGHCupTmpDir + let fn = [rel|ghcup|] :: Path Rel + p <- liftE $ download dli tmp (Just fn) + case mtarget of + Nothing -> do + dest <- liftIO $ ghcupBinDir + handleIO (throwE . CopyError . show) $ liftIO $ copyFile p + (dest fn) + Overwrite + Just fullDest -> liftIO $ copyFile p fullDest Overwrite + pure latestVer + + + + ------------- + --[ Other ]-- + ------------- + + +-- | Creates ghc-x.y.z and ghc-x.y symlinks. This is used for +-- both installing from source and bindist. +postGHCInstall :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) + => Version + -> Excepts '[NotInstalled] m () +postGHCInstall ver = do + liftE $ setGHC ver SetGHC_XYZ + + -- Create ghc-x.y symlinks. This may not be the current + -- version, create it regardless. + (mj, mi) <- liftIO $ getGHCMajor ver + getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs new file mode 100644 index 0000000..123830a --- /dev/null +++ b/lib/GHCup/Download.hs @@ -0,0 +1,615 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} + + +module GHCup.Download where + + +import GHCup.Errors +import GHCup.Platform +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Types.Optics +import GHCup.Utils +import GHCup.Utils.File +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Fail ( MonadFail ) +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.Resource + hiding ( throwM ) +import Data.Aeson +import Data.ByteString ( ByteString ) +import Data.ByteString.Builder +import Data.CaseInsensitive ( CI ) +import Data.IORef +import Data.Maybe +import Data.String.Interpolate +import Data.Text.Read +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Data.Time.Format +import Data.Versions +import GHC.IO.Exception +import HPath +import HPath.IO +import Haskus.Utils.Variant.Excepts +import Network.Http.Client hiding ( URL ) +import OpenSSL.Digest +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +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.QQ + +import qualified Data.Binary.Builder as B +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as L +import qualified Data.CaseInsensitive as CI +import qualified Data.Map.Strict as M +import qualified Data.Text as T +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.RawFilePath.Directory + as RD + + + +ghcupURL :: URI +ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|] + + + + ------------------ + --[ High-level ]-- + ------------------ + + +-- | Downloads the download information! But only if we need to ;P +getDownloads :: ( FromJSONKey Tool + , FromJSONKey Version + , FromJSON VersionInfo + , MonadIO m + , MonadCatch m + , MonadReader Settings m + , MonadLogger m + , MonadThrow m + , MonadFail m + ) + => Excepts '[JSONError , DownloadFailed] m GHCupDownloads +getDownloads = do + urlSource <- lift getUrlSource + lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|] + case urlSource of + GHCupURL -> do + bs <- reThrowAll DownloadFailed $ dl ghcupURL + lE' JSONDecodeError $ eitherDecode' bs + (OwnSource url) -> do + bs <- reThrowAll DownloadFailed $ dl url + lE' JSONDecodeError $ eitherDecode' bs + (OwnSpec av) -> pure $ av + + where + -- First check if the json file is in the ~/.ghcup/cache dir + -- and check it's access time. If it has been accessed within the + -- last 5 minutes, just reuse it. + -- + -- If not, then send a HEAD request and check for modification time. + -- Only download the file if the modification time is newer + -- than the local file. + -- + -- Always save the local file with the mod time of the remote file. + dl :: forall m1 + . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1) + => URI + -> Excepts + '[ FileDoesNotExistError + , HTTPStatusError + , URIParseError + , UnsupportedScheme + , NoLocationHeader + , TooManyRedirs + ] + m1 + L.ByteString + dl uri' = do + let path = view pathL' uri' + json_file <- (liftIO $ ghcupCacheDir) + >>= \cacheDir -> (cacheDir ) <$> urlBaseName path + e <- liftIO $ doesFileExist json_file + if e + then do + accessTime <- + PF.accessTimeHiRes + <$> (liftIO $ PF.getFileStatus (toFilePath json_file)) + currentTime <- liftIO $ getPOSIXTime + + -- access time won't work on most linuxes, but we can try regardless + if (currentTime - accessTime) > 300 + then do -- no access in last 5 minutes, re-check upstream mod time + getModTime >>= \case + Just modTime -> do + fileMod <- liftIO $ getModificationTime json_file + if modTime > fileMod + then do + bs <- liftE $ downloadBS uri' + liftIO $ writeFileWithModTime modTime json_file bs + pure bs + else liftIO $ readFile json_file + Nothing -> do + lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|] + liftIO $ deleteFile json_file + liftE $ downloadBS uri' + else -- access in less than 5 minutes, re-use file + liftIO $ readFile json_file + else do + getModTime >>= \case + Just modTime -> do + bs <- liftE $ downloadBS uri' + liftIO $ writeFileWithModTime modTime json_file bs + pure bs + Nothing -> do + lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|] + liftE $ downloadBS uri' + + where + getModTime = do + headers <- + handleIO (\_ -> pure mempty) + $ liftE + $ ( catchAllE + (\_ -> + pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString) + ) + $ getHead uri' + ) + pure $ parseModifiedHeader headers + + + parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime + parseModifiedHeader headers = + (M.lookup (CI.mk [s|Last-Modified|]) headers) >>= \h -> parseTimeM + True + defaultTimeLocale + "%a, %d %b %Y %H:%M:%S %Z" + (T.unpack . E.decodeUtf8 $ h) + + writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO () + writeFileWithModTime utctime path content = do + let mod_time = utcTimeToPOSIXSeconds utctime + writeFileL path (Just newFilePerms) content + setModificationTimeHiRes path mod_time + + + +getDownloadInfo :: ( MonadLogger m + , MonadCatch m + , MonadIO m + , MonadReader Settings m + ) + => GHCupDownloads + -> 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 + (Left NoDownload) + Right + (with_distro <|> without_distro_ver <|> without_distro) + + where + with_distro = distro_preview id id + without_distro_ver = distro_preview id (const Nothing) + without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing) + + distro_preview f g = + preview (ix t % ix v % viArch % ix a % ix (f p) % ix (g mv)) dls + + +-- | Tries to download from the given http or https url +-- and saves the result in continuous memory into a file. +-- If the filename is not provided, then we: +-- 1. try to guess the filename from the url path +-- 2. otherwise create a random file +-- +-- The file must not exist. +download :: ( MonadMask m + , MonadReader Settings m + , MonadThrow m + , MonadLogger m + , MonadIO m + ) + => DownloadInfo + -> Path Abs -- ^ destination dir + -> Maybe (Path Rel) -- ^ optional filename + -> Excepts '[DigestError , DownloadFailed] m (Path Abs) +download dli dest mfn + | scheme == [s|https|] = dl + | scheme == [s|http|] = dl + | scheme == [s|file|] = cp + | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) + + where + scheme = view (dlUri % uriSchemeL' % schemeBSL') dli + cp = do + -- destination dir must exist + liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest + destFile <- getDestFile + fromFile <- parseAbs path + liftIO $ copyFile fromFile destFile Strict + pure destFile + dl = do + let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli)) + lift $ $(logInfo) [i|downloading: #{uri'}|] + + (https, host, fullPath, port) <- reThrowAll DownloadFailed + $ uriToQuadruple (view dlUri dli) + + -- destination dir must exist + liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest + destFile <- getDestFile + + -- download + fd <- liftIO $ createRegularFileFd newFilePerms destFile + let stepper = fdWrite fd + flip finally (liftIO $ closeFd fd) + $ reThrowAll DownloadFailed + $ downloadInternal True https host fullPath port stepper + + liftE $ checkDigest dli destFile + pure destFile + + -- Manage to find a file we can write the body into. + getDestFile :: MonadThrow m => m (Path Abs) + getDestFile = maybe (urlBaseName path <&> (dest )) (pure . (dest )) mfn + + path = view (dlUri % pathL') dli + + +-- | Download into tmpdir or use cached version, if it exists. If filename +-- is omitted, infers the filename from the url. +downloadCached :: ( MonadMask m + , MonadResource m + , MonadThrow m + , MonadLogger m + , MonadIO m + , MonadReader Settings m + ) + => DownloadInfo + -> Maybe (Path Rel) -- ^ optional filename + -> Excepts '[DigestError , DownloadFailed] m (Path Abs) +downloadCached dli mfn = do + cache <- lift getCache + case cache of + True -> do + cachedir <- liftIO $ ghcupCacheDir + fn <- maybe (urlBaseName $ view (dlUri % pathL') dli) pure mfn + let cachfile = cachedir fn + fileExists <- liftIO $ doesFileExist cachfile + if + | fileExists -> do + liftE $ checkDigest dli cachfile + pure $ cachfile + | otherwise -> liftE $ download dli cachedir mfn + False -> do + tmp <- lift withGHCupTmpDir + liftE $ download dli tmp mfn + + + + + ------------------ + --[ Low-level ]-- + ------------------ + + +-- | This is used for downloading the JSON. +downloadBS :: (MonadCatch m, MonadIO m) + => URI + -> Excepts + '[ FileDoesNotExistError + , HTTPStatusError + , URIParseError + , UnsupportedScheme + , NoLocationHeader + , TooManyRedirs + ] + m + L.ByteString +downloadBS uri' + | scheme == [s|https|] + = dl True + | scheme == [s|http|] + = dl False + | scheme == [s|file|] + = liftIOException doesNotExistErrorType (FileDoesNotExistError path) + $ (liftIO $ RD.readFile path) + | otherwise + = throwE UnsupportedScheme + + where + scheme = view (uriSchemeL' % schemeBSL') uri' + path = view pathL' uri' + dl https = do + (_, host', fullPath', port') <- liftE $ uriToQuadruple uri' + liftE $ downloadBS' https host' fullPath' port' + + +-- | 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 [s|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 [s|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 == [s|https|] = head' True + | scheme == [s|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 [s|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 == [s|https|] -> pure True + | scheme == [s|http|] -> pure False + | otherwise -> throwE UnsupportedScheme + + let + queryBS = + BS.intercalate [s|&|] + . fmap (\(x, y) -> encodeQuery x <> [s|=|] <> encodeQuery y) + $ (queryPairs uriQuery) + port = + preview (_Just % authorityPortL' % _Just % portNumberL') uriAuthority + fullpath = + if BS.null queryBS then uriPath else uriPath <> [s|?|] <> queryBS + pure (https, host, fullpath, port) + where encodeQuery = L.toStrict . B.toLazyByteString . urlEncodeQuery + + +checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m) + => DownloadInfo + -> Path Abs + -> Excepts '[DigestError] m () +checkDigest dli file = do + verify <- lift ask <&> (not . noVerify) + when verify $ do + let p' = toFilePath file + lift $ $(logInfo) [i|veryfing digest of: #{p'}|] + c <- liftIO $ readFile file + let cDigest = E.decodeUtf8 . toHex . digest (digestByName "sha256") $ c + eDigest = view dlHash dli + when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs new file mode 100644 index 0000000..a479ed5 --- /dev/null +++ b/lib/GHCup/Errors.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DataKinds #-} + +module GHCup.Errors where + +import GHCup.Types + +import Control.Exception.Safe +import Data.ByteString ( ByteString ) +import Data.Text ( Text ) +import Data.Versions +import Haskus.Utils.Variant +import HPath + + + + ------------------------ + --[ Low-level errors ]-- + ------------------------ + + + +-- | A compatible platform could not be found. +data NoCompatiblePlatform = NoCompatiblePlatform String -- the platform we got + deriving Show + +-- | Unable to find a download for the requested versio/distro. +data NoDownload = NoDownload + deriving Show + +-- | The Architecture is unknown and unsupported. +data NoCompatibleArch = NoCompatibleArch String + deriving Show + +-- | Unable to figure out the distribution of the host. +data DistroNotFound = DistroNotFound + deriving Show + +-- | The archive format is unknown. We don't know how to extract it. +data UnknownArchive = UnknownArchive ByteString + deriving Show + +-- | The scheme is not supported (such as ftp). +data UnsupportedScheme = UnsupportedScheme + deriving Show + +-- | Unable to copy a file. +data CopyError = CopyError String + deriving Show + +-- | Unable to find a tag of a tool. +data TagNotFound = TagNotFound Tag Tool + deriving Show + +-- | The tool (such as GHC) is already installed with that version. +data AlreadyInstalled = AlreadyInstalled Tool Version + deriving Show + +-- | The tool is not installed. Some operations rely on a tool +-- to be installed (such as setting the current GHC version). +data NotInstalled = NotInstalled Tool Version + deriving Show + +-- | JSON decoding failed. +data JSONError = JSONDecodeError String + deriving Show + +-- | A file that is supposed to exist does not exist +-- (e.g. when we use file scheme to "download" something). +data FileDoesNotExistError = FileDoesNotExistError ByteString + deriving Show + +-- | File digest verification failed. +data DigestError = DigestError Text Text + deriving Show + +-- | Unexpected HTTP status. +data HTTPStatusError = HTTPStatusError Int + deriving Show + +-- | The 'Location' header was expected during a 3xx redirect, but not found. +data NoLocationHeader = NoLocationHeader + deriving Show + +-- | Too many redirects. +data TooManyRedirs = TooManyRedirs + deriving Show + + + + ------------------------- + --[ High-level errors ]-- + ------------------------- + +-- | A download failed. The underlying error is encapsulated. +data DownloadFailed = forall es . Show (V es) => DownloadFailed (V es) + +deriving instance Show DownloadFailed + + +-- | A build failed. +data BuildFailed = forall es . Show (V es) => BuildFailed (Path Abs) (V es) + +deriving instance Show BuildFailed + + +-- | Setting the current GHC version failed. +data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es) + +deriving instance Show GHCupSetError + + + --------------------------------------------- + --[ True Exceptions (e.g. for MonadThrow) ]-- + --------------------------------------------- + + +-- | Parsing failed. +data ParseError = ParseError String + deriving Show + +instance Exception ParseError diff --git a/lib/GHCup/Platform.hs b/lib/GHCup/Platform.hs new file mode 100644 index 0000000..f0ce7a5 --- /dev/null +++ b/lib/GHCup/Platform.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + + +module GHCup.Platform where + + +import GHCup.Errors +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Utils.Bash +import GHCup.Utils.File +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Class ( lift ) +import Data.Foldable +import Data.Maybe +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Versions +import HPath +import HPath.IO +import Haskus.Utils.Variant.Excepts +import Prelude hiding ( abs + , readFile + , writeFile + ) +import System.Info + +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import qualified Data.Text.ICU as ICU + + -------------------------- + --[ Platform detection ]-- + -------------------------- + + +getArchitecture :: Either NoCompatibleArch Architecture +getArchitecture = case arch of + "x86_64" -> Right A_64 + "i386" -> Right A_32 + what -> Left (NoCompatibleArch what) + + + +getPlatform :: (MonadLogger m, MonadCatch m, MonadIO m) + => Excepts + '[NoCompatiblePlatform , DistroNotFound] + m + PlatformResult +getPlatform = do + pfr <- case os of + "linux" -> do + (distro, ver) <- liftE getLinuxDistro + pure $ PlatformResult { _platform = Linux distro, _distroVersion = ver } + -- TODO: these are not verified + "darwin" -> + pure $ PlatformResult { _platform = Darwin, _distroVersion = Nothing } + "freebsd" -> do + ver <- getFreeBSDVersion + pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } + what -> throwE $ NoCompatiblePlatform what + lift $ $(logDebug) [i|Identified Platform as: #{pfr}|] + pure pfr + where getFreeBSDVersion = pure Nothing + + +getLinuxDistro :: (MonadCatch m, MonadIO m) + => Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning) +getLinuxDistro = do + -- TODO: don't do alternative on IO, because it hides bugs + (name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ liftIO $ asum + [ try_os_release + , try_lsb_release_cmd + , try_lsb_release + , try_redhat_release + , try_debian_version + ] + let parsedVer = ver >>= either (const Nothing) Just . versioning + distro = if + | hasWord name ["debian"] -> Debian + | hasWord name ["ubuntu"] -> Ubuntu + | hasWord name ["linuxmint", "Linux Mint"] -> Mint + | hasWord name ["fedora"] -> Fedora + | hasWord name ["centos"] -> CentOS + | hasWord name ["Red Hat"] -> RedHat + | hasWord name ["alpine"] -> Alpine + | hasWord name ["exherbo"] -> Exherbo + | hasWord name ["gentoo"] -> Gentoo + | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux + | otherwise -> UnknownLinux + pure (distro, parsedVer) + where + hasWord t matches = foldr + (\x y -> + ( isJust + . ICU.find (ICU.regex [ICU.CaseInsensitive] ([s|\b|] <> x <> [s|\b|])) + $ t + ) + || y + ) + False + (T.pack <$> matches) + + os_release :: Path Abs + os_release = [abs|/etc/os-release|] + lsb_release :: Path Abs + lsb_release = [abs|/etc/lsb-release|] + lsb_release_cmd :: Path Rel + lsb_release_cmd = [rel|lsb-release|] + redhat_release :: Path Abs + redhat_release = [abs|/etc/redhat-release|] + debian_version :: Path Abs + debian_version = [abs|/etc/debian_version|] + + try_os_release :: IO (Text, Maybe Text) + try_os_release = do + (Just name) <- getAssignmentValueFor os_release "NAME" + ver <- getAssignmentValueFor os_release "VERSION_ID" + pure (T.pack name, fmap T.pack ver) + + try_lsb_release_cmd :: IO (Text, Maybe Text) + try_lsb_release_cmd = do + (Just _) <- findExecutable lsb_release_cmd + name <- fmap _stdOut $ executeOut lsb_release_cmd [[s|-si|]] Nothing + ver <- fmap _stdOut $ executeOut lsb_release_cmd [[s|-sr|]] Nothing + pure (E.decodeUtf8 name, Just $ E.decodeUtf8 ver) + + try_lsb_release :: IO (Text, Maybe Text) + try_lsb_release = do + (Just name) <- getAssignmentValueFor lsb_release "DISTRIB_ID" + ver <- getAssignmentValueFor lsb_release "DISTRIB_RELEASE" + pure (T.pack name, fmap T.pack ver) + + try_redhat_release :: IO (Text, Maybe Text) + try_redhat_release = do + t <- fmap lBS2sT $ readFile redhat_release + let nameRe n = + join + . fmap (ICU.group 0) + . ICU.find + (ICU.regex [ICU.CaseInsensitive] ([s|\b|] <> fS n <> [s|\b|])) + $ t + verRe = + join + . fmap (ICU.group 0) + . ICU.find + (ICU.regex [ICU.CaseInsensitive] [s|\b(\d)+(.(\d)+)*\b|]) + $ t + (Just name) <- pure + (nameRe "CentOS" <|> nameRe "Fedora" <|> nameRe "Red Hat") + pure (name, verRe) + + try_debian_version :: IO (Text, Maybe Text) + try_debian_version = do + ver <- readFile debian_version + pure (T.pack "debian", Just $ lBS2sT ver) diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs new file mode 100644 index 0000000..b0b638e --- /dev/null +++ b/lib/GHCup/Types.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE DeriveGeneric #-} + +module GHCup.Types where + +import Data.Map.Strict ( Map ) +import Data.Text ( Text ) +import Data.Versions +import HPath +import URI.ByteString + +import qualified GHC.Generics as GHC + + + + + --------------------- + --[ Download Tree ]-- + --------------------- + + +-- | Description of all binary and source downloads. This is a tree +-- of nested maps. +type GHCupDownloads = Map Tool ToolVersionSpec +type ToolVersionSpec = Map Version VersionInfo +type ArchitectureSpec = Map Architecture PlatformSpec +type PlatformSpec = Map Platform PlatformVersionSpec +type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo + + +-- | An installable tool. +data Tool = GHC + | Cabal + | GHCup + deriving (Eq, GHC.Generic, Ord, Show) + + +-- | All necessary information of a tool version, including +-- source download and per-architecture downloads. +data VersionInfo = VersionInfo + { _viTags :: [Tag] -- ^ version specific tag + , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball + , _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch + } + deriving (Eq, Show) + + +-- | A tag. These are currently attached to a version of a tool. +data Tag = Latest + | Recommended + deriving (Ord, Eq, Show) + + +data Architecture = A_64 + | A_32 + deriving (Eq, GHC.Generic, Ord, Show) + + +data Platform = Linux LinuxDistro + -- ^ must exit + | Darwin + -- ^ must exit + | FreeBSD + deriving (Eq, GHC.Generic, Ord, Show) + +data LinuxDistro = Debian + | Ubuntu + | Mint + | Fedora + | CentOS + | RedHat + | Alpine + | AmazonLinux + -- rolling + | Gentoo + | Exherbo + -- not known + | UnknownLinux + -- ^ must exit + deriving (Eq, GHC.Generic, Ord, Show) + + +-- | An encapsulation of a download. This can be used +-- to download, extract and install a tool. +data DownloadInfo = DownloadInfo + { _dlUri :: URI + , _dlSubdir :: Maybe (Path Rel) + , _dlHash :: Text + } + deriving (Eq, Show) + + + + + -------------- + --[ Others ]-- + -------------- + + +-- | Where to fetch GHCupDownloads from. +data URLSource = GHCupURL + | OwnSource URI + | OwnSpec GHCupDownloads + deriving Show + + +data Settings = Settings + { cache :: Bool + , urlSource :: URLSource + , noVerify :: Bool + } + deriving Show + + +data DebugInfo = DebugInfo + { diBaseDir :: Path Abs + , diBinDir :: Path Abs + , diGHCDir :: Path Abs + , diCacheDir :: Path Abs + , diURLSource :: URLSource + , diArch :: Architecture + , diPlatform :: PlatformResult + } + deriving Show + + +data SetGHC = SetGHCOnly -- ^ unversioned 'ghc' + | SetGHC_XY -- ^ ghc-x.y + | SetGHC_XYZ -- ^ ghc-x.y.z + deriving (Eq, Show) + + +data PlatformResult = PlatformResult + { _platform :: Platform + , _distroVersion :: Maybe Versioning + } + deriving (Eq, Show) + +data PlatformRequest = PlatformRequest + { _rArch :: Architecture + , _rPlatform :: Platform + , _rVersion :: Maybe Versioning + } + deriving (Eq, Show) + diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs new file mode 100644 index 0000000..a876cfa --- /dev/null +++ b/lib/GHCup/Types/JSON.hs @@ -0,0 +1,149 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module GHCup.Types.JSON where + +import GHCup.Types +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ + +import Data.Aeson +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Text.Encoding ( decodeUtf8 ) +import Data.Text.Encoding as E +import Data.Versions +import Data.Word8 +import HPath +import URI.ByteString + +import qualified Data.ByteString as BS +import qualified Data.Text as T + + +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo + + +instance ToJSON URI where + toJSON = toJSON . decodeUtf8 . serializeURIRef' + +instance FromJSON URI where + parseJSON = withText "URL" $ \t -> + case parseURI strictURIParserOptions (encodeUtf8 t) of + Right x -> pure x + Left e -> fail . show $ e + +instance ToJSON Versioning where + toJSON = toJSON . prettyV + +instance FromJSON Versioning where + parseJSON = withText "Versioning" $ \t -> case versioning t of + Right x -> pure x + Left e -> fail $ "Failure in Version (FromJSON)" <> show e + +instance ToJSONKey Versioning where + toJSONKey = toJSONKeyText $ \x -> prettyV x + +instance FromJSONKey Versioning where + fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of + Right x -> pure x + Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e + +instance ToJSONKey (Maybe Versioning) where + toJSONKey = toJSONKeyText $ \case + Just x -> prettyV x + Nothing -> T.pack "unknown_version" + +instance FromJSONKey (Maybe Versioning) where + fromJSONKey = FromJSONKeyTextParser $ \t -> + if t == T.pack "unknown_version" then pure Nothing else pure $ just t + where + just t = case versioning t of + Right x -> pure x + Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e + +instance ToJSONKey Platform where + toJSONKey = toJSONKeyText $ \case + Darwin -> T.pack "Darwin" + FreeBSD -> T.pack "FreeBSD" + Linux d -> T.pack ("Linux_" <> show d) + +instance FromJSONKey Platform where + fromJSONKey = FromJSONKeyTextParser $ \t -> if + | T.pack "Darwin" == t -> pure Darwin + | T.pack "FreeBSD" == t -> pure FreeBSD + | T.pack "Linux_" `T.isPrefixOf` t -> case + T.stripPrefix (T.pack "Linux_") t + of + Just dstr -> + case + (decodeStrict (E.encodeUtf8 (T.pack "\"" <> dstr <> T.pack "\"")) :: Maybe + LinuxDistro + ) + of + Just d -> pure $ Linux d + Nothing -> + fail + $ "Unexpected failure in decoding LinuxDistro: " + <> show dstr + Nothing -> fail "Unexpected failure in Platform stripPrefix" + | otherwise -> fail $ "Failure in Platform (FromJSONKey)" + +instance ToJSONKey Architecture where + toJSONKey = genericToJSONKey defaultJSONKeyOptions + +instance FromJSONKey Architecture where + fromJSONKey = genericFromJSONKey defaultJSONKeyOptions + +instance ToJSON Version where + toJSON = toJSON . prettyVer + +instance FromJSON Version where + parseJSON = withText "Version" $ \t -> case version t of + Right x -> pure x + Left e -> fail $ "Failure in Version (FromJSON)" <> show e + +instance ToJSONKey Version where + toJSONKey = toJSONKeyText $ \x -> prettyVer x + +instance FromJSONKey Version where + fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of + Right x -> pure x + Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e + +instance ToJSONKey Tool where + toJSONKey = genericToJSONKey defaultJSONKeyOptions + +instance FromJSONKey Tool where + fromJSONKey = genericFromJSONKey defaultJSONKeyOptions + +instance ToJSON (Path Rel) where + toJSON p = case and . fmap isAscii . BS.unpack $ fp of + True -> toJSON . E.decodeUtf8 $ fp + False -> String [s|/not/a/valid/path|] + where fp = toFilePath p + +instance FromJSON (Path Rel) where + parseJSON = withText "HPath Rel" $ \t -> do + let d = encodeUtf8 t + case parseRel d of + Right x -> pure x + Left e -> fail $ "Failure in HPath Rel (FromJSON)" <> show e diff --git a/lib/GHCup/Types/Optics.hs b/lib/GHCup/Types/Optics.hs new file mode 100644 index 0000000..5d02918 --- /dev/null +++ b/lib/GHCup/Types/Optics.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE TemplateHaskell #-} + +module GHCup.Types.Optics where + +import GHCup.Types + +import Data.ByteString ( ByteString ) +import Optics +import URI.ByteString + +makePrisms ''Tool +makePrisms ''Architecture +makePrisms ''LinuxDistro +makePrisms ''Platform +makePrisms ''Tag + +makeLenses ''PlatformResult +makeLenses ''DownloadInfo +makeLenses ''Tag +makeLenses ''VersionInfo + + +uriSchemeL' :: Lens' (URIRef Absolute) Scheme +uriSchemeL' = lensVL uriSchemeL + +schemeBSL' :: Lens' Scheme ByteString +schemeBSL' = lensVL schemeBSL + +authorityL' :: Lens' (URIRef a) (Maybe Authority) +authorityL' = lensVL authorityL + +authorityHostL' :: Lens' Authority Host +authorityHostL' = lensVL authorityHostL + +authorityPortL' :: Lens' Authority (Maybe Port) +authorityPortL' = lensVL authorityPortL + +portNumberL' :: Lens' Port Int +portNumberL' = lensVL portNumberL + +hostBSL' :: Lens' Host ByteString +hostBSL' = lensVL hostBSL + +pathL' :: Lens' (URIRef a) ByteString +pathL' = lensVL pathL + +queryL' :: Lens' (URIRef a) Query +queryL' = lensVL queryL diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs new file mode 100644 index 0000000..1978067 --- /dev/null +++ b/lib/GHCup/Utils.hs @@ -0,0 +1,330 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + + +module GHCup.Utils + ( module GHCup.Utils.Dirs + , module GHCup.Utils + ) +where + + +import GHCup.Errors +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Utils.Dirs +import GHCup.Utils.File +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Fail ( MonadFail ) +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Class ( lift ) +import Data.Attoparsec.ByteString +import Data.ByteString ( ByteString ) +import Data.List +import Data.Maybe +import Data.String.Interpolate +import Data.Versions +import Data.Word8 +import GHC.IO.Exception +import HPath +import HPath.IO +import Haskus.Utils.Variant.Excepts +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import Safe +import System.IO.Error +import System.Posix.FilePath ( takeFileName ) +import System.Posix.Files.ByteString ( readSymbolicLink ) +import URI.ByteString + +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Compression.BZip as BZip +import qualified Codec.Compression.GZip as GZip +import qualified Codec.Compression.Lzma as Lzma +import qualified Data.ByteString as B +import qualified Data.Map.Strict as Map +import qualified Data.Text.Encoding as E + + + + + + + ------------------------ + --[ Symlink handling ]-- + ------------------------ + + +-- | The symlink destination of a ghc tool. +ghcLinkDestination :: ByteString -- ^ the tool, such as 'ghc', 'haddock' etc. + -> Version + -> ByteString +ghcLinkDestination tool ver = [s|../ghc/|] <> verToBS ver <> [s|/bin/|] <> tool + + +-- | Extract the version part of the result of `ghcLinkDestination`. +ghcLinkVersion :: MonadThrow m => ByteString -> m Version +ghcLinkVersion = either (throwM . ParseError) pure . parseOnly parser + where + parser = string [s|../ghc/|] *> verParser <* string [s|/bin/ghc|] + verParser = many1' (notWord8 _slash) >>= \t -> + case version $ E.decodeUtf8 $ B.pack t of + Left e -> fail $ show e + Right r -> pure r + + +-- e.g. ghc-8.6.5 +rmMinorSymlinks :: (MonadIO m, MonadLogger m) => Version -> m () +rmMinorSymlinks ver = do + bindir <- liftIO $ ghcupBinDir + files <- liftIO $ getDirsFiles' bindir + let myfiles = + filter (\x -> ([s|-|] <> verToBS ver) `B.isSuffixOf` toFilePath x) files + forM_ myfiles $ \f -> do + let fullF = (bindir f) + $(logDebug) [i|rm -f #{toFilePath fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + +-- E.g. ghc, if this version is the set one. +-- This reads `ghcupGHCDir`. +rmPlain :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) + => Version + -> Excepts '[NotInstalled] m () +rmPlain ver = do + files <- liftE $ ghcToolFiles ver + bindir <- liftIO $ ghcupBinDir + forM_ files $ \f -> do + let fullF = (bindir f) + lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + -- old ghcup + let hdc_file = (bindir [rel|haddock-ghc|]) + lift $ $(logDebug) [i|rm -f #{toFilePath hdc_file}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file + +-- e.g. ghc-8.6 +rmMajorSymlinks :: (MonadLogger m, MonadIO m) => Version -> m () +rmMajorSymlinks ver = do + (mj, mi) <- liftIO $ getGHCMajor ver + let v' = E.encodeUtf8 $ intToText mj <> [s|.|] <> intToText mi + + bindir <- liftIO ghcupBinDir + + files <- liftIO $ getDirsFiles' bindir + let myfiles = filter (\x -> ([s|-|] <> v') `B.isSuffixOf` toFilePath x) files + forM_ myfiles $ \f -> do + let fullF = (bindir f) + $(logDebug) [i|rm -f #{toFilePath fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + + + + + ----------------------------------- + --[ Set/Installed introspection ]-- + ----------------------------------- + + +toolAlreadyInstalled :: Tool -> Version -> IO Bool +toolAlreadyInstalled tool ver = case tool of + GHC -> ghcInstalled ver + Cabal -> cabalInstalled ver + GHCup -> pure True + + +ghcInstalled :: Version -> IO Bool +ghcInstalled ver = do + ghcdir <- ghcupGHCDir ver + doesDirectoryExist ghcdir + + +ghcSrcInstalled :: Version -> IO Bool +ghcSrcInstalled ver = do + ghcdir <- ghcupGHCDir ver + doesFileExist (ghcdir ghcUpSrcBuiltFile) + + +ghcSet :: (MonadIO m, MonadThrow m) => m (Maybe Version) +ghcSet = do + ghcBin <- ( ([rel|ghc|] :: Path Rel)) <$> liftIO ghcupBinDir + + -- link destination is of the form ../ghc//bin/ghc + liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do + link <- readSymbolicLink $ toFilePath ghcBin + Just <$> ghcLinkVersion link + + +cabalInstalled :: Version -> IO Bool +cabalInstalled ver = do + reportedVer <- cabalSet + pure (reportedVer == ver) + +cabalSet :: (MonadIO m, MonadThrow m) => m Version +cabalSet = do + cabalbin <- ( ([rel|cabal|] :: Path Rel)) <$> liftIO ghcupBinDir + mc <- liftIO $ executeOut cabalbin [[s|--numeric-version|]] Nothing + let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc + case version (E.decodeUtf8 reportedVer) of + Left e -> throwM e + Right r -> pure r + + + + ----------------------------------------- + --[ Major version introspection (X.Y) ]-- + ----------------------------------------- + + +-- | We assume GHC is in semver format. I hope it is. +getGHCMajor :: MonadThrow m => Version -> m (Int, Int) +getGHCMajor ver = do + SemVer {..} <- throwEither (semver $ prettyVer ver) + pure (fromIntegral _svMajor, fromIntegral _svMinor) + + +-- | Get the latest installed full GHC version that satisfies X.Y. +-- This reads `ghcupGHCBaseDir`. +getGHCForMajor :: (MonadIO m, MonadThrow m) + => Int -- ^ major version component + -> Int -- ^ minor version component + -> m (Maybe Version) +getGHCForMajor major' minor' = do + p <- liftIO $ ghcupGHCBaseDir + ghcs <- liftIO $ getDirsFiles' p + semvers <- forM ghcs $ throwEither . semver . E.decodeUtf8 . toFilePath + mapM (throwEither . version) + . fmap prettySemVer + . lastMay + . sort + . filter + (\SemVer {..} -> + fromIntegral _svMajor == major' && fromIntegral _svMinor == minor' + ) + $ semvers + + + + + ----------------- + --[ Unpacking ]-- + ----------------- + + + +-- | Unpack an archive to a temporary directory and return that path. +unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m) + => Path Abs -- ^ destination dir + -> Path Abs -- ^ archive path + -> Excepts '[UnknownArchive] m () +unpackToDir dest av = do + let fp = E.decodeUtf8 (toFilePath av) + lift $ $(logInfo) [i|Unpacking: #{fp}|] + fn <- toFilePath <$> basename av + let untar = Tar.unpack (toFilePath dest) . Tar.read + + -- extract, depending on file extension + if + | [s|.tar.gz|] `B.isSuffixOf` fn -> liftIO + (untar . GZip.decompress =<< readFile av) + | [s|.tar.xz|] `B.isSuffixOf` fn -> do + filecontents <- liftIO $ readFile av + let decompressed = Lzma.decompress filecontents + liftIO $ untar decompressed + | [s|.tar.bz2|] `B.isSuffixOf` fn -> liftIO + (untar . BZip.decompress =<< readFile av) + | [s|.tar|] `B.isSuffixOf` fn -> liftIO (untar =<< readFile av) + | otherwise -> throwE $ UnknownArchive fn + + + + + ------------ + --[ Tags ]-- + ------------ + + +-- | Get the tool versions that have this tag. +getTagged :: GHCupDownloads -> Tool -> Tag -> [Version] +getTagged av tool tag = toListOf + ( ix tool + % to (Map.filter (\VersionInfo {..} -> elem tag _viTags)) + % to Map.keys + % folded + ) + av + +getLatest :: GHCupDownloads -> Tool -> Maybe Version +getLatest av tool = headOf folded $ getTagged av tool Latest + +getRecommended :: GHCupDownloads -> Tool -> Maybe Version +getRecommended av tool = headOf folded $ getTagged av tool Recommended + + + + ----------------------- + --[ Settings Getter ]-- + ----------------------- + + +getUrlSource :: MonadReader Settings m => m URLSource +getUrlSource = ask <&> urlSource + +getCache :: MonadReader Settings m => m Bool +getCache = ask <&> cache + + + + ------------- + --[ Other ]-- + ------------- + + +urlBaseName :: MonadThrow m + => ByteString -- ^ the url path (without scheme and host) + -> m (Path Rel) +urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False + + +-- Get tool files from ~/.ghcup/bin/ghc//bin/* +-- while ignoring *- symlinks. +-- +-- Returns unversioned relative files, e.g.: +-- ["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"] +ghcToolFiles :: (MonadThrow m, MonadFail m, MonadIO m) + => Version + -> Excepts '[NotInstalled] m [Path Rel] +ghcToolFiles ver = do + ghcdir <- liftIO $ ghcupGHCDir ver + let bindir = ghcdir [rel|bin|] + + -- fail if ghc is not installed + whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) + (throwE (NotInstalled GHC ver)) + + files <- liftIO $ getDirsFiles' bindir + -- figure out the suffix, because this might not be `Version` for + -- alpha/rc releases, but x.y.a.somedate. + (Just symver) <- + (B.stripPrefix [s|ghc-|] . takeFileName) + <$> (liftIO $ readSymbolicLink $ toFilePath (bindir [rel|ghc|])) + when (B.null symver) + (throwIO $ userError $ "Fatal: ghc symlink target is broken") + + pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) files + + +-- | This file, when residing in ~/.ghcup/ghc// signals that +-- this GHC was built from source. It contains the build config. +ghcUpSrcBuiltFile :: Path Rel +ghcUpSrcBuiltFile = [rel|.ghcup_src_built|] diff --git a/lib/GHCup/Utils/Bash.hs b/lib/GHCup/Utils/Bash.hs new file mode 100644 index 0000000..32a622e --- /dev/null +++ b/lib/GHCup/Utils/Bash.hs @@ -0,0 +1,69 @@ +module GHCup.Utils.Bash + ( findAssignment + , equalsAssignmentWith + , getRValue + , getAssignmentValueFor + ) +where + +import Control.Monad +import Data.ByteString.UTF8 ( toString ) +import Data.List +import Data.Maybe +import HPath +import HPath.IO +import Language.Bash.Parse +import Language.Bash.Syntax +import Language.Bash.Word +import Prelude hiding ( readFile ) + +import qualified Data.ByteString.Lazy.UTF8 as UTF8 + + +extractAssignments :: List -> [Assign] +extractAssignments (List stms) = join $ fmap getAssign $ getCommands stms + where + getCommands :: [Statement] -> [Command] + getCommands = join . fmap commands . catMaybes . fmap findPipes + where + findPipes (Statement (Last p@(Pipeline{})) Sequential) = Just p + findPipes _ = Nothing + + getAssign :: Command -> [Assign] + getAssign (Command (SimpleCommand ass _) _) = ass + getAssign _ = [] + + +-- | Find an assignment matching the predicate in the given file. +findAssignment :: Path b -> (Assign -> Bool) -> IO (Maybe Assign) +findAssignment p predicate = do + fileContents <- readFile p + -- TODO: this should accept bytestring: + -- https://github.com/knrafto/language-bash/issues/37 + case parse (toString . toFilePath $ p) (UTF8.toString fileContents) of + Left e -> fail $ show e + Right l -> pure $ find predicate (extractAssignments $ l) + + +-- | Check that the assignment is of the form Foo= ignoring the +-- right hand-side. +equalsAssignmentWith :: String -> Assign -> Bool +equalsAssignmentWith n ass = case ass of + (Assign (Parameter name' Nothing) Equals _) -> n == name' + _ -> False + + +-- | This pretty-prints the right hand of an Equals assignment, removing +-- quotations. No evaluation is performed. +getRValue :: Assign -> Maybe String +getRValue ass = case ass of + (Assign (Parameter _ _) Equals (RValue w)) -> Just $ unquote w + _ -> Nothing + + +-- | Given a bash assignment such as Foo="Bar" in the given file, +-- will return "Bar" (without quotations). +getAssignmentValueFor :: Path b -> String -> IO (Maybe String) +getAssignmentValueFor p n = do + mass <- findAssignment p (equalsAssignmentWith n) + pure (mass >>= getRValue) diff --git a/lib/GHCup/Utils/Dirs.hs b/lib/GHCup/Utils/Dirs.hs new file mode 100644 index 0000000..c1cf712 --- /dev/null +++ b/lib/GHCup/Utils/Dirs.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE QuasiQuotes #-} + +module GHCup.Utils.Dirs where + + +import GHCup.Types.JSON ( ) +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.Maybe +import Data.Versions +import HPath +import HPath.IO +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import System.Posix.Env.ByteString ( getEnv + , getEnvDefault + ) +import System.Posix.Temp.ByteString ( mkdtemp ) + +import qualified Data.ByteString.UTF8 as UTF8 +import qualified System.Posix.FilePath as FP +import qualified System.Posix.User as PU + + + + ------------------------- + --[ GHCup directories ]-- + ------------------------- + + +ghcupBaseDir :: IO (Path Abs) +ghcupBaseDir = do + getEnv [s|GHCUP_INSTALL_BASE_PREFIX|] >>= \case + Just r -> parseAbs r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home ([rel|.ghcup|] :: Path Rel)) + +ghcupGHCBaseDir :: IO (Path Abs) +ghcupGHCBaseDir = ghcupBaseDir <&> ( ([rel|ghc|] :: Path Rel)) + +ghcupGHCDir :: Version -> IO (Path Abs) +ghcupGHCDir ver = do + ghcbasedir <- ghcupGHCBaseDir + verdir <- parseRel (verToBS ver) + pure (ghcbasedir verdir) + + +ghcupBinDir :: IO (Path Abs) +ghcupBinDir = ghcupBaseDir <&> ( ([rel|bin|] :: Path Rel)) + +ghcupCacheDir :: IO (Path Abs) +ghcupCacheDir = ghcupBaseDir <&> ( ([rel|cache|] :: Path Rel)) + +ghcupLogsDir :: IO (Path Abs) +ghcupLogsDir = ghcupBaseDir <&> ( ([rel|logs|] :: Path Rel)) + + +mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs) +mkGhcupTmpDir = do + tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|] + tmp <- liftIO $ mkdtemp $ (tmpdir FP. [s|ghcup-|]) + parseAbs tmp + + +withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs) +withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive + + + -------------- + --[ Others ]-- + -------------- + + +getHomeDirectory :: IO (Path Abs) +getHomeDirectory = do + e <- getEnv [s|HOME|] + case e of + Just fp -> parseAbs fp + Nothing -> do + h <- PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID) + parseAbs $ UTF8.fromString h -- this is a guess diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs new file mode 100644 index 0000000..7157029 --- /dev/null +++ b/lib/GHCup/Utils/File.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module GHCup.Utils.File where + +import GHCup.Utils.Dirs +import GHCup.Utils.Prelude + +import Control.Exception.Safe +import Control.Monad +import Data.ByteString +import Data.ByteString.Unsafe ( unsafeUseAsCStringLen ) +import Data.Char +import Data.Foldable +import Data.Functor +import Data.Maybe +import GHC.Foreign ( peekCStringLen ) +import GHC.IO.Encoding ( getLocaleEncoding ) +import GHC.IO.Exception +import HPath +import HPath.IO +import Optics +import Streamly +import Streamly.External.ByteString +import Streamly.External.ByteString.Lazy +import System.IO +import System.Posix.Directory.ByteString +import System.Posix.FD as FD +import System.Posix.FilePath hiding ( () ) +import System.Posix.Foreign ( oExcl ) +import "unix" System.Posix.IO.ByteString + hiding ( openFd ) +import System.Posix.Process ( ProcessStatus(..) ) +import System.Posix.Types + + +import qualified System.Posix.Process.ByteString + as SPPB +import Streamly.External.Posix.DirStream +import qualified Streamly.Internal.Memory.ArrayStream + as AS +import qualified Streamly.FileSystem.Handle as FH +import qualified Streamly.Internal.Data.Unfold as SU +import qualified Streamly.Prelude as S +import qualified Data.ByteString.Lazy as L + + +data ProcessError = NonZeroExit Int ByteString [ByteString] + | PTerminated ByteString [ByteString] + | PStopped ByteString [ByteString] + | NoSuchPid ByteString [ByteString] + deriving Show + + +data CapturedProcess = CapturedProcess + { _exitCode :: ExitCode + , _stdOut :: ByteString + , _stdErr :: ByteString + } + deriving (Eq, Show) + +makeLenses ''CapturedProcess + + +readFd :: Fd -> IO L.ByteString +readFd fd = do + handle' <- fdToHandle fd + fromChunksIO $ (S.unfold (SU.finallyIO hClose FH.readChunks) handle') + + +-- | Read the lines of a file into a stream. The stream holds +-- a file handle as a resource and will close it once the stream +-- terminates (either through exception or because it's drained). +readFileLines :: Path b -> IO (SerialT IO ByteString) +readFileLines p = do + stream <- readFileStream p + pure + . (fmap fromArray) + . AS.splitOn (fromIntegral $ ord '\n') + . (fmap toArray) + $ stream + + +-- | Find the given executable by searching all *absolute* PATH components. +-- Relative paths in PATH are ignored. +-- +-- This shouldn't throw IO exceptions, unless getting the environment variable +-- PATH does. +findExecutable :: Path Rel -> IO (Maybe (Path Abs)) +findExecutable ex = do + sPaths <- fmap catMaybes . (fmap . fmap) parseAbs $ getSearchPath + -- We don't want exceptions to mess up our result. If we can't + -- figure out if a file exists, then treat it as a negative result. + asum $ fmap (handleIO (\_ -> pure Nothing)) $ fmap + -- asum for short-circuiting behavior + (\s' -> (isExecutable (s' ex) >>= guard) $> (Just (s' ex))) + sPaths + + +-- | Execute the given command and collect the stdout, stderr and the exit code. +-- The command is run in a subprocess. +executeOut :: Path b -- ^ command as filename, e.g. 'ls' + -> [ByteString] -- ^ arguments to the command + -> Maybe (Path Abs) -- ^ chdir to this path + -> IO CapturedProcess +executeOut path args chdir = captureOutStreams $ do + maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir + SPPB.executeFile (toFilePath path) True args Nothing + + +execLogged :: ByteString -- ^ thing to execute + -> Bool -- ^ whether to search PATH for the thing + -> [ByteString] -- ^ args for the thing + -> Path Rel -- ^ log filename + -> Maybe (Path Abs) -- ^ optionally chdir into this + -> Maybe [(ByteString, ByteString)] -- ^ optional environment + -> IO (Either ProcessError ()) +execLogged exe spath args lfile chdir env = do + ldir <- ghcupLogsDir + let logfile = ldir lfile + bracket (createFile (toFilePath logfile) newFilePerms) closeFd action + where + action fd = do + pid <- SPPB.forkProcess $ do + -- dup stdout + void $ dupTo fd stdOutput + + -- dup stderr + void $ dupTo fd stdError + + -- execute the action + maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir + SPPB.executeFile exe spath args env + + + SPPB.getProcessStatus True True pid >>= \case + i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i + i -> pure $ toProcessError exe args i + + +-- | Capture the stdout and stderr of the given action, which +-- is run in a subprocess. Stdin is closed. You might want to +-- 'race' this to make sure it terminates. +captureOutStreams :: IO a + -- ^ the action to execute in a subprocess + -> IO CapturedProcess +captureOutStreams action = + actionWithPipes $ \(parentStdoutRead, childStdoutWrite) -> + actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do + pid <- SPPB.forkProcess $ do + -- dup stdout + void $ dupTo childStdoutWrite stdOutput + closeFd childStdoutWrite + closeFd parentStdoutRead + + -- dup stderr + void $ dupTo childStderrWrite stdError + closeFd childStderrWrite + closeFd parentStderrRead + + -- execute the action + void $ action + + -- close everything we don't need + closeFd childStdoutWrite + closeFd childStderrWrite + + SPPB.getProcessStatus True True pid >>= \case + -- readFd will take care of closing the fd + Just (SPPB.Exited es) -> do + stdout' <- L.toStrict <$> readFd parentStdoutRead + stderr' <- L.toStrict <$> readFd parentStderrRead + pure $ CapturedProcess { _exitCode = es + , _stdOut = stdout' + , _stdErr = stderr' + } + _ -> throwIO $ userError $ ("No such PID " ++ show pid) + + where + actionWithPipes a = + createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2) + cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd + + + +-- | Create a new regular file in write-only mode. The file must not exist. +createRegularFileFd :: FileMode -> Path b -> IO Fd +createRegularFileFd fm dest = + FD.openFd (toFilePath dest) WriteOnly [oExcl] (Just fm) + + +-- | Thin wrapper around `executeFile`. +exec :: ByteString -- ^ thing to execute + -> Bool -- ^ whether to search PATH for the thing + -> [ByteString] -- ^ args for the thing + -> Maybe (Path Abs) -- ^ optionally chdir into this + -> Maybe [(ByteString, ByteString)] -- ^ optional environment + -> IO (Either ProcessError ()) +exec exe spath args chdir env = do + pid <- SPPB.forkProcess $ do + maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir + SPPB.executeFile exe spath args env + + fmap (toProcessError exe args) $ SPPB.getProcessStatus True True pid + + +toProcessError :: ByteString + -> [ByteString] + -> Maybe ProcessStatus + -> Either ProcessError () +toProcessError exe args mps = case mps of + Just (SPPB.Exited (ExitFailure i)) -> Left $ NonZeroExit i exe args + Just (SPPB.Exited ExitSuccess ) -> Right () + Just (Terminated _ _ ) -> Left $ PTerminated exe args + Just (Stopped _ ) -> Left $ PStopped exe args + Nothing -> Left $ NoSuchPid exe args + + +-- | Convert the String to a ByteString with the current +-- system encoding. +unsafePathToString :: Path b -> IO FilePath +unsafePathToString p = do + enc <- getLocaleEncoding + unsafeUseAsCStringLen (toFilePath p) (peekCStringLen enc) + + +-- | Search for a file in the search paths. +-- +-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`. +searchPath :: [Path Abs] -> Path Rel -> IO (Maybe (Path Abs)) +searchPath paths needle = go paths + where + go [] = pure Nothing + go (x : xs) = + hideErrorDefM PermissionDenied (go xs) + $ hideErrorDefM NoSuchThing (go xs) + $ do + dirStream <- openDirStream (toFilePath x) + S.findM (\(_, p) -> isMatch x p) (dirContentsStream dirStream) + >>= \case + Just _ -> pure $ Just (x needle) + Nothing -> go xs + isMatch basedir p = do + if p == toFilePath needle + then isExecutable (basedir needle) + else pure False diff --git a/lib/GHCup/Utils/Logger.hs b/lib/GHCup/Utils/Logger.hs new file mode 100644 index 0000000..a586b3a --- /dev/null +++ b/lib/GHCup/Utils/Logger.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE QuasiQuotes #-} + +module GHCup.Utils.Logger where + +import GHCup.Utils + +import Control.Monad +import Control.Monad.Logger +import HPath +import HPath.IO +import Prelude hiding ( appendFile ) +import System.Console.Pretty +import System.IO.Error + +import qualified Data.ByteString as B + + +data LoggerConfig = LoggerConfig + { lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter + , colorOutter :: B.ByteString -> IO () -- ^ how to write the color output + , rawOutter :: B.ByteString -> IO () -- ^ how to write the full raw output + } + + +myLoggerT :: LoggerConfig -> LoggingT m a -> m a +myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger + where + mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO () + mylogger _ _ level str' = do + -- color output + let l = case level of + LevelDebug -> toLogStr (style Bold $ color Blue "[ Debug ]") + LevelInfo -> toLogStr (style Bold $ color Green "[ Info ]") + LevelWarn -> toLogStr (style Bold $ color Yellow "[ Warn ]") + LevelError -> toLogStr (style Bold $ color Red "[ Error ]") + LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]" + let out = fromLogStr (l <> toLogStr " " <> str' <> toLogStr "\n") + + when (lcPrintDebug || (lcPrintDebug == False && not (level == LevelDebug))) + $ colorOutter out + + -- raw output + let lr = case level of + LevelDebug -> toLogStr "Debug: " + LevelInfo -> toLogStr "Info:" + LevelWarn -> toLogStr "Warn:" + LevelError -> toLogStr "Error:" + LevelOther t -> toLogStr t <> toLogStr ":" + let outr = fromLogStr (lr <> toLogStr " " <> str' <> toLogStr "\n") + rawOutter outr + + +initGHCupFileLogging :: Path Rel -> IO (Path Abs) +initGHCupFileLogging context = do + logs <- ghcupLogsDir + let logfile = logs context + createDirIfMissing newDirPerms logs + hideError doesNotExistErrorType $ deleteFile logfile + createRegularFile newFilePerms logfile + pure logfile diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs new file mode 100644 index 0000000..ef74a7e --- /dev/null +++ b/lib/GHCup/Utils/Prelude.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module GHCup.Utils.Prelude where + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Class ( lift ) +import Data.Bifunctor +import Data.ByteString ( ByteString ) +import Data.Monoid ( (<>) ) +import Data.String +import Data.Text ( Text ) +import Data.Versions +import Haskus.Utils.Types.List +import Haskus.Utils.Variant.Excepts +import System.IO.Error +import System.Posix.Env.ByteString ( getEnvironment ) + +import qualified Data.ByteString.Lazy as L +import qualified Data.Strict.Maybe as S +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as B +import qualified Data.Text.Lazy.Builder.Int as B +import qualified Data.Text.Lazy.Encoding as TLE + + + +fS :: IsString a => String -> a +fS = fromString + +fromStrictMaybe :: S.Maybe a -> Maybe a +fromStrictMaybe = S.maybe Nothing Just + +fSM :: S.Maybe a -> Maybe a +fSM = fromStrictMaybe + +toStrictMaybe :: Maybe a -> S.Maybe a +toStrictMaybe = maybe S.Nothing S.Just + +tSM :: Maybe a -> S.Maybe a +tSM = toStrictMaybe + +internalError :: String -> IO a +internalError = fail . ("Internal error: " <>) + +iE :: String -> IO a +iE = internalError + + +showT :: Show a => a -> Text +showT = fS . show + +-- | Like 'when', but where the test can be monadic. +whenM :: Monad m => m Bool -> m () -> m () +whenM ~b ~t = ifM b t (return ()) + +-- | Like 'unless', but where the test can be monadic. +unlessM :: Monad m => m Bool -> m () -> m () +unlessM ~b ~f = ifM b (return ()) f + +-- | Like @if@, but where the test can be monadic. +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM ~b ~t ~f = do + b' <- b + if b' then t else f + +whileM :: Monad m => m a -> (a -> m Bool) -> m a +whileM ~action ~f = do + a <- action + b' <- f a + if b' then whileM action f else pure a + +whileM_ :: Monad m => m a -> (a -> m Bool) -> m () +whileM_ ~action = void . whileM action + +guardM :: (Monad m, Alternative m) => m Bool -> m () +guardM ~f = guard =<< f + +lBS2sT :: L.ByteString -> Text +lBS2sT = TL.toStrict . TLE.decodeUtf8 + + + +handleIO' :: (MonadIO m, MonadCatch m) + => IOErrorType + -> (IOException -> m a) + -> m a + -> m a +handleIO' err handler = handleIO + (\e -> if err == ioeGetErrorType e then handler e else liftIO $ ioError e) + + +(??) :: forall e es a m . (Monad m, e :< es) => Maybe a -> e -> Excepts es m a +(??) m e = maybe (throwE e) pure m + + +(!?) :: forall e es a m + . (Monad m, e :< es) + => m (Maybe a) + -> e + -> Excepts es m a +(!?) em e = lift em >>= (?? e) + + +lE :: forall e es a m . (Monad m, e :< es) => Either e a -> Excepts es m a +lE = liftE . veitherToExcepts . fromEither + +lE' :: forall e' e es a m + . (Monad m, e :< es) + => (e' -> e) + -> Either e' a + -> Excepts es m a +lE' f = liftE . veitherToExcepts . fromEither . bimap f id + +lEM :: forall e es a m . (Monad m, e :< es) => m (Either e a) -> Excepts es m a +lEM em = lift em >>= lE + +lEM' :: forall e' e es a m + . (Monad m, e :< es) + => (e' -> e) + -> m (Either e' a) + -> Excepts es m a +lEM' f em = lift em >>= lE . bimap f id + +fromEither :: Either a b -> VEither '[a] b +fromEither = either (VLeft . V) VRight + + +liftIOException' :: ( MonadCatch m + , MonadIO m + , Monad m + , e :< es' + , LiftVariant es es' + ) + => IOErrorType + -> e + -> Excepts es m a + -> Excepts es' m a +liftIOException' errType ex = + handleIO + (\e -> + if errType == ioeGetErrorType e then throwE ex else liftIO $ ioError e + ) + . liftE + + +liftIOException :: (MonadCatch m, MonadIO m, Monad m, e :< es') + => IOErrorType + -> e + -> m a + -> Excepts es' m a +liftIOException errType ex = + handleIO + (\e -> + if errType == ioeGetErrorType e then throwE ex else liftIO $ ioError e + ) + . lift + + +hideErrorDef :: IOErrorType -> a -> IO a -> IO a +hideErrorDef err def = + handleIO (\e -> if err == ioeGetErrorType e then pure def else ioError e) + + +hideErrorDefM :: IOErrorType -> IO a -> IO a -> IO a +hideErrorDefM err def = + handleIO (\e -> if err == ioeGetErrorType e then def else ioError e) + + +-- TODO: does this work? +hideExcept :: forall e es es' a m + . (Monad m, e :< es, LiftVariant (Remove e es) es') + => e + -> a + -> Excepts es m a + -> Excepts es' m a +hideExcept _ a action = + catchLiftLeft ((\_ -> pure a) :: (e -> Excepts es' m a)) action + + +hideExcept' :: forall e es es' m + . (Monad m, e :< es, LiftVariant (Remove e es) es') + => e + -> Excepts es m () + -> Excepts es' m () +hideExcept' _ action = + catchLiftLeft ((\_ -> pure ()) :: (e -> Excepts es' m ())) action + + +reThrowAll :: forall e es es' a m + . (Monad m, e :< es') + => (V es -> e) + -> Excepts es m a + -> Excepts es' m a +reThrowAll f = catchAllE (throwE . f) + + +reThrowAllIO :: forall e es es' a m + . (MonadCatch m, Monad m, MonadIO m, e :< es') + => (V es -> e) + -> (IOException -> e) + -> Excepts es m a + -> Excepts es' m a +reThrowAllIO f g = handleIO (throwE . g) . catchAllE (throwE . f) + + +throwEither :: (Exception a, MonadThrow m) => Either a b -> m b +throwEither a = case a of + Left e -> throwM e + Right r -> pure r + + +verToBS :: Version -> ByteString +verToBS = E.encodeUtf8 . prettyVer + + +intToText :: Integral a => a -> T.Text +intToText = TL.toStrict . B.toLazyText . B.decimal + + +removeLensFieldLabel :: String -> String +removeLensFieldLabel str' = + maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str' + + +addToCurrentEnv :: MonadIO m + => [(ByteString, ByteString)] + -> m [(ByteString, ByteString)] +addToCurrentEnv adds = do + cEnv <- liftIO $ getEnvironment + pure (adds ++ cEnv) diff --git a/lib/GHCup/Utils/String/QQ.hs b/lib/GHCup/Utils/String/QQ.hs new file mode 100644 index 0000000..c0a1d24 --- /dev/null +++ b/lib/GHCup/Utils/String/QQ.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | QuasiQuoter for non-interpolated strings, texts and bytestrings. +-- +-- The "s" quoter contains a multi-line string with no interpolation at all, +-- except that the leading newline is trimmed and carriage returns stripped. +-- +-- @ +-- {-\# LANGUAGE QuasiQuotes #-} +-- import Data.Text (Text) +-- import Data.String.QQ +-- foo :: Text -- "String", "ByteString" etc also works +-- foo = [s| +-- Well here is a +-- multi-line string! +-- |] +-- @ +-- +-- Any instance of the IsString type is permitted. +-- +-- (For GHC versions 6, write "[$s||]" instead of "[s||]".) +-- +module GHCup.Utils.String.QQ + ( s + ) +where + + +import Data.Char +import GHC.Exts ( IsString(..) ) +import Language.Haskell.TH.Quote + +-- | QuasiQuoter for a non-interpolating ASCII IsString literal. +-- The pattern portion is undefined. +s :: QuasiQuoter +s = QuasiQuoter + (\s' -> case and $ fmap isAscii s' of + True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s' + False -> fail "Not ascii" + ) + (error "Cannot use q as a pattern") + (error "Cannot use q as a type") + (error "Cannot use q as a dec") + where + removeCRs = filter (/= '\r') + trimLeadingNewline ('\n' : xs) = xs + trimLeadingNewline xs = xs + diff --git a/lib/GHCup/Utils/Version/QQ.hs b/lib/GHCup/Utils/Version/QQ.hs new file mode 100644 index 0000000..e89e459 --- /dev/null +++ b/lib/GHCup/Utils/Version/QQ.hs @@ -0,0 +1,89 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} + + +module GHCup.Utils.Version.QQ where + +import Data.Data +import Data.Text ( Text ) +import Data.Versions +import GHC.Base +import Language.Haskell.TH +import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) +import Language.Haskell.TH.Syntax ( Exp(..) + , Lift + , dataToExpQ + ) +import qualified Data.Text as T +import qualified Language.Haskell.TH.Syntax as TH + + + +deriving instance Data Versioning +deriving instance Lift Versioning +deriving instance Data Version +deriving instance Lift Version +deriving instance Data SemVer +deriving instance Lift SemVer +deriving instance Data Mess +deriving instance Lift Mess +deriving instance Data PVP +deriving instance Lift PVP +deriving instance Lift (NonEmpty Word) +deriving instance Lift VSep +deriving instance Data VSep +deriving instance Lift VUnit +deriving instance Data VUnit +instance Lift Text + +qq :: (Text -> Q Exp) -> QuasiQuoter +qq quoteExp' = QuasiQuoter + { quoteExp = (\s -> quoteExp' . T.pack $ s) + , quotePat = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> fail + "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } + +vver :: QuasiQuoter +vver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . version + +mver :: QuasiQuoter +mver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . mess + +sver :: QuasiQuoter +sver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . semver + +vers :: QuasiQuoter +vers = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . versioning + +pver :: QuasiQuoter +pver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . pvp + +-- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable +liftText :: T.Text -> Q Exp +liftText txt = AppE (VarE 'T.pack) <$> TH.lift (T.unpack txt) + +liftDataWithText :: Data a => a -> Q Exp +liftDataWithText = dataToExpQ (\a -> liftText <$> cast a) diff --git a/lib/GHCup/Version.hs b/lib/GHCup/Version.hs new file mode 100644 index 0000000..a8f7d27 --- /dev/null +++ b/lib/GHCup/Version.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE QuasiQuotes #-} + + +module GHCup.Version where + +import GHCup.Utils.Version.QQ + +import Data.Versions + +ghcUpVer :: PVP +ghcUpVer = [pver|0.1.0|] diff --git a/test/MyLibTest.hs b/test/MyLibTest.hs new file mode 100644 index 0000000..3e2059e --- /dev/null +++ b/test/MyLibTest.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = putStrLn "Test suite not yet implemented." diff --git a/update-index-state.sh b/update-index-state.sh new file mode 100755 index 0000000..356f6d5 --- /dev/null +++ b/update-index-state.sh @@ -0,0 +1,66 @@ +#!/usr/bin/env bash + +set -eu + +status_message() { + printf "\\033[0;32m%s\\033[0m\\n" "$1" +} + +error_message() { + printf "\\033[0;31m%s\\033[0m\\n" "$1" +} + +SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )" +CACHE_LOCATION="${HOME}/.cabal/packages/hackage.haskell.org/01-index.cache" + +if [ ! -f "${CACHE_LOCATION}" ] ; then + error_message "${CACHE_LOCATION} does not exist, did you run 'cabal update'?" + exit 1 +fi + +if [ ! -f "${SCRIPTPATH}/cabal.project" ] ; then + error_message "Could not find ${SCRIPTPATH}/cabal.project, skipping index state update." + exit 3 +fi + +cabal v2-update + +arch=$(getconf LONG_BIT) + +case "${arch}" in +32) + byte_size=4 + magic_word="CABA1002" + ;; +64) + byte_size=8 + magic_word="00000000CABA1002" + ;; +*) + error_message "Unknown architecture (long bit): ${arch}" + exit 2 + ;; +esac + +# This is the logic to parse the binary format of 01-index.cache. +# The first word is a magic 'caba1002', the second one is the timestamp in unix epoch. +# Better than copying the cabal-install source code. +if [ "$(xxd -u -p -l${byte_size} -s 0 "${CACHE_LOCATION}")" != "${magic_word}" ] ; then + error_message "Magic word does not match!" + exit 4 +fi +cache_timestamp=$(echo "ibase=16;obase=A;$(xxd -u -p -l${byte_size} -s ${byte_size} "${CACHE_LOCATION}")" | bc) + +# If we got junk from the binary file, this should fail. +cache_date=$(date --utc --date "@${cache_timestamp}" "+%FT%TZ") + + +status_message "Updating index state in ${SCRIPTPATH}/cabal.project" + +if grep -q "^index-state: .*" "${SCRIPTPATH}/cabal.project" ; then + awk '/index-state:/ {gsub(/.*/, "index-state: '${cache_date}'")}; { print }' "${SCRIPTPATH}/cabal.project" > "${SCRIPTPATH}/cabal.project.tmp" + mv "${SCRIPTPATH}/cabal.project.tmp" "${SCRIPTPATH}/cabal.project" +else + printf "index-state: %s\n" "${cache_date}" >> "${SCRIPTPATH}/cabal.project" +fi +