Compare commits
3 Commits
freebsd133
...
rename
| Author | SHA1 | Date | |
|---|---|---|---|
|
e9db8f9895
|
|||
|
7f542646dd
|
|||
|
34910f853b
|
@@ -182,12 +182,12 @@ variables:
|
||||
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
|
||||
|
||||
# make sure to not pollute the machine with temp files etc
|
||||
- mkdir -p $CI_PROJECT_DIR/.brew_cache
|
||||
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
|
||||
- mkdir -p $CI_PROJECT_DIR/.brew_logs
|
||||
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
|
||||
- mkdir -p /private/tmp/.brew_tmp
|
||||
- export HOMEBREW_TEMP=/private/tmp/.brew_tmp
|
||||
- mkdir -p $CI_PROJECT_DIR/.bc
|
||||
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.bc
|
||||
- mkdir -p $CI_PROJECT_DIR/.bl
|
||||
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.bl
|
||||
- mkdir -p $CI_PROJECT_DIR/.bt
|
||||
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.bt
|
||||
|
||||
# update and install packages
|
||||
- brew update
|
||||
@@ -217,9 +217,6 @@ variables:
|
||||
- .freebsd13
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- sudo pkg update
|
||||
- sudo pkg install --yes compat12x-amd64
|
||||
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
|
||||
.test_ghcup_version:windows:
|
||||
@@ -544,12 +541,12 @@ release:darwin:aarch64:
|
||||
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
|
||||
|
||||
# make sure to not pollute the machine with temp files etc
|
||||
- mkdir -p $CI_PROJECT_DIR/.brew_cache
|
||||
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
|
||||
- mkdir -p $CI_PROJECT_DIR/.brew_logs
|
||||
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
|
||||
- mkdir -p /private/tmp/.brew_tmp
|
||||
- export HOMEBREW_TEMP=/private/tmp/.brew_tmp
|
||||
- mkdir -p $CI_PROJECT_DIR/.bc
|
||||
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.bc
|
||||
- mkdir -p $CI_PROJECT_DIR/.bl
|
||||
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.bl
|
||||
- mkdir -p $CI_PROJECT_DIR/.bt
|
||||
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.bt
|
||||
|
||||
# update and install packages
|
||||
- brew update
|
||||
@@ -598,9 +595,6 @@ release:freebsd13:
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- sudo pkg update
|
||||
- sudo pkg install --yes compat12x-amd64
|
||||
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
|
||||
@@ -12,8 +12,4 @@ if [ "${OS}" = "WINDOWS" ] ; then
|
||||
rm -Rf /c/ghcup
|
||||
fi
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
rm -Rf /private/tmp/.brew_tmp
|
||||
fi
|
||||
|
||||
exit 0
|
||||
|
||||
@@ -43,7 +43,7 @@ cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} --ghc ${GHC_VERSION}
|
||||
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
|
||||
|
||||
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
|
||||
|
||||
|
||||
@@ -1,14 +1,5 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.17.4 -- 2021-11-13
|
||||
|
||||
* add `--metadata-caching` option, allowing to also disable yaml metadata caching wrt [#278](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/278)
|
||||
* make upgrading ghcup in TUI more pleasant wrt [#276](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/276)
|
||||
* fix parsing of atypical GHC versions (e.g. `8.10.5-patch1`)
|
||||
* fix compiling HLS dynamically linked, also see [#245](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/245)
|
||||
* redo (and break) some of the `ghcup compile <tool>` interface, improving patch options and setting custom cabal.project files
|
||||
* avoid redundant update warnings wrt [#283](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283)
|
||||
|
||||
## 0.1.17.3 -- 2021-10-27
|
||||
|
||||
* clean up during unpack failures as well
|
||||
|
||||
@@ -13,9 +13,9 @@ import GHCup.Errors
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Logger
|
||||
import GHCup.Prelude ( decUTF8Safe )
|
||||
import GHCup.System.Process
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Border
|
||||
|
||||
@@ -12,9 +12,9 @@ module GHCup.OptParse.ChangeLog where
|
||||
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -34,8 +34,8 @@ import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import Data.Versions
|
||||
import URI.ByteString (serializeURIRef')
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.File (exec)
|
||||
import GHCup.Prelude
|
||||
import GHCup.System.Process (exec)
|
||||
import Data.Char (toLower)
|
||||
|
||||
|
||||
|
||||
@@ -14,9 +14,9 @@ import GHCup.Platform
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Logger
|
||||
import GHCup.MegaParsec
|
||||
import GHCup.Prelude
|
||||
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
@@ -89,18 +89,6 @@ toolVersionArgument criteria tool =
|
||||
mv _ = "VERSION|TAG"
|
||||
|
||||
|
||||
toolVersionOption :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionOption criteria tool =
|
||||
option (eitherReader toolVersionEither)
|
||||
( sh tool
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
sh (Just GHC) = long "ghc" <> metavar "GHC_VERSION|TAG"
|
||||
sh (Just HLS) = long "hls" <> metavar "HLS_VERSION|TAG"
|
||||
sh _ = long "version" <> metavar "VERSION|TAG"
|
||||
|
||||
|
||||
versionParser :: Parser GHCTargetVersion
|
||||
versionParser = option
|
||||
(eitherReader tVersionEither)
|
||||
@@ -208,8 +196,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
]
|
||||
|
||||
|
||||
uriParser :: String -> Either String URI
|
||||
uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
||||
bindistParser :: String -> Either String URI
|
||||
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
||||
|
||||
|
||||
absolutePathParser :: FilePath -> Either String FilePath
|
||||
@@ -258,6 +246,18 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
toolVersionParser :: Parser ToolVersion
|
||||
toolVersionParser = verP' <|> toolP
|
||||
where
|
||||
verP' = ToolVersion <$> versionParser
|
||||
toolP =
|
||||
ToolTag
|
||||
<$> option
|
||||
(eitherReader tagEither)
|
||||
(short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
|
||||
|
||||
|
||||
|
||||
|
||||
keepOnParser :: String -> Either String KeepDirs
|
||||
keepOnParser s' | t == T.pack "always" = Right Always
|
||||
@@ -472,22 +472,42 @@ checkForUpdates :: ( MonadReader env m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> m [(Tool, Version)]
|
||||
=> m ()
|
||||
checkForUpdates = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||
lInstalled <- listVersions Nothing (Just ListInstalled)
|
||||
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||
|
||||
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
|
||||
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
|
||||
forM_ (getLatest dls GHCup) $ \(l, _) -> do
|
||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
when (l > ghc_ver)
|
||||
$ logWarn $
|
||||
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
|
||||
|
||||
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
||||
forMM (getLatest dls t) $ \(l, _) -> do
|
||||
let mver = latestInstalled t
|
||||
forMM mver $ \ver ->
|
||||
if (l > ver) then pure $ Just (t, l) else pure Nothing
|
||||
forM_ (getLatest dls GHC) $ \(l, _) -> do
|
||||
let mghc_ver = latestInstalled GHC
|
||||
forM mghc_ver $ \ghc_ver ->
|
||||
when (l > ghc_ver)
|
||||
$ logWarn $
|
||||
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
|
||||
|
||||
pure $ catMaybes (ghcup:otherTools)
|
||||
where
|
||||
forMM a f = fmap join $ forM a f
|
||||
forM_ (getLatest dls Cabal) $ \(l, _) -> do
|
||||
let mcabal_ver = latestInstalled Cabal
|
||||
forM mcabal_ver $ \cabal_ver ->
|
||||
when (l > cabal_ver)
|
||||
$ logWarn $
|
||||
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls HLS) $ \(l, _) -> do
|
||||
let mhls_ver = latestInstalled HLS
|
||||
forM mhls_ver $ \hls_ver ->
|
||||
when (l > hls_ver)
|
||||
$ logWarn $
|
||||
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls Stack) $ \(l, _) -> do
|
||||
let mstack_ver = latestInstalled Stack
|
||||
forM mstack_ver $ \stack_ver ->
|
||||
when (l > stack_ver)
|
||||
$ logWarn $
|
||||
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
|
||||
|
||||
@@ -13,13 +13,13 @@ module GHCup.OptParse.Compile where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.QQ.String
|
||||
import GHCup.System.Process
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -40,7 +40,6 @@ import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import System.FilePath (isPathSeparator)
|
||||
@@ -69,7 +68,7 @@ data GHCCompileOptions = GHCCompileOptions
|
||||
, bootstrapGhc :: Either Version FilePath
|
||||
, jobs :: Maybe Int
|
||||
, buildConfig :: Maybe FilePath
|
||||
, patches :: Maybe (Either FilePath [URI])
|
||||
, patchDir :: Maybe FilePath
|
||||
, crossTarget :: Maybe Text
|
||||
, addConfArgs :: [Text]
|
||||
, setCompile :: Bool
|
||||
@@ -85,11 +84,10 @@ data HLSCompileOptions = HLSCompileOptions
|
||||
, setCompile :: Bool
|
||||
, ovewrwiteVer :: Maybe Version
|
||||
, isolateDir :: Maybe FilePath
|
||||
, cabalProject :: Maybe (Either FilePath URI)
|
||||
, cabalProjectLocal :: Maybe URI
|
||||
, patches :: Maybe (Either FilePath [URI])
|
||||
, cabalProject :: Maybe FilePath
|
||||
, cabalProjectLocal :: Maybe FilePath
|
||||
, patchDir :: Maybe FilePath
|
||||
, targetGHCs :: [ToolVersion]
|
||||
, cabalArgs :: [Text]
|
||||
}
|
||||
|
||||
|
||||
@@ -150,10 +148,7 @@ Examples:
|
||||
These need to be available in PATH prior to compilation.
|
||||
|
||||
Examples:
|
||||
# compile 1.4.0 for ghc 8.10.5 and 8.10.7
|
||||
ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
|
||||
# compile from master for ghc 8.10.7, linking everything dynamically
|
||||
ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
|
||||
ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
|
||||
|
||||
|
||||
ghcCompileOpts :: Parser GHCCompileOptions
|
||||
@@ -200,23 +195,13 @@ ghcCompileOpts =
|
||||
"Absolute path to build config file"
|
||||
)
|
||||
)
|
||||
<*> (optional
|
||||
(
|
||||
(fmap Right $ many $ option
|
||||
(eitherReader uriParser)
|
||||
(long "patch" <> metavar "PATCH_URI" <> help
|
||||
"URI to a patch (https/http/file)"
|
||||
)
|
||||
)
|
||||
<|>
|
||||
(fmap Left $ option
|
||||
str
|
||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
str
|
||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
str
|
||||
@@ -311,37 +296,26 @@ hlsCompileOpts =
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
|
||||
str
|
||||
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
|
||||
"If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
|
||||
"If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader uriParser)
|
||||
(eitherReader absolutePathParser)
|
||||
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
|
||||
"URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
|
||||
"Absolute path to a cabal.project.local to be used for the build. Will be copied over."
|
||||
)
|
||||
)
|
||||
<*> (optional
|
||||
(
|
||||
(fmap Right $ many $ option
|
||||
(eitherReader uriParser)
|
||||
(long "patch" <> metavar "PATCH_URI" <> help
|
||||
"URI to a patch (https/http/file)"
|
||||
)
|
||||
)
|
||||
<|>
|
||||
(fmap Left $ option
|
||||
str
|
||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader absolutePathParser)
|
||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> some (toolVersionOption Nothing (Just GHC))
|
||||
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
||||
<*> some (toolVersionArgument Nothing (Just GHC))
|
||||
|
||||
|
||||
|
||||
@@ -429,11 +403,11 @@ compile :: ( Monad m
|
||||
)
|
||||
=> CompileCommand
|
||||
-> Settings
|
||||
-> Dirs
|
||||
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
compile compileCommand settings runAppState runLogger = do
|
||||
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
|
||||
case compileCommand of
|
||||
(CompileHLS HLSCompileOptions { .. }) -> do
|
||||
runCompileHLS runAppState (do
|
||||
@@ -456,8 +430,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
isolateDir
|
||||
cabalProject
|
||||
cabalProjectLocal
|
||||
patches
|
||||
cabalArgs
|
||||
patchDir
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
when setCompile $ void $ liftE $
|
||||
@@ -504,7 +477,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
bootstrapGhc
|
||||
jobs
|
||||
buildConfig
|
||||
patches
|
||||
patchDir
|
||||
addConfArgs
|
||||
buildFlavour
|
||||
hadrian
|
||||
|
||||
@@ -14,9 +14,9 @@ module GHCup.OptParse.Config where
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Prelude
|
||||
import GHCup.Logger
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -17,9 +17,10 @@ import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Version
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Prelude
|
||||
import GHCup.Directories
|
||||
import GHCup.Logger
|
||||
import GHCup.System.Process
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -36,7 +37,6 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Utils.File
|
||||
import Language.Haskell.TH
|
||||
|
||||
|
||||
|
||||
@@ -14,8 +14,8 @@ module GHCup.OptParse.GC where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Logger
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -17,9 +17,9 @@ import GHCup.OptParse.Common
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Logger
|
||||
import GHCup.QQ.String
|
||||
import GHCup.System.Process
|
||||
|
||||
import Codec.Archive
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
@@ -37,7 +37,7 @@ import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
@@ -187,7 +187,7 @@ installOpts tool =
|
||||
<*> ( ( (,)
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader uriParser)
|
||||
(eitherReader bindistParser)
|
||||
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
|
||||
"Install the specified version from this bindist"
|
||||
)
|
||||
|
||||
@@ -11,7 +11,7 @@ module GHCup.OptParse.List where
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
import GHCup.Types
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
|
||||
@@ -14,7 +14,7 @@ module GHCup.OptParse.Nuke where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -14,9 +14,9 @@ module GHCup.OptParse.Prefetch where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -33,7 +33,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
import GHCup.Download (getDownloadsF)
|
||||
|
||||
|
||||
|
||||
@@ -18,9 +18,9 @@ import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -17,8 +17,8 @@ import GHCup.OptParse.Common
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Logger
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -10,7 +10,7 @@ module GHCup.OptParse.ToolRequirements where
|
||||
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -28,7 +28,7 @@ import qualified Data.Text.IO as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Platform
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
import GHCup.Requirements
|
||||
import System.IO
|
||||
|
||||
|
||||
@@ -16,8 +16,8 @@ module GHCup.OptParse.UnSet where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Logger
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -14,7 +14,7 @@ module GHCup.OptParse.Upgrade where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Logger
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -113,17 +113,17 @@ runUpgrade runAppState =
|
||||
|
||||
|
||||
upgrade :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> UpgradeOpts
|
||||
-> Bool
|
||||
-> Dirs
|
||||
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
upgrade uOpts force' Dirs{..} runAppState runLogger = do
|
||||
upgrade uOpts force' runAppState runLogger = do
|
||||
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
|
||||
target <- case uOpts of
|
||||
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
||||
(UpgradeAt p) -> pure $ Just p
|
||||
|
||||
@@ -17,8 +17,8 @@ import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Logger
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -20,11 +20,10 @@ import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics hiding ( toolRequirements )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Logger
|
||||
import GHCup.Prelude
|
||||
import GHCup.QQ.String
|
||||
import GHCup.Version
|
||||
|
||||
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
|
||||
@@ -40,7 +39,6 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions
|
||||
import GHC.IO.Encoding
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Language.Haskell.TH
|
||||
@@ -193,7 +191,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
-------------------------
|
||||
|
||||
|
||||
let appState = do
|
||||
appState = do
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
) >>= \case
|
||||
@@ -229,28 +227,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
#if defined(BRICK)
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
-- check for new tools
|
||||
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
||||
newTools <- lift checkForUpdates
|
||||
forM_ newTools $ \newTool@(t, l) -> do
|
||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
||||
alreadyInstalling' <- alreadyInstalling optCommand newTool
|
||||
when (not alreadyInstalling') $
|
||||
case t of
|
||||
GHCup -> runLogger $
|
||||
logWarn ("New GHCup version available: "
|
||||
<> prettyVer l
|
||||
<> ". To upgrade, run 'ghcup upgrade'")
|
||||
_ -> runLogger $
|
||||
logWarn ("New "
|
||||
<> T.pack (prettyShow t)
|
||||
<> " version available. "
|
||||
<> "To upgrade, run 'ghcup install "
|
||||
<> T.pack (prettyShow t)
|
||||
<> " "
|
||||
<> prettyVer l
|
||||
<> "'")
|
||||
Nothing -> runReaderT checkForUpdates s'
|
||||
Just _ -> pure ()
|
||||
|
||||
-- TODO: always run for windows
|
||||
@@ -292,11 +270,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
List lo -> list lo no_color runAppState
|
||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||
DInfo -> dinfo runAppState runLogger
|
||||
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
||||
Compile compileCommand -> compile compileCommand settings runAppState runLogger
|
||||
Config configCommand -> config configCommand settings keybindings runLogger
|
||||
Whereis whereisOptions
|
||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
|
||||
Upgrade uOpts force' -> upgrade uOpts force' runAppState runLogger
|
||||
ToolRequirements -> toolRequirements runAppState runLogger
|
||||
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
|
||||
Nuke -> nuke appState runLogger
|
||||
@@ -309,56 +287,4 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
pure ()
|
||||
|
||||
where
|
||||
alreadyInstalling :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Command
|
||||
-> (Tool, Version)
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m Bool
|
||||
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
|
||||
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
|
||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
|
||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
|
||||
alreadyInstalling _ _ = pure False
|
||||
|
||||
cmp' :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Tool
|
||||
-> Maybe ToolVersion
|
||||
-> Version
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m Bool
|
||||
cmp' tool instVer ver = do
|
||||
(v, _) <- liftE $ fromVersion instVer tool
|
||||
pure (v == mkTVer ver)
|
||||
|
||||
@@ -4,7 +4,6 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
@@ -29,10 +28,10 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base-compat ==0.12.0,
|
||||
any.base-compat-batteries ==0.12.0,
|
||||
any.base-orphans ==0.8.5,
|
||||
any.base16-bytestring ==1.0.1.0,
|
||||
any.base64-bytestring ==1.1.0.0,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
@@ -88,13 +87,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.5.0,
|
||||
any.hashable ==1.3.4.1,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.heaps ==0.4,
|
||||
any.hsc2hs ==0.68.8,
|
||||
any.hsc2hs ==0.68.7,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.7.10,
|
||||
any.hspec-core ==2.7.10,
|
||||
@@ -104,8 +103,8 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.http-io-streams ==0.1.6.0,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.indexed-traversable ==0.1.1,
|
||||
any.indexed-traversable-instances ==0.1,
|
||||
any.integer-gmp ==1.0.3.0,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
@@ -146,13 +145,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.3.0,
|
||||
any.primitive ==0.7.2.0,
|
||||
any.process ==1.6.13.2,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
any.recursion-schemes ==5.2.2.1,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.1,
|
||||
any.regex-posix ==0.96.0.1,
|
||||
@@ -165,13 +164,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
any.scientific ==0.3.7.0,
|
||||
scientific -bytestring-builder -integer-simple,
|
||||
any.semialign ==1.2.0.1,
|
||||
any.semialign ==1.2,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.6,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.1,
|
||||
any.streamly ==0.8.0,
|
||||
@@ -201,14 +200,14 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
any.transformers-compat ==0.7,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.6,
|
||||
any.unix-bytestring ==0.3.7.5,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.15.0,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
@@ -227,4 +226,4 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.zlib ==0.6.2.3,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-11-12T11:11:19Z
|
||||
index-state: hackage.haskell.org 2021-10-24T10:21:56Z
|
||||
|
||||
@@ -4,7 +4,6 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
@@ -29,10 +28,10 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.base ==4.15.0.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base-compat ==0.12.0,
|
||||
any.base-compat-batteries ==0.12.0,
|
||||
any.base-orphans ==0.8.5,
|
||||
any.base16-bytestring ==1.0.1.0,
|
||||
any.base64-bytestring ==1.1.0.0,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
@@ -89,13 +88,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.7.0,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.5.0,
|
||||
any.hashable ==1.3.4.1,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.heaps ==0.4,
|
||||
any.hsc2hs ==0.68.8,
|
||||
any.hsc2hs ==0.68.7,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.7.10,
|
||||
any.hspec-core ==2.7.10,
|
||||
@@ -105,8 +104,8 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.http-io-streams ==0.1.6.0,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.indexed-traversable ==0.1.1,
|
||||
any.indexed-traversable-instances ==0.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.1,
|
||||
@@ -146,13 +145,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.3.0,
|
||||
any.primitive ==0.7.2.0,
|
||||
any.process ==1.6.11.0,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
any.recursion-schemes ==5.2.2.1,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.1,
|
||||
any.regex-posix ==0.96.0.1,
|
||||
@@ -165,13 +164,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
any.scientific ==0.3.7.0,
|
||||
scientific -bytestring-builder -integer-simple,
|
||||
any.semialign ==1.2.0.1,
|
||||
any.semialign ==1.2,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.6,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.0,
|
||||
any.streamly ==0.8.0,
|
||||
@@ -201,14 +200,14 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
any.transformers-compat ==0.7,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.6,
|
||||
any.unix-bytestring ==0.3.7.5,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.15.0,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
@@ -227,4 +226,4 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.zlib ==0.6.2.3,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-11-12T11:11:19Z
|
||||
index-state: hackage.haskell.org 2021-10-24T10:21:56Z
|
||||
|
||||
@@ -8,15 +8,15 @@ package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size.git
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.Cabal ==3.6.2.0,
|
||||
any.aeson >= 2.0.1.0
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/input-output-hk/optparse-applicative
|
||||
tag: 7497a29cb998721a9068d5725d49461f2bba0e7a
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
|
||||
51
ghcup.cabal
51
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17.4
|
||||
version: 0.1.17.3
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@@ -51,8 +51,16 @@ flag no-exe
|
||||
library
|
||||
exposed-modules:
|
||||
GHCup
|
||||
GHCup.Data.Versions
|
||||
GHCup.GHC
|
||||
GHCup.GHC.Rm
|
||||
GHCup.GHC.Unset
|
||||
GHCup.GHC.Set
|
||||
GHCup.GHC.Compile
|
||||
GHCup.GHC.Common
|
||||
GHCup.GHC.Install
|
||||
GHCup.Download
|
||||
GHCup.Download.Utils
|
||||
GHCup.Download.Common
|
||||
GHCup.Errors
|
||||
GHCup.Platform
|
||||
GHCup.Requirements
|
||||
@@ -60,14 +68,16 @@ library
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Utils.File
|
||||
GHCup.Utils.File.Common
|
||||
GHCup.Utils.Logger
|
||||
GHCup.Utils.MegaParsec
|
||||
GHCup.Utils.Prelude
|
||||
GHCup.Utils.String.QQ
|
||||
GHCup.Utils.Version.QQ
|
||||
GHCup.Directories
|
||||
GHCup.System.Process
|
||||
GHCup.System.Directory
|
||||
GHCup.System.Process.Common
|
||||
GHCup.System.Console
|
||||
GHCup.Logger
|
||||
GHCup.MegaParsec
|
||||
GHCup.Prelude
|
||||
GHCup.QQ.String
|
||||
GHCup.QQ.Version
|
||||
GHCup.Version
|
||||
|
||||
hs-source-dirs: lib
|
||||
@@ -110,7 +120,7 @@ library
|
||||
, disk-free-space ^>=0.1.0.1
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.3.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
@@ -152,9 +162,9 @@ library
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
other-modules:
|
||||
GHCup.Utils.File.Windows
|
||||
GHCup.Utils.Prelude.Windows
|
||||
GHCup.Utils.Windows
|
||||
GHCup.System.Process.Windows
|
||||
GHCup.Prelude.Windows
|
||||
GHCup.System.Console.Windows
|
||||
|
||||
build-depends:
|
||||
, bzlib
|
||||
@@ -163,13 +173,14 @@ library
|
||||
|
||||
else
|
||||
other-modules:
|
||||
GHCup.Utils.File.Posix
|
||||
GHCup.Utils.Posix
|
||||
GHCup.Utils.Prelude.Posix
|
||||
GHCup.System.Process.Posix
|
||||
GHCup.System.Console.Posix
|
||||
GHCup.Prelude.Posix
|
||||
System.Console.Terminal.Common
|
||||
System.Console.Terminal.Posix
|
||||
|
||||
build-depends:
|
||||
, bz2 >=0.5.0.5 && <1.1
|
||||
, terminal-size ^>=0.3.2.1
|
||||
, unix ^>=2.7
|
||||
, unix-bytestring ^>=0.3.7.3
|
||||
|
||||
@@ -226,11 +237,11 @@ executable ghcup
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
, optparse-applicative-fork >=0.15.1.0 && <0.17
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, resourcet ^>=1.2.2
|
||||
|
||||
1025
lib/GHCup.hs
1025
lib/GHCup.hs
File diff suppressed because it is too large
Load Diff
@@ -5,7 +5,7 @@
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Dirs
|
||||
Module : GHCup.Directories
|
||||
Description : Definition of GHCup directories
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -13,7 +13,7 @@ Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Utils.Dirs
|
||||
module GHCup.Directories
|
||||
( getAllDirs
|
||||
, ghcupBaseDir
|
||||
, ghcupConfigFile
|
||||
@@ -35,9 +35,9 @@ import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.MegaParsec
|
||||
import GHCup.Logger
|
||||
import GHCup.Prelude
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
@@ -27,16 +27,16 @@ module GHCup.Download where
|
||||
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import GHCup.Download.IOStreams
|
||||
import GHCup.Download.Utils
|
||||
import GHCup.Download.Common
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
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.Directories
|
||||
import GHCup.System.Process
|
||||
import GHCup.Logger
|
||||
import GHCup.Prelude
|
||||
import GHCup.Version
|
||||
|
||||
import Control.Applicative
|
||||
|
||||
@@ -4,13 +4,13 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
|
||||
module GHCup.Download.Utils where
|
||||
module GHCup.Download.Common where
|
||||
|
||||
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
@@ -7,10 +7,10 @@
|
||||
module GHCup.Download.IOStreams where
|
||||
|
||||
|
||||
import GHCup.Download.Utils
|
||||
import GHCup.Download.Common
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Logger
|
||||
Module : GHCup.Logger
|
||||
Description : logger definition
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -14,12 +14,12 @@ Portability : portable
|
||||
|
||||
Here we define our main logger.
|
||||
-}
|
||||
module GHCup.Utils.Logger where
|
||||
module GHCup.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
import {-# SOURCE #-} GHCup.System.Directory
|
||||
import GHCup.QQ.String
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
@@ -34,7 +34,7 @@ import System.IO.Error
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
import qualified Data.Text as T
|
||||
|
||||
logInfo :: ( MonadReader env m
|
||||
@@ -3,7 +3,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Utils.Logger where
|
||||
module GHCup.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.MegaParsec
|
||||
Module : GHCup.MegaParsec
|
||||
Description : MegaParsec utilities
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -10,7 +10,7 @@ Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Utils.MegaParsec where
|
||||
module GHCup.MegaParsec where
|
||||
|
||||
import GHCup.Types
|
||||
|
||||
@@ -23,10 +23,10 @@ import GHCup.Errors
|
||||
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
|
||||
import GHCup.System.Process
|
||||
import GHCup.Logger
|
||||
import GHCup.Prelude
|
||||
import GHCup.QQ.String
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
||||
@@ -7,7 +7,7 @@
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Prelude
|
||||
Module : GHCup.Prelude
|
||||
Description : MegaParsec utilities
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -17,12 +17,12 @@ Portability : portable
|
||||
|
||||
GHCup specific prelude. Lots of Excepts functionality.
|
||||
-}
|
||||
module GHCup.Utils.Prelude
|
||||
(module GHCup.Utils.Prelude,
|
||||
module GHCup.Prelude
|
||||
(module GHCup.Prelude,
|
||||
#if defined(IS_WINDOWS)
|
||||
module GHCup.Utils.Prelude.Windows
|
||||
module GHCup.Prelude.Windows
|
||||
#else
|
||||
module GHCup.Utils.Prelude.Posix
|
||||
module GHCup.Prelude.Posix
|
||||
#endif
|
||||
)
|
||||
where
|
||||
@@ -30,11 +30,11 @@ where
|
||||
import GHCup.Types
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.Logger
|
||||
import {-# SOURCE #-} GHCup.Logger
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Utils.Prelude.Windows
|
||||
import GHCup.Prelude.Windows
|
||||
#else
|
||||
import GHCup.Utils.Prelude.Posix
|
||||
import GHCup.Prelude.Posix
|
||||
#endif
|
||||
|
||||
import Control.Applicative
|
||||
@@ -1,4 +1,4 @@
|
||||
module GHCup.Utils.Prelude.Posix where
|
||||
module GHCup.Prelude.Posix where
|
||||
|
||||
import System.Directory
|
||||
import System.Posix.Files
|
||||
@@ -1,4 +1,4 @@
|
||||
module GHCup.Utils.Prelude.Windows where
|
||||
module GHCup.Prelude.Windows where
|
||||
|
||||
import qualified System.Win32.File as Win32
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.String.QQ
|
||||
Module : GHCup.QQ.String
|
||||
Description : String quasi quoters
|
||||
Copyright : (c) Audrey Tang <audreyt@audreyt.org> 2019, Julian Ospald <hasufell@posteo.de> 2020
|
||||
License : LGPL-3.0
|
||||
@@ -30,7 +30,7 @@ Any instance of the IsString type is permitted.
|
||||
(For GHC versions 6, write "[$s||]" instead of "[s||]".)
|
||||
|
||||
-}
|
||||
module GHCup.Utils.String.QQ
|
||||
module GHCup.QQ.String
|
||||
( s
|
||||
)
|
||||
where
|
||||
@@ -8,7 +8,7 @@
|
||||
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Version.QQ
|
||||
Module : GHCup.QQ.Version
|
||||
Description : Version quasi-quoters
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -16,7 +16,7 @@ Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Utils.Version.QQ where
|
||||
module GHCup.QQ.Version where
|
||||
|
||||
import Data.Data
|
||||
import Data.Text ( Text )
|
||||
16
lib/GHCup/System/Console.hs
Normal file
16
lib/GHCup/System/Console.hs
Normal file
@@ -0,0 +1,16 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module GHCup.System.Console (
|
||||
#if IS_WINDOWS
|
||||
module GHCup.System.Console.Windows
|
||||
#else
|
||||
module GHCup.System.Console.Posix
|
||||
#endif
|
||||
) where
|
||||
|
||||
|
||||
#if IS_WINDOWS
|
||||
import GHCup.System.Console.Windows
|
||||
#else
|
||||
import GHCup.System.Console.Posix
|
||||
#endif
|
||||
@@ -1,4 +1,4 @@
|
||||
module GHCup.Utils.Posix where
|
||||
module GHCup.System.Console.Posix where
|
||||
|
||||
|
||||
-- | Enables ANSI support on windows, does nothing on unix.
|
||||
@@ -3,7 +3,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Utils.Windows where
|
||||
module GHCup.System.Console.Windows where
|
||||
|
||||
|
||||
import Control.Exception.Safe
|
||||
@@ -3,51 +3,24 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module GHCup.Utils.File.Common where
|
||||
module GHCup.System.Directory where
|
||||
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Prelude
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Void
|
||||
import GHC.IO.Exception
|
||||
import Optics hiding ((<|), (|>))
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
|
||||
data ProcessError = NonZeroExit Int FilePath [String]
|
||||
| PTerminated FilePath [String]
|
||||
| PStopped FilePath [String]
|
||||
| NoSuchPid FilePath [String]
|
||||
deriving Show
|
||||
|
||||
instance Pretty ProcessError where
|
||||
pPrint (NonZeroExit e exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
|
||||
pPrint (PTerminated exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
|
||||
pPrint (PStopped exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
|
||||
pPrint (NoSuchPid exe args) =
|
||||
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
|
||||
|
||||
data CapturedProcess = CapturedProcess
|
||||
{ _exitCode :: ExitCode
|
||||
, _stdOut :: BL.ByteString
|
||||
, _stdErr :: BL.ByteString
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''CapturedProcess
|
||||
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module GHCup.Utils.File.Common where
|
||||
module GHCup.System.Directory where
|
||||
|
||||
import Text.Regex.Posix
|
||||
|
||||
19
lib/GHCup/System/Process.hs
Normal file
19
lib/GHCup/System/Process.hs
Normal file
@@ -0,0 +1,19 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module GHCup.System.Process (
|
||||
module GHCup.System.Process.Common,
|
||||
#if IS_WINDOWS
|
||||
module GHCup.System.Process.Windows
|
||||
#else
|
||||
module GHCup.System.Process.Posix
|
||||
#endif
|
||||
) where
|
||||
|
||||
|
||||
#if IS_WINDOWS
|
||||
import GHCup.System.Process.Windows
|
||||
#else
|
||||
import GHCup.System.Process.Posix
|
||||
#endif
|
||||
|
||||
import GHCup.System.Process.Common
|
||||
37
lib/GHCup/System/Process/Common.hs
Normal file
37
lib/GHCup/System/Process/Common.hs
Normal file
@@ -0,0 +1,37 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module GHCup.System.Process.Common where
|
||||
|
||||
|
||||
import GHC.IO.Exception
|
||||
import Optics hiding ((<|), (|>))
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
|
||||
|
||||
|
||||
data ProcessError = NonZeroExit Int FilePath [String]
|
||||
| PTerminated FilePath [String]
|
||||
| PStopped FilePath [String]
|
||||
| NoSuchPid FilePath [String]
|
||||
deriving Show
|
||||
|
||||
instance Pretty ProcessError where
|
||||
pPrint (NonZeroExit e exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
|
||||
pPrint (PTerminated exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
|
||||
pPrint (PStopped exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
|
||||
pPrint (NoSuchPid exe args) =
|
||||
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
|
||||
|
||||
data CapturedProcess = CapturedProcess
|
||||
{ _exitCode :: ExitCode
|
||||
, _stdOut :: BL.ByteString
|
||||
, _stdErr :: BL.ByteString
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''CapturedProcess
|
||||
@@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.File.Posix
|
||||
Module : GHCup.System.Process.Posix
|
||||
Description : File and unix APIs
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -13,13 +13,13 @@ Portability : POSIX
|
||||
This module handles file and executable handling.
|
||||
Some of these functions use sophisticated logging.
|
||||
-}
|
||||
module GHCup.Utils.File.Posix where
|
||||
module GHCup.System.Process.Posix where
|
||||
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Prelude
|
||||
import GHCup.Logger
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.System.Process.Common
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
@@ -35,6 +35,7 @@ import Data.Sequence ( Seq, (|>) )
|
||||
import Data.List
|
||||
import Data.Word8
|
||||
import GHC.IO.Exception
|
||||
import System.Console.Terminal.Common
|
||||
import System.IO.Error
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
@@ -50,7 +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.Size as TP
|
||||
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
|
||||
@@ -72,7 +73,6 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
@@ -85,7 +85,6 @@ execLogged :: ( MonadReader env m
|
||||
execLogged exe args chdir lfile env = do
|
||||
Settings {..} <- getSettings
|
||||
Dirs {..} <- getDirs
|
||||
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||
let logfile = logsDir </> lfile <> ".log"
|
||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
closeFd
|
||||
@@ -181,7 +180,7 @@ execLogged exe args chdir lfile env = do
|
||||
modify (swapRegs bs')
|
||||
liftIO TP.size >>= \case
|
||||
Nothing -> pure ()
|
||||
Just (TP.Window _ w) -> do
|
||||
Just (Window _ w) -> do
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
|
||||
BS.putStr
|
||||
@@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.File.Windows
|
||||
Module : GHCup.System.Process.Windows
|
||||
Description : File and windows APIs
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
@@ -13,14 +13,14 @@ Portability : Windows
|
||||
This module handles file and executable handling.
|
||||
Some of these functions use sophisticated logging.
|
||||
-}
|
||||
module GHCup.Utils.File.Windows where
|
||||
module GHCup.System.Process.Windows where
|
||||
|
||||
import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Directories
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.System.Directory
|
||||
import GHCup.System.Process.Common
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.DeepSeq
|
||||
@@ -41,7 +41,6 @@ import qualified Control.Exception as EX
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
|
||||
@@ -151,7 +150,6 @@ executeOut path args chdir = do
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
@@ -163,7 +161,6 @@ execLogged :: ( MonadReader env m
|
||||
-> m (Either ProcessError ())
|
||||
execLogged exe args chdir lfile env = do
|
||||
Dirs {..} <- getDirs
|
||||
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
|
||||
stderrLogfile = logsDir </> lfile <> ".stderr.log"
|
||||
cp <- createProcessWithMingwPath ((proc exe args)
|
||||
@@ -22,9 +22,9 @@ Portability : portable
|
||||
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.
|
||||
import GHCup.MegaParsec
|
||||
import GHCup.Prelude
|
||||
import GHCup.Logger () -- TH is broken shite and needs GHCup.Logger for linking, although we don't depend on the file.
|
||||
-- This is due to the boot file.
|
||||
|
||||
import Control.Applicative ( (<|>) )
|
||||
|
||||
@@ -20,33 +20,37 @@ This module contains GHCup helpers specific to
|
||||
installation and introspection of files/versions etc.
|
||||
-}
|
||||
module GHCup.Utils
|
||||
( module GHCup.Utils.Dirs
|
||||
( module GHCup.Directories
|
||||
, module GHCup.Utils
|
||||
#if defined(IS_WINDOWS)
|
||||
, module GHCup.Utils.Windows
|
||||
, module GHCup.System.Console.Windows
|
||||
#else
|
||||
, module GHCup.Utils.Posix
|
||||
, module GHCup.System.Console.Posix
|
||||
#endif
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Utils.Windows
|
||||
import GHCup.System.Console.Windows
|
||||
#else
|
||||
import GHCup.Utils.Posix
|
||||
import GHCup.System.Console.Posix
|
||||
#endif
|
||||
import {-# SOURCE #-} GHCup.GHC.Common
|
||||
import {-# SOURCE #-} GHCup.GHC.Set
|
||||
import GHCup.Data.Versions
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
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
|
||||
import GHCup.Directories
|
||||
import GHCup.Logger
|
||||
import GHCup.MegaParsec
|
||||
import GHCup.Prelude
|
||||
import GHCup.QQ.String
|
||||
import GHCup.System.Directory
|
||||
import GHCup.System.Process
|
||||
|
||||
import Codec.Archive hiding ( Directory )
|
||||
import Control.Applicative
|
||||
@@ -67,7 +71,7 @@ import Data.List
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions hiding ( patch )
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
@@ -77,6 +81,7 @@ import System.FilePath
|
||||
import System.IO.Error
|
||||
import Text.Regex.Posix
|
||||
import URI.ByteString
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Codec.Compression.BZip as BZip
|
||||
import qualified Codec.Compression.GZip as GZip
|
||||
@@ -97,14 +102,14 @@ import qualified Data.List.NonEmpty as NE
|
||||
-- >>> import System.Directory
|
||||
-- >>> import URI.ByteString
|
||||
-- >>> import qualified Data.Text as T
|
||||
-- >>> import GHCup.Utils.Prelude
|
||||
-- >>> import GHCup.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 GHCup.QQ.Version
|
||||
-- >>> import qualified Data.Text.Encoding as E
|
||||
-- >>> import Control.Monad.Reader
|
||||
-- >>> import Haskus.Utils.Variant.Excepts
|
||||
@@ -120,161 +125,6 @@ import qualified Data.List.NonEmpty as NE
|
||||
|
||||
|
||||
|
||||
------------------------
|
||||
--[ Symlink handling ]--
|
||||
------------------------
|
||||
|
||||
|
||||
-- | The symlink destination of a ghc tool.
|
||||
ghcLinkDestination :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m, MonadIO m)
|
||||
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
|
||||
-> GHCTargetVersion
|
||||
-> m FilePath
|
||||
ghcLinkDestination tool ver = do
|
||||
Dirs {..} <- getDirs
|
||||
ghcd <- ghcupGHCDir ver
|
||||
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
|
||||
|
||||
|
||||
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
|
||||
rmMinorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
forM_ files $ \f -> do
|
||||
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
||||
let fullF = binDir </> f_xyz
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
-- | Removes the set ghc version for the given target, if any.
|
||||
rmPlain :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Maybe Text -- ^ target
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmPlain target = do
|
||||
Dirs {..} <- lift getDirs
|
||||
mtv <- lift $ ghcSet target
|
||||
forM_ mtv $ \tv -> do
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
forM_ files $ \f -> do
|
||||
let fullF = binDir </> f <> exeExt
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
-- old ghcup
|
||||
let hdc_file = binDir </> "haddock-ghc" <> exeExt
|
||||
lift $ logDebug ("rm -f " <> T.pack hdc_file)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink hdc_file
|
||||
|
||||
|
||||
-- | Remove the major GHC symlink, e.g. ghc-8.6.
|
||||
rmMajorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
(mj, mi) <- getMajorMinorV _tvVersion
|
||||
let v' = intToText mj <> "." <> intToText mi
|
||||
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
forM_ files $ \f -> do
|
||||
let f_xy = f <> "-" <> T.unpack v' <> exeExt
|
||||
let fullF = binDir </> f_xy
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------------------------
|
||||
--[ Set/Installed introspection ]--
|
||||
-----------------------------------
|
||||
|
||||
|
||||
-- | Whether the given GHC versin is installed.
|
||||
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcInstalled ver = do
|
||||
ghcdir <- ghcupGHCDir ver
|
||||
liftIO $ doesDirectoryExist ghcdir
|
||||
|
||||
|
||||
-- | Whether the given GHC version is installed from source.
|
||||
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcSrcInstalled ver = do
|
||||
ghcdir <- ghcupGHCDir ver
|
||||
liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
|
||||
|
||||
|
||||
-- | Whether the given GHC version is set as the current.
|
||||
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||
=> Maybe Text -- ^ the target of the GHC version, if any
|
||||
-- (e.g. armv7-unknown-linux-gnueabihf)
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
ghcSet mtarget = do
|
||||
Dirs {..} <- getDirs
|
||||
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
|
||||
let ghcBin = binDir </> ghc <> exeExt
|
||||
|
||||
-- link destination is of the form ../ghc/<ver>/bin/ghc
|
||||
-- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
|
||||
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
link <- liftIO $ getLinkTarget ghcBin
|
||||
Just <$> ghcLinkVersion link
|
||||
where
|
||||
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
|
||||
ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
|
||||
where
|
||||
parser =
|
||||
(do
|
||||
_ <- parseUntil1 ghcSubPath
|
||||
_ <- ghcSubPath
|
||||
r <- parseUntil1 pathSep
|
||||
rest <- MP.getInput
|
||||
MP.setInput r
|
||||
x <- ghcTargetVerP
|
||||
MP.setInput rest
|
||||
pure x
|
||||
)
|
||||
<* pathSep
|
||||
<* MP.takeRest
|
||||
<* MP.eof
|
||||
ghcSubPath = pathSep <* MP.chunk "ghc" *> pathSep
|
||||
|
||||
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
|
||||
-- If a dir cannot be parsed, returns left.
|
||||
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
||||
getInstalledGHCs = do
|
||||
ghcdir <- ghcupGHCBaseDir
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
|
||||
forM fs $ \f -> case parseGHCupGHCDir f of
|
||||
Right r -> pure $ Right r
|
||||
Left _ -> pure $ Left f
|
||||
|
||||
|
||||
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
||||
@@ -588,79 +438,6 @@ hlsSymlinks = do
|
||||
|
||||
|
||||
|
||||
-----------------------------------------
|
||||
--[ Major version introspection (X.Y) ]--
|
||||
-----------------------------------------
|
||||
|
||||
|
||||
-- | Extract (major, minor) from any version.
|
||||
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
|
||||
getMajorMinorV Version {..} = case _vChunks of
|
||||
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
|
||||
_ -> throwM $ ParseError "Could not parse X.Y from version"
|
||||
|
||||
|
||||
matchMajor :: Version -> Int -> Int -> Bool
|
||||
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
|
||||
|
||||
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_, rest) <- versionToPVP _tvVersion
|
||||
pure (pvp_, rest, _tvTarget)
|
||||
|
||||
getGHCForPVP' pvpIn ghcs' mt
|
||||
|
||||
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
||||
--
|
||||
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
|
||||
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
|
||||
-- >>> 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, Text, 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_, rest, target) -> do
|
||||
ver' <- pvpToVersion pvp_ rest
|
||||
pure (GHCTargetVersion target ver')
|
||||
|
||||
|
||||
-- | Get the latest available ghc for the given PVP version, which
|
||||
@@ -810,39 +587,6 @@ getLatestBaseVersion av pvpVer =
|
||||
-------------
|
||||
|
||||
|
||||
-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
|
||||
-- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
|
||||
--
|
||||
-- Returns unversioned relative files without extension, e.g.:
|
||||
--
|
||||
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
|
||||
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m [FilePath]
|
||||
ghcToolFiles ver = do
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
let bindir = ghcdir </> "bin"
|
||||
|
||||
-- fail if ghc is not installed
|
||||
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
||||
(throwE (NotInstalled GHC ver))
|
||||
|
||||
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
|
||||
|
||||
where
|
||||
|
||||
groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
|
||||
groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
|
||||
|
||||
getUniqueTools :: [[(FilePath, String)]] -> [String]
|
||||
getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
|
||||
|
||||
blackListedTools :: [String]
|
||||
blackListedTools = ["haddock-ghc"]
|
||||
|
||||
isNotAnyInfix :: [String] -> String -> Bool
|
||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
||||
|
||||
|
||||
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
|
||||
@@ -856,7 +600,6 @@ make :: ( MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
)
|
||||
=> [String]
|
||||
@@ -892,22 +635,15 @@ applyPatches pdir ddir = do
|
||||
execBlank
|
||||
([s|.+\.(patch|diff)$|] :: ByteString)
|
||||
)
|
||||
forM_ (sort patches) $ \patch' -> applyPatch patch' ddir
|
||||
|
||||
|
||||
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
||||
=> FilePath -- ^ Patch
|
||||
-> FilePath -- ^ dir to apply patches in
|
||||
-> Excepts '[PatchFailed] m ()
|
||||
applyPatch patch ddir = do
|
||||
lift $ logInfo $ "Applying patch " <> T.pack patch
|
||||
fmap (either (const Nothing) Just)
|
||||
(exec
|
||||
"patch"
|
||||
["-p1", "-s", "-f", "-i", patch]
|
||||
(Just ddir)
|
||||
Nothing)
|
||||
!? PatchFailed
|
||||
forM_ (sort patches) $ \patch' -> do
|
||||
lift $ logInfo $ "Applying patch " <> T.pack patch'
|
||||
fmap (either (const Nothing) Just)
|
||||
(exec
|
||||
"patch"
|
||||
["-p1", "-i", patch']
|
||||
(Just ddir)
|
||||
Nothing)
|
||||
!? PatchFailed
|
||||
|
||||
|
||||
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
|
||||
@@ -1141,11 +877,41 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
|
||||
|
||||
-- | For ghc without arch triple, this is:
|
||||
--
|
||||
-- - ghc
|
||||
-- - ghc-<ver> (e.g. ghc-8.10.4)
|
||||
--
|
||||
-- For ghc with arch triple:
|
||||
--
|
||||
-- - <triple>-ghc (e.g. arm-linux-gnueabihf-ghc)
|
||||
-- - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4)
|
||||
ghcBinaryName :: GHCTargetVersion -> String
|
||||
ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
|
||||
|
||||
|
||||
|
||||
-- | Warn if the installed and set HLS is not compatible with the installed and
|
||||
-- set GHC version.
|
||||
warnAboutHlsCompatibility :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
)
|
||||
=> m ()
|
||||
warnAboutHlsCompatibility = do
|
||||
supportedGHC <- hlsGHCVersions
|
||||
currentGHC <- fmap _tvVersion <$> ghcSet Nothing
|
||||
currentHLS <- hlsSet
|
||||
|
||||
case (currentGHC, currentHLS) of
|
||||
(Just gv, Just hv) | gv `notElem` supportedGHC -> do
|
||||
logWarn $
|
||||
"GHC " <> T.pack (prettyShow gv) <> " is not compatible with " <>
|
||||
"Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
|
||||
"Haskell IDE support may not work until this is fixed." <> "\n" <>
|
||||
"Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
|
||||
T.pack (prettyShow supportedGHC)
|
||||
|
||||
_ -> return ()
|
||||
|
||||
|
||||
|
||||
@@ -1,17 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module GHCup.Utils.File (
|
||||
module GHCup.Utils.File.Common,
|
||||
#if IS_WINDOWS
|
||||
module GHCup.Utils.File.Windows
|
||||
#else
|
||||
module GHCup.Utils.File.Posix
|
||||
#endif
|
||||
) where
|
||||
|
||||
import GHCup.Utils.File.Common
|
||||
#if IS_WINDOWS
|
||||
import GHCup.Utils.File.Windows
|
||||
#else
|
||||
import GHCup.Utils.File.Posix
|
||||
#endif
|
||||
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)
|
||||
@@ -25,7 +25,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.17.4"
|
||||
ghver="0.1.17.3"
|
||||
base_url="https://downloads.haskell.org/~ghcup"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -39,6 +39,7 @@ case "${plat}" in
|
||||
;;
|
||||
*)
|
||||
: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
|
||||
export GHCUP_USE_XDG_DIRS
|
||||
|
||||
if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
|
||||
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
|
||||
@@ -236,7 +237,7 @@ download_ghcup() {
|
||||
*) die "Unknown architecture: ${arch}"
|
||||
;;
|
||||
esac
|
||||
_url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
|
||||
_url=${base_url}/${ghver}/x86_64-portbld-freebsd${freebsd_ver}-ghcup-${ghver}
|
||||
;;
|
||||
"Darwin"|"darwin")
|
||||
case "${arch}" in
|
||||
@@ -678,7 +679,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||
|
||||
do_cabal_config_init $ask_cabal_config_init_answer
|
||||
|
||||
edo cabal new-update --ignore-project
|
||||
edo cabal new-update
|
||||
else # don't install ghc and cabal
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
|
||||
@@ -246,7 +246,6 @@ if ($Silent -and !($InstallDir)) {
|
||||
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
|
||||
}
|
||||
|
||||
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
|
||||
if (!($GhcupBasePrefix)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) {
|
||||
@@ -334,7 +333,6 @@ if ($CabalDir) {
|
||||
$CabalDirPrompt = Read-Host
|
||||
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
|
||||
|
||||
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
|
||||
if (!($CabDirEnv)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||
@@ -446,7 +444,6 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
|
||||
$MsysDir = Read-Host
|
||||
}
|
||||
$MsysDir = $MsysDir.TrimEnd().TrimStart()
|
||||
if (!($MsysDir)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
|
||||
|
||||
@@ -16,6 +16,7 @@ extra-deps:
|
||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
|
||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||
@@ -39,11 +40,6 @@ extra-deps:
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- yaml-streamly-0.12.0
|
||||
|
||||
- git: https://github.com/hasufell/packages.git
|
||||
commit: cc0b4688f8bb374fa92f17c856949de795b56291
|
||||
subdirs:
|
||||
- haskus-utils-variant
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
brotli: false
|
||||
|
||||
Reference in New Issue
Block a user