Compare commits

..

7 Commits

Author SHA1 Message Date
3a8cdf9967 Fix opening changelog on windows 2023-11-20 22:36:17 +08:00
2caf491e9d Remove the "show all tool" config
We show all tools at the moment anyway.
2023-11-18 18:55:06 +08:00
d277e56121 Improve logging by dropping trailing newline 2023-11-18 13:09:19 +08:00
335099ad19 Add rocky/void detection 2023-11-17 17:03:10 +08:00
b1106985ec Merge branch 'monday-improvements' 2023-11-14 23:16:42 +08:00
dee54445bf Merge remote-tracking branch 'origin/pr/928' 2023-11-13 17:50:37 +08:00
Bryan Richter
2df59fd1b3 Emphasize experimental nature of wasm and js 2023-11-13 11:28:14 +02:00
8 changed files with 48 additions and 56 deletions

View File

@@ -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
)
, ( bShowAllTools
, \BrickSettings {..} ->
if showAllTools then "Don't show all tools" else "Show all tools"
, hideShowHandler showAllVersions (not . showAllTools)
, hideShowHandler (not . showAllVersions)
)
, (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{..} =
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
hideShowHandler f BrickState{..} =
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)
(showAllTools appSettings))
replaceLR (filterVisible (showAllVersions 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 v t e | lInstalled e = True
| v
, not t
, Nightly `notElem` lTag e
, lTool e `notElem` hiddenTools = True
| not v
, t
, Old `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)
filterVisible :: Bool -> ListResult -> Bool
filterVisible v e | lInstalled e = True
| v
, Nightly `notElem` lTag e = True
| not v
, Old `notElem` lTag e
, Nightly `notElem` lTag e = True
| otherwise = (Old `notElem` lTag e) &&
(Nightly `notElem` lTag e)
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
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
case _rPlatform pfreq of
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] 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 $ 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)

View File

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

View File

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

View File

@@ -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
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
Nothing
Nothing
case _rPlatform pfreq of
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] 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

View File

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

View File

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

View File

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

View File

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