e6fb85e · vty · git.iko.soy

git.iko.soy/vty

rename debug terminals to mock terminals.

commite6fb85e3429ab4c858c04e6cf15c62948e9ad0d0 authorCorey O'Connor <coreyoconnor@gmail.com> dateFri 5 Jul 2013, 18:36 (13 years ago) parent89b1a3a

14 files changed+102−97

compare with master

unifiedsplit

src/Graphics/Vty/Debug.hs+3−5

@@ -32,11 +32,9 @@ is_set_attr expected_attr (SpanSetAttr in_attr)

3232 | in_attr == expected_attr = True

3333is_set_attr _attr _event = False

3434

35−data DebugWindow = DebugWindow Int Int

35+data MockWindow = MockWindow Int Int

3636 deriving (Show, Eq)

3737

38−region_for_window :: DebugWindow -> DisplayRegion

39−region_for_window (DebugWindow w h) = DisplayRegion w h

40−

41−type TestWindow = DebugWindow

38+region_for_window :: MockWindow -> DisplayRegion

39+region_for_window (MockWindow w h) = DisplayRegion w h

4240

src/Graphics/Vty/Inline.hs+1−1

@@ -33,7 +33,7 @@ module Graphics.Vty.Inline ( module Graphics.Vty.Inline

3333

3434import Graphics.Vty.Attributes

3535import Graphics.Vty.DisplayAttributes

36−import Graphics.Vty.Terminal.Generic

36+import Graphics.Vty.Terminal.Interface

3737

3838import Control.Applicative

3939import Control.Monad.State.Strict

src/Graphics/Vty/Terminal.hs+13−9

@@ -1,13 +1,13 @@

1−-- | Generic Terminal interface.

1+-- | Terminal IO device.

22--

3−-- Defines the common interface supported by all terminals.

3+-- Access to the current terminal or a specific terminal device.

44--

55-- See also:

66--

77-- 1. Graphics.Vty.Terminal: This instantiates an abtract interface to the terminal interface based

88-- on the TERM and COLORTERM environment variables.

99--

10−-- 2. Graphics.Vty.Terminal.Generic: Defines the generic interface all terminals need to implement.

10+-- 2. Graphics.Vty.Terminal.Interface: Defines the generic interface all terminals need to implement.

1111--

1212-- 3. Graphics.Vty.Terminal.TerminfoBased: Defines a terminal instance that uses terminfo for all

1313-- 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

3030

3131

3232import Graphics.Vty.DisplayRegion

33−import Graphics.Vty.Terminal.Generic

33+import Graphics.Vty.Terminal.Interface

3434import Graphics.Vty.Terminal.MacOSX as MacOSX

3535import Graphics.Vty.Terminal.XTermColor as XTermColor

3636import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

@@ -42,7 +42,10 @@ import Control.Monad.Trans

4242

4343import Data.List ( isPrefixOf )

4444

45+import GHC.IO.Handle

46+

4547import System.Environment

48+import System.IO

4649

4750-- | Returns a TerminalHandle (an abstract Terminal instance) for the current terminal.

4851--

@@ -84,23 +87,24 @@ import System.Environment

8487terminal_handle :: ( Applicative m, MonadIO m ) => m TerminalHandle

8588terminal_handle = do

8689 term_type <- liftIO $ getEnv "TERM"

90+ out_handle <- liftIO $ hDuplicate stdout

8791 t <- if "xterm" `isPrefixOf` term_type

8892 then do

8993 maybe_terminal_app <- get_env "TERM_PROGRAM"

9094 case maybe_terminal_app of

9195 Nothing

92− -> XTermColor.terminal_instance term_type >>= new_terminal_handle

96+ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle

9397 Just v | v == "Apple_Terminal" || v == "iTerm.app"

9498 -> do

9599 maybe_xterm <- get_env "XTERM_VERSION"

96100 case maybe_xterm of

97− Nothing -> MacOSX.terminal_instance v >>= new_terminal_handle

98− Just _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle

101+ Nothing -> MacOSX.terminal_instance v out_handle >>= new_terminal_handle

102+ Just _ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle

99103 -- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app

100104 -- like terminal?

101− _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle

105+ _ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle

102106 -- Not an xterm-like terminal. try for generic terminfo.

103− else TerminfoBased.terminal_instance term_type >>= new_terminal_handle

107+ else TerminfoBased.terminal_instance term_type out_handle >>= new_terminal_handle

104108 return t

105109 where

106110 get_env var = do

src/Graphics/Vty/Terminal/Generic.hs → src/Graphics/Vty/Terminal/Interface.hsrenamed+4−4

@@ -1,13 +1,13 @@

1+-- Copyright Corey O'Connor

22{-# LANGUAGE BangPatterns #-}

33{-# LANGUAGE RankNTypes #-}

44{-# LANGUAGE ScopedTypeVariables #-}

55{-# LANGUAGE ExistentialQuantification #-}

66{-# LANGUAGE GADTs #-}

77{-# LANGUAGE FlexibleContexts #-}

8−module Graphics.Vty.Terminal.Generic ( module Graphics.Vty.Terminal.Generic

9− , OutputBuffer

10− )

8+module Graphics.Vty.Terminal.Interface ( module Graphics.Vty.Terminal.Interface

9+ , OutputBuffer

10+ )

1111 where

1212

1313import Data.Marshalling

src/Graphics/Vty/Terminal/MacOSX.hs+4−4

@@ -14,7 +14,7 @@ module Graphics.Vty.Terminal.MacOSX ( terminal_instance

1414 )

1515 where

1616

17−import Graphics.Vty.Terminal.Generic

17+import Graphics.Vty.Terminal.Interface

1818import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

1919

2020import Control.Applicative

@@ -32,11 +32,11 @@ data Term = Term

3232-- "xterm-256color" is used.

3333--

3434-- This effects the terminfo lookup.

35−terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term

36−terminal_instance v = do

35+terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m Term

36+terminal_instance v out_handle = do

3737 let base_term "iTerm.app" = "xterm-256color"

3838 base_term _ = "xterm"

39− t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle

39+ t <- TerminfoBased.terminal_instance (base_term v) out_handle >>= new_terminal_handle

4040 return $ Term t v

4141

4242flushed_put :: MonadIO m => String -> m ()

src/Graphics/Vty/Terminal/Debug.hs → src/Graphics/Vty/Terminal/Mock.hsrenamed+23−23

@@ -1,15 +1,15 @@

1+-- Copyright Corey O'Connor

22{-# LANGUAGE FlexibleInstances #-}

33{-# LANGUAGE TypeFamilies #-}

4−module Graphics.Vty.Terminal.Debug ( DebugTerminal(..)

5− , DebugDisplay(..)

6− , terminal_instance

7− , dehandle

8− )

4+module Graphics.Vty.Terminal.Mock ( MockTerminal(..)

5+ , MockDisplay(..)

6+ , terminal_instance

7+ , dehandle

8+ )

99 where

1010

1111import Graphics.Vty.DisplayRegion

12−import Graphics.Vty.Terminal.Generic

12+import Graphics.Vty.Terminal.Interface

1313

1414import Control.Applicative

1515import Control.Monad.Trans

@@ -27,12 +27,12 @@ import System.IO

2727

2828import Unsafe.Coerce

2929

30−-- | The debug display terminal produces a string representation of the requested picture. There is

30+-- | The mock display terminal produces a string representation of the requested picture. There is

3131-- *not* an isomorphism between the string representation and the picture. The string

3232-- representation is a simplification of the picture that is only useful in debugging VTY without

3333-- considering terminal specific issues.

3434--

35−-- The debug implementation is useful in manually determining if the sequence of terminal operations

35+-- The mock implementation is useful in manually determining if the sequence of terminal operations

3636-- matches the expected sequence. So requirement of the produced representation is simplicity in

3737-- parsing the text representation and determining how the picture was mapped to terminal

3838-- operations.

@@ -42,42 +42,42 @@ import Unsafe.Coerce

4242-- class there exists a monoid that defines it's algebra. The string representation is a sequence of

4343-- identifiers where each identifier is the name of an operation in the algebra.

4444

45−data DebugTerminal = DebugTerminal

46− { debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)

47− , debug_terminal_bounds :: DisplayRegion

45+data MockTerminal = MockTerminal

46+ { mock_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)

47+ , mock_terminal_bounds :: DisplayRegion

4848 }

4949

50−instance Terminal DebugTerminal where

51− terminal_ID _t = "debug_terminal"

50+instance Terminal MockTerminal where

51+ terminal_ID _t = "mock_terminal"

5252 release_terminal _t = return ()

5353 reserve_display _t = return ()

5454 release_display _t = return ()

55− display_bounds t = return $ debug_terminal_bounds t

56− display_terminal_instance _t r c = return $ c (DebugDisplay r)

55+ display_bounds t = return $ mock_terminal_bounds t

56+ display_terminal_instance _t r c = return $ c (MockDisplay r)

5757 output_byte_buffer t out_buffer buffer_size

5858 = liftIO $ do

5959 putStrLn $ "output_byte_buffer ?? " ++ show buffer_size

6060 peekArray (fromEnum buffer_size) out_buffer

6161 >>= return . UTF8.fromRep . BSCore.pack

62− >>= writeIORef (debug_terminal_last_output t)

62+ >>= writeIORef (mock_terminal_last_output t)

6363

6464 output_handle _t = return stdout

6565

66−data DebugDisplay = DebugDisplay

67− { debug_display_bounds :: DisplayRegion

66+data MockDisplay = MockDisplay

67+ { mock_display_bounds :: DisplayRegion

6868 }

6969

7070terminal_instance :: ( Applicative m, MonadIO m ) => DisplayRegion -> m TerminalHandle

7171terminal_instance r = do

7272 output_ref <- liftIO $ newIORef undefined

73− new_terminal_handle $ DebugTerminal output_ref r

73+ new_terminal_handle $ MockTerminal output_ref r

7474

75−dehandle :: TerminalHandle -> DebugTerminal

75+dehandle :: TerminalHandle -> MockTerminal

7676dehandle (TerminalHandle t _) = unsafeCoerce t

7777

78−instance DisplayTerminal DebugDisplay where

78+instance DisplayTerminal MockDisplay where

7979 -- | Provide the current bounds of the output terminal.

80− context_region d = debug_display_bounds d

80+ context_region d = mock_display_bounds d

8181

8282 -- | Assume 16 colors

8383 context_color_count _d = 16

src/Graphics/Vty/Terminal/TerminfoBased.hs+6−5

@@ -12,7 +12,7 @@ import Data.Terminfo.Eval

1212

1313import Graphics.Vty.Attributes

1414import Graphics.Vty.DisplayAttributes

15−import Graphics.Vty.Terminal.Generic

15+import Graphics.Vty.Terminal.Interface

1616import Graphics.Vty.DisplayRegion

1717

1818import Control.Applicative

@@ -21,7 +21,6 @@ import Control.Monad.Trans

2121

2222import Data.Bits ( (.&.) )

2323import Data.Maybe ( isJust, isNothing, fromJust )

24−import Data.Word

2524

2625import Foreign.C.Types ( CLong(..) )

2726

@@ -73,8 +72,8 @@ marshall_cap_to_terminal t cap_selector cap_params = do

7372 - todo: Some display attributes like underline and bold have independent string capabilities that

7473 - should be used instead of the generic "sgr" string capability.

7574 -}

76−terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term

77−terminal_instance in_ID = do

75+terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m Term

76+terminal_instance in_ID the_handle = do

7877 ti <- liftIO $ Terminfo.setupTerm in_ID

7978 let require_cap str

8079 = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of

@@ -92,7 +91,6 @@ terminal_instance in_ID = do

9291 case parse_result of

9392 Left e -> fail $ show e

9493 Right cap -> return $ Just cap

95− the_handle <- liftIO $ hDuplicate stdout

9694 pure Term

9795 <*> pure in_ID

9896 <*> pure ti

@@ -245,6 +243,9 @@ instance DisplayTerminal DisplayContext where

245243 -- the case then the back and fore colors always need to be set if not default.

246244 --

247245 -- This equation implements the above logic.

246+ --

247+ -- \todo This assumes that fewer state changes, followed by fewer bytes, is what to optimize. I

248+ -- haven't measured this or even examined terminal implementations. *shrug*

248249 serialize_set_attr d prev_attr req_attr diffs out_ptr = do

249250 case (fore_color_diff diffs == ColorToDefault) || (back_color_diff diffs == ColorToDefault) of

250251 -- The only way to reset either color, portably, to the default is to use either the set

src/Graphics/Vty/Terminal/XTermColor.hs+4−4

@@ -8,7 +8,7 @@ module Graphics.Vty.Terminal.XTermColor ( terminal_instance

88 )

99 where

1010

11−import Graphics.Vty.Terminal.Generic

11+import Graphics.Vty.Terminal.Interface

1212import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

1313

1414import Control.Applicative

@@ -29,13 +29,13 @@ data XTermColor = XTermColor

2929 }

3030

3131-- | Initialize the display to UTF-8.

32−terminal_instance :: ( Applicative m, MonadIO m ) => String -> m XTermColor

33−terminal_instance variant = do

32+terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m XTermColor

33+terminal_instance variant out_handle = do

3434 -- If the terminal variant is xterm-color use xterm instead since, more often than not,

3535 -- xterm-color is broken.

3636 let variant' = if variant == "xterm-color" then "xterm" else variant

3737 flushed_put set_utf8_char_set

38− t <- TerminfoBased.terminal_instance variant' >>= new_terminal_handle

38+ t <- TerminfoBased.terminal_instance variant' out_handle >>= new_terminal_handle

3939 return $ XTermColor variant' t

4040

4141-- | Output immediately followed by a flush.

test/Verify.hs+2

@@ -10,6 +10,7 @@

1010module Verify ( module Verify

1111 , module Control.DeepSeq

1212 , module Test.QuickCheck

13+ , module Test.QuickCheck.Modifiers

1314 , succeeded

1415 , failed

1516 , result

@@ -26,6 +27,7 @@ import qualified Distribution.TestSuite as TS

2627

2728import Test.QuickCheck hiding ( Result(..) )

2829import qualified Test.QuickCheck as QC

30+import Test.QuickCheck.Modifiers

2931import Test.QuickCheck.Property hiding ( Result(..) )

3032import qualified Test.QuickCheck.Property as Prop

3133import Test.QuickCheck.Monadic ( monadicIO )

test/Verify/Graphics/Vty/DisplayRegion.hs+5−5

@@ -1,7 +1,7 @@

11{-# LANGUAGE ScopedTypeVariables #-}

22module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion

33 , module Graphics.Vty.DisplayRegion

4− , DebugWindow(..)

4+ , MockWindow(..)

55 )

66 where

@@ -10,17 +10,17 @@ import Graphics.Vty.DisplayRegion

1010

1111import Verify

1212

13−data EmptyWindow = EmptyWindow DebugWindow

13+data EmptyWindow = EmptyWindow MockWindow

1414

1515instance Arbitrary EmptyWindow where

16− arbitrary = return $ EmptyWindow (DebugWindow (0 :: Int) (0 :: Int))

16+ arbitrary = return $ EmptyWindow (MockWindow (0 :: Int) (0 :: Int))

1717

1818instance Show EmptyWindow where

1919 show (EmptyWindow _) = "EmptyWindow"

2020

21−instance Arbitrary DebugWindow where

21+instance Arbitrary MockWindow where

2222 arbitrary = do

2323 w <- choose (1,1024)

2424 h <- choose (1,1024)

25− return $ DebugWindow w h

25+ return $ MockWindow w h

2626

test/Verify/Graphics/Vty/Picture.hs+4−4

@@ -15,7 +15,7 @@ import Verify

1515

1616data DefaultPic = DefaultPic

1717 { default_pic :: Picture

18− , default_win :: DebugWindow

18+ , default_win :: MockWindow

1919 , default_construct_log :: ImageConstructLog

2020 }

2121

@@ -26,14 +26,14 @@ instance Show DefaultPic where

2626instance Arbitrary DefaultPic where

2727 arbitrary = do

2828 DefaultImage image image_construct_events <- arbitrary

29− let win = DebugWindow (image_width image) (image_height image)

29+ let win = MockWindow (image_width image) (image_height image)

3030 return $ DefaultPic (pic_for_image image)

3131 win

3232 image_construct_events

3333

3434data PicWithBGAttr = PicWithBGAttr

3535 { with_attr_pic :: Picture

36− , with_attr_win :: DebugWindow

36+ , with_attr_win :: MockWindow

3737 , with_attr_construct_log :: ImageConstructLog

3838 , with_attr_specified_attr :: Attr

3939 } deriving ( Show )

@@ -41,7 +41,7 @@ data PicWithBGAttr = PicWithBGAttr

4141instance Arbitrary PicWithBGAttr where

4242 arbitrary = do

4343 DefaultImage image image_construct_events <- arbitrary

44− let win = DebugWindow (image_width image) (image_height image)

44+ let win = MockWindow (image_width image) (image_height image)

4545 attr <- arbitrary

4646 return $ PicWithBGAttr (pic_for_image image)

4747 win

test/VerifySpanOps.hs+13−13

@@ -40,14 +40,14 @@ horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i })

4040horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result

4141horiz_span_image_and_equal_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

4242 let p = pic_for_image i

43− w = DebugWindow c 1

43+ w = MockWindow c 1

4444 spans = spans_for_pic p (region_for_window w)

4545 in verify_all_spans_have_width i spans c

4646

4747horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool

4848horiz_span_image_and_equal_window_1 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

4949 let p = pic_for_image i

50− w = DebugWindow c 1

50+ w = MockWindow c 1

5151 spans = spans_for_pic p (region_for_window w)

5252 in span_ops_effected_rows spans == 1

5353

@@ -55,14 +55,14 @@ horiz_span_image_and_lesser_window_0 :: SingleRowSingleAttrImage -> Result

5555horiz_span_image_and_lesser_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

5656 let p = pic_for_image i

5757 lesser_width = c `div` 2

58− w = DebugWindow lesser_width 1

58+ w = MockWindow lesser_width 1

5959 spans = spans_for_pic p (region_for_window w)

6060 in verify_all_spans_have_width i spans lesser_width

6161

6262single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result

6363single_attr_single_span_stack_cropped_0 stack =

6464 let p = pic_for_image (stack_image stack)

65− w = DebugWindow (stack_width stack `div` 2) (stack_height stack)

65+ w = MockWindow (stack_width stack `div` 2) (stack_height stack)

6666 spans = spans_for_pic p (region_for_window w)

6767 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2)

6868

@@ -70,7 +70,7 @@ single_attr_single_span_stack_cropped_1 :: SingleAttrSingleSpanStack -> Bool

7070single_attr_single_span_stack_cropped_1 stack =

7171 let p = pic_for_image (stack_image stack)

7272 expected_row_count = stack_height stack `div` 2

73− w = DebugWindow (stack_width stack) expected_row_count

73+ w = MockWindow (stack_width stack) expected_row_count

7474 spans = spans_for_pic p (region_for_window w)

7575 actual_row_count = span_ops_effected_rows spans

7676 in expected_row_count == actual_row_count

@@ -78,14 +78,14 @@ single_attr_single_span_stack_cropped_1 stack =

7878single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

7979single_attr_single_span_stack_cropped_2 stack_0 stack_1 =

8080 let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)

81− w = DebugWindow (stack_width stack_0) (image_height (pic_image p))

81+ w = MockWindow (stack_width stack_0) (image_height (pic_image p))

8282 spans = spans_for_pic p (region_for_window w)

8383 in verify_all_spans_have_width (pic_image p) spans (stack_width stack_0)

8484

8585single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool

8686single_attr_single_span_stack_cropped_3 stack_0 stack_1 =

8787 let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)

88− w = DebugWindow (image_width (pic_image p)) expected_row_count

88+ w = MockWindow (image_width (pic_image p)) expected_row_count

8989 spans = spans_for_pic p (region_for_window w)

9090 expected_row_count = image_height (pic_image p) `div` 2

9191 actual_row_count = span_ops_effected_rows spans

@@ -94,7 +94,7 @@ single_attr_single_span_stack_cropped_3 stack_0 stack_1 =

9494single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

9595single_attr_single_span_stack_cropped_4 stack_0 stack_1 =

9696 let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)

97− w = DebugWindow expected_width (image_height (pic_image p))

97+ w = MockWindow expected_width (image_height (pic_image p))

9898 spans = spans_for_pic p (region_for_window w)

9999 expected_width = image_width (pic_image p) `div` 2

100100 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 =

102102single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool

103103single_attr_single_span_stack_cropped_5 stack_0 stack_1 =

104104 let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)

105− w = DebugWindow (image_width (pic_image p)) (stack_height stack_0)

105+ w = MockWindow (image_width (pic_image p)) (stack_height stack_0)

106106 spans = spans_for_pic p (region_for_window w)

107107 expected_row_count = stack_height stack_0

108108 actual_row_count = span_ops_effected_rows spans

@@ -113,12 +113,12 @@ horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i,

113113 let p = pic_for_image i

114114 -- SingleRowSingleAttrImage always has width >= 1

115115 greater_width = c * 2

116− w = DebugWindow greater_width 1

116+ w = MockWindow greater_width 1

117117 spans = spans_for_pic p (region_for_window w)

118118 in verify_all_spans_have_width i spans greater_width

119119

120−arb_image_is_cropped :: DefaultImage -> DebugWindow -> Bool

121−arb_image_is_cropped (DefaultImage image _) win@(DebugWindow w h) =

120+arb_image_is_cropped :: DefaultImage -> MockWindow -> Bool

121+arb_image_is_cropped (DefaultImage image _) win@(MockWindow w h) =

122122 let pic = pic_for_image image

123123 spans = spans_for_pic pic (region_for_window win)

124124 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 } =

