[Git][ghc/ghc][master] 2 commits: ghc package does not have to depend on terminfo

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jan 19 03:25:15 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00
ghc package does not have to depend on terminfo

- - - - -
981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00
ghc-pkg does not have to depend on terminfo

- - - - -


7 changed files:

- cabal.project-reinstall
- compiler/GHC/SysTools/Terminal.hs
- compiler/ghc.cabal.in
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Packages.hs
- utils/ghc-pkg/Main.hs
- utils/ghc-pkg/ghc-pkg.cabal.in


Changes:

=====================================
cabal.project-reinstall
=====================================
@@ -48,7 +48,7 @@ packages: ./compiler
           ./utils/iserv
           ./linters/**/*.cabal
 
-constraints: ghc +internal-interpreter +dynamic-system-linke +terminfo,
+constraints: ghc +internal-interpreter +dynamic-system-linke,
              ghc-bin +internal-interpreter +threaded,
              ghci +internal-interpreter,
              haddock +in-ghc-tree,


=====================================
compiler/GHC/SysTools/Terminal.hs
=====================================
@@ -4,16 +4,11 @@ module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where
 
 import GHC.Prelude
 
-#if defined(MIN_VERSION_terminfo)
-import GHC.IO (catchException)
-import Data.Maybe (fromMaybe)
-import System.Console.Terminfo (SetupTermError, Terminal, getCapability,
-                                setupTermFromEnv, termColors)
-import System.Posix (queryTerminal, stdError)
-#elif defined(mingw32_HOST_OS)
+#if !defined(mingw32_HOST_OS)
+import System.IO (hIsTerminalDevice, stderr)
+#else
 import GHC.IO (catchException)
 import GHC.Utils.Exception (try)
--- import Data.Bits ((.|.), (.&.))
 import Foreign (Ptr, peek, with)
 import qualified Graphics.Win32 as Win32
 import qualified System.Win32 as Win32
@@ -40,18 +35,10 @@ stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors'
 -- | Check if ANSI escape sequences can be used to control color in stderr.
 stderrSupportsAnsiColors' :: IO Bool
 stderrSupportsAnsiColors' = do
-#if defined(MIN_VERSION_terminfo)
-    stderr_available <- queryTerminal stdError
-    if stderr_available then
-      fmap termSupportsColors setupTermFromEnv
-        `catchException` \ (_ :: SetupTermError) -> pure False
-    else
-      pure False
-  where
-    termSupportsColors :: Terminal -> Bool
-    termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0
-
-#elif defined(mingw32_HOST_OS)
+#if !defined(mingw32_HOST_OS)
+    -- Coloured text is a part of ANSI standard, no reason to query terminfo
+    hIsTerminalDevice stderr
+#else
   h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE
          `catchException` \ (_ :: IOError) ->
            pure Win32.nullHANDLE
@@ -100,6 +87,4 @@ foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode
 foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode
   :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL
 
-#else
-   pure False
 #endif


=====================================
compiler/ghc.cabal.in
=====================================
@@ -46,11 +46,6 @@ Flag internal-interpreter
     Default: False
     Manual: True
 
-Flag terminfo
-    Description: Build GHC with terminfo support on non-Windows platforms.
-    Default: True
-    Manual: True
-
 Flag dynamic-system-linker
     Description: The system can load dynamic code. This is not the case for musl.
     Default: True
@@ -98,8 +93,6 @@ Library
     if os(windows)
         Build-Depends: Win32  >= 2.3 && < 2.14
     else
-        if flag(terminfo)
-            Build-Depends: terminfo == 0.4.*
         Build-Depends: unix   >= 2.7 && < 2.9
 
     GHC-Options: -Wall


=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -172,7 +172,7 @@ toolTargets = [ binary
               , text
               , transformers
               , unlit  -- # executable
-              ] ++ if windowsHost then [ win32 ] else [ terminfo, unix ]
+              ] ++ if windowsHost then [ win32 ] else [ unix ]
 
 -- | Create a mapping from files to which component it belongs to.
 dirMap :: Action [(FilePath, (Package, [String]))]


