Compare commits

...

23 Commits

Author SHA1 Message Date
e5947f3490 Add BOOTSTRAP_HASKELL_MINIMAL wrt #222 2021-08-30 11:19:43 +02:00
b35fe15703 Merge branch 'remove-zipp' 2021-08-29 23:11:03 +02:00
a269b60282 Remove extra 2021-08-29 22:37:16 +02:00
fc6f7ffd73 Update stack.yaml 2021-08-29 21:21:03 +02:00
430dc2d20b Remove zip dependency 2021-08-29 20:56:17 +02:00
77c464870f Refreeze 2021-08-29 17:46:53 +02:00
dda38ec52b Merge remote-tracking branch 'origin/merge-requests/158' 2021-08-29 17:43:01 +02:00
Jan Hrček
f6b6b36eb7 Apply hlint 3.3.2 suggestions 2021-08-29 17:08:06 +02:00
Jan Hrček
3986677b06 Fix typos and simplify code 2021-08-29 14:50:49 +02:00
1fb048777c Merge branch 'cabal-plan' 2021-08-27 15:19:17 +02:00
e9c335eecc Add --cabal-plan 2021-08-27 14:59:09 +02:00
a7c7186aa4 Add ghc-8.10.7 2021-08-27 12:41:01 +02:00
e38bd61066 Fixup merge 2021-08-26 20:16:40 +02:00
b086261c3c Merge remote-tracking branch 'origin/merge-requests/149' 2021-08-26 20:12:19 +02:00
8c098d4e17 Add solus in getLinuxDistro 2021-08-26 20:09:48 +02:00
e3a9c095c6 Merge branch 'remove-string-interpolate' 2021-08-25 21:17:19 +02:00
678bdd7915 Bump stack resolver 2021-08-25 19:02:17 +02:00
14fc6b7281 Remove string-interpolate wrt #212 2021-08-25 18:54:58 +02:00
a2555cecc5 Merge branch 'solus' 2021-08-25 15:11:29 +02:00
9d6e469f79 Add solus support 2021-08-25 13:51:34 +02:00
982c0a0fcf Merge branch 'fix-CII' 2021-08-25 12:16:18 +02:00
Arjun Kathuria
df758d828b swap checkFileAlreadyExists with throwIfFileAlreadyExists 2021-08-24 20:39:07 +05:30
Arjun Kathuria
8c486e8d46 Make GHCup isolate installs non-overwriting by default 2021-08-23 20:18:45 +05:30
29 changed files with 3188 additions and 406 deletions

View File

@@ -99,7 +99,7 @@ variables:
script: script:
- bash ./.gitlab/script/ghcup_version.sh - bash ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.6" JSON_VERSION: "0.0.7"
artifacts: artifacts:
expire_in: 2 week expire_in: 2 week
paths: paths:
@@ -207,7 +207,7 @@ variables:
only: only:
- tags - tags
variables: variables:
JSON_VERSION: "0.0.6" JSON_VERSION: "0.0.7"
######## stack test ######## ######## stack test ########

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Validate where module Validate where
@@ -33,7 +34,6 @@ import Control.Monad.Trans.Resource ( runResourceT
import Data.Containers.ListUtils ( nubOrd ) import Data.Containers.ListUtils ( nubOrd )
import Data.IORef import Data.IORef
import Data.List import Data.List
import Data.String.Interpolate
import Data.Versions import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
@@ -89,24 +89,23 @@ validate dls _ = do
if e > 0 if e > 0
then pure $ ExitFailure e then pure $ ExitFailure e
else do else do
lift $ $(logInfo) [i|All good|] lift $ $(logInfo) "All good"
pure ExitSuccess pure ExitSuccess
where where
checkHasRequiredPlatforms t v tags arch pspecs = do checkHasRequiredPlatforms t v tags arch pspecs = do
let v' = prettyVer v let v' = prettyVer v
arch' = prettyShow arch arch' = prettyShow arch
when (notElem (Linux UnknownLinux) pspecs) $ do when (notElem (Linux UnknownLinux) pspecs) $ do
lift $ $(logError) lift $ $(logError) $
[i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|] "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError addError
when ((notElem Darwin pspecs) && arch == A_64) $ do when ((notElem Darwin pspecs) && arch == A_64) $ do
lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch'}|] lift $ $(logError) $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError addError
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn) when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn) $
[i|FreeBSD missing for #{t} #{v'} #{arch'}|] "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
when (notElem Windows pspecs && arch == A_64) $ do when (notElem Windows pspecs && arch == A_64) $ do
lift $ $(logError) lift $ $(logError) $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
[i|Windows missing for for #{t} #{v'} #{arch'}|]
addError addError
-- alpine needs to be set explicitly, because -- alpine needs to be set explicitly, because
@@ -114,12 +113,12 @@ validate dls _ = do
-- (although it could be static) -- (although it could be static)
when (notElem (Linux Alpine) pspecs) $ when (notElem (Linux Alpine) pspecs) $
case t of case t of
GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
Cabal | v > [vver|2.4.1.0|] Cabal | v > [vver|2.4.1.0|]
, arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError , arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
GHC | Latest `elem` tags || Recommended `elem` tags GHC | Latest `elem` tags || Recommended `elem` tags
, arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) , arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|] _ -> lift $ $(logWarn) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
checkUniqueTags tool = do checkUniqueTags tool = do
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
@@ -139,7 +138,7 @@ validate dls _ = do
case join nonUnique of case join nonUnique of
[] -> pure () [] -> pure ()
xs -> do xs -> do
lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|] lift $ $(logError) $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
addError addError
where where
isUniqueTag Latest = True isUniqueTag Latest = True
@@ -155,7 +154,7 @@ validate dls _ = do
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
[_] -> pure () [_] -> pure ()
_ -> do _ -> do
lift $ $(logError) [i|GHC version #{v} is not valid |] lift $ $(logError) $ "GHC version " <> prettyVer v <> " is not valid"
addError addError
-- a tool must have at least one of each mandatory tags -- a tool must have at least one of each mandatory tags
@@ -163,7 +162,7 @@ validate dls _ = do
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
forM_ [Latest, Recommended] $ \t -> case elem t allTags of forM_ [Latest, Recommended] $ \t -> case elem t allTags of
False -> do False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|] lift $ $(logError) $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
addError addError
True -> pure () True -> pure ()
@@ -172,7 +171,7 @@ validate dls _ = do
let allTags = M.toList $ availableToolVersions dls GHC let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
False -> do False -> do
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|] lift $ $(logError) $ "Base tag missing from GHC ver " <> prettyVer ver
addError addError
True -> pure () True -> pure ()
@@ -205,7 +204,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
let gdlis = nubOrd $ gt ^.. each let gdlis = nubOrd $ gt ^.. each
let allDls = either (const gdlis) (const dlis) etool let allDls = either (const gdlis) (const dlis) etool
when (null allDls) $ $(logError) [i|no tarballs selected by filter|] *> addError when (null allDls) $ $(logError) "no tarballs selected by filter" *> addError
forM_ allDls downloadAll forM_ allDls downloadAll
-- exit -- exit
@@ -213,7 +212,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
if e > 0 if e > 0
then pure $ ExitFailure e then pure $ ExitFailure e
else do else do
lift $ $(logInfo) [i|All good|] lift $ $(logInfo) "All good"
pure ExitSuccess pure ExitSuccess
where where
@@ -265,25 +264,25 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
case _dlSubdir dli of case _dlSubdir dli of
Just (RealDir prel) -> do Just (RealDir prel) -> do
lift $ $(logInfo) lift $ $(logInfo)
[i|verifying subdir: #{prel}|] $ " verifying subdir: " <> T.pack prel
when (basePath /= prel) $ do when (basePath /= prel) $ do
lift $ $(logError) lift $ $(logError) $
[i|Subdir doesn't match: expected "#{prel}", got "#{basePath}"|] "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
addError addError
Just (RegexDir regexString) -> do Just (RegexDir regexString) -> do
lift $ $(logInfo) lift $ $(logInfo) $
[i|verifying subdir (regex): #{regexString}|] "verifying subdir (regex): " <> T.pack regexString
let regex = makeRegexOpts let regex = makeRegexOpts
compIgnoreCase compIgnoreCase
execBlank execBlank
regexString regexString
when (not (match regex basePath)) $ do when (not (match regex basePath)) $ do
lift $ $(logError) lift $ $(logError) $
[i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|] "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
addError addError
Nothing -> pure () Nothing -> pure ()
VRight Nothing -> pure () VRight Nothing -> pure ()
VLeft e -> do VLeft e -> do
lift $ $(logError) lift $ $(logError) $
[i|Could not download (or verify hash) of #{dli}, Error was: #{prettyShow e}|] "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
addError addError

View File

@@ -38,7 +38,6 @@ import Data.Functor
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.IORef import Data.IORef
import Data.String.Interpolate
import Data.Vector ( Vector import Data.Vector ( Vector
, (!?) , (!?)
) )
@@ -467,8 +466,8 @@ install' _ (_, ListResult {..}) = do
pure $ Right () pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right () VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right () VLeft (V NoUpdate) -> pure $ Right ()
VLeft e -> pure $ Left [i|#{prettyShow e} VLeft e -> pure $ Left $ prettyShow e <> "\n"
Also check the logs in ~/.ghcup/logs|] <> "Also check the logs in ~/.ghcup/logs"
set' :: BrickState -> (Int, ListResult) -> IO (Either String ()) set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
@@ -530,8 +529,8 @@ changelog' :: (MonadReader AppState m, MonadIO m)
changelog' _ (_, ListResult {..}) = do changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (Left lVer) of case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left Nothing -> pure $ Left $
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|] "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do Just uri -> do
let cmd = case _rPlatform pfreq of let cmd = case _rPlatform pfreq of
Darwin -> "open" Darwin -> "open"
@@ -597,7 +596,7 @@ brickMain s l = do
) )
$> () $> ()
Left e -> do Left e -> do
runLogger ($(logError) [i|Error building app state: #{show e}|]) runLogger ($(logError) $ "Error building app state: " <> T.pack (show e))
exitWith $ ExitFailure 2 exitWith $ ExitFailure 2

View File

@@ -30,6 +30,7 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import GHCup.Version import GHCup.Version
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
import Codec.Archive import Codec.Archive
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Async import Control.Concurrent.Async
@@ -42,6 +43,8 @@ import Control.Monad.Fail ( MonadFail )
import Control.Monad.Logger import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Aeson ( decodeStrict', Value )
import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Bifunctor import Data.Bifunctor
import Data.Char import Data.Char
import Data.Either import Data.Either
@@ -49,7 +52,6 @@ import Data.Functor
import Data.List ( intercalate, nub, sort, sortBy ) import Data.List ( intercalate, nub, sort, sortBy )
import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Data.Void import Data.Void
@@ -1087,7 +1089,7 @@ setVersionArgument criteria tool =
<|> second SetToolVersion (tVersionEither s') <|> second SetToolVersion (tVersionEither s')
parseSet s' = case fmap toLower s' of parseSet s' = case fmap toLower s' of
"next" -> Right SetNext "next" -> Right SetNext
other -> Left [i|Unknown tag/version #{other}|] other -> Left $ "Unknown tag/version " <> other
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
@@ -1170,8 +1172,8 @@ tagEither s' = case fmap toLower s' of
"latest" -> Right Latest "latest" -> Right Latest
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x) Right x -> Right (Base x)
Left _ -> Left [i|Invalid PVP version for base #{ver'}|] Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left [i|Unknown tag #{other}|] other -> Left $ "Unknown tag " <> other
tVersionEither :: String -> Either String GHCTargetVersion tVersionEither :: String -> Either String GHCTargetVersion
@@ -1364,6 +1366,16 @@ describe_result = $( LitE . StringL <$>
) )
) )
plan_json :: String
plan_json = $( LitE . StringL <$>
runIO (handleIO (\_ -> pure "") $ do
fp <- findPlanJson (ProjectRelativeToDir ".")
c <- B.readFile fp
(Just res) <- pure $ decodeStrict' @Value c
pure $ T.unpack $ decUTF8Safe' $ encodePretty res
)
)
formatConfig :: UserSettings -> String formatConfig :: UserSettings -> String
formatConfig settings formatConfig settings
= UTF8.toString . YP.encodePretty yamlConfig $ settings = UTF8.toString . YP.encodePretty yamlConfig $ settings
@@ -1382,6 +1394,9 @@ main = do
(head . lines $ describe_result) (head . lines $ describe_result)
) )
(long "version" <> help "Show version" <> hidden) (long "version" <> help "Show version" <> hidden)
let planJson = infoOption
plan_json
(long "plan-json" <> help "Show the build-time configuration" <> internal)
let numericVersionHelp = infoOption let numericVersionHelp = infoOption
numericVer numericVer
( long "numeric-version" ( long "numeric-version"
@@ -1409,7 +1424,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
customExecParser customExecParser
(prefs showHelpOnError) (prefs showHelpOnError)
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands) (info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> planJson <**> listCommands)
(footerDoc (Just $ text main_footer)) (footerDoc (Just $ text main_footer))
) )
>>= \opt@Options {..} -> do >>= \opt@Options {..} -> do
@@ -1466,7 +1481,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let s' = AppState settings dirs keybindings ghcupInfo pfreq let s' = AppState settings dirs keybindings ghcupInfo pfreq
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash) race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
(threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|])) (threadDelay 5000000 >> runLogger ($(logWarn) $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
case optCommand of case optCommand of
Nuke -> pure () Nuke -> pure ()
@@ -1718,20 +1733,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ $(logInfo) msg runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn) $
[i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|] "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err) Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err)
_ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err} _ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues. "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
Make sure to clean up #{tmpdir} afterwards.|]) "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e $(logError) $ T.pack $ prettyShow e
$(logError) [i|Also check the logs in #{logsDir}|] $(logError) $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 3 pure $ ExitFailure 3
@@ -1758,13 +1773,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ $(logInfo) msg runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn) $
[i|Cabal ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal #{prettyVer v}' first|] "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e $(logError) $ T.pack $ prettyShow e
$(logError) [i|Also check the logs in #{logsDir}|] $(logError) $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
let installHLS InstallOptions{..} = let installHLS InstallOptions{..} =
@@ -1790,13 +1805,17 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ $(logInfo) msg runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn) $
[i|HLS ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls #{prettyVer v}' first|] "HLS ver "
<> prettyVer v
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls "
<> prettyVer v
<> "' first"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e $(logError) $ T.pack $ prettyShow e
$(logError) [i|Also check the logs in #{logsDir}|] $(logError) $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
let installStack InstallOptions{..} = let installStack InstallOptions{..} =
@@ -1822,13 +1841,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ $(logInfo) msg runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn) $
[i|Stack ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack #{prettyVer v}' first|] "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e $(logError) $ T.pack $ prettyShow e
$(logError) [i|Also check the logs in #{logsDir}|] $(logError) $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
@@ -1842,8 +1861,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $(logInfo) $
[i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|] "GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1860,8 +1879,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $(logInfo) $
[i|Cabal #{prettyVer _tvVersion} successfully set as default version|] "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1878,8 +1897,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $(logInfo) $
[i|HLS #{prettyVer _tvVersion} successfully set as default version|] "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1896,8 +1915,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $(logInfo) $
[i|Stack #{prettyVer _tvVersion} successfully set as default version|] "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1974,18 +1993,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
liftIO $ brickMain s' loggerConfig >> pure ExitSuccess liftIO $ brickMain s' loggerConfig >> 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) "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
installGHC iopts installGHC iopts
Install (Left (InstallGHC iopts)) -> installGHC iopts Install (Left (InstallGHC iopts)) -> installGHC iopts
Install (Left (InstallCabal iopts)) -> installCabal iopts Install (Left (InstallCabal iopts)) -> installCabal iopts
Install (Left (InstallHLS iopts)) -> installHLS iopts Install (Left (InstallHLS iopts)) -> installHLS iopts
Install (Left (InstallStack iopts)) -> installStack iopts Install (Left (InstallStack iopts)) -> installStack iopts
InstallCabalLegacy iopts -> do InstallCabalLegacy iopts -> do
runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|]) runLogger ($(logWarn) "This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.")
installCabal iopts installCabal iopts
Set (Right sopts) -> do Set (Right sopts) -> do
runLogger ($(logWarn) [i|This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.|]) runLogger ($(logWarn) "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
setGHC' sopts setGHC' sopts
Set (Left (SetGHC sopts)) -> setGHC' sopts Set (Left (SetGHC sopts)) -> setGHC' sopts
Set (Left (SetCabal sopts)) -> setCabal' sopts Set (Left (SetCabal sopts)) -> setCabal' sopts
@@ -2000,7 +2019,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
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) "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
rmGHC' rmopts rmGHC' rmopts
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
@@ -2058,15 +2077,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
putStr (T.unpack $ tVerToText tv) putStr (T.unpack $ tVerToText tv)
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn) $
[i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|] "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err
_ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err} _ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues. "Check the logs at " <> T.pack logsDir <> " and the build directory "
Make sure to clean up #{tmpdir} afterwards.|]) <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9 pure $ ExitFailure 9
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -2075,7 +2095,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
Config InitConfig -> do Config InitConfig -> do
path <- getConfigFilePath path <- getConfigFilePath
writeFile path $ formatConfig $ fromSettings settings (Just keybindings) writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|] runLogger $ $(logDebug) $ "config.yaml initialized at " <> T.pack path
pure ExitSuccess pure ExitSuccess
Config ShowConfig -> do Config ShowConfig -> do
@@ -2089,7 +2109,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
pure $ ExitFailure 55 pure $ ExitFailure 55
_ -> do _ -> do
r <- runE @'[JSONError] $ do r <- runE @'[JSONError] $ do
settings' <- updateSettings [i|#{k}: #{v}\n|] settings settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
path <- liftIO getConfigFilePath path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings) liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
runLogger $ $(logDebug) $ T.pack $ show settings' runLogger $ $(logDebug) $ T.pack $ show settings'
@@ -2098,8 +2118,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
case r of case r of
VRight _ -> pure ExitSuccess VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do VLeft (V (JSONDecodeError e)) -> do
runLogger $ $(logError) runLogger $ $(logError) $ "Error decoding config: " <> T.pack e
[i|Error decoding config: #{e}|]
pure $ ExitFailure 65 pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65 VLeft _ -> pure $ ExitFailure 65
@@ -2148,13 +2167,13 @@ Make sure to clean up #{tmpdir} afterwards.|])
VRight (v', dls) -> do VRight (v', dls) -> do
let pretty_v = prettyVer v' let pretty_v = prettyVer v'
let vi = fromJust $ snd <$> getLatest dls GHCup let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo) runLogger $ $(logInfo) $
[i|Successfully upgraded GHCup to version #{pretty_v}|] "Successfully upgraded GHCup to version " <> pretty_v
forM_ (_viPostInstall vi) $ \msg -> forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V NoUpdate) -> do VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) [i|No GHCup update available|] runLogger $ $(logWarn) "No GHCup update available"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -2192,8 +2211,8 @@ Make sure to clean up #{tmpdir} afterwards.|])
case muri of case muri of
Nothing -> do Nothing -> do
runLogger runLogger
($(logWarn) ($(logWarn) $
[i|Could not find ChangeLog for #{tool}, version #{either (T.unpack . prettyVer) show ver'}|] "Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
) )
pure ExitSuccess pure ExitSuccess
Just uri -> do Just uri -> do
@@ -2215,7 +2234,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
Nothing Nothing
>>= \case >>= \case
Right _ -> pure ExitSuccess Right _ -> pure ExitSuccess
Left e -> runLogger ($(logError) [i|#{e}|]) Left e -> runLogger ($(logError) (T.pack $ prettyShow e))
>> pure (ExitFailure 13) >> pure (ExitFailure 13)
else putStrLn uri' >> pure ExitSuccess else putStrLn uri' >> pure ExitSuccess
@@ -2568,46 +2587,46 @@ checkForUpdates = 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)
$ $(logWarn) $ $(logWarn) $
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|] "New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
forM_ (getLatest dls GHC) $ \(l, _) -> do forM_ (getLatest dls GHC) $ \(l, _) -> do
let mghc_ver = latestInstalled GHC let mghc_ver = latestInstalled GHC
forM mghc_ver $ \ghc_ver -> forM mghc_ver $ \ghc_ver ->
when (l > ghc_ver) when (l > ghc_ver)
$ $(logWarn) $ $(logWarn) $
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|] "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
let mcabal_ver = latestInstalled Cabal let mcabal_ver = latestInstalled Cabal
forM mcabal_ver $ \cabal_ver -> forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver) when (l > cabal_ver)
$ $(logWarn) $ $(logWarn) $
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|] "New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
forM_ (getLatest dls HLS) $ \(l, _) -> do forM_ (getLatest dls HLS) $ \(l, _) -> do
let mhls_ver = latestInstalled HLS let mhls_ver = latestInstalled HLS
forM mhls_ver $ \hls_ver -> forM mhls_ver $ \hls_ver ->
when (l > hls_ver) when (l > hls_ver)
$ $(logWarn) $ $(logWarn) $
[i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|] "New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
forM_ (getLatest dls Stack) $ \(l, _) -> do forM_ (getLatest dls Stack) $ \(l, _) -> do
let mstack_ver = latestInstalled Stack let mstack_ver = latestInstalled Stack
forM mstack_ver $ \stack_ver -> forM mstack_ver $ \stack_ver ->
when (l > stack_ver) when (l > stack_ver)
$ $(logWarn) $ $(logWarn) $
[i|New Stack version available: #{prettyVer l}. To upgrade, run 'ghcup install stack #{prettyVer l}'|] "New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
prettyDebugInfo :: DebugInfo -> String prettyDebugInfo :: DebugInfo -> String
prettyDebugInfo DebugInfo {..} = [i|Debug Info prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
========== "==========" <> "\n" <>
GHCup base dir: #{diBaseDir} "GHCup base dir: " <> diBaseDir <> "\n" <>
GHCup bin dir: #{diBinDir} "GHCup bin dir: " <> diBinDir <> "\n" <>
GHCup GHC directory: #{diGHCDir} "GHCup GHC directory: " <> diGHCDir <> "\n" <>
GHCup cache directory: #{diCacheDir} "GHCup cache directory: " <> diCacheDir <> "\n" <>
Architecture: #{prettyShow diArch} "Architecture: " <> prettyShow diArch <> "\n" <>
Platform: #{prettyShow diPlatform} "Platform: " <> prettyShow diPlatform <> "\n" <>
Version: #{describe_result}|] "Version: " <> describe_result

View File

@@ -3,6 +3,7 @@
# Main settings: # Main settings:
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation # * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade # * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
# * BOOTSTRAP_HASKELL_MINIMAL - any nonzero value to only install ghcup
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification # * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation # * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
# * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install # * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
@@ -591,10 +592,12 @@ ask_bashrc
ask_bashrc_answer=$? ask_bashrc_answer=$?
ask_cabal_config_init ask_cabal_config_init
ask_cabal_config_init_answer=$? ask_cabal_config_init_answer=$?
ask_hls if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
ask_hls_answer=$? ask_hls
ask_stack ask_hls_answer=$?
ask_stack_answer=$? ask_stack
ask_stack_answer=$?
fi
edo mkdir -p "${GHCUP_BIN}" edo mkdir -p "${GHCUP_BIN}"
@@ -620,14 +623,30 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
read -r answer </dev/tty read -r answer </dev/tty
fi fi
eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}" eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
do_cabal_config_init $ask_cabal_config_init_answer do_cabal_config_init $ask_cabal_config_init_answer
edo cabal new-update edo cabal new-update
else # don't install ghc and cabal
case "${plat}" in
MSYS*|MINGW*)
# need to bootstrap cabal to initialize config on windows
# we'll remove it afterwards
tmp_dir="$(mktemp -d)"
eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer
rm "${tmp_dir}/cabal"
unset tmp_dir
;;
*)
;;
esac
fi
case $ask_hls_answer in case $ask_hls_answer in
1) 1)

