Merge branch 'ghc-8.10.1'
This commit is contained in:
commit
3c80929c38
|
|
@ -11,15 +11,8 @@ mkdir -p "${TMPDIR}"
|
|||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
|
||||
# ./ghcup-bin install ${GHC_VERSION}
|
||||
# ./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
# ./ghcup-bin set ${GHC_VERSION}
|
||||
|
||||
# install cabal-3.2.0.0
|
||||
curl -sSfL -o cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz&dl=1'
|
||||
tar xf cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz
|
||||
cp cabal "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
|
||||
exit 0
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ ecabal update
|
|||
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${BIT}" = "32" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static'
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
||||
fi
|
||||
|
|
|
|||
|
|
@ -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
|
||||
cp ghcup "./${ARTIFACT}"
|
||||
|
|
|
|||
|
|
@ -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 ())
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
|
@ -19,7 +20,9 @@ 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
|
||||
|
|
@ -47,6 +50,7 @@ import qualified Data.Vector as V
|
|||
data AppState = AppState {
|
||||
lr :: LR
|
||||
, dls :: GHCupDownloads
|
||||
, pfreq :: PlatformRequest
|
||||
}
|
||||
|
||||
type LR = GenericList String Vector ListResult
|
||||
|
|
@ -151,9 +155,9 @@ 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)
|
||||
continue (AppState (listMoveUp lr) dls pfreq)
|
||||
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
|
||||
continue (AppState (listMoveDown lr) dls)
|
||||
continue (AppState (listMoveDown lr) dls pfreq)
|
||||
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
|
||||
case find (\(c', _, _) -> c' == c) keyHandlers of
|
||||
Nothing -> continue as
|
||||
|
|
@ -175,7 +179,7 @@ withIOAction action as = case listSelectedElement (lr as) of
|
|||
Right _ -> do
|
||||
apps <- (fmap . fmap)
|
||||
(\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
|
||||
getAppState
|
||||
$ getAppState Nothing (pfreq as)
|
||||
case apps of
|
||||
Right nas -> do
|
||||
putStrLn "Press enter to continue"
|
||||
|
|
@ -196,13 +200,29 @@ install' AppState {..} (_, ListResult {..}) = do
|
|||
. flip runReaderT settings
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[AlreadyInstalled, UnknownArchive, ArchiveResult, DistroNotFound, FileDoesNotExistError, CopyError, NoCompatibleArch, NoDownload, NotInstalled, NoCompatiblePlatform, BuildFailed, TagNotFound, DigestError, DownloadFailed, NoUpdate]
|
||||
@'[AlreadyInstalled
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
, DistroNotFound
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NoCompatibleArch
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, NoCompatiblePlatform
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, DownloadFailed
|
||||
, NoUpdate]
|
||||
|
||||
(run $ do
|
||||
case lTool of
|
||||
GHC -> liftE $ installGHCBin dls lVer Nothing
|
||||
Cabal -> liftE $ installCabalBin dls lVer Nothing
|
||||
GHCup -> liftE $ upgradeGHCup dls Nothing False $> ()
|
||||
GHC -> liftE $ installGHCBin dls lVer pfreq
|
||||
Cabal -> liftE $ installCabalBin dls lVer pfreq
|
||||
GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
|
|
@ -280,6 +300,7 @@ settings' = unsafePerformIO
|
|||
, noVerify = False
|
||||
, keepDirs = Never
|
||||
, downloader = Curl
|
||||
, verbose = False
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -294,15 +315,15 @@ logger' = unsafePerformIO
|
|||
)
|
||||
|
||||
|
||||
brickMain :: Settings -> Maybe URI -> LoggerConfig -> IO ()
|
||||
brickMain s muri l = do
|
||||
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
|
||||
eApps <- getAppState (Just av) pfreq'
|
||||
case eApps of
|
||||
Right as -> defaultMain app (selectLatest as) $> ()
|
||||
Left e -> do
|
||||
|
|
@ -317,8 +338,8 @@ brickMain s muri l = do
|
|||
$ (listElements lr)
|
||||
|
||||
|
||||
getAppState :: IO (Either String AppState)
|
||||
getAppState = do
|
||||
getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState)
|
||||
getAppState mg pfreq' = do
|
||||
muri <- readIORef uri'
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
|
|
@ -328,13 +349,12 @@ getAppState = do
|
|||
runLogger
|
||||
. flip runReaderT settings
|
||||
. runE
|
||||
@'[JSONError, DownloadFailed, FileDoesNotExistError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||
@'[JSONError, DownloadFailed, FileDoesNotExistError]
|
||||
$ do
|
||||
(GHCupInfo _ dls) <- liftE
|
||||
$ getDownloadsF (maybe GHCupURL OwnSource muri)
|
||||
dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg
|
||||
|
||||
lV <- liftE $ listVersions dls Nothing Nothing
|
||||
pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -28,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 )
|
||||
|
|
@ -806,6 +808,7 @@ toSettings Options {..} =
|
|||
noVerify = optNoVerify
|
||||
keepDirs = optKeepDirs
|
||||
downloader = optsDownloader
|
||||
verbose = optVerbose
|
||||
in Settings { .. }
|
||||
|
||||
|
||||
|
|
@ -909,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
|
||||
|
|
@ -941,7 +943,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
, TagNotFound
|
||||
]
|
||||
|
||||
let runListGHC = runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||
let runListGHC = runLogger
|
||||
|
||||
let runRm =
|
||||
runLogger . flip runReaderT settings . runE @'[NotInstalled]
|
||||
|
|
@ -960,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 =
|
||||
|
|
@ -981,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 =
|
||||
|
|
@ -998,9 +998,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
. runResourceT
|
||||
. runE
|
||||
@'[ DigestError
|
||||
, DistroNotFound
|
||||
, NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, NoDownload
|
||||
, NoUpdate
|
||||
, FileDoesNotExistError
|
||||
|
|
@ -1009,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
|
||||
|
|
@ -1026,14 +1033,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
runLogger
|
||||
($(logError) [i|Error fetching download info: #{e}|])
|
||||
exitWith (ExitFailure 2)
|
||||
(runLogger
|
||||
. runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ checkForUpdates dls
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) [i|Error checking for upgrades: #{e}|])
|
||||
runLogger $ checkForUpdates dls pfreq
|
||||
|
||||
|
||||
|
||||
-----------------------
|
||||
|
|
@ -1043,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
|
||||
|
|
@ -1077,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
|
||||
|
|
@ -1150,7 +1151,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
|
||||
res <- case optCommand of
|
||||
#if defined(BRICK)
|
||||
Interactive -> liftIO $ brickMain settings optUrlSource loggerConfig >> pure ExitSuccess
|
||||
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.|])
|
||||
|
|
@ -1169,16 +1170,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
|
||||
List (ListOptions {..}) ->
|
||||
(runListGHC $ do
|
||||
l <- listVersions dls lTool lCriteria
|
||||
pure l
|
||||
l <- listVersions dls lTool lCriteria pfreq
|
||||
liftIO $ printListResult lRawFormat l
|
||||
pure ExitSuccess
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> do
|
||||
liftIO $ printListResult lRawFormat r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 6
|
||||
|
||||
Rm (Right rmopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|])
|
||||
|
|
@ -1205,6 +1200,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
buildConfig
|
||||
patchDir
|
||||
addConfArgs
|
||||
pfreq
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
|
|
@ -1229,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
|
||||
|
|
@ -1260,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)
|
||||
|
|
@ -1406,37 +1402,32 @@ printListResult raw lr = do
|
|||
|
||||
checkForUpdates :: (MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
|
||||
=> GHCupDownloads
|
||||
-> Excepts
|
||||
'[ NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, DistroNotFound
|
||||
]
|
||||
m
|
||||
()
|
||||
checkForUpdates dls = do
|
||||
-> PlatformRequest
|
||||
-> m ()
|
||||
checkForUpdates dls pfreq = do
|
||||
forM_ (getLatest dls GHCup) $ \l -> do
|
||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
when (l > ghc_ver)
|
||||
$ lift $ $(logWarn)
|
||||
$ $(logWarn)
|
||||
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
|
||||
|
||||
forM_ (getLatest dls GHC) $ \l -> do
|
||||
mghc_ver <- latestInstalled GHC
|
||||
forM mghc_ver $ \ghc_ver ->
|
||||
when (l > ghc_ver)
|
||||
$ lift $ $(logWarn)
|
||||
$ $(logWarn)
|
||||
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
|
||||
|
||||
forM_ (getLatest dls Cabal) $ \l -> do
|
||||
mcabal_ver <- latestInstalled Cabal
|
||||
forM mcabal_ver $ \cabal_ver ->
|
||||
when (l > cabal_ver)
|
||||
$ lift $ $(logWarn)
|
||||
$ $(logWarn)
|
||||
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
|
||||
|
||||
where
|
||||
latestInstalled tool = (fmap lVer . lastMay)
|
||||
<$> (listVersions dls (Just tool) (Just ListInstalled))
|
||||
<$> (listVersions dls (Just tool) (Just ListInstalled) pfreq)
|
||||
|
||||
|
||||
prettyDebugInfo :: DebugInfo -> String
|
||||
|
|
|
|||
|
|
@ -698,6 +698,13 @@
|
|||
"dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-alpine3.10-linux-integer-simple.tar.xz"
|
||||
}
|
||||
},
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "52d27dbf9de82005dde9bfc521bff612e381b5228af194259c2306d2b75825c2",
|
||||
"dlSubdir": "ghc-8.10.1",
|
||||
"dlUri": "https://downloads.haskell.org/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "d1cf7886f27af070f3b7dbe1975a78b43ef2d32b86362cbe953e79464fe70761",
|
||||
|
|
@ -849,6 +856,13 @@
|
|||
"dlUri": "https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.6.5-musl/ghc-8.6.5-x86_64-unknown-linux-musl.tar.xz"
|
||||
}
|
||||
},
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "83a3059a630d40a98e26cb5b520354e12094a96e36ba2f5ab002dad94cf2fb37",
|
||||
"dlSubdir": "ghc-8.6.5",
|
||||
"dlUri": "https://files.hasufell.de/ghc/ghc-8.6.5-x86_64-portbld-freebsd.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "bc75f5601a9f41d58b2ba161b9e28fad52143a7229060f1e084168d9b2e914df",
|
||||
|
|
@ -2002,6 +2016,13 @@
|
|||
"dlUri": "https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.3-musl/ghc-8.8.3-x86_64-unknown-linux-musl.tar.xz"
|
||||
}
|
||||
},
|
||||
"FreeBSD": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "569719075b4d14b3875a899df522090ae31e6fe085e6dffe518e875b09a2f0be",
|
||||
"dlSubdir": "ghc-8.8.3",
|
||||
"dlUri": "https://files.hasufell.de/ghc/ghc-8.8.3-x86_64-portbld-freebsd.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "42fde2ef5a143e1e6b47ae8875162ea2d4d54b06f0f7fa32ee4f0eb86f2be7ad",
|
||||
|
|
|
|||
26
ghcup.cabal
26
ghcup.cabal
|
|
@ -31,6 +31,11 @@ flag internal-downloader
|
|||
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
|
||||
|
||||
|
|
@ -169,6 +174,9 @@ common table-layout
|
|||
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
|
||||
|
||||
|
|
@ -253,7 +261,6 @@ library
|
|||
, hpath-filepath
|
||||
, hpath-io
|
||||
, hpath-posix
|
||||
, libarchive
|
||||
, lzma
|
||||
, megaparsec
|
||||
, monad-logger
|
||||
|
|
@ -315,13 +322,21 @@ library
|
|||
|
||||
if flag(internal-downloader)
|
||||
import:
|
||||
, HsOpenSSL
|
||||
HsOpenSSL
|
||||
, http-io-streams
|
||||
, io-streams
|
||||
, terminal-progress-bar
|
||||
exposed-modules: GHCup.Download.IOStreams
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if flag(tar)
|
||||
import:
|
||||
tar-bytestring
|
||||
cpp-options: -DTAR
|
||||
else
|
||||
import:
|
||||
libarchive
|
||||
|
||||
executable ghcup
|
||||
import:
|
||||
config
|
||||
|
|
@ -331,7 +346,6 @@ executable ghcup
|
|||
, haskus-utils-variant
|
||||
, hpath
|
||||
, hpath-io
|
||||
, libarchive
|
||||
, megaparsec
|
||||
, monad-logger
|
||||
, mtl
|
||||
|
|
@ -368,6 +382,12 @@ executable ghcup
|
|||
other-modules: BrickMain
|
||||
cpp-options: -DBRICK
|
||||
|
||||
if flag(tar)
|
||||
cpp-options: -DTAR
|
||||
else
|
||||
import:
|
||||
libarchive
|
||||
|
||||
executable ghcup-gen
|
||||
import:
|
||||
config
|
||||
|
|
|
|||
94
lib/GHCup.hs
94
lib/GHCup.hs
|
|
@ -27,7 +27,9 @@ import GHCup.Utils.String.QQ
|
|||
import GHCup.Utils.Version.QQ
|
||||
import GHCup.Version
|
||||
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive ( ArchiveResult )
|
||||
#endif
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
|
|
@ -85,28 +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)
|
||||
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
|
||||
|
||||
-- download (or use cached version)
|
||||
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
|
||||
|
|
@ -129,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 ()
|
||||
|
||||
|
||||
|
|
@ -155,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
|
||||
|
|
@ -185,8 +184,6 @@ installCabalBin bDls ver mpfReq = do
|
|||
)
|
||||
$ (throwE $ AlreadyInstalled Cabal ver)
|
||||
|
||||
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
|
||||
|
||||
-- download (or use cached version)
|
||||
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
|
|
@ -380,31 +377,25 @@ listVersions :: ( MonadCatch m
|
|||
=> GHCupDownloads
|
||||
-> Maybe Tool
|
||||
-> Maybe ListCriteria
|
||||
-> Excepts
|
||||
'[ NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, DistroNotFound
|
||||
]
|
||||
m
|
||||
[ListResult]
|
||||
listVersions av lt criteria = do
|
||||
pfreq <- platformRequest
|
||||
-> PlatformRequest
|
||||
-> m [ListResult]
|
||||
listVersions av lt criteria pfreq = do
|
||||
case lt of
|
||||
Just t -> do
|
||||
-- get versions from GHCupDownloads
|
||||
let avTools = availableToolVersions av t
|
||||
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult pfreq t)
|
||||
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult t)
|
||||
|
||||
case t of
|
||||
-- append stray GHCs
|
||||
GHC -> do
|
||||
slr <- lift $ strayGHCs avTools
|
||||
slr <- strayGHCs avTools
|
||||
pure $ (sort (slr ++ lr))
|
||||
_ -> pure lr
|
||||
Nothing -> do
|
||||
ghcvers <- listVersions av (Just GHC) criteria
|
||||
cabalvers <- listVersions av (Just Cabal) criteria
|
||||
ghcupvers <- listVersions av (Just GHCup) criteria
|
||||
ghcvers <- listVersions av (Just GHC) criteria pfreq
|
||||
cabalvers <- listVersions av (Just Cabal) criteria pfreq
|
||||
ghcupvers <- listVersions av (Just GHCup) criteria pfreq
|
||||
pure (ghcvers <> cabalvers <> ghcupvers)
|
||||
|
||||
where
|
||||
|
|
@ -449,8 +440,8 @@ listVersions av lt criteria = do
|
|||
pure Nothing
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: PlatformRequest -> Tool -> (Version, [Tag]) -> IO ListResult
|
||||
toListResult pfreq t (v, tags) = case t of
|
||||
toListResult :: Tool -> (Version, [Tag]) -> IO ListResult
|
||||
toListResult t (v, tags) = case t of
|
||||
GHC -> do
|
||||
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
|
||||
let tver = mkTVer v
|
||||
|
|
@ -600,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))
|
||||
|
|
@ -631,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
|
||||
|
|
@ -664,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
|
||||
|
|
@ -692,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]
|
||||
|
|
@ -706,7 +696,7 @@ Stage1Only = YES|]
|
|||
(Just workdir)
|
||||
(Just (("GHC", toFilePath bghcPath) : cEnv))
|
||||
| otherwise -> do
|
||||
lEM $ liftIO $ execLogged
|
||||
lEM $ execLogged
|
||||
"./configure"
|
||||
False
|
||||
( [ "--prefix=" <> toFilePath ghcdir
|
||||
|
|
@ -731,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)
|
||||
|
|
@ -779,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
|
||||
|
|
@ -817,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
|
||||
|
|
@ -838,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
|
||||
|
|
@ -871,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|]
|
||||
|
|
@ -899,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|]
|
||||
|
|
|
|||
|
|
@ -2,7 +2,10 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
|
||||
module GHCup.Data.GHCupDownloads where
|
||||
module GHCup.Data.GHCupDownloads
|
||||
( ghcupDownloads
|
||||
)
|
||||
where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Version.QQ
|
||||
|
|
@ -661,6 +664,12 @@ ghc_865_32_musl = DownloadInfo
|
|||
(Just [rel|ghc-8.6.5|])
|
||||
"db13ff894faf431f9c64db21c090a1e4e42803794d56720a704c50166c7ca05d"
|
||||
|
||||
ghc_865_64_freebsd :: DownloadInfo
|
||||
ghc_865_64_freebsd = DownloadInfo
|
||||
[uri|https://files.hasufell.de/ghc/ghc-8.6.5-x86_64-portbld-freebsd.tar.xz|]
|
||||
(Just [rel|ghc-8.6.5|])
|
||||
"83a3059a630d40a98e26cb5b520354e12094a96e36ba2f5ab002dad94cf2fb37"
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
|
|
@ -829,6 +838,11 @@ ghc_883_32_musl = DownloadInfo
|
|||
(Just [rel|ghc-8.8.3|])
|
||||
"7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4"
|
||||
|
||||
ghc_883_64_freebsd :: DownloadInfo
|
||||
ghc_883_64_freebsd = DownloadInfo
|
||||
[uri|https://files.hasufell.de/ghc/ghc-8.8.3-x86_64-portbld-freebsd.tar.xz|]
|
||||
(Just [rel|ghc-8.8.3|])
|
||||
"569719075b4d14b3875a899df522090ae31e6fe085e6dffe518e875b09a2f0be"
|
||||
|
||||
|
||||
|
||||
|
|
@ -887,6 +901,11 @@ ghc_8101_64_alpine = DownloadInfo
|
|||
"cb13b645d103e2fba2eb8dfcc4e5f2fbd9550c00c4df42f342b4210436dcb8a8"
|
||||
|
||||
|
||||
ghc_8101_64_freebsd :: DownloadInfo
|
||||
ghc_8101_64_freebsd = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz|]
|
||||
(Just [rel|ghc-8.10.1|])
|
||||
"52d27dbf9de82005dde9bfc521bff612e381b5228af194259c2306d2b75825c2"
|
||||
|
||||
|
||||
|
||||
|
|
@ -1634,6 +1653,7 @@ ghcupDownloads = M.fromList
|
|||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghc_865_64_darwin)])
|
||||
, (Linux Alpine, M.fromList [(Nothing, ghc_865_64_musl)])
|
||||
, (FreeBSD, M.fromList [(Nothing, ghc_865_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
|
|
@ -1796,6 +1816,7 @@ ghcupDownloads = M.fromList
|
|||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghc_883_64_darwin)])
|
||||
, (Linux Alpine, M.fromList [(Nothing, ghc_883_64_musl)])
|
||||
, (FreeBSD , M.fromList [(Nothing, ghc_883_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
|
|
@ -1840,7 +1861,7 @@ ghcupDownloads = M.fromList
|
|||
, (Just [vers|7|], ghc_8101_64_centos)
|
||||
]
|
||||
)
|
||||
, ( Linux RedHat, M.fromList [(Nothing, ghc_8101_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_8101_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_8101_64_centos)]
|
||||
)
|
||||
|
|
@ -1861,6 +1882,7 @@ ghcupDownloads = M.fromList
|
|||
)
|
||||
, (Darwin , M.fromList [(Nothing, ghc_8101_64_darwin)])
|
||||
, (Linux Alpine, M.fromList [(Nothing, ghc_8101_64_alpine)])
|
||||
, (FreeBSD , M.fromList [(Nothing, ghc_8101_64_freebsd)])
|
||||
]
|
||||
)
|
||||
, ( A_32
|
||||
|
|
|
|||
|
|
@ -152,6 +152,7 @@ data Settings = Settings
|
|||
, noVerify :: Bool
|
||||
, keepDirs :: KeepDirs
|
||||
, downloader :: Downloader
|
||||
, verbose :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
|
|
|
|||
|
|
@ -24,7 +24,9 @@ import GHCup.Utils.MegaParsec
|
|||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive
|
||||
#endif
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
|
|
@ -59,13 +61,18 @@ import System.Posix.Files.ByteString ( readSymbolicLink )
|
|||
import Text.Regex.Posix
|
||||
import URI.ByteString
|
||||
|
||||
#if defined(TAR)
|
||||
import qualified Codec.Archive.Tar as Tar
|
||||
#endif
|
||||
import qualified Codec.Compression.BZip as BZip
|
||||
import qualified Codec.Compression.GZip as GZip
|
||||
import qualified Codec.Compression.Lzma as Lzma
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
#if !defined(TAR)
|
||||
import qualified Data.Text as T
|
||||
#endif
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
|
@ -312,17 +319,30 @@ getLatestGHCFor major' minor' dls = do
|
|||
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
=> Path Abs -- ^ destination dir
|
||||
-> Path Abs -- ^ archive path
|
||||
-> Excepts '[UnknownArchive, ArchiveResult] m ()
|
||||
-> Excepts '[UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
] m ()
|
||||
unpackToDir dest av = do
|
||||
fp <- (decUTF8Safe . toFilePath) <$> basename av
|
||||
let dfp = decUTF8Safe . toFilePath $ dest
|
||||
lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
|
||||
fn <- toFilePath <$> basename av
|
||||
|
||||
#if defined(TAR)
|
||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
|
||||
untar = liftIO . Tar.unpack (toFilePath dest) . Tar.read
|
||||
#else
|
||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
|
||||
untar = lEM . liftIO . runArchiveM . unpackToDirLazy (T.unpack . decUTF8Safe . toFilePath $ dest)
|
||||
#endif
|
||||
|
||||
#if defined(TAR)
|
||||
rf :: MonadIO m => Path Abs -> Excepts '[] m BL.ByteString
|
||||
#else
|
||||
rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
|
||||
#endif
|
||||
rf = liftIO . readFile
|
||||
|
||||
-- extract, depending on file extension
|
||||
|
|
@ -453,10 +473,13 @@ ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
|
|||
|
||||
|
||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||
make :: [ByteString] -> Maybe (Path Abs) -> IO (Either ProcessError ())
|
||||
make :: (MonadThrow m, MonadIO m, MonadReader Settings m)
|
||||
=> [ByteString]
|
||||
-> Maybe (Path Abs)
|
||||
-> m (Either ProcessError ())
|
||||
make args workdir = do
|
||||
spaths <- catMaybes . fmap parseAbs <$> getSearchPath
|
||||
has_gmake <- isJust <$> searchPath spaths [rel|gmake|]
|
||||
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
|
||||
has_gmake <- isJust <$> (liftIO $ searchPath spaths [rel|gmake|])
|
||||
let mymake = if has_gmake then "gmake" else "make"
|
||||
execLogged mymake True args [rel|ghc-make|] workdir Nothing
|
||||
|
||||
|
|
|
|||
|
|
@ -1,16 +1,19 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module GHCup.Utils.File where
|
||||
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Exception ( evaluate )
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Foldable
|
||||
import Data.Functor
|
||||
|
|
@ -101,19 +104,21 @@ executeOut path args chdir = captureOutStreams $ do
|
|||
SPPB.executeFile (toFilePath path) True args Nothing
|
||||
|
||||
|
||||
execLogged :: ByteString -- ^ thing to execute
|
||||
execLogged :: (MonadReader Settings m, MonadIO m, MonadThrow m)
|
||||
=> ByteString -- ^ thing to execute
|
||||
-> Bool -- ^ whether to search PATH for the thing
|
||||
-> [ByteString] -- ^ args for the thing
|
||||
-> Path Rel -- ^ log filename
|
||||
-> Maybe (Path Abs) -- ^ optionally chdir into this
|
||||
-> Maybe [(ByteString, ByteString)] -- ^ optional environment
|
||||
-> IO (Either ProcessError ())
|
||||
-> m (Either ProcessError ())
|
||||
execLogged exe spath args lfile chdir env = do
|
||||
ldir <- ghcupLogsDir
|
||||
Settings{..} <- ask
|
||||
ldir <- liftIO ghcupLogsDir
|
||||
logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
|
||||
bracket (createFile (toFilePath logfile) newFilePerms) closeFd action
|
||||
liftIO $ bracket (createFile (toFilePath logfile) newFilePerms) closeFd (action verbose)
|
||||
where
|
||||
action fd = do
|
||||
action verbose fd = do
|
||||
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
|
||||
-- start the thread that logs to stdout in a region
|
||||
done <- newEmptyMVar
|
||||
|
|
@ -122,7 +127,7 @@ execLogged exe spath args lfile chdir env = do
|
|||
$ EX.handle (\(_ :: StopThread) -> pure ())
|
||||
$ EX.handle (\(_ :: IOException) -> pure ())
|
||||
$ flip finally (putMVar done ())
|
||||
$ printToRegion fd stdoutRead 6
|
||||
$ (if verbose then tee fd stdoutRead else printToRegion fd stdoutRead 6)
|
||||
|
||||
-- fork our subprocess
|
||||
pid <- SPPB.forkProcess $ do
|
||||
|
|
@ -151,6 +156,17 @@ execLogged exe spath args lfile chdir env = do
|
|||
closeFd stdoutRead
|
||||
pure e
|
||||
|
||||
tee fileFd fdIn = do
|
||||
flip finally (readTilEOF lineAction fdIn) -- make sure the last few lines don't get cut off
|
||||
$ do
|
||||
hideError eofErrorType $ readTilEOF lineAction fdIn
|
||||
forever (threadDelay 5000)
|
||||
|
||||
where
|
||||
lineAction bs' = do
|
||||
void $ SPIB.fdWrite fileFd (bs' <> "\n")
|
||||
void $ SPIB.fdWrite stdOutput (bs' <> "\n")
|
||||
|
||||
-- Reads fdIn and logs the output in a continous scrolling area
|
||||
-- of 'size' terminal lines. Also writes to a log file.
|
||||
printToRegion fileFd fdIn size = do
|
||||
|
|
@ -170,6 +186,7 @@ execLogged exe spath args lfile chdir env = do
|
|||
|
||||
where
|
||||
-- action to perform line by line
|
||||
-- TODO: do this with vty for efficiency
|
||||
lineAction ref rs bs' = do
|
||||
modifyIORef' ref (swapRegs bs')
|
||||
regs <- readIORef ref
|
||||
|
|
@ -193,18 +210,18 @@ execLogged exe spath args lfile chdir env = do
|
|||
trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
|
||||
| otherwise = bs
|
||||
|
||||
-- read an entire line from the file descriptor (removes the newline char)
|
||||
readLine fd' = do
|
||||
bs <- SPIB.fdRead fd' 1
|
||||
if
|
||||
| bs == "\n" -> pure ""
|
||||
| bs == "" -> pure ""
|
||||
| otherwise -> fmap (bs <>) $ readLine fd'
|
||||
-- read an entire line from the file descriptor (removes the newline char)
|
||||
readLine fd' = do
|
||||
bs <- SPIB.fdRead fd' 1
|
||||
if
|
||||
| bs == "\n" -> pure ""
|
||||
| bs == "" -> pure ""
|
||||
| otherwise -> fmap (bs <>) $ readLine fd'
|
||||
|
||||
readTilEOF action' fd' = do
|
||||
bs <- readLine fd'
|
||||
void $ action' bs
|
||||
readTilEOF action' fd'
|
||||
readTilEOF action' fd' = do
|
||||
bs <- readLine fd'
|
||||
void $ action' bs
|
||||
readTilEOF action' fd'
|
||||
|
||||
|
||||
-- | Capture the stdout and stderr of the given action, which
|
||||
|
|
|
|||
Loading…
Reference in New Issue