ansi-terminal 1.1 → 1.1.1

raw patch · 6 files changed

+68/−12 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• ansi-terminal.cabal +1/−1
• src/System/Console/ANSI.hs +11/−6
• src/System/Console/ANSI/Codes.hs +2/−0
• unix/System/Console/ANSI/Internal.hs +34/−4
• win/System/Console/ANSI/Internal.hs +9/−1

@@ -1,6 +1,17 @@ Changes
 =======
 
+Version 1.1.1
+-------------
+
+* Use of C function `setenv()` in one thread can cause other threads calling C
+  functions that query environment variables to crash. On Unix-like operating
+  systems, where such functions are used, the implementations of
+  `hSupportsANSI` and `hSupportsANSIColor` now avoid unnecessary calls of
+  `System.Environment.lookupEnv`.
+
+* Improvements to Haddock documentation.
+
 Version 1.1
 -----------
 

@@ -1,6 +1,6 @@ Cabal-Version:       1.22
 Name:                ansi-terminal
-Version:             1.1
+Version:             1.1.1
 Category:            User Interfaces
 Synopsis:            Simple ANSI terminal support
 Description:         ANSI terminal support for Haskell: allows cursor movement,

@@ -368,7 +368,6 @@ import Data.Char ( digitToInt, isDigit, isHexDigit )
 import Data.Colour.SRGB ( RGB (..) )
 import Data.Word ( Word16 )
-import System.Environment ( getEnvironment )
 import System.IO
          ( BufferMode (..), Handle, hFlush, hGetBuffering, hGetEcho, hPutStr
          , hReady, hSetBuffering, hSetEcho, stdin, stdout
@@ -638,11 +637,7 @@ --
 -- @since 0.9
 hSupportsANSIColor :: Handle -> IO Bool
-hSupportsANSIColor h = (||) <$> hSupportsANSI h <*> isEmacsTerm
-  where
-    isEmacsTerm = (\env -> insideEmacs env && isDumb env) <$> getEnvironment
-    insideEmacs = any (\(k, _) -> k == "INSIDE_EMACS")
-    isDumb env = Just "dumb" == lookup "TERM" env
+hSupportsANSIColor = Internal.hSupportsANSIColor
 
 -- | Use heuristics to determine whether a given handle will support \'ANSI\'
 -- control characters in output. The function is consistent with
@@ -788,6 +783,8 @@ -- emulated, but the emulation does not work on Windows Terminal and (2) of
 -- difficulties in obtaining the data emitted into the console input stream.
 --
+-- Underlining is not supported.
+--
 -- @since 0.11.4
 reportLayerColor :: ConsoleLayer -> IO ()
 reportLayerColor = hReportLayerColor stdout
@@ -819,6 +816,8 @@ -- as mintty, that are not based on the Windows' Console API. (Command Prompt
 -- and PowerShell are based on the Console API.)
 --
+-- Underlining is not supported.
+--
 -- @since 0.11.4
 getReportedLayerColor :: ConsoleLayer -> IO String
 getReportedLayerColor = Internal.getReportedLayerColor
@@ -836,6 +835,8 @@ -- and PowerShell are based on the Console API.) This function also relies on
 -- emulation that does not work on Windows Terminal.
 --
+-- Underlining is not supported.
+--
 -- @since 0.11.4
 getLayerColor :: ConsoleLayer -> IO (Maybe(RGB Word16))
 getLayerColor = hGetLayerColor stdout
@@ -852,6 +853,8 @@ -- and PowerShell are based on the Console API.) This function also relies on
 -- emulation that does not work on Windows Terminal.
 --
+-- Underlining is not supported.
+--
 -- @since 0.11.4
 hGetLayerColor :: Handle -> ConsoleLayer -> IO (Maybe (RGB Word16))
 hGetLayerColor h layer = do
@@ -890,6 +893,8 @@ -- >     [] -> putStrLn $ "Error: could not parse " ++ show input
 -- >     [(col, _)] -> putStrLn $ "The color was " ++ show col ++ "."
 -- >     (_:_) -> putStrLn $ "Error: parse not unique"
+--
+-- Underlining is not supported.
 --
 -- @since 0.11.4
 layerColor :: ConsoleLayer -> ReadP (RGB Word16)

@@ -289,6 +289,8 @@ -- terminals (2) of difficulties in obtaining the data emitted into the
 -- console input stream. See 'System.Console.ANSI.getReportedLayerColor'.
 --