View File

@@ -32,7 +32,9 @@ param (
# Whether to install hls as well # Whether to install hls as well
[switch]$InstallHLS, [switch]$InstallHLS,
# Skip adjusting cabal.config with mingw paths # Skip adjusting cabal.config with mingw paths
[switch]$NoAdjustCabalConfig [switch]$NoAdjustCabalConfig,
# Do minimal installation of ghcup and msys2 only
[switch]$Minimal
) )
$Silent = !$Interactive $Silent = !$Interactive
@@ -529,10 +531,14 @@ if (!($NoAdjustCabalConfig)) {
$AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;' $AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;'
} }
if ($Minimal) {
$MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;'
}
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) { if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
Exec "$Bash" '-lc' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport) Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
} else { } else {
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport) Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
} }

View File

@@ -8,26 +8,27 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package
type: git
location: https://github.com/Bodigrim/tar
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
source-repository-package source-repository-package
type: git type: git
location: https://github.com/bgamari/terminal-size location: https://github.com/bgamari/terminal-size
tag: 34ea816bd63f75f800eedac12c6908c6f3736036 tag: 34ea816bd63f75f800eedac12c6908c6f3736036
source-repository-package
type: git
location: https://github.com/hasufell/libarchive
tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
constraints: http-io-streams -brotli constraints: http-io-streams -brotli
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-8.10.5 with-compiler: ghc-8.10.7

View File

