rename debug terminals to mock terminals.

This commit is contained in:
Corey O'Connor 2013-07-05 18:36:03 -07:00
parent 89b1a3a098
commit e6fb85e342
14 changed files with 102 additions and 97 deletions

View File

@ -32,11 +32,9 @@ is_set_attr expected_attr (SpanSetAttr in_attr)
| in_attr == expected_attr = True
is_set_attr _attr _event = False
data DebugWindow = DebugWindow Int Int
data MockWindow = MockWindow Int Int
deriving (Show, Eq)
region_for_window :: DebugWindow -> DisplayRegion
region_for_window (DebugWindow w h) = DisplayRegion w h
type TestWindow = DebugWindow
region_for_window :: MockWindow -> DisplayRegion
region_for_window (MockWindow w h) = DisplayRegion w h

View File

@ -33,7 +33,7 @@ module Graphics.Vty.Inline ( module Graphics.Vty.Inline
import Graphics.Vty.Attributes
import Graphics.Vty.DisplayAttributes
import Graphics.Vty.Terminal.Generic
import Graphics.Vty.Terminal.Interface
import Control.Applicative
import Control.Monad.State.Strict

View File

@ -1,13 +1,13 @@
-- | Generic Terminal interface.
-- | Terminal IO device.
--
-- Defines the common interface supported by all terminals.
-- Access to the current terminal or a specific terminal device.
--
-- See also:
--
-- 1. Graphics.Vty.Terminal: This instantiates an abtract interface to the terminal interface based
-- on the TERM and COLORTERM environment variables.
--
-- 2. Graphics.Vty.Terminal.Generic: Defines the generic interface all terminals need to implement.
-- 2. Graphics.Vty.Terminal.Interface: Defines the generic interface all terminals need to implement.
--
-- 3. Graphics.Vty.Terminal.TerminfoBased: Defines a terminal instance that uses terminfo for all
-- control strings. No attempt is made to change the character set to UTF-8 for these terminals.
@ -30,7 +30,7 @@ module Graphics.Vty.Terminal ( module Graphics.Vty.Terminal
import Graphics.Vty.DisplayRegion
import Graphics.Vty.Terminal.Generic
import Graphics.Vty.Terminal.Interface
import Graphics.Vty.Terminal.MacOSX as MacOSX
import Graphics.Vty.Terminal.XTermColor as XTermColor
import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
@ -42,7 +42,10 @@ import Control.Monad.Trans
import Data.List ( isPrefixOf )
import GHC.IO.Handle
import System.Environment
import System.IO
-- | Returns a TerminalHandle (an abstract Terminal instance) for the current terminal.
--
@ -84,23 +87,24 @@ import System.Environment
terminal_handle :: ( Applicative m, MonadIO m ) => m TerminalHandle
terminal_handle = do
term_type <- liftIO $ getEnv "TERM"
out_handle <- liftIO $ hDuplicate stdout
t <- if "xterm" `isPrefixOf` term_type
then do
maybe_terminal_app <- get_env "TERM_PROGRAM"
case maybe_terminal_app of
Nothing
-> XTermColor.terminal_instance term_type >>= new_terminal_handle
-> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle
Just v | v == "Apple_Terminal" || v == "iTerm.app"
-> do
maybe_xterm <- get_env "XTERM_VERSION"
case maybe_xterm of
Nothing -> MacOSX.terminal_instance v >>= new_terminal_handle
Just _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle
Nothing -> MacOSX.terminal_instance v out_handle >>= new_terminal_handle
Just _ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle
-- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app
-- like terminal?
_ -> XTermColor.terminal_instance term_type >>= new_terminal_handle
_ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle
-- Not an xterm-like terminal. try for generic terminfo.
else TerminfoBased.terminal_instance term_type >>= new_terminal_handle
else TerminfoBased.terminal_instance term_type out_handle >>= new_terminal_handle
return t
where
get_env var = do

View File

@ -1,11 +1,11 @@
-- Copyright 2009-2011 Corey O'Connor
-- Copyright Corey O'Connor
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
module Graphics.Vty.Terminal.Generic ( module Graphics.Vty.Terminal.Generic
module Graphics.Vty.Terminal.Interface ( module Graphics.Vty.Terminal.Interface
, OutputBuffer
)
where

View File

@ -14,7 +14,7 @@ module Graphics.Vty.Terminal.MacOSX ( terminal_instance
)
where
import Graphics.Vty.Terminal.Generic
import Graphics.Vty.Terminal.Interface
import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
import Control.Applicative
@ -32,11 +32,11 @@ data Term = Term
-- "xterm-256color" is used.
--
-- This effects the terminfo lookup.
terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term
terminal_instance v = do
terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m Term
terminal_instance v out_handle = do
let base_term "iTerm.app" = "xterm-256color"
base_term _ = "xterm"
t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle
t <- TerminfoBased.terminal_instance (base_term v) out_handle >>= new_terminal_handle
return $ Term t v
flushed_put :: MonadIO m => String -> m ()

View File

@ -1,15 +1,15 @@
-- Copyright 2009-2010 Corey O'Connor
-- Copyright Corey O'Connor
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Vty.Terminal.Debug ( DebugTerminal(..)
, DebugDisplay(..)
module Graphics.Vty.Terminal.Mock ( MockTerminal(..)
, MockDisplay(..)
, terminal_instance
, dehandle
)
where
import Graphics.Vty.DisplayRegion
import Graphics.Vty.Terminal.Generic
import Graphics.Vty.Terminal.Interface
import Control.Applicative
import Control.Monad.Trans
@ -27,12 +27,12 @@ import System.IO
import Unsafe.Coerce
-- | The debug display terminal produces a string representation of the requested picture. There is
-- | The mock display terminal produces a string representation of the requested picture. There is
-- *not* an isomorphism between the string representation and the picture. The string
-- representation is a simplification of the picture that is only useful in debugging VTY without
-- considering terminal specific issues.
--
-- The debug implementation is useful in manually determining if the sequence of terminal operations
-- The mock implementation is useful in manually determining if the sequence of terminal operations
-- matches the expected sequence. So requirement of the produced representation is simplicity in
-- parsing the text representation and determining how the picture was mapped to terminal
-- operations.
@ -42,42 +42,42 @@ import Unsafe.Coerce
-- class there exists a monoid that defines it's algebra. The string representation is a sequence of
-- identifiers where each identifier is the name of an operation in the algebra.
data DebugTerminal = DebugTerminal
{ debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)
, debug_terminal_bounds :: DisplayRegion
data MockTerminal = MockTerminal
{ mock_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)
, mock_terminal_bounds :: DisplayRegion
}
instance Terminal DebugTerminal where
terminal_ID _t = "debug_terminal"
instance Terminal MockTerminal where
terminal_ID _t = "mock_terminal"
release_terminal _t = return ()
reserve_display _t = return ()
release_display _t = return ()
display_bounds t = return $ debug_terminal_bounds t
display_terminal_instance _t r c = return $ c (DebugDisplay r)
display_bounds t = return $ mock_terminal_bounds t
display_terminal_instance _t r c = return $ c (MockDisplay r)
output_byte_buffer t out_buffer buffer_size
= liftIO $ do
putStrLn $ "output_byte_buffer ?? " ++ show buffer_size
peekArray (fromEnum buffer_size) out_buffer
>>= return . UTF8.fromRep . BSCore.pack
>>= writeIORef (debug_terminal_last_output t)
>>= writeIORef (mock_terminal_last_output t)
output_handle _t = return stdout
data DebugDisplay = DebugDisplay
{ debug_display_bounds :: DisplayRegion
data MockDisplay = MockDisplay
{ mock_display_bounds :: DisplayRegion
}
terminal_instance :: ( Applicative m, MonadIO m ) => DisplayRegion -> m TerminalHandle
terminal_instance r = do
output_ref <- liftIO $ newIORef undefined
new_terminal_handle $ DebugTerminal output_ref r
new_terminal_handle $ MockTerminal output_ref r
dehandle :: TerminalHandle -> DebugTerminal
dehandle :: TerminalHandle -> MockTerminal
dehandle (TerminalHandle t _) = unsafeCoerce t
instance DisplayTerminal DebugDisplay where
instance DisplayTerminal MockDisplay where
-- | Provide the current bounds of the output terminal.
context_region d = debug_display_bounds d
context_region d = mock_display_bounds d
-- | Assume 16 colors
context_color_count _d = 16

View File

@ -12,7 +12,7 @@ import Data.Terminfo.Eval
import Graphics.Vty.Attributes
import Graphics.Vty.DisplayAttributes
import Graphics.Vty.Terminal.Generic
import Graphics.Vty.Terminal.Interface
import Graphics.Vty.DisplayRegion
import Control.Applicative
@ -21,7 +21,6 @@ import Control.Monad.Trans
import Data.Bits ( (.&.) )
import Data.Maybe ( isJust, isNothing, fromJust )
import Data.Word
import Foreign.C.Types ( CLong(..) )
@ -73,8 +72,8 @@ marshall_cap_to_terminal t cap_selector cap_params = do
- todo: Some display attributes like underline and bold have independent string capabilities that
- should be used instead of the generic "sgr" string capability.
-}
terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term
terminal_instance in_ID = do
terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m Term
terminal_instance in_ID the_handle = do
ti <- liftIO $ Terminfo.setupTerm in_ID
let require_cap str
= case Terminfo.getCapability ti (Terminfo.tiGetStr str) of
@ -92,7 +91,6 @@ terminal_instance in_ID = do
case parse_result of
Left e -> fail $ show e
Right cap -> return $ Just cap
the_handle <- liftIO $ hDuplicate stdout
pure Term
<*> pure in_ID
<*> pure ti
@ -245,6 +243,9 @@ instance DisplayTerminal DisplayContext where
-- the case then the back and fore colors always need to be set if not default.
--
-- This equation implements the above logic.
--
-- \todo This assumes that fewer state changes, followed by fewer bytes, is what to optimize. I
-- haven't measured this or even examined terminal implementations. *shrug*
serialize_set_attr d prev_attr req_attr diffs out_ptr = do
case (fore_color_diff diffs == ColorToDefault) || (back_color_diff diffs == ColorToDefault) of
-- The only way to reset either color, portably, to the default is to use either the set

View File

@ -8,7 +8,7 @@ module Graphics.Vty.Terminal.XTermColor ( terminal_instance
)
where
import Graphics.Vty.Terminal.Generic
import Graphics.Vty.Terminal.Interface
import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
import Control.Applicative
@ -29,13 +29,13 @@ data XTermColor = XTermColor
}
-- | Initialize the display to UTF-8.
terminal_instance :: ( Applicative m, MonadIO m ) => String -> m XTermColor
terminal_instance variant = do
terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m XTermColor
terminal_instance variant out_handle = do
-- If the terminal variant is xterm-color use xterm instead since, more often than not,
-- xterm-color is broken.
let variant' = if variant == "xterm-color" then "xterm" else variant
flushed_put set_utf8_char_set
t <- TerminfoBased.terminal_instance variant' >>= new_terminal_handle
t <- TerminfoBased.terminal_instance variant' out_handle >>= new_terminal_handle
return $ XTermColor variant' t
-- | Output immediately followed by a flush.

View File

@ -10,6 +10,7 @@
module Verify ( module Verify
, module Control.DeepSeq
, module Test.QuickCheck
, module Test.QuickCheck.Modifiers
, succeeded
, failed
, result
@ -26,6 +27,7 @@ import qualified Distribution.TestSuite as TS
import Test.QuickCheck hiding ( Result(..) )
import qualified Test.QuickCheck as QC
import Test.QuickCheck.Modifiers
import Test.QuickCheck.Property hiding ( Result(..) )
import qualified Test.QuickCheck.Property as Prop
import Test.QuickCheck.Monadic ( monadicIO )

View File

@ -1,7 +1,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion
, module Graphics.Vty.DisplayRegion
, DebugWindow(..)
, MockWindow(..)
)
where
@ -10,17 +10,17 @@ import Graphics.Vty.DisplayRegion
import Verify
data EmptyWindow = EmptyWindow DebugWindow
data EmptyWindow = EmptyWindow MockWindow
instance Arbitrary EmptyWindow where
arbitrary = return $ EmptyWindow (DebugWindow (0 :: Int) (0 :: Int))
arbitrary = return $ EmptyWindow (MockWindow (0 :: Int) (0 :: Int))
instance Show EmptyWindow where
show (EmptyWindow _) = "EmptyWindow"
instance Arbitrary DebugWindow where
instance Arbitrary MockWindow where
arbitrary = do
w <- choose (1,1024)
h <- choose (1,1024)
return $ DebugWindow w h
return $ MockWindow w h

View File

@ -15,7 +15,7 @@ import Verify
data DefaultPic = DefaultPic
{ default_pic :: Picture
, default_win :: DebugWindow
, default_win :: MockWindow
, default_construct_log :: ImageConstructLog
}
@ -26,14 +26,14 @@ instance Show DefaultPic where
instance Arbitrary DefaultPic where
arbitrary = do
DefaultImage image image_construct_events <- arbitrary
let win = DebugWindow (image_width image) (image_height image)
let win = MockWindow (image_width image) (image_height image)
return $ DefaultPic (pic_for_image image)
win
image_construct_events
data PicWithBGAttr = PicWithBGAttr
{ with_attr_pic :: Picture
, with_attr_win :: DebugWindow
, with_attr_win :: MockWindow
, with_attr_construct_log :: ImageConstructLog
, with_attr_specified_attr :: Attr
} deriving ( Show )
@ -41,7 +41,7 @@ data PicWithBGAttr = PicWithBGAttr
instance Arbitrary PicWithBGAttr where
arbitrary = do
DefaultImage image image_construct_events <- arbitrary
let win = DebugWindow (image_width image) (image_height image)
let win = MockWindow (image_width image) (image_height image)
attr <- arbitrary
return $ PicWithBGAttr (pic_for_image image)
win

View File

@ -40,14 +40,14 @@ horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i })
horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result
horiz_span_image_and_equal_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
let p = pic_for_image i
w = DebugWindow c 1
w = MockWindow c 1
spans = spans_for_pic p (region_for_window w)
in verify_all_spans_have_width i spans c
horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool
horiz_span_image_and_equal_window_1 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
let p = pic_for_image i
w = DebugWindow c 1
w = MockWindow c 1
spans = spans_for_pic p (region_for_window w)
in span_ops_effected_rows spans == 1
@ -55,14 +55,14 @@ horiz_span_image_and_lesser_window_0 :: SingleRowSingleAttrImage -> Result
horiz_span_image_and_lesser_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
let p = pic_for_image i
lesser_width = c `div` 2
w = DebugWindow lesser_width 1
w = MockWindow lesser_width 1
spans = spans_for_pic p (region_for_window w)
in verify_all_spans_have_width i spans lesser_width
single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result
single_attr_single_span_stack_cropped_0 stack =
let p = pic_for_image (stack_image stack)
w = DebugWindow (stack_width stack `div` 2) (stack_height stack)
w = MockWindow (stack_width stack `div` 2) (stack_height stack)
spans = spans_for_pic p (region_for_window w)
in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2)
@ -70,7 +70,7 @@ single_attr_single_span_stack_cropped_1 :: SingleAttrSingleSpanStack -> Bool
single_attr_single_span_stack_cropped_1 stack =
let p = pic_for_image (stack_image stack)
expected_row_count = stack_height stack `div` 2
w = DebugWindow (stack_width stack) expected_row_count
w = MockWindow (stack_width stack) expected_row_count
spans = spans_for_pic p (region_for_window w)
actual_row_count = span_ops_effected_rows spans
in expected_row_count == actual_row_count
@ -78,14 +78,14 @@ single_attr_single_span_stack_cropped_1 stack =
single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
single_attr_single_span_stack_cropped_2 stack_0 stack_1 =
let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)
w = DebugWindow (stack_width stack_0) (image_height (pic_image p))
w = MockWindow (stack_width stack_0) (image_height (pic_image p))
spans = spans_for_pic p (region_for_window w)
in verify_all_spans_have_width (pic_image p) spans (stack_width stack_0)
single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
single_attr_single_span_stack_cropped_3 stack_0 stack_1 =
let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)
w = DebugWindow (image_width (pic_image p)) expected_row_count
w = MockWindow (image_width (pic_image p)) expected_row_count
spans = spans_for_pic p (region_for_window w)
expected_row_count = image_height (pic_image p) `div` 2
actual_row_count = span_ops_effected_rows spans
@ -94,7 +94,7 @@ single_attr_single_span_stack_cropped_3 stack_0 stack_1 =
single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
single_attr_single_span_stack_cropped_4 stack_0 stack_1 =
let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)
w = DebugWindow expected_width (image_height (pic_image p))
w = MockWindow expected_width (image_height (pic_image p))
spans = spans_for_pic p (region_for_window w)
expected_width = image_width (pic_image p) `div` 2
in verify_all_spans_have_width (pic_image p) spans expected_width
@ -102,7 +102,7 @@ single_attr_single_span_stack_cropped_4 stack_0 stack_1 =
single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
single_attr_single_span_stack_cropped_5 stack_0 stack_1 =
let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)
w = DebugWindow (image_width (pic_image p)) (stack_height stack_0)
w = MockWindow (image_width (pic_image p)) (stack_height stack_0)
spans = spans_for_pic p (region_for_window w)
expected_row_count = stack_height stack_0
actual_row_count = span_ops_effected_rows spans
@ -113,12 +113,12 @@ horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i,
let p = pic_for_image i
-- SingleRowSingleAttrImage always has width >= 1
greater_width = c * 2
w = DebugWindow greater_width 1
w = MockWindow greater_width 1
spans = spans_for_pic p (region_for_window w)
in verify_all_spans_have_width i spans greater_width
arb_image_is_cropped :: DefaultImage -> DebugWindow -> Bool
arb_image_is_cropped (DefaultImage image _) win@(DebugWindow w h) =
arb_image_is_cropped :: DefaultImage -> MockWindow -> Bool
arb_image_is_cropped (DefaultImage image _) win@(MockWindow w h) =
let pic = pic_for_image image
spans = spans_for_pic pic (region_for_window win)
in ( span_ops_effected_rows spans == h ) && ( all_spans_have_width spans w )
@ -144,7 +144,7 @@ first_span_op_sets_attr DefaultPic { default_pic = pic, default_win = win } =
single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result
single_attr_single_span_stack_op_coverage stack =
let p = pic_for_image (stack_image stack)
w = DebugWindow (stack_width stack) (stack_height stack)
w = MockWindow (stack_width stack) (stack_height stack)
spans = spans_for_pic p (region_for_window w)
in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)

