e6fb85e · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

rename debug terminals to mock terminals.

e6fb85eCorey O'Connor13 years ago

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

compare with master

unifiedsplit

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

32 | in_attr == expected_attr = True

33is_set_attr _attr _event = False

35−data DebugWindow = DebugWindow Int Int

35+data MockWindow = MockWindow Int Int

36 deriving (Show, Eq)

38−region_for_window :: DebugWindow -> DisplayRegion

38+region_for_window :: MockWindow -> DisplayRegion

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

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

40−

41−type TestWindow = DebugWindow

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

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

34import Graphics.Vty.Attributes

35import Graphics.Vty.DisplayAttributes

36−import Graphics.Vty.Terminal.Generic

36+import Graphics.Vty.Terminal.Interface

38import Control.Applicative

39import Control.Monad.State.Strict

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

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

1−-- | Generic Terminal interface.

1+-- | Terminal IO device.

2--

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

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

4--

5-- See also:

6--

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

8-- on the TERM and COLORTERM environment variables.

9--

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.

11--

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

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

32import Graphics.Vty.DisplayRegion

33−import Graphics.Vty.Terminal.Generic

33+import Graphics.Vty.Terminal.Interface

34import Graphics.Vty.Terminal.MacOSX as MacOSX

35import Graphics.Vty.Terminal.XTermColor as XTermColor

36import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

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

43import Data.List ( isPrefixOf )

45+import GHC.IO.Handle

46+

45import System.Environment

47import System.Environment

48+import System.IO

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

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

48--

51--

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

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

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

85terminal_handle = do

88terminal_handle = do

86 term_type <- liftIO $ getEnv "TERM"

89 term_type <- liftIO $ getEnv "TERM"

90+ out_handle <- liftIO $ hDuplicate stdout

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

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

88 then do

92 then do

89 maybe_terminal_app <- get_env "TERM_PROGRAM"

93 maybe_terminal_app <- get_env "TERM_PROGRAM"

90 case maybe_terminal_app of

94 case maybe_terminal_app of

91 Nothing

95 Nothing

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

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

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

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

94 -> do

98 -> do

95 maybe_xterm <- get_env "XTERM_VERSION"

99 maybe_xterm <- get_env "XTERM_VERSION"

96 case maybe_xterm of

100 case maybe_xterm of

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

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

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

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

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

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

100 -- like terminal?

104 -- like terminal?

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

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

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

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

104 return t

108 return t

105 where

109 where

106 get_env var = do

110 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

2{-# LANGUAGE BangPatterns #-}

3{-# LANGUAGE RankNTypes #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ExistentialQuantification #-}

6{-# LANGUAGE GADTs #-}

7{-# LANGUAGE FlexibleContexts #-}

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

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

9− , OutputBuffer

9+ , OutputBuffer

10− )

10+ )

11 where

13import Data.Marshalling

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

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

14 )

15 where

17−import Graphics.Vty.Terminal.Generic

17+import Graphics.Vty.Terminal.Interface

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

20import Control.Applicative

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

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

33--

34-- This effects the terminfo lookup.

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

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

36−terminal_instance v = do

36+terminal_instance v out_handle = do

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

38 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

40 return $ Term t v

42flushed_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

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE TypeFamilies #-}

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

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

5− , DebugDisplay(..)

5+ , MockDisplay(..)

6− , terminal_instance

6+ , terminal_instance

7− , dehandle

7+ , dehandle

8− )

8+ )

9 where

11import Graphics.Vty.DisplayRegion

12−import Graphics.Vty.Terminal.Generic

12+import Graphics.Vty.Terminal.Interface

14import Control.Applicative

15import Control.Monad.Trans

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

28import Unsafe.Coerce

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

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

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

33-- considering terminal specific issues.

34--

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

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

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

38-- operations.

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

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

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

45−data DebugTerminal = DebugTerminal

45+data MockTerminal = MockTerminal

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

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

47− , debug_terminal_bounds :: DisplayRegion

47+ , mock_terminal_bounds :: DisplayRegion

48 }

50−instance Terminal DebugTerminal where

50+instance Terminal MockTerminal where

51− terminal_ID _t = "debug_terminal"

51+ terminal_ID _t = "mock_terminal"

52 release_terminal _t = return ()

53 reserve_display _t = return ()

54 release_display _t = return ()

55− display_bounds t = return $ debug_terminal_bounds t

55+ display_bounds t = return $ mock_terminal_bounds t

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

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

57 output_byte_buffer t out_buffer buffer_size

58 = liftIO $ do

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

60 peekArray (fromEnum buffer_size) out_buffer

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

62− >>= writeIORef (debug_terminal_last_output t)

62+ >>= writeIORef (mock_terminal_last_output t)

64 output_handle _t = return stdout

66−data DebugDisplay = DebugDisplay

66+data MockDisplay = MockDisplay