@@ -1,7 +1,7 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0, constraints: any.Cabal ==3.2.1.0,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7, any.HsOpenSSL ==0.11.7.1,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
@@ -9,7 +9,7 @@ constraints: any.Cabal ==3.2.1.0,
any.aeson ==1.5.6.0, any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast, aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8, any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only, aeson-pretty +lib-only,
any.alex ==3.2.6, any.alex ==3.2.6,
alex +small_base, alex +small_base,
any.ansi-terminal ==0.11, any.ansi-terminal ==0.11,
@@ -23,7 +23,7 @@ constraints: any.Cabal ==3.2.1.0,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.auto-update ==0.1.6, any.auto-update ==0.1.6,
any.base ==4.14.2.0, any.base ==4.14.3.0,
any.base-compat ==0.11.2, any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2, any.base-compat-batteries ==0.11.2,
any.base-orphans ==0.8.4, any.base-orphans ==0.8.4,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.2.1.0,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25, any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.1,
any.brick ==0.63, any.brick ==0.64,
brick -demos, brick -demos,
any.bytestring ==0.10.12.0, any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
@@ -42,6 +42,8 @@ constraints: any.Cabal ==3.2.1.0,
any.bzlib-conduit ==0.3.0.2, any.bzlib-conduit ==0.3.0.2,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1, any.casing ==0.1.4.1,
@@ -52,8 +54,6 @@ constraints: any.Cabal ==3.2.1.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.2, any.clock ==0.8.2,
clock -llvm, clock -llvm,
any.cmdargs ==0.10.21,
cmdargs +quotation -testprog,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable, comonad +containers +distributive +indexed-traversable,
@@ -65,8 +65,8 @@ constraints: any.Cabal ==3.2.1.0,
any.conduit-zstd ==0.0.2.0, any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.4.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.4.1, any.containers ==0.6.5.1,
any.contravariant ==1.5.4, any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
@@ -75,7 +75,7 @@ constraints: any.Cabal ==3.2.1.0,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3, any.data-clist ==0.1.2.3,
any.data-default-class ==0.1.2.0, any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.1, any.data-fix ==0.3.2,
any.deepseq ==1.4.4.0, any.deepseq ==1.4.4.0,
any.digest ==0.0.1.3, any.digest ==0.0.1.3,
digest -bytestring-in-base, digest -bytestring-in-base,
@@ -86,32 +86,26 @@ constraints: any.Cabal ==3.2.1.0,
any.dlist ==1.0, any.dlist ==1.0,
dlist -werror, dlist -werror,
any.easy-file ==0.2.2, any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.extra ==1.7.9, any.extra ==1.7.9,
any.fast-logger ==3.0.5, any.fast-logger ==3.0.5,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.7, any.free ==5.1.7,
any.generic-arbitrary ==0.1.0, any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.1, any.ghc-boot-th ==8.10.7,
any.ghc-boot-th ==8.10.5,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1, any.ghc-prim ==0.6.1,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.2.0, any.hashable ==1.3.3.0,
hashable +integer-gmp -random-initial-seed, hashable +integer-gmp -random-initial-seed,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.7,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.1,
any.hpath-filepath ==0.10.4,
any.hpath-posix ==0.13.3,
any.hsc2hs ==0.68.7, any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10 || ==2.8.2, any.hspec-discover ==2.7.10 || ==2.8.3,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
@@ -137,7 +131,7 @@ constraints: any.Cabal ==3.2.1.0,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3, any.monad-control ==1.0.3.1,
any.monad-logger ==0.3.36, any.monad-logger ==0.3.36,
monad-logger +template_haskell, monad-logger +template_haskell,
any.monad-loops ==0.4.3, any.monad-loops ==0.4.3,
@@ -155,7 +149,6 @@ constraints: any.Cabal ==3.2.1.0,
optics-core -explicit-generic-labels, optics-core -explicit-generic-labels,
any.optics-extra ==0.4, any.optics-extra ==0.4,
any.optics-th ==0.4, any.optics-th ==0.4,
any.optics-vl ==0.2.1,
any.optparse-applicative ==0.16.1.0, any.optparse-applicative ==0.16.1.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2, any.os-release ==1.0.2,
@@ -167,8 +160,8 @@ constraints: any.Cabal ==3.2.1.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.1.0, any.primitive ==0.7.2.0,
any.process ==1.6.9.0, any.process ==1.6.13.2,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
@@ -178,7 +171,7 @@ constraints: any.Cabal ==3.2.1.0,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2, any.resourcet ==1.2.4.3,
any.rts ==1.0.1, any.rts ==1.0.1,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
@@ -187,7 +180,6 @@ constraints: any.Cabal ==3.2.1.0,
any.semigroupoids ==5.3.5, any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.sop-core ==0.5.0.1,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.3,
splitmix -optimised-mixer, splitmix -optimised-mixer,
@@ -198,39 +190,31 @@ constraints: any.Cabal ==3.2.1.0,
any.strict ==0.4.0.1, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.1.1,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1, any.tagged ==0.8.6.1,
tagged +deepseq +transformers, tagged +deepseq +transformers,
any.tar ==0.6.0.0,
any.template-haskell ==2.16.0.0, any.template-haskell ==2.16.0.0,
any.temporary ==1.3, any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1, any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.4,
any.text ==1.2.4.1, any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-zipper ==0.11, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0, any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1.2, any.th-compat ==0.1.2,
any.th-expand-syns ==0.4.8.0,
any.th-lift ==0.8.2, any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18, any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
any.th-reify-many ==0.1.9,
any.these ==1.1.1.1, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
any.time-compat ==1.9.6, any.time-compat ==1.9.6,
time-compat -old-locale, time-compat -old-locale,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0, any.typed-process ==0.2.6.1,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3, any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.3,
@@ -261,4 +245,4 @@ constraints: any.Cabal ==3.2.1.0,
any.zlib-bindings ==0.1.1.5, any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.2.0, any.zstd ==0.1.2.0,
zstd +standalone zstd +standalone
index-state: hackage.haskell.org 2021-07-27T07:59:57Z index-state: hackage.haskell.org 2021-08-24T16:50:39Z

View File

@@ -8,26 +8,27 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package
type: git
location: https://github.com/Bodigrim/tar
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
source-repository-package source-repository-package
type: git type: git
location: https://github.com/bgamari/terminal-size location: https://github.com/bgamari/terminal-size
tag: 34ea816bd63f75f800eedac12c6908c6f3736036 tag: 34ea816bd63f75f800eedac12c6908c6f3736036
source-repository-package
type: git
location: https://github.com/hasufell/libarchive
tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
constraints: http-io-streams -brotli constraints: http-io-streams -brotli
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.1 with-compiler: ghc-9.0.1

View File

@@ -1,7 +1,7 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.4.0.0, constraints: any.Cabal ==3.4.0.0,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7, any.HsOpenSSL ==0.11.7.1,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
@@ -9,7 +9,7 @@ constraints: any.Cabal ==3.4.0.0,
any.aeson ==1.5.6.0, any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast, aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8, any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only, aeson-pretty +lib-only,
any.alex ==3.2.6, any.alex ==3.2.6,
alex +small_base, alex +small_base,
any.ansi-terminal ==0.11, any.ansi-terminal ==0.11,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.4.0.0,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25, any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.1,
any.brick ==0.63, any.brick ==0.64,
brick -demos, brick -demos,
any.bytestring ==0.10.12.1, any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
@@ -42,6 +42,8 @@ constraints: any.Cabal ==3.4.0.0,
any.bzlib-conduit ==0.3.0.2, any.bzlib-conduit ==0.3.0.2,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1, any.casing ==0.1.4.1,
@@ -52,8 +54,6 @@ constraints: any.Cabal ==3.4.0.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.2, any.clock ==0.8.2,
clock -llvm, clock -llvm,
any.cmdargs ==0.10.21,
cmdargs +quotation -testprog,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable, comonad +containers +distributive +indexed-traversable,
@@ -66,7 +66,7 @@ constraints: any.Cabal ==3.4.0.0,
any.config-ini ==0.2.4.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.4.1, any.containers ==0.6.4.1,
any.contravariant ==1.5.4, any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
@@ -75,7 +75,7 @@ constraints: any.Cabal ==3.4.0.0,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3, any.data-clist ==0.1.2.3,
any.data-default-class ==0.1.2.0, any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.1, any.data-fix ==0.3.2,
any.deepseq ==1.4.5.0, any.deepseq ==1.4.5.0,
any.digest ==0.0.1.3, any.digest ==0.0.1.3,
digest -bytestring-in-base, digest -bytestring-in-base,
@@ -86,33 +86,27 @@ constraints: any.Cabal ==3.4.0.0,
any.dlist ==1.0, any.dlist ==1.0,
dlist -werror, dlist -werror,
any.easy-file ==0.2.2, any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.extra ==1.7.9, any.extra ==1.7.9,
any.fast-logger ==3.0.5, any.fast-logger ==3.0.5,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.7, any.free ==5.1.7,
any.generic-arbitrary ==0.1.0, any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.1,
any.ghc-bignum ==1.0, any.ghc-bignum ==1.0,
any.ghc-boot-th ==9.0.1, any.ghc-boot-th ==9.0.1,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0, any.ghc-prim ==0.7.0,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.2.0, any.hashable ==1.3.3.0,
hashable +integer-gmp -random-initial-seed, hashable +integer-gmp -random-initial-seed,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.7,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.1,
any.hpath-filepath ==0.10.4,
any.hpath-posix ==0.13.3,
any.hsc2hs ==0.68.7, any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10 || ==2.8.2, any.hspec-discover ==2.7.10 || ==2.8.3,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
@@ -137,7 +131,7 @@ constraints: any.Cabal ==3.4.0.0,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3, any.monad-control ==1.0.3.1,
any.monad-logger ==0.3.36, any.monad-logger ==0.3.36,
monad-logger +template_haskell, monad-logger +template_haskell,
any.monad-loops ==0.4.3, any.monad-loops ==0.4.3,
@@ -155,7 +149,6 @@ constraints: any.Cabal ==3.4.0.0,
optics-core -explicit-generic-labels, optics-core -explicit-generic-labels,
any.optics-extra ==0.4, any.optics-extra ==0.4,
any.optics-th ==0.4, any.optics-th ==0.4,
any.optics-vl ==0.2.1,
any.optparse-applicative ==0.16.1.0, any.optparse-applicative ==0.16.1.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2, any.os-release ==1.0.2,
@@ -167,7 +160,7 @@ constraints: any.Cabal ==3.4.0.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.1.0, any.primitive ==0.7.2.0,
any.process ==1.6.11.0, any.process ==1.6.11.0,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
@@ -178,7 +171,7 @@ constraints: any.Cabal ==3.4.0.0,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2, any.resourcet ==1.2.4.3,
any.rts ==1.0, any.rts ==1.0,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
@@ -187,7 +180,6 @@ constraints: any.Cabal ==3.4.0.0,
any.semigroupoids ==5.3.5, any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.sop-core ==0.5.0.1,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.3,
splitmix -optimised-mixer, splitmix -optimised-mixer,
@@ -198,39 +190,31 @@ constraints: any.Cabal ==3.4.0.0,
any.strict ==0.4.0.1, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.1.1,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1, any.tagged ==0.8.6.1,
tagged +deepseq +transformers, tagged +deepseq +transformers,
any.tar ==0.6.0.0,
any.template-haskell ==2.17.0.0, any.template-haskell ==2.17.0.0,
any.temporary ==1.3, any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1, any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.4,
any.text ==1.2.4.1, any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-zipper ==0.11, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0, any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1.2, any.th-compat ==0.1.2,
any.th-expand-syns ==0.4.8.0,
any.th-lift ==0.8.2, any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18, any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
any.th-reify-many ==0.1.9,
any.these ==1.1.1.1, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
any.time-compat ==1.9.6, any.time-compat ==1.9.6,
time-compat -old-locale, time-compat -old-locale,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0, any.typed-process ==0.2.6.1,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3, any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.3,
@@ -261,4 +245,4 @@ constraints: any.Cabal ==3.4.0.0,
any.zlib-bindings ==0.1.1.5, any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.2.0, any.zstd ==0.1.2.0,
zstd +standalone zstd +standalone
index-state: hackage.haskell.org 2021-07-27T07:59:57Z index-state: hackage.haskell.org 2021-08-24T16:50:39Z

View File

@@ -16,11 +16,17 @@ source-repository-package
source-repository-package source-repository-package
type: git type: git
location: https://github.com/hasufell/libarchive location: https://github.com/hasufell/libarchive
tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99 tag: 8587aab78dd515928024ecd82c8f215e06db85cd
constraints: http-io-streams -brotli constraints: http-io-streams -brotli
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c allow-newer: base, ghc-prim, template-haskell, language-c

View File

@@ -1690,7 +1690,6 @@ ghcupDownloads:
dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
8.10.6: 8.10.6:
viTags: viTags:
- Recommended
- base-4.14.3.0 - base-4.14.3.0
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
viSourceDL: viSourceDL:
@@ -1789,6 +1788,107 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz
dlSubdir: ghc-8.10.6 dlSubdir: ghc-8.10.6
dlHash: d54de8306aa8b33afabf2ac94408e1f82c8e982a2a3346168c071b92bdb464c0 dlHash: d54de8306aa8b33afabf2ac94408e1f82c8e982a2a3346168c071b92bdb464c0
8.10.7:
viTags:
- Recommended
- base-4.14.3.0
viChangeLog: https://downloads.haskell.org/~ghc/8.10.7/docs/html/users_guide/8.10.7-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-src.tar.xz
dlSubdir: ghc-8.10.7
dlHash: e3eef6229ce9908dfe1ea41436befb0455fefb1932559e860ad4c606b0d03c9d
viPostRemove: *ghc-post-remove
viPreCompile: *ghc-pre-compile
viArch:
A_64:
Linux_Debian:
'( >= 9 && < 10 )': &ghc-8107-64-deb9
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb9-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: ced9870ea351af64fb48274b81a664cdb6a9266775f1598a79cbb6fdd5770a23
'( >= 10 && < 11 )': &ghc-8107-64-deb10
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb10-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: a13719bca87a0d3ac0c7d4157a4e60887009a7f1a8dbe95c4759ec413e086d30
unknown_versioning: *ghc-8107-64-deb9
Linux_Ubuntu:
unknown_versioning: &ghc-8107-64-fedora
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-fedora27-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: b6ed67049a23054a8042e65c9976d5e196e5ee4e83b29b2ee35c8a22ab1e5b73
'( >= 16 && < 19 )': *ghc-8107-64-deb9
Linux_Mint:
unknown_versioning: *ghc-8107-64-deb10
Linux_Fedora:
'( >= 27 && < 28 )': *ghc-8107-64-fedora
unknown_versioning: *ghc-8107-64-fedora
Linux_CentOS:
'( >= 7 && < 8 )': &ghc-8107-64-centos
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-centos7-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: 262a50bfb5b7c8770e0d99f54d42e5876968da7bf93e2e4d6cfe397891a36d05
unknown_versioning: *ghc-8107-64-centos
Linux_RedHat:
unknown_versioning: *ghc-8107-64-centos
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-8.10.7-x86_64-unknown-linux
dlHash: 16903df850ef73d5246f2ff169cbf57ecab76c2ac5acfa9928934282cfad575c
Linux_AmazonLinux:
unknown_versioning: *ghc-8107-64-centos
Linux_UnknownLinux:
unknown_versioning: *ghc-8107-64-fedora
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-apple-darwin.tar.xz
dlSubdir: ghc-8.10.7
dlHash: 287db0f9c338c9f53123bfa8731b0996803ee50f6ee847fe388092e5e5132047
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-unknown-freebsd.tar.xz
dlSubdir: ghc-8.10.7
dlHash: 45e35d24bc700e1093efa39189e9fa01498069881aed2fa8779c011941a80da1
Windows:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-unknown-mingw32.tar.xz
dlSubdir: ghc-8.10.7
dlHash: b6515b0ea3f7a6e34d92e7fcd0c1fef50d6030fe8f46883000185289a4b8ea9a
A_32:
Linux_Debian:
'( >= 9 && < 10 )': &ghc-8107-32-deb9
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-i386-deb9-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: fbfc1ef194f4e7a4c0da8c11cc69b17458a4b928b609b3622c97acc4acd5c5ab
unknown_versioning: *ghc-8107-32-deb9
Linux_Ubuntu:
unknown_versioning: *ghc-8107-32-deb9
Linux_Mint:
unknown_versioning: *ghc-8107-32-deb9
Linux_UnknownLinux:
unknown_versioning: *ghc-8107-32-deb9
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/8.10.7/ghc-8.10.7-i386-alpine-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: 3110e6ee029d9d8062158b54b06f71a21b0fac87bf0e085f9be5bbcf73f99e6d
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-aarch64-deb10-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: fad2417f9b295233bf8ade79c0e6140896359e87be46cb61cd1d35863d9d0e55
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-aarch64-apple-darwin.tar.xz
dlSubdir: ghc-8.10.7
dlHash: dc469fc3c35fd2a33a5a575ffce87f13de7b98c2d349a41002e200a56d9bba1c
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-armv7-deb10-linux.tar.xz
dlSubdir: ghc-8.10.7
dlHash: 3949c31bdf7d3b4afb765ea8246bca4ca9707c5d988d9961a244f0da100956a2
9.0.1: 9.0.1:
viTags: viTags:
- Latest - Latest