144144single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result

145145single_attr_single_span_stack_op_coverage stack =

146146 let p = pic_for_image (stack_image stack)

147− w = DebugWindow (stack_width stack) (stack_height stack)

147+ w = MockWindow (stack_width stack) (stack_height stack)

148148 spans = spans_for_pic p (region_for_window w)

149149 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)

150150

test/VerifyMockTerminal.hs → test/VerifyTerminal.hsrenamed+16−16

@@ -1,12 +1,12 @@

11{-# LANGUAGE ScopedTypeVariables #-}

2−module VerifyMockTerminal where

2+module VerifyTerminal where

44import Verify.Graphics.Vty.DisplayRegion

55import Verify.Graphics.Vty.Picture

66import Verify.Graphics.Vty.Image

77import Verify.Graphics.Vty.Span

88import Graphics.Vty.Terminal

9−import Graphics.Vty.Terminal.Debug

9+import Graphics.Vty.Terminal.Mock

1010

1111import Graphics.Vty.Debug

1212

@@ -26,23 +26,23 @@ unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do

2626 output_picture d pic

2727 return succeeded

2828

29−unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property

30−unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do

29+unit_image_arb_bounds :: UnitImage -> MockWindow -> Property

30+unit_image_arb_bounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do

3131 t <- terminal_instance (DisplayRegion w h)

3232 d <- display_bounds t >>= display_context t

3333 let pic = pic_for_image i

3434 output_picture d pic

3535 return succeeded

3636

37−single_T_row :: DebugWindow -> Property

38−single_T_row (DebugWindow w h) = liftIOResult $ do

37+single_T_row :: MockWindow -> Property

38+single_T_row (MockWindow w h) = liftIOResult $ do

3939 t <- terminal_instance (DisplayRegion w h)

4040 d <- display_bounds t >>= display_context t

4141 -- create an image that contains just the character T repeated for a single row

4242 let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

4343 pic = (pic_for_image i) { pic_background = Background 'B' def_attr }

4444 output_picture d pic

45− out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

45+ out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

4646 -- The UTF8 string that represents the output bytes a single line containing the T string:

4747 let expected = "HD" ++ "MA" ++ replicate (fromEnum w) 'T'

4848 -- 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

5353 then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }

5454 else return succeeded

5555

56−many_T_rows :: DebugWindow -> Property

57−many_T_rows (DebugWindow w h) = liftIOResult $ do

56+many_T_rows :: MockWindow -> Property

57+many_T_rows (MockWindow w h) = liftIOResult $ do

5858 t <- terminal_instance (DisplayRegion w h)

5959 d <- display_bounds t >>= display_context t

6060 -- create an image that contains the character 'T' repeated for all the rows

6161 let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

6262 pic = (pic_for_image i) { pic_background = Background 'B' def_attr }

6363 output_picture d pic

64− out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

64+ out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

6565 -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

6666 -- attribute change. 'A', followed by w 'T's

6767 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')

@@ -70,15 +70,15 @@ many_T_rows (DebugWindow w h) = liftIOResult $ do

7070 then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }

7171 else return succeeded

7272

73−many_T_rows_cropped_width :: DebugWindow -> Property

74−many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do

73+many_T_rows_cropped_width :: MockWindow -> Property

74+many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do

7575 t <- terminal_instance (DisplayRegion w h)

7676 d <- display_bounds t >>= display_context t

7777 -- create an image that contains the character 'T' repeated for all the rows

7878 let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')

7979 pic = (pic_for_image i) { pic_background = Background 'B' def_attr }

