Fix opening changelog on windows

We show all tools at the moment anyway.

app/ghcup/BrickMain.hs

@@ -52,6 +52,7 @@ import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
 import           System.IO.Unsafe
+import           System.Process                 ( system )
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
 
@@ -89,9 +90,6 @@ notInstalledSign = "X "
 notInstalledSign = "✗ "
 #endif
 
-hiddenTools :: [Tool]
-hiddenTools = []
-
 
 data BrickData = BrickData
   { lr    :: [ListResult]
@@ -100,7 +98,6 @@ data BrickData = BrickData
 
 data BrickSettings = BrickSettings
   { showAllVersions    :: Bool
-  , showAllTools       :: Bool
   }
   deriving Show
 
@@ -134,19 +131,14 @@ keyHandlers KeyBindings {..} =
   , ( bShowAllVersions
     , \BrickSettings {..} ->
        if showAllVersions then "Don't show all versions" else "Show all versions"
-    , hideShowHandler (not . showAllVersions) showAllTools
+    , hideShowHandler (not . showAllVersions)
-    )
-  , ( bShowAllTools
-    , \BrickSettings {..} ->
-       if showAllTools then "Don't show all tools" else "Show all tools"
-    , hideShowHandler showAllVersions (not . showAllTools)
     )
   , (bUp, const "Up", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Up, .. })
   , (bDown, const "Down", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Down, .. })
   ]
  where
-  hideShowHandler f p BrickState{..} =
+  hideShowHandler f BrickState{..} =
-    let newAppSettings   = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
+    let newAppSettings   = appSettings { showAllVersions = f appSettings }
         newInternalState = constructList appData newAppSettings (Just appState)
     in  put (BrickState appData newAppSettings newInternalState appKeys)
 
@@ -411,8 +403,7 @@ constructList :: BrickData
               -> Maybe BrickInternalState
               -> BrickInternalState
 constructList appD appSettings =
-  replaceLR (filterVisible (showAllVersions appSettings)
+  replaceLR (filterVisible (showAllVersions appSettings))
-                           (showAllTools appSettings))
             (lr appD)
 
 listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
@@ -443,22 +434,15 @@ replaceLR filterF lr s =
     lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
 
 
-filterVisible :: Bool -> Bool -> ListResult -> Bool
+filterVisible :: Bool -> ListResult -> Bool
-filterVisible v t e | lInstalled e = True
+filterVisible v e | lInstalled e = True
-                    | v
+                  | v
-                    , not t
+                  , Nightly `notElem` lTag e = True
-                    , Nightly `notElem` lTag e
+                  | not v
-                    , lTool e `notElem` hiddenTools = True
+                  , Old `notElem` lTag e
-                    | not v
+                  , Nightly `notElem` lTag e = True
-                    , t
+                  | otherwise = (Old `notElem` lTag e)       &&
-                    , Old `notElem` lTag e
+                                  (Nightly `notElem` lTag e)
-                    , Nightly `notElem` lTag e = True
-                    | v
-                    , Nightly `notElem` lTag e
-                    , t = True
-                    | otherwise = (Old `notElem` lTag e)       &&
-                                  (Nightly `notElem` lTag e)   &&
-                                  (lTool e `notElem` hiddenTools)
 
 
 install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
@@ -661,12 +645,18 @@ changelog' _ (_, ListResult {..}) = do
     Nothing -> pure $ Left $
       "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
     Just uri -> do
-      let cmd = case _rPlatform pfreq of
+      case _rPlatform pfreq of
-            Darwin  -> "open"
+            Darwin  -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-            Linux _ -> "xdg-open"
+            Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-            FreeBSD -> "xdg-open"
+            FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-            Windows -> "start"
+            Windows -> do
-      exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
+              let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
+              c <- liftIO $ system $ args
+              case c of
+                 (ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
+                 ExitSuccess -> pure $ Right ()
+
+       >>= \case
         Right _ -> pure $ Right ()
         Left  e -> pure $ Left $ prettyHFError e
 
@@ -712,7 +702,7 @@ brickMain s = do
 
 
 defaultAppSettings :: BrickSettings
-defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = False }
+defaultAppSettings = BrickSettings { showAllVersions = False }
 
 
 getGHCupInfo :: IO (Either String GHCupInfo)

app/ghcup/Main.hs

@@ -107,7 +107,6 @@ toSettings options = do
          , bSet = fromMaybe bSet kSet
          , bChangelog = fromMaybe bChangelog kChangelog
          , bShowAllVersions = fromMaybe bShowAllVersions kShowAll
-         , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
          }
 
 

docs/guide.md

@@ -508,6 +508,9 @@ libraries, this may need some tweaking of `build.mk` or configure args.
 See `ghcup compile ghc --help` for further information.
 
 Since ghcup version 0.1.20.0, we provide cross bindists for GHC JS and WASM. These can be installed conveniently.
