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

Merge branch 'ghc-8.10.1'

Browse Source
This commit is contained in:
Julian Ospald 2020-07-13 20:06:17 +02:00
commit 3c80929c38
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
13 changed files with 254 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitlab/before_script/freebsd/install_deps.sh
View File

@ -11,15 +11,8 @@ mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
chmod +x 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 exit 0

2
.gitlab/script/ghcup_release.sh
View File

@ -17,7 +17,7 @@ ecabal update
if [ "${OS}" = "LINUX" ] ; then if [ "${OS}" = "LINUX" ] ; then
if [ "${BIT}" = "32" ] ; 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 else
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
fi fi

2
.travis/build.sh
View File

@ -18,7 +18,7 @@ ghcup set 8.8.3
## install ghcup ## install ghcup
cabal update 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')" . cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
strip -s ghcup strip -s ghcup
cp ghcup "./${ARTIFACT}" cp ghcup "./${ARTIFACT}"

2
app/ghcup-gen/Validate.hs
View File

@ -179,7 +179,7 @@ validateTarballs dls = do
where where
downloadAll dli = do downloadAll dli = do
let settings = Settings True False Never Curl let settings = Settings True False Never Curl False
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr , colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ()) , rawOutter = (\_ -> pure ())

54
app/ghcup/BrickMain.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
@ -19,7 +20,9 @@ import Brick.Widgets.Border
import Brick.Widgets.Border.Style import Brick.Widgets.Border.Style
import Brick.Widgets.Center import Brick.Widgets.Center
import Brick.Widgets.List import Brick.Widgets.List
#if !defined(TAR)
import Codec.Archive import Codec.Archive
#endif
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad.Logger import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
@ -47,6 +50,7 @@ import qualified Data.Vector as V
data AppState = AppState { data AppState = AppState {
lr :: LR lr :: LR
, dls :: GHCupDownloads , dls :: GHCupDownloads
, pfreq :: PlatformRequest
} }
type LR = GenericList String Vector ListResult 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.KChar 'q') _)) = halt st
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) = 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) _)) = 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) _)) = eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
case find (\(c', _, _) -> c' == c) keyHandlers of case find (\(c', _, _) -> c' == c) keyHandlers of
Nothing -> continue as Nothing -> continue as
@ -175,7 +179,7 @@ withIOAction action as = case listSelectedElement (lr as) of
Right _ -> do Right _ -> do
apps <- (fmap . fmap) apps <- (fmap . fmap)
(\AppState {..} -> AppState { lr = listMoveTo ix lr, .. }) (\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
getAppState $ getAppState Nothing (pfreq as)
case apps of case apps of
Right nas -> do Right nas -> do
putStrLn "Press enter to continue" putStrLn "Press enter to continue"
@ -196,13 +200,29 @@ install' AppState {..} (_, ListResult {..}) = do
. flip runReaderT settings . flip runReaderT settings
. runResourceT . runResourceT
. runE . 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 (run $ do
case lTool of case lTool of
GHC -> liftE $ installGHCBin dls lVer Nothing GHC -> liftE $ installGHCBin dls lVer pfreq
Cabal -> liftE $ installCabalBin dls lVer Nothing Cabal -> liftE $ installCabalBin dls lVer pfreq
GHCup -> liftE $ upgradeGHCup dls Nothing False $> () GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
) )
>>= \case >>= \case
VRight _ -> pure $ Right () VRight _ -> pure $ Right ()
@ -280,6 +300,7 @@ settings' = unsafePerformIO
, noVerify = False , noVerify = False
, keepDirs = Never , keepDirs = Never
, downloader = Curl , downloader = Curl
, verbose = False
} }
) )
@ -294,15 +315,15 @@ logger' = unsafePerformIO
) )
brickMain :: Settings -> Maybe URI -> LoggerConfig -> IO () brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO ()
brickMain s muri l = do brickMain s muri l av pfreq' = do
writeIORef uri' muri writeIORef uri' muri
writeIORef settings' s writeIORef settings' s
-- logger interpreter -- logger interpreter
writeIORef logger' l writeIORef logger' l
let runLogger = myLoggerT l let runLogger = myLoggerT l
eApps <- getAppState eApps <- getAppState (Just av) pfreq'
case eApps of case eApps of
Right as -> defaultMain app (selectLatest as) $> () Right as -> defaultMain app (selectLatest as) $> ()
Left e -> do Left e -> do
@ -317,8 +338,8 @@ brickMain s muri l = do
$ (listElements lr) $ (listElements lr)
getAppState :: IO (Either String AppState) getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState)
getAppState = do getAppState mg pfreq' = do
muri <- readIORef uri' muri <- readIORef uri'
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
@ -328,13 +349,12 @@ getAppState = do
runLogger runLogger
. flip runReaderT settings . flip runReaderT settings
. runE . runE
@'[JSONError, DownloadFailed, FileDoesNotExistError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] @'[JSONError, DownloadFailed, FileDoesNotExistError]
$ do $ do
(GHCupInfo _ dls) <- liftE dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg
$ getDownloadsF (maybe GHCupURL OwnSource muri)
lV <- liftE $ listVersions dls Nothing Nothing lV <- lift $ listVersions dls Nothing Nothing pfreq'
pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls) pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls pfreq')
case r of case r of
VRight a -> pure $ Right a VRight a -> pure $ Right a

