packages feed

ansi-terminal 1.1.3 → 1.1.4

raw patch · 5 files changed

+85/−32 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,6 +1,15 @@ Changes
 =======
 
+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
 -------------
ansi-terminal.cabal view
@@ -1,6 +1,6 @@ Cabal-Version:       1.22
 Name:                ansi-terminal
-Version:             1.1.3
+Version:             1.1.4
 Category:            User Interfaces
 Synopsis:            Simple ANSI terminal support
 Description:         ANSI terminal support for Haskell: allows cursor movement,
@@ -23,7 +23,7 @@   type:     git
   location: git://github.com/UnkindPartition/ansi-terminal.git
 
-Flag Example
+Flag example
         Description:    Build the example application
         Default:        False
app/Example.hs view
@@ -11,34 +11,56 @@ import Data.Colour.SRGB (sRGB24)
 
 import System.Console.ANSI
+import System.Environment ( getArgs )
 
-examples :: [IO ()]
-examples = [ cursorMovementExample
-           , lineChangeExample
-           , setCursorPositionExample
-           , saveRestoreCursorExample
-           , clearExample
-           , lineWrapExample
-           , 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 = do
-  stdoutSupportsANSI <- hNowSupportsANSI stdout
-  if stdoutSupportsANSI
+  args <- getArgs
+  let numExamples = zip [1 ..] examples
+  if wantHelp args
     then
-      mapM_ (resetScreen >>) examples
-    else
-      putStrLn "Standard output does not support 'ANSI' escape codes."
+      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
src/System/Console/ANSI.hs view
@@ -384,6 +384,7 @@   , hSupportsANSIWithoutEmulation
   ) where
 
+import Control.Concurrent (threadDelay)
 import Control.Exception.Base ( bracket )
 import Control.Monad ( when, void )
 import Data.Char ( digitToInt, isDigit, isHexDigit )
@@ -648,7 +649,7 @@ -- the processing of \'ANSI\' control characters in output is not enabled, this
 -- function first tries to enable such processing.
 --
--- @Since 1.0.1
+-- @since 1.0.1
 hNowSupportsANSI :: Handle -> IO Bool
 hNowSupportsANSI = Internal.hNowSupportsANSI
 
@@ -741,6 +742,8 @@ -- 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
@@ -759,6 +762,8 @@ -- 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'
@@ -775,8 +780,13 @@         hSetEcho stdin False
         clearStdin
         hReportCursorPosition h
-        hFlush h -- ensure the report cursor position code is sent to the
-                 -- operating system
+        -- 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
@@ -858,6 +868,8 @@ --
 -- 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
@@ -876,6 +888,8 @@ --
 -- 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
@@ -889,8 +903,12 @@       hSetEcho stdin False
       clearStdin
       hReportLayerColor h layer
-      hFlush h -- ensure the report cursor position code is sent to the
-               -- operating system
+      -- 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
@@ -966,6 +984,8 @@ -- 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.
@@ -988,6 +1008,8 @@ -- 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
unix/System/Console/ANSI/Internal.hs view
@@ -92,7 +92,7 @@ -- 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(). 
+-- function getenv().
 isNotDumb :: Bool
 isNotDumb = unsafePerformIO (lookupEnv "TERM") /= Just "dumb"
 
@@ -102,7 +102,7 @@ -- 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(). 
+-- System.Environment.lookupEnv is implemented using C function getenv().
 insideEmacs :: Bool
 insideEmacs = isJust $ unsafePerformIO (lookupEnv "INSIDE_EMACS")