+However, these are intended as a developer preview only. By using these GHC variants, you are implicitly signing up to participate in GHC development!
+If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org. 
+
 First, add the cross release channel:
 
 ```sh
@@ -516,7 +519,7 @@ ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup
 
 The next sections explain how to install each cross bindist.
 
-### GHC JS cross bindists
+### GHC JS cross bindists (experimental)
 
 You need the required emscripten JS toolchain:
 
@@ -546,7 +549,7 @@ javascript-unknown-ghcjs-ghc -fforce-recomp hello.hs
 
 You can follow the instructions [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/building#compiling-hello-world).
 
-### GHC WASM cross bindists
+### GHC WASM cross bindists (experimental)
 
 You need the required wasm toolchain:
 

lib-opt/GHCup/OptParse/ChangeLog.hs

@@ -29,6 +29,7 @@ import           Data.Maybe
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
+import           System.Process                 ( system )
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
@@ -128,21 +129,22 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
     Just uri -> do
       pfreq <- runAppState getPlatformReq
       let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
-          cmd = case _rPlatform pfreq of
-                  Darwin  -> "open"
-                  Linux _ -> "xdg-open"
-                  FreeBSD -> "xdg-open"
-                  Windows -> "start"
-
       if clOpen
         then do
           runAppState $
-            exec cmd
+            case _rPlatform pfreq of
-                 [T.unpack $ decUTF8Safe $ serializeURIRef' uri]
+              Darwin  -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-                 Nothing
+              Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-                 Nothing
+              FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
+              Windows -> do
+                let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
+                c <- liftIO $ system $ args
+                case c of
+                   (ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
+                   ExitSuccess -> pure $ Right ()
               >>= \case
                     Right _ -> pure ExitSuccess
                     Left  e -> logError (T.pack $ prettyHFError e)
                       >> pure (ExitFailure 13)
         else liftIO $ putStrLn uri' >> pure ExitSuccess
+

lib-opt/GHCup/OptParse/Config.hs

@@ -149,7 +149,6 @@ updateSettings usl usr =
          , kSet = kSet kbl <|> kSet kbr
          , kChangelog = kChangelog kbl <|> kChangelog kbr
          , kShowAll = kShowAll kbl <|> kShowAll kbr
-         , kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
          }
 
 

lib/GHCup/Platform.hs

@@ -152,6 +152,9 @@ getLinuxDistro = do
         | hasWord name ["exherbo"] -> Exherbo
         | hasWord name ["gentoo"]  -> Gentoo
         | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
+        | hasWord name ["rocky", "Rocky Linux"] -> Rocky
+        -- https://github.com/void-linux/void-packages/blob/master/srcpkgs/base-files/files/os-release
+        | hasWord name ["void", "Void Linux"] -> Void
         | otherwise                -> UnknownLinux
   pure (distro, parsedVer)
  where

lib/GHCup/Prelude/Logger/Internal.hs

@@ -80,7 +80,7 @@ logInternal logLevel msg = do
         Info    -> style' "[ Info  ]"
         Warn    -> style' "[ Warn  ]"
         Error   -> style' "[ Error ]"
-  let strs = T.split (== '\n') msg
+  let strs = T.split (== '\n') . T.dropWhileEnd (`elem` ("\n\r" :: String)) $ msg
   let out = case strs of
               [] -> T.empty
               (x:xs) ->

lib/GHCup/Types.hs

@@ -422,7 +422,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
             , kSet          = Just bSet
             , kChangelog    = Just bChangelog
             , kShowAll      = Just bShowAllVersions
-            , kShowAllTools = Just bShowAllTools
             }
   in UserSettings {
       uCache = Just cache
@@ -449,7 +448,6 @@ data UserKeyBindings = UserKeyBindings
   , kSet          :: Maybe KeyCombination
   , kChangelog    :: Maybe KeyCombination
   , kShowAll      :: Maybe KeyCombination
-  , kShowAllTools :: Maybe KeyCombination
   }
   deriving (Show, GHC.Generic, Eq)
 
@@ -462,7 +460,6 @@ data KeyBindings = KeyBindings
   , bSet             :: KeyCombination
   , bChangelog       :: KeyCombination
   , bShowAllVersions :: KeyCombination
-  , bShowAllTools    :: KeyCombination
   }
   deriving (Show, GHC.Generic)
 
@@ -485,7 +482,6 @@ defaultKeyBindings = KeyBindings
   , bSet             = KeyCombination { key = KChar 's', mods = [] }
   , bChangelog       = KeyCombination { key = KChar 'c', mods = [] }
   , bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
-  , bShowAllTools    = KeyCombination { key = KChar 't', mods = [] }
   }
 
 data AppState = AppState