91
app/ghcup/Main.hs
View File

@ -28,7 +28,9 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import GHCup.Version import GHCup.Version
#if !defined(TAR)
import Codec.Archive import Codec.Archive
#endif
import Control.Exception.Safe import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@ -806,6 +808,7 @@ toSettings Options {..} =
noVerify = optNoVerify noVerify = optNoVerify
keepDirs = optKeepDirs keepDirs = optKeepDirs
downloader = optsDownloader downloader = optsDownloader
verbose = optVerbose
in Settings { .. } in Settings { .. }
@ -909,14 +912,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
. runE . runE
@'[ AlreadyInstalled @'[ AlreadyInstalled
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
, DistroNotFound #endif
, FileDoesNotExistError , FileDoesNotExistError
, CopyError , CopyError
, NoCompatibleArch
, NoDownload , NoDownload
, NotInstalled , NotInstalled
, NoCompatiblePlatform
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, DigestError , DigestError
@ -941,7 +943,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TagNotFound , TagNotFound
] ]
let runListGHC = runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] let runListGHC = runLogger
let runRm = let runRm =
runLogger . flip runReaderT settings . runE @'[NotInstalled] runLogger . flip runReaderT settings . runE @'[NotInstalled]
@ -960,16 +962,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
@'[ AlreadyInstalled @'[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NotFoundInPATH , NotFoundInPATH
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif
] ]
let runCompileCabal = let runCompileCabal =
@ -981,15 +982,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, BuildFailed , BuildFailed
, CopyError , CopyError
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NotInstalled , NotInstalled
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif
] ]
let runUpgrade = let runUpgrade =
@ -998,9 +998,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
. runResourceT . runResourceT
. runE . runE
@'[ DigestError @'[ DigestError
, DistroNotFound
, NoCompatiblePlatform
, NoCompatibleArch
, NoDownload , NoDownload
, NoUpdate , NoUpdate
, FileDoesNotExistError , 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) <- (GHCupInfo treq dls) <-
( runLogger ( runLogger
@ -1026,14 +1033,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger runLogger
($(logError) [i|Error fetching download info: #{e}|]) ($(logError) [i|Error fetching download info: #{e}|])
exitWith (ExitFailure 2) 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}|])
----------------------- -----------------------
@ -1043,7 +1044,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installGHC InstallOptions{..} = let installGHC InstallOptions{..} =
(runInstTool $ do (runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC 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 >>= \case
VRight _ -> do VRight _ -> do
@ -1077,7 +1078,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installCabal InstallOptions{..} = let installCabal InstallOptions{..} =
(runInstTool $ do (runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal 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 >>= \case
VRight _ -> do VRight _ -> do
@ -1150,7 +1151,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
res <- case optCommand of res <- case optCommand of
#if defined(BRICK) #if defined(BRICK)
Interactive -> liftIO $ brickMain settings optUrlSource loggerConfig >> pure ExitSuccess Interactive -> liftIO $ brickMain settings optUrlSource loggerConfig dls pfreq >> pure ExitSuccess
#endif #endif
Install (Right iopts) -> do Install (Right iopts) -> do
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|]) 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 {..}) -> List (ListOptions {..}) ->
(runListGHC $ do (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 Rm (Right rmopts) -> do
runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|]) 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 buildConfig
patchDir patchDir
addConfArgs addConfArgs
pfreq
) )
>>= \case >>= \case
VRight _ -> do VRight _ -> do
@ -1229,7 +1225,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
Compile (CompileCabal CabalCompileOptions {..}) -> Compile (CompileCabal CabalCompileOptions {..}) ->
(runCompileCabal $ do (runCompileCabal $ do
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir pfreq
) )
>>= \case >>= \case
VRight _ -> do VRight _ -> do
@ -1260,7 +1256,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
bdir <- liftIO $ ghcupBinDir bdir <- liftIO $ ghcupBinDir
pure (Just (bdir </> [rel|ghcup|])) pure (Just (bdir </> [rel|ghcup|]))
(runUpgrade $ (liftE $ upgradeGHCup dls target force)) >>= \case (runUpgrade $ (liftE $ upgradeGHCup dls target force pfreq)) >>= \case
VRight v' -> do VRight v' -> do
let pretty_v = prettyVer v' let pretty_v = prettyVer v'
runLogger $ $(logInfo) runLogger $ $(logInfo)
@ -1406,37 +1402,32 @@ printListResult raw lr = do
checkForUpdates :: (MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m) checkForUpdates :: (MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
=> GHCupDownloads => GHCupDownloads
-> Excepts -> PlatformRequest
'[ NoCompatiblePlatform -> m ()
, NoCompatibleArch checkForUpdates dls pfreq = do
, DistroNotFound
]
m
()
checkForUpdates dls = do
forM_ (getLatest dls GHCup) $ \l -> do forM_ (getLatest dls GHCup) $ \l -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver) when (l > ghc_ver)
$ lift $ $(logWarn) $ $(logWarn)
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|] [i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
forM_ (getLatest dls GHC) $ \l -> do forM_ (getLatest dls GHC) $ \l -> do
mghc_ver <- latestInstalled GHC mghc_ver <- latestInstalled GHC
forM mghc_ver $ \ghc_ver -> forM mghc_ver $ \ghc_ver ->
when (l > ghc_ver) when (l > ghc_ver)
$ lift $ $(logWarn) $ $(logWarn)
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|] [i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
forM_ (getLatest dls Cabal) $ \l -> do forM_ (getLatest dls Cabal) $ \l -> do
mcabal_ver <- latestInstalled Cabal mcabal_ver <- latestInstalled Cabal
forM mcabal_ver $ \cabal_ver -> forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver) when (l > cabal_ver)
$ lift $ $(logWarn) $ $(logWarn)
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|] [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
where where
latestInstalled tool = (fmap lVer . lastMay) latestInstalled tool = (fmap lVer . lastMay)
<$> (listVersions dls (Just tool) (Just ListInstalled)) <$> (listVersions dls (Just tool) (Just ListInstalled) pfreq)
prettyDebugInfo :: DebugInfo -> String prettyDebugInfo :: DebugInfo -> String

21
ghcup-0.0.2.json
View File

@ -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" "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": { "Linux_Debian": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "d1cf7886f27af070f3b7dbe1975a78b43ef2d32b86362cbe953e79464fe70761", "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" "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": { "Linux_Debian": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "bc75f5601a9f41d58b2ba161b9e28fad52143a7229060f1e084168d9b2e914df", "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" "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": { "Linux_Debian": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "42fde2ef5a143e1e6b47ae8875162ea2d4d54b06f0f7fa32ee4f0eb86f2be7ad", "dlHash": "42fde2ef5a143e1e6b47ae8875162ea2d4d54b06f0f7fa32ee4f0eb86f2be7ad",

26
ghcup.cabal
View File

@ -31,6 +31,11 @@ flag internal-downloader
default: False default: False
manual: True manual: True
flag tar
description: Use tar-bytestring instead of libarchive
default: False
manual: True
common HsOpenSSL common HsOpenSSL
build-depends: HsOpenSSL >=0.11.4.18 build-depends: HsOpenSSL >=0.11.4.18
@ -169,6 +174,9 @@ common table-layout
common template-haskell common template-haskell
build-depends: template-haskell >=2.7 build-depends: template-haskell >=2.7
common tar-bytestring
build-depends: tar-bytestring >=0.6.3.1
common terminal-progress-bar common terminal-progress-bar
build-depends: terminal-progress-bar >=0.4.1 build-depends: terminal-progress-bar >=0.4.1
@ -253,7 +261,6 @@ library
, hpath-filepath , hpath-filepath
, hpath-io , hpath-io
, hpath-posix , hpath-posix
, libarchive
, lzma , lzma
, megaparsec , megaparsec
, monad-logger , monad-logger
@ -315,13 +322,21 @@ library
if flag(internal-downloader) if flag(internal-downloader)
import: import:
, HsOpenSSL HsOpenSSL
, http-io-streams , http-io-streams
, io-streams , io-streams
, terminal-progress-bar , terminal-progress-bar
exposed-modules: GHCup.Download.IOStreams exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
if flag(tar)
import:
tar-bytestring
cpp-options: -DTAR
else
import:
libarchive
executable ghcup executable ghcup
import: import:
config config
@ -331,7 +346,6 @@ executable ghcup
, haskus-utils-variant , haskus-utils-variant
, hpath , hpath
, hpath-io , hpath-io
, libarchive
, megaparsec , megaparsec
, monad-logger , monad-logger
, mtl , mtl
@ -368,6 +382,12 @@ executable ghcup
other-modules: BrickMain other-modules: BrickMain
cpp-options: -DBRICK cpp-options: -DBRICK
if flag(tar)
cpp-options: -DTAR
else
import:
libarchive
executable ghcup-gen executable ghcup-gen
import: import:
config config

94
lib/GHCup.hs
View File

@ -27,7 +27,9 @@ import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
import GHCup.Version import GHCup.Version
#if !defined(TAR)
import Codec.Archive ( ArchiveResult ) import Codec.Archive ( ArchiveResult )
#endif
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
@ -85,28 +87,26 @@ installGHCBin :: ( MonadFail m
) )
=> GHCupDownloads => GHCupDownloads
-> Version -> Version
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform -> PlatformRequest
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NotInstalled , NotInstalled
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif
] ]
m m
() ()
installGHCBin bDls ver mpfReq = do installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
let tver = (mkTVer ver) let tver = (mkTVer ver)
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
whenM (liftIO $ ghcInstalled tver) whenM (liftIO $ ghcInstalled tver)
$ (throwE $ AlreadyInstalled GHC ver) $ (throwE $ AlreadyInstalled GHC ver)
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version) -- download (or use cached version)
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
@ -129,19 +129,19 @@ installGHCBin bDls ver mpfReq = do
where where
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else. -- | 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 the unpacked GHC bindist (where the configure script resides)
-> Path Abs -- ^ Path to install to -> Path Abs -- ^ Path to install to
-> Excepts '[ProcessError] m () -> Excepts '[ProcessError] m ()
installGHC' path inst = do installGHC' path inst = do
lift $ $(logInfo) "Installing GHC (this may take a while)" lift $ $(logInfo) "Installing GHC (this may take a while)"
lEM $ liftIO $ execLogged "./configure" lEM $ execLogged "./configure"
False False
["--prefix=" <> toFilePath inst] ["--prefix=" <> toFilePath inst]
[rel|ghc-configure|] [rel|ghc-configure|]
(Just path) (Just path)
Nothing Nothing
lEM $ liftIO $ make ["install"] (Just path) lEM $ make ["install"] (Just path)
pure () pure ()
@ -155,23 +155,22 @@ installCabalBin :: ( MonadMask m
) )
=> GHCupDownloads => GHCupDownloads
-> Version -> Version
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform -> PlatformRequest
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NotInstalled , NotInstalled
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif
] ]
m m
() ()
installCabalBin bDls ver mpfReq = do installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
bindir <- liftIO ghcupBinDir bindir <- liftIO ghcupBinDir
@ -185,8 +184,6 @@ installCabalBin bDls ver mpfReq = do
) )
$ (throwE $ AlreadyInstalled Cabal ver) $ (throwE $ AlreadyInstalled Cabal ver)
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version) -- download (or use cached version)
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@ -380,31 +377,25 @@ listVersions :: ( MonadCatch m
=> GHCupDownloads => GHCupDownloads
-> Maybe Tool -> Maybe Tool
-> Maybe ListCriteria -> 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 case lt of
Just t -> do Just t -> do
-- get versions from GHCupDownloads -- get versions from GHCupDownloads
let avTools = availableToolVersions av t 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 case t of
-- append stray GHCs -- append stray GHCs
GHC -> do GHC -> do
slr <- lift $ strayGHCs avTools slr <- strayGHCs avTools
pure $ (sort (slr ++ lr)) pure $ (sort (slr ++ lr))
_ -> pure lr _ -> pure lr
Nothing -> do 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) pure (ghcvers <> cabalvers <> ghcupvers)
where where
@ -449,8 +440,8 @@ listVersions av lt criteria = do
pure Nothing pure Nothing
-- NOTE: this are not cross ones, because no bindists -- 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 GHC -> do
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
let tver = mkTVer v let tver = mkTVer v
@ -600,24 +591,24 @@ compileGHC :: ( MonadMask m
-> Maybe (Path Abs) -- ^ build config -> Maybe (Path Abs) -- ^ build config
-> Maybe (Path Abs) -- ^ patch directory -> Maybe (Path Abs) -- ^ patch directory
-> [Text] -- ^ additional args to ./configure -> [Text] -- ^ additional args to ./configure
-> PlatformRequest
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NotFoundInPATH , NotFoundInPATH
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif
] ]
m 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}|] lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
whenM (liftIO $ ghcInstalled tver) whenM (liftIO $ ghcInstalled tver)
(throwE $ AlreadyInstalled GHC (tver ^. tvVersion)) (throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
@ -631,7 +622,6 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs = do
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
(PlatformRequest {..}) <- liftE $ platformRequest
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
bghc <- case bstrap of bghc <- case bstrap of
@ -664,7 +654,7 @@ BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO HADDOCK_DOCS = NO
Stage1Only = YES|] 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) => Either (Path Rel) (Path Abs)
-> Path Abs -> Path Abs
-> Path Abs -> Path Abs
@ -692,7 +682,7 @@ Stage1Only = YES|]
Left bver -> do Left bver -> do
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
(liftIO $ searchPath spaths bver) !? NotFoundInPATH bver (liftIO $ searchPath spaths bver) !? NotFoundInPATH bver
lEM $ liftIO $ execLogged lEM $ execLogged
"./configure" "./configure"
False False
( ["--prefix=" <> toFilePath ghcdir] ( ["--prefix=" <> toFilePath ghcdir]
@ -706,7 +696,7 @@ Stage1Only = YES|]
(Just workdir) (Just workdir)
(Just (("GHC", toFilePath bghcPath) : cEnv)) (Just (("GHC", toFilePath bghcPath) : cEnv))
| otherwise -> do | otherwise -> do
lEM $ liftIO $ execLogged lEM $ execLogged
"./configure" "./configure"
False False
( [ "--prefix=" <> toFilePath ghcdir ( [ "--prefix=" <> toFilePath ghcdir
@ -731,11 +721,11 @@ Stage1Only = YES|]
liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
lift $ $(logInfo) [i|Building (this may take a while)...|] 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) (Just workdir)
lift $ $(logInfo) [i|Installing...|] lift $ $(logInfo) [i|Installing...|]
lEM $ liftIO $ make ["install"] (Just workdir) lEM $ make ["install"] (Just workdir)
markSrcBuilt ghcdir workdir = do markSrcBuilt ghcdir workdir = do
let dest = (ghcdir </> ghcUpSrcBuiltFile) let dest = (ghcdir </> ghcUpSrcBuiltFile)
@ -779,24 +769,24 @@ compileCabal :: ( MonadReader Settings m
-> Either Version (Path Abs) -- ^ version to bootstrap with -> Either Version (Path Abs) -- ^ version to bootstrap with
-> Maybe Int -> Maybe Int
-> Maybe (Path Abs) -> Maybe (Path Abs)
-> PlatformRequest
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, CopyError , CopyError
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NotInstalled , NotInstalled
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
#if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif
] ]
m 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}|] lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
bindir <- liftIO ghcupBinDir bindir <- liftIO ghcupBinDir
@ -817,7 +807,6 @@ compileCabal dls tver bghc jobs patchdir = do
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
(PlatformRequest {..}) <- liftE $ platformRequest
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
@ -838,7 +827,7 @@ compileCabal dls tver bghc jobs patchdir = do
pure () pure ()
where where
compile :: (MonadThrow m, MonadLogger m, MonadIO m, MonadResource m) compile :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadResource m)
=> Path Abs => Path Abs
-> Excepts '[ProcessError , PatchFailed] m (Path Abs) -> Excepts '[ProcessError , PatchFailed] m (Path Abs)
compile workdir = do compile workdir = do
@ -871,7 +860,7 @@ compileCabal dls tver bghc jobs patchdir = do
newEnv <- lift $ addToCurrentEnv (("PREFIX", toFilePath tmp) : ghcEnv) newEnv <- lift $ addToCurrentEnv (("PREFIX", toFilePath tmp) : ghcEnv)
lift $ $(logDebug) [i|Environment: #{newEnv}|] lift $ $(logDebug) [i|Environment: #{newEnv}|]
lEM $ liftIO $ execLogged "./bootstrap.sh" lEM $ execLogged "./bootstrap.sh"
False False
(maybe [] (\j -> ["-j", fS (show j)]) jobs) (maybe [] (\j -> ["-j", fS (show j)]) jobs)
[rel|cabal-bootstrap|] [rel|cabal-bootstrap|]
@ -899,23 +888,20 @@ upgradeGHCup :: ( MonadMask m
-> Maybe (Path Abs) -- ^ full file destination to write ghcup into -> Maybe (Path Abs) -- ^ full file destination to write ghcup into
-> Bool -- ^ whether to force update regardless -> Bool -- ^ whether to force update regardless
-- of currently installed version -- of currently installed version
-> PlatformRequest
-> Excepts -> Excepts
'[ CopyError '[ CopyError
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, NoUpdate , NoUpdate
] ]
m m
Version Version
upgradeGHCup dls mtarget force = do upgradeGHCup dls mtarget force pfreq = do
lift $ $(logInfo) [i|Upgrading GHCup...|] lift $ $(logInfo) [i|Upgrading GHCup...|]
let latestVer = fromJust $ getLatest dls GHCup let latestVer = fromJust $ getLatest dls GHCup
when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
pfreq <- liftE platformRequest
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|] let fn = [rel|ghcup|]

