vty 4.7.0.0 → 4.7.0.4
raw patch · 20 files changed
+352/−290 lines, 20 filesdep +vectordep −arrayPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: vector
Dependencies removed: array
API changes (from Hackage documentation)
+ Graphics.Vty.Picture: instance Show Picture
Files
- src/Graphics/Vty/Debug.hs +10/−46
- src/Graphics/Vty/Image.hs +27/−12
- src/Graphics/Vty/Picture.hs +3/−0
- src/Graphics/Vty/Span.hs +157/−98
- src/Graphics/Vty/Terminal/Generic.hs +21/−22
- test/Bench.hs +1/−1
- test/Makefile +16/−1
- test/Verify.hs +16/−10
- test/Verify/Data/Terminfo/Parse.hs +1/−1
- test/Verify/Graphics/Vty/DisplayRegion.hs +3/−2
- test/Verify/Graphics/Vty/Image.hs +4/−5
- test/Verify/Graphics/Vty/Span.hs +8/−7
- test/interactive_terminal_test.hs +28/−28
- test/verify_debug_terminal.hs +4/−4
- test/verify_eval_terminfo_caps.hs +5/−6
- test/verify_image_ops.hs +13/−13
- test/verify_image_trans.hs +5/−5
- test/verify_parse_terminfo_caps.hs +3/−3
- test/verify_span_ops.hs +22/−21
- vty.cabal +5/−5
src/Graphics/Vty/Debug.hs view
@@ -1,37 +1,29 @@ -- Copyright 2009-2010 Corey O'Connor {-# LANGUAGE ScopedTypeVariables #-} module Graphics.Vty.Debug ( module Graphics.Vty.Debug+ , module Graphics.Vty.Debug.Image ) where import Graphics.Vty.Attributes-import Graphics.Vty.Image-import Graphics.Vty.Picture+import Graphics.Vty.Debug.Image import Graphics.Vty.Span import Graphics.Vty.DisplayRegion -import Control.Monad-import Data.Array+import qualified Data.Vector as Vector import Data.Word -instance Show SpanOpSequence where- show (SpanOpSequence _ row_ops)- = concat $ ["{ "] ++ map (\ops -> show ops ++ "; " ) (elems row_ops) ++ [" }"]--instance Show SpanOp where- show (AttributeChange attr) = show attr- show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw--row_ops_effected_columns :: SpanOpSequence -> [Word]+row_ops_effected_columns :: DisplayOps -> [Word] row_ops_effected_columns spans - = map span_ops_effected_columns (elems $ row_ops spans)+ = Vector.toList $ Vector.map span_ops_effected_columns $ display_ops spans +all_spans_have_width :: DisplayOps -> Word -> Bool all_spans_have_width spans expected- = all (== expected) ( map span_ops_effected_columns (elems $ row_ops spans) )+ = all (== expected) $ Vector.toList $ Vector.map span_ops_effected_columns $ display_ops spans -span_ops_effected_rows :: SpanOpSequence -> Word-span_ops_effected_rows (SpanOpSequence _ row_ops) - = toEnum $ length (filter (not . null) (elems row_ops))+span_ops_effected_rows :: DisplayOps -> Word+span_ops_effected_rows (DisplayOps _ the_row_ops) + = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList the_row_ops)) type SpanConstructLog = [SpanConstructEvent] data SpanConstructEvent = SpanSetAttr Attr@@ -49,31 +41,3 @@ type TestWindow = DebugWindow -type ImageConstructLog = [ImageConstructEvent]-data ImageConstructEvent = ImageConstructEvent- deriving ( Show, Eq )--forward_image_ops = map forward_transform debug_image_ops--forward_transform, reverse_transform :: ImageOp -> (Image -> Image)--forward_transform (ImageOp f _) = f-reverse_transform (ImageOp _ r) = r--data ImageOp = ImageOp ImageEndo ImageEndo-type ImageEndo = Image -> Image--debug_image_ops = - [ id_image_op- -- , render_single_column_char_op- -- , render_double_column_char_op- ]--id_image_op :: ImageOp-id_image_op = ImageOp id id---- render_char_op :: ImageOp--- render_char_op = ImageOp id id- -instance Show Picture where- show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"
src/Graphics/Vty/Image.hs view
@@ -3,7 +3,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# OPTIONS_GHC -funbox-strict-fields #-}-module Graphics.Vty.Image ( Image(..)+module Graphics.Vty.Image ( DisplayString+ , Image(..) , image_width , image_height , (<|>)@@ -45,7 +46,10 @@ infixr 5 <|> infixr 4 <-> -type StringSeq = Seq.Seq Char+-- | We pair each character with it's display length. This way we only compute the length once per+-- character.+-- * Though currently the width of some strings is still compute multiple times. +type DisplayString = Seq.Seq (Char, Word) -- | An image in VTY defines: --@@ -69,8 +73,7 @@ HorizText { attr :: !Attr -- All character data is stored as Char sequences with the ISO-10646 encoding.- , text :: StringSeq- -- in columns+ , text :: DisplayString , output_width :: !Word -- >= 0 , char_width :: !Word -- >= 1 }@@ -113,7 +116,7 @@ instance Show Image where show ( HorizText { output_width = ow, text = txt } ) - = "HorizText [" ++ show ow ++ "] (" ++ show txt ++ ")"+ = "HorizText [" ++ show ow ++ "] (" ++ show (fmap fst txt) ++ ")" show ( BGFill { output_width = c, output_height = r } ) = "BGFill (" ++ show c ++ "," ++ show r ++ ")" show ( HorizJoin { part_left = l, part_right = r, output_width = c } ) @@ -128,14 +131,13 @@ = "ImagePad " ++ show size ++ " ( " ++ show i ++ " )" show ( EmptyImage ) = "EmptyImage" --- | Currently append in the Monoid instance is equivalent to <->. Future versions will just stack--- the images.+-- | Currently append in the Monoid instance is equivalent to <->. instance Monoid Image where mempty = empty_image mappend = (<->) -- A horizontal text image of 0 characters in width simplifies to the EmptyImage-horiz_text :: Attr -> StringSeq -> Word -> Image+horiz_text :: Attr -> DisplayString -> Word -> Image horiz_text a txt ow | ow == 0 = EmptyImage | otherwise = HorizText a txt ow (toEnum $ Seq.length txt)@@ -288,7 +290,9 @@ -- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in -- the ISO-10646 encoding. char :: Attr -> Char -> Image-char !a !c = HorizText a (Seq.singleton c) (safe_wcwidth c) 1+char !a !c = + let display_width = safe_wcwidth c+ in HorizText a (Seq.singleton (c, display_width)) display_width 1 -- | A string of characters layed out on a single row with the same display attribute. The string is -- assumed to be a sequence of ISO-10646 characters. @@ -300,7 +304,9 @@ -- directly to iso_10646_string or string. -- iso_10646_string :: Attr -> String -> Image-iso_10646_string !a !str = horiz_text a (Seq.fromList str) (safe_wcswidth str)+iso_10646_string !a !str = + let display_text = Seq.fromList $ map (\c -> (c, safe_wcwidth c)) str+ in horiz_text a display_text (safe_wcswidth str) -- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is -- represented internally as a list of ISO 10646 31 bit characters. @@ -316,14 +322,23 @@ utf8_string :: Attr -> [Word8] -> Image utf8_string !a !str = string a ( decode str ) +-- XXX: Characters with unknown widths occupy 1 column?+-- +-- Not sure if this is actually correct. I presume there is a replacement character that is output+-- by the terminal instead of the character and this replacement character is 1 column wide. If this+-- is not true for all terminals then a per-terminal replacement character width needs to be+-- implemented.++-- | Returns the display width of a character. Assumes all characters with unknown widths are 1 width safe_wcwidth :: Char -> Word safe_wcwidth c = case wcwidth c of- i | i < 0 -> 0 -- error "negative wcwidth"+ i | i < 0 -> 1 | otherwise -> toEnum i +-- | Returns the display width of a string. Assumes all characters with unknown widths are 1 width safe_wcswidth :: String -> Word safe_wcswidth str = case wcswidth str of- i | i < 0 -> 0 -- error "negative wcswidth"+ i | i < 0 -> 1 | otherwise -> toEnum i -- | Renders a UTF-8 encoded bytestring.
src/Graphics/Vty/Picture.hs view
@@ -37,6 +37,9 @@ , pic_background :: Background } +instance Show Picture where+ show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"+ -- | Create a picture for display for the given image. The picture will not have a displayed cursor -- and the background display attribute will be `current_attr`. pic_for_image :: Image -> Picture
src/Graphics/Vty/Span.hs view
@@ -9,8 +9,6 @@ module Graphics.Vty.Span where -import Codec.Binary.UTF8.Width ( wcwidth )- import Graphics.Vty.Image import Graphics.Vty.Picture import Graphics.Vty.DisplayRegion@@ -20,19 +18,19 @@ import Control.Monad ( forM_ ) import Control.Monad.ST.Strict -import Data.Array.ST+import Data.Vector (Vector)+import qualified Data.Vector as Vector hiding ( take, replicate )+import Data.Vector.Mutable ( MVector(..))+import qualified Data.Vector.Mutable as Vector+ import qualified Data.ByteString as B import qualified Data.ByteString.Internal as BInt import qualified Data.Foldable as Foldable-import Data.List-import Data.Word-import qualified Data.ByteString.UTF8 as BSUTF8 import qualified Data.String.UTF8 as UTF8+import Data.Word import Foreign.Storable ( pokeByteOff ) -import GHC.Arr- {- | A picture is translated into a sequences of state changes and character spans. - State changes are currently limited to new attribute values. The attribute is applied to all - following spans. Including spans of the next row. The nth element of the sequence represents the@@ -40,31 +38,45 @@ - - A span op sequence will be defined for all rows and columns (and no more) of the region provided - with the picture to spans_for_pic.- - - - todo: Partition attribute changes into multiple categories according to the serialized - representation of the various attributes. -}-data SpanOpSequence = SpanOpSequence - { effected_region :: DisplayRegion- , row_ops :: RowOps - } -type RowOps = Array Word SpanOps-type SpanOps = [SpanOp]+data DisplayOps = DisplayOps+ { effected_region :: DisplayRegion + , display_ops :: RowOps+ } -span_ops_columns :: SpanOpSequence -> Word+-- vector of span operation vectors. One per row of the screen.+type RowOps = Vector SpanOps++type MRowOps s = MVector s SpanOps++-- vector of span operations. executed in succession+type SpanOps = Vector SpanOp++type MSpanOps s = MVector s SpanOp++instance Show DisplayOps where+ show (DisplayOps _ the_row_ops)+ = "{ " ++ (show $ Vector.map (\ops -> show ops ++ "; " ) the_row_ops) ++ " }"++instance Show SpanOp where+ show (AttributeChange attr) = show attr+ show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw++span_ops_columns :: DisplayOps -> Word span_ops_columns ops = region_width $ effected_region ops -span_ops_rows :: SpanOpSequence -> Word+span_ops_rows :: DisplayOps -> Word span_ops_rows ops = region_height $ effected_region ops -span_ops_effected_columns :: [SpanOp] -> Word-span_ops_effected_columns in_ops = span_ops_effected_columns' 0 in_ops+span_ops_effected_columns :: SpanOps -> Word+span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops where - span_ops_effected_columns' t [] = t- span_ops_effected_columns' t (TextSpan w _ _ : r) = span_ops_effected_columns' (t + w) r- span_ops_effected_columns' t (_ : r) = span_ops_effected_columns' t r+ span_ops_effected_columns' t (TextSpan w _ _ ) = t + w+ span_ops_effected_columns' t _ = t -- | -- @@ -79,54 +91,70 @@ | TextSpan !Word !Word (UTF8.UTF8 B.ByteString) deriving Eq +-- used to determine the width of a span operation , if it has one. span_op_has_width :: SpanOp -> Maybe (Word, Word) span_op_has_width (TextSpan ow cw _) = Just (cw, ow) span_op_has_width _ = Nothing +-- returns the number of columns to the character at the given position in the span op columns_to_char_offset :: Word -> SpanOp -> Word columns_to_char_offset cx (TextSpan _ _ utf8_str) = let str = UTF8.toString utf8_str- in toEnum $ sum $ map wcwidth $ take (fromEnum cx) str+ in toEnum $! sum $! map wcwidth $! take (fromEnum cx) str columns_to_char_offset _cx _ = error "columns_to_char_offset applied to span op without width" -- | Produces the span ops that will render the given picture, possibly cropped or padded, into the -- specified region.-spans_for_pic :: Picture -> DisplayRegion -> SpanOpSequence-spans_for_pic pic r = SpanOpSequence r $ runSTArray (build_spans pic r)+spans_for_pic :: Picture -> DisplayRegion -> DisplayOps+spans_for_pic pic r = DisplayOps r $ Vector.create (build_spans pic r) -build_spans :: Picture -> DisplayRegion -> ST s (STArray s Word [SpanOp])+build_spans :: Picture -> DisplayRegion -> ST s (MRowOps s) build_spans pic region = do- -- m for mutable- mrow_ops <- newSTArray (0, region_height region - 1) []- -- I think this can be better optimized if the build produced span operations in display order.+ -- m for mutable! ;-)+ mrow_ops <- Vector.replicate (fromEnum $ region_height region) Vector.empty+ -- XXX: I think building the span operations in display order would provide better performance. -- However, I got stuck trying to implement an algorithm that did this. This will be considered -- as a possible future optimization. --- -- A depth first traversal of the image is performed.- -- ordered according to the column range defined by the image from least to greatest.- -- The output row ops will at least have the region of the image specified. Iterate over all- -- output rows and output background fills for all unspecified columns.+ -- A depth first traversal of the image is performed. ordered according to the column range+ -- defined by the image from least to greatest. The output row ops will at least have the+ -- region of the image specified. Iterate over all output rows and output background fills for+ -- all unspecified columns.+ --+ -- The images are made into span operations from left to right. It's possible that this could+ -- easily be made to assure top to bottom output as well. if region_height region > 0 then do -- The ops builder recursively descends the image and outputs span ops that would -- display that image. The number of columns remaining in this row before exceeding the- -- bounds is also provided. This is used to clip the span ops produced.- _ <- ops_for_row mrow_ops (pic_background pic) region (pic_image pic) (0,0) 0 (region_width region)+ -- bounds is also provided. This is used to clip the span ops produced to the display.+ -- The skip dimensions provided do....???+ _ <- row_ops_for_image mrow_ops + (pic_image pic)+ (pic_background pic) + region + (0,0) + 0 + (region_width region) -- Fill in any unspecified columns with the background pattern.- forM_ [0 .. region_height region - 1] $ \row -> do- end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns+ forM_ [0 .. (fromEnum $ region_height region - 1)] $! \row -> do+ end_x <- Vector.read mrow_ops row >>= return . span_ops_effected_columns if end_x < region_width region then snoc_bg_fill mrow_ops (pic_background pic) (region_width region - end_x) row else return () else return () return mrow_ops -type MRowOps s = STArray s Word SpanOps--ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> (Word, Word) -> Word -> Word -> ST s (Word, Word)-ops_for_row mrow_ops bg region image skip_dim@(skip_row,skip_col) y remaining_columns+row_ops_for_image :: MRowOps s -> Image -> Background -> DisplayRegion -> (Word, Word) -> Int -> Word -> ST s (Word, Word)+row_ops_for_image mrow_ops -- the image to output the ops to+ image -- the image to rasterize in column order to mrow_ops+ bg -- the background fill+ region -- ???+ skip_dim@(skip_row,skip_col) -- the number of rows + y -- ???+ remaining_columns -- ??? | remaining_columns == 0 = return skip_dim- | y >= region_height region = return skip_dim+ | y >= fromEnum (region_height region) = return skip_dim | otherwise = case image of EmptyImage -> return skip_dim -- The width provided is the number of columns this text span will occupy when displayed.@@ -138,22 +166,34 @@ else do skip_col' <- snoc_text_span a text_str mrow_ops skip_col y remaining_columns return (skip_row, skip_col')- VertJoin t b _ _ -> do- (skip_row',skip_col') <- ops_for_row mrow_ops bg region t skip_dim y remaining_columns- (skip_row'',skip_col'') <- ops_for_row mrow_ops bg region b (skip_row', skip_col) (y + image_height t - (skip_row - skip_row')) remaining_columns+ VertJoin top_image bottom_image _ _ -> do+ (skip_row',skip_col') <- row_ops_for_image mrow_ops + top_image+ bg + region + skip_dim + y + remaining_columns+ (skip_row'',skip_col'') <- row_ops_for_image mrow_ops + bottom_image+ bg + region + (skip_row', skip_col) + (y + (fromEnum $! image_height top_image) - (fromEnum $! skip_row - skip_row')) + remaining_columns return (skip_row'', min skip_col' skip_col'') HorizJoin l r _ _ -> do- (skip_row',skip_col') <- ops_for_row mrow_ops bg region l skip_dim y remaining_columns+ (skip_row',skip_col') <- row_ops_for_image mrow_ops l bg region skip_dim y remaining_columns -- Don't output the right part unless there is at least a single column left after -- outputting the left part. if image_width l - (skip_col - skip_col') > remaining_columns then return (skip_row,skip_col') else do- (skip_row'',skip_col'') <- ops_for_row mrow_ops bg region r (skip_row, skip_col') y (remaining_columns - image_width l + (skip_col - skip_col'))+ (skip_row'',skip_col'') <- row_ops_for_image mrow_ops r bg region (skip_row, skip_col') y (remaining_columns - image_width l + (skip_col - skip_col')) return (min skip_row' skip_row'', skip_col'') BGFill width height -> do- let min_height = if y + height > region_height region- then region_height region - y+ let min_height = if y + (fromEnum height) > (fromEnum $! region_height region)+ then region_height region - (toEnum y) else height min_width = if width > remaining_columns then remaining_columns@@ -164,7 +204,7 @@ actual_width = if skip_col > min_width then 0 else min_width - skip_col- forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'+ forM_ [y .. y + fromEnum actual_height - 1] $! \y' -> snoc_bg_fill mrow_ops bg actual_width y' let skip_row' = if actual_height > skip_row then 0 else skip_row - min_height@@ -176,25 +216,25 @@ if dx < 0 -- Translation left -- Extract the delta and add it to skip_col.- then ops_for_row mrow_ops bg region (translate (0, dy) i) (skip_row, skip_col + dw) y remaining_columns+ then row_ops_for_image mrow_ops (translate (0, dy) i) bg region (skip_row, skip_col + dw) y remaining_columns -- Translation right else if dy < 0 -- Translation up -- Extract the delta and add it to skip_row.- then ops_for_row mrow_ops bg region (translate (dx, 0) i) (skip_row + dh, skip_col) y remaining_columns+ then row_ops_for_image mrow_ops (translate (dx, 0) i) bg region (skip_row + dh, skip_col) y remaining_columns -- Translation down -- Pad the start of lines and above the image with a -- background_fill image.- else ops_for_row mrow_ops bg region (background_fill ow dh <-> (background_fill dw ih <|> i)) skip_dim y remaining_columns+ else row_ops_for_image mrow_ops (background_fill ow dh <-> (background_fill dw ih <|> i)) bg region skip_dim y remaining_columns where dw = toEnum $ abs dx dh = toEnum $ abs dy ow = image_width image ih = image_height i ImageCrop (max_w,max_h) i ->- if y >= max_h+ if y >= fromEnum max_h then return skip_dim- else ops_for_row mrow_ops bg region i skip_dim y (min remaining_columns max_w)+ else row_ops_for_image mrow_ops i bg region skip_dim y (min remaining_columns max_w) ImagePad (min_w,min_h) i -> do let hpad = if image_width i < min_w then background_fill (min_w - image_width i) (image_height i)@@ -202,48 +242,68 @@ let vpad = if image_height i < min_h then background_fill (image_width i) (min_h - image_height i) else empty_image- ops_for_row mrow_ops bg region ((i <|> hpad) <-> vpad) skip_dim y remaining_columns+ row_ops_for_image mrow_ops ((i <|> hpad) <-> vpad) bg region skip_dim y remaining_columns -snoc_text_span :: (Foldable.Foldable t) - => Attr - -> t Char - -> MRowOps s - -> Word - -> Word - -> Word +snoc_text_span :: Attr -- the display attributes of the text span+ -> DisplayString -- the text to output+ -> MRowOps s -- the display operations to add to+ -> Word -- the number of display columns in the text span to + -- skip before outputting+ -> Int -- the row of the display operations to add to+ -> Word -- the number of columns from the next column to be + -- defined to the end of the display for the row. -> ST s Word-snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do- snoc_op mrow_ops y $ AttributeChange a- let (ow', dw', cw', txt) = Foldable.foldl'- build_cropped_txt- ( 0, 0, 0, B.empty )- text_str- snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)- return $ skip_col - dw'+snoc_text_span a text_str mrow_ops columns_to_skip y remaining_columns = do+ {-# SCC "snoc_text_span-pre" #-} snoc_op mrow_ops y $! AttributeChange a+ -- At most a text span will consist of remaining_columns characters+ -- we keep track of the position of the next character.+ let max_len :: Int = fromEnum remaining_columns+ mspan_chars <- Vector.new max_len+ ( used_display_columns, display_columns_skipped, used_char_count ) + <- {-# SCC "snoc_text_span-foldlM" #-} Foldable.foldlM (build_text_span mspan_chars) ( 0, 0, 0 ) text_str+ -- once all characters have been output to mspan_chars we grab the used head + out_text <- Vector.unsafeFreeze $! Vector.take used_char_count mspan_chars+ -- convert to UTF8 bytestring.+ -- This could be made faster. Hopefully the optimizer does a fair job at fusing the fold+ -- contained in fromString with the unfold in toList. No biggy right now then.+ {-# SCC "snoc_text_span-post" #-} snoc_op mrow_ops y $! TextSpan used_display_columns (toEnum used_char_count)+ $! UTF8.fromString + $! Vector.toList out_text+ return $ columns_to_skip - display_columns_skipped where- build_cropped_txt (ow', dw', char_count', b0) c = {-# SCC "build_cropped_txt" #-}- let w = wcwidth c- -- Characters with unknown widths occupy 1 column. - -- - -- todo: Not sure if this is actually correct.- -- I presume there is a replacement character that is output by the terminal instead of- -- the character. If so then this replacement process may need to be implemented- -- manually for consistent behavior across terminals.- w' = toEnum $ if w < 0 then 1 else w- in if dw' == skip_col- then if ow' == remaining_columns- then ( ow', dw', char_count', b0 )- else if (w' + ow') > remaining_columns- then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )- else ( ow' + w', dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )- else if (w' + dw') > skip_col- then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )- else ( ow', w' + dw', char_count', b0 )- where- doverflow = skip_col - dw'- ooverflow = remaining_columns - ow'+ build_text_span mspan_chars (!used_display_columns, !display_columns_skipped, !used_char_count) + (out_char, char_display_width) = {-# SCC "build_text_span" #-}+ -- Only valid if the maximum width of a character is 2 display columns.+ -- XXX: Optimize into a skip pass then clipped fill pass+ if display_columns_skipped == columns_to_skip+ then if used_display_columns == remaining_columns+ then return $! ( used_display_columns, display_columns_skipped, used_char_count )+ else if ( used_display_columns + char_display_width ) > remaining_columns+ then do+ Vector.unsafeWrite mspan_chars used_char_count '…'+ return $! ( used_display_columns+ , display_columns_skipped+ , used_char_count + 1+ )+ else do+ Vector.unsafeWrite mspan_chars used_char_count out_char+ return $! ( used_display_columns + char_display_width+ , display_columns_skipped+ , used_char_count + 1+ )+ else if (display_columns_skipped + char_display_width) > columns_to_skip+ then do+ Vector.unsafeWrite mspan_chars used_char_count '…'+ return $! ( used_display_columns + 1+ , columns_to_skip+ , used_char_count + 1+ )+ else return $ ( used_display_columns+ , display_columns_skipped + char_display_width+ , used_char_count+ ) -snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()+snoc_bg_fill :: MRowOps s -> Background -> Word -> Int -> ST s () snoc_bg_fill _row_ops _bg 0 _row = return () snoc_bg_fill mrow_ops (Background c back_attr) fill_length row @@ -266,10 +326,9 @@ $ zip [0 .. fromEnum (fill_length - 1)] (cycle c_bytes) snoc_op mrow_ops row $ TextSpan fill_length fill_length (UTF8.fromRep utf8_bs) -snoc_op :: MRowOps s -> Word -> SpanOp -> ST s ()+snoc_op :: MRowOps s -> Int -> SpanOp -> ST s () snoc_op !mrow_ops !row !op = do- ops <- readSTArray mrow_ops row- let ops' = ops ++ [op]- writeSTArray mrow_ops row ops'- return ()+ ops <- Vector.read mrow_ops row+ let ops' = Vector.snoc ops op+ Vector.write mrow_ops row ops'
src/Graphics/Vty/Terminal/Generic.hs view
@@ -21,11 +21,10 @@ import Control.Monad ( liftM ) import Control.Monad.Trans -import Data.Array import qualified Data.ByteString.Internal as BSCore-import Data.Foldable import Data.IORef import Data.String.UTF8 hiding ( foldl )+import qualified Data.Vector as Vector import System.IO @@ -110,7 +109,7 @@ display_terminal_instance t b (\ d -> DisplayHandle d t s) data DisplayState = DisplayState- { previous_output_ref :: IORef (Maybe SpanOpSequence)+ { previous_output_ref :: IORef (Maybe DisplayOps) } initial_display_state :: MonadIO m => m DisplayState@@ -220,8 +219,8 @@ -> if effected_region previous_ops /= effected_region ops then return $ replicate ( fromEnum $ region_height $ effected_region ops ) True- else return $ zipWith (/=) ( elems $ row_ops previous_ops ) - ( elems $ row_ops ops )+ else return $ zipWith (/=) ( Vector.toList $ display_ops previous_ops ) + ( Vector.toList $ display_ops ops ) -- determine the number of bytes required to completely serialize the output ops. let total = hide_cursor_required_bytes d @@ -254,9 +253,9 @@ liftIO $ writeIORef (previous_output_ref s) (Just ops) return () -required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> SpanOpSequence -> Word+required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> DisplayOps -> Word required_bytes d in_fattr diffs ops = - let (_, n, _, _) = foldl' required_bytes' (0, 0, in_fattr, diffs) ( row_ops ops )+ let (_, n, _, _) = Vector.foldl' required_bytes' (0, 0, in_fattr, diffs) ( display_ops ops ) in n where required_bytes' (y, current_sum, fattr, True : diffs') span_ops@@ -272,11 +271,11 @@ -- The first operation is to set the cursor to the start of the row let header_required_bytes = move_cursor_required_bytes d 0 y -- then the span ops are serialized in the order specified- in foldl' ( \(current_sum, fattr) op -> let (c, fattr') = span_op_required_bytes d fattr op - in (c + current_sum, fattr') - ) - (header_required_bytes, in_fattr)- span_ops+ in Vector.foldl' ( \(current_sum, fattr) op -> let (c, fattr') = span_op_required_bytes d fattr op + in (c + current_sum, fattr') + ) + (header_required_bytes, in_fattr)+ span_ops span_op_required_bytes :: DisplayTerminal d => d -> FixedAttr -> SpanOp -> (Word, FixedAttr) span_op_required_bytes d fattr (AttributeChange attr) = @@ -292,12 +291,12 @@ -> OutputBuffer -> FixedAttr -> [Bool]- -> SpanOpSequence + -> DisplayOps -> m OutputBuffer serialize_output_ops d start_ptr in_fattr diffs ops = do- (_, end_ptr, _, _) <- foldlM serialize_output_ops' + (_, end_ptr, _, _) <- Vector.foldM' serialize_output_ops' ( 0, start_ptr, in_fattr, diffs ) - ( row_ops ops )+ ( display_ops ops ) return end_ptr where serialize_output_ops' ( y, out_ptr, fattr, True : diffs' ) span_ops@@ -319,9 +318,9 @@ -- The first operation is to set the cursor to the start of the row out_ptr' <- serialize_move_cursor d 0 y out_ptr -- then the span ops are serialized in the order specified- foldlM ( \(out_ptr'', fattr) op -> serialize_span_op d op out_ptr'' fattr ) - (out_ptr', in_fattr)- span_ops+ Vector.foldM ( \(out_ptr'', fattr) op -> serialize_span_op d op out_ptr'' fattr ) + (out_ptr', in_fattr)+ span_ops serialize_span_op :: ( MonadIO m, DisplayTerminal d ) => d @@ -357,16 +356,16 @@ { char_to_output_pos :: (Word, Word) -> (Word, Word) } -cursor_output_map :: SpanOpSequence -> Cursor -> CursorOutputMap+cursor_output_map :: DisplayOps -> Cursor -> CursorOutputMap cursor_output_map span_ops _cursor = CursorOutputMap { char_to_output_pos = \(cx, cy) -> (cursor_column_offset span_ops cx cy, cy) } -cursor_column_offset :: SpanOpSequence -> Word -> Word -> Word+cursor_column_offset :: DisplayOps -> Word -> Word -> Word cursor_column_offset span_ops cx cy =- let cursor_row_ops = row_ops span_ops ! cy+ let cursor_row_ops = Vector.unsafeIndex (display_ops span_ops) (fromEnum cy) (out_offset, _, _) - = foldl' ( \(d, current_cx, done) op -> + = Vector.foldl' ( \(d, current_cx, done) op -> if done then (d, current_cx, done) else case span_op_has_width op of Nothing -> (d, current_cx, False) Just (cw, ow) -> case compare cx (current_cx + cw) of
test/Bench.hs view
@@ -1,6 +1,6 @@ module Main where -import Graphics.Vty+import Graphics.Vty hiding ( pad ) import Control.Concurrent( threadDelay ) import Control.Monad( liftM2 )
test/Makefile view
@@ -26,7 +26,18 @@ $(shell mkdir -p objects ) # TODO: Tests should also be buildable referencing the currently installed vty-GHC_ARGS=--make -i../src -package parallel -package deepseq-1.1.0.2 -hide-package transformers -hide-package monads-fd -hide-package monads-tf -package QuickCheck-2.4 -ignore-package vty ../cbits/gwinsz.c ../cbits/set_term_timing.c ../cbits/mk_wcwidth.c -O -funbox-strict-fields -Wall -threaded -fno-full-laziness -fspec-constr -odir objects -hidir objects+GHC_ARGS=--make -i../src \+ -package parallel \+ -package deepseq-1.1.0.2 \+ -hide-package transformers \+ -hide-package monads-fd \+ -hide-package monads-tf \+ -package QuickCheck-2.4 \+ -ignore-package vty \+ ../cbits/gwinsz.c ../cbits/set_term_timing.c ../cbits/mk_wcwidth.c \+ -O -funbox-strict-fields -Wall -threaded -fno-full-laziness -fspec-constr -fspec-constr-count=10 \+ -rtsopts \+ -odir objects -hidir objects GHC_PROF_ARGS=-prof -auto-all $(GHC_ARGS) @@ -48,4 +59,8 @@ .PHONY: interactive_terminal_test interactive_terminal_test : ghc $(GHC_ARGS) $@ && ./$@++.PHONY: core+core :+ ghc-core --no-asm --no-cast -- $(GHC_ARGS) Bench
test/Verify.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-}@@ -11,8 +13,6 @@ , Result(..) , monadicIO , liftIO- , liftIOResult- , liftResult , liftBool ) where@@ -24,9 +24,7 @@ import qualified Codec.Binary.UTF8.String as UTF8 -import Control.Applicative import Control.Monad.State.Strict-import Control.Monad.Trans ( liftIO ) import Data.IORef import Data.Word@@ -34,13 +32,10 @@ import Numeric ( showHex ) import System.IO+import System.Random type Test = StateT TestState IO -instance Applicative Test where- pure = return- ( <*> ) = ap- data TestState = TestState { results_ref :: IORef [QC.Result] }@@ -82,6 +77,17 @@ [ toEnum 0x3040 .. toEnum 0x3098 ] ++ [ toEnum 0x309B .. toEnum 0xA4CF] -instance Arbitrary Word where- arbitrary = choose (0, 1024) >>= return . toEnum++liftIOResult :: Testable prop => IO prop -> Property+liftIOResult = morallyDubiousIOProperty++#if __GLASGOW_HASKELL__ <= 701+instance Random Word where+ random g = + let (i :: Int, g') = random g+ in (toEnum i, g')+ randomR (l,h) g =+ let (i :: Int, g') = randomR (fromEnum l,fromEnum h) g+ in (toEnum i, g')+#endif
test/Verify/Data/Terminfo/Parse.hs view
@@ -111,7 +111,7 @@ verify_bytes_equal out_bytes expected_bytes = if out_bytes == expected_bytes then succeeded- else failed $ result + else failed { reason = "out_bytes [" ++ hex_dump out_bytes ++ "] /= expected_bytes ["
test/Verify/Graphics/Vty/DisplayRegion.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion , module Graphics.Vty.DisplayRegion+ , DebugWindow(..) ) where @@ -21,7 +22,7 @@ instance Arbitrary DebugWindow where arbitrary = do- w <- suchThat arbitrary (/= 0)- h <- suchThat arbitrary (/= 0)+ w <- choose (1,1024)+ h <- choose (1,1024) return $ DebugWindow w h
test/Verify/Graphics/Vty/Image.hs view
@@ -5,12 +5,11 @@ ) where -import Graphics.Vty.Debug+import Verify.Graphics.Vty.Attributes+import Graphics.Vty.Debug.Image import Graphics.Vty.Image-import Graphics.Vty.DisplayRegion import Verify-import Verify.Graphics.Vty.Attributes import Data.Word @@ -51,7 +50,7 @@ -- The text must contain at least one character. Otherwise the image simplifies to the -- IdImage which has a height of 0. If this is to represent a single row then the height -- must be 1- single_column_row_text <- listOf1 arbitrary+ single_column_row_text <- resize 128 (listOf1 arbitrary) attr <- arbitrary return $ SingleRowSingleAttrImage attr @@ -81,7 +80,7 @@ instance Arbitrary SingleAttrSingleSpanStack where arbitrary = do- NonEmpty image_list <- arbitrary+ image_list <- resize 128 (listOf1 arbitrary) let image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- image_list ] return $ SingleAttrSingleSpanStack image
test/Verify/Graphics/Vty/Span.hs view
@@ -20,10 +20,11 @@ verify_all_spans_have_width i spans w = case all_spans_have_width spans w of True -> succeeded- False -> failed $ result { reason = "Not all spans contained operations defining exactly " - ++ show w- ++ " columns of output -\n"- ++ show i- ++ "\n->\n"- ++ show spans- }+ False -> failed { reason = "Not all spans contained operations defining exactly " + ++ show w+ ++ " columns of output -\n"+ ++ show i+ ++ "\n->\n"+ ++ show spans+ }+
test/interactive_terminal_test.hs view
@@ -13,10 +13,10 @@ import Data.List ( lookup ) import Data.Maybe ( isJust, fromJust ) import Data.Monoid+import Data.String.QQ import Data.Word import Foreign.Marshal.Array -import HereDoc import qualified System.Environment as Env @@ -28,14 +28,14 @@ output_file_path = "test_results.list" print_intro = do- putStr $ [$heredoc| + putStr $ [s| This is an interactive verification program for the terminal input and output support of the VTY library. This will ask a series of questions about what you see on screen. The goal is to verify that VTY's output and input support performs as expected with your terminal. This program produces a file named - |] ++ output_file_path ++ [$heredoc| + |] ++ output_file_path ++ [s| in the current directory that contains the results for each test assertion. This can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve support for your terminal. No personal information is contained in the report.@@ -186,7 +186,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. Four lines of text should be visible.@@ -197,7 +197,7 @@ * The cursor is visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -308,14 +308,14 @@ } display_bounds_test_summary has_cursor = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. |] if has_cursor then putStr " 1. The cursor will be visible." else putStr " 1. The cursor will NOT be visible."- putStr [$heredoc|+ putStr [s| 2. The border of the display will be outlined in Xs. So if - and | represented the edge of the terminal window: |-------------|@@ -323,12 +323,12 @@ |X X||] if has_cursor- then putStr $ [$heredoc|+ then putStr $ [s| |XXXXXXXXXXXXC| |]- else putStr $ [$heredoc|+ else putStr $ [s| |XXXXXXXXXXXXX| |] - putStr $ [$heredoc|+ putStr $ [s| |-------------| ( Where C is the final position of the cursor. There may be an X drawn@@ -341,7 +341,7 @@ |] generic_output_match_confirm = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -423,7 +423,7 @@ , confirm_results = generic_output_match_confirm } -unicode_single_width_summary = putStr [$heredoc|+unicode_single_width_summary = putStr [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -505,7 +505,7 @@ , confirm_results = generic_output_match_confirm } -unicode_double_width_summary = putStr [$heredoc|+unicode_double_width_summary = putStr [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -558,7 +558,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -579,7 +579,7 @@ 1. The cursor should be visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -604,7 +604,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -634,7 +634,7 @@ 1. The cursor should be visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -661,7 +661,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -693,7 +693,7 @@ 1. The cursor should be visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -720,7 +720,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -760,7 +760,7 @@ 1. The cursor should be visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -796,7 +796,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -823,7 +823,7 @@ 1. The cursor should be visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -847,7 +847,7 @@ release_terminal t return () , print_summary = do- putStr $ [$heredoc|+ putStr $ [s| Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden.@@ -861,7 +861,7 @@ 1. The cursor should be visible. |] , confirm_results = do- putStr $ [$heredoc|+ putStr $ [s| Did the test output match the description? |] default_success_confirm_results@@ -879,7 +879,7 @@ putStrLn "line 3." release_terminal t return ()- , print_summary = putStr $ [$heredoc|+ , print_summary = putStr $ [s| lines are in order. The second line "line 2" should have a red background and the text underline. The third line "line 3" should be drawn in the same style as the first line.@@ -900,7 +900,7 @@ putStrLn "Not styled." release_terminal t return ()- , print_summary = putStr $ [$heredoc|+ , print_summary = putStr $ [s| |] , confirm_results = generic_output_match_confirm@@ -918,7 +918,7 @@ putStr "Not styled.\n" release_terminal t return ()- , print_summary = putStr $ [$heredoc|+ , print_summary = putStr $ [s| |] , confirm_results = generic_output_match_confirm
test/verify_debug_terminal.hs view
@@ -50,7 +50,7 @@ ++ concat (replicate (fromEnum h - 1) $ "MA" ++ replicate (fromEnum w) 'B') expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected if out_bytes /= expected_bytes- then return $ failed $ result { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }+ then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes } else return succeeded many_T_rows :: DebugWindow -> Property@@ -67,7 +67,7 @@ let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T') expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected if out_bytes /= expected_bytes- then return $ failed $ result { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }+ then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes } else return succeeded many_T_rows_cropped_width :: DebugWindow -> Property@@ -84,7 +84,7 @@ let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T') expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected if out_bytes /= expected_bytes- then return $ failed $ result { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }+ then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes } else return succeeded many_T_rows_cropped_height :: DebugWindow -> Property@@ -101,7 +101,7 @@ let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T') expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected if out_bytes /= expected_bytes- then return $ failed $ result { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }+ then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes } else return succeeded main = run_test $ do
test/verify_eval_terminfo_caps.hs view
@@ -104,8 +104,7 @@ parse_result <- parse_cap_expression cap_def let test_name = "\teval cap " ++ cap_name ++ " -> " ++ show cap_def _ <- case parse_result of- Left error -> verify test_name ( liftResult $ failed - $ result { reason = "prase error " ++ show error } )+ Left error -> verify test_name ( failed { reason = "prase error " ++ show error } ) Right !cap_expr -> verify test_name ( verify_eval_cap eval_buffer cap_expr ) return () Nothing -> do@@ -124,11 +123,11 @@ end_ptr <- serialize_cap_expression expr input_values start_ptr case end_ptr `minusPtr` start_ptr of count | count < 0 -> - return $ failed $ result { reason = "End pointer before start pointer." }+ return $ failed { reason = "End pointer before start pointer." } | toEnum count > byte_count -> - return $ failed $ result { reason = "End pointer past end of buffer by " - ++ show (toEnum count - byte_count) - }+ return $ failed { reason = "End pointer past end of buffer by " + ++ show (toEnum count - byte_count) + } | otherwise -> return succeeded
test/verify_image_ops.hs view
@@ -106,19 +106,19 @@ _ -> True main = run_test $ do- verify "two_sw_horiz_concat" two_sw_horiz_concat- verify "many_sw_horiz_concat" many_sw_horiz_concat- verify "two_sw_vert_concat" two_sw_vert_concat- verify "horiz_concat_sw_assoc" horiz_concat_sw_assoc- verify "many_dw_horiz_concat" many_dw_horiz_concat- verify "two_dw_horiz_concat" two_dw_horiz_concat- verify "two_dw_vert_concat" two_dw_vert_concat- verify "horiz_concat_dw_assoc" horiz_concat_dw_assoc+ _ <- verify "two_sw_horiz_concat" two_sw_horiz_concat+ _ <- verify "many_sw_horiz_concat" many_sw_horiz_concat+ _ <- verify "two_sw_vert_concat" two_sw_vert_concat+ _ <- verify "horiz_concat_sw_assoc" horiz_concat_sw_assoc+ _ <- verify "many_dw_horiz_concat" many_dw_horiz_concat+ _ <- verify "two_dw_horiz_concat" two_dw_horiz_concat+ _ <- verify "two_dw_vert_concat" two_dw_vert_concat+ _ <- verify "horiz_concat_dw_assoc" horiz_concat_dw_assoc liftIO $ putStrLn $ replicate 80 '-'- verify "single row vert concats to correct height" vert_contat_single_row- verify "disjoint_height_horiz_join" disjoint_height_horiz_join- verify "disjoint_height_horiz_join BG fill" disjoint_height_horiz_join_bg_fill- verify "disjoint_width_vert_join" disjoint_width_vert_join- verify "disjoint_width_vert_join BG fill" disjoint_width_vert_join_bg_fill+ _ <- verify "single row vert concats to correct height" vert_contat_single_row+ _ <- verify "disjoint_height_horiz_join" disjoint_height_horiz_join+ _ <- verify "disjoint_height_horiz_join BG fill" disjoint_height_horiz_join_bg_fill+ _ <- verify "disjoint_width_vert_join" disjoint_width_vert_join+ _ <- verify "disjoint_width_vert_join BG fill" disjoint_width_vert_join_bg_fill return ()
test/verify_image_trans.hs view
@@ -2,7 +2,6 @@ module Main where import Verify.Graphics.Vty.Image-import Graphics.Vty.Debug import Verify @@ -18,14 +17,15 @@ is_horiz_text_of_columns image char_count verify_horiz_contat_w_attr_change_simplifies :: SingleRowTwoAttrImage -> Bool-verify_horiz_contat_w_attr_change_simplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 char_count0 image0)- (SingleRowSingleAttrImage attr1 char_count1 image1)+verify_horiz_contat_w_attr_change_simplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 char_count0 _image0)+ (SingleRowSingleAttrImage attr1 char_count1 _image1) i ) | char_count0 == 0 || char_count1 == 0 || attr0 == attr1 = is_horiz_text_of_columns i (char_count0 + char_count1) | otherwise = False == is_horiz_text_of_columns i (char_count0 + char_count1) +main :: IO () main = run_test $ do- verify "verify_horiz_contat_wo_attr_change_simplifies" verify_horiz_contat_wo_attr_change_simplifies- verify "verify_horiz_contat_w_attr_change_simplifies" verify_horiz_contat_w_attr_change_simplifies+ _ <- verify "verify_horiz_contat_wo_attr_change_simplifies" verify_horiz_contat_wo_attr_change_simplifies+ _ <- verify "verify_horiz_contat_w_attr_change_simplifies" verify_horiz_contat_w_attr_change_simplifies return ()
test/verify_parse_terminfo_caps.hs view
@@ -111,7 +111,7 @@ verify_parse_cap cap_string on_parse = liftIOResult $ do parse_result <- parse_cap_expression cap_string case parse_result of- Left error -> return $ failed $ result { reason = "parse error " ++ show error }+ Left error -> return $ failed { reason = "parse error " ++ show error } Right e -> on_parse e non_paramaterized_caps (NonParamCapString cap) = do@@ -140,7 +140,7 @@ out_param_count = param_count e in return $ if out_param_count == expected_param_count then verify_bytes_equal out_bytes expected_bytes- else failed $ result { reason = "out param count /= expected param count" }+ else failed { reason = "out param count /= expected param count" } dec_print_param_caps (DecPrintCap cap_string expected_param_count expected_bytes) = do verify_parse_cap cap_string $ \e ->@@ -149,7 +149,7 @@ out_param_count = param_count e in return $ if out_param_count == expected_param_count then verify_bytes_equal out_bytes expected_bytes- else failed $ result { reason = "out param count /= expected param count" }+ else failed { reason = "out param count /= expected param count" } print_cap ti cap_name = do putStrLn $ cap_name ++ ": " ++ show (from_capname ti cap_name)
test/verify_span_ops.hs view
@@ -11,7 +11,7 @@ import Verify -import Data.Array+import qualified Data.Vector as Vector unit_image_and_zero_window_0 :: UnitImage -> EmptyWindow -> Bool unit_image_and_zero_window_0 (UnitImage _ i) (EmptyWindow w) = @@ -139,7 +139,7 @@ first_span_op_sets_attr :: DefaultPic -> Bool first_span_op_sets_attr DefaultPic { default_pic = pic, default_win = win } = let spans = spans_for_pic pic (region_for_window win)- in all ( is_attr_span_op . head ) ( elems $ row_ops spans )+ in all ( is_attr_span_op . Vector.head ) ( Vector.toList $ display_ops spans ) single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result single_attr_single_span_stack_op_coverage stack =@@ -150,30 +150,31 @@ main :: IO () main = run_test $ do- verify "unit image is cropped when window size == (0,0) [0]" unit_image_and_zero_window_0- verify "unit image is cropped when window size == (0,0) [1]" unit_image_and_zero_window_1- verify "horiz span image is cropped when window size == (0,0) [0]" horiz_span_image_and_zero_window_0- verify "horiz span image is cropped when window size == (0,0) [1]" horiz_span_image_and_zero_window_1- verify "horiz span image is not cropped when window size == size of image [width]" horiz_span_image_and_equal_window_0- verify "horiz span image is not cropped when window size == size of image [height]" horiz_span_image_and_equal_window_1- verify "horiz span image is not cropped when window size < size of image [width]" horiz_span_image_and_lesser_window_0- verify "horiz span image is not cropped when window size > size of image [width]" horiz_span_image_and_greater_window_0- verify "arbitrary image is padded or cropped" arb_image_is_cropped- verify "The span ops actually define content for all the rows in the output region" span_ops_actually_fill_rows- verify "The span ops actually define content for all the columns in the output region" span_ops_actually_fill_columns- verify "first span op is always to set the text attribute" first_span_op_sets_attr- verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"+ _ <- verify "unit image is cropped when window size == (0,0) [0]" unit_image_and_zero_window_0+ _ <- verify "unit image is cropped when window size == (0,0) [1]" unit_image_and_zero_window_1+ _ <- verify "horiz span image is cropped when window size == (0,0) [0]" horiz_span_image_and_zero_window_0+ _ <- verify "horiz span image is cropped when window size == (0,0) [1]" horiz_span_image_and_zero_window_1+ _ <- verify "horiz span image is not cropped when window size == size of image [width]" horiz_span_image_and_equal_window_0+ _ <- verify "horiz span image is not cropped when window size == size of image [height]" horiz_span_image_and_equal_window_1+ _ <- verify "horiz span image is not cropped when window size < size of image [width]" horiz_span_image_and_lesser_window_0+ _ <- verify "horiz span image is not cropped when window size > size of image [width]" horiz_span_image_and_greater_window_0+ _ <- verify "arbitrary image is padded or cropped" arb_image_is_cropped+ _ <- verify "The span ops actually define content for all the rows in the output region" span_ops_actually_fill_rows+ _ <- verify "The span ops actually define content for all the columns in the output region" span_ops_actually_fill_columns+ _ <- verify "first span op is always to set the text attribute" first_span_op_sets_attr+ _ <- verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]" single_attr_single_span_stack_op_coverage- verify "a single attr text span is cropped when window size < size of stack image [width]"+ _ <- verify "a single attr text span is cropped when window size < size of stack image [width]" single_attr_single_span_stack_cropped_0 - verify "a single attr text span is cropped when window size < size of stack image [height]"+ _ <- verify "a single attr text span is cropped when window size < size of stack image [height]" single_attr_single_span_stack_cropped_1- verify "single attr text span <|> single attr text span cropped. [width]"+ _ <- verify "single attr text span <|> single attr text span cropped. [width]" single_attr_single_span_stack_cropped_2- verify "single attr text span <|> single attr text span cropped. [height]"+ _ <- verify "single attr text span <|> single attr text span cropped. [height]" single_attr_single_span_stack_cropped_3- verify "single attr text span <-> single attr text span cropped. [width]"+ _ <- verify "single attr text span <-> single attr text span cropped. [width]" single_attr_single_span_stack_cropped_4- verify "single attr text span <-> single attr text span cropped. [height]"+ _ <- verify "single attr text span <-> single attr text span cropped. [height]" single_attr_single_span_stack_cropped_5 return ()+
vty.cabal view
@@ -1,5 +1,5 @@ Name: vty-Version: 4.7.0.0+Version: 4.7.0.4 License: BSD3 License-file: LICENSE Author: Stefan O'Rear, Corey O'Connor@@ -28,12 +28,12 @@ . © 2008-2011 Corey O'Connor; BSD3 license. -Build-Depends: base >= 4 && < 5, bytestring, containers, unix+Build-Depends: base >= 4 && < 5, ghc-prim, bytestring, containers, unix Build-Depends: terminfo >= 0.3 && < 0.4 Build-Depends: utf8-string >= 0.3 && < 0.4 Build-Depends: mtl >= 1.1.1.0 && < 2.1-Build-Depends: ghc-prim, parallel >= 2.2 && < 3.2, deepseq >= 1.1 && < 1.2-Build-Depends: array+Build-Depends: parallel >= 2.2 && < 3.2, deepseq >= 1.1 && < 1.2+Build-Depends: vector >= 0.7 Build-Depends: parsec >= 2 && < 4 Build-Type: Simple Data-Files: README, TODO@@ -105,4 +105,4 @@ ghc-options: -O2 -funbox-strict-fields -Wall -fno-full-laziness -fspec-constr -fspec-constr-count=10 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fno-full-laziness -fspec-constr -fspec-constr-count=10-+cc-options: -O2