ansi-terminal 0.8.0.2 → 0.8.0.3

raw patch · 10 files changed

+85/−130 lines, 10 filesdep −base-compatsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: base-compat

API changes (from Hackage documentation)

Files

CHANGELOG.md +7/−1
README.md +1/−1
Setup.hs +2/−0
Setup.lhs +0/−4
ansi-terminal.cabal +2/−3
src/System/Console/ANSI.hs +2/−6
src/System/Console/ANSI/Windows.hs +10/−10
src/System/Console/ANSI/Windows/Detect.hs +52/−101
src/includes/Common-Include.hs +8/−3
src/includes/Exports-Include.hs +1/−1

CHANGELOG.md view

@@ -1,13 +1,19 @@ Changes
 =======
 
+Version 0.8.0.3
+---------------
+
+* On Windows, try to enable ANSI on ConHost terminals even if a TERM environment
+  variable exits (such as with the Hyper 2 terminal)
+* Minor improvements to Haddock documentation
+
 Version 0.8.0.2
 ---------------
 
 * Improve README and Haddock documentation
 * On Windows, fix compatability with earlier GHC versions
 * Drop support for GHC versions before 6.12.1 (released December 2009)
-
 
 Version 0.8.0.1
 ---------------

README.md view

@@ -60,7 +60,7 @@ -------  A full example is-[available](http://github.com/feuerbach/ansi-terminal/tree/master/System/Console/ANSI/Example.hs),+[available](https://github.com/feuerbach/ansi-terminal/blob/master/app/Example.hs), but for a taste of how the library works try the following code:  ``` haskell

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

− Setup.lhs

@@ -1,4 +0,0 @@-#! /usr/bin/env runhaskell
-
-> import Distribution.Simple
-> main = defaultMain

ansi-terminal.cabal view

@@ -1,5 +1,5 @@ Name:                ansi-terminal
-Version:             0.8.0.2
+Version:             0.8.0.3
 Cabal-Version:       >= 1.8
 Category:            User Interfaces
 Synopsis:            Simple ANSI terminal support, with Windows compatibility
@@ -39,8 +39,7 @@         Build-Depends:          base >= 4.2.0.0 && < 5
                               , colour
         if os(windows)
-                Build-Depends:          base-compat >= 0.9.1
-                                      , containers >= 0.5.0.0
+                Build-Depends:          containers >= 0.5.0.0
                                       , Win32 >= 2.0
                 Cpp-Options:            -DWINDOWS
                 Other-Modules:          System.Console.ANSI.Windows

src/System/Console/ANSI.hs view

@@ -31,11 +31,7 @@ -- Terminal software other than the native software exists for Windows. One
 -- example is the \'mintty\' terminal emulator for \'Cygwin\', \'MSYS\' or
 -- \'MSYS2\', and dervied projects, and for \'WSL\' (Windows Subsystem for
--- Linux). On Windows, this library makes use of the existence of, and content
--- of, the @TERM@ environment variable to detect the use of non-native terminal
--- software. If you are using a native terminal on Windows (outside of WSL) and
--- this library is not working as you expect, check that the @TERM@ variable
--- does not exist.
+-- Linux).
 --
 -- The \'ANSI\' standards refer to (1) standard ECMA-48 \`Control Functions for
 -- Coded Character Sets\' (5th edition, 1991); (2) extensions in ITU-T
@@ -93,7 +89,7 @@ -- >   putStrLn "Default colors."
 --
 -- For many more examples, see the project's extensive
--- <https://raw.githubusercontent.com/feuerbach/ansi-terminal/master/System/Console/ANSI/Example.hs Example.hs> file.
+-- <https://github.com/feuerbach/ansi-terminal/blob/master/app/Example.hs Example.hs> file.
 #if defined(WINDOWS)
 module System.Console.ANSI
   (

src/System/Console/ANSI/Windows.hs view

@@ -12,8 +12,8 @@ 
 import System.Console.ANSI.Types
 import qualified System.Console.ANSI.Unix as U
-import System.Console.ANSI.Windows.Detect (ANSIEnabledStatus (..),
-  ConsoleDefaultState (..), isANSIEnabled)
+import System.Console.ANSI.Windows.Detect (ANSISupport (..),
+  ConsoleDefaultState (..), aNSISupport)
 import qualified System.Console.ANSI.Windows.Emulator as E
 
 -- This file contains code that is common to modules System.Console.ANSI.Unix,
@@ -28,18 +28,18 @@ #include "Common-Include-Enabled.hs"
 
 -- | A helper function which returns the native or emulated version, depending
--- on `isANSIEnabled`.
+-- on `aNSISupport`.
 nativeOrEmulated :: a -> a -> a
-nativeOrEmulated native emulated = case isANSIEnabled of
-  ANSIEnabled      -> native
-  NotANSIEnabled _ -> emulated
+nativeOrEmulated native emulated = case aNSISupport of
+  Native     -> native
+  Emulated _ -> emulated
 
 -- | A helper function which returns the native or emulated version, depending
--- on `isANSIEnabled`, where the emulator uses the default console state.
+-- on `aNSISupport`, where the emulator uses the default console state.
 nativeOrEmulatedWithDefault :: a -> (ConsoleDefaultState -> a) -> a
-nativeOrEmulatedWithDefault native emulated = case isANSIEnabled of
-  ANSIEnabled        -> native
-  NotANSIEnabled def -> emulated def
+nativeOrEmulatedWithDefault native emulated = case aNSISupport of
+  Native       -> native
+  Emulated def -> emulated def
 
 
 -- * Cursor movement by character

src/System/Console/ANSI/Windows/Detect.hs view

@@ -2,122 +2,73 @@ 
 module System.Console.ANSI.Windows.Detect
   (
-    ANSIEnabledStatus (..)
+    ANSISupport (..)
   , ConsoleDefaultState (..)
-  , isANSIEnabled
+  , aNSISupport
   ) where
 
 import Control.Exception (SomeException(..), throwIO, try)
 import Data.Bits ((.&.), (.|.))
--- 'lookupEnv' is not available until base-4.6.0.0 (GHC 7.6.1)
-import System.Environment.Compat (lookupEnv)
+import System.IO (stdout)
 import System.IO.Unsafe (unsafePerformIO)
 
-import System.Console.ANSI.Windows.Foreign (bACKGROUND_INTENSE_WHITE,
-  ConsoleException(..), CONSOLE_SCREEN_BUFFER_INFO (..), DWORD,
-  eNABLE_VIRTUAL_TERMINAL_PROCESSING, fOREGROUND_INTENSE_WHITE,
-  getConsoleMode, getConsoleScreenBufferInfo, getStdHandle, HANDLE,
-  iNVALID_HANDLE_VALUE, nullHANDLE, setConsoleMode, sTD_OUTPUT_HANDLE, WORD)
+import System.Console.ANSI.Windows.Foreign (ConsoleException(..),
+  CONSOLE_SCREEN_BUFFER_INFO (..), DWORD, HANDLE, WORD,
+  bACKGROUND_INTENSE_WHITE, eNABLE_VIRTUAL_TERMINAL_PROCESSING,
+  fOREGROUND_INTENSE_WHITE, getConsoleMode, getConsoleScreenBufferInfo,
+  iNVALID_HANDLE_VALUE, nullHANDLE, setConsoleMode, withHandleToHANDLE)
 
--- | The default state of the console
+-- | The default state of the console.
 data ConsoleDefaultState = ConsoleDefaultState
   { defaultForegroundAttributes :: WORD -- ^ Foreground attributes
   , defaultBackgroundAttributes :: WORD -- ^ Background attributes
   } deriving (Eq, Show)
 
--- | The status of the console as regards it being ANSI-enabled or not
--- ANSI-enabled.
-data ANSIEnabledStatus
-  = ANSIEnabled -- ^ ANSI-enabled
-  | NotANSIEnabled ConsoleDefaultState -- ^ Not ANSI-enabled (including the
-                                       -- state of the console when that status
-                                       -- was determined)
+-- | How the console is assumed to support ANSI control codes.
+data ANSISupport
+  = Native                       -- ^ Assume ANSI-enabled
+  | Emulated ConsoleDefaultState -- ^ Not ANSI-enabled (including the state of
+                                 -- the console when that status was determined)
   deriving (Eq, Show)
 
 -- | This function assumes that once it is first established whether or not the
--- Windows console is ANSI-enabled, that will not change. If the console is not
--- ANSI-enabled, the state of the console is considered to be its default state.
-{-# NOINLINE isANSIEnabled #-}
-isANSIEnabled :: ANSIEnabledStatus
-isANSIEnabled = unsafePerformIO $ do
-  e <- safeIsANSIEnabled
-  if e
-    then return ANSIEnabled
-    else do
-      hOut <- getValidStdHandle sTD_OUTPUT_HANDLE
-      info <- getConsoleScreenBufferInfo hOut
-      let attributes = csbi_attributes info
-          fgAttributes = attributes .&. fOREGROUND_INTENSE_WHITE
-          bgAttributes = attributes .&. bACKGROUND_INTENSE_WHITE
-          consoleDefaultState = ConsoleDefaultState
-            { defaultForegroundAttributes = fgAttributes
-            , defaultBackgroundAttributes = bgAttributes }
-      return $ NotANSIEnabled consoleDefaultState
-
--- This function takes the following approach. If the environment variable
--- APPVEYOR exists and is set to 'True', it assumes the code is running in the
--- Appveyor build environment and that the build console is ANSI-enabled.
--- Otherwise, if the environment variable TERM exists and is not set to 'dumb'
--- or 'msys' (see below), it assumes the console is ANSI-enabled. Otherwise, it
--- tries to get a valid standard output handle. If that does not fail, it
--- tried to get a ConHost console mode. If that fails, it assumes that the
--- handle is ANSI-enabled. Otherwise, it tries to enable virtual terminal
--- processing. If that fails, it assumes the console is not ANSI-enabled.
---
--- In Git Shell, if Command Prompt or PowerShell are used, the environment
--- variable TERM is set to 'msys'. If 'Git Bash' (mintty) is used, TERM is set
--- to 'xterm' (by default).
-safeIsANSIEnabled :: IO Bool
-safeIsANSIEnabled = do
-  appveyor <- lookupEnv "APPVEYOR"
-  case appveyor of
-    Just "True" -> return True
-    _           -> do
-      term <- lookupEnv "TERM"
-      case term of
-        Just "dumb" -> return False
-        Just "msys" -> doesEnableANSIOutSucceed
-        Just _      -> return True
-        Nothing     -> doesEnableANSIOutSucceed
-
--- This function returns whether or not an attempt to enable virtual terminal
--- processing succeeded, or was deemed to succeed, in the IO monad.
-doesEnableANSIOutSucceed :: IO Bool
-doesEnableANSIOutSucceed = do
-  result <- try enableANSIOut :: IO (Either SomeException ())
-  case result of
-    Left _ -> return False
-    Right () -> return True
-
--- This function tries to get a valid handle on the standard output and throws
--- an exception if it cannot. It then tries to get a ConHost console mode for
--- that handle. If it can not, it assumes that the standard output handle is
--- ANSI-enabled. If it can, it tries to enable virtual terminal processing and
--- throws an exception if it can not.
-enableANSIOut :: IO ()
-enableANSIOut = do
-  hOut <- getValidStdHandle sTD_OUTPUT_HANDLE
-  result <- conHostConsoleMode hOut
-  case result of
-    Nothing -> return ()  -- assume hOut is ANSI-enabled
-    Just mOut -> do
-      let mOut' = mOut .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING
-      setConsoleMode hOut mOut'
+-- Windows console requires emulation, that will not change. If the console
+-- requires emulation, the state of the console is considered to be its default
+-- state.
+{-# NOINLINE aNSISupport #-}
+aNSISupport :: ANSISupport
+aNSISupport = unsafePerformIO $ withHandleToHANDLE stdout aNSISupport'
 
--- This function tries to get a valid standard handle and throws an exception if
--- it cannot.
-getValidStdHandle :: DWORD -> IO HANDLE
-getValidStdHandle nStdHandle = do
-  h <- getStdHandle nStdHandle
+-- | This function first checks if the Windows handle is valid and throws an
+-- exception if it is not. It then tries to get a ConHost console mode for
+-- that handle. If it can not, it assumes that the handle is ANSI-enabled. If
+-- virtual termimal (VT) processing is already enabled, the handle does not
+-- require emulation. Otherwise, it trys to enable processing. If it can, the
+-- handle is ANSI-enabled. If it can not, emulation will be attempted and the
+-- state of the console is considered to be its default state.
+aNSISupport' :: HANDLE -> IO ANSISupport
+aNSISupport' h =
   if h == iNVALID_HANDLE_VALUE || h == nullHANDLE
-    then throwIO $ ConsoleException 6 -- Invalid handle or no handle
-    else return h
-
--- The function tries to get a ConHost console mode from a handle that is
--- assumed to be a valid standard handle (see getValidStdHandle)
-conHostConsoleMode :: HANDLE -> IO (Maybe DWORD)
-conHostConsoleMode h = do
-  result <- try (getConsoleMode h) :: IO (Either SomeException DWORD)
-  case result of
-    Left _ -> return Nothing
-    Right mode -> return (Just mode)
+    then throwIO $ ConsoleException 6  -- Invalid handle or no handle
+    else do
+      tryMode <- try (getConsoleMode h) :: IO (Either SomeException DWORD)
+      case tryMode of
+        Left _     -> return Native  -- No ConHost mode
+        Right mode -> if mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0
+          then return Native  -- VT processing already enabled
+          else do
+            let mode' = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING
+            trySetMode <- try (setConsoleMode h mode') :: IO (Either SomeException ())
+            case trySetMode of
+              Left _   -> emulated       -- Can't enable VT processing
+              Right () -> return Native  -- VT processing enabled
+ where
+  emulated = do
+    info <- getConsoleScreenBufferInfo h
+    let attributes = csbi_attributes info
+        fgAttributes = attributes .&. fOREGROUND_INTENSE_WHITE
+        bgAttributes = attributes .&. bACKGROUND_INTENSE_WHITE
+        consoleDefaultState = ConsoleDefaultState
+          { defaultForegroundAttributes = fgAttributes
+          , defaultBackgroundAttributes = bgAttributes }
+    return $ Emulated consoleDefaultState

src/includes/Common-Include.hs view

@@ -95,9 +95,14 @@ -- | Use heuristics to determine whether the functions defined in this
 -- package will work with a given handle.
 --
--- The current implementation checks that the handle is a terminal, and
--- that the @TERM@ environment variable doesn't say @dumb@ (which is what
--- Emacs sets for its own terminal).
+-- For Unix-like operating systems or Windows, the current implementation checks
+-- that: (1) the handle is a terminal (see further below); and (2) a @TERM@
+-- environment variable is not set to @dumb@ (which is what the GNU Emacs text
+-- editor sets for its integrated terminal).
+--
+-- The function 'hIsTerminalDevice' is used to check if the handle is a
+-- terminal. However, on Windows, this function may not identify a handle to a
+-- non-native terminal (for example, 'mintty') as a terminal.
 hSupportsANSI :: Handle -> IO Bool
 -- Borrowed from an HSpec patch by Simon Hengel
 -- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd)

src/includes/Exports-Include.hs view

@@ -105,7 +105,7 @@   , hSetTitle
   , setTitleCode
 
-    -- * Checking if handle supports ANSI
+    -- * Checking if handle supports ANSI (not portable: GHC only)
   , hSupportsANSI
 
     -- * Getting the cursor position