26
lib/GHCup/Data/GHCupDownloads.hs
View File

@ -2,7 +2,10 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module GHCup.Data.GHCupDownloads where module GHCup.Data.GHCupDownloads
( ghcupDownloads
)
where
import GHCup.Types import GHCup.Types
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
@ -661,6 +664,12 @@ ghc_865_32_musl = DownloadInfo
(Just [rel|ghc-8.6.5|]) (Just [rel|ghc-8.6.5|])
"db13ff894faf431f9c64db21c090a1e4e42803794d56720a704c50166c7ca05d" "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|]) (Just [rel|ghc-8.8.3|])
"7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4" "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" "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)]) , (Darwin , M.fromList [(Nothing, ghc_865_64_darwin)])
, (Linux Alpine, M.fromList [(Nothing, ghc_865_64_musl)]) , (Linux Alpine, M.fromList [(Nothing, ghc_865_64_musl)])
, (FreeBSD, M.fromList [(Nothing, ghc_865_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32
@ -1796,6 +1816,7 @@ ghcupDownloads = M.fromList
) )
, (Darwin , M.fromList [(Nothing, ghc_883_64_darwin)]) , (Darwin , M.fromList [(Nothing, ghc_883_64_darwin)])
, (Linux Alpine, M.fromList [(Nothing, ghc_883_64_musl)]) , (Linux Alpine, M.fromList [(Nothing, ghc_883_64_musl)])
, (FreeBSD , M.fromList [(Nothing, ghc_883_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32
@ -1840,7 +1861,7 @@ ghcupDownloads = M.fromList
, (Just [vers|7|], ghc_8101_64_centos) , (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 , ( Linux AmazonLinux
, M.fromList [(Nothing, ghc_8101_64_centos)] , M.fromList [(Nothing, ghc_8101_64_centos)]
) )
@ -1861,6 +1882,7 @@ ghcupDownloads = M.fromList
) )
, (Darwin , M.fromList [(Nothing, ghc_8101_64_darwin)]) , (Darwin , M.fromList [(Nothing, ghc_8101_64_darwin)])
, (Linux Alpine, M.fromList [(Nothing, ghc_8101_64_alpine)]) , (Linux Alpine, M.fromList [(Nothing, ghc_8101_64_alpine)])
, (FreeBSD , M.fromList [(Nothing, ghc_8101_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32

1
lib/GHCup/Types.hs
View File

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

31
lib/GHCup/Utils.hs
View File

@ -24,7 +24,9 @@ import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
#if !defined(TAR)
import Codec.Archive import Codec.Archive
#endif
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
@ -59,13 +61,18 @@ import System.Posix.Files.ByteString ( readSymbolicLink )
import Text.Regex.Posix import Text.Regex.Posix
import URI.ByteString 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.BZip as BZip
import qualified Codec.Compression.GZip as GZip import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.Lzma as Lzma import qualified Codec.Compression.Lzma as Lzma
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
#if !defined(TAR)
import qualified Data.Text as T import qualified Data.Text as T
#endif
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
@ -312,17 +319,30 @@ getLatestGHCFor major' minor' dls = do
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m) unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
=> Path Abs -- ^ destination dir => Path Abs -- ^ destination dir
-> Path Abs -- ^ archive path -> Path Abs -- ^ archive path
-> Excepts '[UnknownArchive, ArchiveResult] m () -> Excepts '[UnknownArchive
#if !defined(TAR)
, ArchiveResult
#endif
] m ()
unpackToDir dest av = do unpackToDir dest av = do
fp <- (decUTF8Safe . toFilePath) <$> basename av fp <- (decUTF8Safe . toFilePath) <$> basename av
let dfp = decUTF8Safe . toFilePath $ dest let dfp = decUTF8Safe . toFilePath $ dest
lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|] lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
fn <- toFilePath <$> basename av 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 () let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar = lEM . liftIO . runArchiveM . unpackToDirLazy (T.unpack . decUTF8Safe . toFilePath $ dest) 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 rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
#endif
rf = liftIO . readFile rf = liftIO . readFile
-- extract, depending on file extension -- extract, depending on file extension
@ -453,10 +473,13 @@ ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
-- | Calls gmake if it exists in PATH, otherwise make. -- | 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 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" let mymake = if has_gmake then "gmake" else "make"
execLogged mymake True args [rel|ghc-make|] workdir Nothing execLogged mymake True args [rel|ghc-make|] workdir Nothing

51
lib/GHCup/Utils/File.hs
View File

@ -1,16 +1,19 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module GHCup.Utils.File where module GHCup.Utils.File where
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Types
import Control.Concurrent import Control.Concurrent
import Control.Exception ( evaluate ) import Control.Exception ( evaluate )
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Foldable import Data.Foldable
import Data.Functor import Data.Functor
@ -101,19 +104,21 @@ executeOut path args chdir = captureOutStreams $ do
SPPB.executeFile (toFilePath path) True args Nothing 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 -> Bool -- ^ whether to search PATH for the thing
-> [ByteString] -- ^ args for the thing -> [ByteString] -- ^ args for the thing
-> Path Rel -- ^ log filename -> Path Rel -- ^ log filename
-> Maybe (Path Abs) -- ^ optionally chdir into this -> Maybe (Path Abs) -- ^ optionally chdir into this
-> Maybe [(ByteString, ByteString)] -- ^ optional environment -> Maybe [(ByteString, ByteString)] -- ^ optional environment
-> IO (Either ProcessError ()) -> m (Either ProcessError ())
execLogged exe spath args lfile chdir env = do execLogged exe spath args lfile chdir env = do
ldir <- ghcupLogsDir Settings{..} <- ask
ldir <- liftIO ghcupLogsDir
logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log") logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
bracket (createFile (toFilePath logfile) newFilePerms) closeFd action liftIO $ bracket (createFile (toFilePath logfile) newFilePerms) closeFd (action verbose)
where where
action fd = do action verbose fd = do
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
-- start the thread that logs to stdout in a region -- start the thread that logs to stdout in a region
done <- newEmptyMVar done <- newEmptyMVar
@ -122,7 +127,7 @@ execLogged exe spath args lfile chdir env = do
$ EX.handle (\(_ :: StopThread) -> pure ()) $ EX.handle (\(_ :: StopThread) -> pure ())
$ EX.handle (\(_ :: IOException) -> pure ()) $ EX.handle (\(_ :: IOException) -> pure ())
$ flip finally (putMVar done ()) $ flip finally (putMVar done ())
$ printToRegion fd stdoutRead 6 $ (if verbose then tee fd stdoutRead else printToRegion fd stdoutRead 6)
-- fork our subprocess -- fork our subprocess
pid <- SPPB.forkProcess $ do pid <- SPPB.forkProcess $ do
@ -151,6 +156,17 @@ execLogged exe spath args lfile chdir env = do
closeFd stdoutRead closeFd stdoutRead
pure e 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 -- Reads fdIn and logs the output in a continous scrolling area
-- of 'size' terminal lines. Also writes to a log file. -- of 'size' terminal lines. Also writes to a log file.
printToRegion fileFd fdIn size = do printToRegion fileFd fdIn size = do
@ -170,6 +186,7 @@ execLogged exe spath args lfile chdir env = do
where where
-- action to perform line by line -- action to perform line by line
-- TODO: do this with vty for efficiency
lineAction ref rs bs' = do lineAction ref rs bs' = do
modifyIORef' ref (swapRegs bs') modifyIORef' ref (swapRegs bs')
regs <- readIORef ref 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 <> "..." trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
| otherwise = 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 fd' = do
bs <- SPIB.fdRead fd' 1 bs <- SPIB.fdRead fd' 1
if if
| bs == "\n" -> pure "" | bs == "\n" -> pure ""
| bs == "" -> pure "" | bs == "" -> pure ""
| otherwise -> fmap (bs <>) $ readLine fd' | otherwise -> fmap (bs <>) $ readLine fd'
readTilEOF action' fd' = do readTilEOF action' fd' = do
bs <- readLine fd' bs <- readLine fd'
void $ action' bs void $ action' bs
readTilEOF action' fd' readTilEOF action' fd'
-- | Capture the stdout and stderr of the given action, which -- | Capture the stdout and stderr of the given action, which