diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,17 @@ +The following people should be thanked for contributing to the vty library: + * Andrea Vezzosi + * Corey O'Connor + * Emily Backes + * Josef Svenningsson + * Nicolas Pouillard + * Roman Cheplyaka + * Stefan O'Rear + * Yusaku Hashimoto + * allan.clark + * gwern0 + * jeanphilippe.bernardy + * m.niloc + * mikesteele81 + * Mikolaj Konarski + * Eyal Lotem + * Yoshikuni Jujo diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,86 @@ +4.7.0.0 + * API changes: + * Added Graphics.Vty.Image.crop: Ensure an image is no larger than the specified size. + * Added Graphics.Vty.Image.pad: Ensure an image is no smaller than the specified size. + * Added Graphics.Vty.Image.translate: Offset an image. + * Thanks Ben Boeckel for these features. + +4.3.0.0 + +4.2.1.0 + * API changes: + * Attr record accessor fore_color changed to attr_fore_color + * Attr record accessor back_color changed to attr_back_color + * Attr record accessor style changed to attr_style + * Added an "inline" display attribute changing DSL: + * put_attr_change applies a display attribute change immediately to a terminal + * For instance, can be used to change the display attrbiutes of text output via putStrLn + and putStr. EX: "put_attr_change $ back_color red" will set the + background color to red. + * Changes do not apply to a Picture output via output_picture. + * See Graphics.Vty.Inline + * Moved all IO actions into any monad an instance of MonadIO + +4.0.0.1 + * binding for mk_wcswidth was incorrect. Most platforms just magically worked due to + coincidence. + +4.0.0 + * API changes: + * "getSize" has been removed. Use "terminal vty >>= display_bounds" where "vty" is an + instance of the Vty data structure. + * added a "terminal" field to the Vty data structure. Accesses the TerminalHandle associated + with the Vty instance. + * Graphics.Vty.Types has undergone a number of changes. Summary: + * Partitioned into Graphics.Vty.Attributes for display attributes. Graphics.Vty.Image for + image combinators. Graphics.Vty.Picture for final picture construction. + * Graphics.Vty.Attributes: + * "setFG" and "setBG" are now "with_fore_color" and "with_back_color" + * All other "set.." equations similarly replaced. + * "attr" is now "def_attr", short for "default display attributes" Also added a + "current_attr" for "currently applied display attributes" + * Graphics.Vty.Image: + * "horzcat" is now "horiz_cat" + * "vertcat" is now "vert_cat" + * "renderBS" is now "utf8_bytestring" + * "renderChar" is now "char" + * "renderFill" is now "char_fill" + * added a "utf8_string" and "string" (AKA "iso_10464_string") for UTF-8 encoded Strings + and ISO-10464 encoded Strings. String literals in GHC have an ISO-10464 runtime + representation. + * Graphics.Vty.Picture: + * exports Graphics.Vty.Image + * "pic" is now "pic_for_image" + * added API for setting background fill pattern. + * Completely rewritten output backend. + * Efficient, scanline style output span generator. Has not been fully optimized, but good + enough. + * The details required to display the desired picture on a terminal are well encapsulated. + * Terminfo based display terminal implementation. With specialized derivitives for xterm, + Terminal.app, and iTerm.app. + * Attempts to robustly handle even terminals that don't support all display attributes. + * I've tested the following terminals with success: iTerm.app, Terminal.app, xterm, + rxvt, mlterm, Eterm, gnome-terminal, konsole, screen, linux vty. Hopefully you will be + as successfull. + * Improved unicode support. Double wide characters will display as expected. + * 256 color support. See Graphics.Vty.Attributes.Color240. The actual output color is adjusted + according to the number of colors the terminal supports. + * The Graphics.Vty.Image combinators no longer require matching dimensions to arguments. + Unspecified areas are filled in with a user-customizable background pattern. See + Graphics.Vty.Picture. + * output images are always cropped to display size. + * Significant code coverage by QuickCheck tests. An interactive test for those final properties + that couldn't be automatically verified. + + issues resolved: + * "gnome terminal displays non-basic attributes as strikethrough" + * http://trac.haskell.org/vty/ticket/14 + * "Multi-byte characters are not displayed correctly on update" + * http://trac.haskell.org/vty/ticket/10 + * "Redraw does not handle rendering a line that extends beyond screen width characters" + * http://trac.haskell.org/vty/ticket/13 + * "The <|> and <-> combinators should be more forgiving of mismatched dimensions" + * http://trac.haskell.org/vty/ticket/9 + * "256-color support" + * http://trac.haskell.org/vty/ticket/19 + diff --git a/cbits/gwinsz.h b/cbits/gwinsz.h deleted file mode 100644 --- a/cbits/gwinsz.h +++ /dev/null @@ -1,1 +0,0 @@ -unsigned long vty_c_get_window_size(void); diff --git a/src/Codec/Binary/UTF8/Debug.hs b/src/Codec/Binary/UTF8/Debug.hs deleted file mode 100644 --- a/src/Codec/Binary/UTF8/Debug.hs +++ /dev/null @@ -1,17 +0,0 @@ --- Copyright 2009 Corey O'Connor -module Codec.Binary.UTF8.Debug - where - -import Codec.Binary.UTF8.String ( encode ) - -import Data.Word - -import Numeric - --- Converts an array of ISO-10646 characters (Char type) to an array of Word8 bytes that is the --- corresponding UTF8 byte sequence -utf8_from_iso :: Integral i => [i] -> [Word8] -utf8_from_iso = encode . map toEnum - -pp_utf8 = print . map (\f -> f "") . map showHex . utf8_from_iso - diff --git a/src/Data/Terminfo/Eval.hs b/src/Data/Terminfo/Eval.hs --- a/src/Data/Terminfo/Eval.hs +++ b/src/Data/Terminfo/Eval.hs @@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MonoPatBinds #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {- Evaluates the paramaterized terminfo string capability with the given parameters. - diff --git a/src/Graphics/Vty/Debug/Image.hs b/src/Graphics/Vty/Debug/Image.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Vty/Debug/Image.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Graphics.Vty.Debug.Image where + +import Graphics.Vty.Image + +type ImageConstructLog = [ImageConstructEvent] +data ImageConstructEvent = ImageConstructEvent + deriving ( Show, Eq ) + +forward_image_ops :: [Image -> Image] +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 :: [ImageOp] +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 diff --git a/src/Graphics/Vty/LLInput.hs b/src/Graphics/Vty/LLInput.hs --- a/src/Graphics/Vty/LLInput.hs +++ b/src/Graphics/Vty/LLInput.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2009-2010 Corey O'Connor {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE ForeignFunctionInterface #-} @@ -28,11 +29,13 @@ import System.Posix.Signals.Exts import System.Posix.Terminal import System.Posix.IO ( stdInput - ,fdRead + ,fdReadBuf ,setFdOption ,FdOption(..) ) +import Foreign ( alloca, poke, peek, Ptr ) + -- |Representations of non-modifier keys. data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KNP5 | KUp | KMenu @@ -74,28 +77,34 @@ where loop kb = case (classify kb) of Prefix -> do c <- readChan inputChannel loop (kb ++ [c]) - Invalid -> loop "" + Invalid -> do c <- readChan inputChannel + loop [c] MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s Valid k m -> writeChan eventChannel (EvKey k m) >> loop "" finishAtomicInput = writeChan inputChannel '\xFFFE' inputThread :: IO () - inputThread = loop - where - loop = do - setFdOption stdInput NonBlockingRead False - threadWaitRead stdInput - setFdOption stdInput NonBlockingRead True - _ <- try readAll :: IO (Either IOException ()) - when (escDelay == 0) finishAtomicInput - loop - readAll = do - (bytes, bytes_read) <- fdRead stdInput 1 - when (bytes_read > 0) $ do - _ <- tryPutMVar hadInput () -- signal input - writeChan inputChannel (head bytes) - readAll + inputThread = do + _ <- alloca $ \(input_buffer :: Ptr Word8) -> do + let loop = do + setFdOption stdInput NonBlockingRead False + threadWaitRead stdInput + setFdOption stdInput NonBlockingRead True + _ <- try readAll :: IO (Either IOException ()) + when (escDelay == 0) finishAtomicInput + loop + readAll = do + poke input_buffer 0 + bytes_read <- fdReadBuf stdInput input_buffer 1 + input_char <- fmap (chr . fromIntegral) $ peek input_buffer + when (bytes_read > 0) $ do + _ <- tryPutMVar hadInput () -- signal input + writeChan inputChannel input_char + readAll + loop + return () + -- | If there is no input for some time, this thread puts '\xFFFE' in the -- inputChannel. noInputThread :: IO () @@ -104,6 +113,7 @@ takeMVar hadInput -- wait for some input threadDelay escDelay -- microseconds hadNoInput <- isEmptyMVar hadInput -- no input yet? + -- TODO(corey): there is a race between here and the inputThread. when hadNoInput $ do finishAtomicInput loop @@ -218,6 +228,7 @@ writeChan eventChannel (EvResize e e)) _ <- installHandler windowChange pokeIO Nothing _ <- installHandler continueProcess pokeIO Nothing + -- TODO(corey): killThread is a bit risky for my tastes. let uninit = do killThread eventThreadId killThread inputThreadId killThread noInputThreadId diff --git a/src/Graphics/Vty/Span.hs b/src/Graphics/Vty/Span.hs --- a/src/Graphics/Vty/Span.hs +++ b/src/Graphics/Vty/Span.hs @@ -186,7 +186,7 @@ (skip_row', skip_col) (y + top_height) remaining_columns - (remain_rows - top_height) + (max 0 $ remain_rows - top_height) return (skip_row'', min skip_col' skip_col'') HorizJoin l r _ _ -> do (skip_row',skip_col') <- row_ops_for_image mrow_ops l bg region skip_dim y remaining_columns remain_rows diff --git a/src/Graphics/Vty/Terminal/TerminfoBased.hs b/src/Graphics/Vty/Terminal/TerminfoBased.hs --- a/src/Graphics/Vty/Terminal/TerminfoBased.hs +++ b/src/Graphics/Vty/Terminal/TerminfoBased.hs @@ -23,7 +23,7 @@ import Data.Maybe ( isJust, isNothing, fromJust ) import Data.Word -import Foreign.C.Types ( CLong ) +import Foreign.C.Types ( CLong(..) ) import GHC.IO.Handle diff --git a/test/Bench.hs b/test/Bench.hs deleted file mode 100644 --- a/test/Bench.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Main where - -import Graphics.Vty hiding ( pad ) - -import Control.Concurrent( threadDelay ) -import Control.Monad( liftM2 ) - -import Data.List -import Data.Word - -import System.Environment( getArgs ) -import System.IO -import System.Random - - -main = do - let fixed_gen = mkStdGen 0 - setStdGen fixed_gen - args <- getArgs - case args of - [] -> mkVty >>= liftM2 (>>) (run $ Just 0) shutdown - ["--delay"] -> mkVty >>= liftM2 (>>) (run $ Just 1000000) shutdown - ["--slow"] -> mkVty >>= liftM2 (>>) (run Nothing ) shutdown - _ -> fail "usage: ./Bench [--slow|--delay]" - -run (Just delay) vt = mapM_ (\p -> update vt p >> threadDelay delay) . benchgen =<< display_bounds (terminal vt) -run Nothing vt = mapM_ (update vt) (benchgen $ DisplayRegion 200 100) - --- Currently, we just do scrolling. -takem :: (a -> Word) -> Word -> [a] -> ([a],[a]) -takem len n [] = ([],[]) -takem len n (x:xs) | lx > n = ([], x:xs) - | True = let (tk,dp) = takem len (n - lx) xs in (x:tk,dp) - where lx = len x - -fold :: (a -> Word) -> [Word] -> [a] -> [[a]] -fold len [] xs = [] -fold len (ll:lls) xs = let (tk,dp) = takem len ll xs in tk : fold len lls dp - -lengths :: Word -> StdGen -> [Word] -lengths ml g = - let (x,g2) = randomR (0,fromEnum ml) g - (y,g3) = randomR (0,x) g2 - in (toEnum y) : lengths ml g3 - -nums :: StdGen -> [(Attr, String)] -nums g = let (x,g2) = (random g :: (Int, StdGen)) - (c,g3) = random g2 - in ( if c then def_attr `with_fore_color` red else def_attr - , shows x " " - ) : nums g3 - -pad :: Word -> Image -> Image -pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1 - -clines :: StdGen -> Word -> [Image] -clines g maxll = map (pad maxll . horiz_cat . map (uncurry string)) $ fold (toEnum . length . snd) (lengths maxll g1) (nums g2) - where (g1,g2) = split g - -benchgen :: DisplayRegion -> [Picture] -benchgen (DisplayRegion w h) = take 500 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h)) $ tails $ clines (mkStdGen 42) w - diff --git a/test/Bench2.hs b/test/Bench2.hs deleted file mode 100644 --- a/test/Bench2.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -import Graphics.Vty -import System.IO -import System.Environment( getArgs ) -import Control.Concurrent( threadDelay ) -import System.Random -import Data.List -import Control.Monad( liftM2 ) - -import qualified Data.ByteString.Char8 as B - -main = do - let fixed_gen = mkStdGen 0 - setStdGen fixed_gen - args <- getArgs - vt <- mkVty - (w, h) <- getSize vt - let !image_0 = renderFill attr 'X' w h - let !image_1 = renderFill attr '0' w h - run vt image_0 image_1 - shutdown vt - -run vt image_0 image_1 = run' vt 300 image_0 image_1 - -run' vt 0 image_0 image_1 = return () -run' vt n image_0 image_1 = do - let p = pic { pImage = image_0 } - update vt p - run' vt (n - 1) image_1 image_0 - diff --git a/test/BenchRenderChar.hs b/test/BenchRenderChar.hs deleted file mode 100644 --- a/test/BenchRenderChar.hs +++ /dev/null @@ -1,32 +0,0 @@ -{- benchmarks composing images using the renderChar operation. - - This is what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar images horizontally - - composed should provide no worse performance than a fill render op. - -} -import Graphics.Vty - -import Control.Monad ( forM_ ) - -import System.Time - -main = do - vty <- mkVty - (w, h) <- getSize vty - let test_chars = take 500 $ cycle $ [ c | c <- ['a'..'z']] - start_time_0 <- getClockTime - forM_ test_chars $ \test_char -> do - let test_image = test_image_using_renderChar test_char w h - out_pic = pic { pImage = test_image } - update vty out_pic - end_time_0 <- getClockTime - let start_time_1 = end_time_0 - forM_ test_chars $ \test_char -> do - let test_image = renderFill attr test_char w h - out_pic = pic { pImage = test_image } - update vty out_pic - end_time_1 <- getClockTime - shutdown vty - putStrLn $ timeDiffToString $ diffClockTimes end_time_0 start_time_0 - putStrLn $ timeDiffToString $ diffClockTimes end_time_1 start_time_1 - -test_image_using_renderChar c w h = vertcat $ replicate h $ horzcat $ map (renderChar attr) (replicate w c) - diff --git a/test/ControlTable.hs b/test/ControlTable.hs deleted file mode 100644 --- a/test/ControlTable.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Main where - -import Graphics.Vty.ControlStrings - -import System.Console.Terminfo - -main = do - terminal <- setupTermFromEnv - control_table <- init_control_table terminal - putStrLn $ "ANSI terminal show cursor string: " ++ show cvis - putStrLn $ "Current terminal show cursor string: " ++ show (show_cursor_str control_table) - putStrLn $ "ANSI terminal hide cursor string: " ++ show civis - putStrLn $ "Current terminal hide cursor string: " ++ show (hide_cursor_str control_table) - diff --git a/test/HereDoc.hs b/test/HereDoc.hs deleted file mode 100644 --- a/test/HereDoc.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -{- From http://www.reddit.com/r/haskell/comments/8ereh/a_here_document_syntax/ - - copyright unknown? - -} -module HereDoc (heredoc) where - -import Language.Haskell.TH.Quote -import Language.Haskell.TH.Syntax -import Language.Haskell.TH.Lib - -heredoc :: QuasiQuoter -heredoc = QuasiQuoter (litE . stringL) (litP . stringL) undefined undefined - diff --git a/test/Makefile b/test/Makefile deleted file mode 100644 --- a/test/Makefile +++ /dev/null @@ -1,65 +0,0 @@ -VERIF_TESTS := \ -verify_attribute_ops \ -verify_display_attributes \ -verify_parse_terminfo_caps \ -verify_eval_terminfo_caps \ -verify_utf8_width \ -verify_image_ops \ -verify_image_trans \ -verify_empty_image_props \ -verify_picture_ops \ -verify_span_ops \ -verify_debug_terminal \ -verify_inline \ - - -TESTS :=\ -Bench \ -Bench2 \ -BenchRenderChar \ -Test \ -Test2 \ -yi_issue_264 \ -vty_issue_18 \ -$(VERIF_TESTS) - -$(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.3.0.0 \ - -hide-package transformers \ - -hide-package monads-tf \ - -package QuickCheck \ - -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) - -SOURCE := $(shell find ../src ../cbits -name '*.hs' -print -or -name '*.c' -print -or -name '*.h' -print) - -.PHONY: all -all : $(VERIF_TESTS) - -.PHONY: $(TESTS) -.SECONDEXPANSION: -$(TESTS) : - @echo running test $@ - @mkdir -p results/$@ - ( ghc $(GHC_PROF_ARGS) $@ \ - && time ./$@ +RTS -p -sresults/$@/mem_report \ - && cp $@.prof results/$@/profile \ - ) - -.PHONY: interactive_terminal_test -interactive_terminal_test : - ghc $(GHC_ARGS) $@ && ./$@ - -.PHONY: core -core : - ghc-core --no-asm --no-cast -- $(GHC_ARGS) Bench - diff --git a/test/Test.hs b/test/Test.hs deleted file mode 100644 --- a/test/Test.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Main where - -import Graphics.Vty - -import qualified Data.ByteString as B -import Data.Word - -import System.IO - - -main = do - vt <- mkVty - DisplayRegion w h <- display_bounds $ terminal vt - putStrLn $ show $ DisplayRegion w h - play vt 0 1 w h "" - -pieceA = def_attr `with_fore_color` red -dumpA = def_attr `with_style` reverse_video - -play :: Vty -> Word -> Word -> Word -> Word -> String -> IO () -play vt x y sx sy btl = do update vt (current_pic x y sx sy btl) - k <- next_event vt - case k of EvKey (KASCII 'r') [MCtrl] -> refresh vt >> play vt x y sx sy btl - EvKey KLeft [] | x /= 0 -> play vt (x-1) y sx sy btl - EvKey KRight [] | x /= (sx-1) -> play vt (x+1) y sx sy btl - EvKey KUp [] | y /= 1 -> play vt x (y-1) sx sy btl - EvKey KDown [] | y /= (sy-2) -> play vt x (y+1) sx sy btl - EvKey KEsc [] -> shutdown vt >> return () - EvResize nx ny -> play vt (min x (toEnum nx - 1)) - (min y (toEnum ny - 2)) - (toEnum nx) - (toEnum ny) - btl - _ -> play vt x y sx sy (take (fromEnum sx) (show k ++ btl)) - - -current_pic :: Word -> Word -> Word -> Word -> String -> Picture -current_pic x y sx sy btl = pic_for_image i - where i = string def_attr "Move the @ character around with the arrow keys. Escape exits." - <-> char_fill pieceA ' ' sx (y - 1) - <-> char_fill pieceA ' ' x 1 <|> char pieceA '@' <|> char_fill pieceA ' ' (sx - x - 1) 1 - <-> char_fill pieceA ' ' sx (sy - y - 2) - <-> iso_10646_string dumpA btl diff --git a/test/Test2.hs b/test/Test2.hs deleted file mode 100644 --- a/test/Test2.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Main where -import Graphics.Vty - -main = do - vty <- mkVty - (sx,sy) <- getSize vty - update vty (pic { pImage = renderFill (setBG red attr) 'X' sx sy }) - refresh vty - getEvent vty - shutdown vty - putStrLn "Done!" - return () - diff --git a/test/Verify.hs b/test/Verify.hs --- a/test/Verify.hs +++ b/test/Verify.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -10,16 +11,21 @@ , succeeded , failed , result - , Result(..) , monadicIO , liftIO , liftBool + , Test(..) + , Prop.Result(..) ) where +import Distribution.TestSuite hiding ( Result(..) ) +import qualified Distribution.TestSuite as TS + import Test.QuickCheck hiding ( Result(..) ) import qualified Test.QuickCheck as QC -import Test.QuickCheck.Property +import Test.QuickCheck.Property hiding ( Result(..) ) +import qualified Test.QuickCheck.Property as Prop import Test.QuickCheck.Monadic ( monadicIO ) import qualified Codec.Binary.UTF8.String as UTF8 @@ -34,31 +40,18 @@ import System.IO import System.Random -type Test = StateT TestState IO - -data TestState = TestState - { results_ref :: IORef [QC.Result] - } - -run_test :: Test () -> IO () -run_test t = do - s <- newIORef [] >>= return . TestState - s' <- runStateT t s >>= return . snd - results <- readIORef $ results_ref s' - let fail_results = [ fail_result | fail_result@(QC.Failure {}) <- results ] - case fail_results of - [] -> putStrLn "state: PASS" - rs -> do - putStrLn "state: FAIL" - putStrLn $ "fail_count: " ++ show (length rs) - -verify :: Testable prop => String -> prop -> Test QC.Result -verify prop_name prop = do - liftIO $ putStrLn $ "verify " ++ prop_name - get >>= \s -> do - r <- liftIO $ quickCheckResult prop - liftIO $ modifyIORef (results_ref s) (\rs -> r : rs) - return r +verify :: Testable t => String -> t -> Test +verify test_name p = Test $ TestInstance + { name = test_name + , run = do + qc_result <- quickCheckResult p + case qc_result of + QC.Success {..} -> return $ Finished TS.Pass + _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message" + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } data SingleColumnChar = SingleColumnChar Char deriving (Show, Eq) @@ -73,10 +66,9 @@ show (DoubleColumnChar c) = "(0x" ++ showHex (fromEnum c) "" ++ ") ->" ++ UTF8.encodeString [c] instance Arbitrary DoubleColumnChar where - arbitrary = elements $ map DoubleColumnChar $ - [ toEnum 0x3040 .. toEnum 0x3098 ] - ++ [ toEnum 0x309B .. toEnum 0xA4CF] - + arbitrary = elements $ map DoubleColumnChar $ + [ toEnum 0x3040 .. toEnum 0x3098 ] + ++ [ toEnum 0x309B .. toEnum 0xA4CF ] liftIOResult :: Testable prop => IO prop -> Property liftIOResult = morallyDubiousIOProperty diff --git a/test/Verify/Data/Terminfo/Parse.hs b/test/Verify/Data/Terminfo/Parse.hs --- a/test/Verify/Data/Terminfo/Parse.hs +++ b/test/Verify/Data/Terminfo/Parse.hs @@ -8,7 +8,6 @@ import Data.Terminfo.Eval import Verify -import Data.Array.Unboxed import Data.Word import Numeric diff --git a/test/VerifyAttributeOps.hs b/test/VerifyAttributeOps.hs new file mode 100644 --- /dev/null +++ b/test/VerifyAttributeOps.hs @@ -0,0 +1,9 @@ +module VerifyAttributeOps where + +import Verify.Graphics.Vty.Attributes + +import Verify + +tests :: IO [Test] +tests = return [] + diff --git a/test/VerifyDisplayAttributes.hs b/test/VerifyDisplayAttributes.hs new file mode 100644 --- /dev/null +++ b/test/VerifyDisplayAttributes.hs @@ -0,0 +1,9 @@ +module VerifyDisplayAttributes where + +import Verify.Graphics.Vty.DisplayAttributes +import Verify.Graphics.Vty.Attributes + +import Verify + +tests :: IO [Test] +tests = return [] diff --git a/test/VerifyEmptyImageProps.hs b/test/VerifyEmptyImageProps.hs new file mode 100644 --- /dev/null +++ b/test/VerifyEmptyImageProps.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module VerifyEmptyImageProps where + +import Verify + +-- should be exported by Graphics.Vty.Picture +import Graphics.Vty.Picture ( Image, empty_image ) + +tests :: IO [Test] +tests = do + -- should provide an image type. + let _ :: Image = empty_image + return [] + diff --git a/test/VerifyEvalTerminfoCaps.hs b/test/VerifyEvalTerminfoCaps.hs new file mode 100644 --- /dev/null +++ b/test/VerifyEvalTerminfoCaps.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-} +module VerifyEvalTerminfoCaps where + +import Data.Marshalling + +import Data.Terminfo.Eval +import Data.Terminfo.Parse +import Control.DeepSeq + +import qualified System.Console.Terminfo as Terminfo + +import Verify + +import Control.Applicative ( (<$>) ) +import Control.Exception ( try, SomeException(..) ) + +import Control.Monad ( mapM_, forM, forM_ ) + +import Data.Maybe ( fromJust ) +import Data.Word + +import Numeric + +-- A list of terminals that ubuntu includes a terminfo cap file for. +-- Assuming that is a good place to start. +terminals_of_interest = + [ "wsvt25" + , "wsvt25m" + , "vt52" + , "vt100" + , "vt220" + , "vt102" + , "xterm-r5" + , "xterm-xfree86" + , "xterm-r6" + , "xterm-256color" + , "xterm-vt220" + , "xterm-debian" + , "xterm-mono" + , "xterm-color" + , "xterm" + , "mach" + , "mach-bold" + , "mach-color" + , "linux" + , "ansi" + , "hurd" + , "Eterm" + , "pcansi" + , "screen-256color" + , "screen-bce" + , "screen-s" + , "screen-w" + , "screen" + , "screen-256color-bce" + , "sun" + , "rxvt" + , "rxvt-unicode" + , "rxvt-basic" + , "cygwin" + , "cons25" + , "dumb" + ] + +-- If a terminal defines one of the caps then it's expected to be parsable. +caps_of_interest = + [ "cup" + , "sc" + , "rc" + , "setf" + , "setb" + , "setaf" + , "setab" + , "op" + , "cnorm" + , "civis" + , "smcup" + , "rmcup" + , "clear" + , "hpa" + , "vpa" + , "sgr" + , "sgr0" + ] + +from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name) + +tests :: IO [Test] +tests = do + eval_buffer :: Ptr Word8 <- mallocBytes (1024 * 1024) -- Should be big enough for any termcaps ;-) + fmap concat $ forM terminals_of_interest $ \term_name -> do + putStrLn $ "adding tests for terminal: " ++ term_name + mti <- try $ Terminfo.setupTerm term_name + case mti of + Left (_e :: SomeException) + -> return [] + Right ti -> do + fmap concat $ forM caps_of_interest $ \cap_name -> do + case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of + Just cap_def -> do + putStrLn $ "\tadding test for cap: " ++ cap_name + let test_name = term_name ++ "(" ++ cap_name ++ ")" + parse_result <- parse_cap_expression cap_def + case parse_result of + Left error -> return [ verify test_name ( failed { reason = "parse error " ++ show error } ) ] + Right !cap_expr -> return [ verify test_name ( verify_eval_cap eval_buffer cap_expr ) ] + Nothing -> do + return [] + +{-# NOINLINE verify_eval_cap #-} +verify_eval_cap :: Ptr Word8 -> CapExpression -> Int -> Property +verify_eval_cap eval_buffer expr !junk_int = do + forAll (vector 9) $ \input_values -> + let !byte_count = cap_expression_required_bytes expr input_values + in liftIOResult $ do + let start_ptr :: Ptr Word8 = eval_buffer + forM_ [0..100] $ \i -> serialize_cap_expression expr input_values start_ptr + end_ptr <- serialize_cap_expression expr input_values start_ptr + case end_ptr `minusPtr` start_ptr of + count | count < 0 -> + return $ failed { reason = "End pointer before start pointer." } + | toEnum count > byte_count -> + return $ failed { reason = "End pointer past end of buffer by " + ++ show (toEnum count - byte_count) + } + | otherwise -> + return succeeded + diff --git a/test/VerifyImageOps.hs b/test/VerifyImageOps.hs new file mode 100644 --- /dev/null +++ b/test/VerifyImageOps.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module VerifyImageOps where + +import Graphics.Vty.Attributes +import Verify.Graphics.Vty.Image + +import Verify + +import Data.Word + +two_sw_horiz_concat :: SingleColumnChar -> SingleColumnChar -> Bool +two_sw_horiz_concat (SingleColumnChar c1) (SingleColumnChar c2) = + image_width (char def_attr c1 <|> char def_attr c2) == 2 + +many_sw_horiz_concat :: [SingleColumnChar] -> Bool +many_sw_horiz_concat cs = + let chars = [ char | SingleColumnChar char <- cs ] + l = fromIntegral $ length cs + in image_width ( horiz_cat $ map (char def_attr) chars ) == l + +two_sw_vert_concat :: SingleColumnChar -> SingleColumnChar -> Bool +two_sw_vert_concat (SingleColumnChar c1) (SingleColumnChar c2) = + image_height (char def_attr c1 <-> char def_attr c2) == 2 + +horiz_concat_sw_assoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool +horiz_concat_sw_assoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) = + (char def_attr c0 <|> char def_attr c1) <|> char def_attr c2 + == + char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2) + +two_dw_horiz_concat :: DoubleColumnChar -> DoubleColumnChar -> Bool +two_dw_horiz_concat (DoubleColumnChar c1) (DoubleColumnChar c2) = + image_width (char def_attr c1 <|> char def_attr c2) == 4 + +many_dw_horiz_concat :: [DoubleColumnChar] -> Bool +many_dw_horiz_concat cs = + let chars = [ char | DoubleColumnChar char <- cs ] + l = fromIntegral $ length cs + in image_width ( horiz_cat $ map (char def_attr) chars ) == l * 2 + +two_dw_vert_concat :: DoubleColumnChar -> DoubleColumnChar -> Bool +two_dw_vert_concat (DoubleColumnChar c1) (DoubleColumnChar c2) = + image_height (char def_attr c1 <-> char def_attr c2) == 2 + +horiz_concat_dw_assoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool +horiz_concat_dw_assoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) = + (char def_attr c0 <|> char def_attr c1) <|> char def_attr c2 + == + char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2) + +vert_contat_single_row :: NonEmptyList SingleRowSingleAttrImage -> Bool +vert_contat_single_row (NonEmpty stack) = + let expected_height :: Word = fromIntegral $ length stack + stack_image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack ] + in image_height stack_image == expected_height + +disjoint_height_horiz_join :: NonEmptyList SingleRowSingleAttrImage + -> NonEmptyList SingleRowSingleAttrImage + -> Bool +disjoint_height_horiz_join (NonEmpty stack_0) (NonEmpty stack_1) = + let expected_height :: Word = fromIntegral $ max (length stack_0) (length stack_1) + stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] + stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] + in image_height (stack_image_0 <|> stack_image_1) == expected_height + + +disjoint_height_horiz_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage + -> NonEmptyList SingleRowSingleAttrImage + -> Bool +disjoint_height_horiz_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) = + let stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] + stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] + image = stack_image_0 <|> stack_image_1 + expected_height = image_height image + in case image of + HorizJoin {} -> ( expected_height == (image_height $ part_left image) ) + && + ( expected_height == (image_height $ part_right image) ) + _ -> True + +disjoint_width_vert_join :: NonEmptyList SingleRowSingleAttrImage + -> NonEmptyList SingleRowSingleAttrImage + -> Bool +disjoint_width_vert_join (NonEmpty stack_0) (NonEmpty stack_1) = + let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images) + stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] + stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] + stack_0_image = vert_cat stack_0_images + stack_1_image = vert_cat stack_1_images + image = stack_0_image <-> stack_1_image + in image_width image == expected_width + +disjoint_width_vert_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage + -> NonEmptyList SingleRowSingleAttrImage + -> Bool +disjoint_width_vert_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) = + let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images) + stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] + stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] + stack_0_image = vert_cat stack_0_images + stack_1_image = vert_cat stack_1_images + image = stack_0_image <-> stack_1_image + in case image of + VertJoin {} -> ( expected_width == (image_width $ part_top image) ) + && + ( expected_width == (image_width $ part_bottom image) ) + _ -> True + +tests :: IO [Test] +tests = return + [ 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 "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 + ] + diff --git a/test/VerifyImageTrans.hs b/test/VerifyImageTrans.hs new file mode 100644 --- /dev/null +++ b/test/VerifyImageTrans.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE NamedFieldPuns #-} +module VerifyImageTrans where + +import Verify.Graphics.Vty.Image + +import Verify + +import Data.Word + +is_horiz_text_of_columns :: Image -> Word -> Bool +is_horiz_text_of_columns (HorizText { output_width = in_w }) expected_w = in_w == expected_w +is_horiz_text_of_columns (BGFill { output_width = in_w }) expected_w = in_w == expected_w +is_horiz_text_of_columns _image _expected_w = False + +verify_horiz_contat_wo_attr_change_simplifies :: SingleRowSingleAttrImage -> Bool +verify_horiz_contat_wo_attr_change_simplifies (SingleRowSingleAttrImage _attr char_count image) = + 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) + 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) + +tests :: IO [Test] +tests = return + [ 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 + ] + diff --git a/test/VerifyInline.hs b/test/VerifyInline.hs new file mode 100644 --- /dev/null +++ b/test/VerifyInline.hs @@ -0,0 +1,23 @@ +module VerifyInline where + +import Graphics.Vty.Inline +import Graphics.Vty.Terminal + +import Verify + +import Distribution.TestSuite + +tests :: IO [Test] +tests = return + [ Test $ TestInstance + { name = "verify vty inline" + , run = do + t <- terminal_handle + put_attr_change t $ default_all + return $ Finished Pass + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + ] + diff --git a/test/VerifyMockTerminal.hs b/test/VerifyMockTerminal.hs new file mode 100644 --- /dev/null +++ b/test/VerifyMockTerminal.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module VerifyMockTerminal 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.Debug + +import Verify + +import qualified Data.ByteString as BS +import Data.IORef +import qualified Data.String.UTF8 as UTF8 + +import System.IO + +unit_image_unit_bounds :: UnitImage -> Property +unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do + t <- terminal_instance (DisplayRegion 1 1) + d <- display_bounds t >>= display_context t + let pic = pic_for_image i + output_picture d pic + return succeeded + +unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property +unit_image_arb_bounds (UnitImage _ i) (DebugWindow 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 + 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 + -- 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 + -- character + ++ 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 { 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 + 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 + -- 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') + expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected + if out_bytes /= 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 +many_T_rows_cropped_width (DebugWindow 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 + -- 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') + expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected + if out_bytes /= 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 +many_T_rows_cropped_height (DebugWindow 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 + -- 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') + expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected + if out_bytes /= expected_bytes + then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes } + else return succeeded + +tests :: IO [Test] +tests = return [ verify "unit_image_unit_bounds" unit_image_unit_bounds + , verify "unit_image_arb_bounds" unit_image_arb_bounds + , verify "single_T_row" single_T_row + , verify "many_T_rows" many_T_rows + , verify "many_T_rows_cropped_width" many_T_rows_cropped_width + , verify "many_T_rows_cropped_height" many_T_rows_cropped_height + ] + diff --git a/test/VerifyParseTerminfoCaps.hs b/test/VerifyParseTerminfoCaps.hs new file mode 100644 --- /dev/null +++ b/test/VerifyParseTerminfoCaps.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-} +module VerifyParseTerminfoCaps where + +import Prelude hiding ( catch ) + +import qualified System.Console.Terminfo as Terminfo + +import Verify.Data.Terminfo.Parse +import Verify + +import Control.Applicative ( (<$>) ) +import Control.Exception ( try, SomeException(..) ) +import Control.Monad ( mapM_, forM, forM_ ) + +import Data.Maybe ( catMaybes, fromJust ) +import Data.Word + +import Numeric + +-- A list of terminals that ubuntu includes a terminfo cap file for. +-- Assuming that is a good place to start. +terminals_of_interest = + [ "wsvt25" + , "wsvt25m" + , "vt52" + , "vt100" + , "vt220" + , "vt102" + , "xterm-r5" + , "xterm-xfree86" + , "xterm-r6" + , "xterm-256color" + , "xterm-vt220" + , "xterm-debian" + , "xterm-mono" + , "xterm-color" + , "xterm" + , "mach" + , "mach-bold" + , "mach-color" + , "linux" + , "ansi" + , "hurd" + , "Eterm" + , "pcansi" + , "screen-256color" + , "screen-bce" + , "screen-s" + , "screen-w" + , "screen" + , "screen-256color-bce" + , "sun" + , "rxvt" + , "rxvt-unicode" + , "rxvt-basic" + , "cygwin" + , "cons25" + , "dumb" + ] + +-- If a terminal defines one of the caps then it's expected to be parsable. +caps_of_interest = + [ "cup" + , "sc" + , "rc" + , "setf" + , "setb" + , "setaf" + , "setab" + , "op" + , "cnorm" + , "civis" + , "smcup" + , "rmcup" + , "clear" + , "hpa" + , "vpa" + , "sgr" + , "sgr0" + ] + +from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name) + +tests :: IO [Test] +tests = do + parse_tests <- concat <$> forM terminals_of_interest ( \term_name -> do + putStrLn $ "testing parsing of caps for terminal: " ++ term_name + mti <- liftIO $ try $ Terminfo.setupTerm term_name + case mti of + Left (_e :: SomeException) + -> return [] + Right ti -> do + concat <$> forM caps_of_interest ( \cap_name -> do + liftIO $ putStrLn $ "\tparsing cap: " ++ cap_name + case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of + Just cap_def -> do + return [ verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def ) + ( verify_parse_cap cap_def $ const (return succeeded) ) ] + Nothing -> do + return [] + ) + ) + -- The quickcheck tests + return $ [ verify "parse_non_paramaterized_caps" non_paramaterized_caps + , verify "parse cap string with literal %" literal_percent_caps + , verify "parse cap string with %i op" inc_first_two_caps + , verify "parse cap string with %pN op" push_param_caps + ] ++ parse_tests + +verify_parse_cap cap_string on_parse = liftIOResult $ do + parse_result <- parse_cap_expression cap_string + case parse_result of + Left error -> return $ failed { reason = "parse error " ++ show error } + Right e -> on_parse e + +non_paramaterized_caps (NonParamCapString cap) = do + verify_parse_cap cap $ \e -> + let expected_count :: Word8 = toEnum $ length cap + expected_bytes = map (toEnum . fromEnum) cap + out_bytes = bytes_for_range e 0 expected_count + in return $ verify_bytes_equal out_bytes expected_bytes + +literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do + verify_parse_cap cap_string $ \e -> + let expected_count :: Word8 = toEnum $ length expected_bytes + out_bytes = collect_bytes e + in return $ verify_bytes_equal out_bytes expected_bytes + +inc_first_two_caps (IncFirstTwoCap cap_string expected_bytes) = do + verify_parse_cap cap_string $ \e -> + let expected_count :: Word8 = toEnum $ length expected_bytes + out_bytes = collect_bytes e + in return $ verify_bytes_equal out_bytes expected_bytes + +push_param_caps (PushParamCap cap_string expected_param_count expected_bytes) = do + verify_parse_cap cap_string $ \e -> + let expected_count :: Word8 = toEnum $ length expected_bytes + out_bytes = collect_bytes e + 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 { 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 -> + let expected_count :: Word8 = toEnum $ length expected_bytes + out_bytes = collect_bytes e + 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 { reason = "out param count /= expected param count" } + +print_cap ti cap_name = do + putStrLn $ cap_name ++ ": " ++ show (from_capname ti cap_name) + +print_expression ti cap_name = do + parse_result <- parse_cap_expression $ from_capname ti cap_name + putStrLn $ cap_name ++ ": " ++ show parse_result + diff --git a/test/VerifyPictureOps.hs b/test/VerifyPictureOps.hs new file mode 100644 --- /dev/null +++ b/test/VerifyPictureOps.hs @@ -0,0 +1,8 @@ +module VerifyPictureOps where + +import Graphics.Vty.Picture ( translate ) + +import Verify + +tests :: IO [Test] +tests = return [] diff --git a/test/VerifyPictureToSpan.hs b/test/VerifyPictureToSpan.hs new file mode 100644 --- /dev/null +++ b/test/VerifyPictureToSpan.hs @@ -0,0 +1,10 @@ +module VerifyPictureToSpan where + +import Graphics.Vty.Picture +import Graphics.Vty.Span +import Graphics.Vty.PictureToSpans + +import Verify + +tests :: IO [Test] +tests = return [] diff --git a/test/VerifySpanOps.hs b/test/VerifySpanOps.hs new file mode 100644 --- /dev/null +++ b/test/VerifySpanOps.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +module VerifySpanOps where + +import Verify.Graphics.Vty.Picture +import Verify.Graphics.Vty.Image +import Verify.Graphics.Vty.Span +import Verify.Graphics.Vty.DisplayRegion + +import Graphics.Vty.Debug + +import Verify + +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) = + let p = pic_for_image i + spans = spans_for_pic p (region_for_window w) + in span_ops_columns spans == 0 && span_ops_rows spans == 0 + +unit_image_and_zero_window_1 :: UnitImage -> EmptyWindow -> Bool +unit_image_and_zero_window_1 (UnitImage _ i) (EmptyWindow w) = + let p = pic_for_image i + spans = spans_for_pic p (region_for_window w) + in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 ) + +horiz_span_image_and_zero_window_0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool +horiz_span_image_and_zero_window_0 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) = + let p = pic_for_image i + spans = spans_for_pic p (region_for_window w) + in span_ops_columns spans == 0 && span_ops_rows spans == 0 + +horiz_span_image_and_zero_window_1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool +horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) = + let p = pic_for_image i + spans = spans_for_pic p (region_for_window w) + in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 ) + +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 + 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 + spans = spans_for_pic p (region_for_window w) + in span_ops_effected_rows spans == 1 + +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 + 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) + spans = spans_for_pic p (region_for_window w) + in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2) + +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 + spans = spans_for_pic p (region_for_window w) + actual_row_count = span_ops_effected_rows spans + in expected_row_count == actual_row_count + +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)) + 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 + 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 + in expected_row_count == actual_row_count + +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)) + 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 + +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) + spans = spans_for_pic p (region_for_window w) + expected_row_count = stack_height stack_0 + actual_row_count = span_ops_effected_rows spans + in expected_row_count == actual_row_count + +horiz_span_image_and_greater_window_0 :: SingleRowSingleAttrImage -> Result +horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) = + let p = pic_for_image i + -- SingleRowSingleAttrImage always has width >= 1 + greater_width = c * 2 + w = DebugWindow 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) = + 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 ) + +span_ops_actually_fill_rows :: DefaultPic -> Bool +span_ops_actually_fill_rows (DefaultPic pic win _) = + let spans = spans_for_pic pic (region_for_window win) + expected_row_count = region_height (region_for_window win) + actual_row_count = span_ops_effected_rows spans + in expected_row_count == actual_row_count + +span_ops_actually_fill_columns :: DefaultPic -> Bool +span_ops_actually_fill_columns (DefaultPic pic win _) = + let spans = spans_for_pic pic (region_for_window win) + expected_column_count = region_width (region_for_window win) + in all_spans_have_width spans expected_column_count + +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 . Vector.head ) ( Vector.toList $ display_ops spans ) + +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) + spans = spans_for_pic p (region_for_window w) + in verify_all_spans_have_width (stack_image stack) spans (stack_width stack) + +tests :: IO [Test] +tests = return + [ 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]" + single_attr_single_span_stack_cropped_0 + , 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]" + single_attr_single_span_stack_cropped_2 + , 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]" + single_attr_single_span_stack_cropped_4 + , verify "single attr text span <-> single attr text span cropped. [height]" + single_attr_single_span_stack_cropped_5 + ] + diff --git a/test/VerifyUtf8Width.hs b/test/VerifyUtf8Width.hs new file mode 100644 --- /dev/null +++ b/test/VerifyUtf8Width.hs @@ -0,0 +1,18 @@ +module VerifyUtf8Width where +import Verify + +import Graphics.Vty.Attributes +import Graphics.Vty.Picture + +sw_is_1_column :: SingleColumnChar -> Bool +sw_is_1_column (SingleColumnChar c) = image_width (char def_attr c) == 1 + +dw_is_2_column :: DoubleColumnChar -> Bool +dw_is_2_column (DoubleColumnChar c) = image_width (char def_attr c) == 2 + +tests :: IO [Test] +tests = return + [ verify "sw_is_1_column" sw_is_1_column + , verify "dw_is_2_column" dw_is_2_column + ] + diff --git a/test/interactive_terminal_test.hs b/test/interactive_terminal_test.hs deleted file mode 100644 --- a/test/interactive_terminal_test.hs +++ /dev/null @@ -1,926 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Main where - -import Graphics.Vty.Attributes -import Graphics.Vty.Inline -import Graphics.Vty.Picture -import Graphics.Vty.Terminal -import Graphics.Vty.DisplayRegion - -import Control.Monad - -import Data.List ( lookup ) -import Data.Maybe ( isJust, fromJust ) -import Data.Monoid -import Data.String.QQ -import Data.Word - -import Foreign.Marshal.Array - -import qualified System.Environment as Env - -import System.IO ( hFlush, hPutStr, hPutBuf, stdout ) - -main = do - print_intro - -output_file_path = "test_results.list" - -print_intro = do - 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 ++ [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. - -Each test follows, more or less, the following format: - 0. A description of the test is printed which will include a detailed - description of what VTY is going to try and what the expected results are. - Press return to move on. - 1. The program will produce some output or ask for you to press a key. - 2. You will then be asked to confirm if the behavior matched the provided - description. Just pressing enter implies the default response that - everything was as expected. - -All the tests assume the following about the terminal display: - 0. The terminal display will not be resized during a test and is at least 80 - characters in width. - 1. The terminal display is using a monospaced font for both single width and - double width characters. - 2. A double width character is displayed with exactly twice the width of a - single column character. This may require adjusting the font used by the - terminal. At least, that is the case using xterm. - 3. Fonts are installed, and usable by the terminal, that define glyphs for - a good range of the unicode characters. Each test involving unicode display - describes the expected appearance of each glyph. - -Thanks for the help! :-D -To exit the test early enter "q" anytime at the following menu screen. Even if -you exit the test early please email the test_results.list file to -coreyoconnor@gmail.com. The results file will still contain information useful -to debug terminal support. - -|] - wait_for_return - results <- do_test_menu 1 - env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name ) - ( const $ return (env_name, "") ) - ) - [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ] - t <- terminal_handle - let results_txt = show env_attributes ++ "\n" - ++ terminal_ID t ++ "\n" - ++ show results ++ "\n" - release_terminal t - writeFile output_file_path results_txt - -wait_for_return = do - putStr "\n(press return to continue)" - hFlush stdout - getLine - -test_menu :: [(String, Test)] -test_menu = zip (map show [1..]) all_tests - -do_test_menu :: Int -> IO [(String, Bool)] -do_test_menu next_ID - | next_ID > length all_tests = do - putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com" - return [] - | otherwise = do - display_test_menu - putStrLn $ "Press return to start with #" ++ show next_ID ++ "." - putStrLn "Enter a test number to perform only that test." - putStrLn "q (or control-C) to quit." - putStr "> " - hFlush stdout - s <- getLine >>= return . filter (/= '\n') - case s of - "q" -> return mempty - "" -> do - r <- run_test $ show next_ID - rs <- do_test_menu ( next_ID + 1 ) - return $ r : rs - i | isJust ( lookup i test_menu ) -> do - r <- run_test i - rs <- do_test_menu ( read i + 1 ) - return $ r : rs - where - display_test_menu - = mapM_ display_test_menu' test_menu - display_test_menu' ( i, t ) - = putStrLn $ ( if i == show next_ID - then "> " - else " " - ) ++ i ++ ". " ++ test_name t - -run_test :: String -> IO (String, Bool) -run_test i = do - let t = fromJust $ lookup i test_menu - print_summary t - wait_for_return - test_action t - r <- confirm_results t - return (test_ID t, r) - -default_success_confirm_results = do - putStr "\n" - putStr "[Y/n] " - hFlush stdout - r <- getLine - case r of - "" -> return True - "y" -> return True - "Y" -> return True - "n" -> return False - -data Test = Test - { test_name :: String - , test_ID :: String - , test_action :: IO () - , print_summary :: IO () - , confirm_results :: IO Bool - } - -all_tests - = [ reserve_output_test - , display_bounds_test_0 - , display_bounds_test_1 - , display_bounds_test_2 - , display_bounds_test_3 - , unicode_single_width_0 - , unicode_single_width_1 - , unicode_double_width_0 - , unicode_double_width_1 - , attributes_test_0 - , attributes_test_1 - , attributes_test_2 - , attributes_test_3 - , attributes_test_4 - , attributes_test_5 - , inline_test_0 - , inline_test_1 - , inline_test_2 - ] - -reserve_output_test = Test - { test_name = "Initialize and reserve terminal output then restore previous state." - , test_ID = "reserve_output_test" - , test_action = do - t <- terminal_handle - reserve_display t - putStrLn "Line 1" - putStrLn "Line 2" - putStrLn "Line 3" - putStrLn "Line 4 (press return)" - hFlush stdout - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. Four lines of text should be visible. - 1. The cursor should be visible and at the start of the fifth line. - -After return is pressed for the second time this test then: - * The screen containing the test summary should be restored; - * The cursor is visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -display_bounds_test_0 = Test - { test_name = "Verify display bounds are correct test 0: Using spaces." - , test_ID = "display_bounds_test_0" - , test_action = do - t <- terminal_handle - reserve_display t - DisplayRegion w h <- display_bounds t - let row_0 = replicate (fromEnum w) 'X' ++ "\n" - row_h = replicate (fromEnum w - 1) 'X' - row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n" - image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h - putStr image - hFlush stdout - getLine - release_display t - release_terminal t - return () - , print_summary = display_bounds_test_summary True - , confirm_results = generic_output_match_confirm - } - -display_bounds_test_1 = Test - { test_name = "Verify display bounds are correct test 0: Using cursor movement." - , test_ID = "display_bounds_test_1" - , test_action = do - t <- terminal_handle - reserve_display t - DisplayRegion w h <- display_bounds t - set_cursor_pos t 0 0 - let row_0 = replicate (fromEnum w) 'X' ++ "\n" - putStr row_0 - forM_ [1 .. h - 2] $ \y -> do - set_cursor_pos t 0 y - putStr "X" - hFlush stdout - set_cursor_pos t (w - 1) y - putStr "X" - hFlush stdout - set_cursor_pos t 0 (h - 1) - let row_h = replicate (fromEnum w - 1) 'X' - putStr row_h - hFlush stdout - getLine - release_display t - release_terminal t - return () - , print_summary = display_bounds_test_summary True - , confirm_results = generic_output_match_confirm - } - -display_bounds_test_2 = Test - { test_name = "Verify display bounds are correct test 0: Using Image ops." - , test_ID = "display_bounds_test_2" - , test_action = do - t <- terminal_handle - reserve_display t - bounds@(DisplayRegion w h) <- display_bounds t - let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X') - middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row - middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X') - end_row = first_row - image = first_row <-> middle_rows <-> end_row - pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) } - d <- display_context t bounds - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = display_bounds_test_summary True - , confirm_results = generic_output_match_confirm - } - -display_bounds_test_3 = Test - { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos." - , test_ID = "display_bounds_test_3" - , test_action = do - t <- terminal_handle - reserve_display t - DisplayRegion w h <- display_bounds t - hide_cursor t - set_cursor_pos t 0 0 - let row_0 = replicate (fromEnum w) 'X' - putStrLn row_0 - forM_ [1 .. h - 2] $ \y -> do - set_cursor_pos t 0 y - putStr "X" - hFlush stdout - set_cursor_pos t (w - 1) y - putStr "X" - hFlush stdout - set_cursor_pos t 0 (h - 1) - let row_h = row_0 - putStr row_h - hFlush stdout - getLine - show_cursor t - release_display t - release_terminal t - return () - , print_summary = display_bounds_test_summary False - , confirm_results = generic_output_match_confirm - } - -display_bounds_test_summary has_cursor = do - 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 [s| - 2. The border of the display will be outlined in Xs. - So if - and | represented the edge of the terminal window: - |-------------| - |XXXXXXXXXXXXX| - |X X||] - - if has_cursor - then putStr $ [s| - |XXXXXXXXXXXXC| |] - else putStr $ [s| - |XXXXXXXXXXXXX| |] - - putStr $ [s| - |-------------| - - ( Where C is the final position of the cursor. There may be an X drawn - under the cursor. ) - 3. The display will remain in this state until return is pressed again. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - -generic_output_match_confirm = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - --- Explicitely definethe bytes that encode each example text. --- This avoids any issues with how the compiler represents string literals. --- --- This document is UTF-8 encoded so the UTF-8 string is still included for --- reference --- --- It's assumed the compiler will at least not barf on UTF-8 encoded text in --- comments ;-) --- --- txt_0 = ↑↑↓↓←→←→BA - -utf8_txt_0 :: [[Word8]] -utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ] - , [ 0xe2 , 0x86 , 0x91 ] - , [ 0xe2 , 0x86 , 0x93 ] - , [ 0xe2 , 0x86 , 0x93 ] - , [ 0xe2 , 0x86 , 0x90 ] - , [ 0xe2 , 0x86 , 0x92 ] - , [ 0xe2 , 0x86 , 0x90 ] - , [ 0xe2 , 0x86 , 0x92 ] - , [ 0x42 ] - , [ 0x41 ] - ] - -iso_10646_txt_0 :: String -iso_10646_txt_0 = map toEnum - [ 8593 - , 8593 - , 8595 - , 8595 - , 8592 - , 8594 - , 8592 - , 8594 - , 66 - , 65 - ] - -unicode_single_width_0 = Test - { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)" - , test_ID = "unicode_single_width_0" - , test_action = do - t <- terminal_handle - reserve_display t - hide_cursor t - withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout) - hPutStr stdout "\n" - hPutStr stdout "0123456789\n" - hFlush stdout - getLine - release_display t - release_terminal t - return () - , print_summary = unicode_single_width_summary - , confirm_results = generic_output_match_confirm - } - -unicode_single_width_1 = Test - { test_name = "Verify terminal can display unicode single-width characters. (Image ops)" - , test_ID = "unicode_single_width_1" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = line_0 <-> line_1 - line_0 = iso_10646_string def_attr iso_10646_txt_0 - line_1 = string def_attr "0123456789" - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = unicode_single_width_summary - , confirm_results = generic_output_match_confirm - } - -unicode_single_width_summary = putStr [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. Two horizontal lines of text will be displayed: - a. The first will be a sequence of glyphs in UTF-8 encoding. Each glyph - will occupy one column of space. The order and appearance of the glyphs - will be: - | column | appearance | - ========================== - | 0 | up arrow | - | 1 | up arrow | - | 2 | down arrow | - | 3 | down arrow | - | 4 | left arrow | - | 5 | right arrow | - | 6 | left arrow | - | 7 | right arrow | - | 8 | B | - | 9 | A | - ( see: http://en.wikipedia.org/wiki/Arrow_(symbol) ) - b. The second will be: 0123456789. - -Verify: - * The far right extent of the glyphs on both lines are equal; - * The glyphs are as described. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - --- The second example is a unicode string containing double-width glyphs --- 你好吗 -utf8_txt_1 :: [[Word8]] -utf8_txt_1 = [ [0xe4,0xbd,0xa0] - , [0xe5,0xa5,0xbd] - , [0xe5,0x90,0x97] - ] - -iso_10646_txt_1 :: String -iso_10646_txt_1 = map toEnum [20320,22909,21527] - -unicode_double_width_0 = Test - { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)" - , test_ID = "unicode_double_width_0" - , test_action = do - t <- terminal_handle - reserve_display t - hide_cursor t - withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout) - hPutStr stdout "\n" - hPutStr stdout "012345\n" - hFlush stdout - getLine - release_display t - release_terminal t - return () - , print_summary = unicode_double_width_summary - , confirm_results = generic_output_match_confirm - } - -unicode_double_width_1 = Test - { test_name = "Verify terminal can display unicode double-width characters. (Image ops)" - , test_ID = "unicode_double_width_1" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = line_0 <-> line_1 - line_0 = iso_10646_string def_attr iso_10646_txt_1 - line_1 = string def_attr "012345" - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = unicode_double_width_summary - , confirm_results = generic_output_match_confirm - } - -unicode_double_width_summary = putStr [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. Two horizontal lines of text will be displayed: - a. The first will be a sequence of glyphs in UTF-8 encoding. Each glyph - will occupy two columns of space. The order and appearance of the glyphs - will be: - | column | appearance | - ====================================== - | 0 | first half of ni3 | - | 1 | second half of ni3 | - | 2 | first half of hao3 | - | 3 | second half of hao3 | - | 4 | first half of ma | - | 5 | second half of ma | - b. The second will be: 012345. - -Verify: - * The far right extent of the glyphs on both lines are equal; - * The glyphs are as described. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - -all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ] - [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ] - -all_bright_colors - = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ] - [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ] - -attributes_test_0 = Test - { test_name = "Character attributes: foreground colors." - , test_ID = "attributes_test_0" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = border <|> column_0 <|> border <|> column_1 <|> border - column_0 = vert_cat $ map line_with_color all_colors - border = vert_cat $ replicate (length all_colors) $ string def_attr " | " - column_1 = vert_cat $ map (string def_attr . snd) all_colors - line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. 9 lines of text in two columns will be drawn. The first column will be a - name of a standard color (for an 8 color terminal) rendered in that color. - For instance, one line will be the word "magenta" and that word should be - rendered in the magenta color. The second column will be the name of a - standard color rendered with the default attributes. - -Verify: - * In the first column: The foreground color matches the named color. - * The second column: All text is rendered with the default attributes. - * The vertical bars used in each line to mark the border of a column are - lined up. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -attributes_test_1 = Test - { test_name = "Character attributes: background colors." - , test_ID = "attributes_test_1" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = border <|> column_0 <|> border <|> column_1 <|> border - column_0 = vert_cat $ map line_with_color all_colors - border = vert_cat $ replicate (length all_colors) $ string def_attr " | " - column_1 = vert_cat $ map (string def_attr . snd) all_colors - line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. 9 lines of text in two columns will be drawn. The first column will - contain be a name of a standard color for an 8 color terminal rendered with - the default foreground color with a background the named color. For - instance, one line will contain be the word "magenta" and the word should - be rendered in the default foreground color over a magenta background. The - second column will be the name of a standard color rendered with the default - attributes. - -Verify: - * The first column: The background color matches the named color. - * The second column: All text is rendered with the default attributes. - * The vertical bars used in each line to mark the border of a column are - lined up. - -Note: I haven't decided if, in this case, the background color should extend to -fills added for alignment. Right now the selected background color is only -applied to the background where the word is actually rendered. Since each word -is not of the same length VTY adds background fills to make the width of each -row effectively the same. These added fills are all currently rendered with the -default background pattern. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -attributes_test_2 = Test - { test_name = "Character attributes: Vivid foreground colors." - , test_ID = "attributes_test_2" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = horiz_cat [border, column_0, border, column_1, border, column_2, border] - border = vert_cat $ replicate (length all_colors) $ string def_attr " | " - column_0 = vert_cat $ map line_with_color_0 all_colors - column_1 = vert_cat $ map line_with_color_1 all_bright_colors - column_2 = vert_cat $ map (string def_attr . snd) all_colors - line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name - line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. 9 lines of text in three columns will be drawn: - a. The first column will be a name of a standard color (for an 8 color - terminal) rendered with that color as the foreground color. - b. The next column will be also be the name of a standard color rendered - with that color as the foreground color but the shade used should be - more vivid than the shade used in the first column. - c. The final column will be the name of a color rendered with the - default attributes. - -For instance, one line will be the word "magenta" and that word should be -rendered in the magenta color. - -I'm not actually sure exactly what "vivid" means in this context. For xterm the -vivid colors are brighter. - -Verify: - * The first column: The foreground color matches the named color. - * The second column: The foreground color matches the named color but is - more vivid than the color used in the first column. - * The third column: All text is rendered with the default attributes. - * The vertical bars used in each line to mark the border of a column are - lined up. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -attributes_test_3 = Test - { test_name = "Character attributes: Vivid background colors." - , test_ID = "attributes_test_3" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = horiz_cat [border, column_0, border, column_1, border, column_2, border] - border = vert_cat $ replicate (length all_colors) $ string def_attr " | " - column_0 = vert_cat $ map line_with_color_0 all_colors - column_1 = vert_cat $ map line_with_color_1 all_bright_colors - column_2 = vert_cat $ map (string def_attr . snd) all_colors - line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name - line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. 9 lines of text in three columns will be drawn: - a. The first column will contain be a name of a standard color for an 8 - color terminal rendered with the default foreground color with a - background the named color. - b. The first column will contain be a name of a standard color for an 8 - color terminal rendered with the default foreground color with the - background a vivid version of the named color. - c. The third column will be the name of a standard color rendered with - the default attributes. - -For instance, one line will contain be the word "magenta" and the word should -be rendered in the default foreground color over a magenta background. - -I'm not actually sure exactly what "vivid" means in this context. For xterm the -vivid colors are brighter. - -Verify: - * The first column: The background color matches the named color. - * The second column: The background color matches the named color and is - more vivid than the color used in the first column. - * The third column column: All text is rendered with the default attributes. - * The vertical bars used in each line to mark the border of a column are - lined up. - -Note: I haven't decided if, in this case, the background color should extend to -fills added for alignment. Right now the selected background color is only -applied to the background where the word is actually rendered. Since each word -is not of the same length VTY adds background fills to make the width of each -row effectively the same. These added fills are all currently rendered with the -default background pattern. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -attr_combos = - [ ( "default", id ) - , ( "bold", flip with_style bold ) - , ( "blink", flip with_style blink ) - , ( "underline", flip with_style underline ) - , ( "bold + blink", flip with_style (bold + blink) ) - , ( "bold + underline", flip with_style (bold + underline) ) - , ( "underline + blink", flip with_style (underline + blink) ) - , ( "bold + blink + underline", flip with_style (bold + blink + underline) ) - ] - -attributes_test_4 = Test - { test_name = "Character attributes: Bold; Blink; Underline." - , test_ID = "attributes_test_4" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = horiz_cat [border, column_0, border, column_1, border] - border = vert_cat $ replicate (length attr_combos) $ string def_attr " | " - column_0 = vert_cat $ map line_with_attrs attr_combos - column_1 = vert_cat $ map (string def_attr . fst) attr_combos - line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. 8 rows of text in two columns. - The rows will contain the following text: - default - bold - blink - underline - bold + blink - bold + underline - underline + blink - bold + blink + underline - The first column will be rendered with the described attributes. The second - column will be rendered with the default attributes. - -Verify: - * The vertical bars used in each line to mark the border of a column are - lined up. - * The text in the first column is rendered as described. - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -attributes_test_5 = Test - { test_name = "Character attributes: 240 color palette" - , test_ID = "attributes_test_5" - , test_action = do - t <- terminal_handle - reserve_display t - let pic = pic_for_image image - image = vert_cat $ map horiz_cat $ split_color_images color_images - color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239] - split_color_images [] = [] - split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is)) - d <- display_bounds t >>= display_context t - output_picture d pic - getLine - release_display t - release_terminal t - return () - , print_summary = do - putStr $ [s| -Once return is pressed: - 0. The screen will be cleared. - 1. The cursor will be hidden. - 2. A 20 character wide and 12 row high block of color squares. This should look like a palette - of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it... - -Verify: - -After return is pressed for the second time: - 0. The screen containing the test summary should be restored. - 1. The cursor should be visible. -|] - , confirm_results = do - putStr $ [s| -Did the test output match the description? -|] - default_success_confirm_results - } - -inline_test_0 = Test - { test_name = "Verify styled output can be performed without clearing the screen." - , test_ID = "inline_test_0" - , test_action = do - t <- terminal_handle - putStrLn "line 1." - put_attr_change t $ back_color red >> apply_style underline - putStrLn "line 2." - put_attr_change t $ default_all - putStrLn "line 3." - release_terminal t - return () - , 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. -|] - - , confirm_results = generic_output_match_confirm - } - -inline_test_1 = Test - { test_name = "Verify styled output can be performed without clearing the screen." - , test_ID = "inline_test_1" - , test_action = do - t <- terminal_handle - putStr "Not styled. " - put_attr_change t $ back_color red >> apply_style underline - putStr " Styled! " - put_attr_change t $ default_all - putStrLn "Not styled." - release_terminal t - return () - , print_summary = putStr $ [s| -|] - - , confirm_results = generic_output_match_confirm - } - -inline_test_2 = Test - { test_name = "Verify styled output can be performed without clearing the screen." - , test_ID = "inline_test_1" - , test_action = do - t <- terminal_handle - putStr "Not styled. " - put_attr_change t $ back_color red >> apply_style underline - putStr " Styled! " - put_attr_change t $ default_all - putStr "Not styled.\n" - release_terminal t - return () - , print_summary = putStr $ [s| -|] - - , confirm_results = generic_output_match_confirm - } - diff --git a/test/verify_attribute_ops.hs b/test/verify_attribute_ops.hs deleted file mode 100644 --- a/test/verify_attribute_ops.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main where - -import Verify.Graphics.Vty.Attributes - -import Verify - -main = run_test $ do - return () diff --git a/test/verify_debug_terminal.hs b/test/verify_debug_terminal.hs deleted file mode 100644 --- a/test/verify_debug_terminal.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Main 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.Debug - -import Verify - -import qualified Data.ByteString as BS -import Data.IORef -import qualified Data.String.UTF8 as UTF8 - -import System.IO - -unit_image_unit_bounds :: UnitImage -> Property -unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do - t <- terminal_instance (DisplayRegion 1 1) - d <- display_bounds t >>= display_context t - let pic = pic_for_image i - output_picture d pic - return succeeded - -unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property -unit_image_arb_bounds (UnitImage _ i) (DebugWindow 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 - 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 - -- 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 - -- character - ++ 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 { 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 - 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 - -- 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') - expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected - if out_bytes /= 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 -many_T_rows_cropped_width (DebugWindow 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 - -- 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') - expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected - if out_bytes /= 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 -many_T_rows_cropped_height (DebugWindow 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 - -- 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') - expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected - if out_bytes /= expected_bytes - then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes } - else return succeeded - -main = run_test $ do - verify "unit_image_unit_bounds" unit_image_unit_bounds - verify "unit_image_arb_bounds" unit_image_arb_bounds - verify "single_T_row" single_T_row - verify "many_T_rows" many_T_rows - verify "many_T_rows_cropped_width" many_T_rows_cropped_width - verify "many_T_rows_cropped_height" many_T_rows_cropped_height - return () - diff --git a/test/verify_display_attributes.hs b/test/verify_display_attributes.hs deleted file mode 100644 --- a/test/verify_display_attributes.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Main where - -import Verify.Graphics.Vty.DisplayAttributes -import Verify.Graphics.Vty.Attributes - -import Verify - -main = run_test $ do - return () diff --git a/test/verify_empty_image_props.hs b/test/verify_empty_image_props.hs deleted file mode 100644 --- a/test/verify_empty_image_props.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Main where - -import Verify - --- should be exported by Graphics.Vty.Picture -import Graphics.Vty.Picture ( Image, empty_image ) - -main = run_test $ do - -- should provide an image type. - let _ :: Image = empty_image - return () - diff --git a/test/verify_eval_terminfo_caps.hs b/test/verify_eval_terminfo_caps.hs deleted file mode 100644 --- a/test/verify_eval_terminfo_caps.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE NamedFieldPuns #-} -module Main where - -import Data.Marshalling - -import Data.Terminfo.Eval -import Data.Terminfo.Parse -import Control.DeepSeq - -import qualified System.Console.Terminfo as Terminfo - -import Verify - -import Control.Exception ( try, SomeException(..) ) - -import Control.Monad ( mapM_, forM_ ) - -import Data.Array.Unboxed -import Data.Maybe ( fromJust ) -import Data.Word - -import Numeric - --- A list of terminals that ubuntu includes a terminfo cap file for. --- Assuming that is a good place to start. -terminals_of_interest = - [ "wsvt25" - , "wsvt25m" - , "vt52" - , "vt100" - , "vt220" - , "vt102" - , "xterm-r5" - , "xterm-xfree86" - , "xterm-r6" - , "xterm-256color" - , "xterm-vt220" - , "xterm-debian" - , "xterm-mono" - , "xterm-color" - , "xterm" - , "mach" - , "mach-bold" - , "mach-color" - , "linux" - , "ansi" - , "hurd" - , "Eterm" - , "pcansi" - , "screen-256color" - , "screen-bce" - , "screen-s" - , "screen-w" - , "screen" - , "screen-256color-bce" - , "sun" - , "rxvt" - , "rxvt-unicode" - , "rxvt-basic" - , "cygwin" - , "cons25" - , "dumb" - ] - --- If a terminal defines one of the caps then it's expected to be parsable. -caps_of_interest = - [ "cup" - , "sc" - , "rc" - , "setf" - , "setb" - , "setaf" - , "setab" - , "op" - , "cnorm" - , "civis" - , "smcup" - , "rmcup" - , "clear" - , "hpa" - , "vpa" - , "sgr" - , "sgr0" - ] - -from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name) - -main = do - run_test $ do - eval_buffer :: Ptr Word8 <- liftIO $ mallocBytes (1024 * 1024) -- Should be big enough for all termcaps ;-) - forM_ terminals_of_interest $ \term_name -> do - liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name - mti <- liftIO $ try $ Terminfo.setupTerm term_name - case mti of - Left (_e :: SomeException) - -> return () - Right ti -> do - forM_ caps_of_interest $ \cap_name -> do - liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name - case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of - Just cap_def -> do - 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 ( failed { reason = "prase error " ++ show error } ) - Right !cap_expr -> verify test_name ( verify_eval_cap eval_buffer cap_expr ) - return () - Nothing -> do - return () - return () - return () - -{-# NOINLINE verify_eval_cap #-} -verify_eval_cap :: Ptr Word8 -> CapExpression -> Int -> Property -verify_eval_cap eval_buffer expr !junk_int = do - forAll (vector 9) $ \input_values -> - let !byte_count = cap_expression_required_bytes expr input_values - in liftIOResult $ do - let start_ptr :: Ptr Word8 = eval_buffer - forM_ [0..100] $ \i -> serialize_cap_expression expr input_values start_ptr - end_ptr <- serialize_cap_expression expr input_values start_ptr - case end_ptr `minusPtr` start_ptr of - count | count < 0 -> - return $ failed { reason = "End pointer before start pointer." } - | toEnum count > byte_count -> - return $ failed { reason = "End pointer past end of buffer by " - ++ show (toEnum count - byte_count) - } - | otherwise -> - return succeeded - diff --git a/test/verify_image_ops.hs b/test/verify_image_ops.hs deleted file mode 100644 --- a/test/verify_image_ops.hs +++ /dev/null @@ -1,124 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Main where -import Graphics.Vty.Attributes -import Verify.Graphics.Vty.Image - -import Verify - -import Data.Word - -two_sw_horiz_concat :: SingleColumnChar -> SingleColumnChar -> Bool -two_sw_horiz_concat (SingleColumnChar c1) (SingleColumnChar c2) = - image_width (char def_attr c1 <|> char def_attr c2) == 2 - -many_sw_horiz_concat :: [SingleColumnChar] -> Bool -many_sw_horiz_concat cs = - let chars = [ char | SingleColumnChar char <- cs ] - l = fromIntegral $ length cs - in image_width ( horiz_cat $ map (char def_attr) chars ) == l - -two_sw_vert_concat :: SingleColumnChar -> SingleColumnChar -> Bool -two_sw_vert_concat (SingleColumnChar c1) (SingleColumnChar c2) = - image_height (char def_attr c1 <-> char def_attr c2) == 2 - -horiz_concat_sw_assoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool -horiz_concat_sw_assoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) = - (char def_attr c0 <|> char def_attr c1) <|> char def_attr c2 - == - char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2) - -two_dw_horiz_concat :: DoubleColumnChar -> DoubleColumnChar -> Bool -two_dw_horiz_concat (DoubleColumnChar c1) (DoubleColumnChar c2) = - image_width (char def_attr c1 <|> char def_attr c2) == 4 - -many_dw_horiz_concat :: [DoubleColumnChar] -> Bool -many_dw_horiz_concat cs = - let chars = [ char | DoubleColumnChar char <- cs ] - l = fromIntegral $ length cs - in image_width ( horiz_cat $ map (char def_attr) chars ) == l * 2 - -two_dw_vert_concat :: DoubleColumnChar -> DoubleColumnChar -> Bool -two_dw_vert_concat (DoubleColumnChar c1) (DoubleColumnChar c2) = - image_height (char def_attr c1 <-> char def_attr c2) == 2 - -horiz_concat_dw_assoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool -horiz_concat_dw_assoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) = - (char def_attr c0 <|> char def_attr c1) <|> char def_attr c2 - == - char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2) - -vert_contat_single_row :: NonEmptyList SingleRowSingleAttrImage -> Bool -vert_contat_single_row (NonEmpty stack) = - let expected_height :: Word = fromIntegral $ length stack - stack_image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack ] - in image_height stack_image == expected_height - -disjoint_height_horiz_join :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage - -> Bool -disjoint_height_horiz_join (NonEmpty stack_0) (NonEmpty stack_1) = - let expected_height :: Word = fromIntegral $ max (length stack_0) (length stack_1) - stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] - stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] - in image_height (stack_image_0 <|> stack_image_1) == expected_height - - -disjoint_height_horiz_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage - -> Bool -disjoint_height_horiz_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) = - let stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] - stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] - image = stack_image_0 <|> stack_image_1 - expected_height = image_height image - in case image of - HorizJoin {} -> ( expected_height == (image_height $ part_left image) ) - && - ( expected_height == (image_height $ part_right image) ) - _ -> True - -disjoint_width_vert_join :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage - -> Bool -disjoint_width_vert_join (NonEmpty stack_0) (NonEmpty stack_1) = - let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images) - stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] - stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] - stack_0_image = vert_cat stack_0_images - stack_1_image = vert_cat stack_1_images - image = stack_0_image <-> stack_1_image - in image_width image == expected_width - -disjoint_width_vert_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage - -> Bool -disjoint_width_vert_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) = - let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images) - stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ] - stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ] - stack_0_image = vert_cat stack_0_images - stack_1_image = vert_cat stack_1_images - image = stack_0_image <-> stack_1_image - in case image of - VertJoin {} -> ( expected_width == (image_width $ part_top image) ) - && - ( expected_width == (image_width $ part_bottom image) ) - _ -> 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 - 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 - return () - diff --git a/test/verify_image_trans.hs b/test/verify_image_trans.hs deleted file mode 100644 --- a/test/verify_image_trans.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} -module Main where - -import Verify.Graphics.Vty.Image - -import Verify - -import Data.Word - -is_horiz_text_of_columns :: Image -> Word -> Bool -is_horiz_text_of_columns (HorizText { output_width = in_w }) expected_w = in_w == expected_w -is_horiz_text_of_columns (BGFill { output_width = in_w }) expected_w = in_w == expected_w -is_horiz_text_of_columns _image _expected_w = False - -verify_horiz_contat_wo_attr_change_simplifies :: SingleRowSingleAttrImage -> Bool -verify_horiz_contat_wo_attr_change_simplifies (SingleRowSingleAttrImage _attr char_count image) = - 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) - 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 - return () diff --git a/test/verify_inline.hs b/test/verify_inline.hs deleted file mode 100644 --- a/test/verify_inline.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Main where - -import Graphics.Vty.Inline -import Graphics.Vty.Terminal - -import Verify - -main = run_test $ do - t <- terminal_handle - put_attr_change t $ default_all - return () diff --git a/test/verify_parse_terminfo_caps.hs b/test/verify_parse_terminfo_caps.hs deleted file mode 100644 --- a/test/verify_parse_terminfo_caps.hs +++ /dev/null @@ -1,160 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE NamedFieldPuns #-} -module Main where - -import Prelude hiding ( catch ) - -import qualified System.Console.Terminfo as Terminfo - -import Verify.Data.Terminfo.Parse -import Verify - -import Control.Exception ( try, SomeException(..) ) -import Control.Monad ( mapM_, forM_ ) - -import Data.Array.Unboxed -import Data.Maybe ( fromJust ) -import Data.Word - -import Numeric - --- A list of terminals that ubuntu includes a terminfo cap file for. --- Assuming that is a good place to start. -terminals_of_interest = - [ "wsvt25" - , "wsvt25m" - , "vt52" - , "vt100" - , "vt220" - , "vt102" - , "xterm-r5" - , "xterm-xfree86" - , "xterm-r6" - , "xterm-256color" - , "xterm-vt220" - , "xterm-debian" - , "xterm-mono" - , "xterm-color" - , "xterm" - , "mach" - , "mach-bold" - , "mach-color" - , "linux" - , "ansi" - , "hurd" - , "Eterm" - , "pcansi" - , "screen-256color" - , "screen-bce" - , "screen-s" - , "screen-w" - , "screen" - , "screen-256color-bce" - , "sun" - , "rxvt" - , "rxvt-unicode" - , "rxvt-basic" - , "cygwin" - , "cons25" - , "dumb" - ] - --- If a terminal defines one of the caps then it's expected to be parsable. -caps_of_interest = - [ "cup" - , "sc" - , "rc" - , "setf" - , "setb" - , "setaf" - , "setab" - , "op" - , "cnorm" - , "civis" - , "smcup" - , "rmcup" - , "clear" - , "hpa" - , "vpa" - , "sgr" - , "sgr0" - ] - -from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name) - -main = do - run_test $ do - forM_ terminals_of_interest $ \term_name -> do - liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name - mti <- liftIO $ try $ Terminfo.setupTerm term_name - case mti of - Left (_e :: SomeException) - -> return () - Right ti -> do - forM_ caps_of_interest $ \cap_name -> do - liftIO $ putStrLn $ "\tparsing cap: " ++ cap_name - case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of - Just cap_def -> do - verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def ) - ( verify_parse_cap cap_def $ const ( return succeeded ) ) - return () - Nothing -> do - return () - -- The quickcheck tests - verify "parse_non_paramaterized_caps" non_paramaterized_caps - verify "parse cap string with literal %" literal_percent_caps - verify "parse cap string with %i op" inc_first_two_caps - verify "parse cap string with %pN op" push_param_caps - return () - return () - -verify_parse_cap cap_string on_parse = liftIOResult $ do - parse_result <- parse_cap_expression cap_string - case parse_result of - Left error -> return $ failed { reason = "parse error " ++ show error } - Right e -> on_parse e - -non_paramaterized_caps (NonParamCapString cap) = do - verify_parse_cap cap $ \e -> - let expected_count :: Word8 = toEnum $ length cap - expected_bytes = map (toEnum . fromEnum) cap - out_bytes = bytes_for_range e 0 expected_count - in return $ verify_bytes_equal out_bytes expected_bytes - -literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do - verify_parse_cap cap_string $ \e -> - let expected_count :: Word8 = toEnum $ length expected_bytes - out_bytes = collect_bytes e - in return $ verify_bytes_equal out_bytes expected_bytes - -inc_first_two_caps (IncFirstTwoCap cap_string expected_bytes) = do - verify_parse_cap cap_string $ \e -> - let expected_count :: Word8 = toEnum $ length expected_bytes - out_bytes = collect_bytes e - in return $ verify_bytes_equal out_bytes expected_bytes - -push_param_caps (PushParamCap cap_string expected_param_count expected_bytes) = do - verify_parse_cap cap_string $ \e -> - let expected_count :: Word8 = toEnum $ length expected_bytes - out_bytes = collect_bytes e - 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 { 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 -> - let expected_count :: Word8 = toEnum $ length expected_bytes - out_bytes = collect_bytes e - 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 { reason = "out param count /= expected param count" } - -print_cap ti cap_name = do - putStrLn $ cap_name ++ ": " ++ show (from_capname ti cap_name) - -print_expression ti cap_name = do - parse_result <- parse_cap_expression $ from_capname ti cap_name - putStrLn $ cap_name ++ ": " ++ show parse_result - diff --git a/test/verify_picture_ops.hs b/test/verify_picture_ops.hs deleted file mode 100644 --- a/test/verify_picture_ops.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Main where - -import Graphics.Vty.Picture ( translate ) - -import Verify - -main = run_test $ do - return () - diff --git a/test/verify_picture_to_span.hs b/test/verify_picture_to_span.hs deleted file mode 100644 --- a/test/verify_picture_to_span.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -import Graphics.Vty.Picture -import Graphics.Vty.Span -import Graphics.Vty.PictureToSpans - -import Verify - -main = run_test $ do - return () diff --git a/test/verify_span_ops.hs b/test/verify_span_ops.hs deleted file mode 100644 --- a/test/verify_span_ops.hs +++ /dev/null @@ -1,180 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} -module Main where - -import Verify.Graphics.Vty.Picture -import Verify.Graphics.Vty.Image -import Verify.Graphics.Vty.Span -import Verify.Graphics.Vty.DisplayRegion - -import Graphics.Vty.Debug - -import Verify - -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) = - let p = pic_for_image i - spans = spans_for_pic p (region_for_window w) - in span_ops_columns spans == 0 && span_ops_rows spans == 0 - -unit_image_and_zero_window_1 :: UnitImage -> EmptyWindow -> Bool -unit_image_and_zero_window_1 (UnitImage _ i) (EmptyWindow w) = - let p = pic_for_image i - spans = spans_for_pic p (region_for_window w) - in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 ) - -horiz_span_image_and_zero_window_0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool -horiz_span_image_and_zero_window_0 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) = - let p = pic_for_image i - spans = spans_for_pic p (region_for_window w) - in span_ops_columns spans == 0 && span_ops_rows spans == 0 - -horiz_span_image_and_zero_window_1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool -horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) = - let p = pic_for_image i - spans = spans_for_pic p (region_for_window w) - in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 ) - -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 - 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 - spans = spans_for_pic p (region_for_window w) - in span_ops_effected_rows spans == 1 - -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 - 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) - spans = spans_for_pic p (region_for_window w) - in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2) - -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 - spans = spans_for_pic p (region_for_window w) - actual_row_count = span_ops_effected_rows spans - in expected_row_count == actual_row_count - -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)) - 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 - 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 - in expected_row_count == actual_row_count - -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)) - 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 - -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) - spans = spans_for_pic p (region_for_window w) - expected_row_count = stack_height stack_0 - actual_row_count = span_ops_effected_rows spans - in expected_row_count == actual_row_count - -horiz_span_image_and_greater_window_0 :: SingleRowSingleAttrImage -> Result -horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) = - let p = pic_for_image i - -- SingleRowSingleAttrImage always has width >= 1 - greater_width = c * 2 - w = DebugWindow 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) = - 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 ) - -span_ops_actually_fill_rows :: DefaultPic -> Bool -span_ops_actually_fill_rows (DefaultPic pic win _) = - let spans = spans_for_pic pic (region_for_window win) - expected_row_count = region_height (region_for_window win) - actual_row_count = span_ops_effected_rows spans - in expected_row_count == actual_row_count - -span_ops_actually_fill_columns :: DefaultPic -> Bool -span_ops_actually_fill_columns (DefaultPic pic win _) = - let spans = spans_for_pic pic (region_for_window win) - expected_column_count = region_width (region_for_window win) - in all_spans_have_width spans expected_column_count - -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 . Vector.head ) ( Vector.toList $ display_ops spans ) - -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) - spans = spans_for_pic p (region_for_window w) - in verify_all_spans_have_width (stack_image stack) spans (stack_width stack) - -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]" - single_attr_single_span_stack_op_coverage - _ <- 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]" - single_attr_single_span_stack_cropped_1 - _ <- 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]" - single_attr_single_span_stack_cropped_3 - _ <- 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]" - single_attr_single_span_stack_cropped_5 - return () - diff --git a/test/verify_utf8_width.hs b/test/verify_utf8_width.hs deleted file mode 100644 --- a/test/verify_utf8_width.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Main where -import Verify - -import Graphics.Vty.Attributes -import Graphics.Vty.Picture - -sw_is_1_column :: SingleColumnChar -> Bool -sw_is_1_column (SingleColumnChar c) = image_width (char def_attr c) == 1 - -dw_is_2_column :: DoubleColumnChar -> Bool -dw_is_2_column (DoubleColumnChar c) = image_width (char def_attr c) == 2 - -main = run_test $ do - verify "sw_is_1_column" sw_is_1_column - verify "dw_is_2_column" dw_is_2_column - return () - diff --git a/test/vty_inline_example.hs b/test/vty_inline_example.hs deleted file mode 100644 --- a/test/vty_inline_example.hs +++ /dev/null @@ -1,12 +0,0 @@ -import Graphics.Vty -import Graphics.Vty.Inline - -main = do - t <- terminal_handle - putStr "Not styled. " - put_attr_change t $ back_color red >> apply_style underline - putStr " Styled! " - put_attr_change t $ default_all - putStrLn "Not styled." - release_terminal t - return () diff --git a/test/vty_issue_18.hs b/test/vty_issue_18.hs deleted file mode 100644 --- a/test/vty_issue_18.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Main - where - -import Graphics.Vty -import Graphics.Vty.Debug - -import System.IO - -main :: IO () -main = do - vty <- mkVty - (sx, sy) <- getSize vty - play vty sx sy - -play :: Vty -> Int -> Int -> IO () -play vty sx sy = - let - testScreen = pic { - pCursor = NoCursor - , pImage = box 10 10 } - in do - update vty testScreen - getEvent vty - shutdown vty - return () - -box :: Int -> Int -> Image -box w h = - let - corner = renderChar attr '+' - vertLine = renderFill attr '|' 1 (h - 2) - horizLine = corner <|> renderHFill attr '-' (w - 2) <|> corner - centerArea = vertLine <|> renderFill attr 'X' (w - 2) (h - 2) <|> vertLine - in - horizLine <-> centerArea <-> horizLine - diff --git a/test/yi_issue_264.hs b/test/yi_issue_264.hs deleted file mode 100644 --- a/test/yi_issue_264.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Main where -import Graphics.Vty -import Control.Exception - -catchLog = handle (\except -> do putStrLn $ show (except :: IOException)) - -main = do - vty <- mkVty - catchLog $ update vty pic { pImage = empty, pCursor = NoCursor } - catchLog $ update vty pic { pImage = empty, pCursor = NoCursor } - shutdown vty - diff --git a/vty.cabal b/vty.cabal --- a/vty.cabal +++ b/vty.cabal @@ -1,13 +1,13 @@ -Name: vty -Version: 4.7.0.14 -License: BSD3 -License-file: LICENSE -Author: Stefan O'Rear, Corey O'Connor -Maintainer: Corey O'Connor (coreyoconnor@gmail.com) -Homepage: https://github.com/coreyoconnor/vty -Category: User Interfaces -Synopsis: A simple terminal access library -Description: +name: vty +version: 4.7.0.18 +license: BSD3 +license-file: LICENSE +author: AUTHORS +maintainer: Corey O'Connor (coreyoconnor@gmail.com) +homepage: https://github.com/coreyoconnor/vty +category: User Interfaces +synopsis: A simple terminal UI library +description: vty is terminal GUI library in the niche of ncurses. It is intended to be easy to use, have no confusing corner cases, and good support for common terminal types. . @@ -26,83 +26,588 @@ . © 2006-2007 Stefan O'Rear; BSD3 license. . - © 2008-2011 Corey O'Connor; BSD3 license. + © 2008-2012 Corey O'Connor; BSD3 license. +-- the test suites require >= 1.17.0 +cabal-version: >= 1.14.0 +build-type: Simple +data-files: README, + TODO, + AUTHORS, + CHANGELOG, + LICENSE -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.2 -Build-Depends: parallel >= 2.2 && < 3.3, deepseq >= 1.1 && < 1.4 -Build-Depends: vector >= 0.7 -Build-Depends: parsec >= 2 && < 4 -Build-Type: Simple -Data-Files: README, TODO -Exposed-Modules: Graphics.Vty - Graphics.Vty.Terminal - Graphics.Vty.LLInput - Graphics.Vty.Attributes - Graphics.Vty.Inline - Graphics.Vty.Picture - Graphics.Vty.DisplayRegion -other-modules: Codec.Binary.UTF8.Width - Data.Marshalling - Data.Terminfo.Parse - Data.Terminfo.Eval - Graphics.Vty.DisplayAttributes - Graphics.Vty.Image - Graphics.Vty.Span - Graphics.Vty.Terminal.Generic - Graphics.Vty.Terminal.MacOSX - Graphics.Vty.Terminal.XTermColor - Graphics.Vty.Terminal.TerminfoBased +library + default-language: Haskell2010 + build-depends: base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 -C-Sources: cbits/gwinsz.c - cbits/set_term_timing.c - cbits/mk_wcwidth.c + exposed-modules: Graphics.Vty + Graphics.Vty.Terminal + Graphics.Vty.LLInput + Graphics.Vty.Attributes + Graphics.Vty.Image + Graphics.Vty.Inline + Graphics.Vty.Picture + Graphics.Vty.DisplayRegion -Include-Dirs: cbits -hs-source-dirs: src -Extra-Source-Files: test/Makefile - test/Bench.hs - test/Bench2.hs - test/BenchRenderChar.hs - test/ControlTable.hs - test/HereDoc.hs - test/Test.hs - test/Test2.hs - test/Verify.hs - test/Verify/Data/Terminfo/Parse.hs - test/Verify/Graphics/Vty/Attributes.hs - test/Verify/Graphics/Vty/DisplayRegion.hs - test/Verify/Graphics/Vty/Image.hs - test/Verify/Graphics/Vty/Picture.hs - test/Verify/Graphics/Vty/Span.hs - test/interactive_terminal_test.hs - test/verify_attribute_ops.hs - test/verify_debug_terminal.hs - test/verify_display_attributes.hs - test/verify_empty_image_props.hs - test/verify_eval_terminfo_caps.hs - test/verify_image_ops.hs - test/verify_image_trans.hs - test/verify_inline.hs - test/verify_parse_terminfo_caps.hs - test/verify_picture_ops.hs - test/verify_picture_to_span.hs - test/verify_span_ops.hs - test/verify_utf8_width.hs - test/vty_inline_example.hs - test/vty_issue_18.hs - test/yi_issue_264.hs - src/Codec/Binary/UTF8/Debug.hs - src/Graphics/Vty/Terminal/Debug.hs - src/Graphics/Vty/Debug.hs - cbits/gwinsz.c - cbits/mk_wcwidth.c - cbits/set_term_timing.c - cbits/gwinsz.h + other-modules: Codec.Binary.UTF8.Width + Data.Marshalling + Data.Terminfo.Parse + Data.Terminfo.Eval + Graphics.Vty.DisplayAttributes + Graphics.Vty.Span + Graphics.Vty.Terminal.Generic + Graphics.Vty.Terminal.MacOSX + Graphics.Vty.Terminal.XTermColor + Graphics.Vty.Terminal.TerminfoBased -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 + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + hs-source-dirs: src + + 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 + +test-suite verify-attribute-ops + default-language: Haskell2010 + type: detailed-0.9 + hs-source-dirs: src test + test-module: VerifyAttributeOps + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-using-mock-terminal + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyMockTerminal + + other-modules: Graphics.Vty + Graphics.Vty.Attributes + Graphics.Vty.DisplayAttributes + Graphics.Vty.DisplayRegion + Graphics.Vty.Image + Graphics.Vty.Picture + Graphics.Vty.Span + Graphics.Vty.Terminal + Graphics.Vty.Terminal.Generic + Graphics.Vty.Terminal.Debug + Graphics.Vty.Debug + Graphics.Vty.Debug.Image + Codec.Binary.UTF8.Width + Verify + Verify.Graphics.Vty.Attributes + Verify.Graphics.Vty.DisplayRegion + Verify.Graphics.Vty.Picture + Verify.Graphics.Vty.Image + Verify.Graphics.Vty.Span + + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-display-attributes + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyDisplayAttributes + + other-modules: Graphics.Vty + Graphics.Vty.Attributes + Graphics.Vty.DisplayAttributes + Graphics.Vty.DisplayRegion + Graphics.Vty.Image + Graphics.Vty.Picture + Graphics.Vty.Span + Graphics.Vty.Terminal + Graphics.Vty.Terminal.Generic + Graphics.Vty.Terminal.Debug + Graphics.Vty.Debug + Graphics.Vty.Debug.Image + Codec.Binary.UTF8.Width + Verify + Verify.Graphics.Vty.Attributes + Verify.Graphics.Vty.DisplayRegion + Verify.Graphics.Vty.Picture + Verify.Graphics.Vty.Image + Verify.Graphics.Vty.Span + + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-empty-image-props + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyEmptyImageProps + + other-modules: Graphics.Vty.Picture + Verify + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-eval-terminfo-caps + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyEvalTerminfoCaps + + other-modules: Data.Terminfo.Parse + Data.Terminfo.Eval + Data.Marshalling + Codec.Binary.UTF8.Width + Verify + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-image-ops + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyImageOps + + other-modules: Graphics.Vty.Attributes + Graphics.Vty.DisplayAttributes + Graphics.Vty.DisplayRegion + Graphics.Vty.Image + Graphics.Vty.Picture + Graphics.Vty.Span + Graphics.Vty.Debug.Image + Codec.Binary.UTF8.Width + Verify + Verify.Graphics.Vty.Attributes + Verify.Graphics.Vty.Image + + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-image-trans + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyImageTrans + + other-modules: Graphics.Vty.Attributes + Graphics.Vty.Debug.Image + Graphics.Vty.Image + Codec.Binary.UTF8.Width + Verify + Verify.Graphics.Vty.Attributes + Verify.Graphics.Vty.Image + + c-sources: cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-inline + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyInline + + other-modules: Codec.Binary.UTF8.Width + Data.Terminfo.Eval + Data.Terminfo.Parse + Data.Marshalling + Graphics.Vty.Attributes + Graphics.Vty.DisplayAttributes + Graphics.Vty.DisplayRegion + Graphics.Vty.Image + Graphics.Vty.Inline + Graphics.Vty.Span + Graphics.Vty.Terminal + Graphics.Vty.Terminal.Generic + Graphics.Vty.Terminal.MacOSX + Graphics.Vty.Terminal.TerminfoBased + Graphics.Vty.Terminal.XTermColor + + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-parse-terminfo-caps + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyParseTerminfoCaps + + other-modules: Data.Terminfo.Parse + Verify + Verify.Data.Terminfo.Parse + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-picture-ops + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyPictureOps + + other-modules: Graphics.Vty.Picture + Verify + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-picture-to-span + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyPictureToSpan + + other-modules: Graphics.Vty + Graphics.Vty.Attributes + Graphics.Vty.DisplayAttributes + Graphics.Vty.DisplayRegion + Graphics.Vty.Image + Graphics.Vty.Picture + Graphics.Vty.Span + Graphics.Vty.Terminal + Graphics.Vty.Terminal.Generic + Graphics.Vty.Terminal.Debug + Graphics.Vty.Debug + Graphics.Vty.Debug.Image + Codec.Binary.UTF8.Width + Verify + Verify.Graphics.Vty.Attributes + Verify.Graphics.Vty.DisplayRegion + Verify.Graphics.Vty.Picture + Verify.Graphics.Vty.Image + Verify.Graphics.Vty.Span + + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-span-ops + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifySpanOps + + other-modules: Graphics.Vty + Graphics.Vty.Attributes + Graphics.Vty.DisplayAttributes + Graphics.Vty.DisplayRegion + Graphics.Vty.Image + Graphics.Vty.Picture + Graphics.Vty.Span + Graphics.Vty.Terminal + Graphics.Vty.Terminal.Generic + Graphics.Vty.Terminal.Debug + Graphics.Vty.Debug + Graphics.Vty.Debug.Image + Codec.Binary.UTF8.Width + Verify + Verify.Graphics.Vty.Attributes + Verify.Graphics.Vty.DisplayRegion + Verify.Graphics.Vty.Picture + Verify.Graphics.Vty.Image + Verify.Graphics.Vty.Span + + c-sources: cbits/gwinsz.c + cbits/set_term_timing.c + cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +test-suite verify-utf8-width + default-language: Haskell2010 + + type: detailed-0.9 + + hs-source-dirs: src test + + test-module: VerifyUtf8Width + + other-modules: Codec.Binary.UTF8.Width + Graphics.Vty.Attributes + Graphics.Vty.Image + Verify + + c-sources: cbits/mk_wcwidth.c + + include-dirs: cbits + + build-depends: Cabal == 1.17.*, + QuickCheck == 2.4.*, + random == 1.0.*, + base >= 4 && < 5, + bytestring, + containers, + deepseq >= 1.1 && < 1.4, + ghc-prim, + mtl >= 1.1.1.0 && < 2.2, + parallel >= 2.2 && < 3.3, + parsec >= 2 && < 4, + terminfo >= 0.3 && < 0.4, + unix, + utf8-string >= 0.3 && < 0.4, + vector >= 0.7 + +-- Bench.hs +-- Bench2.hs +-- BenchRenderChar.hs +-- ControlTable.hs +-- HereDoc.hs +-- Test.hs +-- Test2.hs +-- Verify.hs +-- Verify/Data/Terminfo/Parse.hs +-- Verify/Graphics/Vty/Attributes.hs +-- Verify/Graphics/Vty/DisplayRegion.hs +-- Verify/Graphics/Vty/Image.hs +-- Verify/Graphics/Vty/Picture.hs +-- Verify/Graphics/Vty/Span.hs +-- interactive_terminal_test.hs +-- vty_inline_example.hs +-- vty_issue_18.hs +-- yi_issue_264.hs +