ansi-terminal 0.6.2.3 → 0.6.3

raw patch · 15 files changed

+702/−302 lines, 15 filesdep +base-compatdep +processdep −unixdep ~Win32PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base-compat, process

Dependencies removed: unix

Dependency ranges changed: Win32

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• System/Console/ANSI.hs +14/−6
• System/Console/ANSI/Codes.hs +161/−0
• System/Console/ANSI/Common.hs +0/−53
• System/Console/ANSI/Example.hs +7/−1
• System/Console/ANSI/Types.hs +63/−0
• System/Console/ANSI/Unix.hs +3/−89
• System/Console/ANSI/Windows.hs +163/−2
• System/Console/ANSI/Windows/Detect.hs +65/−0
• System/Console/ANSI/Windows/Emulator.hs +6/−48
• System/Console/ANSI/Windows/Emulator/Codes.hs +83/−0
• System/Console/ANSI/Windows/Foreign.hs +97/−44
• ansi-terminal.cabal +23/−18
• includes/Common-Include.hs +1/−40
• includes/Exports-Include.hs +10/−1

@@ -1,6 +1,12 @@ Changes ======= +Version 0.6.3+-------------++* Add ANSI support for Windows+* Add compatibility with Win32-2.5.0.0 and above+ Version 0.6.2.3 --------------- 

@@ -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: --

@@ -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"

@@ -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)

@@ -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

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -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 _ = ""

@@ -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 _ = ""

@@ -1,33 +1,44 @@+{-# OPTIONS_HADDOCK hide #-}+ -- | "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 +51,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 +69,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 +231,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 +259,92 @@ fOREGROUND_INTENSE_WHITE = fOREGROUND_WHITE .|. fOREGROUND_INTENSITY bACKGROUND_INTENSE_WHITE = bACKGROUND_WHITE .|. bACKGROUND_INTENSITY +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 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 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 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 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 -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+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 +353,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 +364,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+#endif

@@ -1,5 +1,5 @@ Name:                ansi-terminal-Version:             0.6.2.3+Version:             0.6.3 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

@@ -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

@@ -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,