67− { debug_display_bounds :: DisplayRegion

67+ { mock_display_bounds :: DisplayRegion

68 }

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

71terminal_instance r = do

72 output_ref <- liftIO $ newIORef undefined

73− new_terminal_handle $ DebugTerminal output_ref r

73+ new_terminal_handle $ MockTerminal output_ref r

75−dehandle :: TerminalHandle -> DebugTerminal

75+dehandle :: TerminalHandle -> MockTerminal

76dehandle (TerminalHandle t _) = unsafeCoerce t

78−instance DisplayTerminal DebugDisplay where

78+instance DisplayTerminal MockDisplay where

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

80− context_region d = debug_display_bounds d

80+ context_region d = mock_display_bounds d

82 -- | Assume 16 colors

83 context_color_count _d = 16

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

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

13import Graphics.Vty.Attributes

14import Graphics.Vty.DisplayAttributes

15−import Graphics.Vty.Terminal.Generic

15+import Graphics.Vty.Terminal.Interface

16import Graphics.Vty.DisplayRegion

18import Control.Applicative

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

22import Data.Bits ( (.&.) )

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

24−import Data.Word

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

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

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

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

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

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

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

75 -}

74 -}

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

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

77−terminal_instance in_ID = do

76+terminal_instance in_ID the_handle = do

78 ti <- liftIO $ Terminfo.setupTerm in_ID

77 ti <- liftIO $ Terminfo.setupTerm in_ID

79 let require_cap str

78 let require_cap str

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

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

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

92 case parse_result of

91 case parse_result of

93 Left e -> fail $ show e

92 Left e -> fail $ show e

94 Right cap -> return $ Just cap

93 Right cap -> return $ Just cap

95− the_handle <- liftIO $ hDuplicate stdout

96 pure Term

94 pure Term

97 <*> pure in_ID

95 <*> pure in_ID

98 <*> pure ti

96 <*> pure ti

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

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

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

246 --

244 --

247 -- This equation implements the above logic.

245 -- 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*

248 serialize_set_attr d prev_attr req_attr diffs out_ptr = do

249 serialize_set_attr d prev_attr req_attr diffs out_ptr = do

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

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

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

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

8 )

9 where

11−import Graphics.Vty.Terminal.Generic

11+import Graphics.Vty.Terminal.Interface

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

14import Control.Applicative

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

29 }

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

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

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

33−terminal_instance variant = do

33+terminal_instance variant out_handle = do

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

35 -- xterm-color is broken.

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

37 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

39 return $ XTermColor variant' t

41-- | Output immediately followed by a flush.

test/Verify.hs+2

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

10module Verify ( module Verify

11 , module Control.DeepSeq

12 , module Test.QuickCheck

13+ , module Test.QuickCheck.Modifiers

13 , succeeded

14 , succeeded

14 , failed

15 , failed

15 , result

16 , result

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

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

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

28import qualified Test.QuickCheck as QC

29import qualified Test.QuickCheck as QC

30+import Test.QuickCheck.Modifiers

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

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

30import qualified Test.QuickCheck.Property as Prop

32import qualified Test.QuickCheck.Property as Prop

31import Test.QuickCheck.Monadic ( monadicIO )

33import Test.QuickCheck.Monadic ( monadicIO )

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

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

1{-# LANGUAGE ScopedTypeVariables #-}

2module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion

3 , module Graphics.Vty.DisplayRegion

4− , DebugWindow(..)

4+ , MockWindow(..)

5 )

6 where

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

11import Verify

13−data EmptyWindow = EmptyWindow DebugWindow

13+data EmptyWindow = EmptyWindow MockWindow

15instance Arbitrary EmptyWindow where

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

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

18instance Show EmptyWindow where

19 show (EmptyWindow _) = "EmptyWindow"

21−instance Arbitrary DebugWindow where

21+instance Arbitrary MockWindow where

22 arbitrary = do

23 w <- choose (1,1024)

24 h <- choose (1,1024)

25− return $ DebugWindow w h

25+ return $ MockWindow w h

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

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

16data DefaultPic = DefaultPic

17 { default_pic :: Picture

18− , default_win :: DebugWindow

18+ , default_win :: MockWindow

19 , default_construct_log :: ImageConstructLog

20 }

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

26instance Arbitrary DefaultPic where

27 arbitrary = do

28 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)

30 return $ DefaultPic (pic_for_image image)

31 win

32 image_construct_events

34data PicWithBGAttr = PicWithBGAttr

35 { with_attr_pic :: Picture

36− , with_attr_win :: DebugWindow

36+ , with_attr_win :: MockWindow

37 , with_attr_construct_log :: ImageConstructLog

38 , with_attr_specified_attr :: Attr

39 } deriving ( Show )

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

41instance Arbitrary PicWithBGAttr where

42 arbitrary = do

43 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)

45 attr <- arbitrary

46 return $ PicWithBGAttr (pic_for_image image)

47 win

test/VerifySpanOps.hs+13−13

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

40horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result

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

42 let p = pic_for_image i

43− w = DebugWindow c 1

43+ w = MockWindow c 1

44 spans = spans_for_pic p (region_for_window w)

45 in verify_all_spans_have_width i spans c

47horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool

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

49 let p = pic_for_image i

50− w = DebugWindow c 1

50+ w = MockWindow c 1

