diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml new file mode 100644 index 0000000..3b4da86 --- /dev/null +++ b/.github/workflows/build.yml @@ -0,0 +1,57 @@ +name: Build + +on: push + +jobs: + build-with-cabal: + name: ${{ matrix.os }} / ghc-${{ matrix.ghc }} + + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + - macOS-latest + - windows-2022 + ghc: + - 8.2.2 + - 8.4.4 + - 8.6.5 + - 8.8.2 + - 8.10.7 + - 9.0.2 + - 9.2.4 + - 9.4.2 + cabal: + - latest + + steps: + - name: Checkout + uses: actions/checkout@v3 + + - name: Setup Haskell + id: setup-haskell-cabal + uses: haskell/actions/setup@v2 + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: ${{ matrix.cabal }} + + - name: Cache cabal store + uses: actions/cache@v3 + with: + path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} + key: cabal-store-${{ matrix.os }}-ghc-${{ matrix.ghc }}-${{ hashFiles('terminal-size.cabal') }} + restore-keys: cabal-store-${{ matrix.os }}-ghc-${{ matrix.ghc }}- + + - name: Build dependencies + run: cabal build --only-dependencies + + - name: Build + run: cabal build --write-ghc-environment-files=always + + - name: Build Test Program + # It would be nice if we could also run it. But that doesn't work + # because the std handles are redirected in the gihub runner + # so hSize always returns Nothing. + run: ghc test.hs diff --git a/README.markdown b/README.markdown index c0f57ee..6be8f88 100644 --- a/README.markdown +++ b/README.markdown @@ -14,3 +14,44 @@ Usage >>> size Just (Window {height = 60, width = 112}) ``` + +Test +---- + +Compile test.hs and run it in a terminal. Here is what I get on Linux: + +``` +> ghc test.hs +> ./test +With redirected stdin + hSize stdin = Nothing + hSize stdout = Just (Window {height = 19, width = 87}) + hSize stderr = Just (Window {height = 19, width = 87}) +With redirected stdout + hSize stdin = Just (Window {height = 19, width = 87}) + hSize stdout = Nothing + hSize stderr = Just (Window {height = 19, width = 87}) +With redirected stderr + hSize stdin = Just (Window {height = 19, width = 87}) + hSize stdout = Just (Window {height = 19, width = 87}) + hSize stderr = Nothing +``` + +On MINGW/MSYS the output is the same. + +On Windows with cmd.exe I get + +``` +With redirected stdin + hSize stdin = Nothing + hSize stdout = Just (Window {height = 40, width = 164}) + hSize stderr = Just (Window {height = 40, width = 164}) +With redirected stdout + hSize stdin = Nothing + hSize stdout = Nothing + hSize stderr = Just (Window {height = 40, width = 164}) +With redirected stderr + hSize stdin = Nothing + hSize stdout = Just (Window {height = 40, width = 164}) + hSize stderr = Nothing +``` diff --git a/src/System/Console/Terminal/Size.hs b/src/System/Console/Terminal/Size.hs index ba6162d..a11fd3b 100644 --- a/src/System/Console/Terminal/Size.hs +++ b/src/System/Console/Terminal/Size.hs @@ -9,8 +9,8 @@ module System.Console.Terminal.Size , size #if !defined(mingw32_HOST_OS) , fdSize - , hSize #endif + , hSize ) where import System.Console.Terminal.Common @@ -19,8 +19,8 @@ import qualified System.Console.Terminal.Windows as Host #else import qualified System.Console.Terminal.Posix as Host import System.Posix.Types(Fd) -import System.IO(Handle) #endif +import System.IO(Handle) -- | Get terminal window width and height for @stdout@. @@ -45,9 +45,13 @@ size = Host.size -- Nothing fdSize :: Integral n => Fd -> IO (Maybe (Window n)) fdSize = Host.fdSize +#endif --- | /Not available on Windows:/ --- Same as 'fdSize', but takes 'Handle' instead of 'Fd' (file descriptor). +-- | Same as 'fdSize', but takes 'Handle' instead of 'Fd' (file descriptor). +-- +-- Note that on Windows with shells that use the native console API (cmd.exe, +-- PowerShell) this works only for output handles like 'stdout' and 'stderr'; +-- for input handles like 'stdin' it always returns 'Nothing'. -- -- >>> import System.Console.Terminal.Size -- >>> import System.IO @@ -55,4 +59,3 @@ fdSize = Host.fdSize -- Just (Window {height = 56, width = 85}) hSize :: Integral n => Handle -> IO (Maybe (Window n)) hSize = Host.hSize -#endif diff --git a/src/System/Console/Terminal/Windows.hs b/src/System/Console/Terminal/Windows.hs index 87aa1bf..816bbe9 100644 --- a/src/System/Console/Terminal/Windows.hs +++ b/src/System/Console/Terminal/Windows.hs @@ -1,63 +1,48 @@ - -module System.Console.Terminal.Windows(size) where +module System.Console.Terminal.Windows(size, hSize) where 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.IO.Error (catchIOError) 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 - +import System.Win32.Console + ( CONSOLE_SCREEN_BUFFER_INFO(srWindow) + , SMALL_RECT(..) + , getConsoleScreenBufferInfo + ) +import System.Win32.Types (HANDLE, withHandleToHANDLE) 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 - , std_err = 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) +size = hSize stdout + +hSize :: Integral n => Handle -> IO (Maybe (Window n)) +hSize hdl = + withHandleToHANDLE hdl nativeSize + `catchIOError` \_ -> do + -- Fallback to use for Cygwin or MSYS + let stty = (shell "stty size") { + std_in = UseHandle hdl + , std_out = CreatePipe + , std_err = CreatePipe + } + (_, mbStdout, _, rStty) <- createProcess stty + exStty <- waitForProcess rStty + case exStty of + ExitFailure _ -> return Nothing + ExitSuccess -> + maybe (return Nothing) + (\out -> do + sizeStr <- hGetContents out + let [r, c] = map read $ words sizeStr :: [Int] + return $ Just $ Window (fromIntegral r) (fromIntegral c) + ) + mbStdout + +nativeSize :: Integral n => HANDLE -> IO (Maybe (Window n)) +nativeSize hdl = do + rect <- srWindow <$> getConsoleScreenBufferInfo hdl + return $ Just $ Window + { height = fromIntegral (1 + bottomPos rect - topPos rect) + , width = fromIntegral (1 + rightPos rect - leftPos rect) + } diff --git a/terminal-size.cabal b/terminal-size.cabal index 7c66d22..7ea4bd1 100644 --- a/terminal-size.cabal +++ b/terminal-size.cabal @@ -34,7 +34,8 @@ library ghc-prim if os(windows) build-depends: - process + process, + Win32 >= 2.13.2.0 && < 2.14 build-tools: hsc2hs diff --git a/test.hs b/test.hs new file mode 100644 index 0000000..c103bc2 --- /dev/null +++ b/test.hs @@ -0,0 +1,27 @@ +import System.Console.Terminal.Size +import System.IO +import GHC.IO.Handle +import Control.Monad +import Data.Maybe + +stdHandles = + [ (stdin, "stdin") + , (stdout, "stdout") + , (stderr, "stderr") + ] + +main = do + fh <- openFile "test.hs" ReadMode + forM_ stdHandles $ \(h, n) -> do + putStrLn $ "With redirected " ++ n + -- save handle + h_saved <- hDuplicate h + -- redirect to a file handle + hDuplicateTo fh h + -- run hSize on all three std handles + hSizes <- forM stdHandles (hSize . fst) + -- restore redirected handle + hDuplicateTo h_saved h + -- report sizes + forM_ (zip hSizes stdHandles) $ \(s, (h', n')) -> do + putStrLn $ " hSize " ++ n' ++ " = " ++ show s