Skip to content

Commit

Permalink
Merge branch 'issue-892'
Browse files Browse the repository at this point in the history
  • Loading branch information
hasufell committed Oct 24, 2023
2 parents d145260 + 5f73320 commit 5fd0fa8
Show file tree
Hide file tree
Showing 24 changed files with 843 additions and 183 deletions.
10 changes: 8 additions & 2 deletions app/ghcup/BrickMain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
, listAttr
)
import Codec.Archive
import Control.Applicative
import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
Expand Down Expand Up @@ -432,7 +433,7 @@ filterVisible v t e | lInstalled e = True
(lTool e `notElem` hiddenTools)


install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
Expand Down Expand Up @@ -463,6 +464,11 @@ install' _ (_, ListResult {..}) = do
, ToolShadowed
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]

run (do
Expand Down Expand Up @@ -509,7 +515,7 @@ install' _ (_, ListResult {..}) = do
<> "Also check the logs in ~/.ghcup/logs"


set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
Expand Down
12 changes: 7 additions & 5 deletions app/ghcup/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,8 @@ toSettings options = do
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
stackSetupSource = fromMaybe (Types.stackSetupSource defaultSettings) uStackSetupSource
stackSetup = fromMaybe (Types.stackSetup defaultSettings) uStackSetup
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
Expand Down Expand Up @@ -339,11 +341,11 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, 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 (Install (Right InstallGHCOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallGHCOptions{..}))) (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 $ GHCVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
Expand Down
12 changes: 12 additions & 0 deletions data/config.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,18 @@ url-source:
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

# For stack's setup-info, this works similar, e.g.:
# stack-setup-source:
# AddSource:
# - Left:
# ghc:
# linux64-tinfo6:
# 9.4.7:
# url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
# content-length: 179117892
# sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a


# This is a way to override platform detection, e.g. when you're running
# a Ubuntu derivate based on 18.04, you could do:
#
Expand Down
32 changes: 32 additions & 0 deletions docs/guide.md
Original file line number Diff line number Diff line change
Expand Up @@ -246,6 +246,38 @@ stack config set install-ghc false --global
stack config set system-ghc true --global
```

### Using stack's setup-info metadata to install GHC

You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
to install GHC. For that, you can invoke ghcup like so:

```sh
ghcup install ghc --stack-setup 9.4.7
```

To make this permanent, you can add the following to you `~/.ghcup/config.yaml`:

```yaml
stack-setup: true
```

You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:

```yaml
stack-setup-source:
AddSource:
- Left:
ghc:
linux64-tinfo6:
9.4.7:
url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
content-length: 179117892
sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
```

The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
when you try to install HLS.

### Windows

On windows, you may find the following config options useful too:
Expand Down
2 changes: 2 additions & 0 deletions ghcup.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,9 @@ library
GHCup.Types
GHCup.Types.JSON
GHCup.Types.JSON.Utils
GHCup.Types.JSON.Versions
GHCup.Types.Optics
GHCup.Types.Stack
GHCup.Utils
GHCup.Utils.Dirs
GHCup.Version
Expand Down
2 changes: 1 addition & 1 deletion lib-opt/GHCup/OptParse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,7 @@ data Options = Options
}

data Command
= Install (Either InstallCommand InstallOptions)
= Install (Either InstallCommand InstallGHCOptions)
| Test TestCommand
| InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions)
Expand Down
4 changes: 3 additions & 1 deletion lib-opt/GHCup/OptParse/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -135,7 +135,9 @@ updateSettings usl usr =
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
mirrors' = uMirrors usl <|> uMirrors usr
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
stackSetupSource' = uStackSetupSource usl <|> uStackSetupSource usr
stackSetup' = uStackSetup usl <|> uStackSetup usr
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' stackSetupSource' stackSetup'
where
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
updateKeyBindings Nothing Nothing = Nothing
Expand Down
48 changes: 34 additions & 14 deletions lib-opt/GHCup/OptParse/Install.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ import qualified Data.Text as T
----------------


data InstallCommand = InstallGHC InstallOptions
data InstallCommand = InstallGHC InstallGHCOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
Expand All @@ -63,6 +63,15 @@ data InstallCommand = InstallGHC InstallOptions
--[ Options ]--
---------------

data InstallGHCOptions = InstallGHCOptions
{ instVer :: Maybe ToolVersion
, instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
, useStackSetup :: Maybe Bool
} deriving (Eq, Show)

data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
Expand Down Expand Up @@ -93,14 +102,14 @@ installCabalFooter = [s|Discussion:
--[ Parsers ]--
---------------

installParser :: Parser (Either InstallCommand InstallOptions)
installParser :: Parser (Either InstallCommand InstallGHCOptions)
installParser =
(Left <$> subparser
( command
"ghc"
( InstallGHC
<$> info
(installOpts (Just GHC) <**> helper)
(installGHCOpts <**> helper)
( progDesc "Install GHC"
<> footerDoc (Just $ text installGHCFooter)
)
Expand Down Expand Up @@ -134,7 +143,7 @@ installParser =
)
)
)
<|> (Right <$> installOpts Nothing)
<|> (Right <$> installGHCOpts)
where
installHLSFooter :: String
installHLSFooter = [s|Discussion:
Expand Down Expand Up @@ -210,6 +219,12 @@ installOpts tool =
Just GHC -> False
Just _ -> True

installGHCOpts :: Parser InstallGHCOptions
installGHCOpts =
(\InstallOptions{..} b -> let useStackSetup = b in InstallGHCOptions{..})
<$> installOpts (Just GHC)
<*> invertableSwitch "stack-setup" (Just 's') False (help "Set as active version after install")




Expand Down Expand Up @@ -291,6 +306,11 @@ type InstallGHCEffects = '[ AlreadyInstalled
, UninstallFailed
, UnknownArchive
, InstallSetError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]

runInstGHC :: AppState
Expand All @@ -308,21 +328,21 @@ runInstGHC appstate' =
-------------------


install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install :: Either InstallCommand InstallGHCOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install installCommand settings getAppState' runLogger = case installCommand of
(Right iopts) -> do
(Right iGHCopts) -> do
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
installGHC iopts
(Left (InstallGHC iopts)) -> installGHC iopts
(Left (InstallCabal iopts)) -> installCabal iopts
(Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts
installGHC iGHCopts
(Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
(Left (InstallCabal iopts)) -> installCabal iopts
(Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts
where
installGHC :: InstallOptions -> IO ExitCode
installGHC InstallOptions{..} = do
installGHC :: InstallGHCOptions -> IO ExitCode
installGHC InstallGHCOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstGHC s' $ do
Nothing -> runInstGHC s'{ settings = maybe settings (\b -> settings {stackSetup = b}) useStackSetup } $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
v
Expand Down
16 changes: 15 additions & 1 deletion lib-opt/GHCup/OptParse/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -187,6 +187,11 @@ type RunEffects = '[ AlreadyInstalled
, ProcessError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]

runLeanRUN :: (MonadUnliftIO m, MonadIO m)
Expand Down Expand Up @@ -226,6 +231,7 @@ run :: forall m .
, MonadCatch m
, MonadIO m
, MonadUnliftIO m
, Alternative m
)
=> RunOptions
-> IO AppState
Expand Down Expand Up @@ -255,7 +261,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
liftIO $ putStr tmp
pure ExitSuccess
(cmd:args) -> do
newEnv <- liftIO $ addToPath tmp runAppendPATH
newEnv <- liftIO $ addToPath [tmp] runAppendPATH
let pathVar = if isWindows then "Path" else "PATH"
forM_ (Map.lookup pathVar . Map.fromList $ newEnv) $ liftIO . setEnv pathVar
#ifndef IS_WINDOWS
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
pure ExitSuccess
Expand Down Expand Up @@ -329,6 +337,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
, MonadThrow m
, MonadIO m
, MonadCatch m
, Alternative m
)
=> Toolchain
-> FilePath
Expand All @@ -354,6 +363,11 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
, CopyError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
] (ResourceT (ReaderT AppState m)) ()
installToolChainFull Toolchain{..} tmp = do
case ghcVer of
Expand Down
Loading

0 comments on commit 5fd0fa8

Please sign in to comment.