Compare commits
29 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 63c70ee74b | |||
| 2e0bbca2e0 | |||
| b52fa23ca2 | |||
| ba03b78f23 | |||
| 04ef472c15 | |||
| 75cd8f2341 | |||
| f2e26c1800 | |||
| 0f7dd597d2 | |||
| fb0eba9201 | |||
| 3c80929c38 | |||
| b184ee835f | |||
| ef8e3bd940 | |||
| 1a64527e14 | |||
| 30b4d399b9 | |||
| 50424c2801 | |||
| 7e7c357e47 | |||
| 531b82a406 | |||
| 146ac38549 | |||
| c481956b07 | |||
| 8ef19f0825 | |||
| c1e29a8f16 | |||
| c3611eec6a | |||
| 74b58db7d1 | |||
| 9e4763c640 | |||
| abc4278fc8 | |||
| 8c4cde3d14 | |||
| 3824f6417a | |||
|
|
2be1aa2707 | ||
| da94fa5f92 |
7
.gitignore
vendored
7
.gitignore
vendored
@@ -5,3 +5,10 @@ dist-newstyle/
|
||||
cabal.project.local
|
||||
.stack-work/
|
||||
bin/
|
||||
/*.prof
|
||||
/*.ps
|
||||
/*.hp
|
||||
tags
|
||||
TAGS
|
||||
/tmp/
|
||||
.entangled
|
||||
|
||||
@@ -97,13 +97,13 @@ variables:
|
||||
test:linux:recommended:
|
||||
extends: .test_ghcup_version:linux
|
||||
variables:
|
||||
GHC_VERSION: "8.6.5"
|
||||
GHC_VERSION: "8.8.3"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
|
||||
test:linux:latest:
|
||||
extends: .test_ghcup_version:linux
|
||||
variables:
|
||||
GHC_VERSION: "8.8.3"
|
||||
GHC_VERSION: "8.10.1"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
allow_failure: true
|
||||
|
||||
@@ -113,13 +113,13 @@ test:linux:latest:
|
||||
test:mac:recommended:
|
||||
extends: .test_ghcup_version:darwin
|
||||
variables:
|
||||
GHC_VERSION: "8.6.5"
|
||||
GHC_VERSION: "8.8.3"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
|
||||
test:mac:latest:
|
||||
extends: .test_ghcup_version:darwin
|
||||
variables:
|
||||
GHC_VERSION: "8.8.3"
|
||||
GHC_VERSION: "8.10.1"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
allow_failure: true
|
||||
|
||||
@@ -129,13 +129,13 @@ test:mac:latest:
|
||||
test:freebsd:recommended:
|
||||
extends: .test_ghcup_version:freebsd
|
||||
variables:
|
||||
GHC_VERSION: "8.6.5"
|
||||
GHC_VERSION: "8.8.3"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
|
||||
test:freebsd:latest:
|
||||
extends: .test_ghcup_version:freebsd
|
||||
variables:
|
||||
GHC_VERSION: "8.8.3"
|
||||
GHC_VERSION: "8.10.1"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
allow_failure: true
|
||||
|
||||
@@ -193,5 +193,6 @@ release:freebsd:
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
GHC_VERSION: "8.6.5"
|
||||
GHC_VERSION: "8.8.3"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
|
||||
|
||||
@@ -11,15 +11,8 @@ mkdir -p "${TMPDIR}"
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
|
||||
# ./ghcup-bin install ${GHC_VERSION}
|
||||
# ./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
# ./ghcup-bin set ${GHC_VERSION}
|
||||
|
||||
# install cabal-3.2.0.0
|
||||
curl -sSfL -o cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz&dl=1'
|
||||
tar xf cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz
|
||||
cp cabal "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
|
||||
exit 0
|
||||
|
||||
@@ -18,29 +18,18 @@ apk add --no-cache \
|
||||
tar \
|
||||
perl
|
||||
|
||||
ln -s libncurses.so /usr/lib/libtinfo.so
|
||||
ln -s libncursesw.so.6 /usr/lib/libtinfow.so.6
|
||||
ln -sf libncurses.so /usr/lib/libtinfo.so
|
||||
ln -sf libncursesw.so.6 /usr/lib/libtinfow.so.6
|
||||
ln -sf libtinfow.so.6 /usr/lib/libtinfow.so
|
||||
|
||||
if [ "${BIT}" = "32" ] ; then
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4 > ./ghcup-bin
|
||||
curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin
|
||||
else
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4 > ./ghcup-bin
|
||||
curl -sSfL https://downloads.haskell.org/ghcup/x86_64-linux-ghcup > ./ghcup-bin
|
||||
fi
|
||||
chmod +x ghcup-bin
|
||||
./ghcup-bin upgrade
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
# ./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
# install cabal-3.2.0.0
|
||||
if [ "${BIT}" = "32" ] ; then
|
||||
curl -sSfL -o cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz&dl=1'
|
||||
tar xf cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz
|
||||
cp cabal-install-3.2.0.0-i386-alpine-linux-musl "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
else
|
||||
curl -sSfL -o cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz&dl=1'
|
||||
tar xf cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz
|
||||
cp cabal-install-3.2.0.0-x86_64-alpine-linux-musl "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
fi
|
||||
chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
# utils
|
||||
apk add --no-cache \
|
||||
@@ -57,7 +46,8 @@ apk add --no-cache \
|
||||
openssl-dev \
|
||||
openssl-libs-static \
|
||||
xz \
|
||||
xz-dev
|
||||
|
||||
xz-dev \
|
||||
ncurses-static
|
||||
|
||||
ln -sf libncursesw.a /usr/lib/libtinfow.a
|
||||
|
||||
|
||||
@@ -16,16 +16,24 @@ git describe
|
||||
ecabal update
|
||||
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static'
|
||||
if [ "${BIT}" = "32" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
||||
fi
|
||||
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib static"
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib static" -ftui
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib static" --constraint="lzma static"
|
||||
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib static" --constraint="lzma static" -ftui
|
||||
fi
|
||||
|
||||
mkdir out
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
ver=$(./ghcup --numeric-version)
|
||||
strip -s ./ghcup
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
strip ./ghcup
|
||||
else
|
||||
strip -s ./ghcup
|
||||
fi
|
||||
cp ghcup out/${ARTIFACT}-${ver}
|
||||
|
||||
|
||||
@@ -21,9 +21,9 @@ git describe --always
|
||||
ecabal update
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
ecabal build -w ghc-${GHC_VERSION} -ftui
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
fi
|
||||
|
||||
cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
|
||||
@@ -18,7 +18,7 @@ ghcup set 8.8.3
|
||||
## install ghcup
|
||||
|
||||
cabal update
|
||||
cabal build --constraint="zlib static" --constraint="lzma static"
|
||||
cabal build --constraint="zlib static" --constraint="lzma static" -ftui
|
||||
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
strip -s ghcup
|
||||
strip ./ghcup
|
||||
cp ghcup "./${ARTIFACT}"
|
||||
|
||||
16
3rdparty/libarchive/c/autoconf-linux/config.h
vendored
16
3rdparty/libarchive/c/autoconf-linux/config.h
vendored
@@ -260,7 +260,7 @@
|
||||
/* #undef HAVE_ACL_IS_TRIVIAL_NP */
|
||||
|
||||
/* Define to 1 if you have the <acl/libacl.h> header file. */
|
||||
#define HAVE_ACL_LIBACL_H 1
|
||||
/* #undef HAVE_ACL_LIBACL_H */
|
||||
|
||||
/* Define to 1 if the system has the type `acl_permset_t'. */
|
||||
/* #undef HAVE_ACL_PERMSET_T */
|
||||
@@ -453,6 +453,7 @@
|
||||
/* #undef HAVE_EXPAT_H */
|
||||
|
||||
/* Define to 1 if you have the <ext2fs/ext2_fs.h> header file. */
|
||||
/* #undef HAVE_EXT2FS_EXT2_FS_H */
|
||||
|
||||
/* Define to 1 if you have the `extattr_get_fd' function. */
|
||||
/* #undef HAVE_EXTATTR_GET_FD */
|
||||
@@ -605,7 +606,7 @@
|
||||
/* #undef HAVE_LCHFLAGS */
|
||||
|
||||
/* Define to 1 if you have the `lchmod' function. */
|
||||
/* #undef HAVE_LCHMOD */
|
||||
/* #undef HAVE_LCHMOD 1 */
|
||||
|
||||
/* Define to 1 if you have the `lchown' function. */
|
||||
#define HAVE_LCHOWN 1
|
||||
@@ -1027,10 +1028,10 @@
|
||||
/* #undef HAVE_STRUCT_STAT_ST_UMTIME */
|
||||
|
||||
/* Define to 1 if `tm_gmtoff' is a member of `struct tm'. */
|
||||
#define HAVE_STRUCT_TM_TM_GMTOFF 1
|
||||
/* #undef HAVE_STRUCT_TM_TM_GMTOFF 1 */
|
||||
|
||||
/* Define to 1 if `__tm_gmtoff' is a member of `struct tm'. */
|
||||
/* #undef HAVE_STRUCT_TM___TM_GMTOFF */
|
||||
/* #undef HAVE_STRUCT_TM___TM_GMTOFF 1 */
|
||||
|
||||
/* Define to 1 if the system has the type `struct vfsconf'. */
|
||||
/* #undef HAVE_STRUCT_VFSCONF */
|
||||
@@ -1042,9 +1043,10 @@
|
||||
#define HAVE_SYMLINK 1
|
||||
|
||||
/* Define to 1 if you have the <sys/acl.h> header file. */
|
||||
/* #undef HAVE_SYS_ACL_H */
|
||||
|
||||
/* Define to 1 if you have the <sys/cdefs.h> header file. */
|
||||
#define HAVE_SYS_CDEFS_H 1
|
||||
/* #undef HAVE_SYS_CDEFS_H */
|
||||
|
||||
/* Define to 1 if you have the <sys/dir.h> header file, and it defines `DIR'.
|
||||
*/
|
||||
@@ -1202,7 +1204,7 @@
|
||||
#define HAVE_WMEMMOVE 1
|
||||
|
||||
/* Define to 1 if you have a working EXT2_IOC_GETFLAGS */
|
||||
#define HAVE_WORKING_EXT2_IOC_GETFLAGS 1
|
||||
/* #undef HAVE_WORKING_EXT2_IOC_GETFLAGS */
|
||||
|
||||
/* Define to 1 if you have a working FS_IOC_GETFLAGS */
|
||||
#define HAVE_WORKING_FS_IOC_GETFLAGS 1
|
||||
@@ -1289,7 +1291,7 @@
|
||||
#define STDC_HEADERS 1
|
||||
|
||||
/* Define to 1 if strerror_r returns char *. */
|
||||
#define STRERROR_R_CHAR_P 1
|
||||
/* #undef STRERROR_R_CHAR_P */
|
||||
|
||||
/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
|
||||
#define TIME_WITH_SYS_TIME 1
|
||||
|
||||
1
3rdparty/os-release/.gitattributes
vendored
1
3rdparty/os-release/.gitattributes
vendored
@@ -1 +0,0 @@
|
||||
*.golden -text
|
||||
1
3rdparty/os-release/.gitignore
vendored
1
3rdparty/os-release/.gitignore
vendored
@@ -1 +0,0 @@
|
||||
dist-newstyle/
|
||||
16
3rdparty/os-release/ChangeLog.rst
vendored
16
3rdparty/os-release/ChangeLog.rst
vendored
@@ -1,16 +0,0 @@
|
||||
1.0.0
|
||||
=====
|
||||
|
||||
- Redo of the entire API
|
||||
|
||||
0.2.2
|
||||
=====
|
||||
|
||||
- Fixes builds failing just due to -Werror
|
||||
|
||||
- README.rst and ChangeLog.rst are distributed with cabal package
|
||||
|
||||
0.2.1
|
||||
=====
|
||||
|
||||
- Initial release
|
||||
26
3rdparty/os-release/LICENSE
vendored
26
3rdparty/os-release/LICENSE
vendored
@@ -1,26 +0,0 @@
|
||||
Copyright (c) 2014, Jan Matejka <yac@blesmrt.net>
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright notice,
|
||||
this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. Neither the name of the cbugzilla nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
||||
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
17
3rdparty/os-release/README.rst
vendored
17
3rdparty/os-release/README.rst
vendored
@@ -1,17 +0,0 @@
|
||||
##########
|
||||
os-release
|
||||
##########
|
||||
|
||||
http://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
|
||||
Usage
|
||||
#####
|
||||
|
||||
.. code-block:: haskell
|
||||
|
||||
import System.OsRelease
|
||||
main = readOs >>= print
|
||||
|
||||
.. code-block::
|
||||
|
||||
Right (fromList [(OsReleaseKey "ANSI_COLOR",OsReleaseValue "1;32"),(OsReleaseKey "BUG_REPORT_URL",OsReleaseValue "https://bugs.gentoo.org/"),(OsReleaseKey "HOME_URL",OsReleaseValue "http://www.gentoo.org/"),(OsReleaseKey "ID",OsReleaseValue "gentoo"),(OsReleaseKey "NAME",OsReleaseValue "Gentoo"),(OsReleaseKey "PRETTY_NAME",OsReleaseValue "Gentoo/Linux"),(OsReleaseKey "SUPPORT_URL",OsReleaseValue "http://www.gentoo.org/main/en/support.xml")])
|
||||
2
3rdparty/os-release/Setup.hs
vendored
2
3rdparty/os-release/Setup.hs
vendored
@@ -1,2 +0,0 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
192
3rdparty/os-release/library/System/OsRelease.hs
vendored
192
3rdparty/os-release/library/System/OsRelease.hs
vendored
@@ -1,192 +0,0 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
-- | A module to retrieve os-release information according to the
|
||||
-- freedesktop standard:
|
||||
-- https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
--
|
||||
-- Usage example:
|
||||
--
|
||||
-- @
|
||||
-- do
|
||||
-- Just (OsRelease {..}) <- fmap osRelease <$\> parseOsRelease
|
||||
-- putStrLn name
|
||||
-- @
|
||||
module System.OsRelease
|
||||
(
|
||||
-- * data types
|
||||
OsReleaseResult(..)
|
||||
, OsRelease(..)
|
||||
|
||||
-- * read/parse os-release
|
||||
, parseOsRelease
|
||||
, readOsRelease
|
||||
|
||||
-- * defaults
|
||||
, defaultOsRelease
|
||||
, defaultAssignments
|
||||
|
||||
-- * low-level
|
||||
, parseAssignments
|
||||
, parseAssignment
|
||||
, getAllAssignments
|
||||
, getOsRelease
|
||||
, parseOsRelease'
|
||||
)
|
||||
where
|
||||
|
||||
import System.OsRelease.Megaparsec
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Exception.Safe
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Void
|
||||
import GHC.Generics
|
||||
import Prelude hiding ( id
|
||||
)
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
data OsReleaseResult = OsReleaseResult {
|
||||
osRelease :: !OsRelease
|
||||
, unknown_fields :: [(String, String)]
|
||||
, parse_errors :: [MP.ParseError String Void]
|
||||
} deriving (Show)
|
||||
|
||||
|
||||
-- | All the explicitly documented fields of @os-release@.
|
||||
data OsRelease = OsRelease {
|
||||
name :: !(String)
|
||||
, version :: !(Maybe String)
|
||||
, id :: !(String)
|
||||
, id_like :: !(Maybe String)
|
||||
, version_codename :: !(Maybe String)
|
||||
, version_id :: !(Maybe String)
|
||||
, pretty_name :: !(String)
|
||||
, ansi_color :: !(Maybe String)
|
||||
, cpe_name :: !(Maybe String)
|
||||
, home_url :: !(Maybe String)
|
||||
, documentation_url :: !(Maybe String)
|
||||
, support_url :: !(Maybe String)
|
||||
, bug_report_url :: !(Maybe String)
|
||||
, privacy_policy_url :: !(Maybe String)
|
||||
, build_id :: !(Maybe String)
|
||||
, variant :: !(Maybe String)
|
||||
, variant_id :: !(Maybe String)
|
||||
, logo :: !(Maybe String)
|
||||
} deriving (Generic, Show)
|
||||
|
||||
|
||||
class GetRecords a where
|
||||
getRecords :: a -> [String]
|
||||
|
||||
instance {-# OVERLAPPABLE #-} GetRecords (f p) => GetRecords (M1 i c f p) where
|
||||
getRecords (M1 x) = getRecords x
|
||||
|
||||
instance {-# OVERLAPPING #-} Selector c => GetRecords (M1 S c f p) where
|
||||
getRecords x = [selName x]
|
||||
|
||||
instance (GetRecords (a p), GetRecords (b p)) => GetRecords ((a :*: b) p) where
|
||||
getRecords (a :*: b) = getRecords a ++ getRecords b
|
||||
|
||||
|
||||
|
||||
-- | The defaults as per the spec:
|
||||
--
|
||||
-- @
|
||||
-- NAME=Linux
|
||||
-- ID=linux
|
||||
-- PRETTY_NAME=Linux
|
||||
-- @
|
||||
defaultOsRelease :: OsRelease
|
||||
defaultOsRelease = OsRelease { name = "Linux"
|
||||
, version = Nothing
|
||||
, id = "linux"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Linux"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Nothing
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Nothing
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
|
||||
-- | Like `defaultOsRelease`, except as key-value pair.
|
||||
defaultAssignments :: [(String, String)]
|
||||
defaultAssignments =
|
||||
[("NAME", "Linux"), ("ID", "linux"), ("PRETTY_NAME", "Linux")]
|
||||
|
||||
|
||||
-- | Get all allAssignments as @(key, val)@ from the @os-release@
|
||||
-- file contents.
|
||||
getAllAssignments :: String -- ^ file contents of os-release
|
||||
-> [Either (MP.ParseError String Void) (String, String)]
|
||||
getAllAssignments = fromRight [] . MP.parse parseAssignments "os-release"
|
||||
|
||||
|
||||
-- | Parse the assignments into `OsRelease`. This is merged with the
|
||||
-- defaults as per the spec. In case of no assignments, also returns
|
||||
-- the defaults.
|
||||
getOsRelease :: [(String, String)] -- ^ assignments
|
||||
-> OsRelease
|
||||
getOsRelease =
|
||||
(\case
|
||||
Error _ -> defaultOsRelease
|
||||
Success v -> v
|
||||
)
|
||||
. fromJSON
|
||||
. Object
|
||||
. (\x -> HM.union x (HM.fromList . aesonify $ defaultAssignments))
|
||||
. HM.fromList
|
||||
. aesonify
|
||||
where
|
||||
aesonify = fmap (\(k, v) -> (T.toLower . T.pack $ k, String . T.pack $ v))
|
||||
|
||||
|
||||
-- | Tries to read @\"\/etc\/os-release\"@ and @\"\/usr\/lib\/os_release\"@ in order.
|
||||
--
|
||||
-- Throws @IOError@ if both files could not be read.
|
||||
readOsRelease :: IO String
|
||||
readOsRelease = readFile "/etc/os-release" <|> readFile "/usr/lib/os-release"
|
||||
|
||||
|
||||
-- | Tries to read @\"\/etc\/os-release\"@ and @\"\/usr\/lib\/os_release\"@ in order
|
||||
-- and parses into `OsReleaseResult`. Returns @Nothing@ if both files could
|
||||
-- not be read.
|
||||
parseOsRelease :: IO (Maybe OsReleaseResult)
|
||||
parseOsRelease =
|
||||
handleIO (\_ -> pure Nothing) . fmap (Just . parseOsRelease') $ readOsRelease
|
||||
|
||||
|
||||
-- | Like `parseOsRelease`, except taking the input String explicitly.
|
||||
-- Primarily for tests.
|
||||
parseOsRelease' :: String -> OsReleaseResult
|
||||
parseOsRelease' s =
|
||||
let (errs, ass) = partitionEithers . getAllAssignments $ s
|
||||
osr = getOsRelease ass
|
||||
unknown_fields' =
|
||||
HM.toList
|
||||
. foldr (\x y -> HM.delete (fmap toUpper x) y) (HM.fromList ass)
|
||||
$ (init . getRecords . from $ defaultOsRelease)
|
||||
in OsReleaseResult osr unknown_fields' errs
|
||||
|
||||
|
||||
deriveJSON defaultOptions ''OsRelease
|
||||
@@ -1,102 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module System.OsRelease.Megaparsec where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Data.Char
|
||||
import Data.Functor
|
||||
import Data.Void
|
||||
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MP
|
||||
|
||||
|
||||
-- | Parse the entire file, handling newlines and comments gracefully.
|
||||
--
|
||||
-- This parser generally shouldn't fail, but instead report a failed
|
||||
-- parsed line as @Left@ value.
|
||||
parseAssignments :: MP.Parsec
|
||||
Void
|
||||
String
|
||||
[Either (MP.ParseError String Void) (String, String)]
|
||||
parseAssignments =
|
||||
(\xs x -> join xs ++ x) <$> many (line MP.eol) <*> line MP.eof
|
||||
where
|
||||
line eol = choice'
|
||||
[ comment $> []
|
||||
, blank $> []
|
||||
, fmap
|
||||
(: [])
|
||||
( MP.withRecovery (\e -> parseUntil eol $> Left e)
|
||||
. fmap Right
|
||||
$ (parseAssignment <* eol)
|
||||
)
|
||||
]
|
||||
where
|
||||
comment = pWs *> MP.char '#' *> parseUntil eol *> eol
|
||||
blank = pWs *> eol
|
||||
|
||||
|
||||
-- | Parse a single line assignment and extract the right hand side.
|
||||
-- This is only a subset of a shell parser, refer to the spec for
|
||||
-- details.
|
||||
parseAssignment :: MP.Parsec Void String (String, String)
|
||||
parseAssignment =
|
||||
(,) <$> (pWs *> key) <*> (MP.char '=' *> (MP.try qval <|> mempty) <* pWs)
|
||||
where
|
||||
dropSpace :: String -> String
|
||||
dropSpace = reverse . dropWhile (\x -> x == ' ' || x == '\t') . reverse
|
||||
|
||||
key :: MP.Parsec Void String String
|
||||
key = some (MP.try MP.alphaNumChar <|> MP.char '_')
|
||||
|
||||
qval :: MP.Parsec Void String String
|
||||
qval = do
|
||||
c <- MP.lookAhead MP.printChar
|
||||
case c of
|
||||
' ' -> pure ""
|
||||
'"' -> MP.char c *> val c <* MP.char c
|
||||
'\'' -> MP.char c *> val c <* MP.char c
|
||||
-- no quote, have to drop trailing spaces
|
||||
_ -> fmap
|
||||
dropSpace
|
||||
(some $ MP.satisfy (\x -> isAlphaNum x || (x `elem` ['_', '-', '.']))) -- this is more lax than the spec
|
||||
val :: Char -> MP.Parsec Void String String
|
||||
val !q = many (qspecial q <|> MP.noneOf (specials q)) -- noneOf may be too lax
|
||||
|
||||
qspecial :: Char -> MP.Parsec Void String Char
|
||||
qspecial !q =
|
||||
fmap (!! 1)
|
||||
. (\xs -> choice' xs)
|
||||
. fmap (\s -> MP.try . MP.chunk $ ['\\', s])
|
||||
$ (specials q)
|
||||
|
||||
specials :: Char -> [Char]
|
||||
specials !q = [q, '\\', '$', '`']
|
||||
|
||||
|
||||
parseUntil :: MP.Parsec Void String a -> MP.Parsec Void String String
|
||||
parseUntil !p = do
|
||||
(MP.try (MP.lookAhead p) $> [])
|
||||
<|> (do
|
||||
c <- MP.anySingle
|
||||
c2 <- parseUntil p
|
||||
pure ([c] `mappend` c2)
|
||||
)
|
||||
|
||||
|
||||
-- | Parse one or more white spaces or tabs.
|
||||
pWs :: MP.Parsec Void String ()
|
||||
pWs = many (MP.satisfy (\x -> x == ' ' || x == '\t')) $> ()
|
||||
|
||||
|
||||
-- | Try all parses in order, failing if all failed. Also fails
|
||||
-- on empty list.
|
||||
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
|
||||
choice' = \case
|
||||
[] -> fail "Empty list"
|
||||
xs -> foldr1 (\x y -> MP.try x <|> MP.try y) xs
|
||||
131
3rdparty/os-release/os-release.cabal
vendored
131
3rdparty/os-release/os-release.cabal
vendored
@@ -1,131 +0,0 @@
|
||||
cabal-version: 3.0
|
||||
author: Jan Matějka
|
||||
category: System
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
copyright: 2014 Jan Matějka <yac@blesmrt.net>
|
||||
license: BSD-3-Clause
|
||||
maintainer: Julian Ospald <hasufell@posteo.de>
|
||||
homepage: https://github.com/yaccz/os-release
|
||||
name: os-release
|
||||
synopsis: /etc/os-release helpers
|
||||
version: 1.0.0
|
||||
description:
|
||||
\/etc\/os-release helpers as per the freedesktop spec: https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
|
||||
extra-doc-files:
|
||||
ChangeLog.rst
|
||||
README.rst
|
||||
|
||||
extra-source-files: tests/Golden/data/*.golden tests/Golden/data/*.in
|
||||
|
||||
flag devel
|
||||
description: Enables -Werror
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/yaccz/os-release.git
|
||||
|
||||
common base
|
||||
build-depends: base >=4.11 && <5
|
||||
|
||||
common bytestring
|
||||
build-depends: bytestring
|
||||
|
||||
common aeson
|
||||
build-depends: aeson >=1.4
|
||||
|
||||
common filepath
|
||||
build-depends: filepath >=1.4.2.1
|
||||
|
||||
common hspec
|
||||
build-depends: hspec >=2.7.1
|
||||
|
||||
common hspec-megaparsec
|
||||
build-depends: hspec-megaparsec >=2.1.0
|
||||
|
||||
common megaparsec
|
||||
build-depends: megaparsec >=8.0.0
|
||||
|
||||
common pretty-simple
|
||||
build-depends: pretty-simple >=1.0.0.0
|
||||
|
||||
common safe-exceptions
|
||||
build-depends: safe-exceptions >=0.1.7.0
|
||||
|
||||
common tasty
|
||||
build-depends: tasty >=1.3
|
||||
|
||||
common tasty-golden
|
||||
build-depends: tasty-golden >=2.3.4
|
||||
|
||||
common tasty-hspec
|
||||
build-depends: tasty-hspec >=1.1.5.1
|
||||
|
||||
common text
|
||||
build-depends: text >=1.2
|
||||
|
||||
common unordered-containers
|
||||
build-depends: unordered-containers >=0.2.10.0
|
||||
|
||||
common config
|
||||
default-language: Haskell2010
|
||||
|
||||
if flag(devel)
|
||||
ghc-options:
|
||||
-Werror -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
else
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
LambdaCase
|
||||
OverloadedStrings
|
||||
QuasiQuotes
|
||||
TemplateHaskell
|
||||
TupleSections
|
||||
TypeFamilies
|
||||
|
||||
library
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, aeson
|
||||
, megaparsec
|
||||
, safe-exceptions
|
||||
, text
|
||||
, unordered-containers
|
||||
|
||||
exposed-modules: System.OsRelease
|
||||
other-modules: System.OsRelease.Megaparsec
|
||||
hs-source-dirs: library
|
||||
|
||||
test-suite tests
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, bytestring
|
||||
, filepath
|
||||
, hspec
|
||||
, hspec-megaparsec
|
||||
, megaparsec
|
||||
, pretty-simple
|
||||
, tasty
|
||||
, tasty-golden
|
||||
, tasty-hspec
|
||||
, text
|
||||
|
||||
build-depends: os-release
|
||||
hs-source-dirs: tests
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Golden.Real
|
||||
Specs.Megaparsec
|
||||
|
||||
type: exitcode-stdio-1.0
|
||||
35
3rdparty/os-release/tests/Golden/Real.hs
vendored
35
3rdparty/os-release/tests/Golden/Real.hs
vendored
@@ -1,35 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Golden.Real where
|
||||
|
||||
import System.OsRelease
|
||||
|
||||
import System.FilePath
|
||||
import Text.Pretty.Simple
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Golden
|
||||
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.Text.Lazy as L
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
||||
|
||||
goldenTests :: IO TestTree
|
||||
goldenTests = do
|
||||
files <- findByExtension [".in"] (takeDirectory (__FILE__) </> "data")
|
||||
return $ testGroup
|
||||
"Parse os-release into OsRelease"
|
||||
(flip fmap files $ \file ->
|
||||
let out = replaceExtension file ".golden"
|
||||
in goldenVsString (takeBaseName file) out (parse file)
|
||||
)
|
||||
where
|
||||
parse f = do
|
||||
c <- readFile f
|
||||
pure
|
||||
. B.fromStrict
|
||||
. E.encodeUtf8
|
||||
. L.toStrict
|
||||
. pShowNoColor
|
||||
. parseOsRelease'
|
||||
$ c
|
||||
@@ -1,24 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Alpine Linux"
|
||||
, version = Nothing
|
||||
, id = "alpine"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "3.11.3"
|
||||
, pretty_name = "Alpine Linux v3.11"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://alpinelinux.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugs.alpinelinux.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
@@ -1,7 +0,0 @@
|
||||
NAME="Alpine Linux"
|
||||
ID=alpine
|
||||
VERSION_ID=3.11.3
|
||||
PRETTY_NAME="Alpine Linux v3.11"
|
||||
HOME_URL="https://alpinelinux.org/"
|
||||
BUG_REPORT_URL="https://bugs.alpinelinux.org/"
|
||||
|
||||
@@ -1,29 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Arch Linux"
|
||||
, version = Nothing
|
||||
, id = "arch"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Arch Linux"
|
||||
, ansi_color = Just "38;2;23;147;209"
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.archlinux.org/"
|
||||
, documentation_url = Just "https://wiki.archlinux.org/"
|
||||
, support_url = Just "https://bbs.archlinux.org/"
|
||||
, bug_report_url = Just "https://bugs.archlinux.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Just "rolling"
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Just "archlinux"
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "LOGO"
|
||||
, "archlinux"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
11
3rdparty/os-release/tests/Golden/data/arch.in
vendored
11
3rdparty/os-release/tests/Golden/data/arch.in
vendored
@@ -1,11 +0,0 @@
|
||||
NAME="Arch Linux"
|
||||
PRETTY_NAME="Arch Linux"
|
||||
ID=arch
|
||||
BUILD_ID=rolling
|
||||
ANSI_COLOR="38;2;23;147;209"
|
||||
HOME_URL="https://www.archlinux.org/"
|
||||
DOCUMENTATION_URL="https://wiki.archlinux.org/"
|
||||
SUPPORT_URL="https://bbs.archlinux.org/"
|
||||
BUG_REPORT_URL="https://bugs.archlinux.org/"
|
||||
LOGO=archlinux
|
||||
|
||||
@@ -1,45 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "CentOS Linux"
|
||||
, version = Just "8 (Core)"
|
||||
, id = "centos"
|
||||
, id_like = Just "rhel fedora"
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "8"
|
||||
, pretty_name = "CentOS Linux 8 (Core)"
|
||||
, ansi_color = Just "0;31"
|
||||
, cpe_name = Just "cpe:/o:centos:centos:8"
|
||||
, home_url = Just "https://www.centos.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugs.centos.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "8"
|
||||
)
|
||||
,
|
||||
( "CENTOS_MANTISBT_PROJECT"
|
||||
, "CentOS-8"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "centos"
|
||||
)
|
||||
,
|
||||
( "PLATFORM_ID"
|
||||
, "platform:el8"
|
||||
)
|
||||
,
|
||||
( "CENTOS_MANTISBT_PROJECT_VERSION"
|
||||
, "8"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
17
3rdparty/os-release/tests/Golden/data/centos.in
vendored
17
3rdparty/os-release/tests/Golden/data/centos.in
vendored
@@ -1,17 +0,0 @@
|
||||
NAME="CentOS Linux"
|
||||
VERSION="8 (Core)"
|
||||
ID="centos"
|
||||
ID_LIKE="rhel fedora"
|
||||
VERSION_ID="8"
|
||||
PLATFORM_ID="platform:el8"
|
||||
PRETTY_NAME="CentOS Linux 8 (Core)"
|
||||
ANSI_COLOR="0;31"
|
||||
CPE_NAME="cpe:/o:centos:centos:8"
|
||||
HOME_URL="https://www.centos.org/"
|
||||
BUG_REPORT_URL="https://bugs.centos.org/"
|
||||
|
||||
CENTOS_MANTISBT_PROJECT="CentOS-8"
|
||||
CENTOS_MANTISBT_PROJECT_VERSION="8"
|
||||
REDHAT_SUPPORT_PRODUCT="centos"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION="8"
|
||||
|
||||
@@ -1,24 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Debian GNU/Linux"
|
||||
, version = Just "8 (jessie)"
|
||||
, id = "debian"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "8"
|
||||
, pretty_name = "Debian GNU/Linux 8 (jessie)"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "http://www.debian.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "http://www.debian.org/support/"
|
||||
, bug_report_url = Just "https://bugs.debian.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
@@ -1,8 +0,0 @@
|
||||
PRETTY_NAME="Debian GNU/Linux 8 (jessie)"
|
||||
NAME="Debian GNU/Linux"
|
||||
VERSION_ID="8"
|
||||
VERSION="8 (jessie)"
|
||||
ID=debian
|
||||
HOME_URL="http://www.debian.org/"
|
||||
SUPPORT_URL="http://www.debian.org/support/"
|
||||
BUG_REPORT_URL="https://bugs.debian.org/"
|
||||
@@ -1,24 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Linux"
|
||||
, version = Nothing
|
||||
, id = "linux"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Linux"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Nothing
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Nothing
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
@@ -1 +0,0 @@
|
||||
|
||||
@@ -1,24 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Exherbo"
|
||||
, version = Nothing
|
||||
, id = "exherbo"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Exherbo Linux"
|
||||
, ansi_color = Just "0;32"
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.exherbo.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "irc://irc.freenode.net/#exherbo"
|
||||
, bug_report_url = Just "https://bugs.exherbo.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
@@ -1,9 +0,0 @@
|
||||
NAME="Exherbo"
|
||||
PRETTY_NAME="Exherbo Linux"
|
||||
ID="exherbo"
|
||||
# comment
|
||||
ANSI_COLOR="0;32"
|
||||
HOME_URL="https://www.exherbo.org/"
|
||||
SUPPORT_URL="irc://irc.freenode.net/#exherbo"
|
||||
BUG_REPORT_URL="https://bugs.exherbo.org/"
|
||||
|
||||
@@ -1,49 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Fedora"
|
||||
, version = Just "31 (Container Image)"
|
||||
, id = "fedora"
|
||||
, id_like = Nothing
|
||||
, version_codename = Just ""
|
||||
, version_id = Just "31"
|
||||
, pretty_name = "Fedora 31 (Container Image)"
|
||||
, ansi_color = Just "0;34"
|
||||
, cpe_name = Just "cpe:/o:fedoraproject:fedora:31"
|
||||
, home_url = Just "https://fedoraproject.org/"
|
||||
, documentation_url = Just "https://docs.fedoraproject.org/en-US/fedora/f31/system-administrators-guide/"
|
||||
, support_url = Just "https://fedoraproject.org/wiki/Communicating_and_getting_help"
|
||||
, bug_report_url = Just "https://bugzilla.redhat.com/"
|
||||
, privacy_policy_url = Just "https://fedoraproject.org/wiki/Legal:PrivacyPolicy"
|
||||
, build_id = Nothing
|
||||
, variant = Just "Container Image"
|
||||
, variant_id = Just "container"
|
||||
, logo = Just "fedora-logo-icon"
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "31"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT"
|
||||
, "Fedora"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "Fedora"
|
||||
)
|
||||
,
|
||||
( "PLATFORM_ID"
|
||||
, "platform:f31"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
|
||||
, "31"
|
||||
)
|
||||
,
|
||||
( "LOGO"
|
||||
, "fedora-logo-icon"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
21
3rdparty/os-release/tests/Golden/data/fedora.in
vendored
21
3rdparty/os-release/tests/Golden/data/fedora.in
vendored
@@ -1,21 +0,0 @@
|
||||
NAME=Fedora
|
||||
VERSION="31 (Container Image)"
|
||||
ID=fedora
|
||||
VERSION_ID=31
|
||||
VERSION_CODENAME=""
|
||||
PLATFORM_ID="platform:f31"
|
||||
PRETTY_NAME="Fedora 31 (Container Image)"
|
||||
ANSI_COLOR="0;34"
|
||||
LOGO=fedora-logo-icon
|
||||
CPE_NAME="cpe:/o:fedoraproject:fedora:31"
|
||||
HOME_URL="https://fedoraproject.org/"
|
||||
DOCUMENTATION_URL="https://docs.fedoraproject.org/en-US/fedora/f31/system-administrators-guide/"
|
||||
SUPPORT_URL="https://fedoraproject.org/wiki/Communicating_and_getting_help"
|
||||
BUG_REPORT_URL="https://bugzilla.redhat.com/"
|
||||
REDHAT_BUGZILLA_PRODUCT="Fedora"
|
||||
REDHAT_BUGZILLA_PRODUCT_VERSION=31
|
||||
REDHAT_SUPPORT_PRODUCT="Fedora"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION=31
|
||||
PRIVACY_POLICY_URL="https://fedoraproject.org/wiki/Legal:PrivacyPolicy"
|
||||
VARIANT="Container Image"
|
||||
VARIANT_ID=container
|
||||
@@ -1,24 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Gentoo"
|
||||
, version = Nothing
|
||||
, id = "gentoo"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Gentoo/Linux"
|
||||
, ansi_color = Just "1;32"
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.gentoo.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "https://www.gentoo.org/support/"
|
||||
, bug_report_url = Just "https://bugs.gentoo.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
@@ -1,8 +0,0 @@
|
||||
NAME=Gentoo
|
||||
ID=gentoo
|
||||
PRETTY_NAME="Gentoo/Linux"
|
||||
ANSI_COLOR="1;32"
|
||||
HOME_URL="https://www.gentoo.org/"
|
||||
SUPPORT_URL="https://www.gentoo.org/support/"
|
||||
BUG_REPORT_URL="https://bugs.gentoo.org/"
|
||||
|
||||
@@ -1,29 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Linux Mint"
|
||||
, version = Just "18.2 (Sonya)"
|
||||
, id = "linuxmint"
|
||||
, id_like = Just "ubuntu"
|
||||
, version_codename = Just "sonya"
|
||||
, version_id = Just "18.2"
|
||||
, pretty_name = "Linux Mint 18.2"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "http://www.linuxmint.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "http://forums.linuxmint.com/"
|
||||
, bug_report_url = Just "http://bugs.launchpad.net/linuxmint/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "UBUNTU_CODENAME"
|
||||
, "xenial"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
12
3rdparty/os-release/tests/Golden/data/mint.in
vendored
12
3rdparty/os-release/tests/Golden/data/mint.in
vendored
@@ -1,12 +0,0 @@
|
||||
NAME="Linux Mint"
|
||||
VERSION="18.2 (Sonya)"
|
||||
ID=linuxmint
|
||||
ID_LIKE=ubuntu
|
||||
PRETTY_NAME="Linux Mint 18.2"
|
||||
VERSION_ID="18.2"
|
||||
HOME_URL="http://www.linuxmint.com/"
|
||||
SUPPORT_URL="http://forums.linuxmint.com/"
|
||||
BUG_REPORT_URL="http://bugs.launchpad.net/linuxmint/"
|
||||
VERSION_CODENAME=sonya
|
||||
UBUNTU_CODENAME=xenial
|
||||
|
||||
@@ -1,41 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Red Hat Enterprise Linux Server"
|
||||
, version = Just "7.6 (Maipo)"
|
||||
, id = "rhel"
|
||||
, id_like = Just "fedora"
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "7.6"
|
||||
, pretty_name = "Red Hat Enterprise Linux"
|
||||
, ansi_color = Just "0;31"
|
||||
, cpe_name = Just "cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
, home_url = Just "https://www.redhat.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugzilla.redhat.com/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Just "Server"
|
||||
, variant_id = Just "server"
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT"
|
||||
, "Red Hat Enterprise Linux 7"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "Red Hat Enterprise Linux"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
17
3rdparty/os-release/tests/Golden/data/red-hat.in
vendored
17
3rdparty/os-release/tests/Golden/data/red-hat.in
vendored
@@ -1,17 +0,0 @@
|
||||
NAME="Red Hat Enterprise Linux Server"
|
||||
VERSION="7.6 (Maipo)"
|
||||
ID="rhel"
|
||||
ID_LIKE="fedora"
|
||||
VARIANT="Server"
|
||||
VARIANT_ID="server"
|
||||
VERSION_ID="7.6"
|
||||
PRETTY_NAME="Red Hat Enterprise Linux"
|
||||
ANSI_COLOR="0;31"
|
||||
CPE_NAME="cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
HOME_URL="https://www.redhat.com/"
|
||||
BUG_REPORT_URL="https://bugzilla.redhat.com/"
|
||||
|
||||
REDHAT_BUGZILLA_PRODUCT="Red Hat Enterprise Linux 7"
|
||||
REDHAT_BUGZILLA_PRODUCT_VERSION=7.6
|
||||
REDHAT_SUPPORT_PRODUCT="Red Hat Enterprise Linux"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION="7.6"
|
||||
@@ -1,49 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Red Hat Enterprise Linux Server"
|
||||
, version = Just "7.6 (Maipo)"
|
||||
, id = "rhel"
|
||||
, id_like = Just "fedora"
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "7.6"
|
||||
, pretty_name = "Red Hat Enterprise Linux"
|
||||
, ansi_color = Just "0;31"
|
||||
, cpe_name = Just "cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
, home_url = Just "https://www.redhat.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugzilla.redhat.com/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Just "Server"
|
||||
, variant_id = Just "server"
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT"
|
||||
, "Red Hat Enterprise Linux 7"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "Red Hat Enterprise Linux"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
]
|
||||
, parse_errors =
|
||||
[ TrivialError 520
|
||||
( Just
|
||||
( Tokens ( '\'' :| "" ) )
|
||||
)
|
||||
( fromList
|
||||
[ Label ( 'e' :| "nd of line" ) ]
|
||||
)
|
||||
]
|
||||
}
|
||||
@@ -1,18 +0,0 @@
|
||||
NAME="Red Hat Enterprise Linux Server"
|
||||
VERSION="7.6 (Maipo)"
|
||||
ID="rhel"
|
||||
ID_LIKE="fedora"
|
||||
VARIANT="Server"
|
||||
VARIANT_ID="server"
|
||||
VERSION_ID="7.6"
|
||||
PRETTY_NAME="Red Hat Enterprise Linux"
|
||||
ANSI_COLOR="0;31"
|
||||
CPE_NAME="cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
HOME_URL="https://www.redhat.com/"
|
||||
BUG_REPORT_URL="https://bugzilla.redhat.com/"
|
||||
|
||||
REDHAT_BUGZILLA_PRODUCT="Red Hat Enterprise Linux 7"
|
||||
REDHAT_BUGZILLA_PRODUCT_VERSION=7.6
|
||||
REDHAT_SUPPORT_PRODUCT="Red Hat Enterprise Linux"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION="7.6"
|
||||
foo=1.'
|
||||
@@ -1,29 +0,0 @@
|
||||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Ubuntu"
|
||||
, version = Just "20.04 LTS (Focal Fossa)"
|
||||
, id = "ubuntu"
|
||||
, id_like = Just "debian"
|
||||
, version_codename = Just "focal"
|
||||
, version_id = Just "20.04"
|
||||
, pretty_name = "Ubuntu 20.04 LTS"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.ubuntu.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "https://help.ubuntu.com/"
|
||||
, bug_report_url = Just "https://bugs.launchpad.net/ubuntu/"
|
||||
, privacy_policy_url = Just "https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "UBUNTU_CODENAME"
|
||||
, "focal"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
13
3rdparty/os-release/tests/Golden/data/ubuntu.in
vendored
13
3rdparty/os-release/tests/Golden/data/ubuntu.in
vendored
@@ -1,13 +0,0 @@
|
||||
NAME="Ubuntu"
|
||||
VERSION="20.04 LTS (Focal Fossa)"
|
||||
ID=ubuntu
|
||||
ID_LIKE=debian
|
||||
PRETTY_NAME="Ubuntu 20.04 LTS"
|
||||
VERSION_ID="20.04"
|
||||
HOME_URL="https://www.ubuntu.com/"
|
||||
SUPPORT_URL="https://help.ubuntu.com/"
|
||||
BUG_REPORT_URL="https://bugs.launchpad.net/ubuntu/"
|
||||
PRIVACY_POLICY_URL="https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
|
||||
VERSION_CODENAME=focal
|
||||
UBUNTU_CODENAME=focal
|
||||
|
||||
16
3rdparty/os-release/tests/Main.hs
vendored
16
3rdparty/os-release/tests/Main.hs
vendored
@@ -1,16 +0,0 @@
|
||||
import Golden.Real
|
||||
import Specs.Megaparsec
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hspec
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
ms <- testSpec "megaparsec spec" megaparsecSpec
|
||||
gs <- goldenTests
|
||||
defaultMain (tests [ms, gs])
|
||||
|
||||
tests :: [TestTree] -> TestTree
|
||||
tests ts = testGroup "Tests" (ts++[])
|
||||
|
||||
88
3rdparty/os-release/tests/Specs/Megaparsec.hs
vendored
88
3rdparty/os-release/tests/Specs/Megaparsec.hs
vendored
@@ -1,88 +0,0 @@
|
||||
module Specs.Megaparsec where
|
||||
|
||||
import System.OsRelease
|
||||
|
||||
import Data.Either
|
||||
import Data.Void
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Megaparsec
|
||||
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
megaparsecSpec :: Spec
|
||||
megaparsecSpec = do
|
||||
describe "parseAssignment" $ do
|
||||
it "parses simple value" $ shouldParse' "foo=bar" ("foo", "bar")
|
||||
it "parses single quoted value" $ shouldParse' "foo='bar'" ("foo", "bar")
|
||||
it "parses double quoted value" $ shouldParse' "foo=\"bar\"" ("foo", "bar")
|
||||
|
||||
it "parses _ var" $ shouldParse' "f_x=''" ("f_x", "")
|
||||
|
||||
-- this is not valid per spec, but many files do this
|
||||
it "parses ._- in unquoted assignment"
|
||||
$ shouldParse' "VERSION_ID=bar-1.9_rc2" ("VERSION_ID", "bar-1.9_rc2")
|
||||
|
||||
it "parses quoted space" $ shouldParse' "f='a b'" ("f", "a b")
|
||||
it "parses quoted -" $ shouldParse' "f='a-b'" ("f", "a-b")
|
||||
|
||||
it "parses special \\" $ shouldParse' "foo='ba\\\\r'" ("foo", "ba\\r")
|
||||
it "parses special `" $ shouldParse' "foo='ba\\`r'" ("foo", "ba`r")
|
||||
it "parses special '" $ shouldParse' "foo='ba\\'r'" ("foo", "ba'r")
|
||||
it "parses special $" $ shouldParse' "foo='ba\\$r'" ("foo", "ba$r")
|
||||
it "parses special \"" $ shouldParse' "foo=\"ba\\\"r\"" ("foo", "ba\"r")
|
||||
|
||||
it "parses empty val noquotes" $ shouldParse' "foo=" ("foo", "")
|
||||
it "parses empty val quote \"" $ shouldParse' "foo=\"\"" ("foo", "")
|
||||
it "parses empty val quote '" $ shouldParse' "foo=''" ("foo", "")
|
||||
|
||||
it "breaks on comments" $ shouldFail' "# foo=\"bar'"
|
||||
it "breaks on misquoting 1" $ shouldFail' "foo=\"bar'"
|
||||
it "breaks on misquoting 2" $ shouldFail' "foo='bar\""
|
||||
it "breaks on unquoted $" $ shouldFail' "foo='ba$r'"
|
||||
it "breaks on unquoted `" $ shouldFail' "foo='ba`r'"
|
||||
it "breaks on unquoted \"" $ shouldFail' "foo=\"ba\"r\""
|
||||
it "breaks on unquoted '" $ shouldFail' "foo='ba'r'"
|
||||
it "breaks on unquoted \\" $ shouldFail' "foo='ba\\r'"
|
||||
it "breaks on unquoted val with space" $ shouldFail' "foo=ba r"
|
||||
it "breaks on unquoted val with ;" $ shouldFail' "foo=ba;r"
|
||||
it "breaks on unquoted val with \\" $ shouldFail' "foo=ba\\r"
|
||||
it "breaks on trailing NL" $ shouldFail' "foo=bar\n"
|
||||
|
||||
|
||||
describe "parseAssignments" $ do
|
||||
it "parses simple values" $ shouldParseMany "foo=bar" [("foo", "bar")]
|
||||
|
||||
it "parses multiple values"
|
||||
$ shouldParseMany "foo=bar\nbar=baz" [("foo", "bar"), ("bar", "baz")]
|
||||
it "parses multiple values with comments" $ shouldParseMany
|
||||
"foo=bar\n# comment\nbar=baz"
|
||||
[("foo", "bar"), ("bar", "baz")]
|
||||
|
||||
it "parses gracefully" $ shouldParseMany "foo=bar\nbar=baz\"" [("foo", "bar")]
|
||||
|
||||
it "parses empty files" $ shouldParseMany "" []
|
||||
it "parses empty files with newlines" $ shouldParseMany "\n\n" []
|
||||
it "parses empty files with newlines and comments"
|
||||
$ shouldParseMany "\n\n#\n" []
|
||||
|
||||
it "parses comments with leading spaces" $ shouldParseMany " #" []
|
||||
|
||||
parse :: String -> Either (MP.ParseErrorBundle String Void) (String, String)
|
||||
parse = MP.parse (parseAssignment <* MP.eof) ""
|
||||
|
||||
shouldParse' :: String -> (String, String) -> Expectation
|
||||
shouldParse' s s' = parse s `shouldParse` s'
|
||||
|
||||
shouldFail' :: String -> Expectation
|
||||
shouldFail' s = parse `shouldFailOn` s
|
||||
|
||||
parseMany :: String
|
||||
-> Either (MP.ParseErrorBundle String Void) [(String, String)]
|
||||
parseMany = fmap rights . MP.parse parseAssignments ""
|
||||
|
||||
shouldParseMany :: String -> [(String, String)] -> Expectation
|
||||
shouldParseMany s s' = parseMany s `shouldParse` s'
|
||||
|
||||
shouldFailMany :: String -> Expectation
|
||||
shouldFailMany s = parseMany `shouldFailOn` s
|
||||
10
CHANGELOG.md
10
CHANGELOG.md
@@ -1,5 +1,15 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.6 -- 2020-07-13
|
||||
|
||||
* Create a new curses (brick) based TUI, accessible via `ghcup tui` #24
|
||||
* Support multiple installed versions of cabal #23
|
||||
* Improvements to `ghcup list` (show unavailable bindists for platform)
|
||||
* Fix redhat downloads #29
|
||||
* Support for hadrian bindists (fixes alpine-8.10.1) #31
|
||||
* Add FreeBSD bindists 8.6.5 and 8.8.3
|
||||
* Fix memory leak during unpack
|
||||
|
||||
## 0.1.5 -- 2020-04-30
|
||||
|
||||
* Fix errors when PATH variable contains path components that are actually files
|
||||
|
||||
@@ -40,7 +40,13 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
|
||||
|
||||
See `ghcup --help`.
|
||||
|
||||
Common use cases are:
|
||||
For the simple interactive TUI, run:
|
||||
|
||||
```sh
|
||||
ghcup tui
|
||||
```
|
||||
|
||||
For the full functionality via cli:
|
||||
|
||||
```sh
|
||||
# list available ghc/cabal versions
|
||||
|
||||
@@ -179,7 +179,7 @@ validateTarballs dls = do
|
||||
|
||||
where
|
||||
downloadAll dli = do
|
||||
let settings = Settings True False Never Curl
|
||||
let settings = Settings True False Never Curl False
|
||||
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
||||
, colorOutter = B.hPut stderr
|
||||
, rawOutter = (\_ -> pure ())
|
||||
|
||||
365
app/ghcup/BrickMain.hs
Normal file
365
app/ghcup/BrickMain.hs
Normal file
@@ -0,0 +1,365 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module BrickMain where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Border
|
||||
import Brick.Widgets.Border.Style
|
||||
import Brick.Widgets.Center
|
||||
import Brick.Widgets.List
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive
|
||||
#endif
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Bool
|
||||
import Data.Functor
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Char
|
||||
import Data.IORef
|
||||
import Data.String.Interpolate
|
||||
import Data.Vector ( Vector )
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
|
||||
|
||||
data AppState = AppState {
|
||||
lr :: LR
|
||||
, dls :: GHCupDownloads
|
||||
, pfreq :: PlatformRequest
|
||||
}
|
||||
|
||||
type LR = GenericList String Vector ListResult
|
||||
|
||||
|
||||
keyHandlers :: [(Char, String, AppState -> EventM n (Next AppState))]
|
||||
keyHandlers =
|
||||
[ ('q', "Quit" , halt)
|
||||
, ('i', "Install" , withIOAction install')
|
||||
, ('u', "Uninstall", withIOAction del')
|
||||
, ('s', "Set" , withIOAction set')
|
||||
, ('c', "ChangeLog", withIOAction changelog')
|
||||
]
|
||||
|
||||
|
||||
ui :: AppState -> Widget String
|
||||
ui AppState {..} =
|
||||
( padBottom Max
|
||||
$ ( withBorderStyle unicode
|
||||
$ borderWithLabel (str "GHCup")
|
||||
$ (center $ renderList renderItem True lr)
|
||||
)
|
||||
)
|
||||
<=> ( withAttr "help"
|
||||
. txtWrap
|
||||
. T.pack
|
||||
. foldr1 (\x y -> x <> " " <> y)
|
||||
. (++ ["↑↓:Navigation"])
|
||||
$ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
|
||||
)
|
||||
|
||||
where
|
||||
renderItem b ListResult {..} =
|
||||
let marks = if
|
||||
| lSet -> (withAttr "set" $ str "✔✔")
|
||||
| lInstalled -> (withAttr "installed" $ str "✓ ")
|
||||
| otherwise -> (withAttr "not-installed" $ str "✗ ")
|
||||
ver = case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
dim = if lNoBindist
|
||||
then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
|
||||
else id
|
||||
in dim
|
||||
( marks
|
||||
<+> ( padLeft (Pad 2)
|
||||
$ minHSize 20
|
||||
$ ((if b then withAttr "active" else id)
|
||||
(str $ (fmap toLower . show $ lTool) <> " " <> ver)
|
||||
)
|
||||
)
|
||||
<+> (padLeft (Pad 1) $ if null lTag
|
||||
then emptyWidget
|
||||
else
|
||||
foldr1 (\x y -> x <+> str "," <+> y)
|
||||
$ (fmap printTag $ sort lTag)
|
||||
)
|
||||
)
|
||||
|
||||
printTag Recommended = withAttr "recommended" $ str "recommended"
|
||||
printTag Latest = withAttr "latest" $ str "latest"
|
||||
printTag (Base pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
printTag (UnknownTag t ) = str t
|
||||
|
||||
|
||||
minHSize :: Int -> Widget n -> Widget n
|
||||
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
||||
|
||||
|
||||
app :: App AppState e String
|
||||
app = App { appDraw = \st -> [ui st]
|
||||
, appHandleEvent = eventHandler
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const defaultAttributes
|
||||
, appChooseCursor = neverShowCursor
|
||||
}
|
||||
|
||||
defaultAttributes :: AttrMap
|
||||
defaultAttributes = attrMap
|
||||
Vty.defAttr
|
||||
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue)
|
||||
, ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red)
|
||||
, ("set" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("installed" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("recommended" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("latest" , Vty.defAttr `Vty.withForeColor` Vty.yellow)
|
||||
, ("help" , Vty.defAttr `Vty.withStyle` Vty.italic)
|
||||
]
|
||||
|
||||
|
||||
dimAttributes :: AttrMap
|
||||
dimAttributes = attrMap
|
||||
(Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue)
|
||||
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
]
|
||||
|
||||
|
||||
|
||||
eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState)
|
||||
eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st
|
||||
eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st
|
||||
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st
|
||||
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
|
||||
continue (AppState (listMoveUp lr) dls pfreq)
|
||||
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
|
||||
continue (AppState (listMoveDown lr) dls pfreq)
|
||||
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
|
||||
case find (\(c', _, _) -> c' == c) keyHandlers of
|
||||
Nothing -> continue as
|
||||
Just (_, _, handler) -> handler as
|
||||
eventHandler st _ = continue st
|
||||
|
||||
|
||||
-- | Suspend the current UI and run an IO action in terminal. If the
|
||||
-- IO action returns a Left value, then it's thrown as userError.
|
||||
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
|
||||
-> AppState
|
||||
-> EventM n (Next AppState)
|
||||
withIOAction action as = case listSelectedElement (lr as) of
|
||||
Nothing -> continue as
|
||||
Just (ix, e) -> suspendAndResume $ do
|
||||
r <- action as (ix, e)
|
||||
case r of
|
||||
Left err -> throwIO $ userError err
|
||||
Right _ -> do
|
||||
apps <- (fmap . fmap)
|
||||
(\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
|
||||
$ getAppState Nothing (pfreq as)
|
||||
case apps of
|
||||
Right nas -> do
|
||||
putStrLn "Press enter to continue"
|
||||
_ <- getLine
|
||||
pure nas
|
||||
Left err -> throwIO $ userError err
|
||||
|
||||
|
||||
install' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
||||
install' AppState {..} (_, ListResult {..}) = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let
|
||||
run =
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[AlreadyInstalled
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
, DistroNotFound
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NoCompatibleArch
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, NoCompatiblePlatform
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, DownloadFailed
|
||||
, NoUpdate]
|
||||
|
||||
(run $ do
|
||||
case lTool of
|
||||
GHC -> liftE $ installGHCBin dls lVer pfreq
|
||||
Cabal -> liftE $ installCabalBin dls lVer pfreq
|
||||
GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
VLeft (V (BuildFailed _ e)) ->
|
||||
pure $ Left [i|Build failed with #{e}|]
|
||||
VLeft (V NoDownload) ->
|
||||
pure $ Left [i|No available version for #{prettyVer lVer}|]
|
||||
VLeft (V NoUpdate) -> pure $ Right ()
|
||||
VLeft e -> pure $ Left [i|#{e}
|
||||
Also check the logs in ~/.ghcup/logs|]
|
||||
|
||||
|
||||
set' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
||||
set' _ (_, ListResult {..}) = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let run =
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
. runE @'[FileDoesNotExistError, NotInstalled, TagNotFound]
|
||||
|
||||
(run $ do
|
||||
case lTool of
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
|
||||
Cabal -> liftE $ setCabal lVer $> ()
|
||||
GHCup -> pure ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
VLeft e -> pure $ Left [i|#{e}|]
|
||||
|
||||
|
||||
del' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
||||
del' _ (_, ListResult {..}) = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let run = runLogger . flip runReaderT settings . runE @'[NotInstalled]
|
||||
|
||||
(run $ do
|
||||
case lTool of
|
||||
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> ()
|
||||
Cabal -> liftE $ rmCabalVer lVer $> ()
|
||||
GHCup -> pure ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
VLeft e -> pure $ Left [i|#{e}|]
|
||||
|
||||
|
||||
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
||||
changelog' AppState {..} (_, ListResult {..}) = do
|
||||
case getChangeLog dls lTool (Left lVer) of
|
||||
Nothing -> pure $ Left
|
||||
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
|
||||
Just uri -> do
|
||||
let cmd = case _rPlatform pfreq of
|
||||
Darwin -> "open"
|
||||
Linux _ -> "xdg-open"
|
||||
FreeBSD -> "xdg-open"
|
||||
exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
|
||||
Right _ -> pure $ Right ()
|
||||
Left e -> pure $ Left [i|#{e}|]
|
||||
|
||||
|
||||
uri' :: IORef (Maybe URI)
|
||||
{-# NOINLINE uri' #-}
|
||||
uri' = unsafePerformIO (newIORef Nothing)
|
||||
|
||||
|
||||
settings' :: IORef Settings
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO
|
||||
(newIORef Settings { cache = True
|
||||
, noVerify = False
|
||||
, keepDirs = Never
|
||||
, downloader = Curl
|
||||
, verbose = False
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
logger' :: IORef LoggerConfig
|
||||
{-# NOINLINE logger' #-}
|
||||
logger' = unsafePerformIO
|
||||
(newIORef $ LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO ()
|
||||
brickMain s muri l av pfreq' = do
|
||||
writeIORef uri' muri
|
||||
writeIORef settings' s
|
||||
-- logger interpreter
|
||||
writeIORef logger' l
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
eApps <- getAppState (Just av) pfreq'
|
||||
case eApps of
|
||||
Right as -> defaultMain app (selectLatest as) $> ()
|
||||
Left e -> do
|
||||
runLogger ($(logError) [i|Error building app state: #{show e}|])
|
||||
exitWith $ ExitFailure 2
|
||||
where
|
||||
selectLatest :: AppState -> AppState
|
||||
selectLatest AppState {..} =
|
||||
(\ix -> AppState { lr = listMoveTo ix lr, .. })
|
||||
. fromJust
|
||||
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
|
||||
$ (listElements lr)
|
||||
|
||||
|
||||
getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState)
|
||||
getAppState mg pfreq' = do
|
||||
muri <- readIORef uri'
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
r <-
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
. runE
|
||||
@'[JSONError, DownloadFailed, FileDoesNotExistError]
|
||||
$ do
|
||||
dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg
|
||||
|
||||
lV <- lift $ listVersions dls Nothing Nothing pfreq'
|
||||
pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls pfreq')
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
VLeft e -> pure $ Left [i|#{e}|]
|
||||
@@ -10,6 +10,10 @@
|
||||
|
||||
module Main where
|
||||
|
||||
#if defined(BRICK)
|
||||
import BrickMain ( brickMain )
|
||||
#endif
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
@@ -24,7 +28,9 @@ import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Version
|
||||
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive
|
||||
#endif
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -95,6 +101,9 @@ data Command
|
||||
| Upgrade UpgradeOpts Bool
|
||||
| ToolRequirements
|
||||
| ChangeLog ChangeLogOptions
|
||||
#if defined(BRICK)
|
||||
| Interactive
|
||||
#endif
|
||||
|
||||
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
|
||||
| ToolTag Tag
|
||||
@@ -223,7 +232,20 @@ opts =
|
||||
com :: Parser Command
|
||||
com =
|
||||
subparser
|
||||
#if defined(BRICK)
|
||||
( command
|
||||
"tui"
|
||||
( (\_ -> Interactive)
|
||||
<$> (info
|
||||
helper
|
||||
( progDesc "Start the interactive GHCup UI"
|
||||
)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
#else
|
||||
( command
|
||||
#endif
|
||||
"install"
|
||||
( Install
|
||||
<$> (info
|
||||
@@ -786,6 +808,7 @@ toSettings Options {..} =
|
||||
noVerify = optNoVerify
|
||||
keepDirs = optKeepDirs
|
||||
downloader = optsDownloader
|
||||
verbose = optVerbose
|
||||
in Settings { .. }
|
||||
|
||||
|
||||
@@ -870,11 +893,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- initGHCupFileLogging [rel|ghcup.log|]
|
||||
let runLogger = myLoggerT LoggerConfig
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = optVerbose
|
||||
, colorOutter = B.hPut stderr
|
||||
, rawOutter = appendFile logfile
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
|
||||
|
||||
-------------------------
|
||||
@@ -888,14 +912,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
, DistroNotFound
|
||||
#endif
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NoCompatibleArch
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, NoCompatiblePlatform
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
@@ -910,7 +933,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
, TagNotFound
|
||||
, TagNotFound
|
||||
]
|
||||
|
||||
let
|
||||
@@ -921,9 +943,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, TagNotFound
|
||||
]
|
||||
|
||||
let runListGHC = runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||
let runListGHC = runLogger
|
||||
|
||||
let runRmGHC =
|
||||
let runRm =
|
||||
runLogger . flip runReaderT settings . runE @'[NotInstalled]
|
||||
|
||||
let runDebugInfo =
|
||||
@@ -940,16 +962,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
@'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, GHCupSetError
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotFoundInPATH
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
|
||||
let runCompileCabal =
|
||||
@@ -961,15 +982,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, BuildFailed
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
|
||||
let runUpgrade =
|
||||
@@ -978,9 +998,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ DigestError
|
||||
, DistroNotFound
|
||||
, NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, NoDownload
|
||||
, NoUpdate
|
||||
, FileDoesNotExistError
|
||||
@@ -989,9 +1006,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
|
||||
---------------------------
|
||||
-- Getting download info --
|
||||
---------------------------
|
||||
----------------------------------------
|
||||
-- Getting download and platform info --
|
||||
----------------------------------------
|
||||
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
) >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) [i|Error determining Platform: #{e}|])
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
|
||||
(GHCupInfo treq dls) <-
|
||||
( runLogger
|
||||
@@ -1006,14 +1033,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger
|
||||
($(logError) [i|Error fetching download info: #{e}|])
|
||||
exitWith (ExitFailure 2)
|
||||
(runLogger
|
||||
. runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ checkForUpdates dls
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) [i|Error checking for upgrades: #{e}|])
|
||||
runLogger $ checkForUpdates dls pfreq
|
||||
|
||||
|
||||
|
||||
-----------------------
|
||||
@@ -1023,7 +1044,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
let installGHC InstallOptions{..} =
|
||||
(runInstTool $ do
|
||||
v <- liftE $ fromVersion dls instVer GHC
|
||||
liftE $ installGHCBin dls (_tvVersion v) instPlatform -- FIXME: ugly sharing of tool version
|
||||
liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
@@ -1057,7 +1078,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
let installCabal InstallOptions{..} =
|
||||
(runInstTool $ do
|
||||
v <- liftE $ fromVersion dls instVer Cabal
|
||||
liftE $ installCabalBin dls (_tvVersion v) instPlatform -- FIXME: ugly sharing of tool version
|
||||
liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
@@ -1107,7 +1128,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let rmGHC' RmOptions{..} =
|
||||
(runRmGHC $ do
|
||||
(runRm $ do
|
||||
liftE $ rmGHCVer ghcVer
|
||||
)
|
||||
>>= \case
|
||||
@@ -1117,7 +1138,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure $ ExitFailure 7
|
||||
|
||||
let rmCabal' tv =
|
||||
(runSetCabal $ do
|
||||
(runRm $ do
|
||||
liftE $ rmCabalVer tv
|
||||
)
|
||||
>>= \case
|
||||
@@ -1129,6 +1150,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
|
||||
res <- case optCommand of
|
||||
#if defined(BRICK)
|
||||
Interactive -> liftIO $ brickMain settings optUrlSource loggerConfig dls pfreq >> pure ExitSuccess
|
||||
#endif
|
||||
Install (Right iopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
|
||||
installGHC iopts
|
||||
@@ -1146,16 +1170,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
List (ListOptions {..}) ->
|
||||
(runListGHC $ do
|
||||
l <- listVersions dls lTool lCriteria
|
||||
pure l
|
||||
l <- listVersions dls lTool lCriteria pfreq
|
||||
liftIO $ printListResult lRawFormat l
|
||||
pure ExitSuccess
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> do
|
||||
liftIO $ printListResult lRawFormat r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 6
|
||||
|
||||
Rm (Right rmopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|])
|
||||
@@ -1182,6 +1200,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
buildConfig
|
||||
patchDir
|
||||
addConfArgs
|
||||
pfreq
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
@@ -1206,7 +1225,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
|
||||
Compile (CompileCabal CabalCompileOptions {..}) ->
|
||||
(runCompileCabal $ do
|
||||
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir
|
||||
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir pfreq
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
@@ -1237,7 +1256,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
bdir <- liftIO $ ghcupBinDir
|
||||
pure (Just (bdir </> [rel|ghcup|]))
|
||||
|
||||
(runUpgrade $ (liftE $ upgradeGHCup dls target force)) >>= \case
|
||||
(runUpgrade $ (liftE $ upgradeGHCup dls target force pfreq)) >>= \case
|
||||
VRight v' -> do
|
||||
let pretty_v = prettyVer v'
|
||||
runLogger $ $(logInfo)
|
||||
@@ -1289,9 +1308,14 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
pure ExitSuccess
|
||||
Just uri -> do
|
||||
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
|
||||
cmd = case _rPlatform pfreq of
|
||||
Darwin -> "open"
|
||||
Linux _ -> "xdg-open"
|
||||
FreeBSD -> "xdg-open"
|
||||
|
||||
if clOpen
|
||||
then
|
||||
exec "xdg-open"
|
||||
exec cmd
|
||||
True
|
||||
[serializeURIRef' uri]
|
||||
Nothing
|
||||
@@ -1383,37 +1407,32 @@ printListResult raw lr = do
|
||||
|
||||
checkForUpdates :: (MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
|
||||
=> GHCupDownloads
|
||||
-> Excepts
|
||||
'[ NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, DistroNotFound
|
||||
]
|
||||
m
|
||||
()
|
||||
checkForUpdates dls = do
|
||||
-> PlatformRequest
|
||||
-> m ()
|
||||
checkForUpdates dls pfreq = do
|
||||
forM_ (getLatest dls GHCup) $ \l -> do
|
||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
when (l > ghc_ver)
|
||||
$ lift $ $(logWarn)
|
||||
$ $(logWarn)
|
||||
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
|
||||
|
||||
forM_ (getLatest dls GHC) $ \l -> do
|
||||
mghc_ver <- latestInstalled GHC
|
||||
forM mghc_ver $ \ghc_ver ->
|
||||
when (l > ghc_ver)
|
||||
$ lift $ $(logWarn)
|
||||
$ $(logWarn)
|
||||
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
|
||||
|
||||
forM_ (getLatest dls Cabal) $ \l -> do
|
||||
mcabal_ver <- latestInstalled Cabal
|
||||
forM mcabal_ver $ \cabal_ver ->
|
||||
when (l > cabal_ver)
|
||||
$ lift $ $(logWarn)
|
||||
$ $(logWarn)
|
||||
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
|
||||
|
||||
where
|
||||
latestInstalled tool = (fmap lVer . lastMay)
|
||||
<$> (listVersions dls (Just tool) (Just ListInstalled))
|
||||
<$> (listVersions dls (Just tool) (Just ListInstalled) pfreq)
|
||||
|
||||
|
||||
prettyDebugInfo :: DebugInfo -> String
|
||||
|
||||
@@ -28,7 +28,7 @@ eghcup() {
|
||||
download_ghcup() {
|
||||
_plat="$(uname -s)"
|
||||
_arch=$(uname -m)
|
||||
_ghver="0.1.5"
|
||||
_ghver="0.1.6"
|
||||
|
||||
case "${_plat}" in
|
||||
"linux"|"Linux")
|
||||
@@ -65,7 +65,7 @@ download_ghcup() {
|
||||
*) die "Unknown architecture: ${_arch}"
|
||||
;;
|
||||
esac
|
||||
_url=https://downloads.haskell.org/~ghcup/0.1.5/x86_64-apple-darwin-ghcup-0.1.5-p2 ;;
|
||||
_url=https://downloads.haskell.org/~ghcup/${_ghver}/x86_64-apple-darwin-ghcup-${_ghver} ;;
|
||||
*) die "Unknown platform: ${_plat}"
|
||||
;;
|
||||
esac
|
||||
|
||||
@@ -2,6 +2,12 @@ packages: ./ghcup.cabal
|
||||
|
||||
optional-packages: ./3rdparty/*/*.cabal
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/haskus/packages.git
|
||||
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
|
||||
subdir: haskus-utils-types
|
||||
|
||||
optimization: 2
|
||||
|
||||
package streamly
|
||||
@@ -15,4 +21,4 @@ constraints: http-io-streams -brotli
|
||||
package libarchive
|
||||
flags: static
|
||||
|
||||
allow-newer: base
|
||||
allow-newer: base ghc-prim template-haskell
|
||||
|
||||
@@ -698,6 +698,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-alpine3.10-linux-integer-simple.tar.xz"
|
||||
}
|
||||
},
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "52d27dbf9de82005dde9bfc521bff612e381b5228af194259c2306d2b75825c2",
|
||||
"dlSubdir": "ghc-8.10.1",
|
||||
"dlUri": "https://downloads.haskell.org/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "d1cf7886f27af070f3b7dbe1975a78b43ef2d32b86362cbe953e79464fe70761",
|
||||
@@ -849,6 +856,13 @@
|
||||
"dlUri": "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"
|
||||
}
|
||||
},
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "83a3059a630d40a98e26cb5b520354e12094a96e36ba2f5ab002dad94cf2fb37",
|
||||
"dlSubdir": "ghc-8.6.5",
|
||||
"dlUri": "https://files.hasufell.de/ghc/ghc-8.6.5-x86_64-portbld-freebsd.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "bc75f5601a9f41d58b2ba161b9e28fad52143a7229060f1e084168d9b2e914df",
|
||||
@@ -2002,6 +2016,13 @@
|
||||
"dlUri": "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"
|
||||
}
|
||||
},
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "569719075b4d14b3875a899df522090ae31e6fe085e6dffe518e875b09a2f0be",
|
||||
"dlSubdir": "ghc-8.8.3",
|
||||
"dlUri": "https://files.hasufell.de/ghc/ghc-8.8.3-x86_64-portbld-freebsd.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "42fde2ef5a143e1e6b47ae8875162ea2d4d54b06f0f7fa32ee4f0eb86f2be7ad",
|
||||
@@ -2301,37 +2322,37 @@
|
||||
}
|
||||
},
|
||||
"GHCup": {
|
||||
"0.1.5": {
|
||||
"0.1.6": {
|
||||
"viArch": {
|
||||
"A_64": {
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "6dd57cc5958ef3a6ba7de22808d9292d31dada8af95277578b69be35fc090194",
|
||||
"dlHash": "52707d89c3a4114b577855612d915c1e10295c4354e7e641b4a37a90c34fea53",
|
||||
"dlSubdir": null,
|
||||
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.5/x86_64-portbld-freebsd-ghcup-0.1.5"
|
||||
"dlUri": "https://downloads.haskell.org/ghcup/0.1.6/x86_64-portbld-freebsd-ghcup-0.1.6"
|
||||
}
|
||||
},
|
||||
"Darwin": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "456770c3b1510d44a0e401e0677faa9f5670ef81a11646f47cbba1b95404e788",
|
||||
"dlHash": "bbf56b5820f97b5ee15d292803a2df06922d31b396f9322459f9e3782e78d59c",
|
||||
"dlSubdir": null,
|
||||
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.5/x86_64-apple-darwin-ghcup-0.1.5-p2"
|
||||
"dlUri": "https://downloads.haskell.org/ghcup/0.1.6/x86_64-apple-darwin-ghcup-0.1.6"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "cfdb01dde77121859b5d90b6707238b54e23787fcbb3003e18ab52a5dbfee330",
|
||||
"dlHash": "bdbec0cdf4c8511c4082dd83993d15034c0fbcb5722ecf418c1cee40667da8af",
|
||||
"dlSubdir": null,
|
||||
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.5/x86_64-linux-ghcup-0.1.5"
|
||||
"dlUri": "https://downloads.haskell.org/ghcup/0.1.6/x86_64-linux-ghcup-0.1.6"
|
||||
}
|
||||
}
|
||||
},
|
||||
"A_32": {
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "3707f60d703912709335dc0103fb1af5e5dfa83050825a8156b56bc81760b2a8",
|
||||
"dlHash": "0366ed6c00862c3c002cdefc3e37523ad80e655387956c7ab58b268aaa6fae5d",
|
||||
"dlSubdir": null,
|
||||
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.5/i386-linux-ghcup-0.1.5"
|
||||
"dlUri": "https://downloads.haskell.org/ghcup/0.1.6/i386-linux-ghcup-0.1.6"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
49
ghcup.cabal
49
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.5
|
||||
version: 0.1.6
|
||||
synopsis: ghc toolchain installer as an exe/library
|
||||
description:
|
||||
A rewrite of the shell script ghcup, for providing
|
||||
@@ -21,11 +21,21 @@ source-repository head
|
||||
type: git
|
||||
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
|
||||
|
||||
flag tui
|
||||
description: Build the brick powered tui (ghcup tui)
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag internal-downloader
|
||||
description: Compile the internal downloader, which links against OpenSSL
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag tar
|
||||
description: Use tar-bytestring instead of libarchive
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
common HsOpenSSL
|
||||
build-depends: HsOpenSSL >=0.11.4.18
|
||||
|
||||
@@ -50,6 +60,9 @@ common base16-bytestring
|
||||
common binary
|
||||
build-depends: binary >=0.8.6.0
|
||||
|
||||
common brick
|
||||
build-depends: brick >=0.54
|
||||
|
||||
common bytestring
|
||||
build-depends: bytestring >=0.10
|
||||
|
||||
@@ -158,15 +171,17 @@ common string-interpolate
|
||||
common table-layout
|
||||
build-depends: table-layout >=0.8
|
||||
|
||||
|
||||
common template-haskell
|
||||
build-depends: template-haskell >=2.7
|
||||
|
||||
common tar-bytestring
|
||||
build-depends: tar-bytestring >=0.6.3.1
|
||||
|
||||
common terminal-progress-bar
|
||||
build-depends: terminal-progress-bar >=0.4.1
|
||||
|
||||
common text
|
||||
build-depends: text >=1.2
|
||||
build-depends: text >=1.2.4.0
|
||||
|
||||
common time
|
||||
build-depends: time >=1.9.3
|
||||
@@ -198,6 +213,9 @@ common vector
|
||||
common versions
|
||||
build-depends: versions >=3.5
|
||||
|
||||
common vty
|
||||
build-depends: vty >=5.28.2
|
||||
|
||||
common word8
|
||||
build-depends: word8 >=0.1.3
|
||||
|
||||
@@ -243,7 +261,6 @@ library
|
||||
, hpath-filepath
|
||||
, hpath-io
|
||||
, hpath-posix
|
||||
, libarchive
|
||||
, lzma
|
||||
, megaparsec
|
||||
, monad-logger
|
||||
@@ -305,13 +322,21 @@ library
|
||||
|
||||
if flag(internal-downloader)
|
||||
import:
|
||||
, HsOpenSSL
|
||||
HsOpenSSL
|
||||
, http-io-streams
|
||||
, io-streams
|
||||
, terminal-progress-bar
|
||||
exposed-modules: GHCup.Download.IOStreams
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if flag(tar)
|
||||
import:
|
||||
tar-bytestring
|
||||
cpp-options: -DTAR
|
||||
else
|
||||
import:
|
||||
libarchive
|
||||
|
||||
executable ghcup
|
||||
import:
|
||||
config
|
||||
@@ -321,7 +346,6 @@ executable ghcup
|
||||
, haskus-utils-variant
|
||||
, hpath
|
||||
, hpath-io
|
||||
, libarchive
|
||||
, megaparsec
|
||||
, monad-logger
|
||||
, mtl
|
||||
@@ -350,6 +374,19 @@ executable ghcup
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if flag(tui)
|
||||
import:
|
||||
brick
|
||||
, vector
|
||||
, vty
|
||||
other-modules: BrickMain
|
||||
cpp-options: -DBRICK
|
||||
|
||||
if flag(tar)
|
||||
cpp-options: -DTAR
|
||||
else
|
||||
import:
|
||||
libarchive
|
||||
|
||||
executable ghcup-gen
|
||||
import:
|
||||
|
||||
117
lib/GHCup.hs
117
lib/GHCup.hs
@@ -27,7 +27,9 @@ import GHCup.Utils.String.QQ
|
||||
import GHCup.Utils.Version.QQ
|
||||
import GHCup.Version
|
||||
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive ( ArchiveResult )
|
||||
#endif
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
@@ -85,29 +87,26 @@ installGHCBin :: ( MonadFail m
|
||||
)
|
||||
=> GHCupDownloads
|
||||
-> Version
|
||||
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
|
||||
-> PlatformRequest
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
m
|
||||
()
|
||||
installGHCBin bDls ver mpfReq = do
|
||||
installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
|
||||
let tver = (mkTVer ver)
|
||||
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
||||
whenM (liftIO $ ghcInstalled tver)
|
||||
$ (throwE $ AlreadyInstalled GHC ver)
|
||||
Settings {..} <- lift ask
|
||||
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
|
||||
|
||||
-- download (or use cached version)
|
||||
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
|
||||
@@ -130,19 +129,19 @@ installGHCBin bDls ver mpfReq = do
|
||||
|
||||
where
|
||||
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
|
||||
installGHC' :: (MonadLogger m, MonadIO m)
|
||||
installGHC' :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
|
||||
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
||||
-> Path Abs -- ^ Path to install to
|
||||
-> Excepts '[ProcessError] m ()
|
||||
installGHC' path inst = do
|
||||
lift $ $(logInfo) "Installing GHC (this may take a while)"
|
||||
lEM $ liftIO $ execLogged "./configure"
|
||||
lEM $ execLogged "./configure"
|
||||
False
|
||||
["--prefix=" <> toFilePath inst]
|
||||
[rel|ghc-configure|]
|
||||
(Just path)
|
||||
Nothing
|
||||
lEM $ liftIO $ make ["install"] (Just path)
|
||||
lEM $ make ["install"] (Just path)
|
||||
pure ()
|
||||
|
||||
|
||||
@@ -156,23 +155,22 @@ installCabalBin :: ( MonadMask m
|
||||
)
|
||||
=> GHCupDownloads
|
||||
-> Version
|
||||
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
|
||||
-> PlatformRequest
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
m
|
||||
()
|
||||
installCabalBin bDls ver mpfReq = do
|
||||
installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
|
||||
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
||||
|
||||
bindir <- liftIO ghcupBinDir
|
||||
@@ -186,9 +184,6 @@ installCabalBin bDls ver mpfReq = do
|
||||
)
|
||||
$ (throwE $ AlreadyInstalled Cabal ver)
|
||||
|
||||
Settings {..} <- lift ask
|
||||
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
|
||||
|
||||
-- download (or use cached version)
|
||||
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
@@ -382,31 +377,25 @@ listVersions :: ( MonadCatch m
|
||||
=> GHCupDownloads
|
||||
-> Maybe Tool
|
||||
-> Maybe ListCriteria
|
||||
-> Excepts
|
||||
'[ NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, DistroNotFound
|
||||
]
|
||||
m
|
||||
[ListResult]
|
||||
listVersions av lt criteria = do
|
||||
pfreq <- platformRequest
|
||||
-> PlatformRequest
|
||||
-> m [ListResult]
|
||||
listVersions av lt criteria pfreq = do
|
||||
case lt of
|
||||
Just t -> do
|
||||
-- get versions from GHCupDownloads
|
||||
let avTools = availableToolVersions av t
|
||||
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult pfreq t)
|
||||
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult t)
|
||||
|
||||
case t of
|
||||
-- append stray GHCs
|
||||
GHC -> do
|
||||
slr <- lift $ strayGHCs avTools
|
||||
slr <- strayGHCs avTools
|
||||
pure $ (sort (slr ++ lr))
|
||||
_ -> pure lr
|
||||
Nothing -> do
|
||||
ghcvers <- listVersions av (Just GHC) criteria
|
||||
cabalvers <- listVersions av (Just Cabal) criteria
|
||||
ghcupvers <- listVersions av (Just GHCup) criteria
|
||||
ghcvers <- listVersions av (Just GHC) criteria pfreq
|
||||
cabalvers <- listVersions av (Just Cabal) criteria pfreq
|
||||
ghcupvers <- listVersions av (Just GHCup) criteria pfreq
|
||||
pure (ghcvers <> cabalvers <> ghcupvers)
|
||||
|
||||
where
|
||||
@@ -451,8 +440,8 @@ listVersions av lt criteria = do
|
||||
pure Nothing
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: PlatformRequest -> Tool -> (Version, [Tag]) -> IO ListResult
|
||||
toListResult pfreq t (v, tags) = case t of
|
||||
toListResult :: Tool -> (Version, [Tag]) -> IO ListResult
|
||||
toListResult t (v, tags) = case t of
|
||||
GHC -> do
|
||||
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
|
||||
let tver = mkTVer v
|
||||
@@ -602,24 +591,24 @@ compileGHC :: ( MonadMask m
|
||||
-> Maybe (Path Abs) -- ^ build config
|
||||
-> Maybe (Path Abs) -- ^ patch directory
|
||||
-> [Text] -- ^ additional args to ./configure
|
||||
-> PlatformRequest
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, GHCupSetError
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotFoundInPATH
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
m
|
||||
()
|
||||
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs = do
|
||||
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs PlatformRequest {..} = do
|
||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
|
||||
whenM (liftIO $ ghcInstalled tver)
|
||||
(throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
|
||||
@@ -633,7 +622,6 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs = do
|
||||
-- unpack
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
liftE $ unpackToDir tmpUnpack dl
|
||||
(PlatformRequest {..}) <- liftE $ platformRequest
|
||||
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
|
||||
|
||||
bghc <- case bstrap of
|
||||
@@ -666,7 +654,7 @@ BUILD_SPHINX_PDF = NO
|
||||
HADDOCK_DOCS = NO
|
||||
Stage1Only = YES|]
|
||||
|
||||
compile :: (MonadCatch m, MonadLogger m, MonadIO m)
|
||||
compile :: (MonadReader Settings m, MonadThrow m, MonadCatch m, MonadLogger m, MonadIO m)
|
||||
=> Either (Path Rel) (Path Abs)
|
||||
-> Path Abs
|
||||
-> Path Abs
|
||||
@@ -694,7 +682,7 @@ Stage1Only = YES|]
|
||||
Left bver -> do
|
||||
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
|
||||
(liftIO $ searchPath spaths bver) !? NotFoundInPATH bver
|
||||
lEM $ liftIO $ execLogged
|
||||
lEM $ execLogged
|
||||
"./configure"
|
||||
False
|
||||
( ["--prefix=" <> toFilePath ghcdir]
|
||||
@@ -708,7 +696,7 @@ Stage1Only = YES|]
|
||||
(Just workdir)
|
||||
(Just (("GHC", toFilePath bghcPath) : cEnv))
|
||||
| otherwise -> do
|
||||
lEM $ liftIO $ execLogged
|
||||
lEM $ execLogged
|
||||
"./configure"
|
||||
False
|
||||
( [ "--prefix=" <> toFilePath ghcdir
|
||||
@@ -733,11 +721,11 @@ Stage1Only = YES|]
|
||||
liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
|
||||
|
||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
||||
lEM $ liftIO $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
|
||||
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
|
||||
(Just workdir)
|
||||
|
||||
lift $ $(logInfo) [i|Installing...|]
|
||||
lEM $ liftIO $ make ["install"] (Just workdir)
|
||||
lEM $ make ["install"] (Just workdir)
|
||||
|
||||
markSrcBuilt ghcdir workdir = do
|
||||
let dest = (ghcdir </> ghcUpSrcBuiltFile)
|
||||
@@ -781,24 +769,24 @@ compileCabal :: ( MonadReader Settings m
|
||||
-> Either Version (Path Abs) -- ^ version to bootstrap with
|
||||
-> Maybe Int
|
||||
-> Maybe (Path Abs)
|
||||
-> PlatformRequest
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
m
|
||||
()
|
||||
compileCabal dls tver bghc jobs patchdir = do
|
||||
compileCabal dls tver bghc jobs patchdir PlatformRequest{..} = do
|
||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
|
||||
|
||||
bindir <- liftIO ghcupBinDir
|
||||
@@ -819,7 +807,6 @@ compileCabal dls tver bghc jobs patchdir = do
|
||||
-- unpack
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
liftE $ unpackToDir tmpUnpack dl
|
||||
(PlatformRequest {..}) <- liftE $ platformRequest
|
||||
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
|
||||
|
||||
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
|
||||
@@ -840,7 +827,7 @@ compileCabal dls tver bghc jobs patchdir = do
|
||||
pure ()
|
||||
|
||||
where
|
||||
compile :: (MonadThrow m, MonadLogger m, MonadIO m, MonadResource m)
|
||||
compile :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadResource m)
|
||||
=> Path Abs
|
||||
-> Excepts '[ProcessError , PatchFailed] m (Path Abs)
|
||||
compile workdir = do
|
||||
@@ -873,7 +860,7 @@ compileCabal dls tver bghc jobs patchdir = do
|
||||
newEnv <- lift $ addToCurrentEnv (("PREFIX", toFilePath tmp) : ghcEnv)
|
||||
lift $ $(logDebug) [i|Environment: #{newEnv}|]
|
||||
|
||||
lEM $ liftIO $ execLogged "./bootstrap.sh"
|
||||
lEM $ execLogged "./bootstrap.sh"
|
||||
False
|
||||
(maybe [] (\j -> ["-j", fS (show j)]) jobs)
|
||||
[rel|cabal-bootstrap|]
|
||||
@@ -901,23 +888,20 @@ upgradeGHCup :: ( MonadMask m
|
||||
-> Maybe (Path Abs) -- ^ full file destination to write ghcup into
|
||||
-> Bool -- ^ whether to force update regardless
|
||||
-- of currently installed version
|
||||
-> PlatformRequest
|
||||
-> Excepts
|
||||
'[ CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NoUpdate
|
||||
]
|
||||
m
|
||||
Version
|
||||
upgradeGHCup dls mtarget force = do
|
||||
upgradeGHCup dls mtarget force pfreq = do
|
||||
lift $ $(logInfo) [i|Upgrading GHCup...|]
|
||||
let latestVer = fromJust $ getLatest dls GHCup
|
||||
when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
||||
pfreq <- liftE platformRequest
|
||||
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
|
||||
tmp <- lift withGHCupTmpDir
|
||||
let fn = [rel|ghcup|]
|
||||
@@ -927,20 +911,13 @@ upgradeGHCup dls mtarget force = do
|
||||
`unionFileModes` ownerExecuteMode
|
||||
`unionFileModes` groupExecuteMode
|
||||
`unionFileModes` otherExecuteMode
|
||||
case mtarget of
|
||||
Nothing -> do
|
||||
dest <- liftIO $ ghcupBinDir
|
||||
liftIO $ hideError NoSuchThing $ deleteFile (dest </> fn)
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
||||
(dest </> fn)
|
||||
Overwrite
|
||||
liftIO $ setFileMode (toFilePath (dest </> fn)) fileMode'
|
||||
Just fullDest -> do
|
||||
liftIO $ hideError NoSuchThing $ deleteFile fullDest
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
||||
fullDest
|
||||
Overwrite
|
||||
liftIO $ setFileMode (toFilePath fullDest) fileMode'
|
||||
binDir <- liftIO $ ghcupBinDir
|
||||
let fullDest = fromMaybe (binDir </> fn) mtarget
|
||||
liftIO $ hideError NoSuchThing $ deleteFile fullDest
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
||||
fullDest
|
||||
Overwrite
|
||||
liftIO $ setFileMode (toFilePath fullDest) fileMode'
|
||||
pure latestVer
|
||||
|
||||
|
||||
|
||||
@@ -2,7 +2,10 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
|
||||
module GHCup.Data.GHCupDownloads where
|
||||
module GHCup.Data.GHCupDownloads
|
||||
( ghcupDownloads
|
||||
)
|
||||
where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Version.QQ
|
||||
@@ -661,6 +664,12 @@ ghc_865_32_musl = DownloadInfo
|
||||
(Just [rel|ghc-8.6.5|])
|
||||
"db13ff894faf431f9c64db21c090a1e4e42803794d56720a704c50166c7ca05d"
|
||||
|
||||
ghc_865_64_freebsd :: DownloadInfo
|
||||
ghc_865_64_freebsd = DownloadInfo
|
||||
[uri|https://files.hasufell.de/ghc/ghc-8.6.5-x86_64-portbld-freebsd.tar.xz|]
|
||||
(Just [rel|ghc-8.6.5|])
|
||||
"83a3059a630d40a98e26cb5b520354e12094a96e36ba2f5ab002dad94cf2fb37"
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
@@ -829,6 +838,11 @@ ghc_883_32_musl = DownloadInfo
|
||||
(Just [rel|ghc-8.8.3|])
|
||||
"7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4"
|
||||
|
||||
ghc_883_64_freebsd :: DownloadInfo
|
||||
ghc_883_64_freebsd = DownloadInfo
|
||||
[uri|https://files.hasufell.de/ghc/ghc-8.8.3-x86_64-portbld-freebsd.tar.xz|]
|
||||
(Just [rel|ghc-8.8.3|])
|
||||
"569719075b4d14b3875a899df522090ae31e6fe085e6dffe518e875b09a2f0be"
|
||||
|
||||
|
||||
|
||||
@@ -887,6 +901,11 @@ ghc_8101_64_alpine = DownloadInfo
|
||||
"cb13b645d103e2fba2eb8dfcc4e5f2fbd9550c00c4df42f342b4210436dcb8a8"
|
||||
|
||||
|
||||
ghc_8101_64_freebsd :: DownloadInfo
|
||||
ghc_8101_64_freebsd = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz|]
|
||||
(Just [rel|ghc-8.10.1|])
|
||||
"52d27dbf9de82005dde9bfc521bff612e381b5228af194259c2306d2b75825c2"
|
||||
|
||||
|
||||
|
||||
@@ -1020,32 +1039,32 @@ cabal_3200_64_alpine = DownloadInfo
|
||||
-------------
|
||||
|
||||
|
||||
ghcup_015_32_linux :: DownloadInfo
|
||||
ghcup_015_32_linux = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/~ghcup/0.1.5/i386-linux-ghcup-0.1.5|]
|
||||
ghcup_016_32_linux :: DownloadInfo
|
||||
ghcup_016_32_linux = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/ghcup/0.1.6/i386-linux-ghcup-0.1.6|]
|
||||
Nothing
|
||||
"3707f60d703912709335dc0103fb1af5e5dfa83050825a8156b56bc81760b2a8"
|
||||
"0366ed6c00862c3c002cdefc3e37523ad80e655387956c7ab58b268aaa6fae5d"
|
||||
|
||||
|
||||
ghcup_015_64_linux :: DownloadInfo
|
||||
ghcup_015_64_linux = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-linux-ghcup-0.1.5|]
|
||||
ghcup_016_64_linux :: DownloadInfo
|
||||
ghcup_016_64_linux = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/ghcup/0.1.6/x86_64-linux-ghcup-0.1.6|]
|
||||
Nothing
|
||||
"cfdb01dde77121859b5d90b6707238b54e23787fcbb3003e18ab52a5dbfee330"
|
||||
"bdbec0cdf4c8511c4082dd83993d15034c0fbcb5722ecf418c1cee40667da8af"
|
||||
|
||||
|
||||
ghcup_015_64_freebsd :: DownloadInfo
|
||||
ghcup_015_64_freebsd = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-portbld-freebsd-ghcup-0.1.5|]
|
||||
ghcup_016_64_freebsd :: DownloadInfo
|
||||
ghcup_016_64_freebsd = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/ghcup/0.1.6/x86_64-portbld-freebsd-ghcup-0.1.6|]
|
||||
Nothing
|
||||
"6dd57cc5958ef3a6ba7de22808d9292d31dada8af95277578b69be35fc090194"
|
||||
"52707d89c3a4114b577855612d915c1e10295c4354e7e641b4a37a90c34fea53"
|
||||
|
||||
|
||||
ghcup_015_64_darwin10_13 :: DownloadInfo
|
||||
ghcup_015_64_darwin10_13 = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-apple-darwin-ghcup-0.1.5-p2|]
|
||||
ghcup_016_64_darwin10_13 :: DownloadInfo
|
||||
ghcup_016_64_darwin10_13 = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/ghcup/0.1.6/x86_64-apple-darwin-ghcup-0.1.6|]
|
||||
Nothing
|
||||
"456770c3b1510d44a0e401e0677faa9f5670ef81a11646f47cbba1b95404e788"
|
||||
"bbf56b5820f97b5ee15d292803a2df06922d31b396f9322459f9e3782e78d59c"
|
||||
|
||||
|
||||
|
||||
@@ -1634,6 +1653,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghc_865_64_darwin)])
|
||||
, (Linux Alpine, M.fromList [(Nothing, ghc_865_64_musl)])
|
||||
, (FreeBSD, M.fromList [(Nothing, ghc_865_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
@@ -1796,6 +1816,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghc_883_64_darwin)])
|
||||
, (Linux Alpine, M.fromList [(Nothing, ghc_883_64_musl)])
|
||||
, (FreeBSD , M.fromList [(Nothing, ghc_883_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
@@ -1840,7 +1861,7 @@ ghcupDownloads = M.fromList
|
||||
, (Just [vers|7|], ghc_8101_64_centos)
|
||||
]
|
||||
)
|
||||
, ( Linux RedHat, M.fromList [(Nothing, ghc_8101_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_8101_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_8101_64_centos)]
|
||||
)
|
||||
@@ -1861,6 +1882,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghc_8101_64_darwin)])
|
||||
, (Linux Alpine, M.fromList [(Nothing, ghc_8101_64_alpine)])
|
||||
, (FreeBSD , M.fromList [(Nothing, ghc_8101_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
@@ -1983,7 +2005,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, ( GHCup
|
||||
, M.fromList
|
||||
[ ( [vver|0.1.5|]
|
||||
[ ( [vver|0.1.6|]
|
||||
, VersionInfo
|
||||
[Recommended, Latest]
|
||||
(Just
|
||||
@@ -1994,16 +2016,16 @@ ghcupDownloads = M.fromList
|
||||
[ ( A_64
|
||||
, M.fromList
|
||||
[ ( Linux UnknownLinux
|
||||
, M.fromList [(Nothing, ghcup_015_64_linux)]
|
||||
, M.fromList [(Nothing, ghcup_016_64_linux)]
|
||||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghcup_015_64_darwin10_13)])
|
||||
, (FreeBSD, M.fromList [(Nothing, ghcup_015_64_freebsd)])
|
||||
, (Darwin , M.fromList [(Nothing, ghcup_016_64_darwin10_13)])
|
||||
, (FreeBSD, M.fromList [(Nothing, ghcup_016_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
, M.fromList
|
||||
[ ( Linux UnknownLinux
|
||||
, M.fromList [(Nothing, ghcup_015_32_linux)]
|
||||
, M.fromList [(Nothing, ghcup_016_32_linux)]
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
@@ -152,6 +152,7 @@ data Settings = Settings
|
||||
, noVerify :: Bool
|
||||
, keepDirs :: KeepDirs
|
||||
, downloader :: Downloader
|
||||
, verbose :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
|
||||
@@ -24,7 +24,9 @@ import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive
|
||||
#endif
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
@@ -59,13 +61,18 @@ import System.Posix.Files.ByteString ( readSymbolicLink )
|
||||
import Text.Regex.Posix
|
||||
import URI.ByteString
|
||||
|
||||
#if defined(TAR)
|
||||
import qualified Codec.Archive.Tar as Tar
|
||||
#endif
|
||||
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.ByteString.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
#if !defined(TAR)
|
||||
import qualified Data.Text as T
|
||||
#endif
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
@@ -312,17 +319,30 @@ getLatestGHCFor major' minor' dls = do
|
||||
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
=> Path Abs -- ^ destination dir
|
||||
-> Path Abs -- ^ archive path
|
||||
-> Excepts '[UnknownArchive, ArchiveResult] m ()
|
||||
-> Excepts '[UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
] m ()
|
||||
unpackToDir dest av = do
|
||||
fp <- (decUTF8Safe . toFilePath) <$> basename av
|
||||
let dfp = decUTF8Safe . toFilePath $ dest
|
||||
lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
|
||||
fn <- toFilePath <$> basename av
|
||||
|
||||
#if defined(TAR)
|
||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
|
||||
untar = liftIO . Tar.unpack (toFilePath dest) . Tar.read
|
||||
#else
|
||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
|
||||
untar = lEM . liftIO . runArchiveM . unpackToDirLazy (T.unpack . decUTF8Safe . toFilePath $ dest)
|
||||
#endif
|
||||
|
||||
#if defined(TAR)
|
||||
rf :: MonadIO m => Path Abs -> Excepts '[] m BL.ByteString
|
||||
#else
|
||||
rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
|
||||
#endif
|
||||
rf = liftIO . readFile
|
||||
|
||||
-- extract, depending on file extension
|
||||
@@ -453,10 +473,13 @@ ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
|
||||
|
||||
|
||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||
make :: [ByteString] -> Maybe (Path Abs) -> IO (Either ProcessError ())
|
||||
make :: (MonadThrow m, MonadIO m, MonadReader Settings m)
|
||||
=> [ByteString]
|
||||
-> Maybe (Path Abs)
|
||||
-> m (Either ProcessError ())
|
||||
make args workdir = do
|
||||
spaths <- catMaybes . fmap parseAbs <$> getSearchPath
|
||||
has_gmake <- isJust <$> searchPath spaths [rel|gmake|]
|
||||
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
|
||||
has_gmake <- isJust <$> (liftIO $ searchPath spaths [rel|gmake|])
|
||||
let mymake = if has_gmake then "gmake" else "make"
|
||||
execLogged mymake True args [rel|ghc-make|] workdir Nothing
|
||||
|
||||
|
||||
@@ -1,16 +1,19 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module GHCup.Utils.File where
|
||||
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Exception ( evaluate )
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Foldable
|
||||
import Data.Functor
|
||||
@@ -101,19 +104,21 @@ executeOut path args chdir = captureOutStreams $ do
|
||||
SPPB.executeFile (toFilePath path) True args Nothing
|
||||
|
||||
|
||||
execLogged :: ByteString -- ^ thing to execute
|
||||
execLogged :: (MonadReader Settings m, MonadIO m, MonadThrow m)
|
||||
=> 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 ())
|
||||
-> m (Either ProcessError ())
|
||||
execLogged exe spath args lfile chdir env = do
|
||||
ldir <- ghcupLogsDir
|
||||
Settings{..} <- ask
|
||||
ldir <- liftIO ghcupLogsDir
|
||||
logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
|
||||
bracket (createFile (toFilePath logfile) newFilePerms) closeFd action
|
||||
liftIO $ bracket (createFile (toFilePath logfile) newFilePerms) closeFd (action verbose)
|
||||
where
|
||||
action fd = do
|
||||
action verbose fd = do
|
||||
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
|
||||
-- start the thread that logs to stdout in a region
|
||||
done <- newEmptyMVar
|
||||
@@ -122,7 +127,7 @@ execLogged exe spath args lfile chdir env = do
|
||||
$ EX.handle (\(_ :: StopThread) -> pure ())
|
||||
$ EX.handle (\(_ :: IOException) -> pure ())
|
||||
$ flip finally (putMVar done ())
|
||||
$ printToRegion fd stdoutRead 6
|
||||
$ (if verbose then tee fd stdoutRead else printToRegion fd stdoutRead 6)
|
||||
|
||||
-- fork our subprocess
|
||||
pid <- SPPB.forkProcess $ do
|
||||
@@ -151,6 +156,17 @@ execLogged exe spath args lfile chdir env = do
|
||||
closeFd stdoutRead
|
||||
pure e
|
||||
|
||||
tee fileFd fdIn = do
|
||||
flip finally (readTilEOF lineAction fdIn) -- make sure the last few lines don't get cut off
|
||||
$ do
|
||||
hideError eofErrorType $ readTilEOF lineAction fdIn
|
||||
forever (threadDelay 5000)
|
||||
|
||||
where
|
||||
lineAction bs' = do
|
||||
void $ SPIB.fdWrite fileFd (bs' <> "\n")
|
||||
void $ SPIB.fdWrite stdOutput (bs' <> "\n")
|
||||
|
||||
-- Reads fdIn and logs the output in a continous scrolling area
|
||||
-- of 'size' terminal lines. Also writes to a log file.
|
||||
printToRegion fileFd fdIn size = do
|
||||
@@ -170,6 +186,7 @@ execLogged exe spath args lfile chdir env = do
|
||||
|
||||
where
|
||||
-- action to perform line by line
|
||||
-- TODO: do this with vty for efficiency
|
||||
lineAction ref rs bs' = do
|
||||
modifyIORef' ref (swapRegs bs')
|
||||
regs <- readIORef ref
|
||||
@@ -193,18 +210,18 @@ execLogged exe spath args lfile chdir env = do
|
||||
trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
|
||||
| otherwise = bs
|
||||
|
||||
-- read an entire line from the file descriptor (removes the newline char)
|
||||
readLine fd' = do
|
||||
bs <- SPIB.fdRead fd' 1
|
||||
if
|
||||
| bs == "\n" -> pure ""
|
||||
| bs == "" -> pure ""
|
||||
| otherwise -> fmap (bs <>) $ readLine fd'
|
||||
-- read an entire line from the file descriptor (removes the newline char)
|
||||
readLine fd' = do
|
||||
bs <- SPIB.fdRead fd' 1
|
||||
if
|
||||
| bs == "\n" -> pure ""
|
||||
| bs == "" -> pure ""
|
||||
| otherwise -> fmap (bs <>) $ readLine fd'
|
||||
|
||||
readTilEOF action' fd' = do
|
||||
bs <- readLine fd'
|
||||
void $ action' bs
|
||||
readTilEOF action' fd'
|
||||
readTilEOF action' fd' = do
|
||||
bs <- readLine fd'
|
||||
void $ action' bs
|
||||
readTilEOF action' fd'
|
||||
|
||||
|
||||
-- | Capture the stdout and stderr of the given action, which
|
||||
|
||||
@@ -42,7 +42,6 @@ deriving instance Data VUnit
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
deriving instance Lift (NonEmpty Word)
|
||||
instance Lift Text
|
||||
#endif
|
||||
|
||||
qq :: (Text -> Q Exp) -> QuasiQuoter
|
||||
|
||||
@@ -16,7 +16,7 @@ ghcupURL :: URI
|
||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
|
||||
|
||||
ghcUpVer :: PVP
|
||||
ghcUpVer = [pver|0.1.5|]
|
||||
ghcUpVer = [pver|0.1.6|]
|
||||
|
||||
numericVer :: String
|
||||
numericVer = T.unpack . prettyPVP $ ghcUpVer
|
||||
|
||||
@@ -101,6 +101,7 @@ body#idx p.other-help {
|
||||
|
||||
.instructions div.command-button {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
}
|
||||
|
||||
.instructions div.command-button button {
|
||||
@@ -111,7 +112,7 @@ body#idx p.other-help {
|
||||
border-style: solid;
|
||||
border-radius: 3px;
|
||||
|
||||
margin-left: 1rem;
|
||||
margin-left: 0.5rem;
|
||||
margin-right: auto;
|
||||
margin-top: 25px;
|
||||
margin-bottom: 25px;
|
||||
@@ -134,20 +135,21 @@ hr {
|
||||
#platform-instructions-linux > div > pre,
|
||||
#platform-instructions-mac > div > pre,
|
||||
#platform-instructions-freebsd > div > pre,
|
||||
#platform-instructions-win32 > pre,
|
||||
#platform-instructions-win64 > pre,
|
||||
#platform-instructions-win32 > div > pre,
|
||||
#platform-instructions-win64 > div > pre,
|
||||
#platform-instructions-default > div > div > pre,
|
||||
#platform-instructions-unknown > div > div > pre {
|
||||
background-color: #515151;
|
||||
color: white;
|
||||
margin-left: auto;
|
||||
margin-right: auto;
|
||||
padding-top: 1rem;
|
||||
padding-bottom: 1rem;
|
||||
padding-right: 1rem;
|
||||
text-align: center;
|
||||
border-radius: 3px;
|
||||
box-shadow: inset 0px 0px 20px 0px #333333;
|
||||
font-size: 0.6em;
|
||||
width: 40rem;
|
||||
}
|
||||
|
||||
#platform-instructions-win32 a.windows-download,
|
||||
|
||||
@@ -46,6 +46,9 @@
|
||||
<p>
|
||||
To install Haskell, follow the instructions on
|
||||
<a class="windows-download" href="https://www.haskell.org/platform/#windows">Haskell Platform</a>
|
||||
<p>If you're a Windows Subsystem for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
</p>
|
||||
<p class="other-help">You appear to be running Windows 32-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
</div>
|
||||
@@ -55,6 +58,9 @@
|
||||
To install Haskell, follow the instructions on
|
||||
<a class="windows-download" href="https://www.haskell.org/platform/#windows">Haskell Platform</a>
|
||||
</p>
|
||||
<p>If you're a Windows Subsystem for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">You appear to be running Windows 64-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
</div>
|
||||
|
||||
@@ -77,7 +83,7 @@
|
||||
|
||||
<!-- duplicate the default cross-platform instructions -->
|
||||
<div>
|
||||
<p>If you are running Linux, macOS or FreeBSD,<br/>run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<p>If you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
</div>
|
||||
@@ -95,7 +101,7 @@
|
||||
|
||||
<div id="platform-instructions-default" class="instructions">
|
||||
<div>
|
||||
<p>To install Haskell, if you are running Linux, macOS or FreeBSD,<br/>run the following
|
||||
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following
|
||||
in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
@@ -140,7 +146,7 @@
|
||||
|
||||
<div id="platform-instructions-default" class="instructions">
|
||||
<div>
|
||||
<p>To install Haskell, if you are running Linux, macOS or FreeBSD,<br/>run the following
|
||||
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following
|
||||
in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
|
||||
Reference in New Issue
Block a user