Merge branch 'brick-windows'

This commit is contained in:
Julian Ospald 2023-11-10 19:32:20 +08:00
commit a7be1e7068
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
5 changed files with 49 additions and 32 deletions

View File

@ -5,6 +5,8 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
module BrickMain where module BrickMain where
@ -16,7 +18,6 @@ import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils import GHCup.Utils
import GHCup.OptParse.Common (logGHCPostRm) import GHCup.OptParse.Common (logGHCPostRm)
import GHCup.Prelude ( decUTF8Safe ) import GHCup.Prelude ( decUTF8Safe )
import GHCup.Prelude.File
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
import GHCup.Prelude.Process import GHCup.Prelude.Process
import GHCup.Prompts import GHCup.Prompts
@ -49,7 +50,6 @@ import Data.Vector ( Vector
import Data.Versions import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.FilePath
import System.Exit import System.Exit
import System.IO.Unsafe import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
@ -61,9 +61,34 @@ import qualified Data.Text.Lazy as L
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Data.Vector as V import qualified Data.Vector as V
import System.Environment (getExecutablePath) import System.Environment (getExecutablePath)
#if !IS_WINDOWS
import GHCup.Prelude.File
import System.FilePath
import qualified System.Posix.Process as SPP import qualified System.Posix.Process as SPP
#endif
installedSign :: String
#if IS_WINDOWS
installedSign = "I "
#else
installedSign = ""
#endif
setSign :: String
#if IS_WINDOWS
setSign = "IS"
#else
setSign = "✔✔"
#endif
notInstalledSign :: String
#if IS_WINDOWS
notInstalledSign = "X "
#else
notInstalledSign = ""
#endif
hiddenTools :: [Tool] hiddenTools :: [Tool]
hiddenTools = [] hiddenTools = []
@ -165,9 +190,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} = renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
let marks = if let marks = if
| lSet -> (withAttr (attrName "set") $ str "✔✔") | lSet -> (withAttr (attrName "set") $ str setSign)
| lInstalled -> (withAttr (attrName "installed") $ str "") | lInstalled -> (withAttr (attrName "installed") $ str installedSign)
| otherwise -> (withAttr (attrName "not-installed") $ str "") | otherwise -> (withAttr (attrName "not-installed") $ str notInstalledSign)
ver = case lCross of ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer) Just c -> T.unpack (c <> "-" <> prettyVer lVer)
@ -500,12 +525,15 @@ install' _ (_, ListResult {..}) = do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
case lTool of case lTool of
GHCup -> do GHCup -> do
#if !IS_WINDOWS
up <- liftIO $ fmap (either (const Nothing) Just) up <- liftIO $ fmap (either (const Nothing) Just)
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt) $ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
when ((normalise <$> up) == Just (normalise ce)) $ when ((normalise <$> up) == Just (normalise ce)) $
-- TODO: track cli arguments of previous invocation -- TODO: track cli arguments of previous invocation
liftIO $ SPP.executeFile ce False ["tui"] Nothing liftIO $ SPP.executeFile ce False ["tui"] Nothing
#else
logInfo "Please restart 'ghcup' for the changes to take effect" logInfo "Please restart 'ghcup' for the changes to take effect"
#endif
_ -> pure () _ -> pure ()
pure $ Right () pure $ Right ()
VRight (vi, _, _) -> do VRight (vi, _, _) -> do

View File

@ -4,35 +4,26 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2 optimization: 2
source-repository-package package ghcup
type: git flags: +tui
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
if os(linux) if os(linux)
package ghcup
flags: +tui
if arch(x86_64) || arch(i386) if arch(x86_64) || arch(i386)
package * package *
ghc-options: -split-sections -optl-static ghc-options: -split-sections -optl-static
elif os(darwin) elif os(darwin)
constraints: zlib +bundled-c-zlib, constraints: zlib +bundled-c-zlib,
lzma +static lzma +static
package ghcup
flags: +tui
elif os(mingw32) elif os(mingw32)
constraints: zlib +bundled-c-zlib, constraints: zlib +bundled-c-zlib,
lzma +static, lzma +static,
text -simdutf text -simdutf,
package ghcup vty-windows >=0.1.0.3
flags: -tui
elif os(freebsd) elif os(freebsd)
constraints: zlib +bundled-c-zlib, constraints: zlib +bundled-c-zlib,
zip +disable-zstd zip +disable-zstd
package * package *
ghc-options: -split-sections -pgmc clang++14 ghc-options: -split-sections -pgmc clang++14
package ghcup
flags: +tui
constraints: http-io-streams -brotli, constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0, any.aeson >= 2.0.1.0,

View File

@ -36,7 +36,7 @@ source-repository head
flag tui flag tui
description: description:
Build the brick powered tui (ghcup tui). This is disabled on windows. Build the brick powered tui (ghcup tui).
default: False default: False
manual: True manual: True
@ -86,7 +86,7 @@ common app-common-depends
, unordered-containers ^>=0.2 , unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, vector ^>=0.12 , vector >=0.12 && <0.14
, versions >=6.0.3 && <6.1 , versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
@ -190,7 +190,7 @@ library
, unliftio-core ^>=0.2.0.1 , unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, vector ^>=0.12 , vector >=0.12 && <0.14
, versions >=6.0.3 && <6.1 , versions >=6.0.3 && <6.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
@ -236,9 +236,9 @@ library
, unix ^>=2.7 , unix ^>=2.7
, unix-bytestring ^>=0.3.7.3 , unix-bytestring ^>=0.3.7.3
if (flag(tui) && !os(windows)) if flag(tui)
cpp-options: -DBRICK cpp-options: -DBRICK
build-depends: vty ^>=5.39 build-depends: vty ^>=6.0
library ghcup-optparse library ghcup-optparse
import: app-common-depends import: app-common-depends
@ -284,7 +284,7 @@ library ghcup-optparse
if flag(internal-downloader) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows)) if flag(tui)
cpp-options: -DBRICK cpp-options: -DBRICK
if os(windows) if os(windows)
@ -320,14 +320,13 @@ executable ghcup
if flag(internal-downloader) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows)) if flag(tui)
cpp-options: -DBRICK cpp-options: -DBRICK
other-modules: BrickMain other-modules: BrickMain
build-depends: build-depends:
, brick ^>=1.5 , brick ^>=2.1
, transformers ^>=0.5 , transformers ^>=0.5
, unix ^>=2.7 , vty ^>=6.0
, vty ^>=5.39
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS

View File

@ -475,7 +475,7 @@ data KeyBindings = KeyBindings
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
instance NFData KeyBindings instance NFData KeyBindings
#if defined(IS_WINDOWS) || !defined(BRICK) #if !defined(BRICK)
instance NFData Key instance NFData Key
instance NFData Modifier instance NFData Modifier

View File

@ -172,9 +172,8 @@ _done() {
green "Start a new haskell project in the current directory via:" green "Start a new haskell project in the current directory via:"
green " cabal init --interactive" green " cabal init --interactive"
green green
green "Install other GHC versions and tools via:" green "To install other GHC versions and tools, run:"
green " ghcup list" green " ghcup tui"
green " ghcup install <tool> <version>"
green green
green "To install system libraries and update msys2/mingw64," green "To install system libraries and update msys2/mingw64,"
green "open the \"Mingw haskell shell\"" green "open the \"Mingw haskell shell\""