From e6fb85e3429ab4c858c04e6cf15c62948e9ad0d0 Mon Sep 17 00:00:00 2001 From: Corey O'Connor Date: Fri, 5 Jul 2013 18:36:03 -0700 Subject: [PATCH] rename debug terminals to mock terminals. --- src/Graphics/Vty/Debug.hs | 8 ++-- src/Graphics/Vty/Inline.hs | 2 +- src/Graphics/Vty/Terminal.hs | 22 +++++---- .../Vty/Terminal/{Generic.hs => Interface.hs} | 8 ++-- src/Graphics/Vty/Terminal/MacOSX.hs | 8 ++-- .../Vty/Terminal/{Debug.hs => Mock.hs} | 46 +++++++++---------- src/Graphics/Vty/Terminal/TerminfoBased.hs | 11 +++-- src/Graphics/Vty/Terminal/XTermColor.hs | 8 ++-- test/Verify.hs | 2 + test/Verify/Graphics/Vty/DisplayRegion.hs | 10 ++-- test/Verify/Graphics/Vty/Picture.hs | 8 ++-- test/VerifySpanOps.hs | 26 +++++------ ...erifyMockTerminal.hs => VerifyTerminal.hs} | 32 ++++++------- vty.cabal | 8 ++-- 14 files changed, 102 insertions(+), 97 deletions(-) rename src/Graphics/Vty/Terminal/{Generic.hs => Interface.hs} (98%) rename src/Graphics/Vty/Terminal/{Debug.hs => Mock.hs} (74%) rename test/{VerifyMockTerminal.hs => VerifyTerminal.hs} (82%) diff --git a/src/Graphics/Vty/Debug.hs b/src/Graphics/Vty/Debug.hs index dbbc463..3e5a811 100644 --- a/src/Graphics/Vty/Debug.hs +++ b/src/Graphics/Vty/Debug.hs @@ -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 diff --git a/src/Graphics/Vty/Inline.hs b/src/Graphics/Vty/Inline.hs index 4d1f26c..8c9ef78 100644 --- a/src/Graphics/Vty/Inline.hs +++ b/src/Graphics/Vty/Inline.hs @@ -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 diff --git a/src/Graphics/Vty/Terminal.hs b/src/Graphics/Vty/Terminal.hs index 2b39143..30f2d91 100644 --- a/src/Graphics/Vty/Terminal.hs +++ b/src/Graphics/Vty/Terminal.hs @@ -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 diff --git a/src/Graphics/Vty/Terminal/Generic.hs b/src/Graphics/Vty/Terminal/Interface.hs similarity index 98% rename from src/Graphics/Vty/Terminal/Generic.hs rename to src/Graphics/Vty/Terminal/Interface.hs index 2ed7304..e009a66 100644 --- a/src/Graphics/Vty/Terminal/Generic.hs +++ b/src/Graphics/Vty/Terminal/Interface.hs @@ -1,13 +1,13 @@ --- 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 - , OutputBuffer - ) +module Graphics.Vty.Terminal.Interface ( module Graphics.Vty.Terminal.Interface + , OutputBuffer + ) where import Data.Marshalling diff --git a/src/Graphics/Vty/Terminal/MacOSX.hs b/src/Graphics/Vty/Terminal/MacOSX.hs index 53f0733..1207e87 100644 --- a/src/Graphics/Vty/Terminal/MacOSX.hs +++ b/src/Graphics/Vty/Terminal/MacOSX.hs @@ -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 () diff --git a/src/Graphics/Vty/Terminal/Debug.hs b/src/Graphics/Vty/Terminal/Mock.hs similarity index 74% rename from src/Graphics/Vty/Terminal/Debug.hs rename to src/Graphics/Vty/Terminal/Mock.hs index 55588af..15888b8 100644 --- a/src/Graphics/Vty/Terminal/Debug.hs +++ b/src/Graphics/Vty/Terminal/Mock.hs @@ -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(..) - , terminal_instance - , dehandle - ) +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 diff --git a/src/Graphics/Vty/Terminal/TerminfoBased.hs b/src/Graphics/Vty/Terminal/TerminfoBased.hs index abb7648..0fb9db0 100644 --- a/src/Graphics/Vty/Terminal/TerminfoBased.hs +++ b/src/Graphics/Vty/Terminal/TerminfoBased.hs @@ -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 diff --git a/src/Graphics/Vty/Terminal/XTermColor.hs b/src/Graphics/Vty/Terminal/XTermColor.hs index 2b68c46..d0eeb27 100644 --- a/src/Graphics/Vty/Terminal/XTermColor.hs +++ b/src/Graphics/Vty/Terminal/XTermColor.hs @@ -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. diff --git a/test/Verify.hs b/test/Verify.hs index cb8b007..7f6b964 100644 --- a/test/Verify.hs +++ b/test/Verify.hs @@ -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 ) diff --git a/test/Verify/Graphics/Vty/DisplayRegion.hs b/test/Verify/Graphics/Vty/DisplayRegion.hs index e60096b..9332627 100644 --- a/test/Verify/Graphics/Vty/DisplayRegion.hs +++ b/test/Verify/Graphics/Vty/DisplayRegion.hs @@ -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 diff --git a/test/Verify/Graphics/Vty/Picture.hs b/test/Verify/Graphics/Vty/Picture.hs index 7285094..5817624 100644 --- a/test/Verify/Graphics/Vty/Picture.hs +++ b/test/Verify/Graphics/Vty/Picture.hs @@ -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 diff --git a/test/VerifySpanOps.hs b/test/VerifySpanOps.hs index 9c29565..0c6e302 100644 --- a/test/VerifySpanOps.hs +++ b/test/VerifySpanOps.hs @@ -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) diff --git a/test/VerifyMockTerminal.hs b/test/VerifyTerminal.hs similarity index 82% rename from test/VerifyMockTerminal.hs rename to test/VerifyTerminal.hs index 7d2d0e9..0d1f362 100644 --- a/test/VerifyMockTerminal.hs +++ b/test/VerifyTerminal.hs @@ -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') diff --git a/vty.cabal b/vty.cabal index 96845c0..ae8f542 100644 --- a/vty.cabal +++ b/vty.cabal @@ -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