51 spans = spans_for_pic p (region_for_window w)

52 in span_ops_effected_rows spans == 1

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

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

56 let p = pic_for_image i

57 lesser_width = c `div` 2

58− w = DebugWindow lesser_width 1

58+ w = MockWindow lesser_width 1

59 spans = spans_for_pic p (region_for_window w)

60 in verify_all_spans_have_width i spans lesser_width

62single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result

63single_attr_single_span_stack_cropped_0 stack =

64 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)

66 spans = spans_for_pic p (region_for_window w)

67 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

70single_attr_single_span_stack_cropped_1 stack =

71 let p = pic_for_image (stack_image stack)

72 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

74 spans = spans_for_pic p (region_for_window w)

75 actual_row_count = span_ops_effected_rows spans

76 in expected_row_count == actual_row_count

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

78single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

79single_attr_single_span_stack_cropped_2 stack_0 stack_1 =

80 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))

82 spans = spans_for_pic p (region_for_window w)

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

85single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool

86single_attr_single_span_stack_cropped_3 stack_0 stack_1 =

87 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

89 spans = spans_for_pic p (region_for_window w)

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

91 actual_row_count = span_ops_effected_rows spans

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

94single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

95single_attr_single_span_stack_cropped_4 stack_0 stack_1 =

96 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))

98 spans = spans_for_pic p (region_for_window w)

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

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

102single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool

103single_attr_single_span_stack_cropped_5 stack_0 stack_1 =

104 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)

106 spans = spans_for_pic p (region_for_window w)

107 expected_row_count = stack_height stack_0

108 actual_row_count = span_ops_effected_rows spans

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

113 let p = pic_for_image i

114 -- SingleRowSingleAttrImage always has width >= 1

115 greater_width = c * 2

116− w = DebugWindow greater_width 1

116+ w = MockWindow greater_width 1

117 spans = spans_for_pic p (region_for_window w)

118 in verify_all_spans_have_width i spans greater_width

119

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

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

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

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

122 let pic = pic_for_image image

123 spans = spans_for_pic pic (region_for_window win)

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

144single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result

145single_attr_single_span_stack_op_coverage stack =

146 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)

148 spans = spans_for_pic p (region_for_window w)

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

150

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

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

1{-# LANGUAGE ScopedTypeVariables #-}

2−module VerifyMockTerminal where

2+module VerifyTerminal where

4import Verify.Graphics.Vty.DisplayRegion

5import Verify.Graphics.Vty.Picture

6import Verify.Graphics.Vty.Image

7import Verify.Graphics.Vty.Span

8import Graphics.Vty.Terminal

9−import Graphics.Vty.Terminal.Debug

9+import Graphics.Vty.Terminal.Mock

11import Graphics.Vty.Debug

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

26 output_picture d pic

27 return succeeded

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

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

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

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

31 t <- terminal_instance (DisplayRegion w h)

32 d <- display_bounds t >>= display_context t

33 let pic = pic_for_image i

34 output_picture d pic

35 return succeeded

37−single_T_row :: DebugWindow -> Property

37+single_T_row :: MockWindow -> Property

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

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

39 t <- terminal_instance (DisplayRegion w h)

40 d <- display_bounds t >>= display_context t

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

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

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

44 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

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

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

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

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

54 else return succeeded

56−many_T_rows :: DebugWindow -> Property

56+many_T_rows :: MockWindow -> Property

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

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

58 t <- terminal_instance (DisplayRegion w h)

59 d <- display_bounds t >>= display_context t

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

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

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

63 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

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

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

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

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

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

71 else return succeeded

73−many_T_rows_cropped_width :: DebugWindow -> Property

73+many_T_rows_cropped_width :: MockWindow -> Property

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

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

75 t <- terminal_instance (DisplayRegion w h)

76 d <- display_bounds t >>= display_context t

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

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

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

80 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

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

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

84 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

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

88 else return succeeded

90−many_T_rows_cropped_height :: DebugWindow -> Property

90+many_T_rows_cropped_height :: MockWindow -> Property

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

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

92 t <- terminal_instance (DisplayRegion w h)

93 d <- display_bounds t >>= display_context t

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

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

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

97 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

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

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

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

vty.cabal+4−4

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

74 Graphics.Vty.Image.Internal

75 Graphics.Vty.PictureToSpans

76 Graphics.Vty.Span

77− Graphics.Vty.Terminal.Debug

77+ Graphics.Vty.Terminal.Mock

78− Graphics.Vty.Terminal.Generic

78+ Graphics.Vty.Terminal.Interface

79 Graphics.Vty.Terminal.MacOSX

80 Graphics.Vty.Terminal.XTermColor

81 Graphics.Vty.Terminal.TerminfoBased

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

119 vector >= 0.7

120

121

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

122+test-suite verify-terminal

123 default-language: Haskell2010

124

125 type: detailed-0.9

126

127 hs-source-dirs: test

128

129− test-module: VerifyMockTerminal

129+ test-module: VerifyTerminal

130

131 other-modules: Verify

132 Verify.Graphics.Vty.Attributes