Compare commits
7 Commits
monday-imp
...
issue-936
| Author | SHA1 | Date | |
|---|---|---|---|
| 3a8cdf9967 | |||
| 2caf491e9d | |||
| d277e56121 | |||
| 335099ad19 | |||
| b1106985ec | |||
| dee54445bf | |||
|
|
2df59fd1b3 |
@@ -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)
|
||||
|
||||
@@ -107,7 +107,6 @@ toSettings options = do
|
||||
, bSet = fromMaybe bSet kSet
|
||||
, bChangelog = fromMaybe bChangelog kChangelog
|
||||
, bShowAllVersions = fromMaybe bShowAllVersions kShowAll
|
||||
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -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:
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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) ->
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user