=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -89,7 +89,6 @@ packageArgs = do
 
           , builder (Cabal Flags) ? mconcat
             [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
-            , notM cross `cabalFlag` "terminfo"
             , ifM stage0
                   -- We build a threaded stage 1 if the bootstrapping compiler
                   -- supports it.


=====================================
utils/ghc-pkg/Main.hs
=====================================
@@ -10,13 +10,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
--- We never want to link against terminfo while bootstrapping.
-#if defined(BOOTSTRAPPING)
-#if defined(WITH_TERMINFO)
-#undef WITH_TERMINFO
-#endif
-#endif
-
 -- Fine if this comes from make/Hadrian or the pre-built base.
 #include <ghcplatform.h>
 
@@ -100,10 +93,6 @@ import System.Posix hiding (fdToHandle)
 import qualified System.Info(os)
 #endif
 
-#if defined(WITH_TERMINFO)
-import System.Console.Terminfo as Terminfo
-#endif
-
 #if defined(mingw32_HOST_OS)
 # if defined(i386_HOST_ARCH)
 #  define WINDOWS_CCONV stdcall
@@ -1582,37 +1571,28 @@ listPackages verbosity my_flags mPackageName mModuleName = do
 
   if simple_output then show_simple stack else do
 
-#if !defined(WITH_TERMINFO)
+#if defined(mingw32_HOST_OS)
     mapM_ show_normal stack
 #else
     let
-       show_colour withF db at PackageDB{ packages = pkg_confs } =
-           if null pkg_confs
-           then termText (location db) <#> termText "\n    (no packages)\n"
-           else
-               mconcat $ map (<#> termText "\n") $
-                           (termText (location db)
-                            : map (termText "    " <#>) (map pp_pkg pkg_confs))
-          where
-                   pp_pkg p
-                     | installedUnitId p `elem` broken = withF Red  doc
-                     | exposed p                       = doc
-                     | otherwise                       = withF Blue doc
-                     where doc | verbosity >= Verbose
-                               = termText (printf "%s (%s)" pkg (display (installedUnitId p)))
-                               | otherwise
-                               = termText pkg
-                            where
-                            pkg = display (mungedId p)
+      show_colour PackageDB{ location = db_name, packages = pkg_confs } =
+          do hPutStrLn stdout db_name
+             if null pkg_confs
+                 then hPutStrLn stdout "    (no packages)"
+                 else hPutStrLn stdout $ unlines (map ("    " ++) (map pp_pkg pkg_confs))
+           where
+                 pp_pkg p
+                   | installedUnitId p `elem` broken = printf "\ESC[31m%s\ESC[0m" doc -- red color
+                   | exposed p = doc
+                   | otherwise = printf "\ESC[34m%s\ESC[0m" doc -- blue color
+                   where doc | verbosity >= Verbose = printf "%s (%s)" pkg (display (installedUnitId p))
+                             | otherwise            = pkg
+                          where
+                          pkg = display (mungedId p)
 
     is_tty <- hIsTerminalDevice stdout
-    if not is_tty
-       then mapM_ show_normal stack
-       else do tty <- Terminfo.setupTermFromEnv
-               case Terminfo.getCapability tty withForegroundColor of
-                   Nothing -> mapM_ show_normal stack
-                   Just w  -> runTermOutput tty $ mconcat $
-                                                  map (show_colour w) stack
+    -- Coloured text is a part of ANSI standard, no reason to query terminfo
+    mapM_ (if is_tty then show_colour else show_normal) stack
 #endif
 
 simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO ()


=====================================
utils/ghc-pkg/ghc-pkg.cabal.in
=====================================
@@ -15,11 +15,6 @@ Category: Development
 build-type: Simple
 cabal-version: >=1.10
 
-Flag terminfo
-    Description: Build GHC with terminfo support on non-Windows platforms.
-    Default: True
-    Manual: False
-
 Executable ghc-pkg
     Default-Language: Haskell2010
     Main-Is: Main.hs
@@ -35,9 +30,6 @@ Executable ghc-pkg
                    binary,
                    ghc-boot,
                    bytestring
-    if !os(windows) && flag(terminfo)
-        Build-Depends: terminfo
-        Cpp-Options: -DWITH_TERMINFO
     if !os(windows)
         Build-Depends: unix
     if os(windows)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb5a6b91e02b48f9171217743e3417cb33eb92e3...981ff7c4d0e0dd1f4cf721ceb3e99128e442f9fc

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb5a6b91e02b48f9171217743e3417cb33eb92e3...981ff7c4d0e0dd1f4cf721ceb3e99128e442f9fc
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230118/4bfd360a/attachment-0001.html>


More information about the ghc-commits mailing list