Re-introduce tar

app/ghcup/BrickMain.hs

@@ -44,7 +44,6 @@ import           Brick.Widgets.Center ( center, centerLayer )
 import qualified Brick.Widgets.List as L
 import           Brick.Focus (FocusRing)
 import qualified Brick.Focus as F
-import           Codec.Archive
 import           Control.Applicative
 import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)

cabal.project

@@ -3,7 +3,7 @@ packages: ./ghcup.cabal
 optional-packages: ./vendored/*/*.cabal
 
 package ghcup
-    flags: +tui
+    flags: +tui +tar
 
 constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0
@@ -13,6 +13,11 @@ source-repository-package
   location: https://github.com/fosskers/versions.git
   tag: 7bc3355348aac3510771d4622aff09ac38c9924d
 
+source-repository-package
+  type: git
+  location: https://github.com/haskell/tar.git
+  tag: d94a988be4311b830149a9f8fc16739927e5fc1c
+
 package libarchive
   flags: -system-libarchive
 
@@ -30,3 +35,6 @@ package streamly
 
 package *
   test-show-details: direct
+
+allow-newer: cabal-install-parsers:tar
+

cabal.project.release

@@ -5,7 +5,7 @@ optional-packages: ./vendored/*/*.cabal
 optimization: 2
 
 package ghcup
-  flags: +tui
+  flags: +tui -tar
 
 if os(linux)
   if arch(x86_64) || arch(i386)

ghcup.cabal

@@ -53,6 +53,11 @@ flag no-exe
   default:     False
   manual:      True
 
+flag tar
+  description: Use haskell tar instead of libarchive.
+  default:     False
+  manual:      True
+
 common app-common-depends
   build-depends:
     , aeson                  >=1.4
@@ -68,7 +73,6 @@ common app-common-depends
     , filepath               ^>=1.4.2.1
     , haskus-utils-types     ^>=1.5
     , haskus-utils-variant   ^>=3.2.1
-    , libarchive             ^>=3.0.3.0
     , megaparsec             >=8.0.0    && <9.3
     , mtl                    ^>=2.2
     , optparse-applicative   >=0.15.1.0 && <0.18
@@ -90,6 +94,15 @@ common app-common-depends
     , versions               >=6.0.3    && <6.1
     , yaml-streamly          ^>=0.12.0
 
+  if flag(tar)
+    cpp-options:   -DTAR
+    build-depends:
+        tar ^>=0.6.0.0
+      , zip ^>=2.0.0
+
+  else
+    build-depends: libarchive ^>=3.0.3.0
+
 library
   exposed-modules:
     GHCup
@@ -166,7 +179,6 @@ library
     , filepath              ^>=1.4.2.1
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1
-    , libarchive            ^>=3.0.3.0
     , lzma-static           ^>=5.2.5.3
     , megaparsec            >=8.0.0      && <9.3
     , mtl                   ^>=2.2
@@ -196,6 +208,15 @@ library
     , yaml-streamly         ^>=0.12.0
     , zlib                  ^>=0.6.2.2
 
+  if flag(tar)
+    cpp-options:   -DTAR
+    build-depends:
+        tar ^>=0.6.0.0
+      , zip ^>=2.0.0
+
+  else
+    build-depends: libarchive ^>=3.0.3.0
+
   if (flag(internal-downloader) && !os(windows))
     exposed-modules: GHCup.Download.IOStreams
     cpp-options:     -DINTERNAL_DOWNLOADER

lib-opt/GHCup/OptParse/Compile.hs

@@ -25,7 +25,6 @@ import           GHCup.OptParse.Common
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Codec.Archive                  ( ArchiveResult )
 import           Control.Concurrent (threadDelay)
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource

lib-opt/GHCup/OptParse/Install.hs

@@ -24,7 +24,6 @@ import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
 
-import           Codec.Archive
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif

lib-opt/GHCup/OptParse/Run.hs

@@ -28,7 +28,6 @@ import           Control.Exception.Safe         ( MonadMask, MonadCatch )
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Codec.Archive
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
 import           Data.Functor

lib-opt/GHCup/OptParse/Test.hs

@@ -23,7 +23,6 @@ import           GHCup.Utils.Dirs
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
 
-import           Codec.Archive
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif

lib/GHCup/Cabal.hs

@@ -26,7 +26,6 @@ import           GHCup.Prelude
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 
-import           Codec.Archive                  ( ArchiveResult )
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad

lib/GHCup/Errors.hs

@@ -21,7 +21,9 @@ module GHCup.Errors where
 
 import           GHCup.Types
 
+#if !defined(TAR)
 import           Codec.Archive
+#endif
 import           Control.Exception.Safe
 import           Data.ByteString                ( ByteString )
 import           Data.CaseInsensitive           ( CI )

lib/GHCup/GHC.hs

@@ -34,7 +34,6 @@ import           GHCup.Prelude.String.QQ
 import           GHCup.Prelude.Version.QQ
 import           GHCup.Prelude.MegaParsec
 
-import           Codec.Archive                  ( ArchiveResult )
 import           Control.Applicative
 import           Control.Concurrent             ( threadDelay )
 import           Control.Exception.Safe

lib/GHCup/HLS.hs

@@ -30,7 +30,6 @@ import           GHCup.Prelude.Logger
 import           GHCup.Prelude.Process
 import           GHCup.Prelude.String.QQ
 
-import           Codec.Archive                  ( ArchiveResult )
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad

lib/GHCup/Stack.hs

@@ -26,7 +26,6 @@ import           GHCup.Prelude
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 
-import           Codec.Archive                  ( ArchiveResult )
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad

lib/GHCup/Types.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE DeriveAnyClass    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -24,6 +25,7 @@ module GHCup.Types
   , Key(..)
   , Modifier(..)
 #endif
+  , ArchiveResult(..)
   )
   where
 
@@ -31,6 +33,11 @@ import           GHCup.Types.Stack              ( SetupInfo )
 import {-# SOURCE #-} GHCup.Utils.Dirs          ( fromGHCupPath, GHCupPath )
 
 import           Control.DeepSeq                ( NFData, rnf )
+#if defined(TAR)
+import           Control.Exception              ( Exception )
+#else
+import           Codec.Archive                  ( ArchiveResult(..) )
+#endif
 import           Data.Map.Strict                ( Map )
 import           Data.List.NonEmpty             ( NonEmpty (..) )
 import           Data.Time.Calendar             ( Day )
@@ -776,3 +783,13 @@ data BuildSystem = Hadrian
                  | Make
   deriving (Show, Eq)
 
+#if defined(TAR)
+data ArchiveResult = ArchiveFatal
+                   | ArchiveFailed
+                   | ArchiveWarn
+                   | ArchiveRetry
+                   | ArchiveOk
+                   | ArchiveEOF
+  deriving (Eq, Show, GHC.Generic, NFData, Exception)
+#endif
+

lib/GHCup/Utils.hs

@@ -49,7 +49,13 @@ import           GHCup.Prelude.Logger.Internal
 import           GHCup.Prelude.MegaParsec
 import           GHCup.Prelude.Process
 import           GHCup.Prelude.String.QQ
+#if defined(TAR)
+import           Codec.Archive.Zip
+import qualified Codec.Archive.Tar             as Tar
+import qualified Codec.Archive.Tar.Entry       as Tar
+#else
 import           Codec.Archive           hiding ( Directory )
+#endif
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
@@ -802,11 +808,19 @@ unpackToDir dfp av = do
   let fn = takeFileName av
   lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
 
+#if defined(TAR)
+  let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
+      untar = liftIO . Tar.unpack dfp . Tar.read
+
+      rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
+      rf = liftIO . BL.readFile
+#else
   let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
       untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
 
       rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
       rf = liftIO . BL.readFile
+#endif
 
   -- extract, depending on file extension
   if
@@ -819,23 +833,42 @@ unpackToDir dfp av = do
     | ".tar.bz2" `isSuffixOf` fn ->
       liftE (untar . BZip.decompress =<< rf av)
     | ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
+#if defined(TAR)
+    | ".zip" `isSuffixOf` fn -> withArchive av (unpackInto dfp)
+#else
+    -- libarchive supports zip
     | ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
+#endif
     | otherwise -> throwE $ UnknownArchive fn
 
 
 getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
                 => FilePath       -- ^ archive path
-                -> Excepts '[UnknownArchive
+                -> Excepts '[ UnknownArchive
                             , ArchiveResult
                             ] m [FilePath]
 getArchiveFiles av = do
   let fn = takeFileName av
+#if defined(TAR)
+  let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
+      entries =
+          lE @ArchiveResult
+          . Tar.foldEntries
+            (\e x -> fmap (Tar.entryTarPath e :) x)
+            (Right [])
+            (\_ -> Left ArchiveFailed)
+          . Tar.decodeLongNames
+          . Tar.read
 
+      rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
+      rf = liftIO . BL.readFile
+#else
   let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
       entries = (fmap . fmap) filepath . lE . readArchiveBSL
 
       rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
       rf = liftIO . BL.readFile
+#endif
 
   -- extract, depending on file extension
   if
@@ -848,7 +881,14 @@ getArchiveFiles av = do
     | ".tar.bz2" `isSuffixOf` fn ->
       liftE (entries . BZip.decompress =<< rf av)
     | ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
-    | ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
+    | ".zip" `isSuffixOf` fn ->
+#if defined(TAR)
+        withArchive av $ do
+          entries' <- getEntries
+          pure $ fmap unEntrySelector $ Map.keys entries'
+#else
+        liftE (entries =<< rf av)
+#endif
     | otherwise -> throwE $ UnknownArchive fn