packages feed

ansi-terminal 0.11.5 → 1.1.5

raw patch · 29 files changed

Files

CHANGELOG.md view
@@ -1,6 +1,90 @@ Changes
 =======
 
+Version 1.1.5
+-------------
+
+* On Windows, smothers a C compiler's warnings about `macro-undefined`,
+  `missing-definitions` and `pragma-pack`, which can be triggered by Windows
+  C headers.
+
+Version 1.1.4
+-------------
+
+* Fixes `hGetCursorPosition` and `hGetLayerColor` on Windows, allowing time for
+  reported information to reach the standard input channel.
+* Improvements to Haddock documentation.
+* The executable `ansi-terminal-example` allows individual examples to be
+  selected.
+
+Version 1.1.3
+-------------
+
+* Module `System.Console.ANSI.Codes` spun out to dependency package
+  `ansi-terminal-types-1.1.3`.
+
+Version 1.1.2
+-------------
+
+* Add `enableLineWrap` and `disableLineWrap`, and support for enabling and
+ disabling automatic line wrapping.
+
+Version 1.1.1
+-------------
+
+* Use of C function `setenv()` in one thread can cause other threads calling C
+  functions that query environment variables to crash. On Unix-like operating
+  systems, where such functions are used, the implementations of
+  `hSupportsANSI` and `hSupportsANSIColor` now avoid unnecessary calls of
+  `System.Environment.lookupEnv`.
+
+* Improvements to Haddock documentation.
+
+Version 1.1
+-----------
+
+* Add support for console layer `Underlining` and underlining styles
+  `CurlyUnderline`, `DottedUnderline` and `DashedUnderline`.
+* Add type synonyms `Parameter`, `SubParam`, and `ParamWithSubs` to represent
+  SGR parameter values with and without following parameter substrings comprised
+  of one or more parameter elements (including empty elements).
+* Add `csi'` and `sgrToCode'`, corresponding to `csi` and `sgrToCode` but
+  capable of handling a parameter value followed by a parameter substring.
+
+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 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
 --------------
