hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'issue-289'

Browse Source
This commit is contained in:
Julian Ospald 2021-11-22 23:18:52 +01:00
commit 17524b21b3
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
6 changed files with 12 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
cabal.project
View File

@ -8,6 +8,11 @@ package ghcup
tests: True
flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0

3
ghcup.cabal
View File

@ -166,11 +166,10 @@ library
GHCup.Utils.File.Posix
GHCup.Utils.Posix
GHCup.Utils.Prelude.Posix
System.Console.Terminal.Common
System.Console.Terminal.Posix
build-depends:
, bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.2.1
, unix ^>=2.7
, unix-bytestring ^>=0.3.7.3

8
lib/GHCup/Utils.hs
View File

@ -1141,11 +1141,11 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
-- | For ghc without arch triple, this is:
--
-- - ghc-<ver> (e.g. ghc-8.10.4)
-- - ghc
--
-- 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 (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)

5
lib/GHCup/Utils/File/Posix.hs
View File

@ -35,7 +35,6 @@ import Data.Sequence ( Seq, (|>) )
import Data.List
import Data.Word8
import GHC.IO.Exception
import System.Console.Terminal.Common
import System.IO.Error
import System.FilePath
import System.Directory
@ -51,7 +50,7 @@ import qualified Data.Sequence as Sq
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
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.Lazy as BL
import qualified "unix-bytestring" System.Posix.IO.ByteString
@ -182,7 +181,7 @@ execLogged exe args chdir lfile env = do
modify (swapRegs bs')
liftIO TP.size >>= \case
Nothing -> pure ()
Just (Window _ w) -> do
Just (TP.Window _ w) -> do
regs <- get
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
BS.putStr

43
lib/System/Console/Terminal/Common.hs
View File

@ -1,43 +0,0 @@
{-# 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
)

65
lib/System/Console/Terminal/Posix.hsc
View File

@ -1,65 +0,0 @@
{-# 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)