Enable internal downloader for Linux 64 bit release

This should be faster to draw, use less syscalls
and generally use EOF and pipes correctly.

.gitignore

@@ -5,3 +5,10 @@ dist-newstyle/
 cabal.project.local
 .stack-work/
 bin/
+/*.prof
+/*.ps
+/*.hp
+tags
+TAGS
+/tmp/
+.entangled

.gitlab-ci.yml

@@ -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"
 

.gitlab/before_script/freebsd/install_deps.sh

@@ -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 ${GHC_VERSION}
+./ghcup-bin install-cabal ${CABAL_VERSION}
-# ./ghcup-bin install-cabal ${CABAL_VERSION}
+./ghcup-bin set ${GHC_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"
 
 exit 0

.gitlab/before_script/linux/alpine/install_deps.sh

@@ -18,29 +18,18 @@ apk add --no-cache \
 	tar \
 	perl
 
-ln -s libncurses.so /usr/lib/libtinfo.so
+ln -sf libncurses.so /usr/lib/libtinfo.so
-ln -s libncursesw.so.6 /usr/lib/libtinfow.so.6
+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}
+./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"
-
 
 # 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
 

.gitlab/script/ghcup_release.sh

@@ -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 -finternal-downloader
+	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}
 

.gitlab/script/ghcup_version.sh

@@ -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')" .

.travis/build.sh

@@ -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}"

3rdparty/libarchive/c/autoconf-linux/config.h

@@ -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

3rdparty/os-release/.gitattributes

@@ -1 +0,0 @@
-*.golden	-text

3rdparty/os-release/.gitignore

@@ -1 +0,0 @@
-dist-newstyle/

3rdparty/os-release/ChangeLog.rst

@@ -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

3rdparty/os-release/LICENSE

@@ -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.

3rdparty/os-release/README.rst

@@ -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")])

3rdparty/os-release/Setup.hs

@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain

3rdparty/os-release/library/System/OsRelease.hs

@@ -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

3rdparty/os-release/library/System/OsRelease/Megaparsec.hs

@@ -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

3rdparty/os-release/os-release.cabal

@@ -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

3rdparty/os-release/tests/Golden/Real.hs

@@ -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

3rdparty/os-release/tests/Golden/data/alpine.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/alpine.in

@@ -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/"
-

3rdparty/os-release/tests/Golden/data/arch.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/arch.in

@@ -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
-

3rdparty/os-release/tests/Golden/data/centos.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/centos.in

@@ -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"
-

3rdparty/os-release/tests/Golden/data/debian.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/debian.in

@@ -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/"

3rdparty/os-release/tests/Golden/data/empty.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/empty.in

@@ -1 +0,0 @@
-

3rdparty/os-release/tests/Golden/data/exherbo.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/exherbo.in

@@ -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/"
-

3rdparty/os-release/tests/Golden/data/fedora.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/fedora.in

@@ -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

3rdparty/os-release/tests/Golden/data/gentoo.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/gentoo.in

@@ -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/"
-

3rdparty/os-release/tests/Golden/data/mint.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/mint.in

@@ -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
-

3rdparty/os-release/tests/Golden/data/red-hat.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/red-hat.in

@@ -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"

3rdparty/os-release/tests/Golden/data/red-hat_parseErrors.golden

@@ -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" ) ]
-            )
-        ]
-    }

3rdparty/os-release/tests/Golden/data/red-hat_parseErrors.in

@@ -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.'

3rdparty/os-release/tests/Golden/data/ubuntu.golden

@@ -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 = []
-    }

3rdparty/os-release/tests/Golden/data/ubuntu.in

@@ -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
-

3rdparty/os-release/tests/Main.hs

@@ -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++[])
-

3rdparty/os-release/tests/Specs/Megaparsec.hs

@@ -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

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

README.md

@@ -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

app/ghcup-gen/Validate.hs

@@ -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 ())

app/ghcup/BrickMain.hs

@@ -0,0 +1,362 @@
+{-# 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
+            , FileDoesNotExistError
+            , CopyError
+            , NoDownload
+            , NotInstalled
+            , 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}|]

app/ghcup/Main.hs

@@ -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
+          runLogger $ checkForUpdates dls pfreq
-              . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ checkForUpdates dls
+
-              )
-              >>= \case
-                    VRight _ -> pure ()
-                    VLeft  e -> do
-                      runLogger
-                        ($(logError) [i|Error checking for upgrades: #{e}|])
 
 
           -----------------------
@@ -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
+                  l <- listVersions dls lTool lCriteria pfreq
-                  pure l
+                  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
+                -> PlatformRequest
-                     '[ NoCompatiblePlatform
+                -> m ()
-                      , NoCompatibleArch
+checkForUpdates dls pfreq = do
-                      , DistroNotFound
-                      ]
-                     m
-                     ()
-checkForUpdates dls = 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

bootstrap-haskell

@@ -28,16 +28,17 @@ eghcup() {
 download_ghcup() {
 	_plat="$(uname -s)"
 	_arch=$(uname -m)
-	_ghver="0.1.5"
+	_ghver="0.1.6"
+	_base_url="https://downloads.haskell.org/~ghcup"
 
     case "${_plat}" in
         "linux"|"Linux")
 			case "${_arch}" in
 				x86_64|amd64)
-					_url=https://downloads.haskell.org/~ghcup/${_ghver}/x86_64-linux-ghcup-${_ghver}
+					_url=${_base_url}/${_ghver}/x86_64-linux-ghcup-${_ghver}
 					;;
 				i*86)
-					_url=https://downloads.haskell.org/~ghcup/${_ghver}/i386-linux-ghcup-${_ghver}
+					_url=${_base_url}/${_ghver}/i386-linux-ghcup-${_ghver}
 					;;
 				*) die "Unknown architecture: ${_arch}"
 					;;
@@ -53,7 +54,7 @@ download_ghcup() {
 				*) die "Unknown architecture: ${_arch}"
 					;;
 			esac
-			_url=https://downloads.haskell.org/~ghcup/${_ghver}/x86_64-portbld-freebsd-ghcup-${_ghver}
+			_url=${_base_url}/${_ghver}/x86_64-portbld-freebsd-ghcup-${_ghver}
             ;;
         "Darwin"|"darwin")
 			case "${_arch}" in
@@ -65,14 +66,14 @@ 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=${_base_url}/${_ghver}/x86_64-apple-darwin-ghcup-${_ghver} ;;
         *) die "Unknown platform: ${_plat}"
 			;;
     esac
 
 	edo curl -Lf "${_url}" > "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
 
-	unset _plat _arch _url _ghver
+	unset _plat _arch _url _ghver _base_url
 }
 
 
@@ -129,10 +130,10 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
     read -r answer </dev/tty
 fi
 
-eghcup --cache install "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
 
-eghcup set "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
-eghcup --cache install-cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
+eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
 
 edo cabal new-update
 
@@ -163,6 +164,9 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
 				exit 0
 			fi
 			;;
+		*/fish) # login shell is fish
+			GHCUP_PROFILE_FILE="$HOME/.config/fish/config.fish"
+			MY_SHELL="fish" ;;
 		*) exit 0 ;;
 	esac
 
