From 3a986280c712fe705bba1c3a4c145fa6fa62300a Mon Sep 17 00:00:00 2001 From: Jeff Happily Date: Mon, 17 Feb 2020 13:19:00 +0800 Subject: [PATCH 1/7] Remove terminal size and make some changes --- package.yaml | 1 - src/Stack/Runners.hs | 4 +-- src/unix/System/Terminal.hsc | 58 +++++++++++++++++++++++++++++++++ src/windows/System/Terminal.hs | 59 ++++++++++++++++++++++++++++++++++ 4 files changed, 119 insertions(+), 3 deletions(-) diff --git a/package.yaml b/package.yaml index db70fa4ba8..915c57171b 100644 --- a/package.yaml +++ b/package.yaml @@ -116,7 +116,6 @@ dependencies: - tar - template-haskell - temporary -- terminal-size - text - text-metrics - th-reify-many diff --git a/src/Stack/Runners.hs b/src/Stack/Runners.hs index 0c6ce14495..d40bab60ea 100644 --- a/src/Stack/Runners.hs +++ b/src/Stack/Runners.hs @@ -35,7 +35,7 @@ import Stack.Types.Docker (dockerEnable) import Stack.Types.Nix (nixEnable) import Stack.Types.Version (stackMinorVersion, stackVersion, minorVersion) import System.Console.ANSI (hSupportsANSIWithoutEmulation) -import System.Console.Terminal.Size (size, width) +import System.Terminal (getTerminalWidth) -- | Ensure that no project settings are used when running 'withConfig'. withGlobalProject :: RIO Runner a -> RIO Runner a @@ -145,7 +145,7 @@ withRunnerGlobal go inner = do ColorAuto -> fromMaybe True <$> hSupportsANSIWithoutEmulation stderr termWidth <- clipWidth <$> maybe (fromMaybe defaultTerminalWidth - <$> fmap (fmap width) size) + <$> getTerminalWidth) pure (globalTermWidth go) menv <- mkDefaultProcessContext logOptions0 <- logOptionsHandle stderr False diff --git a/src/unix/System/Terminal.hsc b/src/unix/System/Terminal.hsc index 2f1acc58f5..34a22fb80e 100644 --- a/src/unix/System/Terminal.hsc +++ b/src/unix/System/Terminal.hsc @@ -1,9 +1,67 @@ module System.Terminal ( fixCodePage +, getTerminalWidth , hIsTerminalDeviceOrMinTTY ) where import RIO (MonadIO, Handle, hIsTerminalDevice) +import Foreign +-- import Foreign.C.Error +import Foreign.C.Types +-- import GHC.IO.FD (FD(FD, fdFD)) +-- import GHC.IO.Handle.Internals (withHandle_) +-- import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice)) +-- import System.Posix.Types (Fd(Fd)) + +#include +#include + + +-- #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) +newtype WindowWidth = WindowWidth CUShort + deriving (Eq, Ord, Show) + +instance Storable WindowWidth where + sizeOf _ = (#size struct winsize) + alignment _ = (#alignment struct winsize) + peek p = WindowWidth <$> (#peek struct winsize, ws_col) p + poke p (WindowWidth w) = do + (#poke struct winsize, ws_col) p w + + +-- fdSize :: Integral n => Fd -> IO (Maybe (Window n)) +-- fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do +-- throwErrnoIfMinus1 "ioctl" $ +-- ioctl fd (#const TIOCGWINSZ) ws +-- CWin row col <- peek ws +-- return . Just $ Window (fromIntegral row) (fromIntegral col) +-- `catch` +-- handler +-- where +-- handler :: IOError -> IO (Maybe (Window h)) +-- handler _ = return Nothing + +foreign import ccall "sys/ioctl.h ioctl" + ioctl :: CInt -> CInt -> Ptr WindowWidth -> IO CInt + +-- size :: Integral n => IO (Maybe (Window n)) +-- size = fdSize (Fd (#const STDOUT_FILENO)) + +-- hSize :: Integral n => Handle -> IO (Maybe (Window n)) +-- hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } -> +-- case cast dev of +-- Nothing -> return Nothing +-- Just FD { fdFD = fd } -> fdSize (Fd fd) + +getTerminalWidth :: IO (Maybe Int) +getTerminalWidth = + alloca $ \p -> do + errno <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) p + if errno < 0 + then return Nothing + else do + WindowWidth w <- peek p + return . Just . fromIntegral $ w fixCodePage :: x -> y -> a -> a fixCodePage _ _ = id diff --git a/src/windows/System/Terminal.hs b/src/windows/System/Terminal.hs index 5b93d99a53..f6d3fc614a 100644 --- a/src/windows/System/Terminal.hs +++ b/src/windows/System/Terminal.hs @@ -9,6 +9,65 @@ import Distribution.Types.Version (mkVersion) import Stack.Prelude import System.Win32 (isMinTTYHandle, withHandleToHANDLE) import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP) +import System.Console.Terminal.Common + +import Control.Monad +import Data.Word +import Foreign.Ptr +import Foreign.Storable +import Foreign.Marshal.Alloc +import System.Exit +import System.IO +import System.Process + +type HANDLE = Ptr () + +data CONSOLE_SCREEN_BUFFER_INFO + +sizeCONSOLE_SCREEN_BUFFER_INFO :: Int +sizeCONSOLE_SCREEN_BUFFER_INFO = 22 + +posCONSOLE_SCREEN_BUFFER_INFO_srWindow :: Int +posCONSOLE_SCREEN_BUFFER_INFO_srWindow = 10 -- 4 x Word16 Left,Top,Right,Bottom + +c_STD_OUTPUT_HANDLE :: Word32 +c_STD_OUTPUT_HANDLE = -11 + +foreign import stdcall unsafe "windows.h GetConsoleScreenBufferInfo" + c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO Bool + +foreign import stdcall unsafe "windows.h GetStdHandle" + c_GetStdHandle :: Word32 -> IO HANDLE + + +size :: Integral n => IO (Maybe (Window n)) +size = do + hdl <- c_GetStdHandle c_STD_OUTPUT_HANDLE + allocaBytes sizeCONSOLE_SCREEN_BUFFER_INFO $ \p -> do + b <- c_GetConsoleScreenBufferInfo hdl p + if not b + then do -- This could happen on Cygwin or MSYS + let stty = (shell "stty size") { + std_in = UseHandle stdin + , std_out = CreatePipe + } + (_, mbStdout, _, rStty) <- createProcess stty + exStty <- waitForProcess rStty + case exStty of + ExitFailure _ -> return Nothing + ExitSuccess -> + maybe (return Nothing) + (\hSize -> do + sizeStr <- hGetContents hSize + let [r, c] = map read $ words sizeStr :: [Int] + return $ Just $ Window (fromIntegral r) (fromIntegral c) + ) + mbStdout + else do + [left,top,right,bottom] <- forM [0..3] $ \i -> do + v <- peekByteOff p ((i*2) + posCONSOLE_SCREEN_BUFFER_INFO_srWindow) + return $ fromIntegral (v :: Word16) + return $ Just $ Window (1+bottom-top) (1+right-left) -- | Set the code page for this process as necessary. Only applies to Windows. -- See: https://github.com/commercialhaskell/stack/issues/738 From 7603f5c47556a7ce19b172f6cd297651bd8c3e74 Mon Sep 17 00:00:00 2001 From: jeffhappily Date: Mon, 17 Feb 2020 17:21:14 +0800 Subject: [PATCH 2/7] Modify windows terminal code --- src/unix/System/Terminal.hsc | 31 ++---------------------------- src/windows/System/Terminal.hs | 35 +++++++++++++++++----------------- 2 files changed, 19 insertions(+), 47 deletions(-) diff --git a/src/unix/System/Terminal.hsc b/src/unix/System/Terminal.hsc index 34a22fb80e..b8ab1b52d2 100644 --- a/src/unix/System/Terminal.hsc +++ b/src/unix/System/Terminal.hsc @@ -1,23 +1,18 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module System.Terminal ( fixCodePage , getTerminalWidth , hIsTerminalDeviceOrMinTTY ) where -import RIO (MonadIO, Handle, hIsTerminalDevice) import Foreign --- import Foreign.C.Error import Foreign.C.Types --- import GHC.IO.FD (FD(FD, fdFD)) --- import GHC.IO.Handle.Internals (withHandle_) --- import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice)) --- import System.Posix.Types (Fd(Fd)) +import RIO (MonadIO, Handle, hIsTerminalDevice) #include #include --- #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) newtype WindowWidth = WindowWidth CUShort deriving (Eq, Ord, Show) @@ -28,31 +23,9 @@ instance Storable WindowWidth where poke p (WindowWidth w) = do (#poke struct winsize, ws_col) p w - --- fdSize :: Integral n => Fd -> IO (Maybe (Window n)) --- fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do --- throwErrnoIfMinus1 "ioctl" $ --- ioctl fd (#const TIOCGWINSZ) ws --- CWin row col <- peek ws --- return . Just $ Window (fromIntegral row) (fromIntegral col) --- `catch` --- handler --- where --- handler :: IOError -> IO (Maybe (Window h)) --- handler _ = return Nothing - foreign import ccall "sys/ioctl.h ioctl" ioctl :: CInt -> CInt -> Ptr WindowWidth -> IO CInt --- size :: Integral n => IO (Maybe (Window n)) --- size = fdSize (Fd (#const STDOUT_FILENO)) - --- hSize :: Integral n => Handle -> IO (Maybe (Window n)) --- hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } -> --- case cast dev of --- Nothing -> return Nothing --- Just FD { fdFD = fd } -> fdSize (Fd fd) - getTerminalWidth :: IO (Maybe Int) getTerminalWidth = alloca $ \p -> do diff --git a/src/windows/System/Terminal.hs b/src/windows/System/Terminal.hs index f6d3fc614a..2f8d524c9d 100644 --- a/src/windows/System/Terminal.hs +++ b/src/windows/System/Terminal.hs @@ -1,24 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module System.Terminal ( fixCodePage +, getTerminalWidth , hIsTerminalDeviceOrMinTTY ) where import Distribution.Types.Version (mkVersion) -import Stack.Prelude -import System.Win32 (isMinTTYHandle, withHandleToHANDLE) -import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP) -import System.Console.Terminal.Common - -import Control.Monad -import Data.Word import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc -import System.Exit -import System.IO +import Stack.Prelude +import System.IO hiding (hIsTerminalDevice) import System.Process +import System.Win32 (isMinTTYHandle, withHandleToHANDLE) +import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP) +import RIO.Partial (read) type HANDLE = Ptr () @@ -30,26 +28,27 @@ sizeCONSOLE_SCREEN_BUFFER_INFO = 22 posCONSOLE_SCREEN_BUFFER_INFO_srWindow :: Int posCONSOLE_SCREEN_BUFFER_INFO_srWindow = 10 -- 4 x Word16 Left,Top,Right,Bottom -c_STD_OUTPUT_HANDLE :: Word32 +c_STD_OUTPUT_HANDLE :: Int c_STD_OUTPUT_HANDLE = -11 foreign import stdcall unsafe "windows.h GetConsoleScreenBufferInfo" c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO Bool foreign import stdcall unsafe "windows.h GetStdHandle" - c_GetStdHandle :: Word32 -> IO HANDLE + c_GetStdHandle :: Int -> IO HANDLE -size :: Integral n => IO (Maybe (Window n)) -size = do +getTerminalWidth :: IO (Maybe Int) +getTerminalWidth = do hdl <- c_GetStdHandle c_STD_OUTPUT_HANDLE allocaBytes sizeCONSOLE_SCREEN_BUFFER_INFO $ \p -> do b <- c_GetConsoleScreenBufferInfo hdl p if not b then do -- This could happen on Cygwin or MSYS - let stty = (shell "stty size") { + let stty = (shell "stty size") { std_in = UseHandle stdin , std_out = CreatePipe + , std_err = CreatePipe } (_, mbStdout, _, rStty) <- createProcess stty exStty <- waitForProcess rStty @@ -59,15 +58,15 @@ size = do maybe (return Nothing) (\hSize -> do sizeStr <- hGetContents hSize - let [r, c] = map read $ words sizeStr :: [Int] - return $ Just $ Window (fromIntegral r) (fromIntegral c) + let [_r, c] = map read $ words sizeStr :: [Int] + return $ Just c ) mbStdout else do - [left,top,right,bottom] <- forM [0..3] $ \i -> do + [left,_top,right,_bottom] <- forM [0..3] $ \i -> do v <- peekByteOff p ((i*2) + posCONSOLE_SCREEN_BUFFER_INFO_srWindow) return $ fromIntegral (v :: Word16) - return $ Just $ Window (1+bottom-top) (1+right-left) + return $ Just $ (1+right-left) -- | Set the code page for this process as necessary. Only applies to Windows. -- See: https://github.com/commercialhaskell/stack/issues/738 From c0bb10d553f51a1830f2969133d4971e1ada12df Mon Sep 17 00:00:00 2001 From: jeffhappily Date: Mon, 17 Feb 2020 17:28:41 +0800 Subject: [PATCH 3/7] Exhaustive pattern matching --- src/windows/System/Terminal.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/windows/System/Terminal.hs b/src/windows/System/Terminal.hs index 2f8d524c9d..b8705b870b 100644 --- a/src/windows/System/Terminal.hs +++ b/src/windows/System/Terminal.hs @@ -58,8 +58,9 @@ getTerminalWidth = do maybe (return Nothing) (\hSize -> do sizeStr <- hGetContents hSize - let [_r, c] = map read $ words sizeStr :: [Int] - return $ Just c + case map read $ words sizeStr :: [Int] of + [_r, c] -> return $ Just c + _ -> return Nothing ) mbStdout else do From d715779719665bea771dfb2f4241dd559f5e0660 Mon Sep 17 00:00:00 2001 From: jeffhappily Date: Mon, 17 Feb 2020 18:23:09 +0800 Subject: [PATCH 4/7] Remove trailing tabs --- src/unix/System/Terminal.hsc | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/unix/System/Terminal.hsc b/src/unix/System/Terminal.hsc index b8ab1b52d2..e17b35ae5d 100644 --- a/src/unix/System/Terminal.hsc +++ b/src/unix/System/Terminal.hsc @@ -28,12 +28,12 @@ foreign import ccall "sys/ioctl.h ioctl" getTerminalWidth :: IO (Maybe Int) getTerminalWidth = - alloca $ \p -> do - errno <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) p - if errno < 0 - then return Nothing - else do - WindowWidth w <- peek p + alloca $ \p -> do + errno <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) p + if errno < 0 + then return Nothing + else do + WindowWidth w <- peek p return . Just . fromIntegral $ w fixCodePage :: x -> y -> a -> a From 4bfbfdc9d5a5f8fdafbf5b73a6d8b475740c9612 Mon Sep 17 00:00:00 2001 From: jeffhappily Date: Wed, 19 Feb 2020 18:41:42 +0800 Subject: [PATCH 5/7] Replace stdcall with ccall --- src/windows/System/Terminal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/windows/System/Terminal.hs b/src/windows/System/Terminal.hs index b8705b870b..1d8b91ee9b 100644 --- a/src/windows/System/Terminal.hs +++ b/src/windows/System/Terminal.hs @@ -31,10 +31,10 @@ posCONSOLE_SCREEN_BUFFER_INFO_srWindow = 10 -- 4 x Word16 Left,Top,Right,Bottom c_STD_OUTPUT_HANDLE :: Int c_STD_OUTPUT_HANDLE = -11 -foreign import stdcall unsafe "windows.h GetConsoleScreenBufferInfo" +foreign import ccall unsafe "windows.h GetConsoleScreenBufferInfo" c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO Bool -foreign import stdcall unsafe "windows.h GetStdHandle" +foreign import ccall unsafe "windows.h GetStdHandle" c_GetStdHandle :: Int -> IO HANDLE From 5f71fc1f49e58a30f8616174a9e1369e5f547020 Mon Sep 17 00:00:00 2001 From: jeffhappily Date: Mon, 17 Feb 2020 18:23:09 +0800 Subject: [PATCH 6/7] Remove trailing tabs Fix linter error --- src/windows/System/Terminal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/windows/System/Terminal.hs b/src/windows/System/Terminal.hs index 1d8b91ee9b..fe34c570b3 100644 --- a/src/windows/System/Terminal.hs +++ b/src/windows/System/Terminal.hs @@ -67,7 +67,7 @@ getTerminalWidth = do [left,_top,right,_bottom] <- forM [0..3] $ \i -> do v <- peekByteOff p ((i*2) + posCONSOLE_SCREEN_BUFFER_INFO_srWindow) return $ fromIntegral (v :: Word16) - return $ Just $ (1+right-left) + return $ Just (1+right-left) -- | Set the code page for this process as necessary. Only applies to Windows. -- See: https://github.com/commercialhaskell/stack/issues/738 From 5ec44a48a0cf5c2cefeef7aa802e0e9e1322e229 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 20 Feb 2020 17:04:51 +0200 Subject: [PATCH 7/7] Add ChangeLog entry (closes #4901) --- ChangeLog.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog.md b/ChangeLog.md index 2a97b514a2..df563242f5 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -64,6 +64,9 @@ Bug fixes: * Use Hoogle from the snapshot used and not the latest version. See [#4905](https://github.com/commercialhaskell/stack/issues/4905) +* Resolve "'stty' is not recognized". See + [#4901](https://github.com/commercialhaskell/stack/issues/4901) + ## v2.1.3.1 Hackage-only release: