hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Get rid of tar

Browse Source
This commit is contained in:
Julian Ospald
2021-08-24 20:18:14 +02:00
parent 4d465efef1
commit f8cfcd4038
11 changed files with 27 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
lib/GHCup.hs
View File

@@ -39,9 +39,7 @@ 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.DeepSeq ( force )
import Control.Exception ( evaluate )
@@ -83,7 +81,7 @@ import System.IO.Error
#if defined(IS_WINDOWS)
import System.IO.Temp
#endif
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import qualified Crypto.Hash.SHA256 as SHA256
@@ -197,9 +195,7 @@ installGHCBindist :: ( MonadFail m
, UnknownArchive
, TarDirDoesNotExist
, DirNotEmpty
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
@@ -264,9 +260,7 @@ installPackedGHC :: ( MonadMask m
, UnknownArchive
, TarDirDoesNotExist
, DirNotEmpty
#if !defined(TAR)
, ArchiveResult
#endif
] m ()
installPackedGHC dl msubdir inst ver = do
PlatformRequest {..} <- lift getPlatformReq
@@ -382,9 +376,7 @@ installGHCBin :: ( MonadFail m
, UnknownArchive
, TarDirDoesNotExist
, DirNotEmpty
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
@@ -419,9 +411,7 @@ installCabalBindist :: ( MonadMask m
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
, FileAlreadyExistsError
]
m
@@ -515,9 +505,7 @@ installCabalBin :: ( MonadMask m
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
, FileAlreadyExistsError
]
m
@@ -553,9 +541,7 @@ installHLSBindist :: ( MonadMask m
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
@@ -660,9 +646,7 @@ installHLSBin :: ( MonadMask m
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
@@ -698,9 +682,7 @@ installStackBin :: ( MonadMask m
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
@@ -735,9 +717,7 @@ installStackBindist :: ( MonadMask m
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
@@ -1791,9 +1771,7 @@ compileGHC :: ( MonadMask m
, TarDirDoesNotExist
, NotInstalled
, DirNotEmpty
#if !defined(TAR)
, ArchiveResult
#endif
]
m
GHCTargetVersion

16
lib/GHCup/Errors.hs
View File

@@ -21,11 +21,7 @@ module GHCup.Errors where
import GHCup.Types
#if !defined(TAR)
import Codec.Archive
#else
import qualified Codec.Archive.Tar as Tar
#endif
import Control.Exception.Safe
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
@@ -390,7 +386,6 @@ instance Pretty URIParseError where
pPrint (OtherError err) =
text [i|Failed to parse URI: #{err}|]
#if !defined(TAR)
instance Pretty ArchiveResult where
pPrint ArchiveFatal = text "Archive result: fatal"
pPrint ArchiveFailed = text "Archive result: failed"
@@ -398,14 +393,3 @@ instance Pretty ArchiveResult where
pPrint ArchiveRetry = text "Archive result: retry"
pPrint ArchiveOk = text "Archive result: Ok"
pPrint ArchiveEOF = text "Archive result: EOF"
#else
instance Pretty Tar.FormatError where
pPrint Tar.TruncatedArchive = text "Truncated archive"
pPrint Tar.ShortTrailer = text "Short trailer"
pPrint Tar.BadTrailer = text "Bad trailer"
pPrint Tar.TrailingJunk = text "Trailing junk"
pPrint Tar.ChecksumIncorrect = text "Checksum incorrect"
pPrint Tar.NotTarFormat = text "Not a tar format"
pPrint Tar.UnrecognisedTarFormat = text "Unrecognised tar format"
pPrint Tar.HeaderBadNumericEncoding = text "Header has bad numeric encoding"
#endif

33
lib/GHCup/Utils.hs
View File

@@ -39,9 +39,7 @@ import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
#if !defined(TAR)
import Codec.Archive hiding ( Directory )
#endif
import Codec.Archive.Zip
import Control.Applicative
import Control.Exception.Safe
@@ -83,9 +81,6 @@ import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
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
@@ -603,27 +598,17 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
=> FilePath -- ^ destination dir
-> FilePath -- ^ archive path
-> Excepts '[UnknownArchive
#if !defined(TAR)
, ArchiveResult
#endif
] m ()
unpackToDir dfp av = do
let fn = takeFileName av
lift $ $(logInfo) [i|Unpacking: #{fn} to #{dfp}|]
#if defined(TAR)
let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
untar = liftIO . Tar.unpack dfp . Tar.read
rf :: MonadIO m => FilePath -> Excepts '[] 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
@@ -644,34 +629,16 @@ unpackToDir dfp av = do
getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
=> FilePath -- ^ archive path
-> Excepts '[UnknownArchive
#if defined(TAR)
, Tar.FormatError
#else
, ArchiveResult
#endif
] m [FilePath]
getArchiveFiles av = do
let fn = takeFileName av
#if defined(TAR)
let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [FilePath]
entries =
lE @Tar.FormatError
. Tar.foldEntries
(\e x -> fmap (Tar.entryPath e :) x)
(Right [])
(\e -> Left e)
. Tar.read
rf :: MonadIO m => FilePath -> Excepts '[Tar.FormatError] 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