2494
ghcup-0.0.7.yaml Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -21,6 +21,7 @@ extra-doc-files:
ghcup-0.0.4.yaml ghcup-0.0.4.yaml
ghcup-0.0.5.yaml ghcup-0.0.5.yaml
ghcup-0.0.6.yaml ghcup-0.0.6.yaml
ghcup-0.0.7.yaml
HACKING.md HACKING.md
README.md README.md
RELEASING.md RELEASING.md
@@ -103,7 +104,6 @@ library
, deepseq ^>=1.4.4.0 , deepseq ^>=1.4.4.0
, directory ^>=1.3.6.0 , directory ^>=1.3.6.0
, disk-free-space ^>=0.1.0.1 , disk-free-space ^>=0.1.0.1
, extra ^>=1.7.9
, filepath ^>=1.4.2.1 , filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5 , haskus-utils-types ^>=1.5
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant >=3.0 && <3.2
@@ -122,7 +122,6 @@ library
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, split ^>=0.2.3.4 , split ^>=0.2.3.4
, strict-base ^>=0.4 , strict-base ^>=0.4
, string-interpolate >=0.2.0.0 && <0.4
, template-haskell >=2.7 && <2.18 , template-haskell >=2.7 && <2.18
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=1.2.4.0 , text ^>=1.2.4.0
@@ -135,7 +134,6 @@ library
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml ^>=0.11.4.0 , yaml ^>=0.11.4.0
, zip ^>=1.7.1
, zlib ^>=0.6.2.2 , zlib ^>=0.6.2.2
if (flag(internal-downloader) && !os(windows)) if (flag(internal-downloader) && !os(windows))
@@ -186,9 +184,12 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded -fwarn-incomplete-record-updates -threaded
build-depends: build-depends:
, aeson >=1.4 && <1.6
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3 , async ^>=2.2.3
, base >=4.13 && <5 , base >=4.13 && <5
, bytestring ^>=0.10 , bytestring ^>=0.10
, cabal-plan ^>=0.7.2
, containers ^>=0.6 , containers ^>=0.6
, deepseq ^>=1.4 , deepseq ^>=1.4
, filepath ^>=1.4.2.1 , filepath ^>=1.4.2.1
@@ -204,7 +205,6 @@ executable ghcup
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, string-interpolate >=0.2.0.0 && <0.4
, template-haskell >=2.7 && <2.18 , template-haskell >=2.7 && <2.18
, text ^>=1.2.4.0 , text ^>=1.2.4.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
@@ -268,7 +268,6 @@ executable ghcup-gen
, regex-posix ^>=0.96 , regex-posix ^>=0.96
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, string-interpolate >=0.2.0.0 && <0.4
, text ^>=1.2.4.0 , text ^>=1.2.4.0
, transformers ^>=0.5 , transformers ^>=0.5
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1

View File

