Merge branch 'issue-892'

Author: hasufell

app/ghcup/BrickMain.hs

@@ -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 )
@@ -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 ())
@@ -463,6 +464,11 @@ install' _ (_, ListResult {..}) = do
               , ToolShadowed
               , UninstallFailed
               , MergeFileTreeError
+              , NoCompatiblePlatform
+              , GHCup.Errors.ParseError
+              , UnsupportedSetupCombo
+              , DistroNotFound
+              , NoCompatibleArch
               ]
 
   run (do
@@ -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 ())

app/ghcup/Main.hs

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

data/config.yaml

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

docs/guide.md

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

ghcup.cabal

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

lib-opt/GHCup/OptParse.hs

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

lib-opt/GHCup/OptParse/Config.hs

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

lib-opt/GHCup/OptParse/Install.hs

@@ -50,7 +50,7 @@ import qualified Data.Text                     as T
     ----------------
 
 
-data InstallCommand = InstallGHC InstallOptions
+data InstallCommand = InstallGHC InstallGHCOptions
                     | InstallCabal InstallOptions
                     | InstallHLS InstallOptions
                     | InstallStack InstallOptions
@@ -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
@@ -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)
                 )
@@ -134,7 +143,7 @@ installParser =
            )
       )
     )
-    <|> (Right <$> installOpts Nothing)
+    <|> (Right <$> installGHCOpts)
  where
   installHLSFooter :: String
   installHLSFooter = [s|Discussion:
@@ -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")
+
 
 
 
@@ -291,6 +306,11 @@ type InstallGHCEffects = '[ AlreadyInstalled
                           , UninstallFailed
                           , UnknownArchive
                           , InstallSetError
+                          , NoCompatiblePlatform
+                          , GHCup.Errors.ParseError
+                          , UnsupportedSetupCombo
+                          , DistroNotFound
+                          , NoCompatibleArch
                           ]
 
 runInstGHC :: AppState
@@ -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

lib-opt/GHCup/OptParse/Run.hs

@@ -187,6 +187,11 @@ type RunEffects = '[ AlreadyInstalled
                    , ProcessError
                    , UninstallFailed
                    , MergeFileTreeError
+                   , NoCompatiblePlatform
+                   , GHCup.Errors.ParseError
+                   , UnsupportedSetupCombo
+                   , DistroNotFound
+                   , NoCompatibleArch
                    ]
 
 runLeanRUN :: (MonadUnliftIO m, MonadIO m)
@@ -226,6 +231,7 @@ run :: forall m .
        , MonadCatch m
        , MonadIO m
        , MonadUnliftIO m
+       , Alternative m
        )
    => RunOptions
    -> IO AppState
@@ -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
@@ -329,6 +337,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                            , MonadThrow m
                            , MonadIO m
                            , MonadCatch m
+                           , Alternative m
                            )
                         => Toolchain
                         -> FilePath
@@ -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