LICENSE view
@@ -1,22 +1,25 @@ Copyright (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:
+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.
+* 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.+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.
README.md view
@@ -9,21 +9,18 @@  ['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+-   Colored text output, with control over foreground, background and (where+    supported) underlining colors -   Clearing parts of a line or the screen -   Hiding or showing the cursor -   Moving the cursor around -   Reporting the position of the cursor+-   Enabling and disabling automatic line wrapping -   Scrolling the screen up or down -   Switching between the Alternate and Normal Screen Buffers -   Clickable hyperlinks to URIs -   Changing the title of the terminal -By using emulation, it is compatible with versions of 'Command Prompt' and-'PowerShell' on Windows that did not recognise 'ANSI' escape codes before-Windows 10 version 1511 was released in November 2015.- 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'@@ -44,6 +41,7 @@ -   Directly changing cursor position: `setCursorColumn` and `setCursorPosition` -   Saving, restoring and reporting cursor position: `saveCursor`,     `restoreCursor` and `reportCursorPosition`+-   Automatic line wrapping: `enableLineWrap` and `disableLineWrap` -   Scrolling the screen: `scrollPageUp` and `scrollPageDown` -   Changing the title: `setTitle` @@ -55,8 +53,7 @@ -   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. However, on Windows systems where-    emulation has been necessary, these strings will always be blank!+    included to get the effect of the code.  Example -------@@ -67,21 +64,28 @@  ``` haskell import System.Console.ANSI+import System.IO (stdout) +main :: IO () main = do-    setCursorPosition 5 0-    setTitle "ANSI Terminal Short Example"+  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 BoldIntensity+             , SetColor Foreground Vivid Red+             ]+      putStr "Hello" -    setSGR [ SetConsoleIntensity NormalIntensity-           , SetColor Foreground Vivid White-           , SetColor Background Dull Blue-           ]-    putStrLn "World!"+      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)
ansi-terminal.cabal view
@@ -1,8 +1,8 @@ Cabal-Version:       1.22
 Name:                ansi-terminal
-Version:             0.11.5
+Version:             1.1.5
 Category:            User Interfaces
-Synopsis:            Simple ANSI terminal support, with Windows compatibility
+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.
@@ -13,63 +13,56 @@ Homepage:            https://github.com/UnkindPartition/ansi-terminal
 Build-Type:          Simple
 
-Extra-Source-Files:     src/includes/Common-Include.hs
-                        src/includes/Common-Include-Emulator.hs
-                        src/includes/Common-Include-Enabled.hs
-                        src/includes/Common-Safe-Haskell.hs
-                        src/includes/Exports-Include.hs
-                        CHANGELOG.md
+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
+Flag example
         Description:    Build the example application
         Default:        False
 
-Flag Win32-2-13-1
-        Description:    Use Win32-2-13.1.0 or later. If used, there is
-                        no dependency on the mintty package.
-        Default:        True
-
 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
+        Reexported-Modules:     System.Console.ANSI.Codes
+                              , System.Console.ANSI.Types
 
-        Include-Dirs:           src/includes
+        Other-Modules:          System.Console.ANSI.Internal
 
         Build-Depends:          base >= 4.8.0.0 && < 5
-                              , ansi-terminal-types ==0.11.5
-                              , colour >=2.1.0
+                              , ansi-terminal-types == 1.1.3
+                              , colour >= 2.1.0
         if os(windows)
-                Build-Depends:          containers >= 0.5.0.0
-                if flag(Win32-2-13-1)
-                      Build-Depends:   Win32 >= 2.13.1
-                else
-                      Build-Depends:   Win32 < 2.13.1, mintty
-                Cpp-Options:            -DWINDOWS
-                Other-Modules:          System.Console.ANSI.Windows
-                                        System.Console.ANSI.Windows.Detect
-                                        System.Console.ANSI.Windows.Emulator
-                                        System.Console.ANSI.Windows.Emulator.Codes
-                                        System.Console.ANSI.Windows.Foreign
-                                        -- NB: used for fallback by the emulator
-                                        System.Console.ANSI.Unix
-                                        System.Win32.Compat
+            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
+            Install-Includes:   HsWin32.h
+            C-Sources:          win/c-source/errors.c
+                                win/c-source/HsWin32.c
+            -- The MSYS2 UCRT64 environment is stricter than the MINGW64
+            -- environment about these C compiler diagnostics:
+            -- (1) macro-redefined, (2) missing-declarations, and
+            -- (3) pragma-pack. Windows C headers are not warning-clean under
+            -- -Wmacro-redefined, -Wmissing-declarations and -Wpragma-pack. We
+            -- smother those warnings:
+            Cc-Options:         -Wno-macro-redefined
+                                -Wno-missing-declarations
+                                -Wno-pragma-pack
         else
-                -- We assume any non-Windows platform is Unix
-                Cpp-Options:            -DUNIX
-                Other-Modules:          System.Console.ANSI.Unix
+            Hs-Source-Dirs:     unix
 
         Default-Extensions:     CPP
-                                ForeignFunctionInterface
 
         Ghc-Options:            -Wall
         Default-Language:       Haskell2010
@@ -82,5 +75,5 @@                               , colour
         Ghc-Options:            -Wall
         if !flag(example)
-                Buildable:              False
+            Buildable:          False
         Default-Language:       Haskell2010
app/Example.hs view
@@ -11,28 +11,57 @@ import Data.Colour.SRGB (sRGB24)
 
 import System.Console.ANSI
+import System.Environment ( getArgs )
 
-examples :: [IO ()]
-examples = [ cursorMovementExample
-           , lineChangeExample
-           , setCursorPositionExample
-           , saveRestoreCursorExample
-           , clearExample
-           , scrollExample
-           , screenBuffersExample
-           , sgrColorExample
-           , sgrOtherExample
-           , cursorVisibilityExample
-           , hyperlinkExample
-           , titleExample
-           , getCursorPositionExample
-           , getTerminalSizeExample
-           , getLayerColorExample
-           ]
+examples :: [(String, IO ())]
+examples =
+  [ ( "Cursor movement", cursorMovementExample )
+  , ( "Line change", lineChangeExample )
+  , ( "Set cursor position", setCursorPositionExample )
+  , ( "Save restore cursor", saveRestoreCursorExample )
+  , ( "Clear", clearExample )
+  , ( "Line wrap", lineWrapExample )
+  , ( "Scroll", scrollExample )
+  , ( "Screen buffers", screenBuffersExample )
+  , ( "SGR color", sgrColorExample )
+  , ( "SGR other", sgrOtherExample )
+  , ( "Cursor visibility", cursorVisibilityExample )
+  , ( "Hyperlink", hyperlinkExample )
+  , ( "Title", titleExample )
+  , ( "Get cursor position", getCursorPositionExample )
+  , ( "Get terminal size", getTerminalSizeExample )
+  , ( "Get layer color", getLayerColorExample )
+  ]
 
 main :: IO ()
-main = mapM_ (resetScreen >>) examples
+main = do
+  args <- getArgs
+  let numExamples = zip [1 ..] examples
+  if wantHelp args
+    then
+      listExamples numExamples
+    else do
+      let wantedNumExamples = filter (isExample args) numExamples
+          wantedExamples = map getExample wantedNumExamples
+      stdoutSupportsANSI <- hNowSupportsANSI stdout
+      if stdoutSupportsANSI
+        then
+          mapM_ (resetScreen >>) wantedExamples
+        else
+          putStrLn "Standard output does not support 'ANSI' escape codes."
+ where
+  wantHelp :: [String] -> Bool
+  wantHelp args = "-h" `elem` args || "--help" `elem` args
 
+  listExamples :: [(Int, (String, IO ()))] -> IO ()
+  listExamples = mapM_ (\(n, (d, _)) -> putStrLn $ show n ++ ": " ++ d)
+
+  isExample :: [String] -> (Int, (String, IO ())) -> Bool
+  isExample args (n, _) = show n `elem` args
+
+  getExample :: (Int, (String, IO ())) -> IO ()
+  getExample (_, (_, example)) = example
+
 -- 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
@@ -200,6 +229,24 @@   pause
   --
 
+lineWrapExample :: IO ()
+lineWrapExample = do
+  putStrLn $ take 240 $ cycle "Default-line-wrap|"
+  pause
+  -- Default-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Def
+  -- ault-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Defaul
+  -- t-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Default-l
+  disableLineWrap
+  putStrLn $ take 240 $ cycle "Disable-line-wrap|"
+  pause
+  -- Disable-line-wrap|Disable-line-wrap|Disable-line-wrap|Disable-line-wrap|Dis
+  enableLineWrap
+  putStrLn $ take 240 $ cycle "Enable-line-wrap|"
+  pause
+  -- Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-
+  -- line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wr
+  -- ap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enab
+
 scrollExample :: IO ()
 scrollExample = do
   putStrLn "Line One"
@@ -237,15 +284,16 @@ sgrColorExample :: IO ()
 sgrColorExample = do
   let colors = enumFromTo minBound maxBound :: [Color]
-  forM_ [Foreground, Background] $ \layer ->  do
+  forM_ [Foreground, Background, Underlining] $ \layer ->  do
     forM_ [Dull, Vivid] $ \intensity -> do
       resetScreen
       forM_ colors $ \color -> do
         setSGR [Reset]
         setSGR [SetColor layer intensity color]
+        setSGR [SetUnderlining SingleUnderline]
         print color
       pause
-  -- The ANSI eight standard colors, 4 times in sequence (two layers and two
+  -- The ANSI eight standard colors, 6 times in sequence (three layers and two
   -- intensities)
 
   resetScreen
@@ -327,6 +375,25 @@         putStr " "
   replicateM_ 5 pause
 
+  resetScreen
+  setSGR [Reset]
+  setSGR [SetUnderlining SingleUnderline]
+  forM_
+    (zip "Underlining: True color (24 bit color depth)" (cycle [0, 10 .. 255])) $
+    \(c, i) -> do
+      setSGR [SetRGBColor Underlining $ sRGB24 i 0 0]
+      putChar c
+  putChar '\n'
+  putChar '\n'
+  setSGR [Reset]
+  setSGR [SetUnderlining SingleUnderline]
+  forM_ (zip "Underlining: A 256-color palette" (cycle [0 .. 5])) $
+    \(c, i) -> do
+      setSGR [SetPaletteColor Underlining $ xterm6LevelRGB i 0 0]
+      putChar c
+  putChar '\n'
+  replicateM_ 5 pause
+
 sgrOtherExample :: IO ()
 sgrOtherExample = do
   let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold")
@@ -336,6 +403,9 @@                      , (SetItalicized False, "No Italics")
                      , (SetUnderlining SingleUnderline, "Single Underline")
                      , (SetUnderlining DoubleUnderline, "Double Underline")
+                     , (SetUnderlining CurlyUnderline, "Curly Underline")
+                     , (SetUnderlining DottedUnderline, "Dotted Underline")
+                     , (SetUnderlining DashedUnderline, "Dashed Underline")
                      , (SetUnderlining NoUnderline, "No Underline")
                      , (SetBlinkSpeed SlowBlink, "Slow Blink")
                      , (SetBlinkSpeed RapidBlink, "Rapid Blink")
src/System/Console/ANSI.hs view
@@ -1,177 +1,1095 @@-#include "Common-Safe-Haskell.hs"
-
-{-| == 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 at
-<http://en.wikipedia.org/wiki/ANSI_escape_code> and those codes supported on
-current versions of Windows at
-<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. For
-that software, this library also provides support for such sequences by using
-emulation based on the Windows Console API. 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\').
-
-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 the GHC bug report #806 at
-<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
->
-> -- Set colors and write some text in those colors.
-> main :: IO ()
-> main = 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."
-
-Another example is below:
-
-> module Main where
->
-> import System.IO (hFlush, stdout)
-> import System.Console.ANSI
->
-> main :: IO ()
-> main = 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
-
-For many more examples, see the project's extensive
-<https://github.com/UnkindPartition/ansi-terminal/blob/master/app/Example.hs Example.hs> file.
--}
-#if defined(WINDOWS)
-module System.Console.ANSI
-  (
-    module System.Console.ANSI.Windows
-  ) where
-
-import System.Console.ANSI.Windows
-
-#elif defined(UNIX)
-
-module System.Console.ANSI
-  (
-    module System.Console.ANSI.Unix
-  ) where
-
-import System.Console.ANSI.Unix
-
-#else
-
-#error Unsupported platform for the ansi-terminal package
-
-#endif
+{-# 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 foreground, background and (where
+   supported) underlining colors
+
+ * Clearing parts of a line or the screen
+
+ * Hiding or showing the cursor
+
+ * Moving the cursor around
+
+ * Reporting the position of the cursor
+
+ * Enabling or disabling automatic line wrapping
+
+ * 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 'System.IO.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
+<https://github.com/UnkindPartition/ansi-terminal/blob/master/app/Example.hs Example.hs> 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
+    -- <https://stackoverflow.com/questions/25879183 does not support them>.
+    -- A more portable way would be to query @terminfo@ database
+    -- for @rc@ and @sc@ capabilities.
+    --
+    -- Cursor positions
+    -- <https://unix.stackexchange.com/questions/565597 are relative to the viewport, not to its content>.
+    --
+  , 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
+
+    -- * Enabling and disabling automatic line wrapping
+    --
+    -- | These functions control whether or not characters automatically wrap to
+    -- the next line when the cursor reaches the right border.
+  , enableLineWrap
+  , disableLineWrap
+    -- ** \'h...\' variants
+  , hEnableLineWrap
+  , hDisableLineWrap
+    -- ** \'...Code\' variants
+  , enableLineWrapCode
+  , disableLineWrapCode
+
+    -- * 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
+    -- <https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda many terminals>
+    -- 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.Concurrent (threadDelay)
+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.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 [ \<cursor row> ; \<cursor column> 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
+-- 'System.IO.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 'System.IO.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 = Internal.hSupportsANSIColor
+
+-- | 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.)
+--
+-- This operation may fail with an error if 'stdin' has been redirected.
+--
+-- @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.)
+--
+-- This operation may fail with an error if 'stdin' has been redirected.
+--
+-- @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
+        -- Ensure the report cursor position code is sent to the operating
+        -- system:
+        hFlush h
+        -- On Windows and in Windows Terminal v1.22.12111.0 (at least), it seems
+        -- that a moment's delay is required in order to allow sufficient time
+        -- for the reported information to reach the standard input channel:
+        threadDelay 1
+        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 ] \<Ps> ; rgb: \<red> ; \<green> ; \<blue> \<ST>@
+-- where @\<Ps>@ is @10@ for 'Foreground' and @11@ for 'Background'; @\<red>@,
+-- @\<green>@ and @\<blue>@ are the color channel values in hexadecimal (4, 8,
+-- 12 and 16 bit values are possible, although 16 bit values are most common);
+-- and @\<ST>@ 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.
+--
+-- Underlining is not supported.
+--
+-- @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.)
+--
+-- Underlining is not supported.
+--
+-- @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.
+--
+-- Underlining is not supported.
+--
+-- This operation may fail with an error if 'stdin' has been redirected.
+--
+-- @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.
+--
+-- Underlining is not supported.
+--
+-- This operation may fail with an error if 'stdin' has been redirected.
+--
+-- @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
+      -- Ensure the report cursor position code is sent to the operating system:
+      hFlush h
+      -- On Windows and in Windows Terminal v1.22.12111.0 (at least), it seems
+      -- that a moment's delay is required in order to allow sufficient time for
+      -- the reported information to reach the standard input channel:
+      threadDelay 1
+      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"
+--
+-- Underlining is not supported.
+--
+-- @since 0.11.4
+layerColor :: ConsoleLayer -> ReadP (RGB Word16)
+layerColor layer = do
+  void $ string "\ESC]"
+  void $ string $ case layer of
+    Foreground -> "10"
+    Background -> "11"
+    Underlining -> fail "reportLayerColor does not support underlining"
+  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.)
+--
+-- This operation may fail with an error if 'stdin' has been redirected.
+--
+-- For a different approach, one that does not use control character sequences
+-- and works when 'stdin' is redirected, see the
+-- <https://hackage.haskell.org/package/terminal-size terminal-size> 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 'System.IO.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.)
+--
+-- This operation may fail with an error if 'stdin' has been redirected.
+--
+-- For a different approach, one that does not use control character sequences
+-- and works when 'stdin' is redirected, see the
+-- <https://hackage.haskell.org/package/terminal-size terminal-size> 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
+
+hEnableLineWrap, hDisableLineWrap ::
+     Handle
+  -> IO ()
+hEnableLineWrap h = hPutStr h enableLineWrapCode
+hDisableLineWrap h = hPutStr h disableLineWrapCode
+
+enableLineWrap, disableLineWrap :: IO ()
+enableLineWrap = hEnableLineWrap stdout
+disableLineWrap = hDisableLineWrap 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
− src/System/Console/ANSI/Codes.hs 
@@ -1,312 +0,0 @@-#include "Common-Safe-Haskell.hs"
-
-{-| 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".
-
-The module "System.Console.ANSI" exports functions with the same names as those
-in this module. On some versions of Windows, the terminal in use may not be
-ANSI-capable. When that is the case, the same-named functions exported by module
-"System.Console.ANSI" return \"\", for the reasons set out in the documentation
-of that module.
-
-Consequently, if module "System.Console.ANSI" is also imported, this module is
-intended to be imported qualified, to avoid name clashes with those functions.
-For example:
-
-> import qualified System.Console.ANSI.Codes as ANSI
--}
-module System.Console.ANSI.Codes
-  (
-    -- * Basic data types
-    module System.Console.ANSI.Types
-
-    -- * Cursor movement by character
-    --
-    -- | 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 [ \<cursor row> ; \<cursor column> 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 ] \<Ps> ; rgb: \<red> ; \<green> ; \<blue> \<ST>@
--- where @\<Ps>@ is @10@ for 'Foreground' and @11@ for 'Background'; @\<red>@,
--- @\<green>@ and @\<blue>@ are the color channel values in hexadecimal (4, 8,
--- 12 and 16 bit values are possible, although 16 bit values are most common);
--- and @\<ST>@ 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)
− src/System/Console/ANSI/Unix.hs 
@@ -1,200 +0,0 @@-#include "Common-Safe-Haskell.hs"
-{-# OPTIONS_HADDOCK hide #-}
-
-module System.Console.ANSI.Unix
-  (
--- This file contains code that is common to modules
--- System.Console.ANSI.Unix and System.Console.ANSI.Windows, namely the module
--- exports and the associated Haddock documentation.
-#include "Exports-Include.hs"
-  ) where
-
-import Control.Exception.Base (bracket)
-import Control.Monad (when)
-import Data.List (uncons)
-import Data.Maybe (fromMaybe, mapMaybe)
-import System.IO (BufferMode (..), Handle, hGetBuffering, hGetEcho,
-  hIsTerminalDevice, hIsWritable, hPutStr, hReady, hSetBuffering, hSetEcho,
-  stdin)
-import System.Timeout (timeout)
-import Text.ParserCombinators.ReadP (readP_to_S)
-
-import System.Console.ANSI.Codes
-
--- This file contains code that is common to modules System.Console.ANSI.Unix,
--- System.Console.ANSI.Windows and System.Console.ANSI.Windows.Emulator, such as
--- type signatures and the definition of functions specific to stdout in terms
--- of the corresponding more general functions, including the related Haddock
--- documentation.
-#include "Common-Include.hs"
--- This file contains code that is common save that different code is required
--- in the case of the module System.Console.ANSI.Windows.Emulator (see the file
--- Common-Include-Emulator.hs in respect of the latter).
-#include "Common-Include-Enabled.hs"
-
-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
-
-hCursorDownLine h n = hPutStr h $ cursorDownLineCode n
-hCursorUpLine h n = hPutStr h $ cursorUpLineCode n
-
-hSetCursorColumn h n = hPutStr h $ setCursorColumnCode n
-hSetCursorPosition h n m = hPutStr h $ setCursorPositionCode n m
-
-hSaveCursor h = hPutStr h saveCursorCode
-hRestoreCursor h = hPutStr h restoreCursorCode
-hReportCursorPosition h = hPutStr h reportCursorPositionCode
-
-hClearFromCursorToScreenEnd h = hPutStr h clearFromCursorToScreenEndCode
-hClearFromCursorToScreenBeginning h
-    = hPutStr h clearFromCursorToScreenBeginningCode
-hClearScreen h = hPutStr h clearScreenCode
-
-hClearFromCursorToLineEnd h = hPutStr h clearFromCursorToLineEndCode
-hClearFromCursorToLineBeginning h = hPutStr h clearFromCursorToLineBeginningCode
-hClearLine h = hPutStr h clearLineCode
-
-hScrollPageUp h n = hPutStr h $ scrollPageUpCode n
-hScrollPageDown h n = hPutStr h $ scrollPageDownCode n
-
-hUseAlternateScreenBuffer h = hPutStr h useAlternateScreenBufferCode
-hUseNormalScreenBuffer h = hPutStr h useNormalScreenBufferCode
-
-hReportLayerColor h layer = hPutStr h $ reportLayerColorCode layer
-
-hSetSGR h sgrs = hPutStr h $ setSGRCode sgrs
-
-hHideCursor h = hPutStr h hideCursorCode
-hShowCursor h = hPutStr h showCursorCode
-
-hHyperlinkWithParams h params uri link =
-  hPutStr h $ hyperlinkWithParamsCode params uri link
-
-hSetTitle h title = hPutStr h $ setTitleCode title
-
--- hSupportsANSI :: Handle -> IO Bool
--- (See Common-Include.hs for Haddock documentation)
---
--- Borrowed from an HSpec patch by Simon Hengel
--- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd)
-hSupportsANSI h = (&&) <$> hIsTerminalDevice h <*> isNotDumb
- where
-  -- cannot use lookupEnv since it only appeared in GHC 7.6
-  isNotDumb = (/= Just "dumb") . lookup "TERM" <$> getEnvironment
-
--- hSupportsANSIWithoutEmulation :: Handle -> IO (Maybe Bool)
--- (See Common-Include.hs for Haddock documentation)
-hSupportsANSIWithoutEmulation h =
-  Just <$> ((&&) <$> hIsWritable h <*> hSupportsANSI h)
-
--- getReportedCursorPosition :: IO String
--- (See Common-Include.hs for Haddock documentation)
-getReportedCursorPosition = getReport "\ESC[" ["R"]
-
--- getReportedLayerColor :: ConsoleLayer -> IO String
--- (See Common-Include.hs for Haddock documentation)
-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.
-
--- hGetCursorPosition :: Handle -> IO (Maybe (Int, Int))
--- (See Common-Include.hs for Haddock documentation)
-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
-
--- hGetLayerColor :: Handle -> IO (Maybe (Colour Word16))
--- (See Common-Include.hs for Haddock documentation)
-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
− src/System/Console/ANSI/Windows.hs 
@@ -1,250 +0,0 @@-#include "Common-Safe-Haskell.hs"
-{-# OPTIONS_HADDOCK hide #-}
-
-module System.Console.ANSI.Windows
-  (
--- This file contains code that is common to modules
--- System.Console.ANSI.Unix and System.Console.ANSI.Windows, namely the module
--- exports and the associated Haddock documentation.
-#include "Exports-Include.hs"
-  ) where
-
-import System.IO (Handle)
-
-import qualified System.Console.ANSI.Unix as U
-import System.Console.ANSI.Windows.Detect (ANSISupport (..),
-  ConsoleDefaultState (..), aNSISupport)
-import qualified System.Console.ANSI.Windows.Emulator as E
-
--- This file contains code that is common to modules System.Console.ANSI.Unix,
--- System.Console.ANSI.Windows and System.Console.ANSI.Windows.Emulator, such as
--- type signatures and the definition of functions specific to stdout in terms
--- of the corresponding more general functions, including the related Haddock
--- documentation.
-#include "Common-Include.hs"
--- This file contains code that is common save that different code is required
--- in the case of the module System.Console.ANSI.Windows.Emulator (see the file
--- Common-Include-Emulator.hs in respect of the latter).
-#include "Common-Include-Enabled.hs"
-
--- | A helper function which returns the native or emulated version, depending
--- on `aNSISupport`.
-nativeOrEmulated :: a -> a -> a
-nativeOrEmulated native emulated = case aNSISupport of
-  Native     -> native
-  Emulated _ -> emulated
-
--- | A helper function which returns the native or emulated version, depending
--- on `aNSISupport`, where the emulator uses the default console state.
-nativeOrEmulatedWithDefault :: a -> (ConsoleDefaultState -> a) -> a
-nativeOrEmulatedWithDefault native emulated = case aNSISupport of
-  Native       -> native
-  Emulated def -> emulated def
-
-
--- * Cursor movement by character
-hCursorUp       = nativeOrEmulated U.hCursorUp       E.hCursorUp
-hCursorDown     = nativeOrEmulated U.hCursorDown     E.hCursorDown
-hCursorForward  = nativeOrEmulated U.hCursorForward  E.hCursorForward
-hCursorBackward = nativeOrEmulated U.hCursorBackward E.hCursorBackward
-
-cursorUpCode :: Int -> String
-cursorUpCode = nativeOrEmulated U.cursorUpCode E.cursorUpCode
-
-cursorDownCode :: Int -> String
-cursorDownCode = nativeOrEmulated U.cursorDownCode E.cursorDownCode
-
-cursorForwardCode :: Int -> String
-cursorForwardCode = nativeOrEmulated U.cursorForwardCode E.cursorForwardCode
-
-cursorBackwardCode :: Int -> String
-cursorBackwardCode = nativeOrEmulated U.cursorBackwardCode E.cursorBackwardCode
-
--- * Cursor movement by line
-hCursorUpLine   = nativeOrEmulated U.hCursorUpLine   E.hCursorUpLine
-hCursorDownLine = nativeOrEmulated U.hCursorDownLine E.hCursorDownLine
-
-cursorUpLineCode :: Int -> String
-cursorUpLineCode = nativeOrEmulated U.cursorUpLineCode E.cursorUpLineCode
-
-cursorDownLineCode :: Int -> String
-cursorDownLineCode = nativeOrEmulated U.cursorDownLineCode E.cursorDownLineCode
-
--- * Directly changing cursor position
-hSetCursorColumn = nativeOrEmulated U.hSetCursorColumn E.hSetCursorColumn
-
-setCursorColumnCode :: Int -> String
-setCursorColumnCode = nativeOrEmulated
-  U.setCursorColumnCode E.setCursorColumnCode
-
-hSetCursorPosition = nativeOrEmulated U.hSetCursorPosition E.hSetCursorPosition
-
-setCursorPositionCode :: Int -> Int -> String
-setCursorPositionCode = nativeOrEmulated
-  U.setCursorPositionCode E.setCursorPositionCode
-
--- * Saving, restoring and reporting cursor position
-hSaveCursor = nativeOrEmulated U.hSaveCursor E.hSaveCursor
-hRestoreCursor = nativeOrEmulated U.hRestoreCursor E.hRestoreCursor
-hReportCursorPosition = nativeOrEmulated
-  U.hReportCursorPosition E.hReportCursorPosition
-
-saveCursorCode :: String
-saveCursorCode = nativeOrEmulated U.saveCursorCode E.saveCursorCode
-
-restoreCursorCode :: String
-restoreCursorCode = nativeOrEmulated U.restoreCursorCode E.restoreCursorCode
-
-reportCursorPositionCode :: String
-reportCursorPositionCode = nativeOrEmulated
-    U.reportCursorPositionCode E.reportCursorPositionCode
-
--- * Clearing parts of the screen
-hClearFromCursorToScreenEnd = nativeOrEmulatedWithDefault
-  U.hClearFromCursorToScreenEnd E.hClearFromCursorToScreenEnd
-hClearFromCursorToScreenBeginning = nativeOrEmulatedWithDefault
-  U.hClearFromCursorToScreenBeginning E.hClearFromCursorToScreenBeginning
-hClearScreen = nativeOrEmulatedWithDefault U.hClearScreen E.hClearScreen
-
-clearFromCursorToScreenEndCode :: String
-clearFromCursorToScreenEndCode = nativeOrEmulated
-  U.clearFromCursorToScreenEndCode E.clearFromCursorToScreenEndCode
-
-clearFromCursorToScreenBeginningCode :: String
-clearFromCursorToScreenBeginningCode = nativeOrEmulated
-    U.clearFromCursorToScreenBeginningCode E.clearFromCursorToScreenBeginningCode
-
-clearScreenCode :: String
-clearScreenCode = nativeOrEmulated U.clearScreenCode E.clearScreenCode
-
-hClearFromCursorToLineEnd = nativeOrEmulatedWithDefault
-  U.hClearFromCursorToLineEnd E.hClearFromCursorToLineEnd
-hClearFromCursorToLineBeginning = nativeOrEmulatedWithDefault
-  U.hClearFromCursorToLineBeginning E.hClearFromCursorToLineBeginning
-hClearLine = nativeOrEmulatedWithDefault U.hClearLine E.hClearLine
-
-clearFromCursorToLineEndCode :: String
-clearFromCursorToLineEndCode = nativeOrEmulated
-  U.clearFromCursorToLineEndCode E.clearFromCursorToLineEndCode
-
-clearFromCursorToLineBeginningCode :: String
-clearFromCursorToLineBeginningCode = nativeOrEmulated
-  U.clearFromCursorToLineBeginningCode E.clearFromCursorToLineBeginningCode
-
-clearLineCode :: String
-clearLineCode = nativeOrEmulated U.clearLineCode E.clearLineCode
-
--- * Scrolling the screen
-hScrollPageUp   = nativeOrEmulatedWithDefault U.hScrollPageUp   E.hScrollPageUp
-hScrollPageDown = nativeOrEmulatedWithDefault U.hScrollPageDown E.hScrollPageDown
-
-scrollPageUpCode :: Int -> String
-scrollPageUpCode = nativeOrEmulated U.scrollPageUpCode E.scrollPageUpCode
-
-scrollPageDownCode :: Int -> String
-scrollPageDownCode = nativeOrEmulated U.scrollPageDownCode E.scrollPageDownCode
-
--- * Using screen buffers
-hUseAlternateScreenBuffer = nativeOrEmulated
-  U.hUseAlternateScreenBuffer E.hUseAlternateScreenBuffer
-hUseNormalScreenBuffer = nativeOrEmulated
-  U.hUseNormalScreenBuffer E.hUseNormalScreenBuffer
-
-useAlternateScreenBufferCode :: String
-useAlternateScreenBufferCode = nativeOrEmulated
-  U.useAlternateScreenBufferCode E.useAlternateScreenBufferCode
-
-useNormalScreenBufferCode :: String
-useNormalScreenBufferCode = nativeOrEmulated
-  U.useNormalScreenBufferCode E.useNormalScreenBufferCode
-
--- * Reporting the background or foreground colors
-hReportLayerColor = E.hReportLayerColor
-
-reportLayerColorCode :: ConsoleLayer -> String
-reportLayerColorCode = nativeOrEmulated
-  U.reportLayerColorCode E.reportLayerColorCode
-
--- * Select Graphic Rendition mode: colors and other whizzy stuff
---
--- The following SGR codes are NOT implemented by Windows 10 Threshold 2:
--- 2   SetConsoleIntensity FaintIntensity
--- 3   SetItalicized True
--- 5   SetBlinkSpeed SlowBlink
--- 6   SetBlinkSpeed RapidBlink
--- 8   SetVisible False
--- 21  SetUnderlining DoubleUnderline
--- 23  SetItalicized False
--- 25  SetBlinkSpeed NoBlink
--- 28  SetVisible True
-
-hSetSGR = nativeOrEmulatedWithDefault U.hSetSGR E.hSetSGR
-
-setSGRCode :: [SGR] -> String
-setSGRCode = nativeOrEmulated U.setSGRCode E.setSGRCode
-
--- * Cursor visibilty changes
-hHideCursor = nativeOrEmulated U.hHideCursor E.hHideCursor
-hShowCursor = nativeOrEmulated U.hShowCursor E.hShowCursor
-
-hideCursorCode :: String
-hideCursorCode = nativeOrEmulated U.hideCursorCode E.hideCursorCode
-
-showCursorCode :: String
-showCursorCode = nativeOrEmulated U.showCursorCode E.showCursorCode
-
--- * Hyperlinks
-hHyperlinkWithParams =
-  nativeOrEmulated U.hHyperlinkWithParams E.hHyperlinkWithParams
-
-hyperlinkWithParamsCode
-  :: [(String, String)]
-  -> String
-  -> String
-  -> String
-hyperlinkWithParamsCode =
-  nativeOrEmulated U.hyperlinkWithParamsCode E.hyperlinkWithParamsCode
-
-hyperlinkCode
-  :: String
-  -> String
-  -> String
-hyperlinkCode = nativeOrEmulated U.hyperlinkCode E.hyperlinkCode
-
-hyperlinkWithIdCode
-  :: String
-  -> String
-  -> String
-  -> String
-hyperlinkWithIdCode =
-  nativeOrEmulated U.hyperlinkWithIdCode E.hyperlinkWithIdCode
-
--- * Changing the title
-hSetTitle = nativeOrEmulated U.hSetTitle E.hSetTitle
-
-setTitleCode :: String -> String
-setTitleCode = nativeOrEmulated U.setTitleCode E.setTitleCode
-
--- hSupportsANSI :: Handle -> IO Bool
--- (See Common-Include.hs for Haddock documentation)
-hSupportsANSI = E.hSupportsANSI
-
--- hSupportsANSIWithoutEmulation :: Handle -> IO (Maybe Bool)
--- (See Common-Include.hs for Haddock documentation)
-hSupportsANSIWithoutEmulation = E.hSupportsANSIWithoutEmulation
-
--- getReportedCursorPosition :: IO String
--- (See Common-Include.hs for Haddock documentation)
-getReportedCursorPosition = E.getReportedCursorPosition
-
--- hGetCursorPosition :: Handle -> IO (Maybe (Int, Int))
--- (See Common-Include.hs for Haddock documentation)
-hGetCursorPosition = E.hGetCursorPosition
-
--- getReportedLayerColor :: ConsoleLayer -> IO String
--- (See Common-Include.hs for Haddock documentation)
-getReportedLayerColor = E.getReportedLayerColor
-
--- hGetLayerColor :: ConsoleLayer -> IO (Maybe (RGB Word16))
--- (See Common-Include.hs for Haddock documentation)
-hGetLayerColor = E.hGetLayerColor
− src/System/Console/ANSI/Windows/Detect.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE Trustworthy #-}
-{-# OPTIONS_HADDOCK hide #-}
-
-module System.Console.ANSI.Windows.Detect
-  (
-    ANSISupport (..)
-  , ConsoleDefaultState (..)
-  , aNSISupport
-  , detectHandleSupportsANSI
-  ) where
-
-import Control.Exception (SomeException(..), throwIO, try)
-import Data.Bits ((.&.), (.|.))
-#ifdef MIN_VERSION_mintty
-import System.Console.MinTTY (isMinTTYHandle)
-#else
-import System.Win32.MinTTY (isMinTTYHandle)
-#endif
-import System.IO (Handle, hIsWritable, stdout)
-import System.IO.Unsafe (unsafePerformIO)
-
-import System.Console.ANSI.Windows.Foreign (ConsoleException(..),
-  CONSOLE_SCREEN_BUFFER_INFO (..), DWORD, HANDLE, WORD,
-  bACKGROUND_INTENSE_WHITE, eNABLE_VIRTUAL_TERMINAL_PROCESSING,
-  fOREGROUND_INTENSE_WHITE, getConsoleMode, getConsoleScreenBufferInfo,
-  iNVALID_HANDLE_VALUE, nullHANDLE, setConsoleMode, withHandleToHANDLE)
-
--- | The default state of the console.
-data ConsoleDefaultState = ConsoleDefaultState
-  { defaultForegroundAttributes :: WORD -- ^ Foreground attributes
-  , defaultBackgroundAttributes :: WORD -- ^ Background attributes
-  } deriving (Eq, Show)
-
--- | How the console is assumed to support ANSI control codes.
-data ANSISupport
-  = Native                       -- ^ Assume ANSI-enabled
-  | Emulated ConsoleDefaultState -- ^ Not ANSI-enabled (including the state of
-                                 -- the console when that status was determined)
-  deriving (Eq, Show)
-
--- | Terminals on Windows
-data Terminal
-  = NativeANSIEnabled    -- ^ Windows 10 (Command Prompt or PowerShell)
-  | NativeANSIIncapable  -- ^ Versions before Windows 10 (Command Prompt or
-                         -- PowerShell)
-  | Mintty               -- ^ ANSI-enabled
-  | UnknownTerminal
-
--- | This function assumes that once it is first established whether or not the
--- Windows console requires emulation, that will not change. If the console
--- requires emulation, the state of the console is considered to be its default
--- state.
-{-# NOINLINE aNSISupport #-}
-aNSISupport :: ANSISupport
-aNSISupport = unsafePerformIO $ withHandleToHANDLE stdout $ withHANDLE
-  (throwIO $ ConsoleException 6)  -- Invalid handle or no handle
-  (\h -> do
-    terminal <- handleToTerminal h
-    case terminal of
-      NativeANSIIncapable -> Emulated <$> consoleDefaultState h
-      _                   -> pure Native)
- where
-  consoleDefaultState h = do
-    info <- getConsoleScreenBufferInfo h
-    let attributes = csbi_attributes info
-        fgAttributes = attributes .&. fOREGROUND_INTENSE_WHITE
-        bgAttributes = attributes .&. bACKGROUND_INTENSE_WHITE
-    pure ConsoleDefaultState
-      { defaultForegroundAttributes = fgAttributes
-      , defaultBackgroundAttributes = bgAttributes }
-
--- | This function tests that the handle is writable. If what is attached to the
--- handle is not recognised as a known terminal, it returns @pure Nothing@.
-detectHandleSupportsANSI :: Handle -> IO (Maybe Bool)
-detectHandleSupportsANSI handle = do
-  isWritable <- hIsWritable handle
-  if isWritable
-    then withHandleToHANDLE handle $ withHANDLE
-      (pure $ Just False)  -- Invalid handle or no handle
-      (\h -> do
-        terminal <- handleToTerminal h
-        case terminal of
-          NativeANSIIncapable -> pure (Just False)
-          UnknownTerminal     -> pure Nothing  -- Not sure!
-          _                   -> pure (Just True))
-    else pure (Just False)  -- Not an output handle
-
--- | This function assumes that the Windows handle is writable.
-handleToTerminal :: HANDLE -> IO Terminal
-handleToTerminal h = do
-  tryMode <- try (getConsoleMode h) :: IO (Either SomeException DWORD)
-  case tryMode of
-    Left _     -> do  -- No ConHost mode
-      isMinTTY <- isMinTTYHandle h
-      if isMinTTY
-        then pure Mintty  -- 'mintty' terminal emulator
-        else pure UnknownTerminal  -- Not sure!
-    Right mode -> if mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0
-      then pure NativeANSIEnabled  -- VT processing already enabled
-      else do
-        let mode' = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING
-        trySetMode <- try (setConsoleMode h mode')
-          :: IO (Either SomeException ())
-        case trySetMode of
-          Left _   -> pure NativeANSIIncapable  -- Can't enable VT processing
-          Right () -> pure NativeANSIEnabled  -- VT processing enabled
-
--- | 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
− src/System/Console/ANSI/Windows/Emulator.hs 
@@ -1,564 +0,0 @@-{-# LANGUAGE Trustworthy #-}
-{-# OPTIONS_HADDOCK hide #-}
-
-module System.Console.ANSI.Windows.Emulator
-  (
-#include "Exports-Include.hs"
-  ) where
-
-import Control.Exception (catchJust, IOException)
-import qualified Control.Exception as CE (catch)
-import Control.Monad (unless)
-import Data.Bits ((.&.), (.|.), complement, shiftL, shiftR)
-import Data.Char (isPrint)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.List (foldl', minimumBy)
-import Data.Maybe (mapMaybe)
-import qualified Data.Map.Strict as Map (Map, empty, insert, lookup)
-import System.IO (Handle, hIsTerminalDevice, hPutStr, stdin)
-import System.IO.Unsafe (unsafePerformIO)
-import Text.ParserCombinators.ReadP (readP_to_S)
-import Text.Printf(printf)
-
-import Data.Colour (Colour)
-import Data.Colour.Names (black, blue, cyan, green, grey, lime, magenta, maroon,
-  navy, olive, purple, red, silver, teal, white, yellow)
-import Data.Colour.SRGB (toSRGB)
-#ifdef MIN_VERSION_mintty
-import System.Console.MinTTY (isMinTTYHandle)
-#else
-import System.Win32.MinTTY (isMinTTYHandle)
-#endif
-
-import qualified System.Console.ANSI.Unix as Unix
-import System.Console.ANSI.Windows.Detect
-import System.Console.ANSI.Windows.Emulator.Codes
-import System.Console.ANSI.Windows.Foreign
-
--- This file contains code that is common to modules System.Console.ANSI.Unix,
--- System.Console.ANSI.Windows and System.Console.ANSI.Windows.Emulator, such as
--- type signatures and the definition of functions specific to stdout in terms
--- of the corresponding more general functions, including the related Haddock
--- documentation.
-#include "Common-Include.hs"
--- This file contains code that is required in the case of the module
--- System.Console.ANSI.Windows.Emulator and differs from the common code in
--- file Common-Include-Enabled.hs.
-#include "Common-Include-Emulator.hs"
-
-withHandle :: Handle -> (HANDLE -> IO a) -> IO a
-withHandle handle action = do
-  -- It's VERY IMPORTANT that we flush before issuing any sort of Windows API
-  -- call to change the console because on Windows the arrival of
-  -- API-initiated state changes is not necessarily synchronised with that of
-  -- the text they are attempting to modify.
-  hFlush handle
-  withHandleToHANDLE handle action
-
--- Unfortunately, the emulator is not perfect. In particular, it has a tendency
--- to die with exceptions about invalid handles when it is used with certain
--- Windows consoles (e.g. mintty, terminator, or cygwin sshd).
---
--- This happens because in those environments the stdout family of handles are
--- not actually associated with a real console.
---
--- My observation is that every time I've seen this in practice, the handle we
--- have instead of the actual console handle is there so that the terminal
--- supports ANSI escape codes. So 99% of the time, the correct thing to do is
--- just to fall back on the Unix module to output the ANSI codes and hope for
--- the best.
-emulatorFallback :: IO a -> IO a -> IO a
-emulatorFallback fallback first_try
-  = catchJust invalidHandle first_try (const fallback)
- where
-  invalidHandle (ConsoleException 6) = Just ()  -- 6 is the Windows error code
-                                                -- for invalid handles
-  invalidHandle (_)                  = Nothing
-
-adjustCursorPosition :: HANDLE
-                     -> (SHORT -> SHORT -> SHORT)
-                     -> (SHORT -> SHORT -> SHORT)
-                     -> IO ()
-adjustCursorPosition handle change_x change_y = do
-  screen_buffer_info <- getConsoleScreenBufferInfo handle
-  let window = csbi_window screen_buffer_info
-      l = rect_left window
-      t = rect_top window
-      r = rect_right window
-      b = rect_bottom window
-      (COORD x y) = csbi_cursor_position screen_buffer_info
-      clamp mn mx = max mn . min mx
-      x' = clamp l r (change_x l x)
-      y' = clamp t b (change_y t y)
-      cursor_pos' = COORD x' y'
-  setConsoleCursorPosition handle cursor_pos'
-
-hCursorUp h n
-  = emulatorFallback (Unix.hCursorUp h n) $ withHandle h $
-      \handle -> adjustCursorPosition handle (\_ x -> x)
-                   (\_ y -> y - fromIntegral n)
-hCursorDown h n
-  = emulatorFallback (Unix.hCursorDown h n) $ withHandle h $
-      \handle -> adjustCursorPosition handle (\_ x -> x)
-                   (\_ y -> y + fromIntegral n)
-hCursorForward h n
-  = emulatorFallback (Unix.hCursorForward h n) $ withHandle h $
-      \handle -> adjustCursorPosition handle (\_ x -> x + fromIntegral n)
-                   (\_ y -> y)
-hCursorBackward h n
-  = emulatorFallback (Unix.hCursorBackward h n) $ withHandle h $
-      \handle -> adjustCursorPosition handle (\_ x -> x - fromIntegral n)
-                   (\_ y -> y)
-
-adjustLine :: HANDLE -> (SHORT -> SHORT -> SHORT) -> IO ()
-adjustLine handle change_y
-  = adjustCursorPosition handle (\window_left _ -> window_left) change_y
-
-hCursorDownLine h n
-  = emulatorFallback (Unix.hCursorDownLine h n) $ withHandle h $
-      \handle -> adjustLine handle (\_ y -> y + fromIntegral n)
-
-hCursorUpLine h n
-  = emulatorFallback (Unix.hCursorUpLine h n) $ withHandle h $
-      \handle -> adjustLine handle (\_ y -> y - fromIntegral n)
-
-hSetCursorColumn h x
-  = emulatorFallback (Unix.hSetCursorColumn h x) $ withHandle h $
-      \handle -> adjustCursorPosition handle
-                   (\window_left _ -> window_left + fromIntegral x) (\_ y -> y)
-
-hSetCursorPosition h y x
-  = emulatorFallback (Unix.hSetCursorPosition h y x) $ withHandle h $
-      \handle -> adjustCursorPosition handle
-                   (\window_left _ -> window_left + fromIntegral x)
-                   (\window_top _ -> window_top + fromIntegral y)
-
-clearChar :: WCHAR
-clearChar = charToWCHAR ' '
-
--- | The 'clear' attribute is equated with the default background attributes.
-clearAttribute :: ConsoleDefaultState -> WORD
-clearAttribute = defaultBackgroundAttributes
-
-hClearScreenFraction
-  :: ConsoleDefaultState
-  -> HANDLE
-  -> (SMALL_RECT -> COORD -> (SHORT, SHORT, SHORT, SHORT, SHORT, SHORT))
-  -> IO ()
-hClearScreenFraction cds handle fraction_finder = do
-  screen_buffer_info <- getConsoleScreenBufferInfo handle
-  let window = csbi_window screen_buffer_info
-      cursor_pos = csbi_cursor_position screen_buffer_info
-      (left, top, right, bottom, start_x, end_x)
-          = fraction_finder window cursor_pos
-  mapM_ (fill_line left top right bottom start_x end_x) [top .. bottom]
- where
-  fill_line left top right bottom start_x end_x y = do
-    let left'  = if y == top    then start_x else left
-        right' = if y == bottom then end_x   else right
-        fill_cursor_pos = COORD left' y
-        fill_length = fromIntegral $ right' - left' + 1
-    _ <- fillConsoleOutputCharacter handle clearChar fill_length fill_cursor_pos
-    fillConsoleOutputAttribute handle (clearAttribute cds) fill_length
-      fill_cursor_pos
-
-hClearFromCursorToScreenEnd cds h
-  = emulatorFallback (Unix.hClearFromCursorToScreenEnd h) $ withHandle h $
-      \handle -> hClearScreenFraction cds handle go
- where
-  go window cursor_pos = (left, top, right, bottom, start_x, right)
-   where
-    SMALL_RECT (COORD left _) (COORD right bottom) = window
-    COORD start_x top = cursor_pos
-
-hClearFromCursorToScreenBeginning cds h
-  = emulatorFallback (Unix.hClearFromCursorToScreenBeginning h) $ withHandle h $
-      \handle -> hClearScreenFraction cds handle go
- where
-  go window cursor_pos = (left, top, right, bottom, left, end_x)
-   where
-    SMALL_RECT (COORD left top) (COORD right _) = window
-    COORD end_x bottom = cursor_pos
-
-hClearScreen cds h
-  = emulatorFallback (Unix.hClearScreen h) $ withHandle h $
-      \handle -> hClearScreenFraction cds handle go
- where
-  go window _ = (left, top, right, bottom, left, right)
-   where
-    SMALL_RECT (COORD left top) (COORD right bottom) = window
-
-hClearFromCursorToLineEnd cds h
-  = emulatorFallback (Unix.hClearFromCursorToLineEnd h) $ withHandle h $
-      \handle -> hClearScreenFraction cds handle go
- where
-  go window cursor_pos = (left, y, right, y, start_x, right)
-   where
-    SMALL_RECT (COORD left _) (COORD right _) = window
-    COORD start_x y = cursor_pos
-
-hClearFromCursorToLineBeginning cds h
-  = emulatorFallback (Unix.hClearFromCursorToLineBeginning h) $ withHandle h $
-        \handle -> hClearScreenFraction cds handle go
- where
-  go window cursor_pos = (left, y, right, y, left, end_x)
-   where
-    SMALL_RECT (COORD left _) (COORD right _) = window
-    COORD end_x y = cursor_pos
-
-hClearLine cds h
-  = emulatorFallback (Unix.hClearLine h) $ withHandle h $
-      \handle -> hClearScreenFraction cds handle go
- where
-  go window cursor_pos = (left, y, right, y, left, right)
-   where
-    SMALL_RECT (COORD left _) (COORD right _) = window
-    COORD _ y = cursor_pos
-
-hScrollPage
-  :: ConsoleDefaultState -- ^ The default console state
-  -> HANDLE
-  -> Int
-  -> IO ()
-hScrollPage cds handle new_origin_y = do
-  screen_buffer_info <- getConsoleScreenBufferInfo handle
-  let fill = CHAR_INFO clearChar (clearAttribute cds)
-      window = csbi_window screen_buffer_info
-      origin = COORD (rect_left window)
-                     (rect_top window + fromIntegral new_origin_y)
-  scrollConsoleScreenBuffer handle window Nothing origin fill
-
-hScrollPageUp cds h n
-  = emulatorFallback (Unix.hScrollPageUp h n) $ withHandle h $
-      \handle -> hScrollPage cds handle (negate n)
-
-hScrollPageDown cds h n
-  = emulatorFallback (Unix.hScrollPageDown h n) $ withHandle h $
-      \handle -> hScrollPage cds handle n
-
-hUseAlternateScreenBuffer _ = pure ()
-hUseNormalScreenBuffer _ = pure ()
-
-{-# INLINE applyANSIColorToAttribute #-}
-applyANSIColorToAttribute :: WORD -> WORD -> WORD -> Color -> WORD -> WORD
-applyANSIColorToAttribute rED gREEN bLUE color attribute = case color of
-  Black   -> attribute'
-  Red     -> attribute' .|. rED
-  Green   -> attribute' .|. gREEN
-  Yellow  -> attribute' .|. rED .|. gREEN
-  Blue    -> attribute' .|. bLUE
-  Magenta -> attribute' .|. rED .|. bLUE
-  Cyan    -> attribute' .|. gREEN .|. bLUE
-  White   -> attribute' .|. wHITE
- where
-  wHITE = rED .|. gREEN .|. bLUE
-  attribute' = attribute .&. (complement wHITE)
-
-applyForegroundANSIColorToAttribute, applyBackgroundANSIColorToAttribute
-  :: Color
-  -> WORD
-  -> WORD
-applyForegroundANSIColorToAttribute
-  = applyANSIColorToAttribute fOREGROUND_RED fOREGROUND_GREEN fOREGROUND_BLUE
-applyBackgroundANSIColorToAttribute
-  = applyANSIColorToAttribute bACKGROUND_RED bACKGROUND_GREEN bACKGROUND_BLUE
-
-swapForegroundBackgroundColors :: WORD -> WORD
-swapForegroundBackgroundColors attribute
-  = clean_attribute .|. foreground_attribute' .|. background_attribute'
- where
-  foreground_attribute = attribute .&. fOREGROUND_INTENSE_WHITE
-  background_attribute = attribute .&. bACKGROUND_INTENSE_WHITE
-  clean_attribute = attribute .&. complement
-    (fOREGROUND_INTENSE_WHITE .|. bACKGROUND_INTENSE_WHITE)
-  foreground_attribute' = background_attribute `shiftR` 4
-  background_attribute' = foreground_attribute `shiftL` 4
-
-applyANSISGRToAttribute :: WORD -> SGR -> WORD -> WORD
-applyANSISGRToAttribute def sgr attribute = case sgr of
-  Reset -> def
-  SetDefaultColor Foreground ->
-    (attribute .&. complement fOREGROUND_INTENSE_WHITE) .|.
-    (def .&. fOREGROUND_INTENSE_WHITE)
-  SetDefaultColor Background ->
-    (attribute .&. complement bACKGROUND_INTENSE_WHITE) .|.
-    (def .&. bACKGROUND_INTENSE_WHITE)
-  SetConsoleIntensity intensity -> case intensity of
-    BoldIntensity   -> attribute .|. iNTENSITY
-    FaintIntensity  -> attribute .&. (complement iNTENSITY) -- Not supported
-    NormalIntensity -> attribute .&. (complement iNTENSITY)
-  SetItalicized _ -> attribute -- Not supported
-  SetUnderlining underlining -> case underlining of
-    NoUnderline -> attribute .&. (complement cOMMON_LVB_UNDERSCORE)
-    _           -> attribute .|. cOMMON_LVB_UNDERSCORE -- Not supported, since
-    -- cOMMON_LVB_UNDERSCORE seems to have no effect
-  SetBlinkSpeed _ -> attribute -- Not supported
-  SetVisible _    -> attribute -- Not supported
-  -- The cOMMON_LVB_REVERSE_VIDEO doesn't actually appear to have any affect
-  -- on the colors being displayed, so the emulator just uses it to carry
-  -- information and implements the color-swapping behaviour itself. Bit of a
-  -- hack, I guess :-)
-  SetSwapForegroundBackground True ->
-    -- Check if the color-swapping flag is already set
-    if attribute .&. cOMMON_LVB_REVERSE_VIDEO /= 0
-      then attribute
-      else swapForegroundBackgroundColors attribute .|. cOMMON_LVB_REVERSE_VIDEO
-  SetSwapForegroundBackground False ->
-    -- Check if the color-swapping flag is already not set
-    if attribute .&. cOMMON_LVB_REVERSE_VIDEO == 0
-      then attribute
-      else swapForegroundBackgroundColors attribute .&.
-          (complement cOMMON_LVB_REVERSE_VIDEO)
-  SetColor Foreground Dull color  -> applyForegroundANSIColorToAttribute color
-    (attribute .&. (complement fOREGROUND_INTENSITY))
-  SetColor Foreground Vivid color -> applyForegroundANSIColorToAttribute color
-    (attribute .|. fOREGROUND_INTENSITY)
-  SetColor Background Dull color  -> applyBackgroundANSIColorToAttribute color
-    (attribute .&. (complement bACKGROUND_INTENSITY))
-  SetColor Background Vivid color -> applyBackgroundANSIColorToAttribute color
-    (attribute .|. bACKGROUND_INTENSITY)
-  SetRGBColor Foreground color ->
-    let (colorIntensity, aNSIColor) = toANSIColor color
-        attribute' = case colorIntensity of
-          Dull  -> attribute .&. complement fOREGROUND_INTENSITY
-          Vivid -> attribute .|. fOREGROUND_INTENSITY
-    in applyForegroundANSIColorToAttribute aNSIColor attribute'
-  SetRGBColor Background color ->
-    let (colorIntensity, aNSIColor) = toANSIColor color
-        attribute' = case colorIntensity of
-          Dull  -> attribute .&. complement bACKGROUND_INTENSITY
-          Vivid -> attribute .|. bACKGROUND_INTENSITY
-    in applyBackgroundANSIColorToAttribute aNSIColor attribute'
-  SetPaletteColor _ _ -> attribute  -- Not supported
- where
-  iNTENSITY = fOREGROUND_INTENSITY
-
-hSetSGR cds h sgr
-  = emulatorFallback (Unix.hSetSGR h sgr) $ withHandle h $ \handle -> do
-      screen_buffer_info <- getConsoleScreenBufferInfo handle
-      let attribute  = csbi_attributes screen_buffer_info
-          def        =     defaultForegroundAttributes cds
-                       .|. defaultBackgroundAttributes cds
-          attribute' = foldl' (flip $ applyANSISGRToAttribute def) attribute
-            -- make [] equivalent to [Reset], as documented
-            (if null sgr then [Reset] else sgr)
-      setConsoleTextAttribute handle attribute'
-
-hChangeCursorVisibility :: HANDLE -> Bool -> IO ()
-hChangeCursorVisibility handle cursor_visible = do
-  cursor_info <- getConsoleCursorInfo handle
-  setConsoleCursorInfo handle
-    (cursor_info { cci_cursor_visible = cursor_visible })
-
-hHideCursor h
-  = emulatorFallback (Unix.hHideCursor h) $ withHandle h $
-      \handle -> hChangeCursorVisibility handle False
-hShowCursor h
-  = emulatorFallback (Unix.hShowCursor h) $ withHandle h $
-      \handle -> hChangeCursorVisibility handle True
-
-hHyperlinkWithParams h _ _ = hPutStr h
-
--- Windows only supports setting the terminal title on a process-wide basis, so
--- for now we will assume that that is what the user intended. This will fail if
--- they are sending the command over e.g. a network link... but that's not
--- really what I'm designing for.
-hSetTitle h title
-  = emulatorFallback (Unix.hSetTitle h title) $
-      withTString (filter isPrint title) setConsoleTitle
-
-cursorPositionRef :: IORef (Map.Map HANDLE COORD)
-{-# NOINLINE cursorPositionRef #-}
-cursorPositionRef = unsafePerformIO $ newIORef Map.empty
-
-hSaveCursor h
-  = emulatorFallback (Unix.hSaveCursor h) $ withHandle h $ \handle -> do
-      screen_buffer_info <- getConsoleScreenBufferInfo handle
-      m <- readIORef cursorPositionRef
-      writeIORef cursorPositionRef
-        (Map.insert handle (csbi_cursor_position screen_buffer_info) m)
-
-hRestoreCursor h
-  = emulatorFallback (Unix.hRestoreCursor h) $ withHandle h $ \handle -> do
-      m <- readIORef cursorPositionRef
-      let result = Map.lookup handle m
-      maybe (pure ()) (setConsoleCursorPosition handle) result
-
-hReportCursorPosition h
-  = emulatorFallback (Unix.hReportCursorPosition h) $ withHandle h $
-      \handle -> do
-        result <- getConsoleScreenBufferInfo handle
-        let (COORD cx cy) = csbi_cursor_position result
-            window = csbi_window result
-            x = cx - rect_left window + 1
-            y = cy - rect_top window + 1
-        hIn <- getStdHandle sTD_INPUT_HANDLE
-        _ <- writeConsoleInput hIn $ keyPresses $
-            "\ESC[" ++ show y ++ ";" ++ show x ++ "R"
-        pure ()
-
-hReportLayerColor h layer
-  = emulatorFallback (Unix.hReportLayerColor h layer) $ withHandle h $
-      \handle -> do
-        result <- getConsoleScreenBufferInfoEx handle
-        let attributes = csbix_attributes result
-            colorTable = csbix_color_table result
-            fgRef = attributes .&. fOREGROUND_INTENSE_WHITE
-            bgRef = shiftR (attributes .&. bACKGROUND_INTENSE_WHITE) 4
-            fgColor = colorTable !! fromIntegral fgRef
-            bgColor = colorTable !! fromIntegral bgRef
-            (oscCode, color) = case layer of
-              Foreground -> ("10", fgColor)
-              Background -> ("11", bgColor)
-            r = shiftL (color .&. 0xFF) 8
-            g = color .&. 0xFF00
-            b = shiftR (color .&. 0xFF0000) 8
-            report = printf "\ESC]%s;rgb:%04x/%04x/%04x\ESC\\" oscCode r g b
-        hIn <- getStdHandle sTD_INPUT_HANDLE
-        _ <- writeConsoleInput hIn $ keyPresses report
-        pure ()
-
-keyPress :: Char -> [INPUT_RECORD]
-keyPress c = [keyDown, keyUp]
- where
-  keyDown = key True
-  keyUp   = key False
-  c' = UnicodeAsciiChar $ charToWCHAR c
-  key isDown = INPUT_RECORD kEY_EVENT $
-    InputKeyEvent (KEY_EVENT_RECORD isDown 1 0 0 c' 0)
-
-keyPresses :: String -> [INPUT_RECORD]
-keyPresses = concatMap keyPress
-
-aNSIColors :: [((ColorIntensity, Color), Colour Float)]
-aNSIColors = [ ((Dull,  Black),   black)
-             , ((Dull,  Blue),    navy)
-             , ((Dull,  Green),   green)
-             , ((Dull,  Cyan),    teal)
-             , ((Dull,  Red),     maroon)
-             , ((Dull,  Magenta), purple)
-             , ((Dull,  Yellow),  olive)
-             , ((Dull,  White),   silver)
-             , ((Vivid, Black),   grey)
-             , ((Vivid, Blue),    blue)
-             , ((Vivid, Green),   lime)
-             , ((Vivid, Cyan),    cyan)
-             , ((Vivid, Red),     red)
-             , ((Vivid, Magenta), magenta)
-             , ((Vivid, Yellow),  yellow)
-             , ((Vivid, White),   white) ]
-
-toANSIColor :: Colour Float -> (ColorIntensity, Color)
-toANSIColor color = fst $ minimumBy order aNSIColors
- where
-  RGB r g b = toSRGB color
-  order (_, c1) (_, c2) = compare (dist c1) (dist c2)
-  dist c = let RGB r' g' b' = toSRGB c
-               dr = r' - r
-               dg = g' - g
-               db = b' - b
-           in  dr * dr + dg * dg + db * db
-
--- hSupportsANSI :: Handle -> IO Bool
--- (See Common-Include.hs for Haddock documentation)
-hSupportsANSI h = (||) <$> isTDNotDumb h <*> isMinTTY
- where
-  isMinTTY = withHandleToHANDLE h isMinTTYHandle
-
--- hSupportsANSIWithoutEmulation :: Handle -> IO (Maybe Bool)
--- (See Common-Include.hs for Haddock documentation)
-hSupportsANSIWithoutEmulation handle = do
-  supportsANSI <- detectHandleSupportsANSI handle  -- Without reference to the
-                                                   -- environment
-  case supportsANSI of
-    Just isSupported -> pure (Just isSupported)
-    Nothing -> do  -- Not sure, based on the handle alone
-      notDumb <- isNotDumb  -- Test the environment
-      if notDumb
-        then pure Nothing  -- Still not sure!
-        else pure (Just False) -- A dumb terminal
-
--- Borrowed from an HSpec patch by Simon Hengel
--- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd)
-isTDNotDumb :: Handle -> IO Bool
-isTDNotDumb h = (&&) <$> hIsTerminalDevice h <*> isNotDumb
-
--- Borrowed from an HSpec patch by Simon Hengel
--- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd)
-isNotDumb :: IO Bool
--- cannot use lookupEnv since it only appeared in GHC 7.6
-isNotDumb = (/= Just "dumb") . lookup "TERM" <$> getEnvironment
-
--- getReportedCursorPosition :: IO String
--- (See Common-Include.hs for Haddock documentation)
-getReportedCursorPosition = getReported
-
-getReported :: IO String
-getReported = CE.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
-
--- hGetCursorPosition :: Handle -> IO (Maybe (Int, Int))
--- (See Common-Include.hs for Haddock documentation)
-hGetCursorPosition h = fmap to0base <$> getCursorPosition'
- where
-  to0base (row, col) = (row - 1, col - 1)
-  getCursorPosition' =
-    hGetReport h hReportCursorPosition getReportedCursorPosition cursorPosition
-
-hGetReport :: Handle
-           -> (Handle -> IO ())
-           -> IO String -> ReadP a -> IO (Maybe a)
-hGetReport h report get parse =
-  CE.catch getReport getReportedExceptionHandler
-   where
-    getReport = do
-      withHandleToHANDLE stdin flush -- Flush the console input buffer
-      report h
-      hFlush h -- ensure the report cursor position code is sent to the
-               -- operating system
-      input <- get
-      case readP_to_S parse input of
-        [] -> pure Nothing
-        [(value,_)] -> pure $ Just value
-        (_:_) -> pure Nothing
-     where
-      flush hdl = do
-        n <- getNumberOfConsoleInputEvents hdl
-        unless (n == 0) (void $ readConsoleInput hdl n)
-
-
--- getReportedLayerColor :: ConsoleLayer -> IO String
---(See Common-Include.hs for Haddock documentation)
-getReportedLayerColor _ = getReported
-
-hGetLayerColor h layer = hGetReport h
-  (`hReportLayerColor` layer) (getReportedLayerColor layer) (layerColor layer)
-
-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."
− src/System/Console/ANSI/Windows/Emulator/Codes.hs 
@@ -1,131 +0,0 @@-#include "Common-Safe-Haskell.hs"
-{-# OPTIONS_HADDOCK hide #-}
-
-module System.Console.ANSI.Windows.Emulator.Codes
-  (
-    -- * Cursor movement by character
-    cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode
-
-    -- * Cursor movement by line
-  , cursorUpLineCode, cursorDownLineCode
-
-    -- * Directly changing cursor position
-  , setCursorColumnCode, setCursorPositionCode
-
-    -- * Saving, restoring and reporting cursor position
-  , saveCursorCode, restoreCursorCode, reportCursorPositionCode
-
-    -- * Clearing parts of the screen
-  , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode
-  , clearScreenCode, clearFromCursorToLineEndCode
-  , clearFromCursorToLineBeginningCode, clearLineCode
-
-    -- * Scrolling the screen
-  , scrollPageUpCode, scrollPageDownCode
-
-    -- * Using screen buffers
-  , useAlternateScreenBufferCode, useNormalScreenBufferCode
-
-    -- * Reporting background and foreground colors
-  , reportLayerColorCode
-
-    -- * Select Graphic Rendition mode: colors and other whizzy stuff
-  , setSGRCode
-
-    -- * Cursor visibilty changes
-  , hideCursorCode, showCursorCode
-
-    -- * Hyperlinks
-  , hyperlinkCode, hyperlinkWithIdCode, hyperlinkWithParamsCode
-
-    -- * Changing the title
-  , setTitleCode
-  ) where
-
-import System.Console.ANSI.Types
-
-cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode
-  :: Int -- ^ Number of lines or characters to move
-  -> String
-cursorUpCode _       = ""
-cursorDownCode _     = ""
-cursorForwardCode _  = ""
-cursorBackwardCode _ = ""
-
-cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move
-                                     -> String
-cursorDownLineCode _ = ""
-cursorUpLineCode _   = ""
-
-setCursorColumnCode :: Int -- ^ 0-based column to move to
-                    -> String
-setCursorColumnCode _ = ""
-
-setCursorPositionCode :: Int -- ^ 0-based row to move to
-                      -> Int -- ^ 0-based column to move to
-                      -> String
-setCursorPositionCode _ _ = ""
-
-saveCursorCode, restoreCursorCode, reportCursorPositionCode :: String
-saveCursorCode = ""
-restoreCursorCode = ""
-reportCursorPositionCode = ""
-
-clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode,
-  clearScreenCode :: String
-clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode,
-  clearLineCode :: String
-
-clearFromCursorToScreenEndCode       = ""
-clearFromCursorToScreenBeginningCode = ""
-clearScreenCode                      = ""
-clearFromCursorToLineEndCode         = ""
-clearFromCursorToLineBeginningCode   = ""
-clearLineCode                        = ""
-
-scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by
-                                     -> String
-scrollPageUpCode _   = ""
-scrollPageDownCode _ = ""
-
-useAlternateScreenBufferCode, useNormalScreenBufferCode :: String
-useAlternateScreenBufferCode = ""
-useNormalScreenBufferCode      = ""
-
-reportLayerColorCode :: ConsoleLayer -> String
-reportLayerColorCode _ = ""
-
-setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the
-                    -- current console SGR mode. An empty list of commands is
-                    -- equivalent to the list @[Reset]@. Commands are applied
-                    -- left to right.
-           -> String
-setSGRCode _ = ""
-
-hideCursorCode, showCursorCode :: String
-hideCursorCode = ""
-showCursorCode = ""
-
-hyperlinkWithParamsCode
-  :: ([(String, String)])
-  -> String
-  -> String
-  -> String
-hyperlinkWithParamsCode _ _ _ = ""
-
-hyperlinkCode
-  :: String
-  -> String
-  -> String
-hyperlinkCode _ _ = ""
-
-hyperlinkWithIdCode
-  :: String
-  -> String
-  -> String
-  -> String
-hyperlinkWithIdCode _ _ _ = ""
-
-setTitleCode :: String -- ^ New title
-             -> String
-setTitleCode _ = ""
− src/System/Console/ANSI/Windows/Foreign.hs 
@@ -1,731 +0,0 @@-#include "Common-Safe-Haskell.hs"
-{-# OPTIONS_HADDOCK hide        #-}
-{-# LANGUAGE RankNTypes         #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
-{-| "System.Win32.Console" is really very impoverished, so I have had to do all
-the FFI myself.
--}
-module System.Console.ANSI.Windows.Foreign
-  (
-    -- Re-exports from Win32.Types
-    BOOL, WORD, DWORD, WCHAR, HANDLE, iNVALID_HANDLE_VALUE, nullHANDLE, SHORT,
-
-    -- 'Re-exports from System.Win32.Console.Extra'
-    INPUT_RECORD (..), INPUT_RECORD_EVENT (..), kEY_EVENT,
-    KEY_EVENT_RECORD (..), UNICODE_ASCII_CHAR (..), writeConsoleInput,
-    getNumberOfConsoleInputEvents, readConsoleInput,
-
-    charToWCHAR, cWcharsToChars,
-
-    COLORREF, COORD(..), SMALL_RECT(..), rect_top, rect_bottom, rect_left,
-    rect_right, rect_width, rect_height, CONSOLE_CURSOR_INFO(..),
-    CONSOLE_SCREEN_BUFFER_INFO(..), CONSOLE_SCREEN_BUFFER_INFOEX(..),
-    CHAR_INFO(..),
-
-    sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE,
-
-    eNABLE_VIRTUAL_TERMINAL_INPUT, eNABLE_VIRTUAL_TERMINAL_PROCESSING,
-
-    fOREGROUND_BLUE, fOREGROUND_GREEN, fOREGROUND_RED, fOREGROUND_INTENSITY,
-    fOREGROUND_WHITE, fOREGROUND_INTENSE_WHITE,
-    bACKGROUND_BLUE, bACKGROUND_GREEN, bACKGROUND_RED, bACKGROUND_INTENSITY,
-    bACKGROUND_WHITE, bACKGROUND_INTENSE_WHITE,
-    cOMMON_LVB_REVERSE_VIDEO, cOMMON_LVB_UNDERSCORE,
-
-    getStdHandle,
-    getConsoleScreenBufferInfo,
-    getConsoleScreenBufferInfoEx,
-    getConsoleCursorInfo,
-    getConsoleMode,
-
-    setConsoleTextAttribute,
-    setConsoleCursorPosition,
-    setConsoleCursorInfo,
-    setConsoleTitle,
-    setConsoleMode,
-
-    fillConsoleOutputAttribute,
-    fillConsoleOutputCharacter,
-    scrollConsoleScreenBuffer,
-
-    withTString, withHandleToHANDLE,
-
-    ConsoleException (..)
-  ) where
-
-import Control.Exception (Exception, throw)
-import Data.Bits ((.|.), shiftL)
-import Data.Char (chr, ord)
-import Data.Typeable (Typeable)
-import Data.Word (Word32)
-import Foreign.C.Types (CInt (..), CWchar (..))
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Array (allocaArray, peekArray, pokeArray, withArrayLen)
-import Foreign.Marshal.Utils (maybeWith, with)
-import Foreign.Ptr (Ptr, castPtr, plusPtr)
-import Foreign.Storable (Storable (..))
--- `SHORT` and `withHandleToHANDLE` are not both available before Win32-2.5.1.0
-import System.Win32.Compat (BOOL, DWORD, ErrCode, HANDLE, LPCTSTR, LPDWORD,
-  SHORT, TCHAR, UINT, ULONG, WORD, failIfFalse_, getLastError, iNVALID_HANDLE_VALUE,
-  nullHANDLE, withHandleToHANDLE, withTString)
-
-#if defined(i386_HOST_ARCH)
-#define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-#define WINDOWS_CCONV ccall
-#else
-#error Unknown mingw32 arch
-#endif
-
-type WCHAR = CWchar
-
-charToWCHAR :: Char -> WCHAR
-charToWCHAR char = fromIntegral (ord char)
-
--- This is a FFI hack. Some of the API calls take a Coord, but that isn't a
--- built-in FFI type so I can't use it directly. Instead, I use UNPACKED_COORD
--- and marshal COORDs into this manually. Note that we CAN'T just use two SHORTs
--- directly because they get expanded to 4 bytes each instead of just boing 2
--- lots of 2 bytes by the stdcall convention, so linking fails.
-type UNPACKED_COORD = CInt
-
--- Field packing order determined experimentally: I couldn't immediately find a
--- specification for Windows struct layout anywhere.
-unpackCOORD :: COORD -> UNPACKED_COORD
-unpackCOORD (COORD x y)
-  = (fromIntegral y) `shiftL` (sizeOf x * 8) .|. (fromIntegral x)
-
-
-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
-  { rect_top_left     :: COORD
-  , rect_bottom_right :: COORD
-  }
-
-rect_top, rect_left, rect_bottom, rect_right :: SMALL_RECT -> SHORT
-rect_top = coord_y . rect_top_left
-rect_left = coord_x . rect_top_left
-rect_bottom = coord_y . rect_bottom_right
-rect_right = coord_x . rect_bottom_right
-
-rect_width, rect_height :: SMALL_RECT -> SHORT
-rect_width rect = rect_right rect - rect_left rect + 1
-rect_height rect = rect_bottom rect - rect_top rect + 1
-
-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
-
-eNABLE_VIRTUAL_TERMINAL_INPUT, eNABLE_VIRTUAL_TERMINAL_PROCESSING :: DWORD
-sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE :: DWORD
-eNABLE_VIRTUAL_TERMINAL_INPUT      = 512
-eNABLE_VIRTUAL_TERMINAL_PROCESSING =   4
-sTD_INPUT_HANDLE  = 0xFFFFFFF6 -- minus 10
-sTD_OUTPUT_HANDLE = 0xFFFFFFF5 -- minus 11
-sTD_ERROR_HANDLE  = 0xFFFFFFF4 -- minus 12
-
-fOREGROUND_BLUE, fOREGROUND_GREEN, fOREGROUND_RED, fOREGROUND_INTENSITY,
-  bACKGROUND_BLUE, bACKGROUND_GREEN, bACKGROUND_RED, bACKGROUND_INTENSITY,
-  cOMMON_LVB_REVERSE_VIDEO, cOMMON_LVB_UNDERSCORE :: WORD
-fOREGROUND_BLUE          =    0x1
-fOREGROUND_GREEN         =    0x2
-fOREGROUND_RED           =    0x4
-fOREGROUND_INTENSITY     =    0x8
-bACKGROUND_BLUE          =   0x10
-bACKGROUND_GREEN         =   0x20
-bACKGROUND_RED           =   0x40
-bACKGROUND_INTENSITY     =   0x80
-cOMMON_LVB_REVERSE_VIDEO = 0x4000
-cOMMON_LVB_UNDERSCORE    = 0x8000
-
-fOREGROUND_WHITE, bACKGROUND_WHITE, fOREGROUND_INTENSE_WHITE,
-  bACKGROUND_INTENSE_WHITE :: WORD
-fOREGROUND_WHITE = fOREGROUND_RED .|. fOREGROUND_GREEN .|. fOREGROUND_BLUE
-bACKGROUND_WHITE = bACKGROUND_RED .|. bACKGROUND_GREEN .|. bACKGROUND_BLUE
-fOREGROUND_INTENSE_WHITE = fOREGROUND_WHITE .|. fOREGROUND_INTENSITY
-bACKGROUND_INTENSE_WHITE = bACKGROUND_WHITE .|. bACKGROUND_INTENSITY
-
-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 WINDOWS_CCONV unsafe "windows.h GetStdHandle"
-  getStdHandle :: DWORD -> IO HANDLE
-foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleScreenBufferInfo"
-  cGetConsoleScreenBufferInfo :: HANDLE
-                              -> Ptr CONSOLE_SCREEN_BUFFER_INFO
-                              -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleScreenBufferInfoEx"
-  cGetConsoleScreenBufferInfoEx :: HANDLE
-                                -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX
-                                -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCursorInfo"
-  cGetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode"
-  cGetConsoleMode :: HANDLE -> Ptr DWORD -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleTextAttribute"
-  cSetConsoleTextAttribute :: HANDLE -> WORD -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCursorPosition"
-  cSetConsoleCursorPosition :: HANDLE -> UNPACKED_COORD -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCursorInfo"
-  cSetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleTitleW"
-  cSetConsoleTitle :: LPCTSTR -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleMode"
-  cSetConsoleMode :: HANDLE -> DWORD -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h FillConsoleOutputAttribute"
-  cFillConsoleOutputAttribute :: HANDLE
-                              -> WORD
-                              -> DWORD
-                              -> UNPACKED_COORD
-                              -> Ptr DWORD
-                              -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h FillConsoleOutputCharacterW"
-  cFillConsoleOutputCharacter :: HANDLE
-                              -> TCHAR
-                              -> DWORD
-                              -> UNPACKED_COORD
-                              -> Ptr DWORD
-                              -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h ScrollConsoleScreenBufferW"
-  cScrollConsoleScreenBuffer :: HANDLE
-                             -> Ptr SMALL_RECT
-                             -> Ptr SMALL_RECT
-                             -> UNPACKED_COORD
-                             -> Ptr CHAR_INFO
-                             -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h WriteConsoleInputW"
-  cWriteConsoleInput :: HANDLE
-                     -> Ptr INPUT_RECORD
-                     -> DWORD
-                     -> LPDWORD
-                     -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "windows.h GetNumberOfConsoleInputEvents"
-  cGetNumberOfConsoleInputEvents :: HANDLE -> Ptr DWORD -> IO BOOL
-foreign import WINDOWS_CCONV 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
-
-throwIfFalse :: IO Bool -> IO ()
-throwIfFalse action = do
-  succeeded <- action
-  if not succeeded
-    then getLastError >>= throw . ConsoleException -- TODO: Check if last error
-    -- is zero for some instructable reason (?)
-    else pure ()
-
-getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO
-getConsoleScreenBufferInfo handle
-  = alloca $ \ptr_console_screen_buffer_info -> do
-      throwIfFalse $
-        cGetConsoleScreenBufferInfo handle ptr_console_screen_buffer_info
-      peek ptr_console_screen_buffer_info
-
-getConsoleScreenBufferInfoEx :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFOEX
-getConsoleScreenBufferInfoEx handle
-  = alloca $ \ptr_console_screen_buffer_infoex -> do
-      -- In the Windows Console API, the `CONSOLE_SCREEN_BUFFER_INFOEX`
-      -- structure passed to the `GetConsoleScreenBufferInfoEx` function must
-      -- include the size of the structure.
-      poke (castPtr ptr_console_screen_buffer_infoex) sizeCsbix
-      throwIfFalse $
-        cGetConsoleScreenBufferInfoEx handle ptr_console_screen_buffer_infoex
-      peek ptr_console_screen_buffer_infoex
-
-getConsoleCursorInfo :: HANDLE -> IO CONSOLE_CURSOR_INFO
-getConsoleCursorInfo handle = alloca $ \ptr_console_cursor_info -> do
-  throwIfFalse $ cGetConsoleCursorInfo handle ptr_console_cursor_info
-  peek ptr_console_cursor_info
-
-getConsoleMode :: HANDLE -> IO DWORD
-getConsoleMode handle = alloca $ \ptr_mode -> do
-  throwIfFalse $ cGetConsoleMode handle ptr_mode
-  peek ptr_mode
-
-setConsoleTextAttribute :: HANDLE -> WORD -> IO ()
-setConsoleTextAttribute handle attributes
-  = throwIfFalse $ cSetConsoleTextAttribute handle attributes
-
-setConsoleCursorPosition :: HANDLE -> COORD -> IO ()
-setConsoleCursorPosition handle cursor_position
-  = throwIfFalse $ cSetConsoleCursorPosition handle
-      (unpackCOORD cursor_position)
-
-setConsoleCursorInfo :: HANDLE -> CONSOLE_CURSOR_INFO -> IO ()
-setConsoleCursorInfo handle console_cursor_info
-  = with console_cursor_info $ \ptr_console_cursor_info -> do
-      throwIfFalse $ cSetConsoleCursorInfo handle ptr_console_cursor_info
-
-setConsoleTitle :: LPCTSTR -> IO ()
-setConsoleTitle title = throwIfFalse $ cSetConsoleTitle title
-
-setConsoleMode :: HANDLE -> DWORD -> IO ()
-setConsoleMode handle attributes
-  = throwIfFalse $ cSetConsoleMode handle attributes
-
-fillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> COORD -> IO DWORD
-fillConsoleOutputAttribute handle attribute fill_length write_origin
-  = alloca $ \ptr_chars_written -> do
-      throwIfFalse $ cFillConsoleOutputAttribute handle attribute
-        fill_length (unpackCOORD write_origin) ptr_chars_written
-      peek ptr_chars_written
-
-fillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> COORD -> IO DWORD
-fillConsoleOutputCharacter handle char fill_length write_origin
-  = alloca $ \ptr_chars_written -> do
-      throwIfFalse $ cFillConsoleOutputCharacter handle char fill_length
-        (unpackCOORD write_origin) ptr_chars_written
-      peek ptr_chars_written
-
-scrollConsoleScreenBuffer :: HANDLE
-                          -> SMALL_RECT
-                          -> Maybe SMALL_RECT
-                          -> COORD
-                          -> CHAR_INFO
-                          -> IO ()
-scrollConsoleScreenBuffer
-  handle scroll_rectangle mb_clip_rectangle destination_origin fill
-  = with scroll_rectangle $ \ptr_scroll_rectangle ->
-    maybeWith with mb_clip_rectangle $ \ptr_clip_rectangle ->
-    with fill $ \ptr_fill ->
-    throwIfFalse $ cScrollConsoleScreenBuffer handle ptr_scroll_rectangle
-      ptr_clip_rectangle (unpackCOORD destination_origin) ptr_fill
-
--- The following is based on module System.Win32.Console.Extra from package
--- Win32-console, cut down for the WCHAR version of writeConsoleInput.
-
-writeConsoleInput :: HANDLE -> [INPUT_RECORD] -> IO DWORD
-writeConsoleInput hdl evs
-  = writeConsoleInputWith hdl $ \act ->
-    withArrayLen evs $ \len ptr ->
-    act (ptr, toEnum len)
-
-writeConsoleInputWith :: HANDLE
-                      -> InputHandler (Ptr INPUT_RECORD, DWORD)
-                      -> IO DWORD
-writeConsoleInputWith hdl withBuffer
-  = returnWith_ $ \ptrN ->
-    withBuffer $ \(ptrBuf, len) ->
-    failIfFalse_ "WriteConsoleInputW" $ cWriteConsoleInput hdl ptrBuf len ptrN
-
-returnWith_ :: Storable a => (Ptr a -> IO b) -> IO a
-returnWith_ act = alloca $ \ptr -> act ptr >> peek ptr
-
-type InputHandler i = forall a. (i -> IO a) -> IO a
-
-{-
-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 [] = []
− src/System/Win32/Compat.hs 
@@ -1,178 +0,0 @@-#include "Common-Safe-Haskell.hs"
-{-# OPTIONS_HADDOCK hide #-}
-
-{-| The Win32 library ships with GHC. Win32-2.3.1.0 first shipped with
-GHC 7.10.1 (released March 2015). Win32-2.5.4.1 first shipped with GHC 8.2.1
-(released July 2017), replacing Win32-2.3.1.1.
-
-The ansi-terminal library makes use of functionality in Win32-2.3.1.0 and other
-functionality first added to Win32-2.5.0.0 or Win32-2.5.1.0 (from ansi-terminal
-itself).
-
-Win32-2.9.0.0 introduced support for the Windows I/O Manager, introduced with
-GHC 9.0.1. However, before Win32-2.13.2.0, this changed the behaviour of
-`withHandleFromHANDLE`.
-
-This module provides functions available in those later versions of Win32 to a
-wider range of compilers, reducing the use of CPP pragmas in other modules.
--}
-module System.Win32.Compat
-  (
-    BOOL
-  , DWORD
-  , ErrCode
-  , HANDLE
-  , LPCTSTR
-  , LPDWORD
-  , SHORT                -- from Win32-2.5.0.0
-  , TCHAR
-  , UINT
-  , ULONG                -- from Win32-2.5.0.0
-  , WORD
-  , failIfFalse_
-  , getLastError
-  , iNVALID_HANDLE_VALUE
-  , nullHANDLE
-  , withHandleToHANDLE   -- from Win32-2.5.1.0
-  , withTString
-  ) where
-
-import System.Win32.Types (BOOL, DWORD, ErrCode, HANDLE, LPCTSTR, LPDWORD,
-  TCHAR, UINT, WORD, failIfFalse_, getLastError, iNVALID_HANDLE_VALUE,
-  nullHANDLE, withTString)
-
--- Circumstancees in which the patching of Win32 package for the Windows I/O
--- Manager is required
-#if defined(__IO_MANAGER_WINIO__)&&MIN_VERSION_Win32(2,9,0)&&!MIN_VERSION_Win32(2,13,2)
-#define PATCHING_WIN32_PACKAGE_FOR_WINIO
-#endif
-
--- Circumstances in which the patching of Win32 package is required
-#if !MIN_VERSION_Win32(2,5,1)||defined(PATCHING_WIN32_PACKAGE_FOR_WINIO)
-#define PATCHING_WIN32_PACKAGE
-#endif
-
-#if !defined(PATCHING_WIN32_PACKAGE)
-
-import System.Win32.Types (SHORT, ULONG, withHandleToHANDLE)
-
-#else
-
-import Control.Concurrent.MVar (readMVar)
-import Control.Exception (bracket)
-import Data.Typeable (cast)
-import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr)
-import GHC.IO.Handle.Types (Handle (..), Handle__ (..))
-
-#if defined(PATCHING_WIN32_PACKAGE_FOR_WINIO)
-import GHC.IO.Exception (IOErrorType (InappropriateType), IOException (IOError),
-  ioException)
-import GHC.IO.SubSystem ((<!>))
-import GHC.IO.Windows.Handle (ConsoleHandle, Io, NativeHandle, toHANDLE)
-import System.Win32.Types (withHandleToHANDLEPosix)
-#endif
-
-#if !MIN_VERSION_Win32(2,5,0)
-import Foreign.C.Types (CShort (..))
-import Data.Word (Word32)
-#else
-import System.Win32.Types (SHORT, ULONG)
-#endif
-
-#if !MIN_VERSION_Win32(2,5,1)
-import Foreign.C.Types (CInt (..))
-import GHC.IO.FD (FD(..)) -- A wrapper around an Int32
-#endif
-
-#endif
-
-#if defined(PATCHING_WIN32_PACKAGE)
-
-#if !MIN_VERSION_Win32(2,5,0)
-type SHORT = CShort
-type ULONG = Word32
-#endif
-
-withStablePtr :: a -> (StablePtr a -> IO b) -> IO b
-withStablePtr value = bracket (newStablePtr value) freeStablePtr
-
-#if defined(PATCHING_WIN32_PACKAGE_FOR_WINIO)
-
-withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a
-withHandleToHANDLE = withHandleToHANDLEPosix <!> withHandleToHANDLENative
-
--- | `withHandleToHANDLENative` does not behave as expected for GHC option
--- -with-rtsopts=--io-manager=native when Win32 < 2.13.2. Taken from
--- package Win32-2.13.2.0 `System.Win32.Types.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
-
--- defined(__IO_MANAGER_WINIO__)&&!MIN_VERSION_Win32(2,13,2)
-#else
-
--- | This bit is all highly dubious. The problem is that we want to output ANSI
--- to arbitrary Handles rather than forcing people to use stdout.  However, the
--- Windows ANSI emulator needs a Windows HANDLE to work it's magic, so we need
--- to be able to extract one of those from the Haskell Handle.
---
--- This code accomplishes this, albeit at the cost of only being compatible with
--- GHC.
-withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a
-withHandleToHANDLE haskell_handle action =
-  -- Create a stable pointer to the Handle. This prevents the garbage collector
-  -- getting to it while we are doing horrible manipulations with it, and hence
-  -- stops it being finalized (and closed).
-  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 <- fmap (\(Handle__ { haDevice = dev }) ->
-      fmap fdFD (cast dev)) $ readMVar write_handle_mvar
-
-    -- Finally, turn that (C-land) FD into a HANDLE using msvcrt
-    windows_handle <- cget_osfhandle fd
-
-    -- Do what the user originally wanted
-    action windows_handle
-
-#if defined(i386_HOST_ARCH)
-#define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-#define WINDOWS_CCONV ccall
-#else
-#error Unknown mingw32 arch
-#endif
-
--- 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 WINDOWS_CCONV unsafe "_get_osfhandle"
-  cget_osfhandle :: CInt -> IO HANDLE
-
--- defined(PATCHING_WIN32_PACKAGE_FOR_WINIO)
-#endif
-
--- defined(PATCHING_WIN32_PACKAGE)
-#endif
− src/includes/Common-Include-Emulator.hs 
@@ -1,61 +0,0 @@--- This file contains code that is required in the case of the module
--- System.Console.ANSI.Windows.Emulator and differs from the common code in
--- file Common-Include-Enabled.hs.
-
--- | Set the Select Graphic Rendition mode
-hSetSGR
-  :: ConsoleDefaultState -- ^ The default console state
-  -> 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 ()
-
--- | Set the Select Graphic Rendition mode
-setSGR
-  :: ConsoleDefaultState -- ^ The default console state
-  -> [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 def = hSetSGR def stdout
-
-hClearFromCursorToScreenEnd, hClearFromCursorToScreenBeginning, hClearScreen
-  :: ConsoleDefaultState -- ^ The default console state
-  -> Handle
-  -> IO ()
-
-clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen
-  :: ConsoleDefaultState -- ^ The default console state
-  -> IO ()
-clearFromCursorToScreenEnd def = hClearFromCursorToScreenEnd def stdout
-clearFromCursorToScreenBeginning def
-  = hClearFromCursorToScreenBeginning def stdout
-clearScreen def = hClearScreen def stdout
-
-hClearFromCursorToLineEnd, hClearFromCursorToLineBeginning, hClearLine
-  :: ConsoleDefaultState -- ^ The default console state
-  -> Handle
-  -> IO ()
-
-clearFromCursorToLineEnd, clearFromCursorToLineBeginning, clearLine
-  :: ConsoleDefaultState -- ^ The default console state
-  -> IO ()
-clearFromCursorToLineEnd def = hClearFromCursorToLineEnd def stdout
-clearFromCursorToLineBeginning def = hClearFromCursorToLineBeginning def stdout
-clearLine def = hClearLine def stdout
-
-hScrollPageUp, hScrollPageDown
-  :: ConsoleDefaultState -- ^ The default console state
-  -> Handle
-  -> Int -- ^ Number of lines to scroll by
-  -> IO ()
-
-scrollPageUp, scrollPageDown
-  :: ConsoleDefaultState -- ^ The default console state
-  -> Int -- ^ Number of lines to scroll by
-  -> IO ()
-scrollPageUp def = hScrollPageUp def stdout
-scrollPageDown def = hScrollPageDown def stdout
− src/includes/Common-Include-Enabled.hs 
@@ -1,52 +0,0 @@--- This file contains code that is common save that different code is required
--- in the case of the module System.Console.ANSI.Windows.Emulator (see the file
--- Common-Include-Emulator.hs in respect of the latter).
-
--- 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 ()
-
--- | 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 ()
-
-clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen
-  :: IO ()
-clearFromCursorToScreenEnd = hClearFromCursorToScreenEnd stdout
-clearFromCursorToScreenBeginning = hClearFromCursorToScreenBeginning stdout
-clearScreen = hClearScreen stdout
-
-hClearFromCursorToLineEnd, hClearFromCursorToLineBeginning, hClearLine
-  :: Handle
-  -> IO ()
-
-clearFromCursorToLineEnd, clearFromCursorToLineBeginning, clearLine
-  :: IO ()
-clearFromCursorToLineEnd = hClearFromCursorToLineEnd stdout
-clearFromCursorToLineBeginning = hClearFromCursorToLineBeginning stdout
-clearLine = hClearLine stdout
-
-hScrollPageUp, hScrollPageDown
-  :: Handle
-  -> Int -- Number of lines to scroll by
-  -> IO ()
-
-scrollPageUp, scrollPageDown
-  :: Int -- ^ Number of lines to scroll by
-  -> IO ()
-scrollPageUp = hScrollPageUp stdout
-scrollPageDown = hScrollPageDown stdout
− src/includes/Common-Include.hs 
@@ -1,542 +0,0 @@--- This file contains code that is common to modules System.Console.ANSI.Unix,
--- System.Console.ANSI.Windows and System.Console.ANSI.Windows.Emulator, such as
--- type signatures and the definition of functions specific to stdout in terms
--- of the corresponding more general functions, including the related Haddock
--- documentation.
-
-import Control.Monad (void)
-import Data.Char (digitToInt, isDigit, isHexDigit)
-import Data.Word (Word16)
-import System.Environment (getEnvironment)
-import System.IO (hFlush, stdout)
-import Text.ParserCombinators.ReadP (ReadP, (<++), char, many1, satisfy, string)
-
-import Data.Colour.SRGB (RGB (..))
-
-import System.Console.ANSI.Types
-
-hCursorUp, hCursorDown, hCursorForward, hCursorBackward
-  :: Handle
-  -> Int -- Number of lines or characters to move
-  -> IO ()
-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 ()
-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 ()
-
--- | 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 ()
-
--- | 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 ()
-
--- | 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 ()
-
--- | 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 ()
-
--- | 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 [ \<cursor row> ; \<cursor column> 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 ()
-
-saveCursor = hSaveCursor stdout
-restoreCursor = hRestoreCursor stdout
-reportCursorPosition = hReportCursorPosition stdout
-
-hHideCursor, hShowCursor :: Handle
-                         -> IO ()
-hideCursor, showCursor :: IO ()
-hideCursor = hHideCursor stdout
-showCursor = hShowCursor stdout
-
-hUseAlternateScreenBuffer
-  :: Handle
-  -> IO ()
-
-hUseNormalScreenBuffer
-  :: Handle
-  -> IO ()
-
--- | 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 ()
-
--- | 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 ()
--- | 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. This function assumes that the handle
--- is writable (that is, it manages output - see 'hIsWritable').
---
--- 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 performs the same checks as for
--- Unix-like operating systems and, as an alternative, checks 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.) On Windows 10, if the handle is
--- identified as connected to a native terminal, this function does /not/ enable
--- the processing of \'ANSI\' control characters in output (see
--- 'hSupportsANSIWithoutEmulation').
---
--- @since 0.6.2
-hSupportsANSI :: Handle -> IO Bool
-
--- | 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 env = any (\(k, _) -> k == "INSIDE_EMACS") env
-    isDumb env = Just "dumb" == lookup "TERM" env
-
--- | Use heuristics to determine whether a given handle will support \'ANSI\'
--- control characters in output. (On Windows versions before Windows 10, that
--- means \'support without emulation\'.)
---
--- If the handle is not writable (that is, it cannot manage output - see
--- 'hIsWritable'), then @pure (Just False)@ is returned.
---
--- On Unix-like operating systems, with one exception, the function is
--- consistent with 'hSupportsANSI'. The exception is if the handle is not
--- writable.
---
--- On Windows, what is returned will depend on what the handle is connected to
--- and the version of the operating system. If the handle is identified as
--- connected to a \'mintty\' terminal, @pure (Just True)@ is
--- returned. If it is identified as connected to a native terminal, then, on
--- Windows 10, the processing of \'ANSI\' control characters will be enabled and
--- @pure (Just True)@ returned; and, on versions of Windows before Windows 10,
--- @pure (Just False)@ is returned. Otherwise, if a @TERM@ environment
--- variable is set to @dumb@, @pure (Just False)@ is returned. In all other
--- cases of a writable handle, @pure Nothing@ is returned; this indicates that
--- the heuristics cannot assist - the handle may be connected to a file or
--- to another type of terminal.
---
--- @since 0.8.1
-hSupportsANSIWithoutEmulation :: Handle -> IO (Maybe Bool)
-
--- | 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
-
--- | 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))
-
--- | 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 ] \<Ps> ; rgb: \<red> ; \<green> ; \<blue> \<ST>@
--- where @\<Ps>@ is @10@ for 'Foreground' and @11@ for 'Background'; @\<red>@,
--- @\<green>@ and @\<blue>@ are the color channel values in hexadecimal (4, 8,
--- 12 and 16 bit values are possible, although 16 bit values are most common);
--- and @\<ST>@ 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 ()
-
--- | 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
-
--- | 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))
-
--- | 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
--- <https://hackage.haskell.org/package/terminal-size terminal-size> 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
--- <https://hackage.haskell.org/package/terminal-size terminal-size> 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
− src/includes/Common-Safe-Haskell.hs 
@@ -1,1 +0,0 @@-{-# LANGUAGE Safe #-}
− src/includes/Exports-Include.hs 
@@ -1,182 +0,0 @@--- This file contains code that is common to modules
--- System.Console.ANSI.Unix and System.Console.ANSI.Windows, namely the module
--- exports and the associated Haddock documentation.
-
-    -- * 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 the ECMA-48 standard; they are
-    -- popular, but non-portable extensions. On Unix-like operating systems,
-    -- they correspond to @rc@ and @sc@ capabilities in the @terminfo@ database.
-    --
-    -- Cursor positions are relative to the viewport, not to its content.
-    --
-  , 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 the ECMA-48 standard; they are
-    -- popular, but non-portable extensions. On Unix-like operating systems,
-    -- they correspond to the @smcup@ and @rmcup@ capabilities in the @terminfo@
-    -- database. Windows Terminal supports them. 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
-    -- | These code sequences are not part of the ECMA-48 standard; they are
-    -- popular, but non-portable extensions. In practice, many terminals support
-    -- them.
-  , hideCursor
-  , showCursor
-    -- ** \'h...\' variants
-  , hHideCursor
-  , hShowCursor
-    -- ** \'...Code\' variants
-  , hideCursorCode
-  , showCursorCode
-
-    -- * Hyperlinks
-    -- | These code sequences are not part of the ECMA-48 standard or an Xterm
-    -- extension. However, in practice, many terminals support them, including
-    -- Windows Terminal. 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
-  , hSupportsANSIColor
-  , hSupportsANSIWithoutEmulation
-
-    -- * Getting the cursor position
-  , getCursorPosition
-  , hGetCursorPosition
-  , getReportedCursorPosition
-  , cursorPosition
-
-    -- * Getting the terminal size
-  , getTerminalSize
-  , hGetTerminalSize
-
-    -- * Getting the background or foreground colors
-  , getLayerColor
-  , hGetLayerColor
-  , getReportedLayerColor
-  , layerColor
+ unix/System/Console/ANSI/Internal.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE Trustworthy #-}
+
+module System.Console.ANSI.Internal
+  ( getReportedCursorPosition
+  , getReportedLayerColor
+  , hSupportsANSI
+  , hNowSupportsANSI
+  , hSupportsANSIColor
+  ) where
+
+import Data.List ( uncons )
+import Data.Maybe ( fromMaybe, isJust, mapMaybe )
+import System.Environment ( lookupEnv )
+import System.IO ( Handle, hIsTerminalDevice, hIsWritable )
+import System.IO.Unsafe ( unsafePerformIO )
+import System.Timeout ( timeout )
+
+import System.Console.ANSI.Types ( ConsoleLayer (..) )
+
+getReportedCursorPosition :: IO String
+getReportedCursorPosition = getReport "\ESC[" ["R"]
+
+getReportedLayerColor :: ConsoleLayer -> IO String
+getReportedLayerColor Underlining =
+  error "getReportedLayerColor does not support underlining."
+getReportedLayerColor layer =
+  getReport ("\ESC]" ++ pS ++ ";rgb:") ["\BEL", "\ESC\\"]
+ where
+   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' = (&& isNotDumb) <$> hIsTerminalDevice h
+
+hNowSupportsANSI :: Handle -> IO Bool
+hNowSupportsANSI = hSupportsANSI
+
+hSupportsANSIColor :: Handle -> IO Bool
+hSupportsANSIColor h = (|| isEmacsTerm) <$> hSupportsANSI h
+ where
+  isEmacsTerm = insideEmacs && isDumb
+  isDumb = not isNotDumb
+
+-- | This function assumes that once it is first established whether or not the
+-- TERM environment variable exists with contents dumb, that will not change.
+-- This approach is taken because the use of C function setenv() in one thread
+-- can cause other threads calling C function getenv() to crash. On Unix-like
+-- operating systems, System.Environment.lookupEnv is implemented using C
+-- function getenv().
+isNotDumb :: Bool
+isNotDumb = unsafePerformIO (lookupEnv "TERM") /= Just "dumb"
+
+{-# NOINLINE isNotDumb #-}
+
+-- | This function assumes that once it is first established whether or not the
+-- INSIDE_EMACS environment variable exists, that will not change. This approach
+-- is taken because the use of C function setenv() in one thread can cause other
+-- threads calling C function getenv() to crash. On Unix-like operating systems,
+-- System.Environment.lookupEnv is implemented using C function getenv().
+insideEmacs :: Bool
+insideEmacs = isJust $ unsafePerformIO (lookupEnv "INSIDE_EMACS")
+
+{-# NOINLINE insideEmacs #-}
+ win/System/Console/ANSI/Internal.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE Safe #-}
+
+module System.Console.ANSI.Internal
+  ( getReportedCursorPosition
+  , getReportedLayerColor
+  , hNowSupportsANSI
+  , hSupportsANSI
+  , hSupportsANSIColor
+  ) where
+
+import Control.Exception ( IOException, SomeException, catch, try )
+import Data.Bits ( (.&.), (.|.) )
+import Data.Maybe ( mapMaybe )
+import System.Environment ( getEnvironment, 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
+
+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
+ win/System/Console/ANSI/Windows/Foreign.hs view
@@ -0,0 +1,494 @@+{-# 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
+ win/System/Console/ANSI/Windows/Win32/MinTTY.hsc view
@@ -0,0 +1,256 @@+{-# 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 <windows.h>
+#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
+ win/System/Console/ANSI/Windows/Win32/Types.hs view
@@ -0,0 +1,195 @@+{-# 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)
+ win/c-source/HsWin32.c view
@@ -0,0 +1,3 @@+// Out-of-line versions of all the inline functions from HsWin32.h
+#define INLINE  /* nothing */
+#include "HsWin32.h"
+ win/c-source/errors.c view
@@ -0,0 +1,39 @@+#define UNICODE
+#include <stdio.h>
+#include <stdlib.h>
+#include <windows.h>
+#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;
+}
+ win/include/HsWin32.h view
@@ -0,0 +1,23 @@+#ifndef _ANSI_TERMINAL_HSWIN32_H
+#define _ANSI_TERMINAL_HSWIN32_H
+
+#define UNICODE
+#include <windows.h>
+
+/* 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 */
+ win/include/errors.h view
@@ -0,0 +1,22 @@+#ifndef _ANSI_TERMINAL_ERRORS_H
+#define _ANSI_TERMINAL_ERRORS_H
+
+#include <windows.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.
+ */
+
+/* result should be freed using LocalFree */
+extern LPTSTR _ansi_terminal_getErrorMessage(DWORD err);
+
+#endif /* _ANSI_TERMINAL_ERRORS_H */
+ win/include/winternl_compat.h view
@@ -0,0 +1,31 @@+#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 <winternl.h>
+#else
+// Some declarations from winternl.h that we need
+# include <windows.h>
+
+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 */