+-- Underlining is not supported.
+--
 -- @since 0.11.4
 reportLayerColorCode :: ConsoleLayer -> String
 reportLayerColorCode Foreground = osc "10" "?"

@@ -1,16 +1,18 @@-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
 
 module System.Console.ANSI.Internal
   ( getReportedCursorPosition
   , getReportedLayerColor
   , hSupportsANSI
   , hNowSupportsANSI
+  , hSupportsANSIColor
   ) where
 
 import Data.List ( uncons )
-import Data.Maybe ( fromMaybe, mapMaybe )
+import Data.Maybe ( fromMaybe, isJust, mapMaybe )
 import System.Environment ( lookupEnv )
 import System.IO ( Handle, hIsTerminalDevice, hIsWritable )
+import System.IO.Unsafe ( unsafePerformIO )
 import System.Timeout ( timeout )
 
 import System.Console.ANSI.Types ( ConsoleLayer (..) )
@@ -19,6 +21,8 @@ getReportedCursorPosition = getReport "\ESC[" ["R"]
 
 getReportedLayerColor :: ConsoleLayer -> IO String
+getReportedLayerColor Underlining =
+  error "getReportedLayerColor does not support underlining."
 getReportedLayerColor layer =
   getReport ("\ESC]" ++ pS ++ ";rgb:") ["\BEL", "\ESC\\"]
  where
@@ -72,8 +76,34 @@ -- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd)
 hSupportsANSI h = (&&) <$> hIsWritable h <*> hSupportsANSI'
  where
-  hSupportsANSI' = (&&) <$> hIsTerminalDevice h <*> isNotDumb
-  isNotDumb = (/= Just "dumb") <$> lookupEnv "TERM"
+  hSupportsANSI' = (&& isNotDumb) <$> hIsTerminalDevice h
 
 hNowSupportsANSI :: Handle -> IO Bool
 hNowSupportsANSI = hSupportsANSI
+
+hSupportsANSIColor :: Handle -> IO Bool
+hSupportsANSIColor h = (|| isEmacsTerm) <$> hSupportsANSI h
+ where
+  isEmacsTerm = insideEmacs && isDumb
+  isDumb = not isNotDumb
+
+-- | This function assumes that once it is first established whether or not the
+-- TERM environment variable exists with contents dumb, that will not change.
+-- This approach is taken because the use of C function setenv() in one thread
+-- can cause other threads calling C function getenv() to crash. On Unix-like
+-- operating systems, System.Environment.lookupEnv is implemented using C
+-- function getenv(). 
+isNotDumb :: Bool
+isNotDumb = unsafePerformIO (lookupEnv "TERM") /= Just "dumb"
+
+{-# NOINLINE isNotDumb #-}
+
+-- | This function assumes that once it is first established whether or not the
+-- INSIDE_EMACS environment variable exists, that will not change. This approach
+-- is taken because the use of C function setenv() in one thread can cause other
+-- threads calling C function getenv() to crash. On Unix-like operating systems,
+-- System.Environment.lookupEnv is implemented using C function getenv(). 
+insideEmacs :: Bool
+insideEmacs = isJust $ unsafePerformIO (lookupEnv "INSIDE_EMACS")
+
+{-# NOINLINE insideEmacs #-}

@@ -5,12 +5,13 @@   , getReportedLayerColor
   , hNowSupportsANSI
   , hSupportsANSI
+  , hSupportsANSIColor
   ) where
 
 import Control.Exception ( IOException, SomeException, catch, try )
 import Data.Bits ( (.&.), (.|.) )
 import Data.Maybe ( mapMaybe )
-import System.Environment ( lookupEnv )
+import System.Environment ( getEnvironment, lookupEnv )
 import System.IO ( Handle, hIsTerminalDevice, hIsWritable, stdin )
 import System.Console.ANSI.Types ( ConsoleLayer )
 
@@ -103,3 +104,10 @@   if h == iNVALID_HANDLE_VALUE || h == nullHANDLE
     then invalid  -- Invalid handle or no handle
     else action h
+
+hSupportsANSIColor :: Handle -> IO Bool
+hSupportsANSIColor h = (||) <$> hSupportsANSI h <*> isEmacsTerm
+  where
+    isEmacsTerm = (\env -> insideEmacs env && isDumb env) <$> getEnvironment
+    insideEmacs = any (\(k, _) -> k == "INSIDE_EMACS")
+    isDumb env = Just "dumb" == lookup "TERM" env