Compare commits
23 Commits
friday-imp
...
tar
| Author | SHA1 | Date | |
|---|---|---|---|
| 2ece023c0f | |||
| afd7e7dc4f | |||
| 55030d83da | |||
| c680a9f33b | |||
| df192ee18e | |||
|
|
008def2ff4 | ||
|
|
3976daddb7 | ||
| 524cdbbeb1 | |||
| a01c5acfe2 | |||
|
|
6689312ac5 | ||
| e214695a3e | |||
| 3cea6ef97c | |||
| 3b0f131a65 | |||
|
|
e0a3020e34 | ||
|
|
0e46b9509a | ||
|
|
d3474d0cd9 | ||
|
|
5c3dad1bb9 | ||
|
|
987cdaf313 | ||
|
|
835352428a | ||
|
|
8f4246e716 | ||
|
|
1353a2fd20 | ||
|
|
aa9fbdbfc2 | ||
| 3a8cdf9967 |
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
Submodule data/metadata updated: 0239166c31...7e1a50cfff
@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
|
||||
|
||||
## Basic usage
|
||||
|
||||
For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
|
||||
For the simple, interactive, text-based user interface (TUI), run:
|
||||
|
||||
```sh
|
||||
ghcup tui
|
||||
@@ -67,8 +67,7 @@ and make sure your bashrc sources the startup script
|
||||
|
||||
`ghcup` is very portable. There are a few exceptions though:
|
||||
|
||||
1. `ghcup tui` is only available on non-windows platforms
|
||||
2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
|
||||
1. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
|
||||
|
||||
# Configuration
|
||||
|
||||
@@ -557,7 +556,7 @@ You need the required wasm toolchain:
|
||||
git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta.git
|
||||
cd ghc-wasm-meta/
|
||||
export SKIP_GHC=yes
|
||||
sh setup.sh
|
||||
./setup.sh
|
||||
source ~/.ghc-wasm/env
|
||||
```
|
||||
|
||||
|
||||
28
ghcup.cabal
28
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
|
||||
@@ -122,6 +135,7 @@ library
|
||||
GHCup.Types.Stack
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Utils.Tar
|
||||
GHCup.Version
|
||||
|
||||
hs-source-dirs: lib
|
||||
@@ -166,7 +180,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 +209,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
|
||||
@@ -327,6 +349,8 @@ executable ghcup
|
||||
, brick ^>=2.1
|
||||
, transformers ^>=0.5
|
||||
, vty ^>=6.0
|
||||
, unix ^>=2.7
|
||||
, optics ^>=0.4
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
@@ -29,6 +29,7 @@ import Data.Maybe
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import System.Process ( system )
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
@@ -128,21 +129,22 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||
Just uri -> do
|
||||
pfreq <- runAppState getPlatformReq
|
||||
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
|
||||
cmd = case _rPlatform pfreq of
|
||||
Darwin -> "open"
|
||||
Linux _ -> "xdg-open"
|
||||
FreeBSD -> "xdg-open"
|
||||
Windows -> "start"
|
||||
|
||||
if clOpen
|
||||
then do
|
||||
runAppState $
|
||||
exec cmd
|
||||
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
|
||||
Nothing
|
||||
Nothing
|
||||
case _rPlatform pfreq of
|
||||
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||
FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||
Windows -> do
|
||||
let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
|
||||
c <- liftIO $ system $ args
|
||||
case c of
|
||||
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
|
||||
ExitSuccess -> pure $ Right ()
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> logError (T.pack $ prettyHFError e)
|
||||
>> pure (ExitFailure 13)
|
||||
else liftIO $ putStrLn uri' >> pure ExitSuccess
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 )
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -24,6 +24,7 @@ module GHCup.Types
|
||||
, Key(..)
|
||||
, Modifier(..)
|
||||
#endif
|
||||
, ArchiveResult(..)
|
||||
)
|
||||
where
|
||||
|
||||
@@ -31,6 +32,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 +782,18 @@ data BuildSystem = Hadrian
|
||||
| Make
|
||||
deriving (Show, Eq)
|
||||
|
||||
#if defined(TAR)
|
||||
data ArchiveResult = ArchiveFatal
|
||||
| ArchiveFailed
|
||||
| ArchiveWarn
|
||||
| ArchiveRetry
|
||||
| ArchiveOk
|
||||
| ArchiveEOF
|
||||
deriving (Eq, Show, GHC.Generic)
|
||||
|
||||
instance NFData ArchiveResult
|
||||
|
||||
instance Exception ArchiveResult
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
@@ -21,6 +21,7 @@ installation and introspection of files/versions etc.
|
||||
-}
|
||||
module GHCup.Utils
|
||||
( module GHCup.Utils.Dirs
|
||||
, module GHCup.Utils.Tar
|
||||
, module GHCup.Utils
|
||||
#if defined(IS_WINDOWS)
|
||||
, module GHCup.Prelude.Windows
|
||||
@@ -42,6 +43,7 @@ import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Tar
|
||||
import GHCup.Version
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.File
|
||||
@@ -49,7 +51,6 @@ import GHCup.Prelude.Logger.Internal
|
||||
import GHCup.Prelude.MegaParsec
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prelude.String.QQ
|
||||
import Codec.Archive hiding ( Directory )
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
@@ -79,10 +80,6 @@ import Text.Regex.Posix
|
||||
import Text.PrettyPrint.HughesPJClass (prettyShow)
|
||||
import URI.ByteString
|
||||
|
||||
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.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
@@ -783,99 +780,6 @@ getLatestToolFor tool target pvpIn dls = do
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
--[ Unpacking ]--
|
||||
-----------------
|
||||
|
||||
|
||||
|
||||
-- | Unpack an archive to a temporary directory and return that path.
|
||||
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ destination dir
|
||||
-> FilePath -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
, ArchiveResult
|
||||
] m ()
|
||||
unpackToDir dfp av = do
|
||||
let fn = takeFileName av
|
||||
lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
|
||||
|
||||
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
|
||||
|
||||
-- extract, depending on file extension
|
||||
if
|
||||
| ".tar.gz" `isSuffixOf` fn -> liftE
|
||||
(untar . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
liftE $ untar decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (untar . BZip.decompress =<< rf av)
|
||||
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||
| ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||
| otherwise -> throwE $ UnknownArchive fn
|
||||
|
||||
|
||||
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
, ArchiveResult
|
||||
] m [FilePath]
|
||||
getArchiveFiles av = do
|
||||
let fn = takeFileName av
|
||||
|
||||
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
|
||||
|
||||
-- extract, depending on file extension
|
||||
if
|
||||
| ".tar.gz" `isSuffixOf` fn -> liftE
|
||||
(entries . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
liftE $ entries decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (entries . BZip.decompress =<< rf av)
|
||||
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||
| ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||
| otherwise -> throwE $ UnknownArchive fn
|
||||
|
||||
|
||||
intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
|
||||
=> GHCupPath -- ^ unpacked tar dir
|
||||
-> TarDir -- ^ how to descend
|
||||
-> Excepts '[TarDirDoesNotExist] m GHCupPath
|
||||
intoSubdir bdir tardir = case tardir of
|
||||
RealDir pr -> do
|
||||
whenM (fmap not . liftIO . doesDirectoryExist $ fromGHCupPath (bdir `appendGHCupPath` pr))
|
||||
(throwE $ TarDirDoesNotExist tardir)
|
||||
pure (bdir `appendGHCupPath` pr)
|
||||
RegexDir r -> do
|
||||
let rs = split (`elem` pathSeparators) r
|
||||
foldlM
|
||||
(\y x ->
|
||||
(handleIO (\_ -> pure []) . liftIO . findFiles (fromGHCupPath y) . regex $ x) >>= (\case
|
||||
[] -> throwE $ TarDirDoesNotExist tardir
|
||||
(p : _) -> pure (y `appendGHCupPath` p)) . sort
|
||||
)
|
||||
bdir
|
||||
rs
|
||||
where regex = makeRegexOpts compIgnoreCase execBlank
|
||||
|
||||
|
||||
|
||||
|
||||
------------
|
||||
--[ Tags ]--
|
||||
------------
|
||||
@@ -929,6 +833,28 @@ getLatestBaseVersion av pvpVer =
|
||||
--[ Other ]--
|
||||
-------------
|
||||
|
||||
|
||||
intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
|
||||
=> GHCupPath -- ^ unpacked tar dir
|
||||
-> TarDir -- ^ how to descend
|
||||
-> Excepts '[TarDirDoesNotExist] m GHCupPath
|
||||
intoSubdir bdir tardir = case tardir of
|
||||
RealDir pr -> do
|
||||
whenM (fmap not . liftIO . doesDirectoryExist $ fromGHCupPath (bdir `appendGHCupPath` pr))
|
||||
(throwE $ TarDirDoesNotExist tardir)
|
||||
pure (bdir `appendGHCupPath` pr)
|
||||
RegexDir r -> do
|
||||
let rs = split (`elem` pathSeparators) r
|
||||
foldlM
|
||||
(\y x ->
|
||||
(handleIO (\_ -> pure []) . liftIO . findFiles (fromGHCupPath y) . regex $ x) >>= (\case
|
||||
[] -> throwE $ TarDirDoesNotExist tardir
|
||||
(p : _) -> pure (y `appendGHCupPath` p)) . sort
|
||||
)
|
||||
bdir
|
||||
rs
|
||||
where regex = makeRegexOpts compIgnoreCase execBlank
|
||||
|
||||
-- | Usually @~\/.ghcup\/ghc\/\<ver\>\/bin\/@
|
||||
ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
||||
=> GHCTargetVersion
|
||||
|
||||
139
lib/GHCup/Utils/Tar.hs
Normal file
139
lib/GHCup/Utils/Tar.hs
Normal file
@@ -0,0 +1,139 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Tar
|
||||
Description : GHCup tar abstractions
|
||||
Copyright : (c) Julian Ospald, 2024
|
||||
License : LGPL-3.0
|
||||
Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Utils.Tar where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Errors
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.Logger.Internal
|
||||
import GHCup.Types.Optics
|
||||
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import Control.Monad.Reader
|
||||
import Data.List
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import System.FilePath
|
||||
|
||||
#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 qualified Codec.Compression.BZip as BZip
|
||||
import qualified Codec.Compression.GZip as GZip
|
||||
import qualified Codec.Compression.Lzma as Lzma
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
-- | Unpack an archive to a given directory.
|
||||
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ destination dir
|
||||
-> FilePath -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
, ArchiveResult
|
||||
] m ()
|
||||
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
|
||||
| ".tar.gz" `isSuffixOf` fn -> liftE
|
||||
(untar . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
liftE $ untar decompressed
|
||||
| ".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
|
||||
|
||||
|
||||
-- | Get all files from an archive.
|
||||
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ archive path
|
||||
-> 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
|
||||
| ".tar.gz" `isSuffixOf` fn -> liftE
|
||||
(entries . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
liftE $ entries decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (entries . BZip.decompress =<< rf av)
|
||||
| ".tar" `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
|
||||
|
||||
@@ -35,7 +35,7 @@ export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
: "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
|
||||
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
: "${GHCUP_INSTALL_BASE_PREFIX:=/c}"
|
||||
GHCUP_DIR=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup")
|
||||
GHCUP_BIN=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup/bin")
|
||||
@@ -72,7 +72,7 @@ warn() {
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
# shellcheck disable=SC3037
|
||||
echo -e "\\033[0;35m$1\\033[0m"
|
||||
;;
|
||||
@@ -88,7 +88,7 @@ yellow() {
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
# shellcheck disable=SC3037
|
||||
echo -e "\\033[0;33m$1\\033[0m"
|
||||
;;
|
||||
@@ -104,7 +104,7 @@ green() {
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
# shellcheck disable=SC3037
|
||||
echo -e "\\033[0;32m$1\\033[0m"
|
||||
;;
|
||||
@@ -160,7 +160,7 @@ _done() {
|
||||
echo
|
||||
echo "==============================================================================="
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
green
|
||||
green "All done!"
|
||||
green
|
||||
@@ -313,7 +313,7 @@ download_ghcup() {
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
case "${arch}" in
|
||||
x86_64|amd64)
|
||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe
|
||||
@@ -326,7 +326,7 @@ download_ghcup() {
|
||||
;;
|
||||
esac
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
||||
"curl")
|
||||
# shellcheck disable=SC2086
|
||||
@@ -545,7 +545,7 @@ adjust_bashrc() {
|
||||
printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
||||
fi
|
||||
;;
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
if [ ! -e "${HOME}/.bash_profile" ] ; then
|
||||
echo '# generated by ghcup' > "${HOME}/.bash_profile"
|
||||
echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
|
||||
@@ -595,7 +595,7 @@ adjust_cabal_config() {
|
||||
|
||||
ask_cabal_config_init() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
if [ -n "${BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG}" ] ; then
|
||||
return 1
|
||||
fi
|
||||
@@ -636,7 +636,7 @@ ask_cabal_config_init() {
|
||||
|
||||
do_cabal_config_init() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
case $1 in
|
||||
1)
|
||||
adjust_cabal_config
|
||||
@@ -756,7 +756,7 @@ if [ -z "${GHCUP_USE_XDG_DIRS}" ] ; then
|
||||
echo "ghcup installs only into the following directory,"
|
||||
echo "which can be removed anytime:"
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
echo " $(cygpath -w "$GHCUP_DIR")"
|
||||
;;
|
||||
*)
|
||||
@@ -823,7 +823,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||
edo cabal update --ignore-project
|
||||
else # don't install ghc and cabal
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
# need to bootstrap cabal to initialize config on windows
|
||||
# we'll remove it afterwards
|
||||
tmp_dir="$(mktemp -d)"
|
||||
|
||||
@@ -476,7 +476,9 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
|
||||
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||
Remove-Item -Path "$archivePath"
|
||||
# We ignore errors because we don't want the installation script to fail just because a temporary file can't be removed.
|
||||
# Relevant issue: https://github.com/haskell/ghcup-hs/issues/952
|
||||
Remove-Item -Path "$archivePath" -ErrorAction Continue
|
||||
|
||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||
Exec "$Bash" '-lc' 'exit'
|
||||
|
||||
Reference in New Issue
Block a user