Compare commits

..

3 Commits

Author SHA1 Message Date
e9db8f9895 WIP 2021-11-11 21:10:13 +01:00
7f542646dd Rename lots of modules 2021-11-05 22:57:15 +01:00
34910f853b Split GHCup.Utils.File module 2021-11-05 22:30:47 +01:00
57 changed files with 559 additions and 1699 deletions

View File

@@ -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"

View File

@@ -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

View File

@@ -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}" ]

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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 <> "'"

View File

@@ -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

View File

@@ -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 )

View File

@@ -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

View File

@@ -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 )

View File

@@ -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"
)

View File

@@ -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

View File

@@ -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 )

View File

@@ -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)

View File

@@ -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 )

View File

@@ -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 )

View File

@@ -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

View File

@@ -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 )

View File

@@ -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

View File

@@ -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 )

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

File diff suppressed because it is too large Load Diff

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -3,7 +3,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Logger where
module GHCup.Logger where
import GHCup.Types

View File

@@ -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

View File

@@ -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 )

View File

@@ -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

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.Prelude.Posix where
module GHCup.Prelude.Posix where
import System.Directory
import System.Posix.Files

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.Prelude.Windows where
module GHCup.Prelude.Windows where
import qualified System.Win32.File as Win32

View File

@@ -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

View File

@@ -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 )

View 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

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.Posix where
module GHCup.System.Console.Posix where
-- | Enables ANSI support on windows, does nothing on unix.

View File

@@ -3,7 +3,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Windows where
module GHCup.System.Console.Windows where
import Control.Exception.Safe

View File

@@ -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

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.File.Common where
module GHCup.System.Directory where
import Text.Regex.Posix

View 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

View 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

View File

@@ -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

View File

@@ -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)

View File

@@ -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 ( (<|>) )

View File

@@ -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 ()

View File

@@ -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

View 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
)

View 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)

View File

@@ -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*)

View File

@@ -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))) {

View File

@@ -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