8080 output_picture d pic

81− out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

81+ out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

8282 -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

8383 -- attribute change. 'A', followed by w 'T's

8484 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

8787 then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }

8888 else return succeeded

8989

90−many_T_rows_cropped_height :: DebugWindow -> Property

91−many_T_rows_cropped_height (DebugWindow w h) = liftIOResult $ do

90+many_T_rows_cropped_height :: MockWindow -> Property

91+many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do

9292 t <- terminal_instance (DisplayRegion w h)

9393 d <- display_bounds t >>= display_context t

9494 -- create an image that contains the character 'T' repeated for all the rows

9595 let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

9696 pic = (pic_for_image i) { pic_background = Background 'B' def_attr }

9797 output_picture d pic

98− out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

98+ out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep

9999 -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

100100 -- attribute change. 'A', followed by w count 'T's

101101 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')

vty.cabal+4−4

@@ -74,8 +74,8 @@ library

7474 Graphics.Vty.Image.Internal

7575 Graphics.Vty.PictureToSpans

7676 Graphics.Vty.Span

77− Graphics.Vty.Terminal.Debug

78− Graphics.Vty.Terminal.Generic

77+ Graphics.Vty.Terminal.Mock

78+ Graphics.Vty.Terminal.Interface

7979 Graphics.Vty.Terminal.MacOSX

8080 Graphics.Vty.Terminal.XTermColor

8181 Graphics.Vty.Terminal.TerminfoBased

@@ -119,14 +119,14 @@ test-suite verify-attribute-ops

119119 vector >= 0.7

120120

121121

122−test-suite verify-using-mock-terminal

122+test-suite verify-terminal

123123 default-language: Haskell2010

124124

125125 type: detailed-0.9

126126

127127 hs-source-dirs: test

128128

129− test-module: VerifyMockTerminal

129+ test-module: VerifyTerminal

130130

131131 other-modules: Verify

132132 Verify.Graphics.Vty.Attributes