View File

@ -1,12 +1,12 @@
{-# LANGUAGE ScopedTypeVariables #-}
module VerifyMockTerminal where
module VerifyTerminal where
import Verify.Graphics.Vty.DisplayRegion
import Verify.Graphics.Vty.Picture
import Verify.Graphics.Vty.Image
import Verify.Graphics.Vty.Span
import Graphics.Vty.Terminal
import Graphics.Vty.Terminal.Debug
import Graphics.Vty.Terminal.Mock
import Graphics.Vty.Debug
@ -26,23 +26,23 @@ unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do
output_picture d pic
return succeeded
unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property
unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do
unit_image_arb_bounds :: UnitImage -> MockWindow -> Property
unit_image_arb_bounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do
t <- terminal_instance (DisplayRegion w h)
d <- display_bounds t >>= display_context t
let pic = pic_for_image i
output_picture d pic
return succeeded
single_T_row :: DebugWindow -> Property
single_T_row (DebugWindow w h) = liftIOResult $ do
single_T_row :: MockWindow -> Property
single_T_row (MockWindow w h) = liftIOResult $ do
t <- terminal_instance (DisplayRegion w h)
d <- display_bounds t >>= display_context t
-- create an image that contains just the character T repeated for a single row
let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
output_picture d pic
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
-- The UTF8 string that represents the output bytes a single line containing the T string:
let expected = "HD" ++ "MA" ++ replicate (fromEnum w) 'T'
-- Followed by h - 1 lines of a change to the background attribute and then the background
@ -53,15 +53,15 @@ single_T_row (DebugWindow w h) = liftIOResult $ do
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
else return succeeded
many_T_rows :: DebugWindow -> Property
many_T_rows (DebugWindow w h) = liftIOResult $ do
many_T_rows :: MockWindow -> Property
many_T_rows (MockWindow w h) = liftIOResult $ do
t <- terminal_instance (DisplayRegion w h)
d <- display_bounds t >>= display_context t
-- create an image that contains the character 'T' repeated for all the rows
let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
output_picture d pic
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
-- attribute change. 'A', followed by w 'T's
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
@ -70,15 +70,15 @@ many_T_rows (DebugWindow w h) = liftIOResult $ do
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
else return succeeded
many_T_rows_cropped_width :: DebugWindow -> Property
many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do
many_T_rows_cropped_width :: MockWindow -> Property
many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
t <- terminal_instance (DisplayRegion w h)
d <- display_bounds t >>= display_context t
-- create an image that contains the character 'T' repeated for all the rows
let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
output_picture d pic
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
-- attribute change. 'A', followed by w 'T's
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
@ -87,15 +87,15 @@ many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
else return succeeded
many_T_rows_cropped_height :: DebugWindow -> Property
many_T_rows_cropped_height (DebugWindow w h) = liftIOResult $ do
many_T_rows_cropped_height :: MockWindow -> Property
many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
t <- terminal_instance (DisplayRegion w h)
d <- display_bounds t >>= display_context t
-- create an image that contains the character 'T' repeated for all the rows
let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
output_picture d pic
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
-- attribute change. 'A', followed by w count 'T's
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')

View File

@ -74,8 +74,8 @@ library
Graphics.Vty.Image.Internal
Graphics.Vty.PictureToSpans
Graphics.Vty.Span
Graphics.Vty.Terminal.Debug
Graphics.Vty.Terminal.Generic
Graphics.Vty.Terminal.Mock
Graphics.Vty.Terminal.Interface
Graphics.Vty.Terminal.MacOSX
Graphics.Vty.Terminal.XTermColor
Graphics.Vty.Terminal.TerminfoBased
@ -119,14 +119,14 @@ test-suite verify-attribute-ops
vector >= 0.7
test-suite verify-using-mock-terminal
test-suite verify-terminal
default-language: Haskell2010
type: detailed-0.9
hs-source-dirs: test
test-module: VerifyMockTerminal
test-module: VerifyTerminal
other-modules: Verify
Verify.Graphics.Vty.Attributes