Hello community, here is the log from the commit of package ghc-ansi-terminal for openSUSE:Factory checked in at 2017-06-22 10:36:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-ansi-terminal (Old) and /work/SRC/openSUSE:Factory/.ghc-ansi-terminal.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-ansi-terminal" Thu Jun 22 10:36:51 2017 rev:5 rq:504055 version:0.6.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-ansi-terminal/ghc-ansi-terminal.changes 2016-07-21 07:59:24.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-ansi-terminal.new/ghc-ansi-terminal.changes 2017-06-22 10:36:56.894761528 +0200 @@ -1,0 +2,10 @@ +Thu Jun 8 11:08:24 UTC 2017 - [email protected] + +- Update to version 0.6.3.1. + +------------------------------------------------------------------- +Wed May 31 14:01:06 UTC 2017 - [email protected] + +- Update to version 0.6.3. + +------------------------------------------------------------------- Old: ---- ansi-terminal-0.6.2.3.tar.gz New: ---- ansi-terminal-0.6.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-ansi-terminal.spec ++++++ --- /var/tmp/diff_new_pack.p8pggu/_old 2017-06-22 10:36:57.478679212 +0200 +++ /var/tmp/diff_new_pack.p8pggu/_new 2017-06-22 10:36:57.482678647 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-ansi-terminal # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,19 +18,16 @@ %global pkg_name ansi-terminal Name: ghc-%{pkg_name} -Version: 0.6.2.3 +Version: 0.6.3.1 Release: 0 Summary: Simple ANSI terminal support, with Windows compatibility License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros -# Begin cabal-rpm deps: -BuildRequires: ghc-unix-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description ANSI terminal support for Haskell: allows cursor movement, screen clearing, @@ -52,15 +49,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ ansi-terminal-0.6.2.3.tar.gz -> ansi-terminal-0.6.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/CHANGELOG.md new/ansi-terminal-0.6.3.1/CHANGELOG.md --- old/ansi-terminal-0.6.2.3/CHANGELOG.md 2015-09-10 09:06:35.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/CHANGELOG.md 2017-05-31 16:21:38.000000000 +0200 @@ -1,6 +1,17 @@ Changes ======= +Version 0.6.3.1 +--------------- + +Fix Windows + ghc 7.8 compatibility, + +Version 0.6.3 +------------- + +* Add ANSI support for Windows +* Add compatibility with Win32-2.5.0.0 and above + Version 0.6.2.3 --------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Codes.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Codes.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Codes.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Codes.hs 2017-05-24 13:15:38.000000000 +0200 @@ -0,0 +1,161 @@ +-- | Functions that return 'String' values containing codes in accordance with: +-- (1) standard ECMA-48 Control Functions for Coded Character Sets (5th edition, +-- 1991); or (2) in the case of 'setTitleCode', the XTerm control sequence. +-- +-- The reference used for the codes in this module was +-- <http://en.wikipedia.org/wiki/ANSI_escape_sequences>. +-- +-- If module "System.Console.ANSI" is also imported, this module is intended to +-- be imported qualified, to avoid name clashes with functions which return \"\" +-- when Windows ANSI terminal support is emulated. e.g. +-- +-- > import qualified System.Console.ANSI.Codes as ANSI +-- +module System.Console.ANSI.Codes + ( + -- * Basic data types + module System.Console.ANSI.Types + + -- * Cursor movement by character + , cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode + + -- * Cursor movement by line + , cursorUpLineCode, cursorDownLineCode + + -- * Directly changing cursor position + , setCursorColumnCode, setCursorPositionCode + + -- * Clearing parts of the screen + , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode + , clearScreenCode, clearFromCursorToLineEndCode + , clearFromCursorToLineBeginningCode, clearLineCode + + -- * Scrolling the screen + , scrollPageUpCode, scrollPageDownCode + + -- * Select Graphic Rendition mode: colors and other whizzy stuff + , setSGRCode + + -- * Cursor visibilty changes + , hideCursorCode, showCursorCode + + -- * Changing the title + -- | Thanks to Brandon S. Allbery and Curt Sampson for pointing me in the + -- right direction on xterm title setting on haskell-cafe. The "0" + -- signifies that both the title and "icon" text should be set: i.e. the + -- text for the window in the Start bar (or similar) as well as that in + -- the actual window title. This is chosen for consistent behaviour + -- between Unixes and Windows. + , setTitleCode + + -- * Utilities + , colorToCode, csi, sgrToCode + ) where + +import Data.List (intersperse) +import System.Console.ANSI.Types + +-- | 'csi' @parameters controlFunction@, where @parameters@ is a list of 'Int', +-- returns the control sequence comprising the control function CONTROL +-- SEQUENCE INTRODUCER (CSI) followed by the parameter(s) (separated by \';\') +-- and ending with the @controlFunction@ character(s) that identifies the +-- control function. +csi :: [Int] -- ^ List of parameters for the control sequence + -> String -- ^ Character(s) that identify the control function + -> String +csi args code = "\ESC[" ++ concat (intersperse ";" (map show args)) ++ code + +-- | 'colorToCode' @color@ returns the 0-based index of the color (one of the +-- eight colors in the standard). +colorToCode :: Color -> Int +colorToCode color = case color of + Black -> 0 + Red -> 1 + Green -> 2 + Yellow -> 3 + Blue -> 4 + Magenta -> 5 + Cyan -> 6 + White -> 7 + +-- | 'sgrToCode' @sgr@ returns the parameter of the SELECT GRAPHIC RENDITION +-- (SGR) aspect identified by @sgr@. +sgrToCode :: SGR -- ^ The SGR aspect + -> Int +sgrToCode sgr = case sgr of + Reset -> 0 + SetConsoleIntensity intensity -> case intensity of + BoldIntensity -> 1 + FaintIntensity -> 2 + NormalIntensity -> 22 + SetItalicized True -> 3 + SetItalicized False -> 23 + SetUnderlining underlining -> case underlining of + SingleUnderline -> 4 + DoubleUnderline -> 21 + NoUnderline -> 24 + SetBlinkSpeed blink_speed -> case blink_speed of + SlowBlink -> 5 + RapidBlink -> 6 + NoBlink -> 25 + SetVisible False -> 8 + SetVisible True -> 28 + SetSwapForegroundBackground True -> 7 + SetSwapForegroundBackground False -> 27 + SetColor Foreground Dull color -> 30 + colorToCode color + SetColor Foreground Vivid color -> 90 + colorToCode color + SetColor Background Dull color -> 40 + colorToCode color + SetColor Background Vivid color -> 100 + colorToCode color + +cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode :: Int -- ^ Number of lines or characters to move + -> String +cursorUpCode n = csi [n] "A" +cursorDownCode n = csi [n] "B" +cursorForwardCode n = csi [n] "C" +cursorBackwardCode n = csi [n] "D" + +cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move + -> String +cursorDownLineCode n = csi [n] "E" +cursorUpLineCode n = csi [n] "F" + +setCursorColumnCode :: Int -- ^ 0-based column to move to + -> String +setCursorColumnCode n = csi [n + 1] "G" + +setCursorPositionCode :: Int -- ^ 0-based row to move to + -> Int -- ^ 0-based column to move to + -> String +setCursorPositionCode n m = csi [n + 1, m + 1] "H" + +clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode, clearScreenCode :: String +clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode, clearLineCode :: String + +clearFromCursorToScreenEndCode = csi [0] "J" +clearFromCursorToScreenBeginningCode = csi [1] "J" +clearScreenCode = csi [2] "J" +clearFromCursorToLineEndCode = csi [0] "K" +clearFromCursorToLineBeginningCode = csi [1] "K" +clearLineCode = csi [2] "K" + +scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by + -> String +scrollPageUpCode n = csi [n] "S" +scrollPageDownCode n = csi [n] "T" + +setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the + -- current console SGR mode. An empty list of commands is + -- equivalent to the list @[Reset]@. Commands are applied + -- left to right. + -> String +setSGRCode sgrs = csi (map sgrToCode sgrs) "m" + +hideCursorCode, showCursorCode :: String +hideCursorCode = csi [] "?25l" +showCursorCode = csi [] "?25h" + + +-- | XTerm control sequence to set the Icon Name and Window Title. +setTitleCode :: String -- ^ New Icon Name and Window Title + -> String +setTitleCode title = "\ESC]0;" ++ filter (/= '\007') title ++ "\007" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Common.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Common.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Common.hs 2013-12-14 14:25:39.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Common.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,53 +0,0 @@ -module System.Console.ANSI.Common where - -import Data.Ix - --- | ANSI colors: come in various intensities, which are controlled by 'ColorIntensity' -data Color = Black - | Red - | Green - | Yellow - | Blue - | Magenta - | Cyan - | White - deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) - --- | ANSI colors come in two intensities -data ColorIntensity = Dull - | Vivid - deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) - --- | ANSI colors can be set on two different layers -data ConsoleLayer = Foreground - | Background - deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) - --- | ANSI blink speeds: values other than 'NoBlink' are not widely supported -data BlinkSpeed = SlowBlink -- ^ Less than 150 blinks per minute - | RapidBlink -- ^ More than 150 blinks per minute - | NoBlink - deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) - --- | ANSI text underlining -data Underlining = SingleUnderline - | DoubleUnderline -- ^ Not widely supported - | NoUnderline - deriving (Eq, Ord, Bounded ,Enum, Show, Read, Ix) - --- | ANSI general console intensity: usually treated as setting the font style (e.g. 'BoldIntensity' causes text to be bold) -data ConsoleIntensity = BoldIntensity - | FaintIntensity -- ^ Not widely supported: sometimes treated as concealing text - | NormalIntensity - deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) - --- | ANSI Select Graphic Rendition command -data SGR = Reset - | SetConsoleIntensity ConsoleIntensity - | SetItalicized Bool -- ^ Not widely supported: sometimes treated as swapping foreground and background - | SetUnderlining Underlining - | SetBlinkSpeed BlinkSpeed - | SetVisible Bool -- ^ Not widely supported - | SetSwapForegroundBackground Bool - | SetColor ConsoleLayer ColorIntensity Color - deriving (Eq, Ord, Show, Read) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Example.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Example.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Example.hs 2013-12-14 14:25:39.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Example.hs 2017-05-24 13:15:38.000000000 +0200 @@ -24,8 +24,14 @@ main :: IO () main = mapM_ (\example -> resetScreen >> example) examples +-- Annex D to Standard ECMA-48 (5th Ed, 1991) identifies that the representation +-- of an erased state is implementation-dependent. There may or may not be a +-- distinction between a character position in the erased state and one imaging +-- SPACE. Consequently, to reset the screen, the default graphic rendition must +-- be selected (setSGR [Reset]) before all character positions are put into the +-- erased state (clearScreen). resetScreen :: IO () -resetScreen = clearScreen >> setSGR [Reset] >> setCursorPosition 0 0 +resetScreen = setSGR [Reset] >> clearScreen >> setCursorPosition 0 0 pause :: IO () pause = do @@ -264,4 +270,4 @@ pause -- Yup, I'm a new title! - ansi-terminal-ex - 83x70 --------------------------------------------------- - -- Title Demo \ No newline at end of file + -- Title Demo diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Types.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Types.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Types.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Types.hs 2016-10-09 12:08:26.000000000 +0200 @@ -0,0 +1,63 @@ +-- | Types used to represent SELECT GRAPHIC RENDITION (SGR) aspects. +module System.Console.ANSI.Types + ( + SGR (..) + , ConsoleLayer (..) + , Color (..) + , ColorIntensity (..) + , ConsoleIntensity (..) + , Underlining (..) + , BlinkSpeed (..) + ) where + +import Data.Ix + +-- | ANSI colors: come in various intensities, which are controlled by 'ColorIntensity' +data Color = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) + +-- | ANSI colors come in two intensities +data ColorIntensity = Dull + | Vivid + deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) + +-- | ANSI colors can be set on two different layers +data ConsoleLayer = Foreground + | Background + deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) + +-- | ANSI blink speeds: values other than 'NoBlink' are not widely supported +data BlinkSpeed = SlowBlink -- ^ Less than 150 blinks per minute + | RapidBlink -- ^ More than 150 blinks per minute + | NoBlink + deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) + +-- | ANSI text underlining +data Underlining = SingleUnderline + | DoubleUnderline -- ^ Not widely supported + | NoUnderline + deriving (Eq, Ord, Bounded ,Enum, Show, Read, Ix) + +-- | ANSI general console intensity: usually treated as setting the font style (e.g. 'BoldIntensity' causes text to be bold) +data ConsoleIntensity = BoldIntensity + | FaintIntensity -- ^ Not widely supported: sometimes treated as concealing text + | NormalIntensity + deriving (Eq, Ord, Bounded, Enum, Show, Read, Ix) + +-- | ANSI Select Graphic Rendition command +data SGR = Reset + | SetConsoleIntensity ConsoleIntensity + | SetItalicized Bool -- ^ Not widely supported: sometimes treated as swapping foreground and background + | SetUnderlining Underlining + | SetBlinkSpeed BlinkSpeed + | SetVisible Bool -- ^ Not widely supported + | SetSwapForegroundBackground Bool + | SetColor ConsoleLayer ColorIntensity Color + deriving (Eq, Ord, Show, Read) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Unix.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Unix.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Unix.hs 2014-10-25 16:28:55.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Unix.hs 2017-05-24 13:15:38.000000000 +0200 @@ -3,123 +3,37 @@ #include "Exports-Include.hs" ) where -import System.Console.ANSI.Common - -import System.IO - -import Data.List - +import System.Console.ANSI.Codes +import System.Console.ANSI.Types +import System.IO (Handle, hIsTerminalDevice, hPutStr, stdout) #include "Common-Include.hs" - --- | The reference I used for the ANSI escape characters in this module was <http://en.wikipedia.org/wiki/ANSI_escape_sequences>. -csi :: [Int] -> String -> String -csi args code = "\ESC[" ++ concat (intersperse ";" (map show args)) ++ code - -colorToCode :: Color -> Int -colorToCode color = case color of - Black -> 0 - Red -> 1 - Green -> 2 - Yellow -> 3 - Blue -> 4 - Magenta -> 5 - Cyan -> 6 - White -> 7 - -sgrToCode :: SGR -> Int -sgrToCode sgr = case sgr of - Reset -> 0 - SetConsoleIntensity intensity -> case intensity of - BoldIntensity -> 1 - FaintIntensity -> 2 - NormalIntensity -> 22 - SetItalicized True -> 3 - SetItalicized False -> 23 - SetUnderlining underlining -> case underlining of - SingleUnderline -> 4 - DoubleUnderline -> 21 - NoUnderline -> 24 - SetBlinkSpeed blink_speed -> case blink_speed of - SlowBlink -> 5 - RapidBlink -> 6 - NoBlink -> 25 - SetVisible False -> 8 - SetVisible True -> 28 - SetSwapForegroundBackground True -> 7 - SetSwapForegroundBackground False -> 27 - SetColor Foreground Dull color -> 30 + colorToCode color - SetColor Foreground Vivid color -> 90 + colorToCode color - SetColor Background Dull color -> 40 + colorToCode color - SetColor Background Vivid color -> 100 + colorToCode color - - -cursorUpCode n = csi [n] "A" -cursorDownCode n = csi [n] "B" -cursorForwardCode n = csi [n] "C" -cursorBackwardCode n = csi [n] "D" - hCursorUp h n = hPutStr h $ cursorUpCode n hCursorDown h n = hPutStr h $ cursorDownCode n hCursorForward h n = hPutStr h $ cursorForwardCode n hCursorBackward h n = hPutStr h $ cursorBackwardCode n - -cursorDownLineCode n = csi [n] "E" -cursorUpLineCode n = csi [n] "F" - hCursorDownLine h n = hPutStr h $ cursorDownLineCode n hCursorUpLine h n = hPutStr h $ cursorUpLineCode n - -setCursorColumnCode n = csi [n + 1] "G" -setCursorPositionCode n m = csi [n + 1, m + 1] "H" - hSetCursorColumn h n = hPutStr h $ setCursorColumnCode n hSetCursorPosition h n m = hPutStr h $ setCursorPositionCode n m - -clearFromCursorToScreenEndCode = csi [0] "J" -clearFromCursorToScreenBeginningCode = csi [1] "J" -clearScreenCode = csi [2] "J" - hClearFromCursorToScreenEnd h = hPutStr h clearFromCursorToScreenEndCode hClearFromCursorToScreenBeginning h = hPutStr h clearFromCursorToScreenBeginningCode hClearScreen h = hPutStr h clearScreenCode - -clearFromCursorToLineEndCode = csi [0] "K" -clearFromCursorToLineBeginningCode = csi [1] "K" -clearLineCode = csi [2] "K" - hClearFromCursorToLineEnd h = hPutStr h clearFromCursorToLineEndCode hClearFromCursorToLineBeginning h = hPutStr h clearFromCursorToLineBeginningCode hClearLine h = hPutStr h clearLineCode - -scrollPageUpCode n = csi [n] "S" -scrollPageDownCode n = csi [n] "T" - hScrollPageUp h n = hPutStr h $ scrollPageUpCode n hScrollPageDown h n = hPutStr h $ scrollPageDownCode n - -setSGRCode sgrs = csi (map sgrToCode sgrs) "m" - hSetSGR h sgrs = hPutStr h $ setSGRCode sgrs - -hideCursorCode = csi [] "?25l" -showCursorCode = csi [] "?25h" - hHideCursor h = hPutStr h hideCursorCode hShowCursor h = hPutStr h showCursorCode - --- | Thanks to Brandon S. Allbery and Curt Sampson for pointing me in the right direction on xterm title setting on haskell-cafe. --- The "0" signifies that both the title and "icon" text should be set: i.e. the text for the window in the Start bar (or similar) --- as well as that in the actual window title. This is chosen for consistent behaviour between Unixes and Windows. -setTitleCode title = "\ESC]0;" ++ filter (/= '\007') title ++ "\007" - -hSetTitle h title = hPutStr h $ setTitleCode title \ No newline at end of file +hSetTitle h title = hPutStr h $ setTitleCode title diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Detect.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Detect.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Detect.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Detect.hs 2017-05-24 13:15:38.000000000 +0200 @@ -0,0 +1,65 @@ +{-# OPTIONS_HADDOCK hide #-} + +module System.Console.ANSI.Windows.Detect +( + isANSIEnabled +) where + +import Control.Exception (SomeException(..), throwIO, try) +import Data.Bits ((.|.)) +import System.Console.ANSI.Windows.Foreign (ConsoleException(..), DWORD, + eNABLE_VIRTUAL_TERMINAL_PROCESSING, getConsoleMode, getStdHandle, HANDLE, + iNVALID_HANDLE_VALUE, nullHANDLE, setConsoleMode, sTD_OUTPUT_HANDLE) +-- 'lookupEnv' is not available until base-4.6.0.0 (GHC 7.6.1) +import System.Environment.Compat (lookupEnv) +import System.IO.Unsafe (unsafePerformIO) + +-- This function assumes that once it is first established whether or not the +-- Windows console is ANSI-enabled, that will not change. +{-# NOINLINE isANSIEnabled #-} +isANSIEnabled :: Bool +isANSIEnabled = unsafePerformIO safeIsANSIEnabled + +-- This function takes the following approach. 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 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 + result <- lookupEnv "TERM" + case result 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, 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 enable virtual terminal processing on the standard +-- output and throws an exception if it cannot. +enableANSIOut :: IO () +enableANSIOut = do + hOut <- getValidStdHandle sTD_OUTPUT_HANDLE + mOut <- getConsoleMode hOut + let mOut' = mOut .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING + setConsoleMode hOut mOut' + +-- 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 + if h == iNVALID_HANDLE_VALUE || h == nullHANDLE + then throwIO $ ConsoleException 6 -- Invalid Handle + else return h diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Emulator/Codes.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Emulator/Codes.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Emulator/Codes.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Emulator/Codes.hs 2017-05-24 13:15:38.000000000 +0200 @@ -0,0 +1,83 @@ +{-# OPTIONS_HADDOCK hide #-} + +module System.Console.ANSI.Windows.Emulator.Codes + ( + -- * Cursor movement by character + cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode + + -- * Cursor movement by line + , cursorUpLineCode, cursorDownLineCode + + -- * Directly changing cursor position + , setCursorColumnCode, setCursorPositionCode + + -- * Clearing parts of the screen + , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode + , clearScreenCode, clearFromCursorToLineEndCode + , clearFromCursorToLineBeginningCode, clearLineCode + + -- * Scrolling the screen + , scrollPageUpCode, scrollPageDownCode + + -- * Select Graphic Rendition mode: colors and other whizzy stuff + , setSGRCode + + -- * Cursor visibilty changes + , hideCursorCode, showCursorCode + + -- * Changing the title + , setTitleCode + ) where + +import System.Console.ANSI.Types + +cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode :: Int -- ^ Number of lines or characters to move + -> String +cursorUpCode _ = "" +cursorDownCode _ = "" +cursorForwardCode _ = "" +cursorBackwardCode _ = "" + +cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move + -> String +cursorDownLineCode _ = "" +cursorUpLineCode _ = "" + +setCursorColumnCode :: Int -- ^ 0-based column to move to + -> String +setCursorColumnCode _ = "" + +setCursorPositionCode :: Int -- ^ 0-based row to move to + -> Int -- ^ 0-based column to move to + -> String +setCursorPositionCode _ _ = "" + +clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode, clearScreenCode :: String +clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode, clearLineCode :: String + +clearFromCursorToScreenEndCode = "" +clearFromCursorToScreenBeginningCode = "" +clearScreenCode = "" +clearFromCursorToLineEndCode = "" +clearFromCursorToLineBeginningCode = "" +clearLineCode = "" + +scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by + -> String +scrollPageUpCode _ = "" +scrollPageDownCode _ = "" + +setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the + -- current console SGR mode. An empty list of commands is + -- equivalent to the list @[Reset]@. Commands are applied + -- left to right. + -> String +setSGRCode _ = "" + +hideCursorCode, showCursorCode :: String +hideCursorCode = "" +showCursorCode = "" + +setTitleCode :: String -- ^ New title + -> String +setTitleCode _ = "" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Emulator.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Emulator.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Emulator.hs 2015-08-20 15:46:50.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Emulator.hs 2017-05-24 13:15:38.000000000 +0200 @@ -2,17 +2,15 @@ #include "Exports-Include.hs" ) where -import System.Console.ANSI.Common +import System.Console.ANSI.Types import qualified System.Console.ANSI.Unix as Unix import System.Console.ANSI.Windows.Foreign +import System.Console.ANSI.Windows.Emulator.Codes import System.IO -import Control.Exception (SomeException, catchJust) -import Control.Monad (guard) - +import Control.Exception (catchJust) import Data.Bits -import Data.Char (toLower) import Data.List @@ -38,13 +36,10 @@ -- handle is there so that the terminal supports ANSI escape codes. So 99% of the time, the correct thing to do is -- just to fall back on the Unix module to output the ANSI codes and hope for the best. emulatorFallback :: IO a -> IO a -> IO a -emulatorFallback fallback first_try = catchJust (\e -> guard (isHandleIsInvalidException e) >> return ()) first_try (\() -> fallback) +emulatorFallback fallback first_try = catchJust invalidHandle first_try (const fallback) where - -- NB: this is a pretty hacked-up way to find out if we have the right sort of exception, but System.Win32.Types.fail* call into - -- the fail :: String -> IO a function, and so we don't get any nice exception object we can extract information from. - isHandleIsInvalidException :: SomeException -> Bool - isHandleIsInvalidException e = "the handle is invalid" `isInfixOf` e_string || "invalid handle" `isInfixOf` e_string - where e_string = map toLower (show e) + invalidHandle (ConsoleException 6) = Just () -- 6 is the Windows error code for invalid handles + invalidHandle (_) = Nothing adjustCursorPosition :: HANDLE -> (SHORT -> SHORT -> SHORT) -> (SHORT -> SHORT -> SHORT) -> IO () @@ -60,32 +55,16 @@ hCursorForward h n = emulatorFallback (Unix.hCursorForward h n) $ withHandle h $ \handle -> adjustCursorPosition handle (\_ x -> x + fromIntegral n) (\_ y -> y) hCursorBackward h n = emulatorFallback (Unix.hCursorBackward h n) $ withHandle h $ \handle -> adjustCursorPosition handle (\_ x -> x - fromIntegral n) (\_ y -> y) -cursorUpCode _ = "" -cursorDownCode _ = "" -cursorForwardCode _ = "" -cursorBackwardCode _ = "" - - adjustLine :: HANDLE -> (SHORT -> SHORT -> SHORT) -> IO () adjustLine handle change_y = adjustCursorPosition handle (\window_left _ -> window_left) change_y hCursorDownLine h n = emulatorFallback (Unix.hCursorDownLine h n) $ withHandle h $ \handle -> adjustLine handle (\_ y -> y + fromIntegral n) hCursorUpLine h n = emulatorFallback (Unix.hCursorUpLine h n) $ withHandle h $ \handle -> adjustLine handle (\_ y -> y - fromIntegral n) -cursorDownLineCode _ = "" -cursorUpLineCode _ = "" - - hSetCursorColumn h x = emulatorFallback (Unix.hSetCursorColumn h x) $ withHandle h $ \handle -> adjustCursorPosition handle (\window_left _ -> window_left + fromIntegral x) (\_ y -> y) -setCursorColumnCode _ = "" - - hSetCursorPosition h y x = emulatorFallback (Unix.hSetCursorPosition h y x) $ withHandle h $ \handle -> adjustCursorPosition handle (\window_left _ -> window_left + fromIntegral x) (\window_top _ -> window_top + fromIntegral y) -setCursorPositionCode _ _ = "" - - clearChar :: WCHAR clearChar = charToWCHAR ' ' @@ -142,14 +121,6 @@ where go window cursor_pos = (fromIntegral (rect_width window), cursor_pos { coord_x = rect_left window }) -clearFromCursorToScreenEndCode = "" -clearFromCursorToScreenBeginningCode = "" -clearScreenCode = "" -clearFromCursorToLineEndCode = "" -clearFromCursorToLineBeginningCode = "" -clearLineCode = "" - - hScrollPage :: HANDLE -> Int -> IO () hScrollPage handle new_origin_y = do screen_buffer_info <- getConsoleScreenBufferInfo handle @@ -161,10 +132,6 @@ hScrollPageUp h n = emulatorFallback (Unix.hScrollPageUp h n) $ withHandle h $ \handle -> hScrollPage handle (negate n) hScrollPageDown h n = emulatorFallback (Unix.hScrollPageDown h n) $ withHandle h $ \handle -> hScrollPage handle n -scrollPageUpCode _ = "" -scrollPageDownCode _ = "" - - {-# INLINE applyANSIColorToAttribute #-} applyANSIColorToAttribute :: WORD -> WORD -> WORD -> Color -> WORD -> WORD applyANSIColorToAttribute rED gREEN bLUE color attribute = case color of @@ -233,9 +200,6 @@ (if null sgr then [Reset] else sgr) setConsoleTextAttribute handle attribute' -setSGRCode _ = "" - - hChangeCursorVisibility :: HANDLE -> Bool -> IO () hChangeCursorVisibility handle cursor_visible = do cursor_info <- getConsoleCursorInfo handle @@ -244,13 +208,7 @@ hHideCursor h = emulatorFallback (Unix.hHideCursor h) $ withHandle h $ \handle -> hChangeCursorVisibility handle False hShowCursor h = emulatorFallback (Unix.hShowCursor h) $ withHandle h $ \handle -> hChangeCursorVisibility handle True -hideCursorCode = "" -showCursorCode = "" - - -- Windows only supports setting the terminal title on a process-wide basis, so for now we will -- assume that that is what the user intended. This will fail if they are sending the command -- over e.g. a network link... but that's not really what I'm designing for. hSetTitle h title = emulatorFallback (Unix.hSetTitle h title) $ withTString title $ setConsoleTitle - -setTitleCode _ = "" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Foreign.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Foreign.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows/Foreign.hs 2014-02-05 08:28:00.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows/Foreign.hs 2017-05-26 17:12:01.000000000 +0200 @@ -1,33 +1,45 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE DeriveDataTypeable #-} + -- | "System.Win32.Console" is really very impoverished, so I have had to do all the FFI myself. module System.Console.ANSI.Windows.Foreign ( -- Re-exports from Win32.Types - BOOL, WORD, DWORD, WCHAR, HANDLE, SHORT, - + BOOL, WORD, DWORD, WCHAR, HANDLE, iNVALID_HANDLE_VALUE, nullHANDLE, + SHORT, + charToWCHAR, - + COORD(..), SMALL_RECT(..), rect_top, rect_bottom, rect_left, rect_right, rect_width, rect_height, CONSOLE_CURSOR_INFO(..), CONSOLE_SCREEN_BUFFER_INFO(..), CHAR_INFO(..), - + sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE, - + + eNABLE_VIRTUAL_TERMINAL_INPUT, + eNABLE_VIRTUAL_TERMINAL_PROCESSING, + fOREGROUND_BLUE, fOREGROUND_GREEN, fOREGROUND_RED, fOREGROUND_INTENSITY, fOREGROUND_WHITE, fOREGROUND_INTENSE_WHITE, bACKGROUND_BLUE, bACKGROUND_GREEN, bACKGROUND_RED, bACKGROUND_INTENSITY, bACKGROUND_WHITE, bACKGROUND_INTENSE_WHITE, cOMMON_LVB_REVERSE_VIDEO, cOMMON_LVB_UNDERSCORE, - + getStdHandle, getConsoleScreenBufferInfo, getConsoleCursorInfo, - + getConsoleMode, + setConsoleTextAttribute, setConsoleCursorPosition, setConsoleCursorInfo, setConsoleTitle, - + setConsoleMode, + fillConsoleOutputAttribute, fillConsoleOutputCharacter, scrollConsoleScreenBuffer, - - withTString, withHandleToHANDLE + + withTString, withHandleToHANDLE, + + -- + ConsoleException(..) ) where import Foreign.C.Types @@ -40,11 +52,16 @@ import System.Win32.Types -import Control.Concurrent.MVar -import Control.Exception (bracket) +import Control.Exception (Exception, throw) -import Foreign.StablePtr +#if __GLASGOW_HASKELL__ >= 612 +import Data.Typeable +#endif +#if !MIN_VERSION_Win32(2,5,1) +import Control.Concurrent.MVar +import Foreign.StablePtr +import Control.Exception (bracket) #if __GLASGOW_HASKELL__ >= 612 import GHC.IO.Handle.Types (Handle(..), Handle__(..)) import GHC.IO.FD (FD(..)) -- A wrapper around an Int32 @@ -53,10 +70,21 @@ import GHC.IOBase (Handle(..), Handle__(..)) import qualified GHC.IOBase as IOBase (FD) -- Just an Int32 #endif +#endif +#if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +#elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +#else +# error Unknown mingw32 arch +#endif --- Some Windows types missing from System.Win32 +--import System.Console.ANSI.Windows.Foreign.Compat +#if !MIN_VERSION_Win32(2,5,0) +-- Some Windows types missing from System.Win32 prior version 2.5.0.0 type SHORT = CShort +#endif type WCHAR = CWchar charToWCHAR :: Char -> WCHAR @@ -204,7 +232,10 @@ poke ptr' attributes +eNABLE_VIRTUAL_TERMINAL_INPUT, eNABLE_VIRTUAL_TERMINAL_PROCESSING :: DWORD sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE :: DWORD +eNABLE_VIRTUAL_TERMINAL_INPUT = 512 +eNABLE_VIRTUAL_TERMINAL_PROCESSING = 4 sTD_INPUT_HANDLE = -10 sTD_OUTPUT_HANDLE = -11 sTD_ERROR_HANDLE = -12 @@ -229,78 +260,92 @@ fOREGROUND_INTENSE_WHITE = fOREGROUND_WHITE .|. fOREGROUND_INTENSITY bACKGROUND_INTENSE_WHITE = bACKGROUND_WHITE .|. bACKGROUND_INTENSITY - -foreign import stdcall unsafe "windows.h GetStdHandle" getStdHandle :: DWORD -> IO HANDLE -foreign import stdcall unsafe "windows.h GetConsoleScreenBufferInfo" cGetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL -foreign import stdcall unsafe "windows.h GetConsoleCursorInfo" cGetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL - -foreign import stdcall unsafe "windows.h SetConsoleTextAttribute" cSetConsoleTextAttribute :: HANDLE -> WORD -> IO BOOL -foreign import stdcall unsafe "windows.h SetConsoleCursorPosition" cSetConsoleCursorPosition :: HANDLE -> UNPACKED_COORD -> IO BOOL -foreign import stdcall unsafe "windows.h SetConsoleCursorInfo" cSetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL -foreign import stdcall unsafe "windows.h SetConsoleTitleW" cSetConsoleTitle :: LPCTSTR -> IO BOOL - -foreign import stdcall unsafe "windows.h FillConsoleOutputAttribute" cFillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL -foreign import stdcall unsafe "windows.h FillConsoleOutputCharacterW" cFillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL -foreign import stdcall unsafe "windows.h ScrollConsoleScreenBufferW" cScrollConsoleScreenBuffer :: HANDLE -> Ptr SMALL_RECT -> Ptr SMALL_RECT -> UNPACKED_COORD -> Ptr CHAR_INFO -> IO BOOL - +foreign import WINDOWS_CCONV unsafe "windows.h GetStdHandle" getStdHandle :: DWORD -> IO HANDLE +foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleScreenBufferInfo" cGetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCursorInfo" cGetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode" cGetConsoleMode :: HANDLE -> Ptr DWORD -> IO BOOL + +foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleTextAttribute" cSetConsoleTextAttribute :: HANDLE -> WORD -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCursorPosition" cSetConsoleCursorPosition :: HANDLE -> UNPACKED_COORD -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCursorInfo" cSetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleTitleW" cSetConsoleTitle :: LPCTSTR -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleMode" cSetConsoleMode :: HANDLE -> DWORD -> IO BOOL + +foreign import WINDOWS_CCONV unsafe "windows.h FillConsoleOutputAttribute" cFillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h FillConsoleOutputCharacterW" cFillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h ScrollConsoleScreenBufferW" cScrollConsoleScreenBuffer :: HANDLE -> Ptr SMALL_RECT -> Ptr SMALL_RECT -> UNPACKED_COORD -> Ptr CHAR_INFO -> IO BOOL + +data ConsoleException = ConsoleException !ErrCode deriving (Show, Eq, Typeable) + +instance Exception ConsoleException + +throwIfFalse :: IO Bool -> IO () +throwIfFalse action = do + succeeded <- action + if not succeeded + then getLastError >>= throw . ConsoleException -- TODO: Check if last error is zero for some instructable reason (?) + else return () getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO getConsoleScreenBufferInfo handle = alloca $ \ptr_console_screen_buffer_info -> do - failIfFalse_ "getConsoleScreenBufferInfo" $ cGetConsoleScreenBufferInfo handle ptr_console_screen_buffer_info + throwIfFalse $ cGetConsoleScreenBufferInfo handle ptr_console_screen_buffer_info peek ptr_console_screen_buffer_info + getConsoleCursorInfo :: HANDLE -> IO CONSOLE_CURSOR_INFO getConsoleCursorInfo handle = alloca $ \ptr_console_cursor_info -> do - failIfFalse_ "getConsoleCursorInfo" $ cGetConsoleCursorInfo handle ptr_console_cursor_info + throwIfFalse $ cGetConsoleCursorInfo handle ptr_console_cursor_info peek ptr_console_cursor_info +getConsoleMode :: HANDLE -> IO DWORD +getConsoleMode handle = alloca $ \ptr_mode -> do + throwIfFalse $ cGetConsoleMode handle ptr_mode + peek ptr_mode setConsoleTextAttribute :: HANDLE -> WORD -> IO () -setConsoleTextAttribute handle attributes = failIfFalse_ "setConsoleTextAttribute" $ cSetConsoleTextAttribute handle attributes +setConsoleTextAttribute handle attributes = throwIfFalse $ cSetConsoleTextAttribute handle attributes setConsoleCursorPosition :: HANDLE -> COORD -> IO () -setConsoleCursorPosition handle cursor_position = failIfFalse_ "setConsoleCursorPosition" $ cSetConsoleCursorPosition handle (unpackCOORD cursor_position) +setConsoleCursorPosition handle cursor_position = throwIfFalse $ cSetConsoleCursorPosition handle (unpackCOORD cursor_position) setConsoleCursorInfo :: HANDLE -> CONSOLE_CURSOR_INFO -> IO () setConsoleCursorInfo handle console_cursor_info = with console_cursor_info $ \ptr_console_cursor_info -> do - failIfFalse_ "setConsoleCursorInfo" $ cSetConsoleCursorInfo handle ptr_console_cursor_info + throwIfFalse $ cSetConsoleCursorInfo handle ptr_console_cursor_info setConsoleTitle :: LPCTSTR -> IO () -setConsoleTitle title = failIfFalse_ "setConsoleTitle" $ cSetConsoleTitle title +setConsoleTitle title = throwIfFalse $ cSetConsoleTitle title + +setConsoleMode :: HANDLE -> DWORD -> IO () +setConsoleMode handle attributes = throwIfFalse $ cSetConsoleMode handle attributes fillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> COORD -> IO DWORD fillConsoleOutputAttribute handle attribute fill_length write_origin = alloca $ \ptr_chars_written -> do - failIfFalse_ "fillConsoleOutputAttribute" $ cFillConsoleOutputAttribute handle attribute fill_length (unpackCOORD write_origin) ptr_chars_written + throwIfFalse $ cFillConsoleOutputAttribute handle attribute fill_length (unpackCOORD write_origin) ptr_chars_written peek ptr_chars_written fillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> COORD -> IO DWORD fillConsoleOutputCharacter handle char fill_length write_origin = alloca $ \ptr_chars_written -> do - failIfFalse_ "fillConsoleOutputCharacter" $ cFillConsoleOutputCharacter handle char fill_length (unpackCOORD write_origin) ptr_chars_written + throwIfFalse $ cFillConsoleOutputCharacter handle char fill_length (unpackCOORD write_origin) ptr_chars_written peek ptr_chars_written scrollConsoleScreenBuffer :: HANDLE -> SMALL_RECT -> Maybe SMALL_RECT -> COORD -> CHAR_INFO -> IO () -scrollConsoleScreenBuffer handle scroll_rectangle mb_clip_rectangle destination_origin fill +scrollConsoleScreenBuffer handle scroll_rectangle mb_clip_rectangle destination_origin fill = with scroll_rectangle $ \ptr_scroll_rectangle -> maybeWith with mb_clip_rectangle $ \ptr_clip_rectangle -> with fill $ \ptr_fill -> - failIfFalse_ "scrollConsoleScreenBuffer" $ cScrollConsoleScreenBuffer handle ptr_scroll_rectangle ptr_clip_rectangle (unpackCOORD destination_origin) ptr_fill - + throwIfFalse $ cScrollConsoleScreenBuffer handle ptr_scroll_rectangle ptr_clip_rectangle (unpackCOORD destination_origin) ptr_fill --- This essential function comes from the C runtime system. It is certainly provided by msvcrt, and also seems to be provided by the mingw C library - hurrah! -#if __GLASGOW_HASKELL__ >= 612 -foreign import ccall unsafe "_get_osfhandle" cget_osfhandle :: CInt -> IO HANDLE -#else -foreign import ccall unsafe "_get_osfhandle" cget_osfhandle :: IOBase.FD -> IO HANDLE -#endif +#if !MIN_VERSION_Win32(2,5,1) -- | This bit is all highly dubious. The problem is that we want to output ANSI to arbitrary Handles rather than forcing -- people to use stdout. However, the Windows ANSI emulator needs a Windows HANDLE to work it's magic, so we need to be able -- to extract one of those from the Haskell Handle. -- -- This code accomplishes this, albeit at the cost of only being compatible with GHC. +-- withHandleToHANDLE was added in Win32-2.5.1.0 withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a -withHandleToHANDLE haskell_handle action = +withHandleToHANDLE haskell_handle action = -- Create a stable pointer to the Handle. This prevents the garbage collector -- getting to it while we are doing horrible manipulations with it, and hence -- stops it being finalized (and closed). @@ -309,7 +354,7 @@ let write_handle_mvar = case haskell_handle of FileHandle _ handle_mvar -> handle_mvar DuplexHandle _ _ handle_mvar -> handle_mvar -- This is "write" MVar, we could also take the "read" one - + -- Get the FD from the algebraic data type #if __GLASGOW_HASKELL__ < 612 fd <- fmap haFD $ readMVar write_handle_mvar @@ -320,9 +365,18 @@ -- Finally, turn that (C-land) FD into a HANDLE using msvcrt windows_handle <- cget_osfhandle fd - + -- Do what the user originally wanted action windows_handle +-- This essential function comes from the C runtime system. It is certainly provided by msvcrt, and also seems to be provided by the mingw C library - hurrah! +#if __GLASGOW_HASKELL__ >= 612 +foreign import WINDOWS_CCONV unsafe "_get_osfhandle" cget_osfhandle :: CInt -> IO HANDLE +#else +foreign import WINDOWS_CCONV unsafe "_get_osfhandle" cget_osfhandle :: IOBase.FD -> IO HANDLE +#endif + +-- withStablePtr was added in Win32-2.5.1.0 withStablePtr :: a -> (StablePtr a -> IO b) -> IO b -withStablePtr value = bracket (newStablePtr value) freeStablePtr \ No newline at end of file +withStablePtr value = bracket (newStablePtr value) freeStablePtr +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI/Windows.hs 2013-12-14 14:25:39.000000000 +0100 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI/Windows.hs 2017-05-24 13:15:38.000000000 +0200 @@ -3,5 +3,166 @@ #include "Exports-Include.hs" ) where -import System.Console.ANSI.Common -import System.Console.ANSI.Windows.Emulator +import System.Console.ANSI.Types +import qualified System.Console.ANSI.Unix as U +import System.Console.ANSI.Windows.Detect (isANSIEnabled) +import qualified System.Console.ANSI.Windows.Emulator as E +import System.IO (Handle, hIsTerminalDevice, stdout) + +#include "Common-Include.hs" + +-- * Cursor movement by character +hCursorUp = if isANSIEnabled then U.hCursorUp else E.hCursorUp + +hCursorDown = if isANSIEnabled then U.hCursorDown else E.hCursorDown + +hCursorForward = if isANSIEnabled then U.hCursorForward else E.hCursorForward + +hCursorBackward = if isANSIEnabled then U.hCursorBackward else E.hCursorBackward + +cursorUpCode :: Int -> String +cursorUpCode = if isANSIEnabled then U.cursorUpCode else E.cursorUpCode + +cursorDownCode :: Int -> String +cursorDownCode = if isANSIEnabled then U.cursorDownCode else E.cursorDownCode + +cursorForwardCode :: Int -> String +cursorForwardCode = if isANSIEnabled + then U.cursorForwardCode + else E.cursorForwardCode + +cursorBackwardCode :: Int -> String +cursorBackwardCode = if isANSIEnabled + then U.cursorBackwardCode + else E.cursorBackwardCode + +-- * Cursor movement by line +hCursorUpLine = if isANSIEnabled then U.hCursorUpLine else E.hCursorUpLine + +hCursorDownLine = if isANSIEnabled then U.hCursorDownLine else E.hCursorDownLine + +cursorUpLineCode :: Int -> String +cursorUpLineCode = if isANSIEnabled + then U.cursorUpLineCode + else E.cursorUpLineCode + +cursorDownLineCode :: Int -> String +cursorDownLineCode = if isANSIEnabled + then U.cursorDownLineCode + else E.cursorDownLineCode + +-- * Directly changing cursor position +hSetCursorColumn = if isANSIEnabled + then U.hSetCursorColumn + else E.hSetCursorColumn + +setCursorColumnCode :: Int -> String +setCursorColumnCode = if isANSIEnabled + then U.setCursorColumnCode + else E.setCursorColumnCode + +hSetCursorPosition = if isANSIEnabled + then U.hSetCursorPosition + else E.hSetCursorPosition + +setCursorPositionCode :: Int -> Int -> String +setCursorPositionCode = if isANSIEnabled + then U.setCursorPositionCode + else E.setCursorPositionCode + +-- * Clearing parts of the screen +hClearFromCursorToScreenEnd = if isANSIEnabled + then U.hClearFromCursorToScreenEnd + else E.hClearFromCursorToScreenEnd + +hClearFromCursorToScreenBeginning = if isANSIEnabled + then U.hClearFromCursorToScreenBeginning + else E.hClearFromCursorToScreenBeginning + +hClearScreen = if isANSIEnabled then U.hClearScreen else E.hClearScreen + +clearFromCursorToScreenEndCode :: String +clearFromCursorToScreenEndCode = if isANSIEnabled + then U.clearFromCursorToScreenEndCode + else E.clearFromCursorToScreenEndCode + +clearFromCursorToScreenBeginningCode :: String +clearFromCursorToScreenBeginningCode = + if isANSIEnabled + then U.clearFromCursorToScreenBeginningCode + else E.clearFromCursorToScreenBeginningCode + +clearScreenCode :: String +clearScreenCode = if isANSIEnabled then U.clearScreenCode else E.clearScreenCode + +hClearFromCursorToLineEnd = if isANSIEnabled + then U.hClearFromCursorToLineEnd + else E.hClearFromCursorToLineEnd + +hClearFromCursorToLineBeginning = if isANSIEnabled + then U.hClearFromCursorToLineBeginning + else E.hClearFromCursorToLineBeginning + +hClearLine = if isANSIEnabled then U.hClearLine else E.hClearLine + +clearFromCursorToLineEndCode :: String +clearFromCursorToLineEndCode = if isANSIEnabled + then U.clearFromCursorToLineEndCode + else E.clearFromCursorToLineEndCode + +clearFromCursorToLineBeginningCode :: String +clearFromCursorToLineBeginningCode = if isANSIEnabled + then U.clearFromCursorToLineBeginningCode + else E.clearFromCursorToLineBeginningCode + +clearLineCode :: String +clearLineCode = if isANSIEnabled then U.clearLineCode else E.clearLineCode + +-- * Scrolling the screen +hScrollPageUp = if isANSIEnabled then U.hScrollPageUp else E.hScrollPageUp +hScrollPageDown = if isANSIEnabled then U.hScrollPageDown else E.hScrollPageDown + +scrollPageUpCode :: Int -> String +scrollPageUpCode = if isANSIEnabled + then U.scrollPageUpCode + else E.scrollPageUpCode + +scrollPageDownCode :: Int -> String +scrollPageDownCode = if isANSIEnabled + then U.scrollPageDownCode + else E.scrollPageDownCode + +-- * Select Graphic Rendition mode: colors and other whizzy stuff +-- +-- The following SGR codes are NOT implemented by Windows 10 Threshold 2: +-- 2 SetConsoleIntensity FaintIntensity +-- 3 SetItalicized True +-- 5 SetBlinkSpeed SlowBlink +-- 6 SetBlinkSpeed RapidBlink +-- 8 SetVisible False +-- 21 SetUnderlining DoubleUnderline +-- 23 SetItalicized False +-- 25 SetBlinkSpeed NoBlink +-- 28 SetVisible True + +hSetSGR = if isANSIEnabled then U.hSetSGR else E.hSetSGR + +setSGRCode :: [SGR] -> String +setSGRCode = if isANSIEnabled then U.setSGRCode else E.setSGRCode + +-- * Cursor visibilty changes +hHideCursor = if isANSIEnabled then U.hHideCursor else E.hHideCursor + +hShowCursor = if isANSIEnabled then U.hShowCursor else E.hShowCursor + +hideCursorCode :: String +hideCursorCode = if isANSIEnabled then U.hideCursorCode else E.hideCursorCode + +showCursorCode :: String +showCursorCode = if isANSIEnabled then U.showCursorCode else E.showCursorCode + +-- * Changing the title +hSetTitle = if isANSIEnabled then U.hSetTitle else E.hSetTitle + +setTitleCode :: String -> String +setTitleCode = if isANSIEnabled then U.setTitleCode else E.setTitleCode diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/System/Console/ANSI.hs new/ansi-terminal-0.6.3.1/System/Console/ANSI.hs --- old/ansi-terminal-0.6.2.3/System/Console/ANSI.hs 2015-09-10 09:05:48.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/System/Console/ANSI.hs 2017-05-24 13:15:38.000000000 +0200 @@ -1,4 +1,7 @@ --- | Provides ANSI terminal support for Windows and ANSI terminal software running on a Unix-like operating system. +-- | Provides ANSI terminal support for ANSI terminal software running on a +-- Unix-like operating system or on a Windows operating system (where supported) +-- or on other Windows operating systems where the terminal in use is not +-- ANSI-enabled. -- -- The ANSI escape codes are described at <http://en.wikipedia.org/wiki/ANSI_escape_code> and provide a rich range of -- functionality for terminal control, which includes: @@ -19,13 +22,18 @@ -- and Unix. -- -- * Chocolate: has an @IO ()@ type but takes a @Handle@. This outputs the ANSI command on the terminal corresponding --- to the supplied handle. Commands issued like this should also work as your expect on both Windows and Unix. +-- to the supplied handle. Commands issued like this should also work as you expect on both Windows and Unix. -- -- * Strawberry: has a @String@ type and just consists of an escape code which can be added to any other bit of text --- before being output. This version of the API is often convenient to use, but due to fundamental limitations in --- Windows ANSI terminal support will only work on Unix. On Windows these codes will always be the empty string, --- so it is possible to use them portably for e.g. coloring console output on the understanding that you will only --- see colors if you are running on a Unix-like operating system. +-- before being output. This version of the API is often convenient to use, +-- but will not work on Windows operating systems where the terminal in use +-- is not ANSI-enabled (such as those before Windows 10 Threshold 2). On +-- versions of Windows where the terminal in use is not ANSI-enabled, these +-- codes will always be the empty string, so it is possible to use them +-- portably for e.g. coloring console output on the understanding that you +-- will only see colors if you are running on an operating system that is +-- Unix-like or is a version of Windows where the terminal in use is ANSI- +-- enabled. -- -- Example: -- @@ -59,4 +67,4 @@ #error Unsupported platform for the ansi-terminal package -#endif \ No newline at end of file +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/ansi-terminal.cabal new/ansi-terminal-0.6.3.1/ansi-terminal.cabal --- old/ansi-terminal-0.6.2.3/ansi-terminal.cabal 2015-09-10 09:06:37.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/ansi-terminal.cabal 2017-05-31 16:21:45.000000000 +0200 @@ -1,5 +1,5 @@ Name: ansi-terminal -Version: 0.6.2.3 +Version: 0.6.3.1 Cabal-Version: >= 1.6 Category: User Interfaces Synopsis: Simple ANSI terminal support, with Windows compatibility @@ -17,7 +17,6 @@ CHANGELOG.md README.md - Source-repository head type: git location: git://github.com/feuerbach/ansi-terminal.git @@ -28,24 +27,26 @@ Library Exposed-Modules: System.Console.ANSI - - Other-Modules: System.Console.ANSI.Common + System.Console.ANSI.Types + System.Console.ANSI.Codes Include-Dirs: includes Build-Depends: base >= 4 && < 5 if os(windows) - Build-Depends: Win32 >= 2.0 + Build-Depends: base-compat >= 0.9.1 + , Win32 >= 2.0 + , process Cpp-Options: -DWINDOWS - Extra-Libraries: "kernel32" Other-Modules: System.Console.ANSI.Windows - System.Console.ANSI.Windows.Foreign + System.Console.ANSI.Windows.Detect System.Console.ANSI.Windows.Emulator + System.Console.ANSI.Windows.Emulator.Codes + System.Console.ANSI.Windows.Foreign -- NB: used for fallback by the emulator System.Console.ANSI.Unix else -- We assume any non-Windows platform is Unix - Build-Depends: unix >= 2.3.0.0 Cpp-Options: -DUNIX Other-Modules: System.Console.ANSI.Unix @@ -58,26 +59,30 @@ Main-Is: System/Console/ANSI/Example.hs Include-Dirs: includes - + + Other-Modules: System.Console.ANSI + System.Console.ANSI.Codes + System.Console.ANSI.Types + System.Console.ANSI.Unix + if os(windows) - Build-Depends: Win32 >= 2.0 + Build-Depends: base-compat >= 0.9.1 + , Win32 >= 2.0 Cpp-Options: -DWINDOWS - Extra-Libraries: "kernel32" Other-Modules: System.Console.ANSI.Windows - System.Console.ANSI.Windows.Foreign + System.Console.ANSI.Windows.Detect System.Console.ANSI.Windows.Emulator + System.Console.ANSI.Windows.Emulator.Codes + System.Console.ANSI.Windows.Foreign else -- We assume any non-Windows platform is Unix - Build-Depends: unix >= 2.3.0.0 Cpp-Options: -DUNIX - Other-Modules: System.Console.ANSI.Unix - - + Build-Depends: base >= 4 && < 5 Extensions: CPP ForeignFunctionInterface - + Ghc-Options: -Wall - + if !flag(example) Buildable: False diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/includes/Common-Include.hs new/ansi-terminal-0.6.3.1/includes/Common-Include.hs --- old/ansi-terminal-0.6.2.3/includes/Common-Include.hs 2015-08-20 15:46:50.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/includes/Common-Include.hs 2017-05-24 13:15:38.000000000 +0200 @@ -8,38 +8,26 @@ -> IO () cursorUp, cursorDown, cursorForward, cursorBackward :: Int -- ^ Number of lines or characters to move -> IO () -cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode :: Int -- ^ Number of lines or characters to move - -> String - cursorUp = hCursorUp stdout cursorDown = hCursorDown stdout cursorForward = hCursorForward stdout cursorBackward = hCursorBackward stdout - hCursorDownLine, hCursorUpLine :: Handle -> Int -- ^ Number of lines to move -> IO () cursorDownLine, cursorUpLine :: Int -- ^ Number of lines to move -> IO () -cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move - -> String - cursorDownLine = hCursorDownLine stdout cursorUpLine = hCursorUpLine stdout - hSetCursorColumn :: Handle -> Int -- ^ 0-based column to move to -> IO () setCursorColumn :: Int -- ^ 0-based column to move to -> IO () -setCursorColumnCode :: Int -- ^ 0-based column to move to - -> String - setCursorColumn = hSetCursorColumn stdout - hSetCursorPosition :: Handle -> Int -- ^ 0-based row to move to -> Int -- ^ 0-based column to move to @@ -47,33 +35,23 @@ setCursorPosition :: Int -- ^ 0-based row to move to -> Int -- ^ 0-based column to move to -> IO () -setCursorPositionCode :: Int -- ^ 0-based row to move to - -> Int -- ^ 0-based column to move to - -> String - setCursorPosition = hSetCursorPosition stdout - hClearFromCursorToScreenEnd, hClearFromCursorToScreenBeginning, hClearScreen :: Handle -> IO () clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen :: IO () -clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode, clearScreenCode :: String - clearFromCursorToScreenEnd = hClearFromCursorToScreenEnd stdout clearFromCursorToScreenBeginning = hClearFromCursorToScreenBeginning stdout clearScreen = hClearScreen stdout - hClearFromCursorToLineEnd, hClearFromCursorToLineBeginning, hClearLine :: Handle -> IO () clearFromCursorToLineEnd, clearFromCursorToLineBeginning, clearLine :: IO () -clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode, clearLineCode :: String clearFromCursorToLineEnd = hClearFromCursorToLineEnd stdout clearFromCursorToLineBeginning = hClearFromCursorToLineBeginning stdout clearLine = hClearLine stdout - -- | Scroll the displayed information up or down the terminal: not widely supported hScrollPageUp, hScrollPageDown :: Handle -> Int -- ^ Number of lines to scroll by @@ -82,13 +60,9 @@ scrollPageUp, scrollPageDown :: Int -- ^ Number of lines to scroll by -> IO () -- | Scroll the displayed information up or down the terminal: not widely supported -scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by - -> String - scrollPageUp = hScrollPageUp stdout scrollPageDown = hScrollPageDown stdout - -- | Set the Select Graphic Rendition mode hSetSGR :: Handle -> [SGR] -- ^ Commands: these will typically be applied on top of the current console SGR mode. @@ -101,23 +75,14 @@ -- left to right. -> IO () -- | Set the Select Graphic Rendition mode -setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the current console SGR mode. - -- An empty list of commands is equivalent to the list @[Reset]@. Commands are applied - -- left to right. - -> String - setSGR = hSetSGR stdout - hHideCursor, hShowCursor :: Handle -> IO () hideCursor, showCursor :: IO () -hideCursorCode, showCursorCode :: String - hideCursor = hHideCursor stdout showCursor = hShowCursor stdout - -- | Set the terminal window title hSetTitle :: Handle -> String -- ^ New title @@ -125,17 +90,13 @@ -- | Set the terminal window title setTitle :: String -- ^ New title -> IO () --- | Set the terminal window title -setTitleCode :: String -- ^ New title - -> String - setTitle = hSetTitle stdout -- | 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@ (whcih is what +-- that the @TERM@ environment variable doesn't say @dumb@ (which is what -- Emacs sets for its own terminal). hSupportsANSI :: Handle -> IO Bool -- Borrowed from an HSpec patch by Simon Hengel diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.6.2.3/includes/Exports-Include.hs new/ansi-terminal-0.6.3.1/includes/Exports-Include.hs --- old/ansi-terminal-0.6.2.3/includes/Exports-Include.hs 2014-10-25 14:50:46.000000000 +0200 +++ new/ansi-terminal-0.6.3.1/includes/Exports-Include.hs 2017-05-24 13:15:38.000000000 +0200 @@ -1,5 +1,5 @@ -- * Basic data types -module System.Console.ANSI.Common, +module System.Console.ANSI.Types, -- * Cursor movement by character cursorUp, cursorDown, cursorForward, cursorBackward, @@ -7,6 +7,13 @@ cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode, -- * Cursor movement by line +-- | The difference between movements \"by character\" and \"by line\" is +-- that @*Line@ functions additionally move the cursor to the start of the +-- line, while functions like @cursorUp@ and @cursorDown@ keep the column +-- the same. +-- +-- Also keep in mind that @*Line@ functions are not as portable. See +-- <https://github.com/feuerbach/ansi-terminal/issues/10> for the details. cursorUpLine, cursorDownLine, hCursorUpLine, hCursorDownLine, cursorUpLineCode, cursorDownLineCode, @@ -21,6 +28,8 @@ setCursorPositionCode, -- * Clearing parts of the screen +-- | Note that these functions only clear parts of the screen. They do not move the +-- cursor. clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen, hClearFromCursorToScreenEnd, hClearFromCursorToScreenBeginning, hClearScreen, clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode, clearScreenCode,
