Skip to content
Snippets Groups Projects
Verified Commit 17524b21 authored by Julian Ospald's avatar Julian Ospald :tea:
Browse files

Merge branch 'issue-289'

parents 0c415314 3f0befe3
No related branches found
No related tags found
1 merge request!227Fix `ghcup whereis ghc` for non-standard versions, fixes #289
Pipeline #44318 passed
...@@ -8,6 +8,11 @@ package ghcup ...@@ -8,6 +8,11 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli, constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0, any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0 any.aeson >= 2.0.1.0
......
...@@ -166,11 +166,10 @@ library ...@@ -166,11 +166,10 @@ library
GHCup.Utils.File.Posix GHCup.Utils.File.Posix
GHCup.Utils.Posix GHCup.Utils.Posix
GHCup.Utils.Prelude.Posix GHCup.Utils.Prelude.Posix
System.Console.Terminal.Common
System.Console.Terminal.Posix
build-depends: build-depends:
, bz2 >=0.5.0.5 && <1.1 , bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.2.1
, unix ^>=2.7 , unix ^>=2.7
, unix-bytestring ^>=0.3.7.3 , unix-bytestring ^>=0.3.7.3
......
...@@ -1141,11 +1141,11 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do ...@@ -1141,11 +1141,11 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
-- | For ghc without arch triple, this is: -- | For ghc without arch triple, this is:
-- --
-- - ghc-<ver> (e.g. ghc-8.10.4) -- - ghc
-- --
-- For ghc with arch triple: -- For ghc with arch triple:
-- --
-- - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4) -- - <triple>-ghc (e.g. arm-linux-gnueabihf-ghc)
ghcBinaryName :: GHCTargetVersion -> String ghcBinaryName :: GHCTargetVersion -> String
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt) ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt) ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
...@@ -35,7 +35,6 @@ import Data.Sequence ( Seq, (|>) ) ...@@ -35,7 +35,6 @@ import Data.Sequence ( Seq, (|>) )
import Data.List import Data.List
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
import System.Console.Terminal.Common
import System.IO.Error import System.IO.Error
import System.FilePath import System.FilePath
import System.Directory import System.Directory
...@@ -51,7 +50,7 @@ import qualified Data.Sequence as Sq ...@@ -51,7 +50,7 @@ import qualified Data.Sequence as Sq
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified System.Posix.Process as SPP import qualified System.Posix.Process as SPP
import qualified System.Console.Terminal.Posix as TP import qualified System.Console.Terminal.Size as TP
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified "unix-bytestring" System.Posix.IO.ByteString import qualified "unix-bytestring" System.Posix.IO.ByteString
...@@ -182,7 +181,7 @@ execLogged exe args chdir lfile env = do ...@@ -182,7 +181,7 @@ execLogged exe args chdir lfile env = do
modify (swapRegs bs') modify (swapRegs bs')
liftIO TP.size >>= \case liftIO TP.size >>= \case
Nothing -> pure () Nothing -> pure ()
Just (Window _ w) -> do Just (TP.Window _ w) -> do
regs <- get regs <- get
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
BS.putStr BS.putStr
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
#if __GLASGOW_HASKELL__ >= 702
#define LANGUAGE_DeriveGeneric
{-# LANGUAGE DeriveGeneric #-}
#endif
module System.Console.Terminal.Common
( Window(..)
) where
import Data.Data (Typeable, Data)
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
#endif
#ifdef LANGUAGE_DeriveGeneric
import GHC.Generics
( Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
)
#endif
-- | Terminal window width and height
data Window a = Window
{ height :: !a
, width :: !a
} deriving
( Show, Eq, Read, Data, Typeable
, Foldable, Functor, Traversable
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
{-# LANGUAGE CApiFFI #-}
module System.Console.Terminal.Posix
( size, fdSize, hSize
) where
import System.Console.Terminal.Common
import Control.Exception (catch)
import Data.Typeable (cast)
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))
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
import Prelude hiding (catch)
#endif
import System.Posix.Types (Fd(Fd))
#include <sys/ioctl.h>
#include <unistd.h>
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
-- Interesting part of @struct winsize@
data CWin = CWin CUShort CUShort
instance Storable CWin where
sizeOf _ = (#size struct winsize)
alignment _ = (#alignment struct winsize)
peek ptr = do
row <- (#peek struct winsize, ws_row) ptr
col <- (#peek struct winsize, ws_col) ptr
return $ CWin row col
poke ptr (CWin row col) = do
(#poke struct winsize, ws_row) ptr row
(#poke struct winsize, ws_col) ptr col
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 capi "sys/ioctl.h ioctl"
ioctl :: CInt -> CULong -> Ptr CWin -> 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)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment