ansi-terminal-1.0.2/app/0000755000000000000000000000000014550533447013235 5ustar0000000000000000ansi-terminal-1.0.2/src/0000755000000000000000000000000014425674750013250 5ustar0000000000000000ansi-terminal-1.0.2/src/System/0000755000000000000000000000000014425674750014534 5ustar0000000000000000ansi-terminal-1.0.2/src/System/Console/0000755000000000000000000000000014550533447016132 5ustar0000000000000000ansi-terminal-1.0.2/src/System/Console/ANSI/0000755000000000000000000000000014543633435016664 5ustar0000000000000000ansi-terminal-1.0.2/unix/0000755000000000000000000000000014425674750013444 5ustar0000000000000000ansi-terminal-1.0.2/unix/System/0000755000000000000000000000000014425674750014730 5ustar0000000000000000ansi-terminal-1.0.2/unix/System/Console/0000755000000000000000000000000014425674750016332 5ustar0000000000000000ansi-terminal-1.0.2/unix/System/Console/ANSI/0000755000000000000000000000000014550533447017060 5ustar0000000000000000ansi-terminal-1.0.2/win/0000755000000000000000000000000014427707230013246 5ustar0000000000000000ansi-terminal-1.0.2/win/System/0000755000000000000000000000000014427707227014540 5ustar0000000000000000ansi-terminal-1.0.2/win/System/Console/0000755000000000000000000000000014425674750016144 5ustar0000000000000000ansi-terminal-1.0.2/win/System/Console/ANSI/0000755000000000000000000000000014550533447016672 5ustar0000000000000000ansi-terminal-1.0.2/win/System/Console/ANSI/Windows/0000755000000000000000000000000014550533447020324 5ustar0000000000000000ansi-terminal-1.0.2/win/System/Console/ANSI/Windows/Win32/0000755000000000000000000000000014550533447021226 5ustar0000000000000000ansi-terminal-1.0.2/win/c-source/0000755000000000000000000000000014550533447014772 5ustar0000000000000000ansi-terminal-1.0.2/win/include/0000755000000000000000000000000014550533447014675 5ustar0000000000000000ansi-terminal-1.0.2/src/System/Console/ANSI.hs0000644000000000000000000012054314550536504017222 0ustar0000000000000000{-# LANGUAGE Safe #-} {-| == Introduction Through this module, this library provides platform-independent support for control character sequences following the \'ANSI\' standards (see further below) for terminal software that supports those sequences, running on a Unix-like operating system or on Windows (see further below). The sequences of control characters (also referred to as \'escape\' sequences or codes) provide a rich range of functionality for terminal control, which includes: * Colored text output, with control over both foreground and background colors * Clearing parts of a line or the screen * Hiding or showing the cursor * Moving the cursor around * Reporting the position of the cursor * Scrolling the screen up or down * Switching between the Alternate and Normal Screen Buffers * Clickable hyperlinks to URIs * Changing the title of the terminal A terminal that supports control character sequences acts on them when they are flushed from the output buffer (with a newline character @\"\\n\"@ or, for the standard output channel, @hFlush stdout@). == \'ANSI\' standards The \'ANSI\' standards refer to (1) standard ECMA-48 \`Control Functions for Coded Character Sets\' (5th edition, 1991); (2) extensions in ITU-T Recommendation (previously CCITT Recommendation) T.416 (03/93) \'Information Technology – Open Document Architecture (ODA) and Interchange Format: Character Content Architectures\` (also published as ISO/IEC International Standard 8613-6); and (3) further extensions used by \'XTerm\', a terminal emulator for the X Window System. The escape codes are described in a [Wikipedia article](http://en.wikipedia.org/wiki/ANSI_escape_code) and those codes supported on current versions of Windows are descibed in [Microsoft's documentation](https://docs.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences). The whole of the \'ANSI\' standards are not supported by this library but most (if not all) of the parts that are popular and well-supported by terminal software are supported (see further below). == Cursor positions The functions moving the cursor to an absolute position are 0-based (the top-left corner is considered to be at row 0 column 0) (see 'setCursorPosition') and so is 'getCursorPosition'. The \'ANSI\' standards themselves are 1-based (that is, the top-left corner is considered to be at row 1 column 1) and some functions reporting the position of the cursor are too (see 'reportCursorPosition'). == Windows and control character sequences The native terminal software on Windows has developed over time. Before Windows 10 version 1511 (known as the \'November [2015] Update\' or \'Threshold 2\') that software did not support control character sequences. From 2018, Microsoft introduced the Windows Pseudo Console (\'ConPTY\') API and then Windows Terminal, with the objective of replacing most of the Windows Console API with the use of control character sequences and retiring the historical user-interface role of Windows Console Host (\'ConHost\'). Windows Terminal is supported on Windows 10 version 19041.0 or higher and provided with Windows 11. It can be downloaded from the Microsoft Store. Windows Terminal can be set as the default terminal application on Windows 10 (from the 22H2 update) and is the default application on Windows 11 (from the 22H2 update). Despite the above developments, some Windows users may continue to use ConHost. ConHost does not enable the processing of \'ANSI\' control characters in output by default. See 'hNowSupportsANSI' for a function that can try to enable such processing. Terminal software other than the native software exists for Windows. One example is the \'mintty\' terminal emulator for \'Cygwin\', \'MSYS\' or \'MSYS2\', and dervied projects, and for \'WSL\' (Windows Subsystem for Linux). GHC's management of input and output (IO) on Windows has also developed over time. If they are supported by the terminal software, some control character sequences cause data to be emitted into the console input stream. For GHC's historical and default IO manager, the function 'hGetBufNonBlocking' in module "System.IO" does not work on Windows. This has been attributed to the lack of non-blocking primatives in the operating system (see [GHC bug report #806](https://ghc.haskell.org/trac/ghc/ticket/806). GHC's native IO manager on Windows (\'WinIO\'), introduced as a preview in [GHC 9.0.1](https://downloads.haskell.org/ghc/9.0.1/docs/html/users_guide/9.0.1-notes.html#highlights), has not yet provided a solution. On Windows, this library uses emulation based on the Windows Console API to try to read data emitted into the console input stream. Functions that use that emulation are not supported on consoles, such as mintty, that are not based on that API. == Function variants provided Every function exported by this module comes in three variants, namely: * A variant that has an @IO ()@ type and doesn't take a @Handle@ (for example, @clearScreen :: IO ()@). This variant just outputs the \`ANSI\` command directly to the standard output channel ('stdout') and any terminal corresponding to it. Commands issued like this should work as you expect on both Unix-like operating systems and Windows (unless exceptions on Windows are stated). * An \'@h@...\' variant that has an @IO ()@ type but takes a @Handle@ (for example, @hClearScreen :: Handle -> IO ()@). This variant outputs the \`ANSI\` command to the supplied handle and any terminal corresponding to it. Commands issued like this should also work as you expect on both Unix-like operating systems and Windows (unless exceptions on Windows are stated). * A \'...@Code@\' variant that has a @String@ type (for example, @clearScreenCode :: String@). This variant outputs the sequence of control characters as a 'String', which can be added to any other bit of text before being output. If a high degree of backwards compatability is rewuired, the use of these codes is discouraged because they will not work on legacy versions of Windows where the terminal in use is not ANSI-enabled (see further above). On Windows, where emulation has been necessary, these variants will always output the empty string. That is done so that it is possible to use them portably; for example, coloring console output on the understanding that you will see colors only if you are running on a Unix-like operating system or a version of Windows where emulation has not been necessary. If the control characters are always required, see module "System.Console.ANSI.Codes". == Examples of use A simple example is below: > module Main where > > import System.Console.ANSI > import System.IO (stdout) > > -- Set colors and write some text in those colors. > main :: IO () > main = do > stdoutSupportsANSI <- hNowSupportsANSI stdout > if stdoutSupportsANSI > then do > setSGR [SetColor Foreground Vivid Red] > setSGR [SetColor Background Vivid Blue] > putStrLn "Red-On-Blue" > setSGR [Reset] -- Reset to default colour scheme > putStrLn "Default colors." > else > putStrLn "Standard output does not support 'ANSI' escape codes." Another example is below: > module Main where > > import System.IO (hFlush, stdout) > import System.Console.ANSI > > main :: IO () > main = do > stdoutSupportsANSI <- hNowSupportsANSI stdout > if stdoutSupportsANSI > then do > setSGR [SetColor Foreground Dull Blue] > putStr "Enter your name: " > setSGR [SetColor Foreground Dull Yellow] > hFlush stdout -- flush the output buffer before getLine > name <- getLine > setSGR [SetColor Foreground Dull Blue] > putStrLn $ "Hello, " ++ name ++ "!" > setSGR [Reset] -- reset to default colour scheme > else > putStrLn "Standard output does not support 'ANSI' escape codes." For many more examples, see the project's extensive file. -} module System.Console.ANSI ( -- * Basic data types module System.Console.ANSI.Types -- * Cursor movement by character , cursorUp , cursorDown , cursorForward , cursorBackward -- ** \'h...\' variants , hCursorUp , hCursorDown , hCursorForward , hCursorBackward -- ** \'...Code\' variants , 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. , cursorUpLine , cursorDownLine -- ** \'h...\' variants , hCursorUpLine , hCursorDownLine -- ** \'...Code\' variants , cursorUpLineCode , cursorDownLineCode -- * Directly changing cursor position , setCursorColumn , setCursorPosition -- ** \'h...\' variants , hSetCursorColumn , hSetCursorPosition -- ** \'...Code\' variants , setCursorColumnCode , setCursorPositionCode -- * Saving, restoring and reporting cursor position -- | These code sequences are not part of ECMA-48 standard; they are popular, -- but non-portable extensions. E. g., Terminal.app on MacOS -- . -- A more portable way would be to query @terminfo@ database -- for @rc@ and @sc@ capabilities. -- -- Cursor positions -- . -- , saveCursor , restoreCursor , reportCursorPosition -- ** \'h...\' variants , hSaveCursor , hRestoreCursor , hReportCursorPosition -- ** \'...Code\' variants , saveCursorCode , restoreCursorCode , reportCursorPositionCode -- * Clearing parts of the screen -- | Note that these functions only clear parts of the screen. They do not -- move the cursor. Some functions are based on the whole screen and others -- are based on the line in which the cursor is located. , clearFromCursorToScreenEnd , clearFromCursorToScreenBeginning , clearScreen , clearFromCursorToLineEnd , clearFromCursorToLineBeginning , clearLine -- ** \'h...\' variants , hClearFromCursorToScreenEnd , hClearFromCursorToScreenBeginning , hClearScreen , hClearFromCursorToLineEnd , hClearFromCursorToLineBeginning , hClearLine -- ** \'...Code\' variants , clearFromCursorToScreenEndCode , clearFromCursorToScreenBeginningCode , clearScreenCode , clearFromCursorToLineEndCode , clearFromCursorToLineBeginningCode , clearLineCode -- * Scrolling the screen , scrollPageUp , scrollPageDown -- ** \'h...\' variants , hScrollPageUp , hScrollPageDown -- ** \'...Code\' variants , scrollPageUpCode , scrollPageDownCode -- * Using screen buffers -- | These code sequences are not part of ECMA-48 standard; they are popular, -- but non-portable extensions, corresponding to @smcup@ and @rmcup@ capabilities -- in @terminfo@ database. -- On Windows, if emulation is required, switching between alternate and -- normal screen buffers is not emulated. , useAlternateScreenBuffer , useNormalScreenBuffer -- ** \'h...\' variants , hUseAlternateScreenBuffer , hUseNormalScreenBuffer -- ** \'...Code\' variants , useAlternateScreenBufferCode , useNormalScreenBufferCode -- * Reporting the background or foreground colors , reportLayerColor , hReportLayerColor , reportLayerColorCode -- * Select Graphic Rendition mode: colors and other whizzy stuff , setSGR , hSetSGR , setSGRCode -- * Cursor visibilty changes -- | Strictly speaking, these code sequences are not part of ECMA-48 standard; -- they are popular, but non-portable extensions. However, in practice they seem -- to work pretty much everywhere. , hideCursor , showCursor -- ** \'h...\' variants , hHideCursor , hShowCursor -- ** \'...Code\' variants , hideCursorCode , showCursorCode -- * Hyperlinks -- | These code sequences are not part of ECMA-48 standard and not even an -- @xterm@ extension. Nevertheless -- -- support them. On Windows, if emulation is required, -- hyperlinks are not emulated. , hyperlink , hyperlinkWithId , hyperlinkWithParams -- ** \'h...\' variants , hHyperlink , hHyperlinkWithId , hHyperlinkWithParams -- ** \'...Code\' variants , hyperlinkCode , hyperlinkWithIdCode , hyperlinkWithParamsCode -- * Changing the title , setTitle , hSetTitle , setTitleCode -- * Checking if handle supports ANSI (not portable: GHC only) , hSupportsANSI , hNowSupportsANSI , hSupportsANSIColor -- * Getting the cursor position , getCursorPosition , hGetCursorPosition , getReportedCursorPosition , cursorPosition -- * Getting the terminal size , getTerminalSize , hGetTerminalSize -- * Getting the background or foreground colors , getLayerColor , hGetLayerColor , getReportedLayerColor , layerColor -- * Deprecated , hSupportsANSIWithoutEmulation ) where import Control.Exception.Base ( bracket ) import Control.Monad ( when, void ) import Data.Char ( digitToInt, isDigit, isHexDigit ) import Data.Colour.SRGB ( RGB (..) ) import Data.Word ( Word16 ) import System.Environment ( getEnvironment ) import System.IO ( BufferMode (..), Handle, hFlush, hGetBuffering, hGetEcho, hPutStr , hReady, hSetBuffering, hSetEcho, stdin, stdout ) import Text.ParserCombinators.ReadP ( ReadP, (<++), char, many1, readP_to_S, satisfy, string ) import System.Console.ANSI.Codes import qualified System.Console.ANSI.Internal as Internal import System.Console.ANSI.Types hCursorUp, hCursorDown, hCursorForward, hCursorBackward :: Handle -> Int -- Number of lines or characters to move -> IO () 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 cursorUp, cursorDown, cursorForward, cursorBackward :: Int -- ^ Number of lines or characters to move -> IO () cursorUp = hCursorUp stdout cursorDown = hCursorDown stdout cursorForward = hCursorForward stdout cursorBackward = hCursorBackward stdout hCursorDownLine, hCursorUpLine :: Handle -> Int -- Number of lines to move -> IO () hCursorDownLine h n = hPutStr h $ cursorDownLineCode n hCursorUpLine h n = hPutStr h $ cursorUpLineCode n cursorDownLine, cursorUpLine :: Int -- ^ Number of lines to move -> IO () cursorDownLine = hCursorDownLine stdout cursorUpLine = hCursorUpLine stdout hSetCursorColumn :: Handle -> Int -- 0-based column to move to -> IO () hSetCursorColumn h n = hPutStr h $ setCursorColumnCode n -- | Move the cursor to the specified column. The column numbering is 0-based -- (that is, the left-most column is numbered 0). setCursorColumn :: Int -- ^ 0-based column to move to -> IO () setCursorColumn = hSetCursorColumn stdout hSetCursorPosition :: Handle -> Int -- 0-based row to move to -> Int -- 0-based column to move to -> IO () hSetCursorPosition h n m = hPutStr h $ setCursorPositionCode n m -- | Move the cursor to the specified position (row and column). The position is -- 0-based (that is, the top-left corner is at row 0 column 0). setCursorPosition :: Int -- ^ 0-based row to move to -> Int -- ^ 0-based column to move to -> IO () setCursorPosition = hSetCursorPosition stdout hSaveCursor, hRestoreCursor, hReportCursorPosition :: Handle -> IO () hSaveCursor h = hPutStr h saveCursorCode hRestoreCursor h = hPutStr h restoreCursorCode hReportCursorPosition h = hPutStr h reportCursorPositionCode -- | Save the cursor position in memory. The only way to access the saved value -- is with the 'restoreCursor' command. -- -- @since 0.7.1 saveCursor :: IO () saveCursor = hSaveCursor stdout -- | Restore the cursor position from memory. There will be no value saved in -- memory until the first use of the 'saveCursor' command. -- -- @since 0.7.1 restoreCursor :: IO () restoreCursor = hRestoreCursor stdout -- | Looking for a way to get the cursors position? See -- 'getCursorPosition'. -- -- Emit the cursor position into the console input stream, immediately after -- being recognised on the output stream, as: -- @ESC [ \ ; \ R@ -- -- Note that the information that is emitted is 1-based (the top-left corner is -- at row 1 column 1) but 'setCursorColumn' and 'setCursorPosition' are -- 0-based. -- -- In isolation of 'getReportedCursorPosition' or 'getCursorPosition', this -- function may be of limited use on Windows operating systems because of -- difficulties in obtaining the data emitted into the console input stream. -- -- @since 0.7.1 reportCursorPosition :: IO () reportCursorPosition = hReportCursorPosition stdout hHideCursor, hShowCursor :: Handle -> IO () hHideCursor h = hPutStr h hideCursorCode hShowCursor h = hPutStr h showCursorCode hideCursor, showCursor :: IO () hideCursor = hHideCursor stdout showCursor = hShowCursor stdout hUseAlternateScreenBuffer :: Handle -> IO () hUseAlternateScreenBuffer h = hPutStr h useAlternateScreenBufferCode hUseNormalScreenBuffer :: Handle -> IO () hUseNormalScreenBuffer h = hPutStr h useNormalScreenBufferCode -- | Use the Alternate Screen Buffer. If currently using the Normal Screen -- Buffer, it will save the cursor position and switch to the Alternate Screen -- Buffer. It will always clear the Alternate Screen Buffer. The Alternate -- Screen Buffer has no scroll back facility. -- -- It is an application's responsibility to ensure that it switches back to the -- Normal Screen Buffer if an exception is raised while the Alternate Screen -- Buffer is being used. For example, by using 'Control.Exception.bracket_': -- -- > bracket_ useAlternateScreenBuffer useNormalScreenBuffer action -- -- @since 0.11.4 useAlternateScreenBuffer :: IO () useAlternateScreenBuffer = hUseAlternateScreenBuffer stdout -- | Use the Normal Screen Buffer. If currently using the Alternate Screen -- Buffer, it will clear the Alternate Screen Buffer, and switch to the Normal -- Screen Buffer. It will always restore the saved cursor position. -- -- @since 0.11.4 useNormalScreenBuffer :: IO () useNormalScreenBuffer = hUseNormalScreenBuffer stdout -- Introduce a hyperlink with (key, value) parameters. Some terminals support -- an @id@ parameter key, so that hyperlinks with the same @id@ value are -- treated as connected. -- -- @since 0.11.3 hHyperlinkWithParams:: Handle -> [(String, String)] -- Parameters -> String -- URI -> String -- Link text -> IO () hHyperlinkWithParams h params uri link = hPutStr h $ hyperlinkWithParamsCode params uri link -- | Introduce a hyperlink with (key, value) parameters. Some terminals support -- an @id@ parameter key, so that hyperlinks with the same @id@ value are -- treated as connected. -- -- @since 0.11.3 hyperlinkWithParams :: [(String, String)] -- ^ Parameters -> String -- ^ URI -> String -- ^ Link text -> IO () hyperlinkWithParams = hHyperlinkWithParams stdout -- Introduce a hyperlink. -- -- @since 0.11.3 hHyperlink :: Handle -> String -- URI -> String -- Link text -> IO () hHyperlink h = hHyperlinkWithParams h [] -- | Introduce a hyperlink. -- -- @since 0.11.3 hyperlink :: String -- ^ URI -> String -- ^ Link text -> IO () hyperlink = hHyperlink stdout -- Introduce a hyperlink with an identifier for the link. Some terminals -- support an identifier, so that hyperlinks with the same identifier are -- treated as connected. -- -- @since 0.11.3 hHyperlinkWithId :: Handle -> String -- Identifier for the link -> String -- URI -> String -- Link text -> IO () hHyperlinkWithId h linkId = hHyperlinkWithParams h [("id", linkId)] -- | Introduce a hyperlink with an identifier for the link. Some terminals -- support an identifier, so that hyperlinks with the same identifier are -- treated as connected. -- -- @since 0.11.3 hyperlinkWithId :: String -- ^ Identifier for the link -> String -- ^ URI -> String -- ^ Link text -> IO () hyperlinkWithId = hHyperlinkWithId stdout -- Set the terminal window title and icon name (that is, the text for the -- window in the Start bar, or similar). hSetTitle :: Handle -> String -- New window title and icon name -> IO () hSetTitle h title = hPutStr h $ setTitleCode title -- | Set the terminal window title and icon name (that is, the text for the -- window in the Start bar, or similar). setTitle :: String -- ^ New window title and icon name -> IO () setTitle = hSetTitle stdout -- | Use heuristics to determine whether the functions defined in this package -- will work with a given handle. -- -- If the handle is not writable (that is, it cannot manage output - see -- 'hIsWritable'), then @pure False@ is returned. -- -- For Unix-like operating systems, the current implementation checks -- that: (1) the handle is a terminal; and (2) a @TERM@ environment variable is -- not set to @dumb@ (which is what the GNU Emacs text editor sets for its -- integrated terminal). -- -- For Windows, the current implementation checks: first that (1) the handle is -- a terminal, (2) a @TERM@ environment variable is not set to @dumb@, and (3) -- the processing of \'ANSI\' control characters in output is enabled; and -- second, as an alternative, whether the handle is connected to a \'mintty\' -- terminal. (That is because the function 'hIsTerminalDevice' is used to check -- if the handle is a terminal. However, where a non-native Windows terminal -- (such as \'mintty\') is implemented using redirection, that function will not -- identify a handle to the terminal as a terminal.) If it is not already -- enabled, this function does *not* enable the processing of \'ANSI\' control -- characters in output (see 'hNowSupportsANSI'). -- -- @since 0.6.2 hSupportsANSI :: Handle -> IO Bool hSupportsANSI = Internal.hSupportsANSI -- | With one exception, equivalent to 'hSupportsANSI'. The exception is that, -- on Windows only, if a @TERM@ environment variable is not set to @dumb@ and -- the processing of \'ANSI\' control characters in output is not enabled, this -- function first tries to enable such processing. -- -- @Since 1.0.1 hNowSupportsANSI :: Handle -> IO Bool hNowSupportsANSI = Internal.hNowSupportsANSI -- | Some terminals (e.g. Emacs) are not fully ANSI compliant but can support -- ANSI colors. This can be used in such cases, if colors are all that is -- needed. -- -- @since 0.9 hSupportsANSIColor :: Handle -> IO Bool hSupportsANSIColor h = (||) <$> hSupportsANSI h <*> isEmacsTerm where isEmacsTerm = (\env -> insideEmacs env && isDumb env) <$> getEnvironment insideEmacs = any (\(k, _) -> k == "INSIDE_EMACS") isDumb env = Just "dumb" == lookup "TERM" env -- | Use heuristics to determine whether a given handle will support \'ANSI\' -- control characters in output. The function is consistent with -- 'hNowSupportsANSI'. -- -- This function is deprecated as, from version 1.0, the package no longer -- supports legacy versions of Windows that required emulation. -- -- @since 0.8.1 {-# DEPRECATED hSupportsANSIWithoutEmulation "See Haddock documentation and hNowSupportsANSI." #-} hSupportsANSIWithoutEmulation :: Handle -> IO (Maybe Bool) hSupportsANSIWithoutEmulation h = Just <$> hNowSupportsANSI h -- | Parses the characters emitted by 'reportCursorPosition' into the console -- input stream. Returns the cursor row and column as a tuple. -- -- For example, if the characters emitted by 'reportCursorPosition' are in -- 'String' @input@ then the parser could be applied like this: -- -- > let result = readP_to_S cursorPosition input -- > case result of -- > [] -> putStrLn $ "Error: could not parse " ++ show input -- > [((row, column), _)] -> putStrLn $ "The cursor was at row " ++ show row -- > ++ " and column" ++ show column ++ "." -- > (_:_) -> putStrLn $ "Error: parse not unique" -- -- @since 0.7.1 cursorPosition :: ReadP (Int, Int) cursorPosition = do void $ char '\ESC' void $ char '[' row <- decimal -- A non-negative whole decimal number void $ char ';' col <- decimal -- A non-negative whole decimal number void $ char 'R' pure (read row, read col) where digit = satisfy isDigit decimal = many1 digit -- | Attempts to get the reported cursor position data from the console input -- stream. The function is intended to be called immediately after -- 'reportCursorPosition' (or related functions) have caused characters to be -- emitted into the stream. -- -- For example, on a Unix-like operating system: -- -- > -- set no buffering (if 'no buffering' is not already set, the contents of -- > -- the buffer will be discarded, so this needs to be done before the cursor -- > -- positon is emitted) -- > hSetBuffering stdin NoBuffering -- > -- ensure that echoing is off -- > input <- bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do -- > hSetEcho stdin False -- > reportCursorPosition -- > hFlush stdout -- ensure the report cursor position code is sent to the -- > -- operating system -- > getReportedCursorPosition -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- -- @since 0.7.1 getReportedCursorPosition :: IO String getReportedCursorPosition = Internal.getReportedCursorPosition -- | Attempts to get the reported cursor position, combining the functions -- 'reportCursorPosition', 'getReportedCursorPosition' and 'cursorPosition'. Any -- position @(row, column)@ is translated to be 0-based (that is, the top-left -- corner is at @(0, 0)@), consistent with `setCursorColumn` and -- `setCursorPosition`. (Note that the information emitted into the console -- input stream by 'reportCursorPosition' is 1-based.) Returns 'Nothing' if any -- data emitted by 'reportCursorPosition', obtained by -- 'getReportedCursorPosition', cannot be parsed by 'cursorPosition'. Uses -- 'stdout'. If 'stdout' will be redirected, see 'hGetCursorPosition' for a more -- general function. -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- -- @since 0.10.3 getCursorPosition :: IO (Maybe (Int, Int)) getCursorPosition = hGetCursorPosition stdout -- | Attempts to get the reported cursor position, combining the functions -- 'hReportCursorPosition' (with the specified handle), -- 'getReportedCursorPosition' and 'cursorPosition'. Any position -- @(row, column)@ is translated to be 0-based (that is, the top-left corner is -- at @(0, 0)@), consistent with 'hSetCursorColumn' and 'hSetCursorPosition'. -- (Note that the information emitted into the console input stream by -- 'hReportCursorPosition' is 1-based.) Returns 'Nothing' if any data emitted by -- 'hReportCursorPosition', obtained by 'getReportedCursorPosition', cannot be -- parsed by 'cursorPosition'. -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- -- @since 0.10.1 hGetCursorPosition :: Handle -> IO (Maybe (Int, Int)) hGetCursorPosition h = fmap to0base <$> getCursorPosition' where to0base (row, col) = (row - 1, col - 1) getCursorPosition' = do input <- bracket (hGetBuffering stdin) (hSetBuffering stdin) $ \_ -> do -- set no buffering (if 'no buffering' is not already set, the contents of -- the buffer will be discarded, so this needs to be done before the -- cursor positon is emitted) hSetBuffering stdin NoBuffering -- ensure that echoing is off bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do hSetEcho stdin False clearStdin hReportCursorPosition h hFlush h -- ensure the report cursor position code is sent to the -- operating system getReportedCursorPosition case readP_to_S cursorPosition input of [] -> pure Nothing [((row, col),_)] -> pure $ Just (row, col) (_:_) -> pure Nothing clearStdin = do isReady <- hReady stdin when isReady $ do _ <-getChar clearStdin -- | Looking for a way to get layer colors? See 'getLayerColor'. -- -- Emit the layerColor into the console input stream, immediately after -- being recognised on the output stream, as: -- @ESC ] \ ; rgb: \ ; \ ; \ \@ -- where @\@ is @10@ for 'Foreground' and @11@ for 'Background'; @\@, -- @\@ and @\@ are the color channel values in hexadecimal (4, 8, -- 12 and 16 bit values are possible, although 16 bit values are most common); -- and @\@ is the STRING TERMINATOR (ST). ST depends on the terminal -- software and may be the @BEL@ character or @ESC \\@ characters. -- -- This function may be of limited, or no, use on Windows operating systems -- because (1) the function is not supported on native terminals and is -- emulated, but the emulation does not work on Windows Terminal and (2) of -- difficulties in obtaining the data emitted into the console input stream. -- -- @since 0.11.4 reportLayerColor :: ConsoleLayer -> IO () reportLayerColor = hReportLayerColor stdout -- @since 0.11.4 hReportLayerColor :: Handle -> ConsoleLayer -> IO () hReportLayerColor h layer = hPutStr h $ reportLayerColorCode layer -- | Attempts to get the reported layer color data from the console input -- stream. The function is intended to be called immediately after -- 'reportLayerColor' (or related functions) have caused characters to be -- emitted into the stream. -- -- For example, on a Unix-like operating system: -- -- > -- set no buffering (if 'no buffering' is not already set, the contents of -- > -- the buffer will be discarded, so this needs to be done before the cursor -- > -- positon is emitted) -- > hSetBuffering stdin NoBuffering -- > -- ensure that echoing is off -- > input <- bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do -- > hSetEcho stdin False -- > reportLayerColor Foreground -- > hFlush stdout -- ensure the report cursor position code is sent to the -- > -- operating system -- > getReportedLayerColor Foreground -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- -- @since 0.11.4 getReportedLayerColor :: ConsoleLayer -> IO String getReportedLayerColor = Internal.getReportedLayerColor -- | Attempts to get the reported layer color, combining the functions -- 'reportLayerColor', 'getReportedLayerColor' and 'layerColor'. Any RGB color -- is scaled to be 16 bits per channel, the most common format reported by -- terminal software. Returns 'Nothing' if any data emitted by -- 'reportLayerColor', obtained by 'getReportedLayerColor', cannot be parsed by -- 'layerColor'. Uses 'stdout'. If 'stdout' will be redirected, see -- 'hGetLayerColor' for a more general function. -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) This function also relies on -- emulation that does not work on Windows Terminal. -- -- @since 0.11.4 getLayerColor :: ConsoleLayer -> IO (Maybe(RGB Word16)) getLayerColor = hGetLayerColor stdout -- | Attempts to get the reported layer color, combining the functions -- 'hReportLayerColor', 'getReportedLayerColor' and 'layerColor'. Any RGB color -- is scaled to be 16 bits per channel, the most common format reported by -- terminal software. Returns 'Nothing' if any data emitted by -- 'hReportLayerColor', obtained by 'getReportedLayerColor', cannot be parsed by -- 'layerColor'. -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) This function also relies on -- emulation that does not work on Windows Terminal. -- -- @since 0.11.4 hGetLayerColor :: Handle -> ConsoleLayer -> IO (Maybe (RGB Word16)) hGetLayerColor h layer = do input <- bracket (hGetBuffering stdin) (hSetBuffering stdin) $ \_ -> do -- set no buffering (if 'no buffering' is not already set, the contents of -- the buffer will be discarded, so this needs to be done before the -- cursor positon is emitted) hSetBuffering stdin NoBuffering -- ensure that echoing is off bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do hSetEcho stdin False clearStdin hReportLayerColor h layer hFlush h -- ensure the report cursor position code is sent to the -- operating system getReportedLayerColor layer case readP_to_S (layerColor layer) input of [] -> pure Nothing [(col, _)] -> pure $ Just col (_:_) -> pure Nothing where clearStdin = do isReady <- hReady stdin when isReady $ do _ <-getChar clearStdin -- | Parses the characters emitted by 'reportLayerColor' into the console input -- stream. -- -- For example, if the characters emitted by 'reportLayerColor' are in 'String' -- @input@ then the parser could be applied like this: -- -- > let result = readP_to_S (layerColor layer) input -- > case result of -- > [] -> putStrLn $ "Error: could not parse " ++ show input -- > [(col, _)] -> putStrLn $ "The color was " ++ show col ++ "." -- > (_:_) -> putStrLn $ "Error: parse not unique" -- -- @since 0.11.4 layerColor :: ConsoleLayer -> ReadP (RGB Word16) layerColor layer = do void $ string "\ESC]" void $ string $ case layer of Foreground -> "10" Background -> "11" void $ string ";rgb:" redHex <- hexadecimal -- A non-negative whole hexadecimal number void $ char '/' greenHex <- hexadecimal -- A non-negative whole hexadecimal number void $ char '/' blueHex <- hexadecimal -- A non-negative whole hexadecimal number void $ string "\BEL" <++ string "\ESC\\" let lenRed = length redHex lenGreen = length greenHex lenBlue = length blueHex if lenRed == lenGreen && lenGreen == lenBlue then if lenRed == 0 || lenRed > 4 then fail "Color format not recognised" else let m = 16 ^ (4 - lenRed) r = fromIntegral $ m * hexToInt redHex g = fromIntegral $ m * hexToInt greenHex b = fromIntegral $ m * hexToInt blueHex in pure $ RGB r g b else fail "Color format not recognised" where hexDigit = satisfy isHexDigit hexadecimal = many1 hexDigit hexToInt hex = foldl (\d a -> d * 16 + a) 0 (map digitToInt hex) -- | Attempts to get the current terminal size (height in rows, width in -- columns). -- -- There is no \'ANSI\' control character sequence that reports the terminal -- size. So, it attempts to set the cursor position beyond the bottom right -- corner of the terminal and then use 'getCursorPosition' to query the console -- input stream. It works only on terminals that support each step and if data -- can be emitted to 'stdin'. (Use 'System.IO.hIsTerminalDevice' to test if -- 'stdin' is connected to a terminal.) Uses 'stdout'. If 'stdout' will be -- redirected, see 'System.IO.hGetTerminalSize' for a more general function. -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on Windows' Console API. (Command Prompt and -- PowerShell are based on the Console API.) -- -- For a different approach, one that does not use control character sequences -- and works when 'stdin' is redirected, see the -- package. -- -- @since 0.9 getTerminalSize :: IO (Maybe (Int, Int)) getTerminalSize = hGetTerminalSize stdout -- | Attempts to get the current terminal size (height in rows, width in -- columns), by writing control character sequences to the specified handle -- (which will typically be 'stdout' or 'stderr'). -- -- There is no \'ANSI\' control character sequence that reports the terminal -- size. So, it attempts to set the cursor position beyond the bottom right -- corner of the terminal and then use 'hGetCursorPosition' to query the console -- input stream. It works only on terminals that support each step and if data -- can be emitted to 'stdin'. (Use 'System.IO.hIsTerminalDevice' to test if -- 'stdin' is connected to a terminal.) -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- -- For a different approach, one that does not use control character sequences -- and works when 'stdin' is redirected, see the -- package. -- -- @since 0.10.1 hGetTerminalSize :: Handle -> IO (Maybe (Int, Int)) hGetTerminalSize h = do hSaveCursor h hSetCursorPosition h 9999 9999 -- Attempt to set the cursor position beyond -- the bottom right corner of the terminal. mPos <- hGetCursorPosition h hRestoreCursor h hFlush h -- ensure the restore cursor position code is sent to the -- operating system pure $ fmap (\(r, c) -> (r + 1, c + 1)) mPos -- Set the Select Graphic Rendition mode hSetSGR :: Handle -> [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. -> IO () hSetSGR h sgrs = hPutStr h $ setSGRCode sgrs -- | Set the Select Graphic Rendition mode setSGR :: [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. -> IO () setSGR = hSetSGR stdout hClearFromCursorToScreenEnd, hClearFromCursorToScreenBeginning, hClearScreen :: Handle -> IO () hClearFromCursorToScreenEnd h = hPutStr h clearFromCursorToScreenEndCode hClearFromCursorToScreenBeginning h = hPutStr h clearFromCursorToScreenBeginningCode hClearScreen h = hPutStr h clearScreenCode clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen :: IO () clearFromCursorToScreenEnd = hClearFromCursorToScreenEnd stdout clearFromCursorToScreenBeginning = hClearFromCursorToScreenBeginning stdout clearScreen = hClearScreen stdout hClearFromCursorToLineEnd, hClearFromCursorToLineBeginning, hClearLine :: Handle -> IO () hClearFromCursorToLineEnd h = hPutStr h clearFromCursorToLineEndCode hClearFromCursorToLineBeginning h = hPutStr h clearFromCursorToLineBeginningCode hClearLine h = hPutStr h clearLineCode clearFromCursorToLineEnd, clearFromCursorToLineBeginning, clearLine :: IO () clearFromCursorToLineEnd = hClearFromCursorToLineEnd stdout clearFromCursorToLineBeginning = hClearFromCursorToLineBeginning stdout clearLine = hClearLine stdout hScrollPageUp, hScrollPageDown :: Handle -> Int -- Number of lines to scroll by -> IO () hScrollPageUp h n = hPutStr h $ scrollPageUpCode n hScrollPageDown h n = hPutStr h $ scrollPageDownCode n scrollPageUp, scrollPageDown :: Int -- ^ Number of lines to scroll by -> IO () scrollPageUp = hScrollPageUp stdout scrollPageDown = hScrollPageDown stdout ansi-terminal-1.0.2/src/System/Console/ANSI/Codes.hs0000644000000000000000000002622414543633435020263 0ustar0000000000000000{-# LANGUAGE Safe #-} {-| This module exports functions that return 'String' values containing codes in accordance with the \'ANSI\' standards for control character sequences described in the documentation of module "System.Console.ANSI". -} module System.Console.ANSI.Codes ( -- * Basic data types module System.Console.ANSI.Types -- * Cursor movement by character -- -- | These functions yield @\"\"@ when the number is @0@ as, on some -- terminals, a @0@ parameter for the underlying \'ANSI\' code specifies a -- default parameter of @1@. , cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode -- * Cursor movement by line -- -- | These functions yield the equivalent of @setCursorColumnCode 0@ when -- the number is @0@ as, on some terminals, a @0@ parameter for the -- underlying \'ANSI\' code specifies a default parameter of @1@. , cursorUpLineCode, cursorDownLineCode -- * Directly changing cursor position , setCursorColumnCode, setCursorPositionCode -- * Saving, restoring and reporting cursor position , saveCursorCode, restoreCursorCode, reportCursorPositionCode -- * Clearing parts of the screen , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode , clearScreenCode, clearFromCursorToLineEndCode , clearFromCursorToLineBeginningCode, clearLineCode -- * Scrolling the screen -- -- | These functions yield @\"\"@ when the number is @0@ as, on some -- terminals, a @0@ parameter for the underlying \'ANSI\' code specifies a -- default parameter of @1@. , scrollPageUpCode, scrollPageDownCode -- * Using screen buffers , useAlternateScreenBufferCode, useNormalScreenBufferCode -- * Reporting background or foreground colors , reportLayerColorCode -- * Select Graphic Rendition mode: colors and other whizzy stuff , setSGRCode -- * Cursor visibilty changes , hideCursorCode, showCursorCode -- * Hyperlinks -- | Some, but not all, terminals support hyperlinks - that is, clickable -- text that points to a URI. , hyperlinkCode, hyperlinkWithIdCode, hyperlinkWithParamsCode -- * Changing the title , setTitleCode -- * Utilities , colorToCode, csi, osc, sgrToCode ) where import Data.Char (isPrint) import Data.List (intercalate) import Data.Colour.SRGB (toSRGB24, RGB (..)) 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[" ++ intercalate ";" (map show args) ++ code -- | 'osc' @parameterS parametersT@, where @parameterS@ specifies the type of -- operation to perform and @parametersT@ is the other parameter(s) (if any), -- returns the control sequence comprising the control function OPERATING SYSTEM -- COMMAND (OSC) followed by the parameters (separated by \';\') and ending with -- the STRING TERMINATOR (ST) @\"\\ESC\\\\\"@. -- -- @since 0.11.4 osc :: String -- ^ Ps parameter -> String -- ^ Pt parameter(s) -> String osc pS pT = "\ESC]" ++ pS ++ ";" ++ pT ++ "\ESC\\" -- | 'colorToCode' @color@ returns the 0-based index of the color (one of the -- eight colors in the ANSI 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] SetPaletteColor Foreground index -> [38, 5, fromIntegral index] SetPaletteColor Background index -> [48, 5, fromIntegral index] SetRGBColor Foreground color -> [38, 2] ++ toRGB color SetRGBColor Background color -> [48, 2] ++ toRGB color SetDefaultColor Foreground -> [39] SetDefaultColor Background -> [49] where toRGB color = let RGB r g b = toSRGB24 color in map fromIntegral [r, g, b] cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode :: Int -- ^ Number of lines or characters to move -> String cursorUpCode n = if n == 0 then "" else csi [n] "A" cursorDownCode n = if n == 0 then "" else csi [n] "B" cursorForwardCode n = if n == 0 then "" else csi [n] "C" cursorBackwardCode n = if n == 0 then "" else csi [n] "D" cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move -> String cursorDownLineCode n = if n == 0 then csi [1] "G" else csi [n] "E" cursorUpLineCode n = if n == 0 then csi [1] "G" else csi [n] "F" -- | Code to move the cursor to the specified column. The column numbering is -- 0-based (that is, the left-most column is numbered 0). setCursorColumnCode :: Int -- ^ 0-based column to move to -> String setCursorColumnCode n = csi [n + 1] "G" -- | Code to move the cursor to the specified position (row and column). The -- position is 0-based (that is, the top-left corner is at row 0 column 0). 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" -- | @since 0.7.1 saveCursorCode, restoreCursorCode :: String saveCursorCode = "\ESC7" restoreCursorCode = "\ESC8" -- | Code to emit the cursor position into the console input stream, immediately -- after being recognised on the output stream, as: -- @ESC [ \ ; \ R@ -- -- Note that the information that is emitted is 1-based (the top-left corner is -- at row 1 column 1) but 'setCursorPositionCode' is 0-based. -- -- In isolation of 'System.Console.ANSI.getReportedCursorPosition' or -- 'System.Console.ANSI.getCursorPosition', this function may be of limited use -- on Windows operating systems because of difficulties in obtaining the data -- emitted into the console input stream. -- -- @since 0.7.1 reportCursorPositionCode :: String reportCursorPositionCode = csi [] "6n" -- | Code to emit the layer color into the console input stream, immediately -- after being recognised on the output stream, as: -- @ESC ] \ ; rgb: \ ; \ ; \ \@ -- where @\@ is @10@ for 'Foreground' and @11@ for 'Background'; @\@, -- @\@ and @\@ are the color channel values in hexadecimal (4, 8, -- 12 and 16 bit values are possible, although 16 bit values are most common); -- and @\@ is the STRING TERMINATOR (ST). ST depends on the terminal -- software and may be the @BEL@ character or @ESC \\@ characters. -- -- This function may be of limited, or no, use on Windows operating systems -- because (1) the control character sequence is not supported on native -- terminals (2) of difficulties in obtaining the data emitted into the -- console input stream. See 'System.Console.ANSI.getReportedLayerColor'. -- -- @since 0.11.4 reportLayerColorCode :: ConsoleLayer -> String reportLayerColorCode Foreground = osc "10" "?" reportLayerColorCode Background = osc "11" "?" 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 = if n == 0 then "" else csi [n] "S" scrollPageDownCode n = if n == 0 then "" else csi [n] "T" useAlternateScreenBufferCode, useNormalScreenBufferCode :: String useAlternateScreenBufferCode = csi [] "?1049h" useNormalScreenBufferCode = csi [] "?1049l" 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 (concatMap sgrToCode sgrs) "m" hideCursorCode, showCursorCode :: String hideCursorCode = csi [] "?25l" showCursorCode = csi [] "?25h" -- | Code to introduce a hyperlink with (key, value) parameters. Some terminals -- support an @id@ parameter key, so that hyperlinks with the same @id@ value -- are treated as connected. -- -- @since 0.11.3 hyperlinkWithParamsCode :: [(String, String)] -- ^ Parameters -> String -- ^ URI -> String -- ^ Link text -> String hyperlinkWithParamsCode params uri link = osc "8" pT ++ link ++ osc "8" ";" where pT = params' ++ ";" ++ uri params' = intercalate ":" $ map (\(k, v) -> k ++ "=" ++ v) params -- | Code to introduce a hyperlink. -- -- @since 0.11.3 hyperlinkCode :: String -- ^ URI -> String -- ^ Link text -> String hyperlinkCode = hyperlinkWithParamsCode [] -- | Code to introduce a hyperlink with an identifier for the link. Some -- terminals support an identifier, so that hyperlinks with the same identifier -- are treated as connected. -- -- @since 0.11.3 hyperlinkWithIdCode :: String -- ^ Identifier for the link -> String -- ^ URI -> String -- ^ Link text -> String hyperlinkWithIdCode linkId = hyperlinkWithParamsCode [("id", linkId)] -- | Code to set the terminal window title and the icon name (that is, the text -- for the window in the Start bar, or similar). -- 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. This is chosen for consistent -- behaviour between Unixes and Windows. setTitleCode :: String -- ^ New window title and icon name -> String setTitleCode title = osc "0" (filter isPrint title) ansi-terminal-1.0.2/win/System/Console/ANSI/Internal.hs0000644000000000000000000001015714550533447021006 0ustar0000000000000000{-# LANGUAGE Safe #-} module System.Console.ANSI.Internal ( getReportedCursorPosition , getReportedLayerColor , hNowSupportsANSI , hSupportsANSI ) where import Control.Exception ( IOException, SomeException, catch, try ) import Data.Bits ( (.&.), (.|.) ) import Data.Maybe ( mapMaybe ) import System.Environment ( lookupEnv ) import System.IO ( Handle, hIsTerminalDevice, hIsWritable, stdin ) import System.Console.ANSI.Types ( ConsoleLayer ) -- Provided by the ansi-terminal package import System.Console.ANSI.Windows.Foreign ( INPUT_RECORD (..), INPUT_RECORD_EVENT (..), KEY_EVENT_RECORD (..) , cWcharsToChars, eNABLE_VIRTUAL_TERMINAL_PROCESSING , getConsoleMode, getNumberOfConsoleInputEvents, iNVALID_HANDLE_VALUE , nullHANDLE, readConsoleInput, setConsoleMode, unicodeAsciiChar ) import System.Console.ANSI.Windows.Win32.MinTTY ( isMinTTYHandle ) import System.Console.ANSI.Windows.Win32.Types ( DWORD, HANDLE, withHandleToHANDLE ) getReportedCursorPosition :: IO String getReportedCursorPosition = getReported getReportedLayerColor :: ConsoleLayer -> IO String getReportedLayerColor _ = getReported getReported :: IO String getReported = catch getReported' getReportedExceptionHandler where getReported' = withHandleToHANDLE stdin action where action hdl = do n <- getNumberOfConsoleInputEvents hdl if n == 0 then pure "" else do es <- readConsoleInput hdl n pure $ stringFromInputEvents es stringFromInputEvents = cWcharsToChars . wCharsFromInputEvents wCharsFromInputEvents = mapMaybe wCharFromInputEvent wCharFromInputEvent e = if isKeyEvent && isKeyDown then Just (unicodeAsciiChar $ keyEventChar keyEventRecord) else Nothing where eventType = inputEventType e eventRecord = inputEvent e isKeyEvent = eventType == 1 keyEventRecord = case eventRecord of InputKeyEvent keyEventRecord' -> keyEventRecord' _ -> error "Unexpected input event, given input event type." isKeyDown = keyEventKeyDown keyEventRecord getReportedExceptionHandler :: IOException -> IO a getReportedExceptionHandler e = error msg where msg = "Error: " ++ show e ++ "\nThis error may be avoided by using a " ++ "console based on the Windows' Console API, such as Command Prompt " ++ "or PowerShell." hSupportsANSI :: Handle -> IO Bool hSupportsANSI = hSupportsANSI' False hNowSupportsANSI :: Handle -> IO Bool hNowSupportsANSI = hSupportsANSI' True hSupportsANSI' :: Bool -> Handle -> IO Bool hSupportsANSI' tryToEnable handle = do isWritable <- hIsWritable handle if isWritable then withHandleToHANDLE handle $ withHANDLE (pure False) -- Invalid handle or no handle ( \h -> do tryMode <- try (getConsoleMode h) :: IO (Either SomeException DWORD) case tryMode of Left _ -> isMinTTYHandle h -- No ConHost mode Right mode -> do let isVTEnabled = mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0 isNotDumb = (/= Just "dumb") <$> lookupEnv "TERM" isTDNotDumb <- (&&) <$> hIsTerminalDevice handle <*> isNotDumb if isTDNotDumb && not isVTEnabled && tryToEnable then do let mode' = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING trySetMode <- try (setConsoleMode h mode') :: IO (Either SomeException ()) case trySetMode of Left _ -> pure False -- Can't enable VT processing Right () -> pure True -- VT processing enabled else pure $ isTDNotDumb && isVTEnabled ) else pure False -- | This function applies another to the Windows handle, if the handle is -- valid. If it is invalid, the specified default action is returned. withHANDLE :: IO a -> (HANDLE -> IO a) -> HANDLE -> IO a withHANDLE invalid action h = if h == iNVALID_HANDLE_VALUE || h == nullHANDLE then invalid -- Invalid handle or no handle else action h ansi-terminal-1.0.2/unix/System/Console/ANSI/Internal.hs0000644000000000000000000000603314550533447021172 0ustar0000000000000000{-# LANGUAGE Safe #-} module System.Console.ANSI.Internal ( getReportedCursorPosition , getReportedLayerColor , hSupportsANSI , hNowSupportsANSI ) where import Data.List ( uncons ) import Data.Maybe ( fromMaybe, mapMaybe ) import System.Environment ( lookupEnv ) import System.IO ( Handle, hIsTerminalDevice, hIsWritable ) import System.Timeout ( timeout ) import System.Console.ANSI.Types ( ConsoleLayer (..) ) getReportedCursorPosition :: IO String getReportedCursorPosition = getReport "\ESC[" ["R"] getReportedLayerColor :: ConsoleLayer -> IO String getReportedLayerColor layer = getReport ("\ESC]" ++ pS ++ ";rgb:") ["\BEL", "\ESC\\"] where pS = case layer of Foreground -> "10" Background -> "11" getReport :: String -> [String] -> IO String getReport _ [] = error "getReport requires a list of terminating sequences." getReport startChars endChars = do -- If, unexpectedly, no data is available on the console input stream then -- the timeout will prevent the getChar blocking. For consistency with the -- Windows equivalent, returns "" if the expected information is unavailable. fromMaybe "" <$> timeout 500000 (getStart startChars "") -- 500 milliseconds where endChars' = mapMaybe uncons endChars -- The list is built in reverse order, in order to avoid O(n^2) complexity. -- So, getReport yields the reversed built list. getStart :: String -> String -> IO String getStart "" r = getRest r getStart (h:hs) r = do c <- getChar if c == h then getStart hs (c:r) -- Try to get the rest of the start characters else pure $ reverse (c:r) -- If the first character(s) are not the -- expected start then give up. This provides -- a modicom of protection against unexpected -- data in the input stream. getRest :: String -> IO String getRest r = do c <- getChar case lookup c endChars' of Nothing -> getRest (c:r) -- Continue building the list, until the first of -- the end characters is obtained. Just es -> getEnd es (c:r) -- Try to get the rest of the end characters. getEnd :: String -> String -> IO String getEnd "" r = pure $ reverse r getEnd (e:es) r = do c <- getChar if c /= e then getRest (c:r) -- Continue building the list, with the original end -- characters. else getEnd es (c:r) -- Continue building the list, checking against the -- remaining end characters. hSupportsANSI :: Handle -> IO Bool -- Borrowed from an HSpec patch by Simon Hengel -- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd) hSupportsANSI h = (&&) <$> hIsWritable h <*> hSupportsANSI' where hSupportsANSI' = (&&) <$> hIsTerminalDevice h <*> isNotDumb isNotDumb = (/= Just "dumb") <$> lookupEnv "TERM" hNowSupportsANSI :: Handle -> IO Bool hNowSupportsANSI = hSupportsANSI ansi-terminal-1.0.2/win/System/Console/ANSI/Windows/Foreign.hs0000644000000000000000000004204614550542254022253 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} module System.Console.ANSI.Windows.Foreign ( INPUT_RECORD (..) , INPUT_RECORD_EVENT (..) , KEY_EVENT_RECORD (..) , getNumberOfConsoleInputEvents , readConsoleInput , cWcharsToChars , unicodeAsciiChar , eNABLE_VIRTUAL_TERMINAL_PROCESSING , iNVALID_HANDLE_VALUE , nullHANDLE , getConsoleMode , setConsoleMode ) where import Control.Exception ( Exception ) import Data.Char ( chr ) import Data.Typeable ( Typeable ) import Data.Word ( Word32 ) import Foreign.C.Types ( CWchar (..) ) import Foreign.Marshal.Alloc ( alloca ) import Foreign.Marshal.Array ( allocaArray, peekArray, pokeArray ) import Foreign.Ptr ( Ptr, castPtr, plusPtr, nullPtr ) import Foreign.Storable ( Storable (..) ) import System.Console.ANSI.Windows.Win32.Types ( BOOL, DWORD, ErrCode, HANDLE, LPDWORD, SHORT, UINT, UINT_PTR, ULONG , WCHAR, WORD, failIfFalse_ ) peekAndOffset :: Storable a => Ptr a -> IO (a, Ptr b) peekAndOffset ptr = do item <- peek ptr pure (item, ptr `plusPtr` sizeOf item) pokeAndOffset :: Storable a => Ptr a -> a -> IO (Ptr b) pokeAndOffset ptr item = do poke ptr item pure (ptr `plusPtr` sizeOf item) data COORD = COORD { coord_x :: SHORT , coord_y :: SHORT } deriving (Read, Eq) instance Show COORD where show (COORD x y) = "(" ++ show x ++ ", " ++ show y ++ ")" instance Storable COORD where sizeOf ~(COORD x y) = sizeOf x + sizeOf y alignment ~(COORD x _) = alignment x peek ptr = do let ptr' = castPtr ptr :: Ptr SHORT x <- peekElemOff ptr' 0 y <- peekElemOff ptr' 1 pure (COORD x y) poke ptr (COORD x y) = do let ptr' = castPtr ptr :: Ptr SHORT pokeElemOff ptr' 0 x pokeElemOff ptr' 1 y data SMALL_RECT = SMALL_RECT COORD COORD instance Show SMALL_RECT where show (SMALL_RECT tl br) = show tl ++ "-" ++ show br instance Storable SMALL_RECT where sizeOf ~(SMALL_RECT tl br) = sizeOf tl + sizeOf br alignment ~(SMALL_RECT tl _) = alignment tl peek ptr = do let ptr' = castPtr ptr :: Ptr COORD tl <- peekElemOff ptr' 0 br <- peekElemOff ptr' 1 pure (SMALL_RECT tl br) poke ptr (SMALL_RECT tl br) = do let ptr' = castPtr ptr :: Ptr COORD pokeElemOff ptr' 0 tl pokeElemOff ptr' 1 br data CONSOLE_CURSOR_INFO = CONSOLE_CURSOR_INFO { cci_cursor_size :: DWORD , cci_cursor_visible :: BOOL } deriving (Show) instance Storable CONSOLE_CURSOR_INFO where sizeOf ~(CONSOLE_CURSOR_INFO size visible) = sizeOf size + sizeOf visible alignment ~(CONSOLE_CURSOR_INFO size _) = alignment size peek ptr = do (size, ptr') <- peekAndOffset (castPtr ptr) visible <- peek ptr' pure (CONSOLE_CURSOR_INFO size visible) poke ptr (CONSOLE_CURSOR_INFO size visible) = do ptr' <- pokeAndOffset (castPtr ptr) size poke ptr' visible data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO { csbi_size :: COORD , csbi_cursor_position :: COORD , csbi_attributes :: WORD , csbi_window :: SMALL_RECT , csbi_maximum_window_size :: COORD } deriving (Show) instance Storable CONSOLE_SCREEN_BUFFER_INFO where sizeOf ~(CONSOLE_SCREEN_BUFFER_INFO size cursor_position attributes window maximum_window_size) = sizeOf size + sizeOf cursor_position + sizeOf attributes + sizeOf window + sizeOf maximum_window_size alignment ~(CONSOLE_SCREEN_BUFFER_INFO size _ _ _ _) = alignment size peek ptr = do (size, ptr1) <- peekAndOffset (castPtr ptr) (cursor_position, ptr2) <- peekAndOffset ptr1 (attributes, ptr3) <- peekAndOffset ptr2 (window, ptr4) <- peekAndOffset ptr3 maximum_window_size <- peek ptr4 pure (CONSOLE_SCREEN_BUFFER_INFO size cursor_position attributes window maximum_window_size) poke ptr (CONSOLE_SCREEN_BUFFER_INFO size cursor_position attributes window maximum_window_size) = do ptr1 <- pokeAndOffset (castPtr ptr) size ptr2 <- pokeAndOffset ptr1 cursor_position ptr3 <- pokeAndOffset ptr2 attributes ptr4 <- pokeAndOffset ptr3 window poke ptr4 maximum_window_size data CONSOLE_SCREEN_BUFFER_INFOEX = CONSOLE_SCREEN_BUFFER_INFOEX { csbix_size :: COORD , csbix_cursor_position :: COORD , csbix_attributes :: WORD , csbix_window :: SMALL_RECT , csbix_maximum_window_size :: COORD , csbix_popup_attributes :: WORD , csbix_fullscreen_supported :: BOOL , csbix_color_table :: [COLORREF] } deriving (Show) -- When specifying an explicit RGB color, the COLORREF value has the following -- hexadecimal form: -- 0x00bbggrr -- The low-order byte contains a value for the relative intensity of red; the -- second byte contains a value for green; and the third byte contains a value -- for blue. The high-order byte must be zero. The maximum value for a single -- byte is 0xFF. type COLORREF = Word32 instance Storable CONSOLE_SCREEN_BUFFER_INFOEX where sizeOf ~(CONSOLE_SCREEN_BUFFER_INFOEX size cursor_position attributes window maximum_window_size popup_attributes fullscreen_supported _) = sizeOf sizeCsbix + sizeOf size + sizeOf cursor_position + sizeOf attributes + sizeOf window + sizeOf maximum_window_size + sizeOf popup_attributes + sizeOf fullscreen_supported + 16 * sizeOf (undefined :: COLORREF) alignment ~(CONSOLE_SCREEN_BUFFER_INFOEX _ _ _ _ _ _ _ _) = alignment sizeCsbix peek ptr = do let ptr0 = castPtr ptr `plusPtr` sizeOf sizeCsbix (size, ptr1) <- peekAndOffset ptr0 (cursor_position, ptr2) <- peekAndOffset ptr1 (attributes, ptr3) <- peekAndOffset ptr2 (window, ptr4) <- peekAndOffset ptr3 (maximum_window_size, ptr5) <- peekAndOffset ptr4 (popup_attributes, ptr6) <- peekAndOffset ptr5 (fullscreen_supported, ptr7) <- peekAndOffset ptr6 color_table <- peekArray 16 ptr7 pure (CONSOLE_SCREEN_BUFFER_INFOEX size cursor_position attributes window maximum_window_size popup_attributes fullscreen_supported color_table) poke ptr (CONSOLE_SCREEN_BUFFER_INFOEX size cursor_position attributes window maximum_window_size popup_attributes fullscreen_supported color_table) = do ptr0 <- pokeAndOffset (castPtr ptr) sizeCsbix ptr1 <- pokeAndOffset ptr0 size ptr2 <- pokeAndOffset ptr1 cursor_position ptr3 <- pokeAndOffset ptr2 attributes ptr4 <- pokeAndOffset ptr3 window ptr5 <- pokeAndOffset ptr4 maximum_window_size ptr6 <- pokeAndOffset ptr5 popup_attributes ptr7 <- pokeAndOffset ptr6 fullscreen_supported pokeArray ptr7 color_table' where color_table' = take 16 $ color_table ++ repeat 0 sizeCsbix :: ULONG sizeCsbix = fromIntegral $ sizeOf (undefined :: CONSOLE_SCREEN_BUFFER_INFOEX) data CHAR_INFO = CHAR_INFO { ci_char :: WCHAR , ci_attributes :: WORD } deriving (Show) instance Storable CHAR_INFO where sizeOf ~(CHAR_INFO char attributes) = sizeOf char + sizeOf attributes alignment ~(CHAR_INFO char _) = alignment char peek ptr = do (char, ptr') <- peekAndOffset (castPtr ptr) attributes <- peek ptr' pure (CHAR_INFO char attributes) poke ptr (CHAR_INFO char attributes) = do ptr' <- pokeAndOffset (castPtr ptr) char poke ptr' attributes kEY_EVENT, mOUSE_EVENT, wINDOW_BUFFER_SIZE_EVENT, mENU_EVENT, fOCUS_EVENT :: WORD kEY_EVENT = 1 mOUSE_EVENT = 2 wINDOW_BUFFER_SIZE_EVENT = 4 mENU_EVENT = 8 fOCUS_EVENT = 16 foreign import ccall unsafe "windows.h GetNumberOfConsoleInputEvents" cGetNumberOfConsoleInputEvents :: HANDLE -> Ptr DWORD -> IO BOOL foreign import ccall unsafe "windows.h ReadConsoleInputW" cReadConsoleInput :: HANDLE -> Ptr INPUT_RECORD -> DWORD -> LPDWORD -> IO BOOL data ConsoleException = ConsoleException !ErrCode deriving (Eq, Typeable) instance Show ConsoleException where show (ConsoleException 6) = "A fatal error has occurred.\n\n" ++ "An attempt has been made to send console virtual terminal sequences\n" ++ "(ANSI codes) to an output that has not been recognised as an\n" ++ "ANSI-capable terminal and also cannot be emulated as an ANSI-enabled\n" ++ "terminal (emulation needs a ConHost-based terminal, such as Command\n" ++ "Prompt or PowerShell). That may occur, for example, if output has\n" ++ "been redirected to a file.\n\n" ++ "If that is unexpected, please post an issue at:\n" ++ "https://github.com/UnkindPartition/ansi-terminal/issues\n" show (ConsoleException errCode) = "ConsoleException " ++ show errCode instance Exception ConsoleException returnWith_ :: Storable a => (Ptr a -> IO b) -> IO a returnWith_ act = alloca $ \ptr -> act ptr >> peek ptr {- typedef union _UNICODE_ASCII_CHAR { WCHAR UnicodeChar; CHAR AsciiChar; } UNICODE_ASCII_CHAR; -} newtype UNICODE_ASCII_CHAR = UnicodeAsciiChar { unicodeAsciiChar :: WCHAR } deriving (Show, Read, Eq) instance Storable UNICODE_ASCII_CHAR where sizeOf _ = 2 alignment _ = 2 peek ptr = UnicodeAsciiChar <$> (`peekByteOff` 0) ptr poke ptr val = case val of UnicodeAsciiChar c -> (`pokeByteOff` 0) ptr c {- typedef struct _KEY_EVENT_RECORD { BOOL bKeyDown; WORD wRepeatCount; WORD wVirtualKeyCode; WORD wVirtualScanCode; union { WCHAR UnicodeChar; CHAR AsciiChar; } uChar; DWORD dwControlKeyState; } #ifdef __GNUC__ /* gcc's alignment is not what win32 expects */ PACKED #endif KEY_EVENT_RECORD; -} data KEY_EVENT_RECORD = KEY_EVENT_RECORD { keyEventKeyDown :: BOOL , keyEventRepeatCount :: WORD , keyEventVirtualKeyCode :: WORD , keyEventVirtualScanCode :: WORD , keyEventChar :: UNICODE_ASCII_CHAR , keyEventControlKeystate :: DWORD } deriving (Show, Read, Eq) instance Storable KEY_EVENT_RECORD where sizeOf _ = 16 alignment _ = 4 peek ptr = KEY_EVENT_RECORD <$> (`peekByteOff` 0) ptr <*> (`peekByteOff` 4) ptr <*> (`peekByteOff` 6) ptr <*> (`peekByteOff` 8) ptr <*> (`peekByteOff` 10) ptr <*> (`peekByteOff` 12) ptr poke ptr val = do (`pokeByteOff` 0) ptr $ keyEventKeyDown val (`pokeByteOff` 4) ptr $ keyEventRepeatCount val (`pokeByteOff` 6) ptr $ keyEventVirtualKeyCode val (`pokeByteOff` 8) ptr $ keyEventVirtualScanCode val (`pokeByteOff` 10) ptr $ keyEventChar val (`pokeByteOff` 12) ptr $ keyEventControlKeystate val {- typedef struct _MOUSE_EVENT_RECORD { COORD dwMousePosition; DWORD dwButtonState; DWORD dwControlKeyState; DWORD dwEventFlags; } MOUSE_EVENT_RECORD; -} data MOUSE_EVENT_RECORD = MOUSE_EVENT_RECORD { mousePosition :: COORD , mouseButtonState :: DWORD , mouseControlKeyState :: DWORD , mouseEventFlags :: DWORD } deriving (Show, Read, Eq) instance Storable MOUSE_EVENT_RECORD where sizeOf _ = 16 alignment _ = 4 peek ptr = MOUSE_EVENT_RECORD <$> (`peekByteOff` 0) ptr <*> (`peekByteOff` 4) ptr <*> (`peekByteOff` 8) ptr <*> (`peekByteOff` 12) ptr poke ptr val = do (`pokeByteOff` 0) ptr $ mousePosition val (`pokeByteOff` 4) ptr $ mouseButtonState val (`pokeByteOff` 8) ptr $ mouseControlKeyState val (`pokeByteOff` 12) ptr $ mouseEventFlags val {- typedef struct _WINDOW_BUFFER_SIZE_RECORD { COORD dwSize; } WINDOW_BUFFER_SIZE_RECORD; -} data WINDOW_BUFFER_SIZE_RECORD = WINDOW_BUFFER_SIZE_RECORD { bufSizeNew :: COORD } deriving (Show, Read, Eq) instance Storable WINDOW_BUFFER_SIZE_RECORD where sizeOf _ = 4 alignment _ = 4 peek ptr = WINDOW_BUFFER_SIZE_RECORD <$> (`peekByteOff` 0) ptr poke ptr val = (`pokeByteOff` 0) ptr $ bufSizeNew val {- typedef struct _MENU_EVENT_RECORD { UINT dwCommandId; } MENU_EVENT_RECORD,*PMENU_EVENT_RECORD; -} data MENU_EVENT_RECORD = MENU_EVENT_RECORD { menuCommandId :: UINT } deriving (Show, Read, Eq) instance Storable MENU_EVENT_RECORD where sizeOf _ = 4 alignment _ = 4 peek ptr = MENU_EVENT_RECORD <$> (`peekByteOff` 0) ptr poke ptr val = (`pokeByteOff` 0) ptr $ menuCommandId val {- typedef struct _FOCUS_EVENT_RECORD { BOOL bSetFocus; } FOCUS_EVENT_RECORD; -} data FOCUS_EVENT_RECORD = FOCUS_EVENT_RECORD { focusSetFocus :: BOOL } deriving (Show, Read, Eq) instance Storable FOCUS_EVENT_RECORD where sizeOf _ = 4 alignment _ = 4 peek ptr = FOCUS_EVENT_RECORD <$> (`peekByteOff` 0) ptr poke ptr val = (`pokeByteOff` 0) ptr $ focusSetFocus val data INPUT_RECORD_EVENT = InputKeyEvent KEY_EVENT_RECORD | InputMouseEvent MOUSE_EVENT_RECORD | InputWindowBufferSizeEvent WINDOW_BUFFER_SIZE_RECORD | InputMenuEvent MENU_EVENT_RECORD | InputFocusEvent FOCUS_EVENT_RECORD deriving (Show, Read, Eq) {- typedef struct _INPUT_RECORD { WORD EventType; union { KEY_EVENT_RECORD KeyEvent; MOUSE_EVENT_RECORD MouseEvent; WINDOW_BUFFER_SIZE_RECORD WindowBufferSizeEvent; MENU_EVENT_RECORD MenuEvent; FOCUS_EVENT_RECORD FocusEvent; } Event; } INPUT_RECORD,*PINPUT_RECORD; -} data INPUT_RECORD = INPUT_RECORD { inputEventType :: WORD , inputEvent :: INPUT_RECORD_EVENT } deriving (Show, Read, Eq) instance Storable INPUT_RECORD where sizeOf _ = 20 alignment _ = 4 peek ptr = do evType <- (`peekByteOff` 0) ptr event <- case evType of _ | evType == kEY_EVENT -> InputKeyEvent <$> (`peekByteOff` 4) ptr _ | evType == mOUSE_EVENT -> InputMouseEvent <$> (`peekByteOff` 4) ptr _ | evType == wINDOW_BUFFER_SIZE_EVENT -> InputWindowBufferSizeEvent <$> (`peekByteOff` 4) ptr _ | evType == mENU_EVENT -> InputMenuEvent <$> (`peekByteOff` 4) ptr _ | evType == fOCUS_EVENT -> InputFocusEvent <$> (`peekByteOff` 4) ptr _ -> error $ "peek (INPUT_RECORD): Unknown event type " ++ show evType pure $ INPUT_RECORD evType event poke ptr val = do (`pokeByteOff` 0) ptr $ inputEventType val case inputEvent val of InputKeyEvent ev -> (`pokeByteOff` 4) ptr ev InputMouseEvent ev -> (`pokeByteOff` 4) ptr ev InputWindowBufferSizeEvent ev -> (`pokeByteOff` 4) ptr ev InputMenuEvent ev -> (`pokeByteOff` 4) ptr ev InputFocusEvent ev -> (`pokeByteOff` 4) ptr ev -- The following is based on module System.Win32.Console.Extra from package -- Win32-console. getNumberOfConsoleInputEvents :: HANDLE -> IO DWORD getNumberOfConsoleInputEvents hdl = returnWith_ $ \ptrN -> failIfFalse_ "GetNumberOfConsoleInputEvents" $ cGetNumberOfConsoleInputEvents hdl ptrN -- The following is based on module System.Win32.Console.Extra from package -- Win32-console, cut down for the WCHAR version of readConsoleInput. readConsoleInput :: HANDLE -> DWORD -> IO [INPUT_RECORD] readConsoleInput hdl len = readConsoleInputWith hdl len $ \(ptr, n) -> peekArray (fromEnum n) ptr readConsoleInputWith :: HANDLE -> DWORD -> OutputHandler (Ptr INPUT_RECORD, DWORD) readConsoleInputWith hdl len handler = allocaArray (fromEnum len) $ \ptrBuf -> alloca $ \ptrN -> do failIfFalse_ "ReadConsoleInputW" $ cReadConsoleInput hdl ptrBuf len ptrN n <- peek ptrN handler (ptrBuf, n) type OutputHandler o = forall a. (o -> IO a) -> IO a -- Replicated from module Foreign.C.String in package base because that module -- does not export the function. cWcharsToChars :: [CWchar] -> [Char] cWcharsToChars = map chr . fromUTF16 . map fromIntegral where fromUTF16 (c1:c2:wcs) | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff = ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs fromUTF16 (c:wcs) = c : fromUTF16 wcs fromUTF16 [] = [] eNABLE_VIRTUAL_TERMINAL_PROCESSING :: DWORD eNABLE_VIRTUAL_TERMINAL_PROCESSING = 4 iNVALID_HANDLE_VALUE :: HANDLE iNVALID_HANDLE_VALUE = castUINTPtrToPtr maxBound nullHANDLE :: HANDLE nullHANDLE = nullPtr foreign import ccall unsafe "HsWin32.h _ansi_terminal_castUINTPtrToPtr" castUINTPtrToPtr :: UINT_PTR -> Ptr a foreign import ccall unsafe "windows.h GetConsoleMode" c_GetConsoleMode :: HANDLE -> LPDWORD -> IO BOOL foreign import ccall unsafe "windows.h SetConsoleMode" c_SetConsoleMode :: HANDLE -> DWORD -> IO BOOL getConsoleMode :: HANDLE -> IO DWORD getConsoleMode h = alloca $ \ptr -> do failIfFalse_ "GetConsoleMode" $ c_GetConsoleMode h ptr peek ptr setConsoleMode :: HANDLE -> DWORD -> IO () setConsoleMode h mode = failIfFalse_ "SetConsoleMode" $ c_SetConsoleMode h mode ansi-terminal-1.0.2/win/System/Console/ANSI/Windows/Win32/Types.hs0000644000000000000000000001435514550542320022664 0ustar0000000000000000{-# LANGUAGE Safe #-} {-| This module is based on the corresponding code in the Win32 package, in order to avoid a dependency on that package. Some of that code had its origins in earlier versions of this package. -} module System.Console.ANSI.Windows.Win32.Types ( Addr , BOOL , DWORD , ErrCode , FileType , HANDLE , HMODULE , LPCSTR , LPCTSTR , LPDWORD , LPTSTR , SHORT , TCHAR , UINT , UINT_PTR , ULONG , USHORT , WCHAR , WORD , failIfFalse_ , failIfNeg , failIfNull , withHandleToHANDLE ) where import Control.Concurrent.MVar ( readMVar ) import Control.Exception ( bracket, throwIO ) import Control.Monad ( when ) import Data.Char ( isSpace ) import Data.Typeable ( cast ) import Data.Word ( Word16, Word32 ) import Foreign.C.Error ( Errno (..), errnoToIOError ) import Foreign.C.String ( peekCWString ) import Foreign.C.Types ( CChar, CInt (..), CShort (..), CWchar ) import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.StablePtr ( StablePtr, freeStablePtr, newStablePtr ) import GHC.IO.Handle.Types ( Handle (..), Handle__ (..) ) import GHC.IO.FD ( FD(..) ) -- A wrapper around an Int32 import Numeric ( showHex ) import System.IO.Error ( ioeSetErrorString ) #if defined(__IO_MANAGER_WINIO__) import GHC.IO.Exception ( IOErrorType (InappropriateType), IOException (IOError), ioException ) import GHC.IO.SubSystem ( () ) import GHC.IO.Windows.Handle ( ConsoleHandle, Io, NativeHandle, toHANDLE ) #endif type Addr = Ptr () type BOOL = Bool type DWORD = Word32 type ErrCode = DWORD type FileType = DWORD type HANDLE = Ptr () type HMODULE = Ptr () type LPCSTR = LPSTR type LPCTSTR = LPTSTR type LPDWORD = Ptr DWORD type LPSTR = Ptr CChar type LPTSTR = Ptr TCHAR type LPWSTR = Ptr CWchar type SHORT = CShort type TCHAR = CWchar type UINT = Word32 type UINT_PTR = Word type ULONG = Word32 type USHORT = Word16 type WCHAR = CWchar type WORD = Word16 withStablePtr :: a -> (StablePtr a -> IO b) -> IO b withStablePtr value = bracket (newStablePtr value) freeStablePtr #if defined(__IO_MANAGER_WINIO__) withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a withHandleToHANDLE = withHandleToHANDLEPosix withHandleToHANDLENative withHandleToHANDLENative :: Handle -> (HANDLE -> IO a) -> IO a withHandleToHANDLENative haskell_handle action = withStablePtr haskell_handle $ const $ do let write_handle_mvar = case haskell_handle of FileHandle _ handle_mvar -> handle_mvar DuplexHandle _ _ handle_mvar -> handle_mvar windows_handle <- readMVar write_handle_mvar >>= handle_ToHANDLE action windows_handle where handle_ToHANDLE :: Handle__ -> IO HANDLE handle_ToHANDLE (Handle__{haDevice = dev}) = case ( cast dev :: Maybe (Io NativeHandle) , cast dev :: Maybe (Io ConsoleHandle)) of (Just hwnd, Nothing) -> pure $ toHANDLE hwnd (Nothing, Just hwnd) -> pure $ toHANDLE hwnd _ -> throwErr "not a known HANDLE" throwErr msg = ioException $ IOError (Just haskell_handle) InappropriateType "withHandleToHANDLENative" msg Nothing Nothing #else withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a withHandleToHANDLE = withHandleToHANDLEPosix #endif withHandleToHANDLEPosix :: Handle -> (HANDLE -> IO a) -> IO a withHandleToHANDLEPosix 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). withStablePtr haskell_handle $ const $ do -- Grab the write handle variable from the Handle 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 Just fd <- (\(Handle__ { haDevice = dev }) -> fmap fdFD (cast dev)) <$> readMVar write_handle_mvar -- Finally, turn that (C-land) FD into a HANDLE using msvcrt windows_handle <- c_get_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! foreign import ccall unsafe "_get_osfhandle" c_get_osfhandle :: CInt -> IO HANDLE failIfNeg :: (Num a, Ord a) => String -> IO a -> IO a failIfNeg = failIf (< 0) failIfNull :: String -> IO (Ptr a) -> IO (Ptr a) failIfNull = failIf (== nullPtr) failIf :: (a -> Bool) -> String -> IO a -> IO a failIf p wh act = do v <- act if p v then errorWin wh else return v failIfFalse_ :: String -> IO Bool -> IO () failIfFalse_ = failIf_ not failIf_ :: (a -> Bool) -> String -> IO a -> IO () failIf_ p wh act = do v <- act when (p v) $ errorWin wh errorWin :: String -> IO a errorWin fn_name = do err_code <- getLastError failWith fn_name err_code failWith :: String -> ErrCode -> IO a failWith fn_name err_code = do c_msg <- getErrorMessage err_code msg <- if c_msg == nullPtr then return $ "Error 0x" ++ Numeric.showHex err_code "" else do msg <- peekTString c_msg -- We ignore failure of freeing c_msg, given we're already failing _ <- localFree c_msg return msg -- turn GetLastError() into errno, which errnoToIOError knows how to convert -- to an IOException we can throw. errno <- c_maperrno_func err_code let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n ioerror = errnoToIOError fn_name errno Nothing Nothing `ioeSetErrorString` msg' throwIO ioerror peekTString :: LPCTSTR -> IO String peekTString = peekCWString foreign import ccall unsafe "maperrno_func" -- in base/cbits/Win32Utils.c c_maperrno_func :: ErrCode -> IO Errno foreign import ccall unsafe "errors.h _ansi_terminal_getErrorMessage" getErrorMessage :: DWORD -> IO LPWSTR foreign import ccall unsafe "windows.h GetLastError" getLastError :: IO ErrCode foreign import ccall unsafe "windows.h LocalFree" localFree :: Ptr a -> IO (Ptr a) ansi-terminal-1.0.2/win/System/Console/ANSI/Windows/Win32/MinTTY.hsc0000644000000000000000000002217014427707227023055 0ustar0000000000000000{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-| This module is based on the corresponding code in the mintty package and the Win32 package, in order to avoid a dependency on those packages. -} module System.Console.ANSI.Windows.Win32.MinTTY ( isMinTTYHandle ) where import Control.Exception ( catch ) import Data.Int ( Int32 ) import Data.List ( isInfixOf ) import Data.Word ( Word8 ) import Foreign.C.String ( peekCWStringLen, withCAString, withCWString, withCWStringLen ) import Foreign.C.Types ( CInt (..) ) import Foreign.Marshal.Alloc ( alloca, allocaBytes ) import Foreign.Marshal.Array ( advancePtr, copyArray ) import Foreign.Marshal.Utils ( maybeWith ) import Foreign.Ptr ( FunPtr, Ptr, castPtr, castPtrToFunPtr, plusPtr ) import Foreign.Storable ( Storable (..) ) -- Provided by the ansi-terminal package import System.Console.ANSI.Windows.Win32.Types ( Addr, BOOL, DWORD, FileType, HANDLE, HMODULE, LPCSTR, LPCTSTR, LPTSTR , TCHAR, ULONG, USHORT, failIfFalse_, failIfNeg, failIfNull ) -- The headers that are shipped with GHC's copy of MinGW-w64 assume Windows XP. -- Since we need some structs that are only available with Vista or later, -- we must manually set WINVER/_WIN32_WINNT accordingly. #undef WINVER #define WINVER 0x0600 #undef _WIN32_WINNT #define _WIN32_WINNT 0x0600 #include #include "winternl_compat.h" #if __GLASGOW_HASKELL__ < 800 #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) #endif type F_NtQueryObject = HANDLE -> CInt -> Ptr OBJECT_NAME_INFORMATION -> ULONG -> Ptr ULONG -> IO NTSTATUS type F_GetFileInformationByHandleEx = HANDLE -> CInt -> Ptr FILE_NAME_INFO -> DWORD -> IO BOOL type NTSTATUS = #type NTSTATUS data FILE_NAME_INFO = FILE_NAME_INFO { fniFileNameLength :: DWORD , fniFileName :: String } instance Storable FILE_NAME_INFO where sizeOf _ = #size FILE_NAME_INFO alignment _ = #alignment FILE_NAME_INFO poke buf fni = withTStringLen (fniFileName fni) $ \(str, len) -> do let len' = (min mAX_PATH len) * sizeOfTCHAR start = advancePtr (castPtr buf) (#offset FILE_NAME_INFO, FileName) end = advancePtr start len' (#poke FILE_NAME_INFO, FileNameLength) buf len' copyArray start (castPtr str :: Ptr Word8) len' poke (castPtr end) (0 :: TCHAR) peek buf = do vfniFileNameLength <- (#peek FILE_NAME_INFO, FileNameLength) buf let len = fromIntegral vfniFileNameLength `div` sizeOfTCHAR vfniFileName <- peekTStringLen (plusPtr buf (#offset FILE_NAME_INFO, FileName), len) pure $ FILE_NAME_INFO { fniFileNameLength = vfniFileNameLength , fniFileName = vfniFileName } newtype OBJECT_NAME_INFORMATION = OBJECT_NAME_INFORMATION { oniName :: UNICODE_STRING } instance Storable OBJECT_NAME_INFORMATION where sizeOf _ = #size OBJECT_NAME_INFORMATION alignment _ = #alignment OBJECT_NAME_INFORMATION poke buf oni = (#poke OBJECT_NAME_INFORMATION, Name) buf (oniName oni) peek buf = fmap OBJECT_NAME_INFORMATION $ (#peek OBJECT_NAME_INFORMATION, Name) buf data UNICODE_STRING = UNICODE_STRING { usLength :: USHORT , usMaximumLength :: USHORT , usBuffer :: String } instance Storable UNICODE_STRING where sizeOf _ = #size UNICODE_STRING alignment _ = #alignment UNICODE_STRING poke buf us = withTStringLen (usBuffer us) $ \(str, len) -> do let len' = (min mAX_PATH len) * sizeOfTCHAR start = advancePtr (castPtr buf) (#size UNICODE_STRING) end = advancePtr start len' (#poke UNICODE_STRING, Length) buf len' (#poke UNICODE_STRING, MaximumLength) buf (len' + sizeOfTCHAR) (#poke UNICODE_STRING, Buffer) buf start copyArray start (castPtr str :: Ptr Word8) len' poke (castPtr end) (0 :: TCHAR) peek buf = do vusLength <- (#peek UNICODE_STRING, Length) buf vusMaximumLength <- (#peek UNICODE_STRING, MaximumLength) buf vusBufferPtr <- (#peek UNICODE_STRING, Buffer) buf let len = fromIntegral vusLength `div` sizeOfTCHAR vusBuffer <- peekTStringLen (vusBufferPtr, len) pure $ UNICODE_STRING { usLength = vusLength , usMaximumLength = vusMaximumLength , usBuffer = vusBuffer } -- | Returns 'True' is the given handle is attached to a MinTTY console -- (e.g., Cygwin or MSYS). Returns 'False' otherwise. isMinTTYHandle :: HANDLE -> IO Bool isMinTTYHandle h = do fileType <- getFileType h if fileType /= fILE_TYPE_PIPE then pure False else isMinTTYVista h `catch` \(_ :: IOError) -> isMinTTYCompat h -- GetFileNameByHandleEx is only available on Vista and later (hence -- the name isMinTTYVista). If we're on an older version of Windows, -- getProcAddress will throw an IOException when it fails to find -- GetFileNameByHandleEx, and thus we will default to using -- NtQueryObject (isMinTTYCompat). isMinTTYVista :: HANDLE -> IO Bool isMinTTYVista h = do fn <- getFileNameByHandle h pure $ cygwinMSYSCheck fn `catch` \(_ :: IOError) -> pure False cygwinMSYSCheck :: String -> Bool cygwinMSYSCheck fn = ("cygwin-" `isInfixOf` fn || "msys-" `isInfixOf` fn) && "-pty" `isInfixOf` fn -- Note that GetFileInformationByHandleEx might return a filepath like: -- -- \msys-dd50a72ab4668b33-pty1-to-master -- -- But NtQueryObject might return something like: -- -- \Device\NamedPipe\msys-dd50a72ab4668b33-pty1-to-master -- -- This means we can't rely on "\cygwin-" or "\msys-" being at the very start -- of the filepath. As a result, we use `isPrefixOf` to check for "cygwin" and -- "msys". -- -- It's unclear if "-master" will always appear in the filepath name. Recent -- versions of MinTTY have been known to give filepaths like this (#186): -- -- \msys-dd50a72ab4668b33-pty0-to-master-nat -- -- Just in case MinTTY ever changes this convention, we don't bother checking -- for the presence of "-master" in the filepath name at all. isMinTTYCompat :: HANDLE -> IO Bool isMinTTYCompat h = do fn <- ntQueryObjectNameInformation h pure $ cygwinMSYSCheck fn `catch` \(_ :: IOError) -> pure False fILE_TYPE_PIPE :: FileType fILE_TYPE_PIPE = 3 ntQueryObjectNameInformation :: HANDLE -> IO String ntQueryObjectNameInformation h = do let sizeOfONI = sizeOf (undefined :: OBJECT_NAME_INFORMATION) bufSize = sizeOfONI + mAX_PATH * sizeOfTCHAR allocaBytes bufSize $ \buf -> alloca $ \p_len -> do hwnd <- getModuleHandle (Just "ntdll.exe") addr <- getProcAddress hwnd "NtQueryObject" let c_NtQueryObject = mk_NtQueryObject (castPtrToFunPtr addr) _ <- failIfNeg "NtQueryObject" $ c_NtQueryObject h objectNameInformation buf (fromIntegral bufSize) p_len oni <- peek buf pure $ usBuffer $ oniName oni sizeOfTCHAR :: Int sizeOfTCHAR = sizeOf (undefined :: TCHAR) getFileNameByHandle :: HANDLE -> IO String getFileNameByHandle h = do let sizeOfDWORD = sizeOf (undefined :: DWORD) -- note: implicitly assuming that DWORD has stronger alignment than wchar_t bufSize = sizeOfDWORD + mAX_PATH * sizeOfTCHAR allocaBytes bufSize $ \buf -> do getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize) fni <- peek buf pure $ fniFileName fni getFileInformationByHandleEx :: HANDLE -> CInt -> Ptr FILE_NAME_INFO -> DWORD -> IO () getFileInformationByHandleEx h cls buf bufSize = do lib <- getModuleHandle (Just "kernel32.dll") ptr <- getProcAddress lib "GetFileInformationByHandleEx" let c_GetFileInformationByHandleEx = mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr) failIfFalse_ "getFileInformationByHandleEx" (c_GetFileInformationByHandleEx h cls buf bufSize) getModuleHandle :: Maybe String -> IO HMODULE getModuleHandle mb_name = maybeWith withTString mb_name $ \ c_name -> failIfNull "GetModuleHandle" $ c_GetModuleHandle c_name getProcAddress :: HMODULE -> String -> IO Addr getProcAddress hmod procname = withCAString procname $ \ c_procname -> failIfNull "GetProcAddress" $ c_GetProcAddress hmod c_procname peekTStringLen :: (LPCTSTR, Int) -> IO String peekTStringLen = peekCWStringLen withTString :: String -> (LPTSTR -> IO a) -> IO a withTString = withCWString withTStringLen :: String -> ((LPTSTR, Int) -> IO a) -> IO a withTStringLen = withCWStringLen fileNameInfo :: CInt fileNameInfo = #const FileNameInfo mAX_PATH :: Num a => a mAX_PATH = #const MAX_PATH objectNameInformation :: CInt objectNameInformation = #const ObjectNameInformation foreign import ccall "dynamic" mk_GetFileInformationByHandleEx :: FunPtr F_GetFileInformationByHandleEx -> F_GetFileInformationByHandleEx foreign import ccall unsafe "windows.h GetFileType" getFileType :: HANDLE -> IO FileType foreign import ccall unsafe "windows.h GetProcAddress" c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr foreign import ccall "dynamic" mk_NtQueryObject :: FunPtr F_NtQueryObject -> F_NtQueryObject foreign import ccall unsafe "windows.h GetModuleHandleW" c_GetModuleHandle :: LPCTSTR -> IO HMODULE ansi-terminal-1.0.2/win/c-source/errors.c0000644000000000000000000000223014427707230016443 0ustar0000000000000000#define UNICODE #include #include #include #include "errors.h" /* Copied from the Win32-2.13.4.0 package, but renamed `getErrorMessage` to * `_ansi_terminal_getErrorMessage`, in order to avoid problems with duplicate * symbols in GHC's object files. See: * https://gitlab.haskell.org/ghc/ghc/-/issues/23365. */ /* There's two ways we can generate error messages - with different tradeoffs: * If we do a function call, we have to use a static buffer. * If we use a macro and ANSI C's string splicing, we have to use constant * strings - and accept a certain amount of overhead from inserting the * boilerplate text. * * Why the concern about performance? Error messages are only generated * in exceptional situations -- sof 9/98 * * sof 9/98 : Removed use of non-standard (and wimpy :-) snprintf(). */ LPTSTR _ansi_terminal_getErrorMessage(DWORD err) { LPTSTR what; FormatMessage( (FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER) , NULL, err, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), /* Default language */ (LPTSTR) &what, 0, NULL ); return what; } ansi-terminal-1.0.2/win/c-source/HsWin32.c0000644000000000000000000000017114550533447016332 0ustar0000000000000000// Out-of-line versions of all the inline functions from HsWin32.h #define INLINE /* nothing */ #include "HsWin32.h" ansi-terminal-1.0.2/app/Example.hs0000644000000000000000000002774114550533447015177 0ustar0000000000000000module Main ( main ) where import Control.Concurrent (threadDelay) import Control.Monad (forM_, replicateM_) import System.IO (hFlush, stdout) import Text.Printf(printf) import Data.Colour.SRGB (sRGB24) import System.Console.ANSI examples :: [IO ()] examples = [ cursorMovementExample , lineChangeExample , setCursorPositionExample , saveRestoreCursorExample , clearExample , scrollExample , screenBuffersExample , sgrColorExample , sgrOtherExample , cursorVisibilityExample , hyperlinkExample , titleExample , getCursorPositionExample , getTerminalSizeExample , getLayerColorExample ] main :: IO () main = do stdoutSupportsANSI <- hNowSupportsANSI stdout if stdoutSupportsANSI then mapM_ (resetScreen >>) examples else putStrLn "Standard output does not support 'ANSI' escape codes." -- 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 = setSGR [Reset] >> clearScreen >> setCursorPosition 0 0 pause :: IO () pause = do hFlush stdout -- 1 second pause threadDelay 1000000 cursorMovementExample :: IO () cursorMovementExample = do putStrLn "Line One" putStr "Line Two" pause -- Line One -- Line Two cursorUp 1 putStr " - Extras" pause -- Line One - Extras -- Line Two cursorBackward 2 putStr "zz" pause -- Line One - Extrzz -- Line Two cursorForward 2 putStr "- And More" pause -- Line One - Extrzz - And More -- Line Two cursorDown 1 putStr "Disconnected" pause -- Line One - Extrzz - And More -- Line Two Disconnected lineChangeExample :: IO () lineChangeExample = do putStrLn "Line One" putStr "Line Two" pause -- Line One -- Line Two cursorUpLine 1 putStr "New Line One" pause -- New Line One -- Line Two cursorDownLine 1 putStr "New Line Two" pause -- New Line One -- New Line Two setCursorPositionExample :: IO () setCursorPositionExample = do putStrLn "Line One" putStrLn "Line Two" pause -- Line One -- Line Two setCursorPosition 0 5 putStr "Foo" pause -- Line Foo -- Line Two setCursorPosition 1 5 putStr "Bar" pause -- Line Foo -- Line Bar setCursorColumn 1 putStr "oaf" pause -- Line Foo -- Loaf Bar saveRestoreCursorExample :: IO () saveRestoreCursorExample = do putStr "Start sentence ..." pause -- Start sentence ... saveCursor setCursorPosition 2 3 putStr "SPLASH!" pause -- Start sentence ... -- -- SPLASH! restoreCursor putStr " end sentence, uninterrupted." pause -- Start sentence ... end sentence, uninterrupted -- -- SPLASH! clearExample :: IO () clearExample = do putStrLn "Line One" putStrLn "Line Two" pause -- Line One -- Line Two setCursorPosition 0 4 clearFromCursorToScreenEnd pause -- Line resetScreen putStrLn "Line One" putStrLn "Line Two" pause -- Line One -- Line Two setCursorPosition 1 4 clearFromCursorToScreenBeginning pause -- -- Two resetScreen putStrLn "Line One" putStrLn "Line Two" pause -- Line One -- Line Two setCursorPosition 0 4 clearFromCursorToLineEnd pause -- Line -- Line Two setCursorPosition 1 4 clearFromCursorToLineBeginning pause -- Line -- Two clearLine pause -- Line clearScreen pause -- scrollExample :: IO () scrollExample = do putStrLn "Line One" putStrLn "Line Two" putStrLn "Line Three" pause -- Line One -- Line Two -- Line Three scrollPageDown 2 pause -- -- -- Line One -- Line Two -- Line Three scrollPageUp 3 pause -- Line Two -- Line Three screenBuffersExample :: IO () screenBuffersExample = do replicateM_ 5 $ putStrLn "This message is on the Normal Screen Bufffer" replicateM_ 5 pause useAlternateScreenBuffer replicateM_ 5 $ putStrLn "This message is on the Alternate Screen Bufffer" replicateM_ 5 pause useNormalScreenBuffer replicateM_ 5 $ putStrLn "This message is continuing where we left off" replicateM_ 5 pause sgrColorExample :: IO () sgrColorExample = do let colors = enumFromTo minBound maxBound :: [Color] forM_ [Foreground, Background] $ \layer -> do forM_ [Dull, Vivid] $ \intensity -> do resetScreen forM_ colors $ \color -> do setSGR [Reset] setSGR [SetColor layer intensity color] print color pause -- The ANSI eight standard colors, 4 times in sequence (two layers and two -- intensities) resetScreen putStrLn "True color (24 bit color depth)" putStrLn "-------------------------------" putStrLn "" setSGR [SetRGBColor Foreground $ sRGB24 0 0 0] forM_ [0 .. 23] $ \row -> do forM_ [0 .. 47] $ \col -> do let r = row * 11 g = 255 - r b = col * 5 setSGR [SetRGBColor Background $ sRGB24 r g b] putStr "-" putStrLn "" replicateM_ 5 pause -- True colors, a swatch of 24 rows and 48 columns resetScreen putStrLn "A 256-color palette" putStrLn "-------------------" putStrLn "" -- First 16 colors ('system' colors in xterm protocol), in a row -- -- 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 A A B B C C D D E E F F forM_ [Dull .. Vivid] $ \intensity -> do forM_ [Black .. White] $ \color -> do let i = fromEnum intensity * 8 + fromEnum color eol = i == 15 setSGR [SetPaletteColor Background $ xtermSystem intensity color] setSGR [SetPaletteColor Foreground $ xtermSystem Dull Black] printf "%X " i setSGR [SetPaletteColor Foreground $ xtermSystem Vivid White] printf "%X" i if eol then putStrLn "" else do setSGR [Reset] putStr " " putStrLn "" -- Next 216 colors (6 level RGB in xterm protocol), in 12 rows of 18 -- -- 000 001 002 003 004 005 010 011 012 013 014 015 020 021 022 023 024 025 -- 030 031 032 033 034 035 040 041 042 043 044 045 050 051 052 053 054 055 -- 100 101 102 103 104 105 110 111 112 113 114 115 120 121 122 123 124 125 -- ... and so on ... forM_ [0 .. 5] $ \r -> do forM_ [0 .. 5] $ \g -> do forM_ [0 .. 5] $ \b -> do let i = 16 + b + g * 6 + r * 36 eol = i `mod` 18 == 15 r' = (r + 3) `mod` 6 g' = (g + 3) `mod` 6 b' = (b + 3) `mod` 6 setSGR [SetPaletteColor Foreground $ xterm6LevelRGB r' g' b'] setSGR [SetPaletteColor Background $ xterm6LevelRGB r g b] putStr $ show r ++ show g ++ show b if eol then putStrLn "" else do setSGR [Reset] putStr " " putStrLn "" -- Final 24 colors (24 levels of gray in xterm protocol), in two rows -- -- 0 1 2 3 4 5 6 7 8 9 10 11 -- 12 13 14 15 16 17 18 19 20 21 22 23 forM_ [0 .. 23] $ \y -> do setSGR [SetPaletteColor Foreground $ xterm24LevelGray $ (y + 12) `mod` 24] setSGR [SetPaletteColor Background $ xterm24LevelGray y] printf "%3d" y if y == 11 then putStrLn "" else do setSGR [Reset] putStr " " replicateM_ 5 pause sgrOtherExample :: IO () sgrOtherExample = do let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold") , (SetConsoleIntensity FaintIntensity, "Faint") , (SetConsoleIntensity NormalIntensity, "Normal") , (SetItalicized True, "Italic") , (SetItalicized False, "No Italics") , (SetUnderlining SingleUnderline, "Single Underline") , (SetUnderlining DoubleUnderline, "Double Underline") , (SetUnderlining NoUnderline, "No Underline") , (SetBlinkSpeed SlowBlink, "Slow Blink") , (SetBlinkSpeed RapidBlink, "Rapid Blink") , (SetBlinkSpeed NoBlink, "No Blink") , (SetVisible False, "Conceal") , (SetVisible True, "Reveal") ] forM_ named_styles $ \(style, name) -> do resetScreen setSGR [style] putStrLn name pause -- Text describing a style displayed in that style in sequence setSGR [SetColor Foreground Vivid Red] setSGR [SetColor Background Vivid Blue] clearScreen >> setCursorPosition 0 0 setSGR [SetSwapForegroundBackground False] putStr "Red-On-Blue" pause -- Red-On-Blue clearScreen >> setCursorPosition 0 0 setSGR [SetSwapForegroundBackground True] putStr "Blue-On-Red" pause -- Blue-On-Red cursorVisibilityExample :: IO () cursorVisibilityExample = do putStr "Cursor Demo" pause -- Cursor Demo| hideCursor pause -- Cursor Demo showCursor pause -- Cursor Demo| hyperlinkExample :: IO () hyperlinkExample = do putStr "Hyperlink demo: " hyperlink "https://example.com" "Example hyperlink\n" putStrLn "" putStrLn "Linked hyperlinks demo:" hyperlinkWithId "ref" "https://example.com" "Example linked hyperlink one\n" hyperlinkWithId "ref" "https://example.com" "Example linked hyperlink two\n" replicateM_ 5 pause -- Hyperlink demo: Example hyperlink -- -- Linked hyperlinks demo: -- Example linked hyperlink one -- Example linked hyperlink two titleExample :: IO () titleExample = do putStr "Title Demo" pause -- ~/foo/ - ansi-terminal-ex - 83x70 ------------------------------------ -- Title Demo setTitle "Yup, I'm a new title!" pause -- Yup, I'm a new title! - ansi-terminal-ex - 83x70 --------------------------------------------------- -- Title Demo getCursorPositionExample :: IO () getCursorPositionExample = do putStrLn " 11111111112222222222" putStrLn "12345678901234567890123456789" putStr "Report cursor position here:" pause -- 11111111112222222222 -- 12345678901234567890123456789 -- Report cursor position here:| result <- getCursorPosition putStrLn " (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.\n" case result of Just (row, col) -> putStrLn $ "The cursor was at row number " ++ show (row + 1) ++ " and column number " ++ show (col + 1) ++ ".\n" Nothing -> putStrLn "Error: unable to get the cursor position\n" replicateM_ 3 pause -- 11111111112222222222 -- 12345678901234567890123456789 -- Report cursor position here: (3rd row, 29th column) to stdin, as CSI 3 ; 29 R. -- -- The cursor was at row number 3 and column number 29. getTerminalSizeExample :: IO () getTerminalSizeExample = do result <- getTerminalSize case result of Just (h, w) -> putStrLn $ "The size of the terminal is " ++ show h ++ " rows by " ++ show w ++ " columns.\n" Nothing -> putStrLn "Error: unable to get the terminal size\n" pause -- The size of the terminal is 25 rows by 80 columns. getLayerColorExample :: IO () getLayerColorExample = do fgResult <- getLayerColor Foreground case fgResult of Just fgCol -> putStrLn $ "The reported foreground color is:\n" ++ show fgCol ++ "\n" Nothing -> putStrLn "Error: unable to get the foreground color\n" bgResult <- getLayerColor Background case bgResult of Just bgCol -> putStrLn $ "The reported background color is:\n" ++ show bgCol ++ "\n" Nothing -> putStrLn "Error: unable to get the background color\n" ansi-terminal-1.0.2/CHANGELOG.md0000644000000000000000000002022514550543447014270 0ustar0000000000000000Changes ======= Version 1.0.2 ------------- * On Windows, fix linker error about a duplicate symbol `castUINTPtrToPtr`. Version 1.0.1 ------------- * On Windows, the processing of \'ANSI\' control characters in output is enabled by default in Windows Terminal but is not enabled by default in ConHost terminals. Additions have been made to allow support of users of ConHost terminals. * Add `hNowSupportsANSI`. On Unix, the function is equivalent to `hSupportsANSI`. On Windows, in Windows Terminal and ConHost terminals, the action can try to enable the processing of \'ANSI\' control characters in output. * In Windows Terminal and ConHost terminals, `hSupportsANSI` will yield `False` if the the processing of \'ANSI\' control characters in output is not enabled. * Deprecated `hSupportsANSIWithoutEmulation` is now consistent with `hNowSupportsANSI`. * Improvements to Haddock documentation. Version 1.0 ----------- * On Windows, drop support for legacy Windows requiring emulation. The package assumes Windows Terminal has replaced ConHost terminals on supported versions of Windows. Functions that yield actions no longer enable (re-enable) the processing of \'ANSI\' control characters in output. * On Windows, the package no longer depends (directly or indirectly) on the `Win32`, `array`,`containers`, `deepseq`, `filepath`, `ghc-boot-th`, `mintty`, `pretty` or `template-haskell` packages. * `hSupportsANSI` no longer assumes that the given handle is writeable. * `hSupportsANSIWithoutEmulation` is deprecated. Version 0.11.5 -------------- * Module `System.Console.ANSI.Types` spun out to new dependency package `ansi-terminal-types-0.11.5`. * Drop support for GHC versions before GHC 7.10.1 (released March 2015). * Improvements to Haddock documentation. Version 0.11.4 -------------- * Add `reportLayerColor`, `getReportedLayerColor` and `getLayerColor` for querying the layer color on terminals that support the functionality. * Add `useAlternateScreenBuffer` and `useNormalScreenBuffer`, and support for switching between the Alternate and Normal Screen Buffers. * When the argument is `0`, `cursorUpCode`, `cursorDownCode`, `cursorForwardCode`, `cursorBackwardCode`,`scrollPageUpCode` and `scrollPageDownCode` now yield `""`, and `cursorUpLineCode` and `cursorDownLineCode` now yield the equivalent of `setCursorColumnCode 0`. This is because, on some terminals, a `0` parameter for the underlying 'ANSI' code specifies a default parameter of `1`. * Add `osc` as a utility function, for OSC sequences. * `setTitle` now uses the recommended STRING TERMINATOR (ST) of `\ESC\\`, rather than the legacy `\BEL` (`\007`), and filters the title of all non-printable characters, not just `\BEL`. * Improvements to Haddock documentation. Version 0.11.3 -------------- * Add `hyperlink`, `hyperlinkWithId` and `hyperlinkWithParams`, and support for clickable hyperlinks. Version 0.11.2 -------------- * On Windows, fix compatability with the Windows I/O Manager (WinIO) when GHC >= 9.0.1 but `Win32` < 2.9.0.0. * Improvements to Haddock documentation. Version 0.11.1 -------------- * On Windows, fix compatability with the Windows I/O Manager (WinIO) introduced in GHC 9.0.1, by incorporating changes made in package `Win32-2.13.2.0` in that regard. * Improvements to Haddock documentation. Version 0.11 ------------ * Remove deprecated `getCursorPosition0`. (Use `getCursorPosition` instead.) * On Unix-like operating systems, the temporary turning off of echoing is moved from `getReportedCursorPosition` to `hGetCursorPositon`. * On Unix-like operating systems, fix a bug in `getCursorPosition` and `hGetCursorPosition`, where the console input stream was was not always clear before the cursor position was emitted into it. Version 0.10.3 -------------- * Add `getCursorPosition` as a synonym of `getCursorPosition0` and deprecate the latter. Version 0.10.2 -------------- * `hGetTerminalSize` now assumes a terminal is no bigger than 9,999 by 9,999 (previously, no bigger than 999 by 999). * On Windows, fix a bug where emulated cursor movement functions differed from Windows 10 (movement bounded by the current viewport). Version 0.10.1 -------------- * Add `hGetCursorPosition` and `hGetTerminalSize`. * On Unix-like operating systems, fix a bug where `getReportedCursorPosition` could block indefinitely if no information was forthcoming on the console input stream. * Improvements to Haddock documentation. Version 0.10 ------------ * Add support for setting the default color with new `SetDefaultColor` constructor of the `SGR` type. * `getTerminalSize` now flushes the `stdout` channel, to ensure the cursor position is unaffected. Version 0.9.1 ------------- * Flag modules with GHC's 'Safe Haskell' language extensions (from GHC 7.2.1). * Improvements and corrections to Haddock documentation. Version 0.9 ----------- * Add support for 256-color palettes with new `SetPaletteColor` constructor of the `SGR` type, and `xterm6LevelRGB`, `xterm24LevelGray` and `xtermSystem`. * Remove deprecated `getCursorPosition`. (Use `getCursorPosition0` instead.) * Add `hSupportsANSIColor`. * Add `getTerminalSize`. * Improvements to Haddock documentation. Version 0.8.2 ------------- * Add `getCursorPosition0` and deprecate `getCursorPosition`. Any position provided by the latter is 1-based. Any position provided by the former is 0-based, consistent with `setCursorColumn` and `setCursorPosition`. * Improvements to Haddock documentation in respect of 0-based and 1-based cursor positions. Version 0.8.1 ------------- * Add `hSupportsANSIWithoutEmulation`. On Windows 10, if the handle is identified as connected to a native terminal ('Command Prompt' or 'PowerShell'), the processing of 'ANSI' control characters will be enabled. Version 0.8.0.4 --------------- * On Windows, `hSupportsANSI` now recognises if the handle is connected to a 'mintty' terminal. * Drop support for GHC versions before GHC 7.0.1 (released November 2010) Version 0.8.0.3 --------------- * On Windows, try to enable ANSI on ConHost terminals even if a TERM environment variable exits (such as with the Hyper 2 terminal) * Minor improvements to Haddock documentation Version 0.8.0.2 --------------- * Improve README and Haddock documentation * On Windows, fix compatability with earlier GHC versions * Drop support for GHC versions before 6.12.1 (released December 2009) Version 0.8.0.1 --------------- * On Windows, if the standard output channel is valid but not a ConHost terminal, assume it is ANSI-enabled rather than failing * On Windows, output the improved error message to the standard error channel rather than the standard output channel Version 0.8 ----------- * Make the fields of `SGR` strict * Make compatible with GHC 8.2.2 * Improve the error message on Windows when not ANSI-capable or ConHost * Recognise Appveyor build environment as ANSI-enabled Version 0.7.1.1 --------------- `getReportedCursorPosition`: don't let the cursor reporting code be echo'd Version 0.7.1 ------------- * Allow saving, restoring, and querying the current cursor position * Fix a couple of issues with the Reset emulation on Windows Version 0.7 ----------- Add 24-bit RGB color support 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 --------------- Add an example to the haddocks Version 0.6.2.2 --------------- Fix a GHC 7.10 warning Version 0.6.2.1 --------------- Restore compatibility with GHC 7.4 and older Version 0.6.2 ------------- * Add `hSupportsANSI` * Drop support for `base < 4` Version 0.6.1.1 --------------- Fix to build with GHC 7.8 on Windows Version 0.6.1 ------------- * `BoldIntensity` no longer changes background color on Windows * `setSGR []` was not equivalent to `setSGR [Reset]` on Windows, even though it should be according to the documentation. This is now fixed. ansi-terminal-1.0.2/README.md0000644000000000000000000000764614550536176013753 0ustar0000000000000000ansi-terminal [![GitHub CI](https://github.com/UnkindPartition/ansi-terminal/workflows/CI/badge.svg)](https://github.com/UnkindPartition/ansi-terminal/actions) ============= A Haskell package providing support for 'ANSI' control character sequences for terminals on Unix-like operating systems and Windows Description ----------- ['ANSI' terminal escape code](http://en.wikipedia.org/wiki/ANSI_escape_sequences) support for Haskell, which allows: - Colored text output, with control over both foreground and background colors - Clearing parts of a line or the screen - Hiding or showing the cursor - Moving the cursor around - Reporting the position of the cursor - Scrolling the screen up or down - Switching between the Alternate and Normal Screen Buffers - Clickable hyperlinks to URIs - Changing the title of the terminal If you like this, you may be interested in [ansi-wl-pprint](http://github.com/batterseapower/ansi-wl-pprint), which provides a pretty-printer that can construct strings containing 'ANSI' colorisation. Not all 'ANSI' escape codes are suported by this library but most (if not all) of the popular ones that are well-supported by terminal software are, including: - Select Graphic Rendition mode (colors and other attributes): `setSGR` - Clearing parts of the screen: `clearFromCursorToScreenEnd`, `clearFromCursorToScreenBeginning`, `clearScreen`, `clearFromCursorToLineEnd`, `clearFromCursorToLineBeginning` and `clearLine` - Cursor visibility changes: `hideCursor` and `showCursor` - Cursor movement by character: `cursorUp`, `cursorDown`, `cursorForward` and `cursorBackward` - Cursor movement by line: `cursorUpLine` and `cursorDownLine` - Directly changing cursor position: `setCursorColumn` and `setCursorPosition` - Saving, restoring and reporting cursor position: `saveCursor`, `restoreCursor` and `reportCursorPosition` - Scrolling the screen: `scrollPageUp` and `scrollPageDown` - Changing the title: `setTitle` Each supported escape code or family of codes has a corresponding function that comes in three variants: - A straight `IO` variant that doesn't take a `Handle` and just applies the escape code to `stdout` and any terminal attached to it - An `IO` variant similar to above, but which takes a `Handle` to which the escape code should be applied - A `String` variant that returns a literal string that should be included to get the effect of the code. Example ------- A full example is [available](https://github.com/UnkindPartition/ansi-terminal/blob/master/ansi-terminal/app/Example.hs), but for a taste of how the library works try the following code: ``` haskell import System.Console.ANSI import System.IO (stdout) main :: IO () main = do stdoutSupportsANSI <- hNowSupportsANSI stdout if stdoutSupportsANSI then do setCursorPosition 5 0 setTitle "ANSI Terminal Short Example" setSGR [ SetConsoleIntensity BoldIntensity , SetColor Foreground Vivid Red ] putStr "Hello" setSGR [ SetConsoleIntensity NormalIntensity , SetColor Foreground Vivid White , SetColor Background Dull Blue ] putStrLn "World!" else putStrLn "Standard output does not support 'ANSI' escape codes." ``` ![](https://raw.githubusercontent.com/feuerbach/ansi-terminal/master/example.png) Documentation ------------- Haddock documentation is [available at Hackage](http://hackage.haskell.org/packages/archive/ansi-terminal/latest/doc/html/System-Console-ANSI.html). Credits ------- The library is originally written by [Max Bolingbroke](https://github.com/batterseapower) Maintainers ----------- [Mike Pilgrem](https://github.com/mpilgrem) and [Roman Cheplyaka](https://github.com/UnkindPartition) are the primary maintainers. [Oliver Charles](https://github.com/ocharles) is the backup maintainer. Please get in touch with him if the primary maintainers cannot be reached. ansi-terminal-1.0.2/win/include/errors.h0000644000000000000000000000145714427707230016365 0ustar0000000000000000#ifndef _ANSI_TERMINAL_ERRORS_H #define _ANSI_TERMINAL_ERRORS_H #include /* Copied from the Win32-2.13.4.0 package, but renamed `getErrorMessage` to * `_ansi_terminal_getErrorMessage`, in order to avoid problems with duplicate * symbols in GHC's object files. See: * https://gitlab.haskell.org/ghc/ghc/-/issues/23365. */ /* There's two ways we can generate error messages - with different tradeoffs: * If we do a function call, we have to use a static buffer. * If we use a macro and ANSI C's string splicing, we have to use constant * strings - and accept a certain amount of overhead from inserting the * boilerplate text. */ /* result should be freed using LocalFree */ extern LPTSTR _ansi_terminal_getErrorMessage(DWORD err); #endif /* _ANSI_TERMINAL_ERRORS_H */ ansi-terminal-1.0.2/win/include/HsWin32.h0000644000000000000000000000116214550542254016237 0ustar0000000000000000#ifndef _ANSI_TERMINAL_HSWIN32_H #define _ANSI_TERMINAL_HSWIN32_H #define UNICODE #include /* Copied from the Win32-2.13.4.0 package, but renamed `castUINTPtrToPtr` to * `_ansi_terminal_castUINTPtrToPtr`, in order to avoid problems with duplicate * symbols in GHC's object files. See: * https://gitlab.haskell.org/ghc/ghc/-/issues/23365. */ #ifndef INLINE # if defined(_MSC_VER) # define INLINE extern __inline # else # define INLINE extern inline # endif #endif INLINE void *_ansi_terminal_castUINTPtrToPtr(UINT_PTR n) { return (void *)n; } #endif /* _ANSI_TERMINAL_HSWIN32_H */ ansi-terminal-1.0.2/win/include/winternl_compat.h0000644000000000000000000000142114427707230020245 0ustar0000000000000000#ifndef WINTERNL_COMPAT_H #define WINTERNL_COMPAT_H /* * winternl.h is not included in MinGW, which was shipped with the 32-bit * Windows version of GHC prior to the 7.10.3 release. */ #if defined(x86_64_HOST_ARCH) || \ __GLASGOW_HASKELL__ >= 711 || \ (__GLASGOW_HASKELL__ == 710 && \ defined(__GLASGOW_HASKELL_PATCHLEVEL1__) && \ __GLASGOW_HASKELL_PATCHLEVEL1__ >= 2) # include #else // Some declarations from winternl.h that we need # include typedef LONG NTSTATUS; typedef struct _UNICODE_STRING { USHORT Length; USHORT MaximumLength; PWSTR Buffer; } UNICODE_STRING; typedef struct _OBJECT_NAME_INFORMATION { UNICODE_STRING Name; } OBJECT_NAME_INFORMATION; #endif #endif /* WINTERNL_COMPAT_H */ ansi-terminal-1.0.2/LICENSE0000644000000000000000000000301514425674750013465 0ustar0000000000000000Copyright (c) 2008, Maximilian Bolingbroke All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ansi-terminal-1.0.2/Setup.hs0000644000000000000000000000006014405320467014100 0ustar0000000000000000import Distribution.Simple main = defaultMain ansi-terminal-1.0.2/ansi-terminal.cabal0000644000000000000000000000552114550541456016206 0ustar0000000000000000Cabal-Version: 1.22 Name: ansi-terminal Version: 1.0.2 Category: User Interfaces Synopsis: Simple ANSI terminal support Description: ANSI terminal support for Haskell: allows cursor movement, screen clearing, color output, showing or hiding the cursor, and changing the title. Works on UNIX and Windows. License: BSD3 License-File: LICENSE Author: Max Bolingbroke Maintainer: Mike Pilgrem , Roman Cheplyaka Homepage: https://github.com/UnkindPartition/ansi-terminal Build-Type: Simple Extra-Source-Files: CHANGELOG.md README.md win/include/errors.h win/include/HsWin32.h win/include/winternl_compat.h Source-repository head type: git location: git://github.com/UnkindPartition/ansi-terminal.git Flag Example Description: Build the example application Default: False Library Hs-Source-Dirs: src Exposed-Modules: System.Console.ANSI System.Console.ANSI.Codes -- We re-export all of ansi-terminal-types to aid compatibility for -- downstream users. Reexported-Modules: System.Console.ANSI.Types Other-Modules: System.Console.ANSI.Internal Build-Depends: base >= 4.8.0.0 && < 5 , ansi-terminal-types == 0.11.5 , colour >= 2.1.0 if os(windows) Hs-Source-Dirs: win Other-Modules: System.Console.ANSI.Windows.Foreign System.Console.ANSI.Windows.Win32.Types System.Console.ANSI.Windows.Win32.MinTTY Include-Dirs: win/include Includes: errors.h HsWin32.h winternl_compat.h Install-Includes: HsWin32.h C-Sources: win/c-source/errors.c win/c-source/HsWin32.c else Hs-Source-Dirs: unix Default-Extensions: CPP Ghc-Options: -Wall Default-Language: Haskell2010 Executable ansi-terminal-example Hs-Source-Dirs: app Main-Is: Example.hs Build-Depends: base >= 4.8.0.0 && < 5 , ansi-terminal , colour Ghc-Options: -Wall if !flag(example) Buildable: False Default-Language: Haskell2010