@@ -58,10 +58,8 @@ import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.List import Data.List
import Data.List.Extra
import Data.Maybe import Data.Maybe
import Data.String ( fromString ) import Data.String ( fromString )
import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Format.ISO8601 import Data.Time.Format.ISO8601
@@ -90,6 +88,7 @@ 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
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32 import qualified System.Win32.File as Win32
@@ -202,7 +201,7 @@ installGHCBindist :: ( MonadFail m
installGHCBindist dlinfo ver isoFilepath = do installGHCBindist dlinfo ver isoFilepath = do
let tver = mkTVer ver let tver = mkTVer ver
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] lift $ $(logDebug) $ "Requested to install GHC with " <> prettyVer ver
case isoFilepath of case isoFilepath of
-- we only care for already installed errors in regular (non-isolated) installs -- we only care for already installed errors in regular (non-isolated) installs
@@ -219,7 +218,7 @@ installGHCBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|] lift $ $(logInfo) $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
@@ -417,7 +416,7 @@ installCabalBindist :: ( MonadMask m
m m
() ()
installCabalBindist dlinfo ver isoFilepath = do installCabalBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -448,7 +447,7 @@ installCabalBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir
liftE $ installCabalUnpacked workdir isoDir Nothing liftE $ installCabalUnpacked workdir isoDir Nothing
Nothing -> do -- regular install Nothing -> do -- regular install
@@ -473,6 +472,9 @@ installCabalUnpacked path inst mver' = do
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver' <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
<> exeExt <> exeExt
let destPath = inst </> destFileName let destPath = inst </> destFileName
liftE $ throwIfFileAlreadyExists destPath
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile <> exeExt) (path </> cabalFile <> exeExt)
destPath destPath
@@ -542,11 +544,12 @@ installHLSBindist :: ( MonadMask m
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, ArchiveResult , ArchiveResult
, FileAlreadyExistsError
] ]
m m
() ()
installHLSBindist dlinfo ver isoFilepath = do installHLSBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) [i|Requested to install hls version #{ver}|] lift $ $(logDebug) $ "Requested to install hls version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -572,7 +575,7 @@ installHLSBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do Just isoDir -> do
lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] lift $ $(logInfo) $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpacked workdir isoDir Nothing liftE $ installHLSUnpacked workdir isoDir Nothing
Nothing -> do Nothing -> do
@@ -589,7 +592,7 @@ installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Maybe Version -- ^ Nothing for isolated install
-> Excepts '[CopyError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked path inst mver' = do installHLSUnpacked path inst mver' = do
lift $ $(logInfo) "Installing HLS" lift $ $(logInfo) "Installing HLS"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
@@ -605,20 +608,32 @@ installHLSUnpacked path inst mver' = do
let toF = dropSuffix exeExt f let toF = dropSuffix exeExt f
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver' <> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
<> exeExt <> exeExt
let srcPath = path </> f
let destPath = inst </> toF
liftE $ throwIfFileAlreadyExists destPath
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> f) srcPath
(inst </> toF) destPath
lift $ chmod_755 (inst </> toF) lift $ chmod_755 destPath
-- install haskell-language-server-wrapper -- install haskell-language-server-wrapper
let wrapper = "haskell-language-server-wrapper" let wrapper = "haskell-language-server-wrapper"
toF = wrapper toF = wrapper
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver' <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
<> exeExt <> exeExt
srcWrapperPath = path </> wrapper <> exeExt
destWrapperPath = inst </> toF
liftE $ throwIfFileAlreadyExists destWrapperPath
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> wrapper <> exeExt) srcWrapperPath
(inst </> toF) destWrapperPath
lift $ chmod_755 (inst </> toF)
lift $ chmod_755 destWrapperPath
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@ -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -647,6 +662,7 @@ installHLSBin :: ( MonadMask m
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, ArchiveResult , ArchiveResult
, FileAlreadyExistsError
] ]
m m
() ()
@@ -683,6 +699,7 @@ installStackBin :: ( MonadMask m
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, ArchiveResult , ArchiveResult
, FileAlreadyExistsError
] ]
m m
() ()
@@ -718,11 +735,12 @@ installStackBindist :: ( MonadMask m
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, ArchiveResult , ArchiveResult
, FileAlreadyExistsError
] ]
m m
() ()
installStackBindist dlinfo ver isoFilepath = do installStackBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) [i|Requested to install stack version #{ver}|] lift $ $(logDebug) $ "Requested to install stack version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -747,7 +765,7 @@ installStackBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] lift $ $(logInfo) $ "isolated installing Stack to " <> T.pack isoDir
liftE $ installStackUnpacked workdir isoDir Nothing liftE $ installStackUnpacked workdir isoDir Nothing
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installStackUnpacked workdir binDir (Just ver) liftE $ installStackUnpacked workdir binDir (Just ver)
@@ -763,7 +781,7 @@ installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated installs -> Maybe Version -- ^ Nothing for isolated installs
-> Excepts '[CopyError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked path inst mver' = do installStackUnpacked path inst mver' = do
lift $ $(logInfo) "Installing stack" lift $ $(logInfo) "Installing stack"
let stackFile = "stack" let stackFile = "stack"
@@ -771,7 +789,10 @@ installStackUnpacked path inst mver' = do
let destFileName = stackFile let destFileName = stackFile
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver' <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
<> exeExt <> exeExt
let destPath = inst </> destFileName destPath = inst </> destFileName
liftE $ throwIfFileAlreadyExists destPath
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> stackFile <> exeExt) (path </> stackFile <> exeExt)
destPath destPath
@@ -829,7 +850,7 @@ setGHC ver sghc = do
SetGHCOnly -> pure $ Just file SetGHCOnly -> pure $ Just file
SetGHC_XY -> do SetGHC_XY -> do
handle handle
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
$ do $ do
(mj, mi) <- getMajorMinorV (_tvVersion ver) (mj, mi) <- getMajorMinorV (_tvVersion ver)
let major' = intToText mj <> "." <> intToText mi let major' = intToText mj <> "." <> intToText mi
@@ -871,9 +892,9 @@ setGHC ver sghc = do
whenM (liftIO $ doesDirectoryExist fullsharedir) $ do whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
let fullF = destdir </> sharedir let fullF = destdir </> sharedir
let targetF = "." </> "ghc" </> ver' </> sharedir let targetF = "." </> "ghc" </> ver' </> sharedir
$(logDebug) [i|rm -f #{fullF}|] $(logDebug) $ "rm -f " <> T.pack fullF
hideError doesNotExistErrorType $ rmDirectoryLink fullF hideError doesNotExistErrorType $ rmDirectoryLink fullF
$(logDebug) [i|ln -s #{targetF} #{fullF}|] $(logDebug) $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
liftIO liftIO
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
-- On windows we need to be more permissive -- On windows we need to be more permissive
@@ -939,7 +960,7 @@ setHLS ver = do
-- selected version, so we could end up with stray or incorrect symlinks. -- selected version, so we could end up with stray or incorrect symlinks.
oldSyms <- lift hlsSymlinks oldSyms <- lift hlsSymlinks
forM_ oldSyms $ \f -> do forM_ oldSyms $ \f -> do
lift $ $(logDebug) [i|rm #{binDir </> f}|] lift $ $(logDebug) $ "rm " <> T.pack (binDir </> f)
lift $ rmLink (binDir </> f) lift $ rmLink (binDir </> f)
-- set haskell-language-server-<ghcver> symlinks -- set haskell-language-server-<ghcver> symlinks
@@ -1126,7 +1147,7 @@ listVersions lt' criteria = do
} }
Left e -> do Left e -> do
$(logWarn) $(logWarn)
[i|Could not parse version of stray directory #{e}|] $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
strayCabals :: ( MonadReader env m strayCabals :: ( MonadReader env m
@@ -1161,7 +1182,7 @@ listVersions lt' criteria = do
} }
Left e -> do Left e -> do
$(logWarn) $(logWarn)
[i|Could not parse version of stray directory #{e}|] $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
strayHLS :: ( MonadReader env m strayHLS :: ( MonadReader env m
@@ -1195,7 +1216,7 @@ listVersions lt' criteria = do
} }
Left e -> do Left e -> do
$(logWarn) $(logWarn)
[i|Could not parse version of stray directory #{e}|] $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
strayStacks :: ( MonadReader env m strayStacks :: ( MonadReader env m
@@ -1230,7 +1251,7 @@ listVersions lt' criteria = do
} }
Left e -> do Left e -> do
$(logWarn) $(logWarn)
[i|Could not parse version of stray directory #{e}|] $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
@@ -1373,23 +1394,23 @@ rmGHCVer ver = do
-- this isn't atomic, order matters -- this isn't atomic, order matters
when isSetGHC $ do when isSetGHC $ do
lift $ $(logInfo) [i|Removing ghc symlinks|] lift $ $(logInfo) "Removing ghc symlinks"
liftE $ rmPlain (_tvTarget ver) liftE $ rmPlain (_tvTarget ver)
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|] lift $ $(logInfo) "Removing ghc-x.y.z symlinks"
liftE $ rmMinorSymlinks ver liftE $ rmMinorSymlinks ver
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|] lift $ $(logInfo) "Removing/rewiring ghc-x.y symlinks"
-- first remove -- first remove
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
-- then fix them (e.g. with an earlier version) -- then fix them (e.g. with an earlier version)
lift $ $(logInfo) [i|Removing directory recursively: #{dir}|] lift $ $(logInfo) $ "Removing directory recursively: " <> T.pack dir
lift $ recyclePathForcibly dir lift $ recyclePathForcibly dir
v' <- v' <-
handle handle
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
$ fmap Just $ fmap Just
$ getMajorMinorV (_tvVersion ver) $ getMajorMinorV (_tvVersion ver)
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver)) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
@@ -1460,7 +1481,7 @@ rmHLSVer ver = do
oldSyms <- lift hlsSymlinks oldSyms <- lift hlsSymlinks
forM_ oldSyms $ \f -> do forM_ oldSyms $ \f -> do
let fullF = binDir </> f let fullF = binDir </> f
lift $ $(logDebug) [i|rm #{fullF}|] lift $ $(logDebug) $ "rm " <> T.pack fullF
lift $ rmLink fullF lift $ rmLink fullF
-- set latest hls -- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs hlsVers <- lift $ fmap rights getInstalledHLSs
@@ -1603,7 +1624,7 @@ rmGhcupDirs = do
handleRm $ rmBinDir binDir handleRm $ rmBinDir binDir
handleRm $ rmDir recycleDir handleRm $ rmDir recycleDir
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
$logInfo [i|removing #{(baseDir </> "msys64")}|] $logInfo $ "removing " <> T.pack (baseDir </> "msys64")
handleRm $ rmPathForcibly (baseDir </> "msys64") handleRm $ rmPathForcibly (baseDir </> "msys64")
#endif #endif
@@ -1615,8 +1636,8 @@ rmGhcupDirs = do
where where
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m () handleRm :: (MonadCatch m, MonadLogger m) => m () -> m ()
handleRm = handleIO (\e -> $logDebug [i|Part of the cleanup action failed with error: #{displayException e} handleRm = handleIO (\e -> $logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
continuing regardless...|]) <> "continuing regardless...")
rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmEnvFile enFilePath = do rmEnvFile enFilePath = do
@@ -1634,7 +1655,7 @@ continuing regardless...|])
-- an error leaks through, we catch it here as well, -- an error leaks through, we catch it here as well,
-- althought 'deleteFile' should already handle it. -- althought 'deleteFile' should already handle it.
hideErrorDef [doesNotExistErrorType] () $ do hideErrorDef [doesNotExistErrorType] () $ do
$logInfo [i|removing #{dir}|] $logInfo $ "removing " <> T.pack dir
contents <- liftIO $ getDirectoryContentsRecursive dir contents <- liftIO $ getDirectoryContentsRecursive dir
forM_ contents (deleteFile . (dir </>)) forM_ contents (deleteFile . (dir </>))
@@ -1783,7 +1804,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(workdir, tmpUnpack, tver) <- case targetGhc of (workdir, tmpUnpack, tver) <- case targetGhc of
-- unpack from version tarball -- unpack from version tarball
Left tver -> do Left tver -> do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|] lift $ $(logDebug) $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
-- download source tarball -- download source tarball
dlInfo <- dlInfo <-
@@ -1808,7 +1829,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
lift $ $(logInfo) [i|Fetching git repo #{rep} at ref #{ref} (this may take a while)|] lift $ $(logInfo) $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ] lEM $ git [ "init" ]
lEM $ git [ "remote" lEM $ git [ "remote"
, "add" , "add"
@@ -1835,7 +1856,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr)) ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|] lift $ $(logInfo) $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver) pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
-- the version that's installed may differ from the -- the version that's installed may differ from the
@@ -1847,9 +1868,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
when alreadyInstalled $ do when alreadyInstalled $ do
case isolateDir of case isolateDir of
Just isoDir -> Just isoDir ->
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |] lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
Nothing -> Nothing ->
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|] lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
lift $ $(logWarn) lift $ $(logWarn)
"...waiting for 10 seconds before continuing, you can still abort..." "...waiting for 10 seconds before continuing, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene liftIO $ threadDelay 10000000 -- give the user a sec to intervene
@@ -1877,7 +1898,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
Nothing -> Nothing ->
-- only remove old ghc in regular installs -- only remove old ghc in regular installs
when alreadyInstalled $ do when alreadyInstalled $ do
lift $ $(logInfo) [i|Deleting existing installation|] lift $ $(logInfo) "Deleting existing installation"
liftE $ rmGHCVer tver liftE $ rmGHCVer tver
_ -> pure () _ -> pure ()
@@ -1952,11 +1973,11 @@ endif|]
liftE $ configureBindist bghc tver workdir ghcdir liftE $ configureBindist bghc tver workdir ghcdir
lift $ $(logInfo) [i|Building (this may take a while)...|] lift $ $(logInfo) "Building (this may take a while)..."
hadrian_build <- liftE $ findHadrianFile workdir hadrian_build <- liftE $ findHadrianFile workdir
lEM $ execLogged hadrian_build lEM $ execLogged hadrian_build
( maybe [] (\j -> [[i|-j#{j}|]] ) jobs ( maybe [] (\j -> ["-j" <> show j] ) jobs
++ maybe [] (\bf -> [[i|--flavour=#{bf}|]]) buildFlavour ++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
++ ["binary-dist"] ++ ["binary-dist"]
) )
(Just workdir) "ghc-make" Nothing (Just workdir) "ghc-make" Nothing
@@ -2018,19 +2039,19 @@ endif|]
(FileDoesNotExistError bc) (FileDoesNotExistError bc)
(liftIO $ copyFile bc (build_mk workdir)) (liftIO $ copyFile bc (build_mk workdir))
Nothing -> Nothing ->
liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf) liftIO $ T.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
liftE $ checkBuildConfig (build_mk workdir) liftE $ checkBuildConfig (build_mk workdir)
lift $ $(logInfo) [i|Building (this may take a while)...|] lift $ $(logInfo) "Building (this may take a while)..."
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir) lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
if | isCross tver -> do if | isCross tver -> do
lift $ $(logInfo) [i|Installing cross toolchain...|] lift $ $(logInfo) "Installing cross toolchain..."
lEM $ make ["install"] (Just workdir) lEM $ make ["install"] (Just workdir)
pure Nothing pure Nothing
| otherwise -> do | otherwise -> do
lift $ $(logInfo) [i|Creating bindist...|] lift $ $(logInfo) "Creating bindist..."
lEM $ make ["binary-dist"] (Just workdir) lEM $ make ["binary-dist"] (Just workdir)
[tar] <- liftIO $ findFiles [tar] <- liftIO $ findFiles
workdir workdir
@@ -2071,11 +2092,20 @@ endif|]
. SHA256.hashlazy . SHA256.hashlazy
$ c $ c
cTime <- liftIO getCurrentTime cTime <- liftIO getCurrentTime
let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|] let tarName = makeValid ("ghc-"
<> T.unpack (tVerToText tver)
<> "-"
<> pfReqToString pfreq
<> "-"
<> iso8601Show cTime
<> "-"
<> T.unpack cDigest
<> ".tar"
<> takeExtension tar)
let tarPath = cacheDir </> tarName let tarPath = cacheDir </> tarName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
tarPath tarPath
lift $ $(logInfo) [i|Copied bindist to #{tarPath}|] lift $ $(logInfo) $ "Copied bindist to " <> T.pack tarPath
pure tarPath pure tarPath
checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m) checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
@@ -2100,13 +2130,12 @@ endif|]
_ -> pure () _ -> pure ()
forM_ buildFlavour $ \bf -> forM_ buildFlavour $ \bf ->
when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do
lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|] lift $ $(logWarn) $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
liftIO $ threadDelay 5000000 liftIO $ threadDelay 5000000
addBuildFlavourToConf bc = case buildFlavour of addBuildFlavourToConf bc = case buildFlavour of
Just bf -> [i|BuildFlavour = #{bf} Just bf -> "BuildFlavour = " <> T.pack bf <> "\n" <> bc
|] <> [i|#{bc}|]
Nothing -> bc Nothing -> bc
isCross :: GHCTargetVersion -> Bool isCross :: GHCTargetVersion -> Bool
@@ -2224,7 +2253,7 @@ upgradeGHCup mtarget force' = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ $(logInfo) [i|Upgrading GHCup...|] lift $ $(logInfo) "Upgrading GHCup..."
let latestVer = fromJust $ fst <$> getLatest dls GHCup let latestVer = fromJust $ fst <$> getLatest dls GHCup
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -2233,20 +2262,28 @@ upgradeGHCup mtarget force' = do
p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
let destDir = takeDirectory destFile let destDir = takeDirectory destFile
destFile = fromMaybe (binDir </> fn) mtarget destFile = fromMaybe (binDir </> fn) mtarget
lift $ $(logDebug) [i|mkdir -p #{destDir}|] lift $ $(logDebug) $ "mkdir -p " <> T.pack destDir
liftIO $ createDirRecursive' destDir liftIO $ createDirRecursive' destDir
lift $ $(logDebug) [i|rm -f #{destFile}|] lift $ $(logDebug) $ "rm -f " <> T.pack destFile
lift $ hideError NoSuchThing $ recycleFile destFile lift $ hideError NoSuchThing $ recycleFile destFile
lift $ $(logDebug) [i|cp #{p} #{destFile}|] lift $ $(logDebug) $ "cp " <> T.pack p <> " " <> T.pack destFile
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
destFile destFile
lift $ chmod_755 destFile lift $ chmod_755 destFile
liftIO (isInPath destFile) >>= \b -> unless b $ liftIO (isInPath destFile) >>= \b -> unless b $
lift $ $(logWarn) [i|"#{takeFileName destFile}" is not in PATH! You have to add it in order to use ghcup.|] lift $ $(logWarn) $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
liftIO (isShadowed destFile) >>= \case liftIO (isShadowed destFile) >>= \case
Nothing -> pure () Nothing -> pure ()
Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{pa}". The upgrade will not be in effect, unless you remove "#{pa}" or make sure "#{destDir}" comes before "#{takeFileName pa}" in PATH.|] Just pa -> lift $ $(logWarn) $ "ghcup is shadowed by "
<> T.pack pa
<> ". The upgrade will not be in effect, unless you remove "
<> T.pack pa
<> " or make sure "
<> T.pack destDir
<> " comes before "
<> T.pack (takeFileName pa)
<> " in PATH."
pure latestVer pure latestVer
@@ -2278,7 +2315,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
-- Create ghc-x.y symlinks. This may not be the current -- Create ghc-x.y symlinks. This may not be the current
-- version, create it regardless. -- version, create it regardless.
v' <- v' <-
handle (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) handle (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
$ fmap Just $ fmap Just
$ getMajorMinorV _tvVersion $ getMajorMinorV _tvVersion
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
@@ -2332,3 +2369,10 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
liftIO $ canonicalizePath currentRunningExecPath liftIO $ canonicalizePath currentRunningExecPath
throwIfFileAlreadyExists :: ( MonadIO m ) =>
FilePath ->
Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists fp = whenM (checkFileAlreadyExists fp)
(throwE $ FileAlreadyExistsError fp)

View File

@@ -57,9 +57,8 @@ import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( mk ) import Data.CaseInsensitive ( mk )
#endif #endif
import Data.List.Extra
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.List
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Data.Versions import Data.Versions
@@ -73,6 +72,7 @@ import Prelude hiding ( abs
, readFile , readFile
, writeFile , writeFile
) )
import Safe
import System.Directory import System.Directory
import System.Environment import System.Environment
import System.Exit import System.Exit
@@ -187,13 +187,13 @@ getBase uri = do
-- if we didn't get a filepath from the download, use the cached yaml -- if we didn't get a filepath from the download, use the cached yaml
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
lift $ $(logDebug) [i|Decoding yaml at: #{actualYaml}|] lift $ $(logDebug) $ "Decoding yaml at: " <> T.pack actualYaml
liftE liftE
. onE_ (onError actualYaml) . onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] JSONDecodeError . lEM' @_ @_ @'[JSONError] JSONDecodeError
. fmap (first (\e -> [i|#{displayException e} . fmap (first (\e -> unlines [displayException e
Consider removing "#{actualYaml}" manually.|])) ,"Consider removing " <> actualYaml <> " manually."]))
. liftIO . liftIO
. Y.decodeFileEither . Y.decodeFileEither
$ actualYaml $ actualYaml
@@ -203,12 +203,12 @@ Consider removing "#{actualYaml}" manually.|]))
onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m () onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do onError fp = do
let efp = etagsFile fp let efp = etagsFile fp
handleIO (\e -> $(logWarn) [i|Couldn't remove file #{efp}, error was: #{displayException e}|]) handleIO (\e -> $(logWarn) $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
(hideError doesNotExistErrorType $ rmFile efp) (hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0)) liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
warnCache s = do warnCache s = do
lift $ $(logWarn) [i|Could not get download info, trying cached version (this may not be recent!)|] lift $ $(logWarn) "Could not get download info, trying cached version (this may not be recent!)"
lift $ $(logDebug) [i|Error was: #{s}|] lift $ $(logDebug) $ "Error was: " <> T.pack s
-- First check if the json file is in the ~/.ghcup/cache dir -- First check if the json file is in the ~/.ghcup/cache dir
-- and check it's access time. If it has been accessed within the -- and check it's access time. If it has been accessed within the
@@ -327,7 +327,7 @@ download uri eDigest dest mfn etags
| scheme == "http" = dl | scheme == "http" = dl
| scheme == "file" = do | scheme == "file" = do
let destFile' = T.unpack . decUTF8Safe $ path let destFile' = T.unpack . decUTF8Safe $ path
lift $ $(logDebug) [i|using local file: #{destFile'}|] lift $ $(logDebug) $ "using local file: " <> T.pack destFile'
forM_ eDigest (liftE . flip checkDigest destFile') forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile' pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
@@ -336,7 +336,7 @@ download uri eDigest dest mfn etags
scheme = view (uriSchemeL' % schemeBSL') uri scheme = view (uriSchemeL' % schemeBSL') uri
dl = do dl = do
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|] lift $ $(logInfo) $ "downloading: " <> uri' <> " as file " <> T.pack destFile
-- destination dir must exist -- destination dir must exist
liftIO $ createDirRecursive' dest liftIO $ createDirRecursive' dest
@@ -362,7 +362,7 @@ download uri eDigest dest mfn etags
metag <- readETag destFile metag <- readETag destFile
liftE $ lEM @_ @'[ProcessError] $ exec "curl" liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ (if etags then ["--dump-header", dh] else []) (o' ++ (if etags then ["--dump-header", dh] else [])
++ maybe [] (\t -> ["-H", [i|If-None-Match: #{t}|]]) metag ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing ++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
headers <- liftIO $ T.readFile dh headers <- liftIO $ T.readFile dh
@@ -371,9 +371,9 @@ download uri eDigest dest mfn etags
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
Just (http':sc:_) Just (http':sc:_)
| sc == "304" | sc == "304"
, T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug [i|Status code was 304, not overwriting|] , T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug "Status code was 304, not overwriting"
| T.pack "HTTP" `T.isPrefixOf` http' -> do | T.pack "HTTP" `T.isPrefixOf` http' -> do
$logDebug [i|Status code was #{sc}, overwriting|] $logDebug $ "Status code was " <> sc <> ", overwriting"
liftIO $ copyFile (destFile <.> "tmp") destFile liftIO $ copyFile (destFile <.> "tmp") destFile
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers) _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
:: V '[MalformedHeaders])) :: V '[MalformedHeaders]))
@@ -389,7 +389,7 @@ download uri eDigest dest mfn etags
if etags if etags
then do then do
metag <- readETag destFile metag <- readETag destFile
let opts = o' ++ maybe [] (\t -> ["--header", [i|If-None-Match: #{t}|]]) metag let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri'] ++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
case _exitCode of case _exitCode of
@@ -453,7 +453,7 @@ download uri eDigest dest mfn etags
$logDebug "Couldn't parse etags, no input: " $logDebug "Couldn't parse etags, no input: "
pure Nothing pure Nothing
(Just [_, etag']) -> do (Just [_, etag']) -> do
$logDebug [i|Parsed etag: #{etag'}|] $logDebug $ "Parsed etag: " <> etag'
pure (Just etag') pure (Just etag')
(Just xs) -> do (Just xs) -> do
$logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs) $logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
@@ -466,10 +466,10 @@ download uri eDigest dest mfn etags
writeEtags destFile getTags = do writeEtags destFile getTags = do
getTags >>= \case getTags >>= \case
Just t -> do Just t -> do
$logDebug [i|Writing etagsFile #{(etagsFile destFile)}|] $logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
liftIO $ T.writeFile (etagsFile destFile) t liftIO $ T.writeFile (etagsFile destFile) t
Nothing -> Nothing ->
$logDebug [i|No etags files written|] $logDebug "No etags files written"
readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text) readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
readETag fp = do readETag fp = do
@@ -479,13 +479,13 @@ download uri eDigest dest mfn etags
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp) rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
case rE of case rE of
(Right et) -> do (Right et) -> do
$logDebug [i|Read etag: #{et}|] $logDebug $ "Read etag: " <> et
pure (Just et) pure (Just et)
(Left _) -> do (Left _) -> do
$logDebug [i|Etag file doesn't exist (yet)|] $logDebug "Etag file doesn't exist (yet)"
pure Nothing pure Nothing
else do else do
$logDebug [i|Skipping and deleting etags file because destination file #{fp} doesn't exist|] $logDebug $ "Skipping and deleting etags file because destination file " <> T.pack fp <> " doesn't exist"
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp) liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
pure Nothing pure Nothing
@@ -563,7 +563,7 @@ checkDigest eDigest file = do
let verify = not noVerify let verify = not noVerify
when verify $ do when verify $ do
let p' = takeFileName file let p' = takeFileName file
lift $ $(logInfo) [i|verifying digest of: #{p'}|] lift $ $(logInfo) $ "verifying digest of: " <> T.pack p'
c <- liftIO $ L.readFile file c <- liftIO $ L.readFile file
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)

View File

@@ -4,7 +4,6 @@
{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
@@ -25,7 +24,6 @@ import Codec.Archive
import Control.Exception.Safe import Control.Exception.Safe
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( CI )
import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import Haskus.Utils.Variant import Haskus.Utils.Variant
@@ -34,6 +32,7 @@ import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString import URI.ByteString
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T
@@ -51,7 +50,7 @@ instance Pretty NoCompatiblePlatform where
pPrint (NoCompatiblePlatform str') = pPrint (NoCompatiblePlatform str') =
text ("Could not find a compatible platform. Got: " ++ str') text ("Could not find a compatible platform. Got: " ++ str')
-- | Unable to find a download for the requested versio/distro. -- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload data NoDownload = NoDownload
deriving Show deriving Show
@@ -88,7 +87,7 @@ data UnknownArchive = UnknownArchive FilePath
instance Pretty UnknownArchive where instance Pretty UnknownArchive where
pPrint (UnknownArchive file) = pPrint (UnknownArchive file) =
text [i|The archive format is unknown. We don't know how to extract the file "#{file}"|] text $ "The archive format is unknown. We don't know how to extract the file " <> file
-- | The scheme is not supported (such as ftp). -- | The scheme is not supported (such as ftp).
data UnsupportedScheme = UnsupportedScheme data UnsupportedScheme = UnsupportedScheme
@@ -111,7 +110,7 @@ data TagNotFound = TagNotFound Tag Tool
instance Pretty TagNotFound where instance Pretty TagNotFound where
pPrint (TagNotFound tag tool) = pPrint (TagNotFound tag tool) =
text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|] text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
-- | Unable to find the next version of a tool (the one after the currently -- | Unable to find the next version of a tool (the one after the currently
-- set one). -- set one).
@@ -120,7 +119,7 @@ data NextVerNotFound = NextVerNotFound Tool
instance Pretty NextVerNotFound where instance Pretty NextVerNotFound where
pPrint (NextVerNotFound tool) = pPrint (NextVerNotFound tool) =
text [i|Unable to find next (the one after the currently set one) version of tool "#{tool}"|] text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
-- | The tool (such as GHC) is already installed with that version. -- | The tool (such as GHC) is already installed with that version.
data AlreadyInstalled = AlreadyInstalled Tool Version data AlreadyInstalled = AlreadyInstalled Tool Version
@@ -128,14 +127,14 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
instance Pretty AlreadyInstalled where instance Pretty AlreadyInstalled where
pPrint (AlreadyInstalled tool ver') = pPrint (AlreadyInstalled tool ver') =
text [i|#{tool}-#{prettyShow ver'} is already installed|] pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
-- | The Directory is supposed to be empty, but wasn't. -- | The Directory is supposed to be empty, but wasn't.
data DirNotEmpty = DirNotEmpty {path :: FilePath} data DirNotEmpty = DirNotEmpty {path :: FilePath}
instance Pretty DirNotEmpty where instance Pretty DirNotEmpty where
pPrint (DirNotEmpty path) = do pPrint (DirNotEmpty path) = do
text [i|The directory was expected to be empty, but isn't: #{path}|] text $ "The directory was expected to be empty, but isn't: " <> path
-- | The tool is not installed. Some operations rely on a tool -- | The tool is not installed. Some operations rely on a tool
-- to be installed (such as setting the current GHC version). -- to be installed (such as setting the current GHC version).
@@ -144,7 +143,7 @@ data NotInstalled = NotInstalled Tool GHCTargetVersion
instance Pretty NotInstalled where instance Pretty NotInstalled where
pPrint (NotInstalled tool ver) = pPrint (NotInstalled tool ver) =
text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|] text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
-- | An executable was expected to be in PATH, but was not found. -- | An executable was expected to be in PATH, but was not found.
data NotFoundInPATH = NotFoundInPATH FilePath data NotFoundInPATH = NotFoundInPATH FilePath
@@ -152,7 +151,7 @@ data NotFoundInPATH = NotFoundInPATH FilePath
instance Pretty NotFoundInPATH where instance Pretty NotFoundInPATH where
pPrint (NotFoundInPATH exe) = pPrint (NotFoundInPATH exe) =
text [i|The exe "#{exe}" was not found in PATH.|] text $ "The exe " <> exe <> " was not found in PATH."
-- | JSON decoding failed. -- | JSON decoding failed.
data JSONError = JSONDecodeError String data JSONError = JSONDecodeError String
@@ -160,7 +159,7 @@ data JSONError = JSONDecodeError String
instance Pretty JSONError where instance Pretty JSONError where
pPrint (JSONDecodeError err) = pPrint (JSONDecodeError err) =
text [i|JSON decoding failed with: #{err}|] text $ "JSON decoding failed with: " <> err
-- | A file that is supposed to exist does not exist -- | A file that is supposed to exist does not exist
-- (e.g. when we use file scheme to "download" something). -- (e.g. when we use file scheme to "download" something).
@@ -169,7 +168,7 @@ data FileDoesNotExistError = FileDoesNotExistError FilePath
instance Pretty FileDoesNotExistError where instance Pretty FileDoesNotExistError where
pPrint (FileDoesNotExistError file) = pPrint (FileDoesNotExistError file) =
text [i|File "#{file}" does not exist.|] text $ "File " <> file <> " does not exist."
-- | The file already exists -- | The file already exists
-- (e.g. when we use isolated installs with the same path). -- (e.g. when we use isolated installs with the same path).
@@ -179,7 +178,7 @@ data FileAlreadyExistsError = FileAlreadyExistsError FilePath
instance Pretty FileAlreadyExistsError where instance Pretty FileAlreadyExistsError where
pPrint (FileAlreadyExistsError file) = pPrint (FileAlreadyExistsError file) =
text [i|File "#{file}" Already exists.|] text $ "File " <> file <> " Already exists."
data TarDirDoesNotExist = TarDirDoesNotExist TarDir data TarDirDoesNotExist = TarDirDoesNotExist TarDir
deriving Show deriving Show
@@ -194,7 +193,7 @@ data DigestError = DigestError Text Text
instance Pretty DigestError where instance Pretty DigestError where
pPrint (DigestError currentDigest expectedDigest) = pPrint (DigestError currentDigest expectedDigest) =
text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|] text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString) data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
@@ -202,7 +201,7 @@ data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
instance Pretty HTTPStatusError where instance Pretty HTTPStatusError where
pPrint (HTTPStatusError status _) = pPrint (HTTPStatusError status _) =
text [i|Unexpected HTTP status: #{status}|] text "Unexpected HTTP status:" <+> pPrint status
-- | Malformed headers. -- | Malformed headers.
data MalformedHeaders = MalformedHeaders Text data MalformedHeaders = MalformedHeaders Text
@@ -210,7 +209,7 @@ data MalformedHeaders = MalformedHeaders Text
instance Pretty MalformedHeaders where instance Pretty MalformedHeaders where
pPrint (MalformedHeaders h) = pPrint (MalformedHeaders h) =
text [i|Headers are malformed: #{h}|] text "Headers are malformed: " <+> pPrint h
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPNotModified = HTTPNotModified Text data HTTPNotModified = HTTPNotModified Text
@@ -218,7 +217,7 @@ data HTTPNotModified = HTTPNotModified Text
instance Pretty HTTPNotModified where instance Pretty HTTPNotModified where
pPrint (HTTPNotModified etag) = pPrint (HTTPNotModified etag) =
text [i|Remote resource not modifed, etag was: #{etag}|] text "Remote resource not modifed, etag was:" <+> pPrint etag
-- | The 'Location' header was expected during a 3xx redirect, but not found. -- | The 'Location' header was expected during a 3xx redirect, but not found.
data NoLocationHeader = NoLocationHeader data NoLocationHeader = NoLocationHeader
@@ -226,7 +225,7 @@ data NoLocationHeader = NoLocationHeader
instance Pretty NoLocationHeader where instance Pretty NoLocationHeader where
pPrint NoLocationHeader = pPrint NoLocationHeader =
text [i|The 'Location' header was expected during a 3xx redirect, but not found.|] text "The 'Location' header was expected during a 3xx redirect, but not found."
-- | Too many redirects. -- | Too many redirects.
data TooManyRedirs = TooManyRedirs data TooManyRedirs = TooManyRedirs
@@ -234,7 +233,7 @@ data TooManyRedirs = TooManyRedirs
instance Pretty TooManyRedirs where instance Pretty TooManyRedirs where
pPrint TooManyRedirs = pPrint TooManyRedirs =
text [i|Too many redirections.|] text "Too many redirections."
-- | A patch could not be applied. -- | A patch could not be applied.
data PatchFailed = PatchFailed data PatchFailed = PatchFailed
@@ -242,7 +241,7 @@ data PatchFailed = PatchFailed
instance Pretty PatchFailed where instance Pretty PatchFailed where
pPrint PatchFailed = pPrint PatchFailed =
text [i|A patch could not be applied.|] text "A patch could not be applied."
-- | The tool requirements could not be found. -- | The tool requirements could not be found.
data NoToolRequirements = NoToolRequirements data NoToolRequirements = NoToolRequirements
@@ -250,35 +249,35 @@ data NoToolRequirements = NoToolRequirements
instance Pretty NoToolRequirements where instance Pretty NoToolRequirements where
pPrint NoToolRequirements = pPrint NoToolRequirements =
text [i|The Tool requirements could not be found.|] text "The Tool requirements could not be found."
data InvalidBuildConfig = InvalidBuildConfig Text data InvalidBuildConfig = InvalidBuildConfig Text
deriving Show deriving Show
instance Pretty InvalidBuildConfig where instance Pretty InvalidBuildConfig where
pPrint (InvalidBuildConfig reason) = pPrint (InvalidBuildConfig reason) =
text [i|The build config is invalid. Reason was: #{reason}|] text "The build config is invalid. Reason was:" <+> pPrint reason
data NoToolVersionSet = NoToolVersionSet Tool data NoToolVersionSet = NoToolVersionSet Tool
deriving Show deriving Show
instance Pretty NoToolVersionSet where instance Pretty NoToolVersionSet where
pPrint (NoToolVersionSet tool) = pPrint (NoToolVersionSet tool) =
text [i|No version is set for tool "#{tool}".|] text "No version is set for tool" <+> pPrint tool <+> text "."
data NoNetwork = NoNetwork data NoNetwork = NoNetwork
deriving Show deriving Show
instance Pretty NoNetwork where instance Pretty NoNetwork where
pPrint NoNetwork = pPrint NoNetwork =
text [i|A download was required or requested, but '--offline' was specified.|] text "A download was required or requested, but '--offline' was specified."
data HadrianNotFound = HadrianNotFound data HadrianNotFound = HadrianNotFound
deriving Show deriving Show
instance Pretty HadrianNotFound where instance Pretty HadrianNotFound where
pPrint HadrianNotFound = pPrint HadrianNotFound =
text [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|] text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
------------------------- -------------------------
@@ -300,17 +299,17 @@ data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FileP
instance Pretty BuildFailed where instance Pretty BuildFailed where
pPrint (BuildFailed path reason) = pPrint (BuildFailed path reason) =
text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
deriving instance Show BuildFailed deriving instance Show BuildFailed
-- | Setting the current GHC version failed. -- | Setting the current GHC version failed.
data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es) data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es)
instance Pretty GHCupSetError where instance Pretty GHCupSetError where
pPrint (GHCupSetError reason) = pPrint (GHCupSetError reason) =
text [i|Setting the current GHC version failed: #{reason}|] text "Setting the current GHC version failed:" <+> pPrint reason
deriving instance Show GHCupSetError deriving instance Show GHCupSetError
@@ -326,7 +325,7 @@ data ParseError = ParseError String
instance Pretty ParseError where instance Pretty ParseError where
pPrint (ParseError reason) = pPrint (ParseError reason) =
text [i|Parsing failed: #{reason}|] text "Parsing failed:" <+> pPrint reason
instance Exception ParseError instance Exception ParseError
@@ -336,7 +335,7 @@ data UnexpectedListLength = UnexpectedListLength String
instance Pretty UnexpectedListLength where instance Pretty UnexpectedListLength where
pPrint (UnexpectedListLength reason) = pPrint (UnexpectedListLength reason) =
text [i|List length unexpected: #{reason}|] text "List length unexpected:" <+> pPrint reason
instance Exception UnexpectedListLength instance Exception UnexpectedListLength
@@ -345,7 +344,7 @@ data NoUrlBase = NoUrlBase Text
instance Pretty NoUrlBase where instance Pretty NoUrlBase where
pPrint (NoUrlBase url) = pPrint (NoUrlBase url) =
text [i|Couldn't get a base filename from url #{url}|] text "Couldn't get a base filename from url" <+> pPrint url
instance Exception NoUrlBase instance Exception NoUrlBase
@@ -370,21 +369,21 @@ instance
instance Pretty URIParseError where instance Pretty URIParseError where
pPrint (MalformedScheme reason) = pPrint (MalformedScheme reason) =
text [i|Failed to parse URI. Malformed scheme: #{reason}|] text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
pPrint MalformedUserInfo = pPrint MalformedUserInfo =
text [i|Failed to parse URI. Malformed user info.|] text "Failed to parse URI. Malformed user info."
pPrint MalformedQuery = pPrint MalformedQuery =
text [i|Failed to parse URI. Malformed query.|] text "Failed to parse URI. Malformed query."
pPrint MalformedFragment = pPrint MalformedFragment =
text [i|Failed to parse URI. Malformed fragment.|] text "Failed to parse URI. Malformed fragment."
pPrint MalformedHost = pPrint MalformedHost =
text [i|Failed to parse URI. Malformed host.|] text "Failed to parse URI. Malformed host."
pPrint MalformedPort = pPrint MalformedPort =
text [i|Failed to parse URI. Malformed port.|] text "Failed to parse URI. Malformed port."
pPrint MalformedPath = pPrint MalformedPath =
text [i|Failed to parse URI. Malformed path.|] text "Failed to parse URI. Malformed path."
pPrint (OtherError err) = pPrint (OtherError err) =
text [i|Failed to parse URI: #{err}|] text "Failed to parse URI:" <+> pPrint err
instance Pretty ArchiveResult where instance Pretty ArchiveResult where
pPrint ArchiveFatal = text "Archive result: fatal" pPrint ArchiveFatal = text "Archive result: fatal"
@@ -393,3 +392,6 @@ instance Pretty ArchiveResult where
pPrint ArchiveRetry = text "Archive result: retry" pPrint ArchiveRetry = text "Archive result: retry"
pPrint ArchiveOk = text "Archive result: Ok" pPrint ArchiveOk = text "Archive result: Ok"
pPrint ArchiveEOF = text "Archive result: EOF" pPrint ArchiveEOF = text "Archive result: EOF"
instance Pretty T.Text where
pPrint = text . T.unpack

View File

@@ -33,7 +33,6 @@ import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Foldable import Data.Foldable
import Data.Maybe import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
@@ -108,7 +107,7 @@ getPlatform = do
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing } "mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
what -> throwE $ NoCompatiblePlatform what what -> throwE $ NoCompatiblePlatform what
lift $ $(logDebug) [i|Identified Platform as: #{prettyShow pfr}|] lift $ $(logDebug) $ "Identified Platform as: " <> T.pack (prettyShow pfr)
pure pfr pure pfr
where where
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
@@ -139,12 +138,11 @@ getLinuxDistro = do
| hasWord name ["exherbo"] -> Exherbo | hasWord name ["exherbo"] -> Exherbo
| hasWord name ["gentoo"] -> Gentoo | hasWord name ["gentoo"] -> Gentoo
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
| hasWord name ["solus"] -> Solus
| otherwise -> UnknownLinux | otherwise -> UnknownLinux
pure (distro, parsedVer) pure (distro, parsedVer)
where where
hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y) hasWord t = any (\x -> match (regex x) (T.unpack t))
False
matches
where where
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|]) regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])

View File

@@ -115,6 +115,13 @@ data Tool = GHC
| Stack | Stack
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded) deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
instance Pretty Tool where
pPrint GHC = text "ghc"
pPrint Cabal = text "cabal"
pPrint GHCup = text "ghcup"
pPrint HLS = text "hls"
pPrint Stack = text "stack"
instance NFData Tool instance NFData Tool
data GlobalTool = ShimGen data GlobalTool = ShimGen
@@ -145,7 +152,7 @@ data Tag = Latest
| Recommended | Recommended
| Prerelease | Prerelease
| Base PVP | Base PVP
| Old -- ^ old version are hidden by default in TUI | Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -220,6 +227,7 @@ data LinuxDistro = Debian
| RedHat | RedHat
| Alpine | Alpine
| AmazonLinux | AmazonLinux
| Solus
-- rolling -- rolling
| Gentoo | Gentoo
| Exherbo | Exherbo
@@ -233,12 +241,13 @@ instance NFData LinuxDistro
distroToString :: LinuxDistro -> String distroToString :: LinuxDistro -> String
distroToString Debian = "debian" distroToString Debian = "debian"
distroToString Ubuntu = "ubuntu" distroToString Ubuntu = "ubuntu"
distroToString Mint= "mint" distroToString Mint = "mint"
distroToString Fedora = "fedora" distroToString Fedora = "fedora"
distroToString CentOS = "centos" distroToString CentOS = "centos"
distroToString RedHat = "redhat" distroToString RedHat = "redhat"
distroToString Alpine = "alpine" distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon" distroToString AmazonLinux = "amazon"
distroToString Solus = "solus"
distroToString Gentoo = "gentoo" distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo" distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown" distroToString UnknownLinux = "unknown"

View File

@@ -42,7 +42,7 @@ import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC import qualified Text.Megaparsec.Char as MPC
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit

View File

@@ -40,7 +40,6 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import Codec.Archive hiding ( Directory ) import Codec.Archive hiding ( Directory )
import Codec.Archive.Zip
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
@@ -59,10 +58,8 @@ import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.Foldable import Data.Foldable
import Data.List import Data.List
import Data.List.Extra
import Data.List.NonEmpty ( NonEmpty( (:|) )) import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.Maybe import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import GHC.IO.Exception import GHC.IO.Exception
@@ -130,7 +127,7 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
forM_ files $ \f -> do forM_ files $ \f -> do
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
let fullF = binDir </> f_xyz let fullF = binDir </> f_xyz
lift $ $(logDebug) [i|rm -f #{fullF}|] lift $ $(logDebug) ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
@@ -152,11 +149,11 @@ rmPlain target = do
files <- liftE $ ghcToolFiles tv files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do forM_ files $ \f -> do
let fullF = binDir </> f <> exeExt let fullF = binDir </> f <> exeExt
lift $ $(logDebug) [i|rm -f #{fullF}|] lift $ $(logDebug) ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
-- old ghcup -- old ghcup
let hdc_file = binDir </> "haddock-ghc" <> exeExt let hdc_file = binDir </> "haddock-ghc" <> exeExt
lift $ $(logDebug) [i|rm -f #{hdc_file}|] lift $ $(logDebug) ("rm -f " <> T.pack hdc_file)
lift $ hideError doesNotExistErrorType $ rmLink hdc_file lift $ hideError doesNotExistErrorType $ rmLink hdc_file
@@ -180,7 +177,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
forM_ files $ \f -> do forM_ files $ \f -> do
let f_xy = f <> "-" <> T.unpack v' <> exeExt let f_xy = f <> "-" <> T.unpack v' <> exeExt
let fullF = binDir </> f_xy let fullF = binDir </> f_xy
lift $ $(logDebug) [i|rm -f #{fullF}|] lift $ $(logDebug) "rm -f #{fullF}"
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
@@ -296,7 +293,11 @@ cabalSet = do
case linkVersion =<< link of case linkVersion =<< link of
Right v -> pure $ Just v Right v -> pure $ Just v
Left err -> do Left err -> do
$(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|] $(logWarn) $ "Failed to parse cabal symlink target with: "
<> T.pack (displayException err)
<> ". The symlink "
<> T.pack cabalbin
<> " needs to point to valid cabal binary, such as 'cabal-3.4.0.0'."
pure Nothing pure Nothing
where where
-- We try to be extra permissive with link destination parsing, -- We try to be extra permissive with link destination parsing,
@@ -380,7 +381,11 @@ stackSet = do
case linkVersion =<< link of case linkVersion =<< link of
Right v -> pure $ Just v Right v -> pure $ Just v
Left err -> do Left err -> do
$(logWarn) [i|Failed to parse stack symlink target with: "#{err}". The symlink #{stackBin} needs to point to valid stack binary, such as 'stack-2.7.1'.|] $(logWarn) $ "Failed to parse stack symlink target with: "
<> T.pack (displayException err)
<> ". The symlink "
<> T.pack stackBin
<> " needs to point to valid stack binary, such as 'stack-2.7.1'."
pure Nothing pure Nothing
where where
linkVersion :: MonadThrow m => FilePath -> m Version linkVersion :: MonadThrow m => FilePath -> m Version
@@ -602,7 +607,7 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
] m () ] m ()
unpackToDir dfp av = do unpackToDir dfp av = do
let fn = takeFileName av let fn = takeFileName av
lift $ $(logInfo) [i|Unpacking: #{fn} to #{dfp}|] lift $ $(logInfo) $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m () let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
@@ -621,8 +626,7 @@ unpackToDir dfp av = do
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (untar . BZip.decompress =<< rf av) liftE (untar . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av) | ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
| ".zip" `isSuffixOf` fn -> | ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
withArchive av (unpackInto dfp)
| otherwise -> throwE $ UnknownArchive fn | otherwise -> throwE $ UnknownArchive fn
@@ -651,10 +655,7 @@ getArchiveFiles av = do
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (entries . BZip.decompress =<< rf av) liftE (entries . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av) | ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
| ".zip" `isSuffixOf` fn -> | ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
withArchive av $ do
entries' <- getEntries
pure $ fmap unEntrySelector $ Map.keys entries'
| otherwise -> throwE $ UnknownArchive fn | otherwise -> throwE $ UnknownArchive fn
@@ -793,7 +794,7 @@ applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
applyPatches pdir ddir = do applyPatches pdir ddir = do
patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
forM_ (sort patches) $ \patch' -> do forM_ (sort patches) $ \patch' -> do
lift $ $(logInfo) [i|Applying patch #{patch'}|] lift $ $(logInfo) $ "Applying patch " <> T.pack patch'
fmap (either (const Nothing) Just) fmap (either (const Nothing) Just)
(exec (exec
"patch" "patch"
@@ -864,8 +865,8 @@ runBuildAction bdir instdir action = do
-- printing other errors without crashing. -- printing other errors without crashing.
rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m () rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
rmBDir dir = withRunInIO (\run -> run $ rmBDir dir = withRunInIO (\run -> run $
liftIO $ handleIO (\e -> run $ $(logWarn) liftIO $ handleIO (\e -> run $ $(logWarn) $
[i|Couldn't remove build dir #{dir}, error was: #{displayException e}|]) "Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
$ hideError doesNotExistErrorType $ hideError doesNotExistErrorType
$ rmPathForcibly dir) $ rmPathForcibly dir)
@@ -999,17 +1000,17 @@ createLink link exe = do
fullLink = takeDirectory exe </> link fullLink = takeDirectory exe </> link
shimContents = "path = " <> fullLink shimContents = "path = " <> fullLink
$(logDebug) [i|rm -f #{exe}|] $(logDebug) $ "rm -f " <> T.pack exe
rmLink exe rmLink exe
$(logDebug) [i|ln -s #{fullLink} #{exe}|] $(logDebug) $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
liftIO $ copyFile shimGen exe liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents liftIO $ writeFile shim shimContents
#else #else
$(logDebug) [i|rm -f #{exe}|] $(logDebug) $ "rm -f " <> T.pack exe
hideError doesNotExistErrorType $ recycleFile exe hideError doesNotExistErrorType $ recycleFile exe
$(logDebug) [i|ln -s #{link} #{exe}|] $(logDebug) $ "ln -s " <> T.pack link <> " " <> T.pack exe
liftIO $ createFileLink link exe liftIO $ createFileLink link exe
#endif #endif
@@ -1034,8 +1035,8 @@ ensureGlobalTools = do
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _) -> do void $ (\(DigestError _ _) -> do
lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|] lift $ $(logWarn) "Digest doesn't match, redownloading gs.exe..."
lift $ $(logDebug) [i|rm -f #{shimDownload}|] lift $ $(logDebug) "rm -f #{shimDownload}"
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe") lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[DigestError , DownloadFailed] $ dl liftE @'[DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[DigestError , DownloadFailed] dl) ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)

View File

@@ -50,7 +50,6 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource hiding (throwM) import Control.Monad.Trans.Resource hiding (throwM)
import Data.Bifunctor import Data.Bifunctor
import Data.Maybe import Data.Maybe
import Data.String.Interpolate
import GHC.IO.Exception ( IOErrorType(NoSuchThing) ) import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
@@ -274,7 +273,13 @@ mkGhcupTmpDir = do
let minSpace = 5000 -- a rough guess, aight? let minSpace = 5000 -- a rough guess, aight?
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
when (maybe False (toBytes minSpace >) space) $ do when (maybe False (toBytes minSpace >) space) $ do
$(logWarn) [i|Possibly insufficient disk space on #{tmpdir}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|] $(logWarn) ("Possibly insufficient disk space on "
<> T.pack tmpdir
<> ". At least "
<> T.pack (show minSpace)
<> " MB are recommended, but only "
<> toMB (fromJust space)
<> " are free. Consider freeing up disk space or setting TMPDIR env variable.")
$(logWarn) $(logWarn)
"...waiting for 10 seconds before continuing anyway, you can still abort..." "...waiting for 10 seconds before continuing anyway, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene liftIO $ threadDelay 10000000 -- give the user a sec to intervene
@@ -282,7 +287,7 @@ mkGhcupTmpDir = do
liftIO $ createTempDirectory tmpdir "ghcup" liftIO $ createTempDirectory tmpdir "ghcup"
where where
toBytes mb = mb * 1024 * 1024 toBytes mb = mb * 1024 * 1024
toMB b = show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2) toMB b = T.pack $ show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
truncate' :: Double -> Int -> Double truncate' :: Double -> Int -> Double
truncate' x n = fromIntegral (floor (x * t) :: Integer) / t truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
where t = 10^n where t = 10^n
@@ -304,7 +309,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
(run mkGhcupTmpDir) (run mkGhcupTmpDir)
(\fp -> (\fp ->
handleIO (\e -> run handleIO (\e -> run
$ $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|]) $ $(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
. rmPathForcibly . rmPathForcibly
$ fp)) $ fp))
@@ -347,8 +352,8 @@ cleanupTrash = do
if null contents if null contents
then pure () then pure ()
else do else do
$(logWarn) [i|Removing leftover files in #{recycleDir}|] $(logWarn) ("Removing leftover files in " <> T.pack recycleDir)
forM_ contents (\fp -> handleIO (\e -> forM_ contents (\fp -> handleIO (\e ->
$(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|] $(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
) $ liftIO $ removePathForcibly (recycleDir </> fp)) ) $ liftIO $ removePathForcibly (recycleDir </> fp))

View File

@@ -1,4 +1,3 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
@@ -8,10 +7,8 @@ module GHCup.Utils.File.Common where
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.Monad.Extra
import Control.Monad.Reader import Control.Monad.Reader
import Data.Maybe import Data.Maybe
import Data.String.Interpolate
import GHC.IO.Exception import GHC.IO.Exception
import Optics hiding ((<|), (|>)) import Optics hiding ((<|), (|>))
import System.Directory import System.Directory
@@ -31,13 +28,13 @@ data ProcessError = NonZeroExit Int FilePath [String]
instance Pretty ProcessError where instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) = pPrint (NonZeroExit e exe args) =
text [i|Process "#{exe}" with arguments #{args} failed with exit code #{e}.|] text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "."
pPrint (PTerminated exe args) = pPrint (PTerminated exe args) =
text [i|Process "#{exe}" with arguments #{args} terminated.|] text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated."
pPrint (PStopped exe args) = pPrint (PStopped exe args) =
text [i|Process "#{exe}" with arguments #{args} stopped.|] text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped."
pPrint (NoSuchPid exe args) = pPrint (NoSuchPid exe args) =
text [i|Could not find PID for process running "#{exe}" with arguments #{args}.|] text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
data CapturedProcess = CapturedProcess data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode { _exitCode :: ExitCode
@@ -104,3 +101,6 @@ findFiles path regex = do
contents <- listDirectory path contents <- listDirectory path
pure $ filter (match regex) contents pure $ filter (match regex) contents
checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
checkFileAlreadyExists fp = liftIO $ doesFileExist fp

View File

@@ -35,7 +35,6 @@ import Data.ByteString ( ByteString )
import Data.Foldable import Data.Foldable
import Data.IORef import Data.IORef
import Data.Sequence ( Seq, (|>) ) import Data.Sequence ( Seq, (|>) )
import Data.String.Interpolate
import Data.List import Data.List
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
@@ -132,7 +131,7 @@ execLogged exe args chdir lfile env = do
pure e pure e
tee :: Fd -> Fd -> IO () tee :: Fd -> Fd -> IO ()
tee fileFd fdIn = readTilEOF lineAction fdIn tee fileFd = readTilEOF lineAction
where where
lineAction :: ByteString -> IO () lineAction :: ByteString -> IO ()
@@ -362,7 +361,7 @@ chmod_755 fp = do
`unionFileModes` groupReadMode `unionFileModes` groupReadMode
`unionFileModes` otherExecuteMode `unionFileModes` otherExecuteMode
`unionFileModes` otherReadMode `unionFileModes` otherReadMode
$(logDebug) [i|chmod 755 #{fp}|] $(logDebug) ("chmod 755 " <> T.pack fp)
liftIO $ setFileMode fp exe_mode liftIO $ setFileMode fp exe_mode

View File

@@ -33,7 +33,8 @@ import Control.Monad.Reader
import Control.Monad.Logger import Control.Monad.Logger
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.List ( nub, intercalate ) import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
import Data.Maybe
import Data.Foldable import Data.Foldable
import Data.String import Data.String
import Data.Text ( Text ) import Data.Text ( Text )
@@ -75,8 +76,9 @@ import qualified System.Win32.File as Win32
-- >>> import Data.ByteString.Internal (c2w, w2c) -- >>> import Data.ByteString.Internal (c2w, w2c)
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> import Data.Word8 -- >>> import Data.Word8
-- >>> import Data.Word8
-- >>> import qualified Data.Text as T -- >>> import qualified Data.Text as T
-- >>> import qualified Data.Char as C
-- >>> import Data.List
-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary -- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
@@ -520,7 +522,7 @@ forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
forFold = \t -> (`traverseFold` t) forFold = \t -> (`traverseFold` t)
-- | Strip @\\r@ and @\\n@ from 'ByteString's -- | Strip @\\r@ and @\\n@ from 'String's
-- --
-- >>> stripNewline "foo\n\n\n" -- >>> stripNewline "foo\n\n\n"
-- "foo" -- "foo"
@@ -532,13 +534,10 @@ forFold = \t -> (`traverseFold` t)
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t -- prop> \t -> stripNewline (t <> "\n") === stripNewline t
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t -- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
stripNewline :: String -> String stripNewline :: String -> String
stripNewline s stripNewline = filter (`notElem` "\n\r")
| null s = []
| head s `elem` "\n\r" = stripNewline (tail s)
| otherwise = head s : stripNewline (tail s)
-- | Strip @\\r@ and @\\n@ from 'ByteString's -- | Strip @\\r@ and @\\n@ from 'Text's
-- --
-- >>> stripNewline' "foo\n\n\n" -- >>> stripNewline' "foo\n\n\n"
-- "foo" -- "foo"
@@ -550,10 +549,7 @@ stripNewline s
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t -- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t -- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
stripNewline' :: T.Text -> T.Text stripNewline' :: T.Text -> T.Text
stripNewline' s stripNewline' = T.filter (`notElem` "\n\r")
| T.null s = mempty
| T.head s `elem` "\n\r" = stripNewline' (T.tail s)
| otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s)
-- | Is the word8 a newline? -- | Is the word8 a newline?
@@ -587,3 +583,117 @@ splitOnPVP c s = case Split.splitOn c s of
| otherwise -> def | otherwise -> def
where where
def = (s, "") def = (s, "")
-- | Like 'find', but where the test can be monadic.
--
-- >>> findM (Just . C.isUpper) "teST"
-- Just (Just 'S')
-- >>> findM (Just . C.isUpper) "test"
-- Just Nothing
-- >>> findM (Just . const True) ["x",undefined]
-- Just (Just "x")
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
-- | Drops the given suffix from a list.
-- It returns the original sequence if the sequence doesn't end with the given suffix.
--
-- >>> dropSuffix "!" "Hello World!"
-- "Hello World"
-- >>> dropSuffix "!" "Hello World!!"
-- "Hello World!"
-- >>> dropSuffix "!" "Hello World."
-- "Hello World."
dropSuffix :: Eq a => [a] -> [a] -> [a]
dropSuffix a b = fromMaybe b $ stripSuffix a b
-- | Return the prefix of the second list if its suffix
-- matches the entire first list.
--
-- >>> stripSuffix "bar" "foobar"
-- Just "foo"
-- >>> stripSuffix "" "baz"
-- Just "baz"
-- >>> stripSuffix "foo" "quux"
-- Nothing
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b)
-- | Drops the given prefix from a list.
-- It returns the original sequence if the sequence doesn't start with the given prefix.
--
-- >>> dropPrefix "Mr. " "Mr. Men"
-- "Men"
-- >>> dropPrefix "Mr. " "Dr. Men"
-- "Dr. Men"
dropPrefix :: Eq a => [a] -> [a] -> [a]
dropPrefix a b = fromMaybe b $ stripPrefix a b
-- | Break a list into pieces separated by the first
-- list argument, consuming the delimiter. An empty delimiter is
-- invalid, and will cause an error to be raised.
--
-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
-- ["a","b","d","e"]
-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
-- ["","X","X","X",""]
-- >>> splitOn "x" "x"
-- ["",""]
-- >>> splitOn "x" ""
-- [""]
--
-- prop> \s x -> s /= "" ==> intercalate s (splitOn s x) == x
-- prop> \c x -> splitOn [c] x == split (==c) x
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn [] _ = error "splitOn, needle may not be empty"
splitOn _ [] = [[]]
splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
where (a,b) = breakOn needle haystack
-- | Splits a list into components delimited by separators,
-- where the predicate returns True for a separator element. The
-- resulting components do not contain the separators. Two adjacent
-- separators result in an empty component in the output.
--
-- >>> split (== 'a') "aabbaca"
-- ["","","bb","c",""]
-- >>> split (== 'a') ""
-- [""]
-- >>> split (== ':') "::xyz:abc::123::"
-- ["","","xyz","abc","","123","",""]
-- >>> split (== ',') "my,list,here"
-- ["my","list","here"]
split :: (a -> Bool) -> [a] -> [[a]]
split _ [] = [[]]
split f (x:xs)
| f x = [] : split f xs
| y:ys <- split f xs = (x:y) : ys
| otherwise = [[]]
-- | Find the first instance of @needle@ in @haystack@.
-- The first element of the returned tuple
-- is the prefix of @haystack@ before @needle@ is matched. The second
-- is the remainder of @haystack@, starting with the match.
-- If you want the remainder /without/ the match, use 'stripInfix'.
--
-- >>> breakOn "::" "a::b::c"
-- ("a","::b::c")
-- >>> breakOn "/" "foobar"
-- ("foobar","")
--
-- prop> \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn _ [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs

View File

@@ -44,15 +44,14 @@ import Language.Haskell.TH.Quote
-- The pattern portion is undefined. -- The pattern portion is undefined.
s :: QuasiQuoter s :: QuasiQuoter
s = QuasiQuoter s = QuasiQuoter
(\s' -> case and $ fmap isAscii s' of (\s' -> case all isAscii s' of
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s' True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
False -> fail "Not ascii" False -> fail "Not ascii"
) )
(error "Cannot use q as a pattern") (error "Cannot use s as a pattern")
(error "Cannot use q as a type") (error "Cannot use s as a type")
(error "Cannot use q as a dec") (error "Cannot use s as a dec")
where where
removeCRs = filter (/= '\r') removeCRs = filter (/= '\r')
trimLeadingNewline ('\n' : xs) = xs trimLeadingNewline ('\n' : xs) = xs
trimLeadingNewline xs = xs trimLeadingNewline xs = xs

View File

@@ -25,7 +25,7 @@ import qualified Data.Text as T
-- | This reflects the API version of the YAML. -- | This reflects the API version of the YAML.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|] ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: PVP ghcUpVer :: PVP

View File

@@ -4,11 +4,11 @@ packages:
- . - .
extra-deps: extra-deps:
- git: https://github.com/hasufell/text-conversions.git - git: https://github.com/bgamari/terminal-size
commit: 9abf0e5e5664a3178367597c32db19880477a53c commit: 34ea816bd63f75f800eedac12c6908c6f3736036
- git: https://github.com/Bodigrim/tar - git: https://github.com/hasufell/libarchive
commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf commit: 8587aab78dd515928024ecd82c8f215e06db85cd
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530 - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
@@ -29,7 +29,6 @@ extra-deps:
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184 - hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179 - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582 - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308 - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716 - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568 - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
@@ -43,7 +42,6 @@ extra-deps:
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138 - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248 - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918
flags: flags:
http-io-streams: http-io-streams:
@@ -55,6 +53,12 @@ flags:
regex-posix: regex-posix:
_regex-posix-clib: true _regex-posix-clib: true
aeson-pretty:
lib-only: true
cabal-plan:
exe: false
ghc-options: ghc-options:
"$locals": -O2 "$locals": -O2
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

View File

@@ -66,7 +66,7 @@ instance Arbitrary ByteString where
--------------------- ---------------------
instance Arbitrary Scheme where instance Arbitrary Scheme where
arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ] arbitrary = elements [ Scheme "http", Scheme "https" ]
instance Arbitrary Host where instance Arbitrary Host where
arbitrary = genericArbitrary arbitrary = genericArbitrary