@@ -178,7 +182,16 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
 
         case $next_answer in
             [Yy]*)
-                echo "[ -f \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\" ] && source \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\"" >> "${GHCUP_PROFILE_FILE}"
+				case $MY_SHELL in
+					"") break ;;
+					fish)
+						echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME" >> "${GHCUP_PROFILE_FILE}"
+						echo "test -f \$GHCUP_INSTALL_BASE_PREFIX/.ghcup/env ; and set -gx PATH \$HOME/.cabal/bin \$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin \$PATH" >> "${GHCUP_PROFILE_FILE}"
+						break ;;
+					*)
+						echo "[ -f \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\" ] && source \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\"" >> "${GHCUP_PROFILE_FILE}"
+						break ;;
+				esac
                 printf "\\033[0;35m%s\\033[0m\\n" "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
                 printf "\\033[0;35m%s\\033[0m\\n" "or type \"source ${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/env\" to apply them in your current terminal session."
                 exit 0;;

cabal.project

@@ -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

ghcup-0.0.2.json

@@ -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",
@@ -1236,6 +1250,136 @@
           "base-4.13.0.0"
         ]
       },
+      "8.8.4": {
+        "viArch": {
+          "A_64": {
+            "Linux_Debian": {
+              "unknown_versioning": {
+                "dlHash": "4862559d221153caf978f4bf2c15a82c114d1e1f43b298b2ecff2ac94b586d20",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb9-linux.tar.xz"
+              },
+              "8": {
+                "dlHash": "51a36892f1264744195274187298d13ac62bce2da86d4ddf76d8054ab90f2feb",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb8-linux.tar.xz"
+              }
+            },
+            "Linux_Ubuntu": {
+              "unknown_versioning": {
+                "dlHash": "f32e37f8aa03e74bad533ae02f62dc27a4521e78199576af490888ba34b515db",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-fedora27-linux.tar.xz"
+              },
+              "16.04": {
+                "dlHash": "4862559d221153caf978f4bf2c15a82c114d1e1f43b298b2ecff2ac94b586d20",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb9-linux.tar.xz"
+              },
+              "18.04": {
+                "dlHash": "4862559d221153caf978f4bf2c15a82c114d1e1f43b298b2ecff2ac94b586d20",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb9-linux.tar.xz"
+              }
+            },
+            "Darwin": {
+              "unknown_versioning": {
+                "dlHash": "e80a789e9d8cfb41dd87f3284b75432427c4461c1731d220d04ead8733ccdb5e",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-apple-darwin.tar.xz"
+              }
+            },
+            "Linux_RedHat": {
+              "unknown_versioning": {
+                "dlHash": "a12aa4b1fd3c64240a8a6d15196d33e1c0e0d55b51ff78c387242126d0ef7910",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-centos7-linux.tar.xz"
+              }
+            },
+            "Linux_UnknownLinux": {
+              "unknown_versioning": {
+                "dlHash": "f32e37f8aa03e74bad533ae02f62dc27a4521e78199576af490888ba34b515db",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-fedora27-linux.tar.xz"
+              }
+            },
+            "Linux_Mint": {
+              "unknown_versioning": {
+                "dlHash": "4862559d221153caf978f4bf2c15a82c114d1e1f43b298b2ecff2ac94b586d20",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb9-linux.tar.xz"
+              }
+            },
+            "Linux_Fedora": {
+              "unknown_versioning": {
+                "dlHash": "f32e37f8aa03e74bad533ae02f62dc27a4521e78199576af490888ba34b515db",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-fedora27-linux.tar.xz"
+              }
+            },
+            "Linux_CentOS": {
+              "unknown_versioning": {
+                "dlHash": "a12aa4b1fd3c64240a8a6d15196d33e1c0e0d55b51ff78c387242126d0ef7910",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-centos7-linux.tar.xz"
+              }
+            },
+            "Linux_AmazonLinux": {
+              "unknown_versioning": {
+                "dlHash": "a12aa4b1fd3c64240a8a6d15196d33e1c0e0d55b51ff78c387242126d0ef7910",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-centos7-linux.tar.xz"
+              }
+            }
+          },
+          "A_32": {
+            "FreeBSD": {
+              "unknown_versioning": {
+                "dlHash": "8cebe5ccf454e82acd1ff52ca57590d1ab0f3f44a981b46257ec12158c8c447e",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://files.hasufell.de/ghc/ghc-8.8.4-x86_64-portbld-freebsd.tar.xz"
+              }
+            },
+            "Linux_Debian": {
+              "unknown_versioning": {
+                "dlHash": "43dd954910c9027694312cef0aabc7774d102d0422b7172802cfb72f7d5da3a0",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-i386-deb9-linux.tar.xz"
+              }
+            },
+            "Linux_Ubuntu": {
+              "unknown_versioning": {
+                "dlHash": "43dd954910c9027694312cef0aabc7774d102d0422b7172802cfb72f7d5da3a0",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-i386-deb9-linux.tar.xz"
+              }
+            },
+            "Linux_UnknownLinux": {
+              "unknown_versioning": {
+                "dlHash": "43dd954910c9027694312cef0aabc7774d102d0422b7172802cfb72f7d5da3a0",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-i386-deb9-linux.tar.xz"
+              }
+            },
+            "Linux_Mint": {
+              "unknown_versioning": {
+                "dlHash": "43dd954910c9027694312cef0aabc7774d102d0422b7172802cfb72f7d5da3a0",
+                "dlSubdir": "ghc-8.8.4",
+                "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-i386-deb9-linux.tar.xz"
+              }
+            }
+          }
+        },
+        "viSourceDL": {
+          "dlHash": "f0505e38b2235ff9f1090b51f44d6c8efd371068e5a6bb42a2a6d8b67b5ffc2d",
+          "dlSubdir": "ghc-8.8.4",
+          "dlUri": "https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-src.tar.xz"
+        },
+        "viChangeLog": "https://downloads.haskell.org/~ghc/8.8.4/docs/html/users_guide/8.8.4-notes.html",
+        "viTags": [
+          "base-4.13.0.0"
+        ]
+      },
       "8.4.3": {
         "viArch": {
           "A_64": {
@@ -2002,6 +2146,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 +2452,37 @@
       }
     },
     "GHCup": {
-      "0.1.5": {
+      "0.1.6": {
         "viArch": {
           "A_64": {
             "FreeBSD": {
               "unknown_versioning": {
-                "dlHash": "6dd57cc5958ef3a6ba7de22808d9292d31dada8af95277578b69be35fc090194",
+                "dlHash": "6bbfb1047691ff3ae9249e8805cf9f37bab30a008dae130cb2a4b3aa5253e6e5",
                 "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": "1e025e66d7f7b75d94f17a7da6120efd7e2df918a8eac88c4711ed11d2aac4ec",
                 "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"
               }
             }
           }

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
 
@@ -92,11 +105,14 @@ common hpath-io
 common hpath-posix
   build-depends: hpath-posix >=0.13.2
 
-common http-io-streams
+common http-client
-  build-depends: http-io-streams >=0.1.2.0
+  build-depends: http-client >=0.7.1
 
-common io-streams
+common http-client-openssl
-  build-depends: io-streams >=1.5
+  build-depends: http-client-openssl >=0.3.1.0
+
+common http-types
+  build-depends: http-types >=0.12.3
 
 common libarchive
   build-depends: libarchive >= 2.2.5.0
@@ -107,6 +123,9 @@ common lzma
 common megaparsec
   build-depends: megaparsec >=8.0.0
 
+common monad-control
+  build-depends: monad-control >=1.0.2.3
+
 common monad-logger
   build-depends: monad-logger >=0.3.31
 
@@ -158,15 +177,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
@@ -174,6 +195,9 @@ common time
 common transformers
   build-depends: transformers >=0.5
 
+common transformers-base
+  build-depends: transformers-base >=0.4.4
+
 common os-release
   build-depends: os-release >=1.0.0
 
@@ -198,6 +222,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,9 +270,9 @@ library
     , hpath-filepath
     , hpath-io
     , hpath-posix
-    , libarchive
     , lzma
     , megaparsec
+    , monad-control
     , monad-logger
     , mtl
     , optics
@@ -265,6 +292,7 @@ library
     , text
     , time
     , transformers
+    , transformers-base
     , os-release
     , unix
     , unix-bytestring
@@ -282,7 +310,6 @@ library
     GHCup.Data.GHCupInfo
     GHCup.Data.ToolRequirements
     GHCup.Download
-    GHCup.Download.Utils
     GHCup.Errors
     GHCup.Platform
     GHCup.Requirements
@@ -305,13 +332,22 @@ library
 
   if flag(internal-downloader)
     import:
-      , HsOpenSSL
+        HsOpenSSL
-      , http-io-streams
+      , http-client
-      , io-streams
+      , http-client-openssl
+      , http-types
       , terminal-progress-bar
-    exposed-modules: GHCup.Download.IOStreams
+    exposed-modules: GHCup.Download.Internal
     cpp-options:     -DINTERNAL_DOWNLOADER
 
+  if flag(tar)
+    import:
+        tar-bytestring
+    cpp-options:     -DTAR
+  else
+    import:
+        libarchive
+
 executable ghcup
   import:
     config
@@ -321,7 +357,6 @@ executable ghcup
     , haskus-utils-variant
     , hpath
     , hpath-io
-    , libarchive
     , megaparsec
     , monad-logger
     , mtl
@@ -350,6 +385,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:

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
@@ -48,7 +50,7 @@ import           Data.Versions
 import           Data.Word8
 import           GHC.IO.Exception
 import           HPath
-import           HPath.IO
+import           HPath.IO                hiding ( hideError )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
 import           Prelude                 hiding ( abs
@@ -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
+             -> PlatformRequest
-                  '[ NoCompatiblePlatform
+             -> m [ListResult]
-                   , NoCompatibleArch
+listVersions av lt criteria pfreq = do
-                   , DistroNotFound
-                   ]
-                  m
-                  [ListResult]
-listVersions av lt criteria = do
-  pfreq <- platformRequest
   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
+      ghcvers   <- listVersions av (Just GHC) criteria pfreq
-      cabalvers <- listVersions av (Just Cabal) criteria
+      cabalvers <- listVersions av (Just Cabal) criteria pfreq
-      ghcupvers <- listVersions av (Just GHCup) criteria
+      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 :: Tool -> (Version, [Tag]) -> IO ListResult
-  toListResult pfreq t (v, tags) = case t of
+  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
+  binDir <- liftIO $ ghcupBinDir
-    Nothing -> do
+  let fullDest = fromMaybe (binDir </> fn) mtarget
-      dest <- liftIO $ ghcupBinDir
+  liftIO $ hideError NoSuchThing $ deleteFile fullDest
-      liftIO $ hideError NoSuchThing $ deleteFile (dest </> fn)
+  handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
-      handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
+                                                           fullDest
-                                                               (dest </> fn)
+                                                           Overwrite
-                                                               Overwrite
+  liftIO $ setFileMode (toFilePath fullDest) fileMode'
-      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'
   pure latestVer
 
 

lib/GHCup/Data/GHCupDownloads.hs

@@ -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,61 @@ 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"
+
+
+
+    -----------------
+    --[ GHC 8.8.4 ]--
+    -----------------
+
+
+
+ghc_884_64_deb8 :: DownloadInfo
+ghc_884_64_deb8 = DownloadInfo
+  [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb8-linux.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "51a36892f1264744195274187298d13ac62bce2da86d4ddf76d8054ab90f2feb"
+
+ghc_884_64_deb9 :: DownloadInfo
+ghc_884_64_deb9 = DownloadInfo
+  [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb9-linux.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "4862559d221153caf978f4bf2c15a82c114d1e1f43b298b2ecff2ac94b586d20"
+
+ghc_884_32_deb9 :: DownloadInfo
+ghc_884_32_deb9 = DownloadInfo
+  [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-i386-deb9-linux.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "43dd954910c9027694312cef0aabc7774d102d0422b7172802cfb72f7d5da3a0"
+
+ghc_884_64_fedora :: DownloadInfo
+ghc_884_64_fedora = DownloadInfo
+  [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-fedora27-linux.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "f32e37f8aa03e74bad533ae02f62dc27a4521e78199576af490888ba34b515db"
+
+ghc_884_64_centos :: DownloadInfo
+ghc_884_64_centos = DownloadInfo
+  [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-centos7-linux.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "a12aa4b1fd3c64240a8a6d15196d33e1c0e0d55b51ff78c387242126d0ef7910"
+
+ghc_884_64_darwin :: DownloadInfo
+ghc_884_64_darwin = DownloadInfo
+  [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-apple-darwin.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "e80a789e9d8cfb41dd87f3284b75432427c4461c1731d220d04ead8733ccdb5e"
+
+ghc_884_64_freebsd :: DownloadInfo
+ghc_884_64_freebsd = DownloadInfo
+  [uri|https://files.hasufell.de/ghc/ghc-8.8.4-x86_64-portbld-freebsd.tar.xz|]
+  (Just [rel|ghc-8.8.4|])
+  "8cebe5ccf454e82acd1ff52ca57590d1ab0f3f44a981b46257ec12158c8c447e"
 
 
 
@@ -887,6 +951,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 +1089,32 @@ cabal_3200_64_alpine = DownloadInfo
     -------------
 
 
-ghcup_015_32_linux :: DownloadInfo
+ghcup_016_32_linux :: DownloadInfo
-ghcup_015_32_linux = DownloadInfo
+ghcup_016_32_linux = DownloadInfo
-  [uri|https://downloads.haskell.org/~ghcup/0.1.5/i386-linux-ghcup-0.1.5|]
+  [uri|https://downloads.haskell.org/~ghcup/0.1.6/i386-linux-ghcup-0.1.6|]
   Nothing
-  "3707f60d703912709335dc0103fb1af5e5dfa83050825a8156b56bc81760b2a8"
+  "0366ed6c00862c3c002cdefc3e37523ad80e655387956c7ab58b268aaa6fae5d"
 
 
-ghcup_015_64_linux :: DownloadInfo
+ghcup_016_64_linux :: DownloadInfo
-ghcup_015_64_linux = DownloadInfo
+ghcup_016_64_linux = DownloadInfo
-  [uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-linux-ghcup-0.1.5|]
+  [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_016_64_freebsd :: DownloadInfo
-ghcup_015_64_freebsd = DownloadInfo
+ghcup_016_64_freebsd = DownloadInfo
-  [uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-portbld-freebsd-ghcup-0.1.5|]
+  [uri|https://downloads.haskell.org/~ghcup/0.1.6/x86_64-portbld-freebsd-ghcup-0.1.6|]
   Nothing
-  "6dd57cc5958ef3a6ba7de22808d9292d31dada8af95277578b69be35fc090194"
+  "6bbfb1047691ff3ae9249e8805cf9f37bab30a008dae130cb2a4b3aa5253e6e5"
 
 
-ghcup_015_64_darwin10_13 :: DownloadInfo
+ghcup_016_64_darwin10_13 :: DownloadInfo
-ghcup_015_64_darwin10_13 = DownloadInfo
+ghcup_016_64_darwin10_13 = DownloadInfo
-  [uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-apple-darwin-ghcup-0.1.5-p2|]
+  [uri|https://downloads.haskell.org/~ghcup/0.1.6/x86_64-apple-darwin-ghcup-0.1.6|]
   Nothing
-  "456770c3b1510d44a0e401e0677faa9f5670ef81a11646f47cbba1b95404e788"
+  "1e025e66d7f7b75d94f17a7da6120efd7e2df918a8eac88c4711ed11d2aac4ec"
 
 
 
@@ -1634,6 +1703,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 +1866,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
@@ -1811,6 +1882,59 @@ ghcupDownloads = M.fromList
                 )
               ]
         )
+      , ( [vver|8.8.4|]
+        , VersionInfo
+            [Base [pver|4.13.0.0|]]
+            (Just
+              [uri|https://downloads.haskell.org/~ghc/8.8.4/docs/html/users_guide/8.8.4-notes.html|]
+            )
+            (Just $ DownloadInfo
+              [uri|https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-src.tar.xz|]
+              (Just [rel|ghc-8.8.4|])
+              "f0505e38b2235ff9f1090b51f44d6c8efd371068e5a6bb42a2a6d8b67b5ffc2d"
+            )
+          $ M.fromList
+              [ ( A_64
+                , M.fromList
+                  [ ( Linux UnknownLinux
+                    , M.fromList [(Nothing, ghc_884_64_fedora)]
+                    )
+                  , (Linux Fedora, M.fromList [(Nothing, ghc_884_64_fedora)])
+                  , (Linux CentOS, M.fromList [(Nothing, ghc_884_64_centos)])
+                  , (Linux RedHat, M.fromList [(Nothing, ghc_884_64_centos)])
+                  , ( Linux AmazonLinux
+                    , M.fromList [(Nothing, ghc_884_64_centos)]
+                    )
+                  , ( Linux Ubuntu
+                    , M.fromList
+                      [ (Nothing           , ghc_884_64_fedora)
+                      , (Just [vers|16.04|], ghc_884_64_deb9)
+                      , (Just [vers|18.04|], ghc_884_64_deb9)
+                      ]
+                    )
+                  , (Linux Mint, M.fromList [(Nothing, ghc_884_64_deb9)])
+                  , ( Linux Debian
+                    , M.fromList
+                      [ (Nothing       , ghc_884_64_deb9)
+                      , (Just [vers|8|], ghc_884_64_deb8)
+                      ]
+                    )
+                  , (Darwin, M.fromList [(Nothing, ghc_884_64_darwin)])
+                  ]
+                )
+              , ( A_32
+                , M.fromList
+                  [ ( Linux UnknownLinux
+                    , M.fromList [(Nothing, ghc_884_32_deb9)]
+                    )
+                  , (Linux Ubuntu, M.fromList [(Nothing, ghc_884_32_deb9)])
+                  , (Linux Mint  , M.fromList [(Nothing, ghc_884_32_deb9)])
+                  , (Linux Debian, M.fromList [(Nothing, ghc_884_32_deb9)])
+                  , (FreeBSD     , M.fromList [(Nothing, ghc_884_64_freebsd)])
+                  ]
+                )
+              ]
+        )
       , ( [vver|8.10.1|]
         , VersionInfo
             [Latest, Base [pver|4.14.0.0|]]
@@ -1840,7 +1964,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 +1985,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 +2108,7 @@ ghcupDownloads = M.fromList
     )
   , ( GHCup
     , M.fromList
-      [ ( [vver|0.1.5|]
+      [ ( [vver|0.1.6|]
         , VersionInfo
             [Recommended, Latest]
             (Just
@@ -1994,16 +2119,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)])
+                  , (Darwin , M.fromList [(Nothing, ghcup_016_64_darwin10_13)])
-                  , (FreeBSD, M.fromList [(Nothing, ghcup_015_64_freebsd)])
+                  , (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)]
                     )
                   ]
                 )

lib/GHCup/Download.hs

@@ -12,8 +12,7 @@
 module GHCup.Download where
 
 #if defined(INTERNAL_DOWNLOADER)
-import           GHCup.Download.IOStreams
+import           GHCup.Download.Internal
-import           GHCup.Download.Utils
 #endif
 import           GHCup.Errors
 import           GHCup.Types
@@ -50,7 +49,7 @@ import           Data.Versions
 import           Data.Word8
 import           GHC.IO.Exception
 import           HPath
-import           HPath.IO                      as HIO
+import           HPath.IO                     as HIO hiding ( hideError )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
 import           Prelude                 hiding ( abs
@@ -233,16 +232,20 @@ getDownloads urlSource = do
 #if !defined(INTERNAL_DOWNLOADER)
       pure Nothing
 #else
-      headers <-
+      Settings{..} <- lift ask
-        handleIO (\_ -> pure mempty)
+      case downloader of
-        $ liftE
+        Internal -> do
-        $ ( catchAllE
+          headers <-
-              (\_ ->
+            handleIO (\_ -> pure mempty)
-                pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
+            $ liftE
+            $ ( catchAllE
+                  (\_ ->
+                    pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
+                  )
+              $ getHead uri'
               )
-          $ getHead uri'
+          pure $ parseModifiedHeader headers
-          )
+        _ -> pure Nothing
-      pure $ parseModifiedHeader headers
 
   parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
   parseModifiedHeader headers =
@@ -339,9 +342,7 @@ download dli dest mfn
                   liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" True
                     (o' ++ ["-O", toFilePath destFile , serializeURIRef' $ view dlUri dli]) Nothing Nothing
 #if defined(INTERNAL_DOWNLOADER)
-                Internal -> do
+                Internal -> liftE $ downloadToFile (_dlUri dli) destFile
-                  (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
-                  liftE $ downloadToFile https host fullPath port destFile
 #endif
 
     liftE $ checkDigest dli destFile
@@ -408,10 +409,8 @@ downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
                 m
                 L.ByteString
 downloadBS uri'
-  | scheme == "https"
+  | scheme == "https" || scheme == "http"
-  = dl True
+  = dl
-  | scheme == "http"
-  = dl False
   | scheme == "file"
   = liftIOException doesNotExistErrorType (FileDoesNotExistError path)
     $ (liftIO $ RD.readFile path)
@@ -421,11 +420,7 @@ downloadBS uri'
  where
   scheme = view (uriSchemeL' % schemeBSL') uri'
   path   = view pathL' uri'
-#if defined(INTERNAL_DOWNLOADER)
+  dl = do
-  dl https = do
-#else
-  dl _ = do
-#endif
     lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
     lift getDownloader >>= \case
       Curl -> do
@@ -445,9 +440,7 @@ downloadBS uri'
             pure $ L.fromStrict stdout
           CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
 #if defined(INTERNAL_DOWNLOADER)
-      Internal -> do
+      Internal -> liftE $ downloadBS' uri'
-        (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
-        liftE $ downloadBS' https host' fullPath' port'
 #endif
 
 

lib/GHCup/Download/IOStreams.hs

@@ -1,253 +0,0 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeApplications      #-}
-{-# LANGUAGE TypeFamilies          #-}
-
-
-module GHCup.Download.IOStreams where
-
-
-import           GHCup.Download.Utils
-import           GHCup.Errors
-import           GHCup.Types.Optics
-import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.File
-import           GHCup.Utils.Prelude
-
-import           Control.Applicative
-import           Control.Exception.Safe
-import           Control.Monad
-import           Control.Monad.Reader
-import           Data.ByteString                ( ByteString )
-import           Data.ByteString.Builder
-import           Data.CaseInsensitive           ( CI )
-import           Data.IORef
-import           Data.Maybe
-import           Data.Text.Read
-import           HPath
-import           HPath.IO                      as HIO
-import           Haskus.Utils.Variant.Excepts
-import           Network.Http.Client     hiding ( URL )
-import           Optics
-import           Prelude                 hiding ( abs
-                                                , readFile
-                                                , writeFile
-                                                )
-import "unix"    System.Posix.IO.ByteString
-                                         hiding ( fdWrite )
-import "unix-bytestring" System.Posix.IO.ByteString
-                                                ( fdWrite )
-import           System.ProgressBar
-import           URI.ByteString
-
-import qualified Data.ByteString               as BS
-import qualified Data.ByteString.Lazy          as L
-import qualified Data.Map.Strict               as M
-import qualified System.IO.Streams             as Streams
-
-
-
-
-
-    ----------------------------
-    --[ Low-level (non-curl) ]--
-    ----------------------------
-
-
--- | Load the result of this download into memory at once.
-downloadBS' :: MonadIO m
-            => Bool             -- ^ https?
-            -> ByteString       -- ^ host (e.g. "www.example.com")
-            -> ByteString       -- ^ path (e.g. "/my/file") including query
-            -> Maybe Int        -- ^ optional port (e.g. 3000)
-            -> Excepts
-                 '[ HTTPStatusError
-                  , URIParseError
-                  , UnsupportedScheme
-                  , NoLocationHeader
-                  , TooManyRedirs
-                  ]
-                 m
-                 (L.ByteString)
-downloadBS' https host path port = do
-  bref <- liftIO $ newIORef (mempty :: Builder)
-  let stepper bs = modifyIORef bref (<> byteString bs)
-  downloadInternal False https host path port stepper
-  liftIO (readIORef bref <&> toLazyByteString)
-
-
-downloadToFile :: (MonadMask m, MonadIO m)
-               => Bool             -- ^ https?
-               -> ByteString       -- ^ host (e.g. "www.example.com")
-               -> ByteString       -- ^ path (e.g. "/my/file") including query
-               -> Maybe Int        -- ^ optional port (e.g. 3000)
-               -> Path Abs         -- ^ destination file to create and write to
-               -> Excepts '[DownloadFailed] m ()
-downloadToFile https host fullPath port destFile = do
-  fd <- liftIO $ createRegularFileFd newFilePerms destFile
-  let stepper = fdWrite fd
-  flip finally (liftIO $ closeFd fd)
-    $ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper
-
-
-downloadInternal :: MonadIO m
-                 => Bool        -- ^ whether to show a progress bar
-                 -> Bool        -- ^ https?
-                 -> ByteString  -- ^ host
-                 -> ByteString  -- ^ path with query
-                 -> Maybe Int   -- ^ optional port
-                 -> (ByteString -> IO a)   -- ^ the consuming step function
-                 -> Excepts
-                      '[ HTTPStatusError
-                       , URIParseError
-                       , UnsupportedScheme
-                       , NoLocationHeader
-                       , TooManyRedirs
-                       ]
-                      m
-                      ()
-downloadInternal = go (5 :: Int)
-
- where
-  go redirs progressBar https host path port consumer = do
-    r <- liftIO $ withConnection' https host port action
-    veitherToExcepts r >>= \case
-      Just r' ->
-        if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
-      Nothing -> pure ()
-   where
-    action c = do
-      let q = buildRequest1 $ http GET path
-
-      sendRequest c q emptyBody
-
-      receiveResponse
-        c
-        (\r i' -> runE $ do
-          let scode = getStatusCode r
-          if
-            | scode >= 200 && scode < 300 -> downloadStream r i' >> pure Nothing
-            | scode >= 300 && scode < 400 -> case getHeader r "Location" of
-              Just r' -> pure $ Just $ r'
-              Nothing -> throwE NoLocationHeader
-            | otherwise -> throwE $ HTTPStatusError scode
-        )
-
-    followRedirectURL bs = case parseURI strictURIParserOptions bs of
-      Right uri' -> do
-        (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
-        go (redirs - 1) progressBar https' host' fullPath' port' consumer
-      Left e -> throwE e
-
-    downloadStream r i' = do
-      let size = case getHeader r "Content-Length" of
-            Just x' -> case decimal $ decUTF8Safe x' of
-              Left  _       -> 0
-              Right (r', _) -> r'
-            Nothing -> 0
-
-      mpb <- if progressBar
-        then Just <$> (liftIO $ newProgressBar defStyle 10 (Progress 0 size ()))
-        else pure Nothing
-
-      outStream <- liftIO $ Streams.makeOutputStream
-        (\case
-          Just bs -> do
-            forM_ mpb $ \pb -> incProgress pb (BS.length bs)
-            void $ consumer bs
-          Nothing -> pure ()
-        )
-      liftIO $ Streams.connect i' outStream
-
-
-getHead :: (MonadCatch m, MonadIO m)
-        => URI
-        -> Excepts
-             '[ HTTPStatusError
-              , URIParseError
-              , UnsupportedScheme
-              , NoLocationHeader
-              , TooManyRedirs
-              , ProcessError
-              ]
-             m
-             (M.Map (CI ByteString) ByteString)
-getHead uri' | scheme == "https" = head' True
-             | scheme == "http"  = head' False
-             | otherwise         = throwE UnsupportedScheme
-
- where
-  scheme = view (uriSchemeL' % schemeBSL') uri'
-  head' https = do
-    (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
-    liftE $ headInternal https host' fullPath' port'
-
-
-headInternal :: MonadIO m
-             => Bool        -- ^ https?
-             -> ByteString  -- ^ host
-             -> ByteString  -- ^ path with query
-             -> Maybe Int   -- ^ optional port
-             -> Excepts
-                  '[ HTTPStatusError
-                   , URIParseError
-                   , UnsupportedScheme
-                   , TooManyRedirs
-                   , NoLocationHeader
-                   ]
-                  m
-                  (M.Map (CI ByteString) ByteString)
-headInternal = go (5 :: Int)
-
- where
-  go redirs https host path port = do
-    r <- liftIO $ withConnection' https host port action
-    veitherToExcepts r >>= \case
-      Left r' ->
-        if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
-      Right hs -> pure hs
-   where
-
-    action c = do
-      let q = buildRequest1 $ http HEAD path
-
-      sendRequest c q emptyBody
-
-      unsafeReceiveResponse
-        c
-        (\r _ -> runE $ do
-          let scode = getStatusCode r
-          if
-            | scode >= 200 && scode < 300 -> do
-              let headers = getHeaderMap r
-              pure $ Right $ headers
-            | scode >= 300 && scode < 400 -> case getHeader r "Location" of
-              Just r' -> pure $ Left $ r'
-              Nothing -> throwE NoLocationHeader
-            | otherwise -> throwE $ HTTPStatusError scode
-        )
-
-    followRedirectURL bs = case parseURI strictURIParserOptions bs of
-      Right uri' -> do
-        (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
-        go (redirs - 1) https' host' fullPath' port'
-      Left e -> throwE e
-
-
-withConnection' :: Bool
-                -> ByteString
-                -> Maybe Int
-                -> (Connection -> IO a)
-                -> IO a
-withConnection' https host port action = bracket acquire closeConnection action
-
- where
-  acquire = case https of
-    True -> do
-      ctx <- baselineContextSSL
-      openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
-    False -> openConnection host (fromIntegral $ fromMaybe 80 port)

lib/GHCup/Download/Internal.hs

@@ -0,0 +1,214 @@
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+
+module GHCup.Download.Internal where
+
+
+import           GHCup.Errors
+import           GHCup.Types.Optics
+import           GHCup.Types.JSON               ( )
+import           GHCup.Utils.File
+import           GHCup.Utils.Prelude
+
+import           Control.Applicative
+import           Control.Exception.Safe
+import           Control.Monad
+import           Control.Monad.Reader
+import           Data.ByteString                ( ByteString )
+import           Data.ByteString.Builder
+import           Data.CaseInsensitive           ( CI )
+import           Data.IORef
+import           Data.Maybe
+import           Data.Text.Read
+import           HPath
+import           HPath.IO                      as HIO
+import           Haskus.Utils.Variant.Excepts
+import           Network.HTTP.Client
+import           Network.HTTP.Client.OpenSSL
+import           Network.HTTP.Types.Status
+import           Network.HTTP.Types.Header
+import           Optics
+import           Prelude                 hiding ( abs
+                                                , readFile
+                                                , writeFile
+                                                )
+import "unix"    System.Posix.IO.ByteString
+                                         hiding ( fdWrite )
+import "unix-bytestring" System.Posix.IO.ByteString
+                                                ( fdWrite )
+import           System.ProgressBar
+import           URI.ByteString
+
+import qualified Data.ByteString               as BS
+import qualified Data.ByteString.Lazy          as L
+import qualified Data.Map.Strict               as M
+import qualified Data.Text                     as T
+import qualified OpenSSL.Session               as SSL
+
+
+
+
+
+    ----------------------------
+    --[ Low-level (non-curl) ]--
+    ----------------------------
+
+
+-- | Load the result of this download into memory at once.
+downloadBS' :: (MonadThrow m, MonadIO m)
+            => URI
+            -> Excepts
+                 '[HTTPStatusError]
+                 m
+                 (L.ByteString)
+downloadBS' uri' = do
+  bref <- liftIO $ newIORef (mempty :: Builder)
+  -- TODO: performance
+  let stepper bs = modifyIORef bref (<> byteString bs)
+  downloadInternal False
+                   (T.unpack . decUTF8Safe . serializeURIRef' $ uri')
+                   stepper
+  liftIO (readIORef bref <&> toLazyByteString)
+
+
+downloadToFile :: (MonadMask m, MonadIO m)
+               => URI
+               -> Path Abs         -- ^ destination file to create and write to
+               -> Excepts '[DownloadFailed] m ()
+downloadToFile uri' destFile = do
+  fd <- liftIO $ createRegularFileFd newFilePerms destFile
+  let stepper = fdWrite fd
+  flip finally (liftIO $ closeFd fd)
+    $ reThrowAll DownloadFailed
+    $ downloadInternal True
+                       (T.unpack . decUTF8Safe . serializeURIRef' $ uri')
+                       stepper
+
+
+downloadInternal :: (MonadThrow m, MonadIO m)
+                 => Bool        -- ^ whether to show a progress bar
+                 -> String
+                 -> (ByteString -> IO a)   -- ^ the consuming step function
+                 -> Excepts
+                      '[HTTPStatusError]
+                      m
+                      ()
+downloadInternal progressBar uri' consumer = lEM $ liftIO $ withConnection' action
+ where
+  action :: (MonadThrow m, MonadIO m) => Manager -> m (Either HTTPStatusError ())
+  action m = do
+    request <- parseRequest ("GET " <> uri')
+    liftIO $ withResponse
+      request
+      m
+      (\r -> do
+        let scode = statusCode . responseStatus $ r
+        if
+          | scode >= 200 && scode < 300 ->
+              let headers = M.fromList . responseHeaders $ r
+              in fmap Right $ liftIO $ downloadStream (responseBody r) headers
+          | otherwise -> pure $ Left $ HTTPStatusError scode
+      )
+
+  downloadStream :: BodyReader -> M.Map HeaderName ByteString -> IO ()
+  downloadStream br headers = do
+    let size = case M.lookup "Content-Length" headers of
+          Just x' -> case decimal $ decUTF8Safe x' of
+            Left  _       -> 0
+            Right (r', _) -> r'
+          Nothing -> 0
+
+    mpb <- if progressBar
+      then Just <$> (liftIO $ newProgressBar defStyle 10 (Progress 0 size ()))
+      else pure Nothing
+
+    loop mpb
+
+   where
+    loop mpb = do
+      bs <- brRead br
+      if BS.length bs == 0 then pure () else do
+        void $ consumer bs
+        forM_ mpb $ \pb -> incProgress pb (BS.length bs)
+        loop mpb
+
+
+getHead :: (MonadCatch m, MonadIO m)
+        => URI
+        -> Excepts
+             '[HTTPStatusError, UnsupportedScheme]
+             m
+             (M.Map (CI ByteString) ByteString)
+getHead uri' | scheme == "https" || scheme == "http" = head'
+             | otherwise                             = throwE UnsupportedScheme
+
+ where
+  scheme = view (uriSchemeL' % schemeBSL') uri'
+  head' =
+    liftE $ headInternal (T.unpack . decUTF8Safe . serializeURIRef' $ uri')
+
+
+headInternal :: (MonadThrow m, MonadIO m)
+             => String
+             -> Excepts
+                  '[HTTPStatusError]
+                  m
+                  (M.Map (CI ByteString) ByteString)
+headInternal uri' = lEM $ liftIO $ withConnection' action
+ where
+  action :: (MonadThrow m, MonadIO m)
+         => Manager
+         -> m (Either HTTPStatusError (M.Map (CI ByteString) ByteString))
+  action m = do
+    request <- parseRequest ("HEAD " <> uri')
+    liftIO $ withResponse
+      request
+      m
+      (\r -> do
+        let scode = statusCode . responseStatus $ r
+        if
+          | scode >= 200 && scode < 300 -> do
+            let headers = responseHeaders r
+            pure $ Right $ M.fromList $ headers
+          | otherwise -> pure $ Left (HTTPStatusError scode)
+      )
+
+
+withConnection' :: (Manager -> IO a) -> IO a
+withConnection' action = do
+  mg  <- newManager $ opensslManagerSettings baselineContextSSL
+  withOpenSSL (action mg)
+
+
+baselineContextSSL :: IO SSL.SSLContext
+baselineContextSSL = withOpenSSL $ do
+    ctx <- SSL.context
+    SSL.contextSetDefaultCiphers ctx
+#if defined(darwin_HOST_OS)
+    SSL.contextSetVerificationMode ctx SSL.VerifyNone
+#elif defined(mingw32_HOST_OS)
+    SSL.contextSetVerificationMode ctx SSL.VerifyNone
+#elif defined(freebsd_HOST_OS)
+    SSL.contextSetCAFile ctx "/usr/local/etc/ssl/cert.pem"
+    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
+#elif defined(openbsd_HOST_OS)
+    SSL.contextSetCAFile ctx "/etc/ssl/cert.pem"
+    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
+#else
+    fedora <- doesDirectoryExist [abs|/etc/pki/tls|]
+    if fedora
+        then do
+            SSL.contextSetCAFile ctx "/etc/pki/tls/certs/ca-bundle.crt"
+        else do
+            SSL.contextSetCADirectory ctx "/etc/ssl/certs"
+    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
+#endif
+    return ctx

lib/GHCup/Download/Utils.hs

@@ -1,64 +0,0 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeApplications      #-}
-{-# LANGUAGE TypeFamilies          #-}
-
-
-module GHCup.Download.Utils where
-
-
-import           GHCup.Errors
-import           GHCup.Types.Optics
-import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Prelude
-
-import           Control.Applicative
-import           Control.Monad
-import           Data.ByteString                ( ByteString )
-import           Data.Maybe
-import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           Prelude                 hiding ( abs
-                                                , readFile
-                                                , writeFile
-                                                )
-import           URI.ByteString
-
-import qualified Data.Binary.Builder           as B
-import qualified Data.ByteString               as BS
-import qualified Data.ByteString.Lazy          as L
-
-
--- | Extracts from a URI type: (https?, host, path+query, port)
-uriToQuadruple :: Monad m
-               => URI
-               -> Excepts
-                    '[UnsupportedScheme]
-                    m
-                    (Bool, ByteString, ByteString, Maybe Int)
-uriToQuadruple URI {..} = do
-  let scheme = view schemeBSL' uriScheme
-
-  host <-
-    preview (_Just % authorityHostL' % hostBSL') uriAuthority
-      ?? UnsupportedScheme
-
-  https <- if
-    | scheme == "https" -> pure True
-    | scheme == "http"  -> pure False
-    | otherwise         -> throwE UnsupportedScheme
-
-  let queryBS =
-        BS.intercalate "&"
-          . fmap (\(x, y) -> encodeQuery x <> "=" <> encodeQuery y)
-          $ (queryPairs uriQuery)
-      port =
-        preview (_Just % authorityPortL' % _Just % portNumberL') uriAuthority
-      fullpath = if BS.null queryBS then uriPath else uriPath <> "?" <> queryBS
-  pure (https, host, fullpath, port)
-  where encodeQuery = L.toStrict . B.toLazyByteString . urlEncodeQuery
-

lib/GHCup/Types.hs

@@ -152,6 +152,7 @@ data Settings = Settings
   , noVerify   :: Bool
   , keepDirs   :: KeepDirs
   , downloader :: Downloader
+  , verbose    :: Bool
   }
   deriving Show
 

lib/GHCup/Utils.hs

@@ -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
@@ -43,7 +45,7 @@ import           Data.Versions
 import           Data.Word8
 import           GHC.IO.Exception
 import           HPath
-import           HPath.IO
+import           HPath.IO                hiding ( hideError )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
 import           Prelude                 hiding ( abs
@@ -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
+  spaths    <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
-  has_gmake <- isJust <$> searchPath spaths [rel|gmake|]
+  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
 

lib/GHCup/Utils/File.hs

@@ -1,27 +1,33 @@
 {-# 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           Control.Monad.Trans.State.Strict
 import           Data.ByteString                ( ByteString )
 import           Data.Foldable
 import           Data.Functor
 import           Data.IORef
 import           Data.Maybe
+import           Data.Sequence                  ( Seq, (|>) )
 import           Data.Text                      ( Text )
 import           Data.Void
+import           Data.Word8
 import           GHC.IO.Exception
 import           HPath
-import           HPath.IO
+import           HPath.IO                hiding ( hideError )
-import           Optics
+import           Optics                  hiding ((<|), (|>))
 import           System.Console.Pretty
 import           System.Console.Regions
 import           System.IO.Error
@@ -37,6 +43,7 @@ import           Text.Regex.Posix
 
 
 import qualified Control.Exception             as EX
+import qualified Data.Sequence                 as Sq
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified System.Posix.Process.ByteString
@@ -50,6 +57,7 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString
 
 
 
+
 -- | Bool signals whether the regions should be cleaned.
 data StopThread = StopThread Bool
   deriving Show
@@ -101,110 +109,149 @@ 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
-  logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
+  ldir          <- liftIO ghcupLogsDir
-  bracket (createFile (toFilePath logfile) newFilePerms) closeFd action
+  logfile       <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
+  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
+      -- start the thread that logs to stdout
-      done <- newEmptyMVar
+      pState <- newEmptyMVar
-      tid  <-
+      done   <- newEmptyMVar
-        forkIO
+      void
+        $ forkOS
         $ 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 pState
+          )
 
-      -- fork our subprocess
+      -- fork the subprocess
       pid <- SPPB.forkProcess $ do
         void $ dupTo stdoutWrite stdOutput
         void $ dupTo stdoutWrite stdError
-        closeFd stdoutWrite
         closeFd stdoutRead
+        closeFd stdoutWrite
 
         -- execute the action
         maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-        SPPB.executeFile exe spath args env
+        void $ SPPB.executeFile exe spath args env
 
       closeFd stdoutWrite
 
       -- wait for the subprocess to finish
-      e <- SPPB.getProcessStatus True True pid >>= \case
+      e <- toProcessError exe args <$!> SPPB.getProcessStatus True True pid
-        i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i
+      putMVar pState (either (const False) (const True) e)
-        i                        -> pure $ toProcessError exe args i
 
-      -- make sure the logging thread stops
-      case e of
-        Left  _ -> EX.throwTo tid (StopThread False)
-        Right _ -> EX.throwTo tid (StopThread True)
       takeMVar done
-
       closeFd stdoutRead
+
       pure e
 
+  tee :: Fd -> Fd -> IO ()
+  tee fileFd fdIn = readTilEOF lineAction fdIn
+
+   where
+    lineAction :: ByteString -> IO ()
+    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
+  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
-    ref <- newIORef ([] :: [ByteString])
+  printToRegion fileFd fdIn size pState = do
-    displayConsoleRegions $ do
+    void $ displayConsoleRegions $ do
-      rs <- sequence . replicate size . openConsoleRegion $ Linear
+      rs <-
-      flip finally (readTilEOF (lineAction ref rs) fdIn) -- make sure the last few lines don't get cut off
+        liftIO
+        . fmap Sq.fromList
+        . sequence
+        . replicate size
+        . openConsoleRegion
+        $ Linear
+      flip runStateT mempty
         $ handle
-            (\(StopThread b) -> do
+            (\(ex :: SomeException) -> do
-              when b (forM_ rs closeConsoleRegion)
+              ps <- liftIO $ takeMVar pState
-              EX.throw (StopThread b)
+              when (ps == True) (forM_ rs (liftIO . closeConsoleRegion))
+              throw ex
             )
-        $ do
+        $ readTilEOF (lineAction rs) fdIn
-            hideError eofErrorType $ readTilEOF (lineAction ref rs) fdIn
-            -- wait for explicit stop from the parent to signal what cleanup to run
-            forever (threadDelay 5000)
 
    where
     -- action to perform line by line
-    lineAction ref rs bs' = do
+    -- TODO: do this with vty for efficiency
-      modifyIORef' ref (swapRegs bs')
+    lineAction :: (MonadMask m, MonadIO m)
-      regs <- readIORef ref
+               => Seq ConsoleRegion
-      void $ SPIB.fdWrite fileFd (bs' <> "\n")
+               -> ByteString
-      forM (zip regs rs) $ \(bs, r) -> do
+               -> StateT (Seq ByteString) m ()
-        setConsoleRegion r $ do
+    lineAction rs = \bs' -> do
-          w <- consoleWidth
+      void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
-          return
+      modify (swapRegs bs')
-            . T.pack
+      regs <- get
-            . color Blue
+      liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
-            . T.unpack
+        w <- consoleWidth
-            . decUTF8Safe
+        return
-            . trim w
+          . T.pack
-            . (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
+          . color Blue
-            $ bs
+          . T.unpack
+          . decUTF8Safe
+          . trim w
+          . (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
+          $ bs
 
-    swapRegs bs regs | length regs < size = regs ++ [bs]
+    swapRegs :: a -> Seq a -> Seq a
-                     | otherwise          = tail regs ++ [bs]
+    swapRegs bs = \regs -> if
+      | Sq.length regs < size -> regs |> bs
+      | otherwise             -> Sq.drop 1 regs |> bs
 
     -- trim output line to terminal width
-    trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
+    trim :: Int -> ByteString -> ByteString
-              | otherwise                 = bs
+    trim w = \bs -> if
+      | 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)
+  -- read an entire line from the file descriptor (removes the newline char)
-    readLine fd' = do
+  readLine :: MonadIO m => Fd -> ByteString -> m (ByteString, ByteString)
-      bs <- SPIB.fdRead fd' 1
+  readLine fd = go
+   where
+    go inBs = do
+      bs <-
+        liftIO
+        $ handleIO (\e -> if isEOFError e then pure "" else ioError e)
+        $ SPIB.fdRead fd 512
+      let nbs          = BS.append inBs bs
+          (line, rest) = BS.span (/= _lf) nbs
       if
-        | bs == "\n" -> pure ""
+        | BS.length rest /= 0 -> pure (line, BS.tail rest)
-        | bs == ""   -> pure ""
+        | BS.length line == 0 -> pure (mempty, mempty)
-        | otherwise  -> fmap (bs <>) $ readLine fd'
+        | otherwise           -> (\(l, r) -> (line <> l, r)) <$!> go mempty
 
-    readTilEOF action' fd' = do
+  readTilEOF :: MonadIO m => (ByteString -> m a) -> Fd -> m ()
-      bs <- readLine fd'
+  readTilEOF ~action' fd' = go mempty
-      void $ action' bs
+   where
-      readTilEOF action' fd'
+    go bs' = do
+      (bs, rest) <- readLine fd' bs'
+      if
+        | BS.length bs == 0 -> liftIO
+        $ ioError (mkIOError eofErrorType "" Nothing Nothing)
+        | otherwise -> do
+          void $ action' bs
+          go rest
 
 
 -- | Capture the stdout and stderr of the given action, which

lib/GHCup/Utils/Prelude.hs

@@ -1,8 +1,12 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE DeriveLift          #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE QuasiQuotes         #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE TypeFamilies        #-}
@@ -13,8 +17,10 @@ module GHCup.Utils.Prelude where
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
+import           Control.Monad.Base
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      ( lift )
+import           Control.Monad.Trans.Control
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 import           Data.String
@@ -165,6 +171,11 @@ liftIOException errType ex =
     . lift
 
 
+-- | Uses safe-exceptions.
+hideError :: (MonadIO m, MonadCatch m) => IOErrorType -> m () -> m ()
+hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else liftIO . ioError $ e)
+
+
 hideErrorDef :: [IOErrorType] -> a -> IO a -> IO a
 hideErrorDef errs def =
   handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e)
@@ -259,3 +270,40 @@ decUTF8Safe = E.decodeUtf8With E.lenientDecode
 
 decUTF8Safe' :: L.ByteString -> Text
 decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode
+
+
+instance MonadBaseControl b m => MonadBaseControl b (Excepts e m) where
+    type StM (Excepts e m) a = ComposeSt (Excepts e) m a
+    liftBaseWith   = defaultLiftBaseWith
+    restoreM       = defaultRestoreM
+    {-# INLINABLE liftBaseWith #-}
+    {-# INLINABLE restoreM #-}
+
+instance MonadTransControl (Excepts e) where
+    type StT (Excepts e) a = VEither e a
+    liftWith f = veitherMToExcepts <$> liftM return $ f $ runE
+    restoreT = veitherMToExcepts
+    {-# INLINABLE liftWith #-}
+    {-# INLINABLE restoreT #-}
+
+instance MonadBase b m => MonadBase b (Excepts e m) where
+  liftBase = liftBaseDefault
+  {-# INLINABLE liftBase #-}
+
+instance MonadBaseControl (VEither e) (VEither e) where
+  type StM (VEither e) a = a
+  liftBaseWith f = f id
+  restoreM = return
+  {-# INLINABLE liftBaseWith #-}
+  {-# INLINABLE restoreM #-}
+
+instance MonadBase (VEither e) (VEither e) where
+  liftBase = id
+  {-# INLINABLE liftBase #-}
+
+
+veitherMToExcepts :: Monad m => m (VEither es a) -> Excepts es m a
+veitherMToExcepts ma = do
+  ve <- lift ma
+  veitherToExcepts ve
+

lib/GHCup/Utils/Version/QQ.hs

@@ -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

lib/GHCup/Version.hs

@@ -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

www/ghcup.css

@@ -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-win32 > div > pre,
-#platform-instructions-win64 > 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,

www/index.html

@@ -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>