Compare commits
32 Commits
hls-compil
...
issue-253
| Author | SHA1 | Date | |
|---|---|---|---|
|
3b8f2e8307
|
|||
|
0af7aaef3c
|
|||
|
b8907335ba
|
|||
|
0073ca769b
|
|||
|
8a286156f6
|
|||
|
5a39ead523
|
|||
|
d2b4eccac2
|
|||
|
be9b3a3857
|
|||
|
a8e6fca128
|
|||
|
0483133857
|
|||
|
30d9eb5634
|
|||
|
9fe7af3335
|
|||
|
bedfb3d114
|
|||
|
c19dd5ee8b
|
|||
|
6ae3bfe395
|
|||
|
4f82e80dad
|
|||
|
8e8198546f
|
|||
|
9497e310ca
|
|||
|
02135bdbae
|
|||
|
041a341879
|
|||
|
15dd810d67
|
|||
|
7982f3aec0
|
|||
|
2fb07201c7
|
|||
|
b5ca01dc4f
|
|||
|
fa523d590e
|
|||
|
523f2f57e1
|
|||
|
d662682fb5
|
|||
|
ff2b06a5e8
|
|||
|
aece305003
|
|||
|
ef8da9bcec
|
|||
|
3cd55beab1
|
|||
|
6766501858
|
@@ -86,7 +86,7 @@ variables:
|
||||
|
||||
.freebsd12:
|
||||
tags:
|
||||
- x86_64-freebsd
|
||||
- x86_64-freebsd12
|
||||
variables:
|
||||
OS: "FREEBSD"
|
||||
ARCH: "64"
|
||||
|
||||
@@ -11,21 +11,23 @@
|
||||
module Main where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Types.JSON ( )
|
||||
|
||||
import Control.Monad.Trans.Reader ( runReaderT )
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Char ( toLower )
|
||||
import Data.Maybe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Data.Semigroup ( (<>) )
|
||||
#endif
|
||||
import Options.Applicative hiding ( style )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import System.Console.Pretty
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO ( stderr )
|
||||
import Text.Regex.Posix
|
||||
@@ -114,12 +116,14 @@ com = subparser
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
||||
, colorOutter = T.hPutStr stderr
|
||||
, rawOutter = \_ -> pure ()
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
||||
, consoleOutter = T.hPutStr stderr
|
||||
, fileOutter = \_ -> pure ()
|
||||
, fancyColors = not no_color
|
||||
}
|
||||
dirs <- liftIO getAllDirs
|
||||
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings loggerConfig
|
||||
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig
|
||||
|
||||
pfreq <- (
|
||||
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
|
||||
@@ -129,7 +133,7 @@ main = do
|
||||
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
|
||||
liftIO $ exitWith (ExitFailure 2)
|
||||
|
||||
let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
|
||||
let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
|
||||
|
||||
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
||||
>>= \Options {..} -> case optCommand of
|
||||
|
||||
@@ -15,6 +15,7 @@ import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Version.QQ
|
||||
|
||||
import Codec.Archive
|
||||
|
||||
@@ -13,9 +13,9 @@ module BrickMain where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||
import GHCup.Utils.File
|
||||
|
||||
@@ -43,7 +43,6 @@ import Data.Vector ( Vector
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
@@ -537,9 +536,10 @@ settings' :: IORef AppState
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO $ do
|
||||
dirs <- getAllDirs
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, consoleOutter = \_ -> pure ()
|
||||
, fileOutter = \_ -> pure ()
|
||||
, fancyColors = True
|
||||
}
|
||||
newIORef $ AppState (Settings { cache = True
|
||||
, noVerify = False
|
||||
@@ -549,6 +549,7 @@ settings' = unsafePerformIO $ do
|
||||
, urlSource = GHCupURL
|
||||
, noNetwork = False
|
||||
, gpgSetting = GPGNone
|
||||
, noColor = False
|
||||
, ..
|
||||
})
|
||||
dirs
|
||||
@@ -564,13 +565,11 @@ brickMain :: AppState
|
||||
brickMain s = do
|
||||
writeIORef settings' s
|
||||
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
eAppData <- getAppData (Just $ ghcupInfo s)
|
||||
case eAppData of
|
||||
Right ad ->
|
||||
defaultMain
|
||||
(app (defaultAttributes no_color) (dimAttributes no_color))
|
||||
(app (defaultAttributes (noColor $ settings s)) (dimAttributes (noColor $ settings s)))
|
||||
(BrickState ad
|
||||
defaultAppSettings
|
||||
(constructList ad defaultAppSettings Nothing)
|
||||
|
||||
@@ -49,7 +49,6 @@ import Data.Char
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.List ( intercalate, nub, sort, sortBy )
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions hiding ( str )
|
||||
@@ -118,6 +117,7 @@ data Command
|
||||
| Interactive
|
||||
#endif
|
||||
| Prefetch PrefetchCommand
|
||||
| GC GCOptions
|
||||
|
||||
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
|
||||
| ToolTag Tag
|
||||
@@ -146,6 +146,15 @@ data InstallOptions = InstallOptions
|
||||
, forceInstall :: Bool
|
||||
}
|
||||
|
||||
data GCOptions = GCOptions
|
||||
{ gcOldGHC :: Bool
|
||||
, gcProfilingLibs :: Bool
|
||||
, gcShareDir :: Bool
|
||||
, gcHLSNoGHC :: Bool
|
||||
, gcCache :: Bool
|
||||
, gcTmp :: Bool
|
||||
}
|
||||
|
||||
data SetCommand = SetGHC SetOptions
|
||||
| SetCabal SetOptions
|
||||
| SetHLS SetOptions
|
||||
@@ -439,6 +448,16 @@ com =
|
||||
(progDesc "Prefetch assets"
|
||||
<> footerDoc ( Just $ text prefetchFooter ))
|
||||
)
|
||||
<> command
|
||||
"gc"
|
||||
(info
|
||||
( (GC
|
||||
<$> gcP
|
||||
) <**> helper
|
||||
)
|
||||
(progDesc "Garbage collection"
|
||||
<> footerDoc ( Just $ text gcFooter ))
|
||||
)
|
||||
<> commandGroup "Main commands:"
|
||||
)
|
||||
<|> subparser
|
||||
@@ -485,6 +504,7 @@ com =
|
||||
(info (pure Nuke <**> helper)
|
||||
(progDesc "Completely remove ghcup from your system"))
|
||||
<> commandGroup "Nuclear Commands:"
|
||||
<> hidden
|
||||
)
|
||||
|
||||
where
|
||||
@@ -543,6 +563,10 @@ Examples:
|
||||
ghcup prefetch ghc 8.10.5
|
||||
ghcup --offline install ghc 8.10.5|]
|
||||
|
||||
gcFooter :: String
|
||||
gcFooter = [s|Discussion:
|
||||
Performs garbage collection. If no switches are specified, does nothing.|]
|
||||
|
||||
configFooter :: String
|
||||
configFooter = [s|Examples:
|
||||
|
||||
@@ -824,7 +848,7 @@ listOpts =
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader toolParser)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal>" <> help
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||
"Tool to list versions for. Default is all"
|
||||
)
|
||||
)
|
||||
@@ -833,8 +857,8 @@ listOpts =
|
||||
(eitherReader criteriaParser)
|
||||
( short 'c'
|
||||
<> long "show-criteria"
|
||||
<> metavar "<installed|set>"
|
||||
<> help "Show only installed or set tool versions"
|
||||
<> metavar "<installed|set|available>"
|
||||
<> help "Show only installed/set/available tool versions"
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
@@ -1123,6 +1147,28 @@ prefetchP = subparser
|
||||
)
|
||||
)
|
||||
|
||||
gcP :: Parser GCOptions
|
||||
gcP =
|
||||
GCOptions
|
||||
<$>
|
||||
switch
|
||||
(short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'")
|
||||
<*>
|
||||
switch
|
||||
(short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions")
|
||||
<*>
|
||||
switch
|
||||
(short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)")
|
||||
<*>
|
||||
switch
|
||||
(short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version")
|
||||
<*>
|
||||
switch
|
||||
(short 'c' <> long "cache" <> help "GC the GHCup cache")
|
||||
<*>
|
||||
switch
|
||||
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
|
||||
|
||||
|
||||
ghcCompileOpts :: Parser GHCCompileOptions
|
||||
ghcCompileOpts =
|
||||
@@ -1338,12 +1384,13 @@ tagCompleter :: Tool -> [String] -> Completer
|
||||
tagCompleter tool add = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
{ lcPrintDebug = False
|
||||
, consoleOutter = mempty
|
||||
, fileOutter = mempty
|
||||
, fancyColors = False
|
||||
}
|
||||
let appState = LeanAppState
|
||||
(Settings True False Never Curl False GHCupURL True GPGNone)
|
||||
(Settings True False Never Curl False GHCupURL True GPGNone False)
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
@@ -1364,11 +1411,12 @@ versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
{ lcPrintDebug = False
|
||||
, consoleOutter = mempty
|
||||
, fileOutter = mempty
|
||||
, fancyColors = False
|
||||
}
|
||||
let settings = Settings True False Never Curl False GHCupURL True GPGNone
|
||||
let settings = Settings True False Never Curl False GHCupURL True GPGNone False
|
||||
let leanAppState = LeanAppState
|
||||
settings
|
||||
dirs'
|
||||
@@ -1427,6 +1475,8 @@ toolVersionEither s' =
|
||||
toolParser :: String -> Either String Tool
|
||||
toolParser s' | t == T.pack "ghc" = Right GHC
|
||||
| t == T.pack "cabal" = Right Cabal
|
||||
| t == T.pack "hls" = Right HLS
|
||||
| t == T.pack "stack" = Right Stack
|
||||
| otherwise = Left ("Unknown tool: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
@@ -1434,6 +1484,7 @@ toolParser s' | t == T.pack "ghc" = Right GHC
|
||||
criteriaParser :: String -> Either String ListCriteria
|
||||
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
||||
| t == T.pack "set" = Right ListSet
|
||||
| t == T.pack "available" = Right ListAvailable
|
||||
| otherwise = Left ("Unknown criteria: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
@@ -1527,6 +1578,7 @@ absolutePathParser f = case isValid f && isAbsolute f of
|
||||
|
||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
||||
toSettings options = do
|
||||
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
||||
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft (V (JSONDecodeError e)) -> do
|
||||
@@ -1534,10 +1586,10 @@ toSettings options = do
|
||||
pure defaultUserSettings
|
||||
_ -> do
|
||||
die "Unexpected error!"
|
||||
pure $ mergeConf options userConf
|
||||
pure $ mergeConf options userConf noColor
|
||||
where
|
||||
mergeConf :: Options -> UserSettings -> (Settings, KeyBindings)
|
||||
mergeConf Options{..} UserSettings{..} =
|
||||
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
||||
mergeConf Options{..} UserSettings{..} noColor =
|
||||
let cache = fromMaybe (fromMaybe False uCache) optCache
|
||||
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
|
||||
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
|
||||
@@ -1583,7 +1635,7 @@ updateSettings config settings = do
|
||||
urlSource' = fromMaybe urlSource uUrlSource
|
||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting'
|
||||
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
|
||||
|
||||
upgradeOptsP :: Parser UpgradeOpts
|
||||
upgradeOptsP =
|
||||
@@ -1608,7 +1660,7 @@ describe_result = $( LitE . StringL <$>
|
||||
runIO (do
|
||||
CapturedProcess{..} <- do
|
||||
dirs <- liftIO getAllDirs
|
||||
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone)
|
||||
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False)
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
flip runReaderT settings $ executeOut "git" ["describe"] Nothing
|
||||
@@ -1688,17 +1740,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- flip runReaderT dirs initGHCupFileLogging
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = verbose settings
|
||||
, colorOutter = T.hPutStr stderr
|
||||
, rawOutter =
|
||||
, consoleOutter = T.hPutStr stderr
|
||||
, fileOutter =
|
||||
case optCommand of
|
||||
Nuke -> \_ -> pure ()
|
||||
_ -> T.appendFile logfile
|
||||
, fancyColors = not no_color
|
||||
}
|
||||
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
|
||||
let runLogger = flip runReaderT leanAppstate
|
||||
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
|
||||
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { consoleOutter = \_ -> pure () } } :: LeanAppState)
|
||||
|
||||
|
||||
-------------------------
|
||||
@@ -1739,6 +1793,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
DInfo -> pure ()
|
||||
ToolRequirements -> pure ()
|
||||
ChangeLog _ -> pure ()
|
||||
UnSet _ -> pure ()
|
||||
#if defined(BRICK)
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
@@ -1825,7 +1880,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runUnsetGHC =
|
||||
runAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled ]
|
||||
|
||||
@@ -1972,6 +2027,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, FileDoesNotExistError
|
||||
]
|
||||
|
||||
let runGC =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
]
|
||||
|
||||
|
||||
-----------------------
|
||||
-- Command functions --
|
||||
@@ -2336,7 +2398,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
List ListOptions {..} ->
|
||||
runListGHC (do
|
||||
l <- listVersions loTool lCriteria
|
||||
liftIO $ printListResult lRawFormat l
|
||||
liftIO $ printListResult no_color lRawFormat l
|
||||
pure ExitSuccess
|
||||
)
|
||||
|
||||
@@ -2691,6 +2753,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
GC GCOptions{..} ->
|
||||
runGC (do
|
||||
when gcOldGHC rmOldGHC
|
||||
lift $ when gcProfilingLibs rmProfilingLibs
|
||||
lift $ when gcShareDir rmShareDir
|
||||
lift $ when gcHLSNoGHC rmHLSNoGHC
|
||||
lift $ when gcCache rmCache
|
||||
lift $ when gcTmp rmTmp
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 27
|
||||
|
||||
|
||||
case res of
|
||||
@@ -2741,13 +2817,15 @@ fromVersion' SetRecommended tool = do
|
||||
fromVersion' (SetToolVersion v) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
||||
case pvp $ prettyVer (_tvVersion v) of
|
||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||
Left _ -> pure (v, vi)
|
||||
Right (PVP (major' :|[minor'])) ->
|
||||
case getLatestGHCFor (fromIntegral major') (fromIntegral minor') dls of
|
||||
Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
||||
Right pvpIn ->
|
||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
||||
Just (pvp_, vi') -> do
|
||||
v' <- lift $ pvpToVersion pvp_
|
||||
when (v' /= (_tvVersion v)) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
||||
Nothing -> pure (v, vi)
|
||||
Right _ -> pure (v, vi)
|
||||
fromVersion' (SetToolTag Latest) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
(\(x, y) -> (mkTVer x, Just y)) <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
@@ -2807,9 +2885,8 @@ fromVersion' (SetToolTag t') tool =
|
||||
throwE $ TagNotFound t' tool
|
||||
|
||||
|
||||
printListResult :: Bool -> [ListResult] -> IO ()
|
||||
printListResult raw lr = do
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
printListResult :: Bool -> Bool -> [ListResult] -> IO ()
|
||||
printListResult no_color raw lr = do
|
||||
|
||||
let
|
||||
color | raw || no_color = flip const
|
||||
|
||||
@@ -8,11 +8,6 @@ package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
|
||||
@@ -1493,6 +1493,7 @@ ghcupDownloads:
|
||||
dlHash: b823b58cae36fbac0741680ca7605180fa4cf4c6ae439123d282184b94d32fd6
|
||||
8.10.4:
|
||||
viTags:
|
||||
- old
|
||||
- base-4.14.1.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.4/docs/html/users_guide/8.10.4-notes.html
|
||||
viSourceDL:
|
||||
@@ -1588,6 +1589,7 @@ ghcupDownloads:
|
||||
dlHash: 0d18ef83593272f6196a41cc3abdc48dfe5e14372db75d71ea19fe35320c4e81
|
||||
8.10.5:
|
||||
viTags:
|
||||
- old
|
||||
- base-4.14.2.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.5/docs/html/users_guide/8.10.5-notes.html
|
||||
viSourceDL:
|
||||
@@ -1693,6 +1695,7 @@ ghcupDownloads:
|
||||
dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
|
||||
8.10.6:
|
||||
viTags:
|
||||
- old
|
||||
- base-4.14.3.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
|
||||
viSourceDL:
|
||||
@@ -2057,6 +2060,11 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~ghc/9.2.1-rc1/ghc-9.2.0.20210821-aarch64-deb10-linux.tar.xz
|
||||
dlSubdir: ghc-9.2.0.20210821
|
||||
dlHash: 289fc361be4a3199ac15449e30405a9831454811dd454e81eab73bfcdd2c4088
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghc/9.2.1-rc1/ghc-9.2.0.20210821-aarch64-apple-darwin.tar.xz
|
||||
dlSubdir: ghc-9.2.0.20210821-aarch64-apple-darwin
|
||||
dlHash: 0d763fb619cfa32fa37c113c446e13bebc2215db5946e5fa8fd8400559cf4152
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
@@ -2174,8 +2182,7 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz
|
||||
dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93
|
||||
3.4.0.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
viTags: []
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
@@ -2226,6 +2233,7 @@ ghcupDownloads:
|
||||
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
|
||||
3.6.0.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md
|
||||
viArch:
|
||||
@@ -2269,7 +2277,7 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
|
||||
dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
|
||||
GHCup:
|
||||
0.1.16.2:
|
||||
0.1.17.1:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
@@ -2279,43 +2287,43 @@ ghcupDownloads:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning: &ghcup-64
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
|
||||
dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-linux-ghcup-0.1.17.1
|
||||
dlHash: 2824687fe3965374f463ae49f9d8abd9d3d556a0f63880bc78b5ee02098ba142
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
|
||||
dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-apple-darwin-ghcup-0.1.17.1
|
||||
dlHash: 0dd4e5afc7d93bdef20ba16085ae9f2aa5e4acd6b34e75a3b31b1fcc8ea451a9
|
||||
FreeBSD:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
|
||||
dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-freebsd-ghcup-0.1.17.1
|
||||
dlHash: a480ba827c07ed50d9ab724bd80198722a85b7bb683c5bcc1e8b1df2be7ad0e5
|
||||
Windows:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-mingw64-ghcup-0.1.16.2.exe
|
||||
dlHash: ec78872a84213968c490675127b9aad2285980b747c68207801ae824b98c7948
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-mingw64-ghcup-0.1.17.1.exe
|
||||
dlHash: dabd8c545401b038407a01168a9fda977f17cb326f43c6b3129e76bee3b113d6
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *ghcup-64
|
||||
A_32:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning: &ghcup-32
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
|
||||
dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/i386-linux-ghcup-0.1.17.1
|
||||
dlHash: 04ec4ffd8fab1931e53f70beb3497770b42f4d37d7469c1973a0eeeccd5e8989
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *ghcup-32
|
||||
A_ARM64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2
|
||||
dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/aarch64-linux-ghcup-0.1.17.1
|
||||
dlHash: d14539dbbbb2269b6c3e105b83fa7dac744c1cfaf39f7eb2760293fec856e738
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2
|
||||
dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/aarch64-apple-darwin-ghcup-0.1.17.1
|
||||
dlHash: 80cb12af6eaeab2839e13f9cd428c0152fcb38fffc62954a3f5eccca7b06b6d9
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2
|
||||
dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/armv7-linux-ghcup-0.1.17.1
|
||||
dlHash: 2b1e63cbd62cce1a15c7cf0635f85b6bc7de880563cdf4b3a20422c9c30a616c
|
||||
HLS:
|
||||
1.1.0:
|
||||
viTags:
|
||||
|
||||
@@ -1,5 +1,14 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.17.1 -- 2021-09-26
|
||||
|
||||
* Fix `NO_COLOR`
|
||||
* Fix `ghcup list -t` for hls/stack, wrt [#244](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/244)
|
||||
* Get rid of concurrent-output
|
||||
* Improve cli interface with partial versions (e.g. `ghcup install ghc 8`)
|
||||
* Fix HLS compilation builds
|
||||
* Implement `ghcup gc` (garbage collection) command
|
||||
|
||||
## 0.1.17 -- 2021-09-20
|
||||
|
||||
* Add `--force` option to install/compile wrt [#210](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/210) by Arjun Kathuria
|
||||
|
||||
49
ghcup.cabal
49
ghcup.cabal
@@ -1,33 +1,33 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
maintainer: hasufell@posteo.de
|
||||
author: Julian Ospald
|
||||
homepage: https://gitlab.haskell.org/haskell/ghcup-hs
|
||||
bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
|
||||
synopsis: ghc toolchain installer
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17.1
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
maintainer: hasufell@posteo.de
|
||||
author: Julian Ospald
|
||||
homepage: https://gitlab.haskell.org/haskell/ghcup-hs
|
||||
bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
|
||||
synopsis: ghc toolchain installer
|
||||
description:
|
||||
A rewrite of the shell script ghcup, for providing
|
||||
a more stable user experience and exposing an API.
|
||||
|
||||
category: System
|
||||
build-type: Simple
|
||||
category: System
|
||||
build-type: Simple
|
||||
extra-doc-files:
|
||||
README.md
|
||||
docs/CHANGELOG.md
|
||||
docs/HACKING.md
|
||||
docs/RELEASING.md
|
||||
data/config.yaml
|
||||
data/metadata/ghcup-0.0.4.yaml
|
||||
data/metadata/ghcup-0.0.5.yaml
|
||||
data/metadata/ghcup-0.0.6.yaml
|
||||
docs/CHANGELOG.md
|
||||
docs/HACKING.md
|
||||
docs/RELEASING.md
|
||||
README.md
|
||||
|
||||
extra-source-files:
|
||||
data/build_mk/default
|
||||
data/build_mk/cross
|
||||
data/build_mk/default
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@@ -102,7 +102,6 @@ library
|
||||
, Cabal
|
||||
, case-insensitive ^>=1.2.1.0
|
||||
, casing ^>=0.1.4.1
|
||||
, concurrent-output ^>=1.10.11
|
||||
, containers ^>=0.6
|
||||
, cryptohash-sha256 ^>=0.11.101.0
|
||||
, deepseq ^>=1.4.4.0
|
||||
@@ -111,6 +110,7 @@ library
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, libarchive ^>=3.0.0.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
@@ -136,7 +136,6 @@ library
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, word8 ^>=0.1.3
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, zlib ^>=0.6.2.2
|
||||
|
||||
if (flag(internal-downloader) && !os(windows))
|
||||
@@ -158,7 +157,11 @@ library
|
||||
, Win32 ^>=2.10
|
||||
|
||||
else
|
||||
other-modules: GHCup.Utils.File.Posix
|
||||
other-modules:
|
||||
GHCup.Utils.File.Posix
|
||||
System.Console.Terminal.Common
|
||||
System.Console.Terminal.Posix
|
||||
|
||||
build-depends:
|
||||
, bz2 >=0.5.0.5 && <1.1
|
||||
, unix ^>=2.7
|
||||
@@ -198,6 +201,7 @@ executable ghcup
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, libarchive ^>=3.0.0.0
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, mtl ^>=2.2
|
||||
@@ -212,7 +216,6 @@ executable ghcup
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, versions >=4.0.1 && <5.1
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
@@ -260,6 +263,7 @@ executable ghcup-gen
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, libarchive ^>=3.0.0.0
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
@@ -272,7 +276,6 @@ executable ghcup-gen
|
||||
, text ^>=1.2.4.0
|
||||
, transformers ^>=0.5
|
||||
, versions >=4.0.1 && <5.1
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
251
lib/GHCup.hs
251
lib/GHCup.hs
@@ -34,6 +34,7 @@ import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Utils.Version.QQ
|
||||
@@ -58,6 +59,7 @@ import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.List.NonEmpty ( NonEmpty((:|)) )
|
||||
import Data.String ( fromString )
|
||||
import Data.Text ( Text )
|
||||
import Data.Time.Clock
|
||||
@@ -81,9 +83,7 @@ import System.Directory hiding ( findFiles )
|
||||
import System.Environment
|
||||
import System.FilePath
|
||||
import System.IO.Error
|
||||
#if defined(IS_WINDOWS)
|
||||
import System.IO.Temp
|
||||
#endif
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import Text.Regex.Posix
|
||||
|
||||
@@ -510,7 +510,7 @@ installCabalUnpacked path inst mver' forceInstall = do
|
||||
unless forceInstall -- Overwrite it when it IS a force install
|
||||
(liftE $ throwIfFileAlreadyExists destPath)
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
copyFileE
|
||||
(path </> cabalFile <> exeExt)
|
||||
destPath
|
||||
lift $ chmod_755 destPath
|
||||
@@ -660,7 +660,7 @@ installHLSUnpacked path inst mver' forceInstall = do
|
||||
unless forceInstall -- if it is a force install, overwrite it.
|
||||
(liftE $ throwIfFileAlreadyExists destPath)
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
copyFileE
|
||||
srcPath
|
||||
destPath
|
||||
lift $ chmod_755 destPath
|
||||
@@ -676,7 +676,7 @@ installHLSUnpacked path inst mver' forceInstall = do
|
||||
unless forceInstall
|
||||
(liftE $ throwIfFileAlreadyExists destWrapperPath)
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
copyFileE
|
||||
srcWrapperPath
|
||||
destWrapperPath
|
||||
|
||||
@@ -848,35 +848,37 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
cp <- case cabalProject of
|
||||
Just cp
|
||||
| isAbsolute cp -> do
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile cp (workdir </> "cabal.project")
|
||||
copyFileE cp (workdir </> "cabal.project")
|
||||
pure "cabal.project"
|
||||
| otherwise -> pure (takeFileName cp)
|
||||
Nothing -> pure "cabal.project"
|
||||
forM_ cabalProjectLocal $ \cpl -> handleIO (throwE . CopyError . show) $ liftIO $ copyFile cpl (workdir </> cp <.> "local")
|
||||
forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir </> cp <.> "local")
|
||||
|
||||
let targets = ["exe:haskell-language-server", "exe:haskell-language-server-wrapper"]
|
||||
|
||||
artifacts <- forM (sort ghcs) $ \ghc -> do
|
||||
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
|
||||
liftIO $ createDirRecursive' installDir
|
||||
liftIO $ createDirRecursive' ghcInstallDir
|
||||
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
|
||||
liftE $ lEM @_ @'[ProcessError] $
|
||||
execLogged "cabal" ( [ "v2-install"
|
||||
execLogged "cabal" ( [ "v2-build"
|
||||
, "-w"
|
||||
, "ghc-" <> T.unpack (prettyVer ghc)
|
||||
, "--install-method=copy"
|
||||
] ++
|
||||
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
|
||||
[ "--overwrite-policy=always"
|
||||
, "--disable-profiling"
|
||||
, "--disable-tests"
|
||||
, "--enable-split-sections"
|
||||
, "--enable-executable-stripping"
|
||||
, "--enable-executable-static"
|
||||
, "--installdir=" <> ghcInstallDir
|
||||
, "--project-file=" <> cp
|
||||
, "exe:haskell-language-server"
|
||||
, "exe:haskell-language-server-wrapper"]
|
||||
[ "--project-file=" <> cp
|
||||
] ++ targets
|
||||
)
|
||||
(Just workdir) "cabal" Nothing
|
||||
forM_ targets $ \target -> do
|
||||
let cabal = "cabal"
|
||||
args = ["list-bin", target]
|
||||
CapturedProcess{..} <- lift $ executeOut cabal args (Just workdir)
|
||||
case _exitCode of
|
||||
ExitFailure i -> throwE (NonZeroExit i cabal args)
|
||||
_ -> pure ()
|
||||
let cbin = stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
copyFileE cbin (ghcInstallDir </> takeFileName cbin)
|
||||
pure ghcInstallDir
|
||||
|
||||
forM_ artifacts $ \artifact -> do
|
||||
@@ -1037,7 +1039,7 @@ installStackUnpacked path inst mver' forceInstall = do
|
||||
unless forceInstall
|
||||
(liftE $ throwIfFileAlreadyExists destPath)
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
copyFileE
|
||||
(path </> stackFile <> exeExt)
|
||||
destPath
|
||||
lift $ chmod_755 destPath
|
||||
@@ -1226,7 +1228,7 @@ setHLS ver = do
|
||||
lift $ rmLink (binDir </> f)
|
||||
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
bins <- lift $ hlsServerBinaries ver
|
||||
bins <- lift $ hlsServerBinaries ver Nothing
|
||||
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
||||
|
||||
forM_ bins $ \f -> do
|
||||
@@ -1334,6 +1336,7 @@ warnAboutHlsCompatibility = do
|
||||
-- | Filter data type for 'listVersions'.
|
||||
data ListCriteria = ListInstalled
|
||||
| ListSet
|
||||
| ListAvailable
|
||||
deriving Show
|
||||
|
||||
-- | A list result describes a single tool version
|
||||
@@ -1571,7 +1574,7 @@ listVersions lt' criteria = do
|
||||
|
||||
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
||||
currentGHCup av =
|
||||
let currentVer = pvpToVersion ghcUpVer
|
||||
let currentVer = fromJust $ pvpToVersion ghcUpVer
|
||||
listVer = Map.lookup currentVer av
|
||||
latestVer = fst <$> headOf (getTagged Latest) av
|
||||
recommendedVer = fst <$> headOf (getTagged Latest) av
|
||||
@@ -1676,6 +1679,7 @@ listVersions lt' criteria = do
|
||||
Nothing -> lr
|
||||
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
|
||||
Just ListSet -> filter (\ListResult {..} -> lSet) lr
|
||||
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
|
||||
|
||||
|
||||
|
||||
@@ -1728,7 +1732,7 @@ rmGHCVer ver = do
|
||||
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ fmap Just
|
||||
$ getMajorMinorV (_tvVersion ver)
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) (_tvTarget ver))
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -2117,6 +2121,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
bghc <- case bstrap of
|
||||
Right g -> pure $ Right g
|
||||
Left bver -> pure $ Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
||||
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
Left tver -> do
|
||||
@@ -2136,6 +2144,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
workdir <- maybe (pure tmpUnpack)
|
||||
(liftE . intoSubdir tmpUnpack)
|
||||
(view dlSubdir dlInfo)
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||
|
||||
pure (workdir, tmpUnpack, tver)
|
||||
|
||||
@@ -2143,7 +2152,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
Right GitBranch{..} -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
|
||||
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH] DownloadFailed $ do
|
||||
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
|
||||
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
||||
lEM $ git [ "init" ]
|
||||
@@ -2163,8 +2172,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
|
||||
lEM $ git [ "checkout", "FETCH_HEAD" ]
|
||||
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
||||
lEM $ execLogged "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap" Nothing
|
||||
lEM $ execLogged "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap" Nothing
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir tmpUnpack)
|
||||
env <- liftE $ ghcEnv bghc
|
||||
lEM $ execLogged "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap" (Just env)
|
||||
lEM $ execLogged "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap" (Just env)
|
||||
CapturedProcess {..} <- lift $ makeOut
|
||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just tmpUnpack)
|
||||
case _exitCode of
|
||||
@@ -2180,13 +2191,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
let installVer = maybe tver (\ov' -> tver { _tvVersion = ov' }) ov
|
||||
|
||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||
|
||||
when alreadyInstalled $ do
|
||||
case isolateDir of
|
||||
Just isoDir ->
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Isolate installing to " <> T.pack isoDir
|
||||
Nothing ->
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Will overwrite existing version."
|
||||
lift $ logWarn
|
||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||
@@ -2195,10 +2207,6 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
Just isoDir -> pure isoDir
|
||||
Nothing -> lift $ ghcupGHCDir installVer
|
||||
|
||||
bghc <- case bstrap of
|
||||
Right g -> pure $ Right g
|
||||
Left bver -> pure $ Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
||||
|
||||
(mBindist, bmk) <- liftE $ runBuildAction
|
||||
tmpUnpack
|
||||
Nothing
|
||||
@@ -2215,7 +2223,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
-- only remove old ghc in regular installs
|
||||
when alreadyInstalled $ do
|
||||
lift $ logInfo "Deleting existing installation"
|
||||
liftE $ rmGHCVer tver
|
||||
liftE $ rmGHCVer installVer
|
||||
|
||||
_ -> pure ()
|
||||
|
||||
@@ -2223,7 +2231,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
liftE $ installPackedGHC bindist
|
||||
(Just $ RegexDir "ghc-.*")
|
||||
ghcdir
|
||||
(tver ^. tvVersion)
|
||||
(installVer ^. tvVersion)
|
||||
False -- not a force install, since we already overwrite when compiling.
|
||||
|
||||
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||
@@ -2231,13 +2239,13 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
case isolateDir of
|
||||
-- set and make symlinks for regular (non-isolated) installs
|
||||
Nothing -> do
|
||||
reThrowAll GHCupSetError $ postGHCInstall tver
|
||||
reThrowAll GHCupSetError $ postGHCInstall installVer
|
||||
-- restore
|
||||
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
||||
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly
|
||||
|
||||
_ -> pure ()
|
||||
|
||||
pure tver
|
||||
pure installVer
|
||||
|
||||
where
|
||||
defaultConf =
|
||||
@@ -2406,7 +2414,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
<> ".tar"
|
||||
<> takeExtension tar)
|
||||
let tarPath = cacheDir </> tarName
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||
copyFileE (workdir </> tar)
|
||||
tarPath
|
||||
lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
|
||||
pure tarPath
|
||||
@@ -2471,17 +2479,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
()
|
||||
configureBindist bghc tver workdir ghcdir = do
|
||||
lift $ logInfo [s|configuring build|]
|
||||
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||
|
||||
cEnv <- liftIO getEnvironment
|
||||
|
||||
if | _tvVersion tver >= [vver|8.8.0|] -> do
|
||||
bghcPath <- case bghc of
|
||||
Right ghc' -> pure ghc'
|
||||
Left bver -> do
|
||||
spaths <- liftIO getSearchPath
|
||||
liftIO (searchPath spaths bver) !? NotFoundInPATH bver
|
||||
env <- liftE $ ghcEnv bghc
|
||||
lEM $ execLogged
|
||||
"sh"
|
||||
("./configure" : maybe mempty
|
||||
@@ -2495,7 +2495,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
)
|
||||
(Just workdir)
|
||||
"ghc-conf"
|
||||
(Just (("GHC", bghcPath) : cEnv))
|
||||
(Just env)
|
||||
| otherwise -> do
|
||||
lEM $ execLogged
|
||||
"sh"
|
||||
@@ -2512,9 +2512,19 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
)
|
||||
(Just workdir)
|
||||
"ghc-conf"
|
||||
(Just cEnv)
|
||||
Nothing
|
||||
pure ()
|
||||
|
||||
ghcEnv :: MonadIO m => Either FilePath FilePath -> Excepts '[NotFoundInPATH] m [(String, String)]
|
||||
ghcEnv bghc = do
|
||||
cEnv <- liftIO getEnvironment
|
||||
bghcPath <- case bghc of
|
||||
Right ghc' -> pure ghc'
|
||||
Left bver -> do
|
||||
spaths <- liftIO getSearchPath
|
||||
liftIO (searchPath spaths bver) !? NotFoundInPATH bver
|
||||
pure (("GHC", bghcPath) : cEnv)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -2536,6 +2546,7 @@ upgradeGHCup :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -2560,7 +2571,8 @@ upgradeGHCup mtarget force' = do
|
||||
|
||||
lift $ logInfo "Upgrading GHCup..."
|
||||
let latestVer = fromJust $ fst <$> getLatest dls GHCup
|
||||
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
||||
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer
|
||||
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
|
||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||
tmp <- lift withGHCupTmpDir
|
||||
let fn = "ghcup" <> exeExt
|
||||
@@ -2572,7 +2584,7 @@ upgradeGHCup mtarget force' = do
|
||||
lift $ logDebug $ "rm -f " <> T.pack destFile
|
||||
lift $ hideError NoSuchThing $ recycleFile destFile
|
||||
lift $ logDebug $ "cp " <> T.pack p <> " " <> T.pack destFile
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
||||
copyFileE p
|
||||
destFile
|
||||
lift $ chmod_755 destFile
|
||||
|
||||
@@ -2623,7 +2635,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
handle (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ fmap Just
|
||||
$ getMajorMinorV _tvVersion
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) _tvTarget)
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
|
||||
|
||||
|
||||
@@ -2697,3 +2709,134 @@ throwIfFileAlreadyExists :: ( MonadIO m ) =>
|
||||
throwIfFileAlreadyExists fp = whenM (checkFileAlreadyExists fp)
|
||||
(throwE $ FileAlreadyExistsError fp)
|
||||
|
||||
|
||||
|
||||
--------------------------
|
||||
--[ Garbage collection ]--
|
||||
--------------------------
|
||||
|
||||
|
||||
rmOldGHC :: ( MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Excepts '[NotInstalled] m ()
|
||||
rmOldGHC = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls
|
||||
ghcs <- lift $ fmap rights getInstalledGHCs
|
||||
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
||||
|
||||
|
||||
|
||||
rmProfilingLibs :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> m ()
|
||||
rmProfilingLibs = do
|
||||
ghcs <- fmap rights getInstalledGHCs
|
||||
|
||||
let regexes :: [ByteString]
|
||||
regexes = [[s|.*_p\.a$|], [s|.*\.p_hi$|]]
|
||||
|
||||
forM_ regexes $ \regex ->
|
||||
forM_ ghcs $ \ghc -> do
|
||||
d <- ghcupGHCDir ghc
|
||||
matches <- liftIO $ handleIO (\_ -> pure []) $ findFilesDeep
|
||||
d
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
regex
|
||||
)
|
||||
forM_ matches $ \m -> do
|
||||
let p = d </> m
|
||||
logDebug $ "rm " <> T.pack p
|
||||
rmFile p
|
||||
|
||||
|
||||
|
||||
rmShareDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> m ()
|
||||
rmShareDir = do
|
||||
ghcs <- fmap rights getInstalledGHCs
|
||||
forM_ ghcs $ \ghc -> do
|
||||
d <- ghcupGHCDir ghc
|
||||
let p = d </> "share"
|
||||
logDebug $ "rm -rf " <> T.pack p
|
||||
rmPathForcibly p
|
||||
|
||||
|
||||
rmHLSNoGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> m ()
|
||||
rmHLSNoGHC = do
|
||||
Dirs {..} <- getDirs
|
||||
ghcs <- fmap rights getInstalledGHCs
|
||||
hlses <- fmap rights getInstalledHLSs
|
||||
forM_ hlses $ \hls -> do
|
||||
hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
|
||||
forM_ hlsGHCs $ \ghc -> do
|
||||
when (ghc `notElem` ghcs) $ do
|
||||
bins <- hlsServerBinaries hls (Just $ _tvVersion ghc)
|
||||
forM_ bins $ \bin -> do
|
||||
let f = binDir </> bin
|
||||
logDebug $ "rm " <> T.pack f
|
||||
rmFile f
|
||||
|
||||
|
||||
rmCache :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> m ()
|
||||
rmCache = do
|
||||
Dirs {..} <- getDirs
|
||||
contents <- liftIO $ listDirectory cacheDir
|
||||
forM_ contents $ \f -> do
|
||||
let p = cacheDir </> f
|
||||
logDebug $ "rm " <> T.pack p
|
||||
rmFile p
|
||||
|
||||
|
||||
rmTmp :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> m ()
|
||||
rmTmp = do
|
||||
tmpdir <- liftIO getCanonicalTemporaryDirectory
|
||||
ghcup_dirs <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
tmpdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|^ghcup-.*$|] :: ByteString)
|
||||
)
|
||||
forM_ ghcup_dirs $ \f -> do
|
||||
let p = tmpdir </> f
|
||||
logDebug $ "rm -rf " <> T.pack p
|
||||
rmPathForcibly p
|
||||
|
||||
@@ -35,6 +35,7 @@ import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Version
|
||||
|
||||
|
||||
@@ -23,6 +23,7 @@ import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
|
||||
@@ -417,6 +417,7 @@ data Settings = Settings
|
||||
, urlSource :: URLSource
|
||||
, noNetwork :: Bool
|
||||
, gpgSetting :: GPGSetting
|
||||
, noColor :: Bool -- this also exists in LoggerConfig
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
@@ -576,11 +577,12 @@ data LogLevel = Warn
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data LoggerConfig = LoggerConfig
|
||||
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
|
||||
, colorOutter :: T.Text -> IO () -- ^ how to write the color output
|
||||
, rawOutter :: T.Text -> IO () -- ^ how to write the full raw output
|
||||
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
|
||||
, consoleOutter :: T.Text -> IO () -- ^ how to write the console output
|
||||
, fileOutter :: T.Text -> IO () -- ^ how to write the file output
|
||||
, fancyColors :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
instance NFData LoggerConfig where
|
||||
rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug
|
||||
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
|
||||
|
||||
@@ -24,6 +24,8 @@ module GHCup.Types.JSON where
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
|
||||
-- This is due to the boot file.
|
||||
|
||||
import Control.Applicative ( (<|>) )
|
||||
import Data.Aeson
|
||||
|
||||
@@ -23,12 +23,9 @@ import GHCup.Types
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
import URI.ByteString
|
||||
import System.Console.Pretty
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
makePrisms ''Tool
|
||||
makePrisms ''Architecture
|
||||
@@ -117,80 +114,6 @@ getDirs :: ( MonadReader env m
|
||||
getDirs = gets @"dirs"
|
||||
|
||||
|
||||
logInfo :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logInfo = logInternal Info
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logWarn = logInternal Warn
|
||||
|
||||
logDebug :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logDebug = logInternal Debug
|
||||
|
||||
logError :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logError = logInternal Error
|
||||
|
||||
|
||||
logInternal :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
) => LogLevel
|
||||
-> Text
|
||||
-> m ()
|
||||
logInternal logLevel msg = do
|
||||
LoggerConfig {..} <- gets @"loggerConfig"
|
||||
let style' = case logLevel of
|
||||
Debug -> style Bold . color Blue
|
||||
Info -> style Bold . color Green
|
||||
Warn -> style Bold . color Yellow
|
||||
Error -> style Bold . color Red
|
||||
let l = case logLevel of
|
||||
Debug -> style' "[ Debug ]"
|
||||
Info -> style' "[ Info ]"
|
||||
Warn -> style' "[ Warn ]"
|
||||
Error -> style' "[ Error ]"
|
||||
let strs = T.split (== '\n') msg
|
||||
let out = case strs of
|
||||
[] -> T.empty
|
||||
(x:xs) ->
|
||||
foldr (\a b -> a <> "\n" <> b) mempty
|
||||
. ((l <> " " <> x) :)
|
||||
. fmap (\line' -> style' "[ ... ] " <> line' )
|
||||
$ xs
|
||||
|
||||
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
|
||||
$ liftIO $ colorOutter out
|
||||
|
||||
-- raw output
|
||||
let lr = case logLevel of
|
||||
Debug -> "Debug:"
|
||||
Info -> "Info:"
|
||||
Warn -> "Warn:"
|
||||
Error -> "Error:"
|
||||
let outr = lr <> " " <> msg <> "\n"
|
||||
liftIO $ rawOutter outr
|
||||
|
||||
|
||||
|
||||
getLogCleanup :: ( MonadReader env m
|
||||
, LabelOptic' "logCleanup" A_Lens env (IO ())
|
||||
)
|
||||
|
||||
@@ -35,6 +35,7 @@ import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
@@ -85,8 +86,37 @@ import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
-- >>> :set -XDataKinds
|
||||
-- >>> :set -XTypeApplications
|
||||
-- >>> :set -XQuasiQuotes
|
||||
-- >>> import System.Directory
|
||||
-- >>> import URI.ByteString
|
||||
-- >>> import qualified Data.Text as T
|
||||
-- >>> import GHCup.Utils.Prelude
|
||||
-- >>> import GHCup.Download
|
||||
-- >>> import GHCup.Version
|
||||
-- >>> import GHCup.Errors
|
||||
-- >>> import GHCup.Types
|
||||
-- >>> import GHCup.Types.Optics
|
||||
-- >>> import Optics
|
||||
-- >>> import GHCup.Utils.Version.QQ
|
||||
-- >>> import qualified Data.Text.Encoding as E
|
||||
-- >>> import Control.Monad.Reader
|
||||
-- >>> import Haskus.Utils.Variant.Excepts
|
||||
-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
|
||||
-- >>> dirs' <- getAllDirs
|
||||
-- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ]
|
||||
-- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False
|
||||
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
|
||||
-- >>> cwd <- getCurrentDirectory
|
||||
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
||||
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
|
||||
|
||||
|
||||
|
||||
@@ -462,33 +492,50 @@ hlsGHCVersions :: ( MonadReader env m
|
||||
)
|
||||
=> m [Version]
|
||||
hlsGHCVersions = do
|
||||
h <- hlsSet
|
||||
vers <- forM h $ \h' -> do
|
||||
bins <- hlsServerBinaries h'
|
||||
pure $ fmap
|
||||
(version
|
||||
. T.pack
|
||||
. fromJust
|
||||
. stripPrefix "haskell-language-server-"
|
||||
. head
|
||||
. splitOn "~"
|
||||
)
|
||||
bins
|
||||
pure . sortBy (flip compare) . rights . concat . maybeToList $ vers
|
||||
h <- hlsSet
|
||||
fromMaybe [] <$> forM h hlsGHCVersions'
|
||||
|
||||
|
||||
hlsGHCVersions' :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Version
|
||||
-> m [Version]
|
||||
hlsGHCVersions' v' = do
|
||||
bins <- hlsServerBinaries v' Nothing
|
||||
let vers = fmap
|
||||
(version
|
||||
. T.pack
|
||||
. fromJust
|
||||
. stripPrefix "haskell-language-server-"
|
||||
. head
|
||||
. splitOn "~"
|
||||
)
|
||||
bins
|
||||
pure . sortBy (flip compare) . rights $ vers
|
||||
|
||||
|
||||
-- | Get all server binaries for an hls version, if any.
|
||||
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
=> Version
|
||||
-> Maybe Version -- ^ optional GHC version
|
||||
-> m [FilePath]
|
||||
hlsServerBinaries ver = do
|
||||
hlsServerBinaries ver mghcVer = do
|
||||
Dirs {..} <- getDirs
|
||||
liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts
|
||||
compExtended
|
||||
execBlank
|
||||
([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
|
||||
([s|^haskell-language-server-|]
|
||||
<> maybe [s|.*|] escapeVerRex mghcVer
|
||||
<> [s|~|]
|
||||
<> escapeVerRex ver
|
||||
<> E.encodeUtf8 (T.pack exeExt)
|
||||
<> [s|$|] :: ByteString
|
||||
)
|
||||
)
|
||||
|
||||
@@ -517,7 +564,7 @@ hlsWrapperBinary ver = do
|
||||
-- | Get all binaries for an hls version, if any.
|
||||
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
|
||||
hlsAllBinaries ver = do
|
||||
hls <- hlsServerBinaries ver
|
||||
hls <- hlsServerBinaries ver Nothing
|
||||
wrapper <- hlsWrapperBinary ver
|
||||
pure (maybeToList wrapper ++ hls)
|
||||
|
||||
@@ -558,34 +605,83 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
|
||||
Just (x, y) -> x == major' && y == minor'
|
||||
Nothing -> False
|
||||
|
||||
-- | Match PVP prefix.
|
||||
--
|
||||
-- >>> matchPVPrefix [pver|8.8|] [pver|8.8.4|]
|
||||
-- True
|
||||
-- >>> matchPVPrefix [pver|8|] [pver|8.8.4|]
|
||||
-- True
|
||||
-- >>> matchPVPrefix [pver|8.10|] [pver|8.8.4|]
|
||||
-- False
|
||||
-- >>> matchPVPrefix [pver|8.10|] [pver|8.10.7|]
|
||||
-- True
|
||||
matchPVPrefix :: PVP -> PVP -> Bool
|
||||
matchPVPrefix (toL -> prefix) (toL -> full) = and $ zipWith (==) prefix full
|
||||
|
||||
-- | Get the latest installed full GHC version that satisfies X.Y.
|
||||
-- This reads `ghcupGHCBaseDir`.
|
||||
getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||
=> Int -- ^ major version component
|
||||
-> Int -- ^ minor version component
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForMajor major' minor' mt = do
|
||||
toL :: PVP -> [Int]
|
||||
toL (PVP inner) = fmap fromIntegral $ NE.toList inner
|
||||
|
||||
|
||||
-- | Get the latest installed full GHC version that satisfies the given (possibly partial)
|
||||
-- PVP version.
|
||||
getGHCForPVP :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||
=> PVP
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForPVP pvpIn mt = do
|
||||
ghcs <- rights <$> getInstalledGHCs
|
||||
-- we're permissive here... failed parse just means we have no match anyway
|
||||
let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
|
||||
pvp_ <- versionToPVP _tvVersion
|
||||
pure (pvp_, _tvTarget)
|
||||
|
||||
pure
|
||||
. lastMay
|
||||
. sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
|
||||
. filter
|
||||
(\GHCTargetVersion {..} ->
|
||||
_tvTarget == mt && matchMajor _tvVersion major' minor'
|
||||
)
|
||||
$ ghcs
|
||||
getGHCForPVP' pvpIn ghcs' mt
|
||||
|
||||
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
||||
--
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
|
||||
-- "Just 8.10.7"
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
|
||||
-- "Just 8.8.4"
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
|
||||
-- "Just 8.10.4"
|
||||
getGHCForPVP' :: MonadThrow m
|
||||
=> PVP
|
||||
-> [(PVP, Maybe Text)] -- ^ installed GHCs
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForPVP' pvpIn ghcs' mt = do
|
||||
let mResult = lastMay
|
||||
. sortBy (\(x, _) (y, _) -> compare x y)
|
||||
. filter
|
||||
(\(pvp_, target) ->
|
||||
target == mt && matchPVPrefix pvp_ pvpIn
|
||||
)
|
||||
$ ghcs'
|
||||
forM mResult $ \(pvp_, target) -> do
|
||||
ver' <- pvpToVersion pvp_
|
||||
pure (GHCTargetVersion target ver')
|
||||
|
||||
|
||||
-- | Get the latest available ghc for X.Y major version.
|
||||
getLatestGHCFor :: Int -- ^ major version component
|
||||
-> Int -- ^ minor version component
|
||||
-> GHCupDownloads
|
||||
-> Maybe (Version, VersionInfo)
|
||||
getLatestGHCFor major' minor' dls =
|
||||
preview (ix GHC % to Map.toDescList) dls >>= lastMay . filter (\(v, _) -> matchMajor v major' minor')
|
||||
-- | Get the latest available ghc for the given PVP version, which
|
||||
-- may only contain parts.
|
||||
--
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [10,7]})
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||
getLatestToolFor :: MonadThrow m
|
||||
=> Tool
|
||||
-> PVP
|
||||
-> GHCupDownloads
|
||||
-> m (Maybe (PVP, VersionInfo))
|
||||
getLatestToolFor tool pvpIn dls = do
|
||||
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
|
||||
pure . headMay . filter (\(v, _) -> matchPVPrefix pvpIn v) $ ps
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -689,11 +785,10 @@ intoSubdir bdir tardir = case tardir of
|
||||
-- | Get the tool version that has this tag. If multiple have it,
|
||||
-- picks the greatest version.
|
||||
getTagged :: Tag
|
||||
-> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
||||
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
||||
getTagged tag =
|
||||
to (Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||
% to Map.toDescList
|
||||
% _head
|
||||
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||
% folding id
|
||||
|
||||
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
||||
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
||||
@@ -824,7 +919,7 @@ getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
|
||||
getChangeLog dls tool (Left v') =
|
||||
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||
getChangeLog dls tool (Right tag) =
|
||||
preview (ix tool % getTagged tag % to snd % viChangeLog % _Just) dls
|
||||
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
||||
|
||||
|
||||
-- | Execute a build action while potentially cleaning up:
|
||||
|
||||
@@ -38,6 +38,7 @@ import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
import Control.Exception.Safe
|
||||
|
||||
@@ -105,6 +105,11 @@ findFiles path regex = do
|
||||
contents <- listDirectory path
|
||||
pure $ filter (match regex) contents
|
||||
|
||||
findFilesDeep :: FilePath -> Regex -> IO [FilePath]
|
||||
findFilesDeep path regex = do
|
||||
contents <- getDirectoryContentsRecursive path
|
||||
pure $ filter (match regex) contents
|
||||
|
||||
findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
|
||||
findFiles' path parser = do
|
||||
contents <- listDirectory path
|
||||
|
||||
5
lib/GHCup/Utils/File/Common.hs-boot
Normal file
5
lib/GHCup/Utils/File/Common.hs-boot
Normal file
@@ -0,0 +1,5 @@
|
||||
module GHCup.Utils.File.Common where
|
||||
|
||||
import Text.Regex.Posix
|
||||
|
||||
findFiles :: FilePath -> Regex -> IO [FilePath]
|
||||
@@ -17,6 +17,7 @@ module GHCup.Utils.File.Posix where
|
||||
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
|
||||
@@ -34,8 +35,7 @@ import Data.Sequence ( Seq, (|>) )
|
||||
import Data.List
|
||||
import Data.Word8
|
||||
import GHC.IO.Exception
|
||||
import System.Console.Pretty hiding ( Pretty )
|
||||
import System.Console.Regions
|
||||
import System.Console.Terminal.Common
|
||||
import System.IO.Error
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
@@ -51,6 +51,7 @@ import qualified Data.Sequence as Sq
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified System.Posix.Process as SPP
|
||||
import qualified System.Console.Terminal.Posix as TP
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified "unix-bytestring" System.Posix.IO.ByteString
|
||||
@@ -87,9 +88,9 @@ execLogged exe args chdir lfile env = do
|
||||
let logfile = logsDir </> lfile <> ".log"
|
||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
closeFd
|
||||
(action verbose)
|
||||
(action verbose noColor)
|
||||
where
|
||||
action verbose fd = do
|
||||
action verbose no_color fd = do
|
||||
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
|
||||
-- start the thread that logs to stdout
|
||||
pState <- newEmptyMVar
|
||||
@@ -100,7 +101,7 @@ execLogged exe args chdir lfile env = do
|
||||
$ EX.finally
|
||||
(if verbose
|
||||
then tee fd stdoutRead
|
||||
else printToRegion fd stdoutRead 6 pState
|
||||
else printToRegion fd stdoutRead 6 pState no_color
|
||||
)
|
||||
(putMVar done ())
|
||||
|
||||
@@ -137,46 +138,57 @@ execLogged exe args chdir lfile env = do
|
||||
|
||||
-- Reads fdIn and logs the output in a continous scrolling area
|
||||
-- of 'size' terminal lines. Also writes to a log file.
|
||||
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
|
||||
printToRegion fileFd fdIn size pState = do
|
||||
void $ displayConsoleRegions $ do
|
||||
rs <-
|
||||
liftIO
|
||||
. fmap Sq.fromList
|
||||
. sequence
|
||||
. replicate size
|
||||
. openConsoleRegion
|
||||
$ Linear
|
||||
flip runStateT mempty
|
||||
$ handle
|
||||
(\(ex :: SomeException) -> do
|
||||
ps <- liftIO $ takeMVar pState
|
||||
when ps (forM_ rs (liftIO . closeConsoleRegion))
|
||||
throw ex
|
||||
)
|
||||
$ readTilEOF (lineAction rs) fdIn
|
||||
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
|
||||
printToRegion fileFd fdIn size pState no_color = do
|
||||
-- init region
|
||||
forM_ [1..size] $ \_ -> BS.putStr "\n"
|
||||
|
||||
void $ flip runStateT mempty
|
||||
$ do
|
||||
handle
|
||||
(\(ex :: SomeException) -> do
|
||||
ps <- liftIO $ takeMVar pState
|
||||
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen))
|
||||
throw ex
|
||||
) $ readTilEOF lineAction fdIn
|
||||
|
||||
where
|
||||
clearScreen :: ByteString
|
||||
clearScreen = "\x1b[0J"
|
||||
clearLine :: ByteString
|
||||
clearLine = "\x1b[2K"
|
||||
moveLineUp :: Int -> ByteString
|
||||
moveLineUp n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "A"
|
||||
moveLineDown :: Int -> ByteString
|
||||
moveLineDown n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "B"
|
||||
pos1 :: ByteString
|
||||
pos1 = "\r"
|
||||
overwriteNthLine :: Int -> ByteString -> ByteString
|
||||
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
|
||||
|
||||
blue :: ByteString -> ByteString
|
||||
blue bs
|
||||
| no_color = bs
|
||||
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
|
||||
|
||||
-- action to perform line by line
|
||||
-- TODO: do this with vty for efficiency
|
||||
lineAction :: (MonadMask m, MonadIO m)
|
||||
=> Seq ConsoleRegion
|
||||
-> ByteString
|
||||
=> ByteString
|
||||
-> StateT (Seq ByteString) m ()
|
||||
lineAction rs = \bs' -> do
|
||||
lineAction = \bs' -> do
|
||||
void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
|
||||
modify (swapRegs bs')
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
|
||||
w <- consoleWidth
|
||||
return
|
||||
. T.pack
|
||||
. color Blue
|
||||
. T.unpack
|
||||
. decUTF8Safe
|
||||
. trim w
|
||||
. (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
|
||||
$ bs
|
||||
liftIO TP.size >>= \case
|
||||
Nothing -> pure ()
|
||||
Just (Window _ w) -> do
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
|
||||
BS.putStr
|
||||
. overwriteNthLine (size - i)
|
||||
. trim w
|
||||
. blue
|
||||
. (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
|
||||
$ bs
|
||||
|
||||
swapRegs :: a -> Seq a -> Seq a
|
||||
swapRegs bs = \regs -> if
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Logger
|
||||
@@ -16,21 +18,97 @@ module GHCup.Utils.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils.File
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Console.Pretty
|
||||
import System.FilePath
|
||||
import System.IO.Error
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import GHCup.Utils.Prelude
|
||||
import qualified Data.Text as T
|
||||
|
||||
logInfo :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logInfo = logInternal Info
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logWarn = logInternal Warn
|
||||
|
||||
logDebug :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logDebug = logInternal Debug
|
||||
|
||||
logError :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logError = logInternal Error
|
||||
|
||||
|
||||
logInternal :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
) => LogLevel
|
||||
-> Text
|
||||
-> m ()
|
||||
logInternal logLevel msg = do
|
||||
LoggerConfig {..} <- gets @"loggerConfig"
|
||||
let color' c = if fancyColors then color c else id
|
||||
let style' = case logLevel of
|
||||
Debug -> style Bold . color' Blue
|
||||
Info -> style Bold . color' Green
|
||||
Warn -> style Bold . color' Yellow
|
||||
Error -> style Bold . color' Red
|
||||
let l = case logLevel of
|
||||
Debug -> style' "[ Debug ]"
|
||||
Info -> style' "[ Info ]"
|
||||
Warn -> style' "[ Warn ]"
|
||||
Error -> style' "[ Error ]"
|
||||
let strs = T.split (== '\n') msg
|
||||
let out = case strs of
|
||||
[] -> T.empty
|
||||
(x:xs) ->
|
||||
foldr (\a b -> a <> "\n" <> b) mempty
|
||||
. ((l <> " " <> x) :)
|
||||
. fmap (\line' -> style' "[ ... ] " <> line' )
|
||||
$ xs
|
||||
|
||||
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
|
||||
$ liftIO $ consoleOutter out
|
||||
|
||||
-- raw output
|
||||
let lr = case logLevel of
|
||||
Debug -> "Debug:"
|
||||
Info -> "Info:"
|
||||
Warn -> "Warn:"
|
||||
Error -> "Error:"
|
||||
let outr = lr <> " " <> msg <> "\n"
|
||||
liftIO $ fileOutter outr
|
||||
|
||||
|
||||
initGHCupFileLogging :: ( MonadReader env m
|
||||
|
||||
21
lib/GHCup/Utils/Logger.hs-boot
Normal file
21
lib/GHCup/Utils/Logger.hs-boot
Normal file
@@ -0,0 +1,21 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Utils.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
|
||||
@@ -22,7 +22,9 @@ module GHCup.Utils.Prelude where
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Types
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.Logger
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
@@ -31,13 +33,14 @@ import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
|
||||
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
|
||||
import Data.Maybe
|
||||
import Data.Foldable
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
import Data.String
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Data.Word8
|
||||
import Data.Word8 hiding ( isDigit )
|
||||
import Haskus.Utils.Types.List
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
|
||||
@@ -58,6 +61,7 @@ import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.Strict.Maybe as S
|
||||
import qualified Data.List.Split as Split
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
@@ -295,12 +299,28 @@ removeLensFieldLabel str' =
|
||||
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
|
||||
|
||||
|
||||
pvpToVersion :: PVP -> Version
|
||||
pvpToVersion :: MonadThrow m => PVP -> m Version
|
||||
pvpToVersion =
|
||||
either (\_ -> error "Couldn't convert PVP to Version") id
|
||||
. version
|
||||
. prettyPVP
|
||||
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
|
||||
|
||||
versionToPVP :: MonadThrow m => Version -> m PVP
|
||||
versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
|
||||
where
|
||||
alternative :: MonadThrow m => Version -> m PVP
|
||||
alternative v' = case NE.takeWhile isDigit (_vChunks v') of
|
||||
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
|
||||
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
|
||||
|
||||
isDigit :: VChunk -> Bool
|
||||
isDigit (Digits _ :| []) = True
|
||||
isDigit _ = False
|
||||
|
||||
unsafeDigit :: VChunk -> Int
|
||||
unsafeDigit (Digits x :| []) = fromIntegral x
|
||||
unsafeDigit _ = error "unsafeDigit: wrong input"
|
||||
|
||||
pvpFromList :: [Int] -> PVP
|
||||
pvpFromList = PVP . NE.fromList . fmap fromIntegral
|
||||
|
||||
-- | Safe 'decodeUtf8With'. Replaces an invalid input byte with
|
||||
-- the Unicode replacement character U+FFFD.
|
||||
@@ -508,6 +528,10 @@ recover action =
|
||||
#endif
|
||||
|
||||
|
||||
copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
|
||||
copyFileE from = handleIO (throwE . CopyError . show) . liftIO . copyFile from
|
||||
|
||||
|
||||
-- | Gathering monoidal values
|
||||
--
|
||||
-- >>> traverseFold (pure . (:["0"])) ["1","2"]
|
||||
@@ -528,6 +552,8 @@ forFold = \t -> (`traverseFold` t)
|
||||
--
|
||||
-- >>> stripNewline "foo\n\n\n"
|
||||
-- "foo"
|
||||
-- >>> stripNewline "foo\n\n\nfoo"
|
||||
-- "foofoo"
|
||||
-- >>> stripNewline "foo\r"
|
||||
-- "foo"
|
||||
-- >>> stripNewline "foo"
|
||||
@@ -539,10 +565,29 @@ stripNewline :: String -> String
|
||||
stripNewline = filter (`notElem` "\n\r")
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from end of 'String'.
|
||||
--
|
||||
-- >>> stripNewlineEnd "foo\n\n\n"
|
||||
-- "foo"
|
||||
-- >>> stripNewlineEnd "foo\n\n\nfoo"
|
||||
-- "foo\n\n\nfoo"
|
||||
-- >>> stripNewlineEnd "foo\r"
|
||||
-- "foo"
|
||||
-- >>> stripNewlineEnd "foo"
|
||||
-- "foo"
|
||||
--
|
||||
-- prop> \t -> stripNewlineEnd (t <> "\n") === stripNewlineEnd t
|
||||
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewlineEnd t == t
|
||||
stripNewlineEnd :: String -> String
|
||||
stripNewlineEnd = dropWhileEnd (`elem` "\n\r")
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from 'Text's
|
||||
--
|
||||
-- >>> stripNewline' "foo\n\n\n"
|
||||
-- "foo"
|
||||
-- >>> stripNewline' "foo\n\n\nfoo"
|
||||
-- "foofoo"
|
||||
-- >>> stripNewline' "foo\r"
|
||||
-- "foo"
|
||||
-- >>> stripNewline' "foo"
|
||||
|
||||
43
lib/System/Console/Terminal/Common.hs
Normal file
43
lib/System/Console/Terminal/Common.hs
Normal file
@@ -0,0 +1,43 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 702
|
||||
#define LANGUAGE_DeriveGeneric
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
#endif
|
||||
|
||||
module System.Console.Terminal.Common
|
||||
( Window(..)
|
||||
) where
|
||||
|
||||
import Data.Data (Typeable, Data)
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Data.Foldable (Foldable)
|
||||
import Data.Traversable (Traversable)
|
||||
#endif
|
||||
|
||||
#ifdef LANGUAGE_DeriveGeneric
|
||||
import GHC.Generics
|
||||
( Generic
|
||||
#if __GLASGOW_HASKELL__ >= 706
|
||||
, Generic1
|
||||
#endif
|
||||
)
|
||||
#endif
|
||||
|
||||
-- | Terminal window width and height
|
||||
data Window a = Window
|
||||
{ height :: !a
|
||||
, width :: !a
|
||||
} deriving
|
||||
( Show, Eq, Read, Data, Typeable
|
||||
, Foldable, Functor, Traversable
|
||||
#ifdef LANGUAGE_DeriveGeneric
|
||||
, Generic
|
||||
#if __GLASGOW_HASKELL__ >= 706
|
||||
, Generic1
|
||||
#endif
|
||||
#endif
|
||||
)
|
||||
65
lib/System/Console/Terminal/Posix.hsc
Normal file
65
lib/System/Console/Terminal/Posix.hsc
Normal file
@@ -0,0 +1,65 @@
|
||||
{-# LANGUAGE CApiFFI #-}
|
||||
|
||||
module System.Console.Terminal.Posix
|
||||
( size, fdSize, hSize
|
||||
) where
|
||||
|
||||
import System.Console.Terminal.Common
|
||||
import Control.Exception (catch)
|
||||
import Data.Typeable (cast)
|
||||
import Foreign
|
||||
import Foreign.C.Error
|
||||
import Foreign.C.Types
|
||||
import GHC.IO.FD (FD(FD, fdFD))
|
||||
import GHC.IO.Handle.Internals (withHandle_)
|
||||
import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
|
||||
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
|
||||
import Prelude hiding (catch)
|
||||
#endif
|
||||
import System.Posix.Types (Fd(Fd))
|
||||
|
||||
#include <sys/ioctl.h>
|
||||
#include <unistd.h>
|
||||
|
||||
|
||||
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
|
||||
|
||||
|
||||
-- Interesting part of @struct winsize@
|
||||
data CWin = CWin CUShort CUShort
|
||||
|
||||
instance Storable CWin where
|
||||
sizeOf _ = (#size struct winsize)
|
||||
alignment _ = (#alignment struct winsize)
|
||||
peek ptr = do
|
||||
row <- (#peek struct winsize, ws_row) ptr
|
||||
col <- (#peek struct winsize, ws_col) ptr
|
||||
return $ CWin row col
|
||||
poke ptr (CWin row col) = do
|
||||
(#poke struct winsize, ws_row) ptr row
|
||||
(#poke struct winsize, ws_col) ptr col
|
||||
|
||||
|
||||
fdSize :: Integral n => Fd -> IO (Maybe (Window n))
|
||||
fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
|
||||
_ <- throwErrnoIfMinus1 "ioctl" $
|
||||
ioctl fd (#const TIOCGWINSZ) ws
|
||||
CWin row col <- peek ws
|
||||
return . Just $ Window (fromIntegral row) (fromIntegral col)
|
||||
`catch`
|
||||
handler
|
||||
where
|
||||
handler :: IOError -> IO (Maybe (Window h))
|
||||
handler _ = return Nothing
|
||||
|
||||
foreign import capi "sys/ioctl.h ioctl"
|
||||
ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
|
||||
|
||||
size :: Integral n => IO (Maybe (Window n))
|
||||
size = fdSize (Fd (#const STDOUT_FILENO))
|
||||
|
||||
hSize :: Integral n => Handle -> IO (Maybe (Window n))
|
||||
hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
|
||||
case cast dev of
|
||||
Nothing -> return Nothing
|
||||
Just FD { fdFD = fd } -> fdSize (Fd fd)
|
||||
@@ -1,5 +1,9 @@
|
||||
#!/bin/sh
|
||||
|
||||
# This script downloads the 'ghcup' binary into '~/.ghcup/bin/' and then runs an interactive
|
||||
# installation that lets you choose various options. Below is a list of environment variables
|
||||
# that affect the installation procedure.
|
||||
|
||||
# Main settings:
|
||||
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
|
||||
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
|
||||
@@ -21,7 +25,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.16.2"
|
||||
ghver="0.1.17.1"
|
||||
base_url="https://downloads.haskell.org/~ghcup"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -52,41 +56,57 @@ esac
|
||||
|
||||
|
||||
die() {
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
(>&2 printf "%s\\n" "$1")
|
||||
else
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
fi
|
||||
exit 2
|
||||
}
|
||||
|
||||
warn() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;35m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;35m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;35m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;35m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
yellow() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;33m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;33m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;33m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;33m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
green() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;32m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;32m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
edo() {
|
||||
|
||||
@@ -11,6 +11,8 @@
|
||||
* cabal - The Cabal build tool for managing Haskell software"
|
||||
* stack - (optional) A cross-platform program for developing Haskell projects"
|
||||
* hls - (optional) A language server for developers to integrate with their editor/IDE"
|
||||
|
||||
By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
|
||||
#>
|
||||
param (
|
||||
# Run an interactive installation
|
||||
|
||||
@@ -4,9 +4,6 @@ packages:
|
||||
- .
|
||||
|
||||
extra-deps:
|
||||
- git: https://github.com/bgamari/terminal-size
|
||||
commit: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
- git: https://github.com/hasufell/libarchive
|
||||
commit: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
|
||||
@@ -24,30 +24,29 @@
|
||||
</p>
|
||||
|
||||
<div id="platform-instructions-linux" class="instructions" style="display: none;">
|
||||
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running Linux. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p>On Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Linux</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-mac" class="instructions" style="display: none;">
|
||||
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<p>On macOS, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-normal">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running macOS</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-freebsd" class="instructions" style="display: none;">
|
||||
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<p>On FreeBSD Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running FreeBSD. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running FreeBSD</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-win32" class="instructions">
|
||||
<p>
|
||||
To install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
On Windows, to install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div>
|
||||
<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-powershell">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
</div>
|
||||
<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
</p>
|
||||
@@ -58,18 +57,19 @@
|
||||
</div>
|
||||
</p>
|
||||
<hr/>
|
||||
<p class="other-help">You appear to be running Windows 32-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-win64" class="instructions" style="display: none;">
|
||||
<p>
|
||||
To install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
On Windows, to install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run an non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
|
||||
</div>
|
||||
</p>
|
||||
<hr/>
|
||||
<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
</p>
|
||||
<div>
|
||||
@@ -77,7 +77,7 @@
|
||||
</div>
|
||||
<p class="other-help">WSL1 does not work with ghcup, follow <a href="https://docs.microsoft.com/en-us/windows/wsl/install-win10">the instructions here</a> to upgrade to WSL2 if needed.</p>
|
||||
</div>
|
||||
<p class="other-help">You appear to be running Windows 64-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-unknown" class="instructions" style="display: none;">
|
||||
@@ -101,7 +101,7 @@
|
||||
<div>
|
||||
<p>If you are running Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a></p>
|
||||
</div>
|
||||
|
||||
<hr/>
|
||||
@@ -120,7 +120,7 @@
|
||||
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run the following
|
||||
in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a></p>
|
||||
</div>
|
||||
|
||||
<hr/>
|
||||
@@ -130,7 +130,7 @@
|
||||
If you are running Windows,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a></p>
|
||||
</div>
|
||||
</p>
|
||||
</div>
|
||||
@@ -151,9 +151,9 @@
|
||||
ghcup is a haskell.org supported project.
|
||||
<br/>
|
||||
<a href="https://www.haskell.org/downloads/">other installation options</a>
|
||||
·
|
||||
<b> · </b>
|
||||
<a href="https://gitlab.haskell.org/haskell/ghcup-hs">about ghcup</a>
|
||||
·
|
||||
<b> · </b>
|
||||
<a href="https://github.com/rust-lang/rustup.rs/tree/master/www">web design from rustup</a>
|
||||
</p>
|
||||
<script type="text/javascript" src="ghcup.js"></script>
|
||||
|
||||
Reference in New Issue
Block a user