packages feed

vty 5.37 → 5.38

raw patch · 49 files changed

+250/−3000 lines, 49 filesdep −Cabaldep −HUnitdep −QuickCheckdep ~basedep ~microlensdep ~mtl

Dependencies removed: Cabal, HUnit, QuickCheck, hashable, parallel, quickcheck-assertions, random, smallcheck, string-qq, test-framework, test-framework-hunit, test-framework-smallcheck

Dependency ranges changed: base, microlens, mtl

Files

CHANGELOG.md view
@@ -1,4 +1,43 @@ +5.38+----++This release includes numerous API changes, although none of them should+break your programs. If so, please open a ticket on the Vty issue+tracker.++Package changes:+* Support mtl 2.3 (thanks Daniel Firth)+* The test and example collections got completely overhauled to clean up+  bit rot.+  * Moved example programs into examples/ under a new vty-examples+    package.+  * Moved test suite programs out of vty.cabal and into tests/ under a+    new vty-tests package.+  * Cleaned up all build-depends lists in all three packages to remove+    unused deps.+  * Consolidated the test suite library modules into the vty-tests+    library to avoid redundant compilation.+  * Added build.sh to build everything in the development process to+    help ensure that examples and tests don't get forgotten.+  * Removeed lots of stale/unused modules in old test/ directory.+* Got vty-examples building again and resolved various warnings and+  issues.++API changes:+* All modules got explicit export lists. Prior to this release, many+  modules exported everything they contained, making it difficult to+  know what was really intended to be part of the public API. The new+  export lists should contain everything that applications need; the+  risk of breakage exists but should be minor. Please open a ticket if+  you were using something that is no longer exported. It might be that+  it was never supposed to be exported to begin with, or it might be+  just something we need to export once again.+* Moved the `attributeControl` function from `Graphics.Vty.Input.Loop`+  to `Graphics.Vty.Input`.+* Removed the `Graphics.Vty.Image.DisplayText` alias for `Text`.+* Unified the `Image` cropping constructors (thanks Fraser Tweedale)+ 5.37 ----
README.md view
@@ -163,6 +163,8 @@ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: + - Please ensure that the examples and test suites build along with the+   library by running `build.sh` in the repository.  - If you want to take on big things, talk to me first; let's have a    design/vision discussion before you start coding. Create a GitHub    issue and we can use that as the place to hash things out.
demos/Demo.hs view
@@ -5,6 +5,7 @@  import Control.Applicative hiding ((<|>)) import Control.Arrow+import Control.Monad import Control.Monad.RWS  import Data.Sequence (Seq, (<|) )
− src/Codec/Binary/UTF8/Debug.hs 
@@ -1,17 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--- 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-utf8FromIso :: [Int] -> [Word8]-utf8FromIso = encode . map toEnum--ppUtf8 :: [Int] -> IO ()-ppUtf8 = print . map (`showHex` "") . utf8FromIso
src/Data/Terminfo/Eval.hs view
@@ -14,6 +14,7 @@ import Blaze.ByteString.Builder import Data.Terminfo.Parse +import Control.Monad import Control.Monad.Identity import Control.Monad.State.Strict import Control.Monad.Writer
src/Graphics/Vty/Attributes/Color.hs view
@@ -125,7 +125,7 @@     term <- catch (Just <$> Terminfo.setupTerm termName')                   (\(_ :: Terminfo.SetupTermError) -> return Nothing)     let getCap cap = term >>= \t -> Terminfo.getCapability t cap-        termColors = fromMaybe 0 $! getCap (Terminfo.tiGetNum "colors")+        termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")     colorterm <- lookupEnv "COLORTERM"     return $ if         | termColors <  8               -> NoColor@@ -157,6 +157,10 @@ brightCyan   = ISOColor 14 brightWhite  = ISOColor 15 +-- | Create a color value from RGB values in the 0..255 range inclusive.+-- No transformation of the input values is done; a color is created+-- directly from the RGB values specified, unlike the 'srgbColor' and+-- 'color240' functions. linearColor :: Integral i => i -> i -> i -> Color linearColor r g b = RGBColor r' g' b'     where@@ -165,11 +169,12 @@         b' = fromIntegral (clamp b) :: Word8         clamp = min 255 . max 0 +-- | Given RGB values in the range 0..255 inclusive, create a color+-- using the sRGB transformation described at+--+-- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation srgbColor :: Integral i => i -> i -> i -> Color srgbColor r g b =-    -- srgb to rgb transformation as described at-    -- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation-    --     -- TODO: it may be worth translating this to a lookup table, as with color240     let shrink n = fromIntegral n / 255 :: Double         -- called gamma^-1 in wiki@@ -185,7 +190,8 @@ color240 r g b = Color240 (rgbColorToColor240 r g b)  -- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.--- This function is lossy in the sense that we only internally support 240 colors but the--- #RRGGBB format supports 16^3 colors.+-- This is a synonym for 'color240'. This function is lossy in the sense+-- that we only internally support 240 colors but the #RRGGBB format+-- supports 16^3 colors. rgbColor :: Integral i => i -> i -> i -> Color rgbColor = color240
src/Graphics/Vty/Attributes/Color240.hs view
@@ -11,7 +11,10 @@ -- Note: rgbColor's mapping from RGB to 240 colors was generated from -- 256colres.pl which is forked from xterm 256colres.pl. --- | Create a value in the Color240 set from an RGB triple+-- | Create a value in the Color240 set from an RGB triple. This maps+-- the input arguments to an entry in the 240-color palette depicted at:+--+-- https://rich.readthedocs.io/en/stable/appendix/colors.html rgbColorToColor240 :: Integral i => i -> i -> i -> Word8 rgbColorToColor240 r g b     | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"
src/Graphics/Vty/Debug.hs view
@@ -1,13 +1,15 @@ -- Copyright 2009-2010 Corey O'Connor module Graphics.Vty.Debug-  ( module Graphics.Vty.Debug-  , module Graphics.Vty.Debug.Image+  ( MockWindow(..)+  , regionForWindow+  , allSpansHaveWidth+  , spanOpsAffectedColumns+  , spanOpsAffectedRows   ) where  import Graphics.Vty.Attributes import Graphics.Vty.Image (DisplayRegion)-import Graphics.Vty.Debug.Image import Graphics.Vty.Span  import qualified Data.Vector as Vector
− src/Graphics/Vty/Debug/Image.hs 
@@ -1,32 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}-module Graphics.Vty.Debug.Image where--import Graphics.Vty.Image--type ImageConstructLog = [ImageConstructEvent]-data ImageConstructEvent = ImageConstructEvent-    deriving ( Show, Eq )--forwardImageOps :: [Image -> Image]-forwardImageOps = map forwardTransform debugImageOps--forwardTransform, reverseTransform :: ImageOp -> (Image -> Image)--forwardTransform (ImageOp f _) = f-reverseTransform (ImageOp _ r) = r--data ImageOp = ImageOp ImageEndo ImageEndo-type ImageEndo = Image -> Image--debugImageOps :: [ImageOp]-debugImageOps =-    [ idImageOp-    -- , renderSingleColumnCharOp-    -- , renderDoubleColumnCharOp-    ]--idImageOp :: ImageOp-idImageOp = ImageOp id id---- renderCharOp :: ImageOp--- renderCharOp = ImageOp id id
src/Graphics/Vty/DisplayAttributes.hs view
@@ -2,7 +2,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -module Graphics.Vty.DisplayAttributes where+module Graphics.Vty.DisplayAttributes+  ( DisplayAttrDiff(..)+  , StyleStateChange(..)+  , DisplayColorDiff(..)+  , URLDiff(..)+  , fixDisplayAttr+  , displayAttrDiffs+  )+where  import Graphics.Vty.Attributes
src/Graphics/Vty/Error.hs view
@@ -1,4 +1,7 @@-module Graphics.Vty.Error where+module Graphics.Vty.Error+  ( VtyException(..)+  )+where  -- | The type of exceptions specific to vty. --
src/Graphics/Vty/Image.hs view
@@ -52,7 +52,6 @@   , wctwidth   , wctlwidth   -- * Display Regions-  , DisplayText   , DisplayRegion   , regionWidth   , regionHeight@@ -258,7 +257,7 @@ translateX :: Int -> Image -> Image translateX x i     | x < 0 && (abs x > imageWidth i) = emptyImage-    | x < 0     = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)+    | x < 0     = cropLeft (imageWidth i + x) i     | x == 0    = i     | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h @@ -266,7 +265,7 @@ translateY :: Int -> Image -> Image translateY y i     | y < 0 && (abs y > imageHeight i) = emptyImage-    | y < 0     = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)+    | y < 0     = cropTop (imageHeight i + y) i     | y == 0    = i     | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y) @@ -296,12 +295,11 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropBottom {croppedImage, outputWidth, outputHeight})-                | outputHeight <= h = i-                | otherwise          = CropBottom croppedImage outputWidth h+            go i@(Crop {outputHeight})+                = i {outputHeight = min h outputHeight}             go i                 | h >= imageHeight i = i-                | otherwise           = CropBottom i (imageWidth i) h+                | otherwise = Crop i 0 0 (imageWidth i) h  -- | Crop an image's width. If the image's width is less than or equal -- to the specified width then this operation has no effect. Otherwise@@ -313,12 +311,11 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropRight {croppedImage, outputWidth, outputHeight})-                | outputWidth <= w = i-                | otherwise         = CropRight croppedImage w outputHeight+            go i@(Crop {outputWidth})+                = i {outputWidth = min w outputWidth}             go i                 | w >= imageWidth i = i-                | otherwise          = CropRight i w (imageHeight i)+                | otherwise = Crop i 0 0 w (imageHeight i)  -- | Crop an image's width. If the image's width is less than or equal -- to the specified width then this operation has no effect. Otherwise@@ -330,14 +327,13 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})-                | outputWidth <= w = i-                | otherwise         =-                    let leftSkip' = leftSkip + outputWidth - w-                    in CropLeft croppedImage leftSkip' w outputHeight+            go i@(Crop {leftSkip, outputWidth}) =+                let delta = max 0 (outputWidth - w)+                in i { leftSkip = leftSkip + delta+                     , outputWidth = outputWidth - delta }             go i                 | imageWidth i <= w = i-                | otherwise          = CropLeft i (imageWidth i - w) w (imageHeight i)+                | otherwise = Crop i (imageWidth i - w) 0 w (imageHeight i)  -- | Crop an image's height. If the image's height is less than or equal -- to the specified height then this operation has no effect. Otherwise@@ -349,14 +345,13 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropTop {croppedImage, topSkip, outputWidth, outputHeight})-                | outputHeight <= h = i-                | otherwise         =-                    let topSkip' = topSkip + outputHeight - h-                    in CropTop croppedImage topSkip' outputWidth h+            go i@(Crop {topSkip, outputHeight}) =+                let delta = max 0 (outputHeight - h)+                in i { topSkip = topSkip + delta+                     , outputHeight = outputHeight - delta }             go i                 | imageHeight i <= h = i-                | otherwise          = CropTop i (imageHeight i - h) (imageWidth i) h+                | otherwise = Crop i 0 (imageHeight i - h) (imageWidth i) h  -- | Generic resize. Pads and crops are added to ensure that the -- resulting image matches the specified dimensions. This is biased to
src/Graphics/Vty/Image/Internal.hs view
@@ -3,8 +3,18 @@ {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_HADDOCK hide #-} -module Graphics.Vty.Image.Internal where+module Graphics.Vty.Image.Internal+  ( Image(..)+  , imageHeight+  , imageWidth+  , horizJoin+  , vertJoin +  , ppImageStructure+  , clipText+  )+where+ import Graphics.Vty.Attributes import Graphics.Text.Width @@ -17,10 +27,7 @@ #endif import qualified Data.Text.Lazy as TL --- | A display text is a Data.Text.Lazy-type DisplayText = TL.Text--clipText :: DisplayText -> Int -> Int -> DisplayText+clipText :: TL.Text -> Int -> Int -> TL.Text clipText txt leftSkip rightClip =     -- CPS would clarify this I think     let (toDrop,padPrefix) = clipForCharWidth leftSkip txt 0@@ -57,7 +64,7 @@       { attr :: Attr       -- | The text to display. The display width of the text is always       -- outputWidth.-      , displayText :: DisplayText+      , displayText :: TL.Text       -- | The number of display columns for the text.       , outputWidth :: Int       -- | the number of characters in the text.@@ -96,42 +103,12 @@       { outputWidth :: Int -- ^ always > 0       , outputHeight :: Int -- ^ always > 0       }-    -- | Crop an image horizontally to a size by reducing the size from-    -- the right.-    | CropRight-      { croppedImage :: Image-      -- | Always < imageWidth croppedImage > 0-      , outputWidth :: Int-      , outputHeight :: Int -- ^ imageHeight croppedImage-      }-    -- | Crop an image horizontally to a size by reducing the size from-    -- the left.-    | CropLeft+    -- | Crop an image+    | Crop       { croppedImage :: Image-      -- | Always < imageWidth croppedImage > 0       , leftSkip :: Int-      -- | Always < imageWidth croppedImage > 0-      , outputWidth :: Int-      , outputHeight :: Int-      }-    -- | Crop an image vertically to a size by reducing the size from-    -- the bottom-    | CropBottom-      { croppedImage :: Image-      -- | imageWidth croppedImage-      , outputWidth :: Int-      -- | height image is cropped to. Always < imageHeight croppedImage > 0-      , outputHeight :: Int-      }-    -- | Crop an image vertically to a size by reducing the size from-    -- the top-    | CropTop-      { croppedImage :: Image-      -- | Always < imageHeight croppedImage > 0       , topSkip :: Int-      -- | imageWidth croppedImage       , outputWidth :: Int-      -- | Always < imageHeight croppedImage > 0       , outputHeight :: Int       }     -- | The empty image@@ -159,26 +136,14 @@             = "VertJoin(" ++ show c ++ ", " ++ show r ++ ")\n"               ++ go (i+1) t ++ "\n"               ++ go (i+1) b-        pp i (CropRight {croppedImage, outputWidth, outputHeight})-            = "CropRight(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"-              ++ go (i+1) croppedImage-        pp i (CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})-            = "CropLeft(" ++ show leftSkip ++ "->" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"-              ++ go (i+1) croppedImage-        pp i (CropBottom {croppedImage, outputWidth, outputHeight})-            = "CropBottom(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"-              ++ go (i+1) croppedImage-        pp i (CropTop {croppedImage, topSkip, outputWidth, outputHeight})-            = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n"+        pp i (Crop {croppedImage, leftSkip, topSkip, outputWidth, outputHeight})+            = "Crop(" ++ show leftSkip ++ "," ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"               ++ go (i+1) croppedImage         pp _ EmptyImage = "EmptyImage"  instance NFData Image where     rnf EmptyImage = ()-    rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()-    rnf (CropLeft i s w h) = i `deepseq` s `seq` w `seq` h `seq` ()-    rnf (CropBottom i w h) = i `deepseq` w `seq` h `seq` ()-    rnf (CropTop i s w h) = i `deepseq` s `seq` w `seq` h `seq` ()+    rnf (Crop i x y w h) = i `deepseq` x `seq` y `seq` w `seq` h `seq` ()     rnf (BGFill w h) = w `seq` h `seq` ()     rnf (VertJoin t b w h) = t `deepseq` b `deepseq` w `seq` h `seq` ()     rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` ()@@ -191,10 +156,7 @@ imageWidth HorizJoin { outputWidth = w } = w imageWidth VertJoin { outputWidth = w } = w imageWidth BGFill { outputWidth = w } = w-imageWidth CropRight { outputWidth  = w } = w-imageWidth CropLeft { outputWidth  = w } = w-imageWidth CropBottom { outputWidth = w } = w-imageWidth CropTop { outputWidth = w } = w+imageWidth Crop { outputWidth = w } = w imageWidth EmptyImage = 0  -- | The height of an Image. This is the number of display rows the@@ -204,10 +166,7 @@ imageHeight HorizJoin { outputHeight = h } = h imageHeight VertJoin { outputHeight = h } = h imageHeight BGFill { outputHeight = h } = h-imageHeight CropRight { outputHeight  = h } = h-imageHeight CropLeft { outputHeight  = h } = h-imageHeight CropBottom { outputHeight = h } = h-imageHeight CropTop { outputHeight = h } = h+imageHeight Crop { outputHeight = h } = h imageHeight EmptyImage = 0  -- | Append in the 'Semigroup' instance is equivalent to '<->'.
src/Graphics/Vty/Inline/Unsafe.hs view
@@ -1,6 +1,10 @@ {-# OPTIONS_HADDOCK hide #-} -module Graphics.Vty.Inline.Unsafe where+module Graphics.Vty.Inline.Unsafe+  ( withOutput+  , withVty+  )+where  import Graphics.Vty
src/Graphics/Vty/Input.hs view
@@ -118,6 +118,7 @@   , Event(..)   , Input(..)   , inputForConfig+  , attributeControl   ) where @@ -131,6 +132,8 @@  import qualified System.Console.Terminfo as Terminfo import System.Posix.Signals.Exts+import System.Posix.Terminal+import System.Posix.Types (Fd(..))  #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))@@ -174,3 +177,45 @@         , restoreInputState = restoreInputState input >> restore         } inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig++-- | Construct two IO actions: one to configure the terminal for Vty and+-- one to restore the terminal mode flags to the values they had at the+-- time this function was called.+--+-- This function constructs a configuration action to clear the+-- following terminal mode flags:+--+-- * IXON disabled: disables software flow control on outgoing data.+-- This stops the process from being suspended if the output terminal+-- cannot keep up.+--+-- * Raw mode is used for input.+--+-- * ISIG (enables keyboard combinations that result in+-- signals)+--+-- * ECHO (input is not echoed to the output)+--+-- * ICANON (canonical mode (line mode) input is not used)+--+-- * IEXTEN (extended functions are disabled)+--+-- The configuration action also explicitly sets these flags:+--+-- * ICRNL (input carriage returns are mapped to newlines)+attributeControl :: Fd -> IO (IO (), IO ())+attributeControl fd = do+    original <- getTerminalAttributes fd+    let vtyMode = foldl withMode clearedFlags flagsToSet+        clearedFlags = foldl withoutMode original flagsToUnset+        flagsToSet = [ MapCRtoLF -- ICRNL+                     ]+        flagsToUnset = [ StartStopOutput -- IXON+                       , KeyboardInterrupts -- ISIG+                       , EnableEcho -- ECHO+                       , ProcessInput -- ICANON+                       , ExtendedFunctions -- IEXTEN+                       ]+    let setAttrs = setTerminalAttributes fd vtyMode Immediately+        unsetAttrs = setTerminalAttributes fd original Immediately+    return (setAttrs, unsetAttrs)
src/Graphics/Vty/Input/Events.hs view
@@ -1,6 +1,14 @@ {-# Language DeriveGeneric #-} {-# Language StrictData #-}-module Graphics.Vty.Input.Events where+module Graphics.Vty.Input.Events+  ( Key(..)+  , Modifier(..)+  , Event(..)+  , Button(..)+  , ClassifyMap+  , InternalEvent(..)+  )+where  import Control.DeepSeq import Data.ByteString
src/Graphics/Vty/Input/Focus.hs view
@@ -10,6 +10,7 @@ import Graphics.Vty.Input.Classify.Types import Graphics.Vty.Input.Classify.Parse +import Control.Monad import Control.Monad.State  import qualified Data.ByteString.Char8 as BS8
src/Graphics/Vty/Input/Loop.hs view
@@ -15,8 +15,14 @@ -- more of these examples... -- -- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html-module Graphics.Vty.Input.Loop where+module Graphics.Vty.Input.Loop+  ( Input(..)+  , eventChannel +  , initInput+  )+where+ import Graphics.Vty.Config import Graphics.Vty.Input.Classify import Graphics.Vty.Input.Events@@ -46,7 +52,6 @@  import System.IO import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))-import System.Posix.Terminal import System.Posix.Types (Fd(..))  import Text.Printf (hPrintf)@@ -194,48 +199,6 @@                 <*> pure (InputBuffer bufferPtr bufferSize)                 <*> pure (classify classifyTable)         runReaderT (evalStateT loopInputProcessor s0) input---- | Construct two IO actions: one to configure the terminal for Vty and--- one to restore the terminal mode flags to the values they had at the--- time this function was called.------ This function constructs a configuration action to clear the--- following terminal mode flags:------ * IXON disabled: disables software flow control on outgoing data.--- This stops the process from being suspended if the output terminal--- cannot keep up.------ * Raw mode is used for input.------ * ISIG (enables keyboard combinations that result in--- signals)------ * ECHO (input is not echoed to the output)------ * ICANON (canonical mode (line mode) input is not used)------ * IEXTEN (extended functions are disabled)------ The configuration action also explicitly sets these flags:------ * ICRNL (input carriage returns are mapped to newlines)-attributeControl :: Fd -> IO (IO (), IO ())-attributeControl fd = do-    original <- getTerminalAttributes fd-    let vtyMode = foldl withMode clearedFlags flagsToSet-        clearedFlags = foldl withoutMode original flagsToUnset-        flagsToSet = [ MapCRtoLF -- ICRNL-                     ]-        flagsToUnset = [ StartStopOutput -- IXON-                       , KeyboardInterrupts -- ISIG-                       , EnableEcho -- ECHO-                       , ProcessInput -- ICANON-                       , ExtendedFunctions -- IEXTEN-                       ]-    let setAttrs = setTerminalAttributes fd vtyMode Immediately-        unsetAttrs = setTerminalAttributes fd original Immediately-    return (setAttrs, unsetAttrs)  logInitialInputState :: Input -> ClassifyMap -> IO() logInitialInputState input classifyTable = case _inputDebug input of
src/Graphics/Vty/Input/Mouse.hs view
@@ -14,6 +14,7 @@ import Graphics.Vty.Input.Classify.Types import Graphics.Vty.Input.Classify.Parse +import Control.Monad import Control.Monad.State import Data.Maybe (catMaybes) import Data.Bits ((.&.))
src/Graphics/Vty/Input/Terminfo.hs view
@@ -1,5 +1,13 @@ {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-module Graphics.Vty.Input.Terminfo where+module Graphics.Vty.Input.Terminfo+  ( classifyMapForTerm+  , specialSupportKeys+  , capsClassifyMap+  , keysFromCapsTable+  , universalTable+  , visibleChars+  )+where  import Graphics.Vty.Input.Events import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT
src/Graphics/Vty/Input/Terminfo/ANSIVT.hs view
@@ -5,7 +5,10 @@ -- Terminal emulators will often use VT50 input bytes regardless of -- declared terminal type. This provides compatibility with programs -- that don't follow terminfo.-module Graphics.Vty.Input.Terminfo.ANSIVT where+module Graphics.Vty.Input.Terminfo.ANSIVT+  ( classifyTable+  )+where  import Graphics.Vty.Input.Events
src/Graphics/Vty/PictureToSpans.hs view
@@ -6,7 +6,10 @@ {-# LANGUAGE TemplateHaskell #-}  -- | Transforms an image into rows of operations.-module Graphics.Vty.PictureToSpans where+module Graphics.Vty.PictureToSpans+  ( displayOpsForPic+  )+where  import Graphics.Vty.Attributes (Attr, currentAttr) import Graphics.Vty.Image@@ -17,6 +20,7 @@ import Lens.Micro import Lens.Micro.Mtl import Lens.Micro.TH+import Control.Monad import Control.Monad.Reader import Control.Monad.State.Strict hiding ( state ) import Control.Monad.ST.Strict@@ -29,8 +33,6 @@  type MRowOps s = MVector s SpanOps -type MSpanOps s = MVector s SpanOp- -- transform plus clip. More or less. data BlitState = BlitState     -- we always snoc to the operation vectors. Thus the columnOffset =@@ -69,13 +71,6 @@ displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r) --- | Returns the DisplayOps for an image rendered to a window the size--- of the image.------ largely used only for debugging.-displayOpsForImage :: Image -> DisplayOps-displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)- -- | Produces the span ops for each layer then combines them. combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s) combinedOpsForLayers pic r@@ -220,18 +215,18 @@  isOutOfBounds :: Image -> BlitState -> Bool isOutOfBounds i s-    | s ^. remainingColumns <= 0              = True-    | s ^. remainingRows    <= 0              = True+    | s ^. remainingColumns <= 0             = True+    | s ^. remainingRows    <= 0             = True     | s ^. skipColumns      >= imageWidth i  = True     | s ^. skipRows         >= imageHeight i = True     | otherwise = False  -- | This adds an image that might be partially clipped to the output -- ops.--- -- This is a very touchy algorithm. Too touchy. For instance, the--- CropRight and CropBottom implementations are odd. They pass the--- current tests but something seems terribly wrong about all this.+-- Crop implementations is odd. They pass the current tests but+-- something seems terribly wrong about all this.+-- addMaybeClipped :: forall s . Image -> BlitM s () addMaybeClipped EmptyImage = return () addMaybeClipped (HorizText a textStr ow _cw) = do@@ -266,23 +261,13 @@         outputHeight' = min (outputHeight - s^.skipRows   ) (s^.remainingRows)     y <- use rowOffset     forM_ [y..y+outputHeight'-1] $ snocOp (Skip outputWidth')-addMaybeClipped CropRight {croppedImage, outputWidth} = do-    s <- use skipColumns-    r <- use remainingColumns-    let x = outputWidth - s-    when (x < r) $ remainingColumns .= x-    addMaybeClipped croppedImage-addMaybeClipped CropLeft {croppedImage, leftSkip} = do+addMaybeClipped Crop {croppedImage, leftSkip, topSkip, outputWidth, outputHeight} = do+    sx <- use skipColumns     skipColumns += leftSkip-    addMaybeClipped croppedImage-addMaybeClipped CropBottom {croppedImage, outputHeight} = do-    s <- use skipRows-    r <- use remainingRows-    let x = outputHeight - s-    when (x < r) $ remainingRows .= x-    addMaybeClipped croppedImage-addMaybeClipped CropTop {croppedImage, topSkip} = do+    modifying remainingColumns (min (outputWidth - sx))+    sy <- use skipRows     skipRows += topSkip+    modifying remainingRows (min (outputHeight - sy))     addMaybeClipped croppedImage  addMaybeClippedJoin :: forall s . String@@ -318,7 +303,7 @@                 addMaybeClipped i1         _ -> error $ name ++ " has unhandled skip class" -addUnclippedText :: Attr -> DisplayText -> BlitM s ()+addUnclippedText :: Attr -> TL.Text -> BlitM s () addUnclippedText a txt = do     let op = TextSpan a usedDisplayColumns                       (fromIntegral $ TL.length txt)
src/Graphics/Vty/Span.hs view
@@ -7,8 +7,23 @@ -- -- A span op sequence will be defined for all rows and columns (and no -- more) of the region provided with the picture to 'spansForPic'.-module Graphics.Vty.Span where+module Graphics.Vty.Span+  ( SpanOp(..)+  , columnsToCharOffset+  , spanOpHasWidth +  , SpanOps+  , spanOpsAffectedColumns+  , splitOpsAt+  , dropOps++  , DisplayOps+  , displayOpsRows+  , displayOpsColumns+  , affectedRegion+  )+where+ import Graphics.Vty.Attributes (Attr) import Graphics.Vty.Image import Graphics.Vty.Image.Internal ( clipText )@@ -28,7 +43,7 @@       { textSpanAttr :: !Attr       , textSpanOutputWidth :: !Int       , textSpanCharWidth :: !Int-      , textSpanText :: DisplayText+      , textSpanText :: TL.Text       }     -- | Skips the given number of columns.     | Skip !Int
− test/Verify.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module Verify-  ( module Verify-  , module Control.Applicative-  , module Control.DeepSeq-  , module Control.Exception-  , module Control.Monad-  , module Test.QuickCheck-  , module Test.QuickCheck.Modifiers-  , module Text.Printf-  , succeeded-  , failed-  , monadicIO-  , liftIO-  , liftBool-  , Test(..)-  , Prop.Result(..)-  )-where--import Control.Exception ( bracket, try, SomeException(..) )--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.Modifiers-import Test.QuickCheck.Property hiding ( Result(..) )-import qualified Test.QuickCheck.Property as Prop-import Test.QuickCheck.Monadic ( monadicIO )--import Text.Printf--import qualified Codec.Binary.UTF8.String as UTF8--import Control.Applicative hiding ( (<|>) )-import Control.DeepSeq-import Control.Monad ( forM, mapM, mapM_, forM_ )-import Control.Monad.State.Strict--import Numeric ( showHex )--verify :: Testable t => String -> t -> Test-verify testName p = Test $ TestInstance-  { name = testName-  , run = do-    qcResult <- quickCheckWithResult (stdArgs {chatty = False}) p-    case qcResult of-        QC.Success {..} -> return $ Finished TS.Pass-        QC.Failure {numShrinks,reason} -> return $ Finished-            $ TS.Fail $ "After "-                      ++ show numShrinks ++ " shrinks determined failure to be: "-                      ++ show reason-        _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"-  , tags = []-  , options = []-  , setOption = \_ _ -> Left "no options supported"-  }--data SingleColumnChar = SingleColumnChar Char-    deriving (Show, Eq)--instance Arbitrary SingleColumnChar where-    arbitrary = elements $ map SingleColumnChar [toEnum 0x21 .. toEnum 0x7E]--data DoubleColumnChar = DoubleColumnChar Char-    deriving (Eq)--instance Show DoubleColumnChar where-    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 ]--liftIOResult :: Testable prop => IO prop -> Property-liftIOResult = ioProperty--data Bench where-    Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench
− test/Verify/Data/Terminfo/Parse.hs 
@@ -1,112 +0,0 @@-module Verify.Data.Terminfo.Parse-  ( module Verify.Data.Terminfo.Parse-  , module Data.Terminfo.Parse-  )-where--import Data.Terminfo.Parse-import Data.Terminfo.Eval-import Verify--import Data.Word-import qualified Data.Vector.Unboxed as Vector--import Numeric--hexDump :: [Word8] -> String-hexDump bytes = foldr (\b s -> showHex b s) "" bytes--data NonParamCapString = NonParamCapString String-    deriving Show--instance Arbitrary NonParamCapString where-    arbitrary-        = ( do-            s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%')-            return $ NonParamCapString s-          ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )--data LiteralPercentCap = LiteralPercentCap String [Word8]-    deriving ( Show )--instance Arbitrary LiteralPercentCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s-            return $ LiteralPercentCap s' bytes-          ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )--data IncFirstTwoCap = IncFirstTwoCap String [Word8]-    deriving ( Show )--instance Arbitrary IncFirstTwoCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            (s', bytes) <- insertEscapeOp "i" [] s-            return $ IncFirstTwoCap s' bytes-          ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )--data PushParamCap = PushParamCap String Int [Word8]-    deriving ( Show )--instance Arbitrary PushParamCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            n <- choose (1,9)-            (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s-            return $ PushParamCap s' n bytes-          ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )--data DecPrintCap = DecPrintCap String Int [Word8]-    deriving ( Show )--instance Arbitrary DecPrintCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            n <- choose (1,9)-            (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s-            return $ DecPrintCap s' n bytes-          ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )--insertEscapeOp opStr replBytes s = do-    insertPoints <- listOf1 $ elements [0 .. length s - 1]-    let s' = f s ('%' : opStr)-        remainingBytes = f (map (toEnum . fromEnum) s) replBytes-        f inVs out_v = concat [ vs-                              | vi <- zip inVs [0 .. length s - 1]-                              , let vs = fst vi : ( if snd vi `elem` insertPoints-                                                       then out_v-                                                       else []-                                                  )-                              ]-    return (s', remainingBytes)--isBytesOp :: CapOp -> Bool-isBytesOp (Bytes {}) = True--- isBytesOp _ = False--bytesForRange cap offset count-    = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap--collectBytes :: CapExpression -> [Word8]-collectBytes e = concat [ bytes-                        | Bytes offset count <- capOps e-                        , let bytes = bytesForRange e offset count-                        ]---verifyBytesEqual :: [Word8] -> [Word8] -> Result-verifyBytesEqual outBytes expectedBytes-    = if outBytes == expectedBytes-        then succeeded-        else failed-             { reason = "outBytes ["-                      ++ hexDump outBytes-                      ++ "] /= expectedBytes ["-                      ++ hexDump expectedBytes-                      ++ "]"-             }
− test/Verify/Graphics/Vty/Attributes.hs 
@@ -1,73 +0,0 @@-module Verify.Graphics.Vty.Attributes-  ( module Verify.Graphics.Vty.Attributes-  , module Graphics.Vty.Attributes-  )-where--import Graphics.Vty.Attributes-import Verify--import Data.List ( delete )--allColors :: [Color]-allColors =-    [ black-    , red-    , green-    , yellow-    , blue-    , magenta-    , cyan-    , white-    , brightBlack-    , brightRed-    , brightGreen-    , brightYellow-    , brightBlue-    , brightMagenta-    , brightCyan-    , brightWhite-    ] ++ map Color240 [0..239]--allStyles :: [Style]-allStyles =-    [ standout-    , underline-    , reverseVideo-    , blink-    , dim-    , bold-    ]---- Limit the possible attributes to just a few for now.-possibleAttrMods :: [ AttrOp ]-possibleAttrMods =-    [ idOp-    ] ++ map setForeColorOp allColors-      ++ map setBackColorOp allColors-      ++ map setStyleOp allStyles--instance Arbitrary Attr where-    arbitrary = elements possibleAttrMods >>= return . flip applyOp defAttr--data DiffAttr = DiffAttr Attr Attr--instance Arbitrary DiffAttr where-    arbitrary = do-        op0 <- elements possibleAttrMods-        let possibleAttrMods' = delete op0 possibleAttrMods-        op1 <- elements possibleAttrMods'-        return $ DiffAttr (applyOp op0 defAttr) (applyOp op1 defAttr)--data AttrOp = AttrOp String (Attr -> Attr)--instance Eq AttrOp where-    AttrOp n0 _ == AttrOp n1 _ = n0 == n1--setStyleOp s     = AttrOp "set_style"      (flip withStyle s)-setForeColorOp c = AttrOp "set_fore_color" (flip withForeColor c)-setBackColorOp c = AttrOp "set_back_color" (flip withBackColor c)-idOp = AttrOp "id" id--applyOp :: AttrOp -> Attr -> Attr-applyOp (AttrOp _ f) a = f a
− test/Verify/Graphics/Vty/DisplayAttributes.hs 
@@ -1,8 +0,0 @@-module Verify.Graphics.Vty.DisplayAttributes-  ( module Verify.Graphics.Vty.DisplayAttributes-  , module Graphics.Vty.DisplayAttributes-  )-where--import Graphics.Vty.DisplayAttributes-import Verify
− test/Verify/Graphics/Vty/Image.hs 
@@ -1,218 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE DisambiguateRecordFields #-}-module Verify.Graphics.Vty.Image-  ( module Verify.Graphics.Vty.Image-  , module Graphics.Vty.Image-  )-where--import Verify.Graphics.Vty.Attributes-import Graphics.Vty.Image-import Graphics.Vty.Image.Internal--import Verify--data UnitImage = UnitImage Char Image--instance Arbitrary UnitImage where-    arbitrary = do-        SingleColumnChar c <- arbitrary-        a <- arbitrary-        return $ UnitImage c (char a c)--instance Show UnitImage where-    show (UnitImage c _) = "UnitImage " ++ show c--data DefaultImage = DefaultImage Image--instance Show DefaultImage where-    show (DefaultImage i)-        = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i)--instance Arbitrary DefaultImage where-    arbitrary = do-        i <- return $ char defAttr 'X'-        return $ DefaultImage i--data SingleRowSingleAttrImage-    = SingleRowSingleAttrImage-      { expectedAttr :: Attr-      , expectedColumns :: Int-      , rowImage :: Image-      }--instance Show SingleRowSingleAttrImage where-    show (SingleRowSingleAttrImage attr columns image)-        = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"--newtype WidthResize = WidthResize (Image -> (Image, Int))--instance Arbitrary WidthResize where-    arbitrary = do-        WidthResize f <- arbitrary-        w <- choose (1,64)-        oneof $ map (return . WidthResize)-            [ \i -> (i, imageWidth i)-            , \i -> (resizeWidth w $ fst $ f i, w)-            , \i -> let i' = fst $ f i in (cropLeft w i', min (imageWidth i') w)-            , \i -> let i' = fst $ f i in (cropRight w i', min (imageWidth i') w)-            ]--newtype HeightResize = HeightResize (Image -> (Image, Int))--instance Arbitrary HeightResize where-    arbitrary = do-        HeightResize f <- arbitrary-        h <- choose (1,64)-        oneof $ map (return . HeightResize)-            [ \i -> (i, imageHeight i)-            , \i -> (resizeHeight h $ fst $ f i, h)-            , \i -> let i' = fst $ f i in (cropTop h i', min (imageHeight i') h)-            , \i -> let i' = fst $ f i in (cropBottom h i', min (imageHeight i') h)-            ]--newtype ImageResize = ImageResize (Image -> (Image, (Int, Int)))--instance Arbitrary ImageResize where-    arbitrary = oneof-        [ return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , do-            ImageResize f <- arbitrary-            WidthResize g <- arbitrary-            return $! ImageResize $! \i ->-                let (i0, (_, outHeight)) = f i-                    gI = g i0-                in (fst gI, (snd gI, outHeight))-        , do-            ImageResize f <- arbitrary-            HeightResize g <- arbitrary-            return $! ImageResize $! \i ->-                let (i0, (outWidth, _)) = f i-                    gI = g i0-                in (fst gI, (outWidth, snd gI))-        ]---instance Arbitrary SingleRowSingleAttrImage where-    arbitrary = do-        -- The text must contain at least one character. Otherwise the-        -- image simplifies to the IdImage which has a height of 0. If-        -- this is to represent a single row then the height must be 1-        singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary)-        a <- arbitrary-        let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText]-            outWidth = length singleColumnRowText-        return $ SingleRowSingleAttrImage a outWidth outImage--data SingleRowTwoAttrImage-    = SingleRowTwoAttrImage-    { part0 :: SingleRowSingleAttrImage-    , part1 :: SingleRowSingleAttrImage-    , joinImage :: Image-    } deriving Show--instance Arbitrary SingleRowTwoAttrImage where-    arbitrary = do-        p0 <- arbitrary-        p1 <- arbitrary-        return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1)--data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack-    { stackImage :: Image-    , stackSourceImages :: [SingleRowSingleAttrImage]-    , stackWidth :: Int-    , stackHeight :: Int-    }-    deriving Show--instance Arbitrary SingleAttrSingleSpanStack where-    arbitrary = do-        imageList <- Verify.resize 16 (listOf1 arbitrary)-        return $ mkSingleAttrSingleSpanStack imageList-    shrink s = do-        imageList <- shrink $ stackSourceImages s-        if null imageList-            then []-            else return $ mkSingleAttrSingleSpanStack imageList--mkSingleAttrSingleSpanStack imageList =-    let image = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- imageList ]-    in SingleAttrSingleSpanStack image imageList (maximum $ map expectedColumns imageList)-                                                 (toEnum $ length imageList)--instance Arbitrary Image  where-    arbitrary = oneof-        [ return EmptyImage-        , do-            SingleAttrSingleSpanStack {stackImage} <- Verify.resize 8 arbitrary-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f stackImage-        , do-            SingleAttrSingleSpanStack {stackImage} <- Verify.resize 8 arbitrary-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f stackImage-        , do-            i0 <- arbitrary-            i1 <- arbitrary-            let i = i0 <|> i1-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f i-        , do-            i0 <- arbitrary-            i1 <- arbitrary-            let i = i0 <-> i1-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f i-        ]-    {--    shrink i@(HorizJoin {partLeft, partRight}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        !partLeft' <- shrink partLeft-        !partRight' <- shrink partRight-        [i_alt, partLeft' <|> partRight']-    shrink i@(VertJoin {partTop, partBottom}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        !partTop' <- shrink partTop-        !partBottom' <- shrink partBottom-        [i_alt, partTop' <-> partBottom']-    shrink i@(CropRight {croppedImage, outputWidth}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i@(CropLeft {croppedImage, leftSkip, outputWidth}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i@(CropBottom {croppedImage, outputHeight}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i@(CropTop {croppedImage, topSkip, outputHeight}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i = [emptyImage, backgroundFill (imageWidth i) (imageHeight i)]-    -}--data CropOperation-    = CropFromLeft-    | CropFromRight-    | CropFromTop-    | CropFromBottom-    deriving (Eq, Show)--instance Arbitrary CropOperation where-    arbitrary = oneof $ map return [CropFromLeft, CropFromRight, CropFromTop, CropFromBottom]--data Translation = Translation Image (Int, Int) Image-    deriving (Eq, Show)--instance Arbitrary Translation where-    arbitrary = do-        i <- arbitrary-        x <- arbitrary `suchThat` (> 0)-        y <- arbitrary `suchThat` (> 0)-        let i' = translate x y i-        return $ Translation i (x,y) i'
− test/Verify/Graphics/Vty/Output.hs 
@@ -1,59 +0,0 @@-module Verify.Graphics.Vty.Output where--import Control.Applicative ((<$>))--import Graphics.Vty.Output.Mock--import Data.IORef-import qualified Data.String.UTF8 as UTF8--import Test.QuickCheck.Property---- A list of terminals that should be supported. This started with a--- list of terminals ubuntu supported. Then those terminals that really--- could not be supported were removed. Then a few more were pruned--- until a reasonable looking set was made.-terminalsOfInterest :: [String]-terminalsOfInterest =-    [ "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"-    ]--compareMockOutput :: MockData -> String -> IO Result-compareMockOutput mockData expectedStr = do-    outStr <- UTF8.toString <$> readIORef mockData-    if outStr /=  expectedStr-        then return $ failed { reason = "bytes\n" ++ outStr-                                      ++ "\nare not the expected bytes\n"-                                      ++ expectedStr-                             }-        else return succeeded
− test/Verify/Graphics/Vty/Picture.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-module Verify.Graphics.Vty.Picture-  ( module Verify.Graphics.Vty.Picture-  , module Graphics.Vty.Picture-  )-where--import Verify.Graphics.Vty.Prelude--import Graphics.Vty.Picture-import Graphics.Vty.Debug--import Verify.Graphics.Vty.Attributes-import Verify.Graphics.Vty.Image--import Verify--data DefaultPic = DefaultPic-    { defaultPic :: Picture-    , defaultWin :: MockWindow-    }--instance Show DefaultPic where-    show (DefaultPic pic win)-        = "DefaultPic\n\t( " ++ show pic ++ ")\n\t" ++ show win ++ "\n"--instance Arbitrary DefaultPic where-    arbitrary = do-        DefaultImage image <- arbitrary-        let win = MockWindow (imageWidth image) (imageHeight image)-        return $ DefaultPic (picForImage image)-                            win--data PicWithBGAttr = PicWithBGAttr-    { withAttrPic :: Picture-    , withAttrWin :: MockWindow-    , withAttrSpecifiedAttr :: Attr-    } deriving ( Show )--instance Arbitrary PicWithBGAttr where-    arbitrary = do-        DefaultImage image <- arbitrary-        let win = MockWindow (imageWidth image) (imageHeight image)-        attr <- arbitrary-        return $ PicWithBGAttr (picForImage image)-                               win-                               attr--instance Arbitrary Picture where-    arbitrary = do-        layers <- Verify.resize 20 (listOf1 arbitrary)-        return $ picForLayers layers
− test/Verify/Graphics/Vty/Prelude.hs 
@@ -1,24 +0,0 @@-module Verify.Graphics.Vty.Prelude-  ( module Verify.Graphics.Vty.Prelude-  , MockWindow(..)-  )-where--import Graphics.Vty.Debug--import Verify--data EmptyWindow = EmptyWindow MockWindow--instance Arbitrary EmptyWindow where-    arbitrary = return $ EmptyWindow (MockWindow (0 :: Int) (0 :: Int))--instance Show EmptyWindow where-    show (EmptyWindow _) = "EmptyWindow"--instance Arbitrary MockWindow where-    arbitrary = do-        w <- choose (1,1024)-        h <- choose (1,1024)-        return $ MockWindow w h-
− test/Verify/Graphics/Vty/Span.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Verify.Graphics.Vty.Span-  ( module Verify.Graphics.Vty.Span-  , module Graphics.Vty.Span-  )-where--import Graphics.Vty.Debug-import Graphics.Vty.Span--import Verify.Graphics.Vty.Picture--import qualified Data.Vector as Vector-import Data.Word--import Verify--isAttrSpanOp :: SpanOp -> Bool-isAttrSpanOp TextSpan {} = True-isAttrSpanOp _           = False--verifyAllSpansHaveWidth i spans w-    = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)-      in case any ((== True) . fst) v of-        False -> succeeded-        True -> failed { reason = "Not all spans contained operations defining exactly "-                                ++ show w-                                ++ " columns of output - \n"-                                ++ (concatMap ((++ "\n") . show)) v-                            }--verifyOpsEquality i_ops i_alt_ops =-    if i_ops == i_alt_ops-        then succeeded-        else failed { reason = "ops for alternate image " ++ show i_alt_ops-                               ++ " are not the same as " ++ show i_ops-                    }
− test/VerifyColor240.hs 
@@ -1,269 +0,0 @@-module VerifyColor240 where--import Data.Word(Word8)-import Verify--import Graphics.Vty.Attributes.Color240(rgbColorToColor240)--oldRgbColorToColor240 :: Integral i => i -> i -> i -> Word8-oldRgbColorToColor240 r g b-    | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"-    | r == 8 && g == 8 && b == 8 = 216-    | r == 18 && g == 18 && b == 18 = 217-    | r == 28 && g == 28 && b == 28 = 218-    | r == 38 && g == 38 && b == 38 = 219-    | r == 48 && g == 48 && b == 48 = 220-    | r == 58 && g == 58 && b == 58 = 221-    | r == 68 && g == 68 && b == 68 = 222-    | r == 78 && g == 78 && b == 78 = 223-    | r == 88 && g == 88 && b == 88 = 224-    | r == 98 && g == 98 && b == 98 = 225-    | r == 108 && g == 108 && b == 108 = 226-    | r == 118 && g == 118 && b == 118 = 227-    | r == 128 && g == 128 && b == 128 = 228-    | r == 138 && g == 138 && b == 138 = 229-    | r == 148 && g == 148 && b == 148 = 230-    | r == 158 && g == 158 && b == 158 = 231-    | r == 168 && g == 168 && b == 168 = 232-    | r == 178 && g == 178 && b == 178 = 233-    | r == 188 && g == 188 && b == 188 = 234-    | r == 198 && g == 198 && b == 198 = 235-    | r == 208 && g == 208 && b == 208 = 236-    | r == 218 && g == 218 && b == 218 = 237-    | r == 228 && g == 228 && b == 228 = 238-    | r == 238 && g == 238 && b == 238 = 239-    | r <= 0 && g <= 0 && b <= 0 = 0-    | r <= 0 && g <= 0 && b <= 95 = 1-    | r <= 0 && g <= 0 && b <= 135 = 2-    | r <= 0 && g <= 0 && b <= 175 = 3-    | r <= 0 && g <= 0 && b <= 215 = 4-    | r <= 0 && g <= 0 && b <= 255 = 5-    | r <= 0 && g <= 95 && b <= 0 = 6-    | r <= 0 && g <= 95 && b <= 95 = 7-    | r <= 0 && g <= 95 && b <= 135 = 8-    | r <= 0 && g <= 95 && b <= 175 = 9-    | r <= 0 && g <= 95 && b <= 215 = 10-    | r <= 0 && g <= 95 && b <= 255 = 11-    | r <= 0 && g <= 135 && b <= 0 = 12-    | r <= 0 && g <= 135 && b <= 95 = 13-    | r <= 0 && g <= 135 && b <= 135 = 14-    | r <= 0 && g <= 135 && b <= 175 = 15-    | r <= 0 && g <= 135 && b <= 215 = 16-    | r <= 0 && g <= 135 && b <= 255 = 17-    | r <= 0 && g <= 175 && b <= 0 = 18-    | r <= 0 && g <= 175 && b <= 95 = 19-    | r <= 0 && g <= 175 && b <= 135 = 20-    | r <= 0 && g <= 175 && b <= 175 = 21-    | r <= 0 && g <= 175 && b <= 215 = 22-    | r <= 0 && g <= 175 && b <= 255 = 23-    | r <= 0 && g <= 215 && b <= 0 = 24-    | r <= 0 && g <= 215 && b <= 95 = 25-    | r <= 0 && g <= 215 && b <= 135 = 26-    | r <= 0 && g <= 215 && b <= 175 = 27-    | r <= 0 && g <= 215 && b <= 215 = 28-    | r <= 0 && g <= 215 && b <= 255 = 29-    | r <= 0 && g <= 255 && b <= 0 = 30-    | r <= 0 && g <= 255 && b <= 95 = 31-    | r <= 0 && g <= 255 && b <= 135 = 32-    | r <= 0 && g <= 255 && b <= 175 = 33-    | r <= 0 && g <= 255 && b <= 215 = 34-    | r <= 0 && g <= 255 && b <= 255 = 35-    | r <= 95 && g <= 0 && b <= 0 = 36-    | r <= 95 && g <= 0 && b <= 95 = 37-    | r <= 95 && g <= 0 && b <= 135 = 38-    | r <= 95 && g <= 0 && b <= 175 = 39-    | r <= 95 && g <= 0 && b <= 215 = 40-    | r <= 95 && g <= 0 && b <= 255 = 41-    | r <= 95 && g <= 95 && b <= 0 = 42-    | r <= 95 && g <= 95 && b <= 95 = 43-    | r <= 95 && g <= 95 && b <= 135 = 44-    | r <= 95 && g <= 95 && b <= 175 = 45-    | r <= 95 && g <= 95 && b <= 215 = 46-    | r <= 95 && g <= 95 && b <= 255 = 47-    | r <= 95 && g <= 135 && b <= 0 = 48-    | r <= 95 && g <= 135 && b <= 95 = 49-    | r <= 95 && g <= 135 && b <= 135 = 50-    | r <= 95 && g <= 135 && b <= 175 = 51-    | r <= 95 && g <= 135 && b <= 215 = 52-    | r <= 95 && g <= 135 && b <= 255 = 53-    | r <= 95 && g <= 175 && b <= 0 = 54-    | r <= 95 && g <= 175 && b <= 95 = 55-    | r <= 95 && g <= 175 && b <= 135 = 56-    | r <= 95 && g <= 175 && b <= 175 = 57-    | r <= 95 && g <= 175 && b <= 215 = 58-    | r <= 95 && g <= 175 && b <= 255 = 59-    | r <= 95 && g <= 215 && b <= 0 = 60-    | r <= 95 && g <= 215 && b <= 95 = 61-    | r <= 95 && g <= 215 && b <= 135 = 62-    | r <= 95 && g <= 215 && b <= 175 = 63-    | r <= 95 && g <= 215 && b <= 215 = 64-    | r <= 95 && g <= 215 && b <= 255 = 65-    | r <= 95 && g <= 255 && b <= 0 = 66-    | r <= 95 && g <= 255 && b <= 95 = 67-    | r <= 95 && g <= 255 && b <= 135 = 68-    | r <= 95 && g <= 255 && b <= 175 = 69-    | r <= 95 && g <= 255 && b <= 215 = 70-    | r <= 95 && g <= 255 && b <= 255 = 71-    | r <= 135 && g <= 0 && b <= 0 = 72-    | r <= 135 && g <= 0 && b <= 95 = 73-    | r <= 135 && g <= 0 && b <= 135 = 74-    | r <= 135 && g <= 0 && b <= 175 = 75-    | r <= 135 && g <= 0 && b <= 215 = 76-    | r <= 135 && g <= 0 && b <= 255 = 77-    | r <= 135 && g <= 95 && b <= 0 = 78-    | r <= 135 && g <= 95 && b <= 95 = 79-    | r <= 135 && g <= 95 && b <= 135 = 80-    | r <= 135 && g <= 95 && b <= 175 = 81-    | r <= 135 && g <= 95 && b <= 215 = 82-    | r <= 135 && g <= 95 && b <= 255 = 83-    | r <= 135 && g <= 135 && b <= 0 = 84-    | r <= 135 && g <= 135 && b <= 95 = 85-    | r <= 135 && g <= 135 && b <= 135 = 86-    | r <= 135 && g <= 135 && b <= 175 = 87-    | r <= 135 && g <= 135 && b <= 215 = 88-    | r <= 135 && g <= 135 && b <= 255 = 89-    | r <= 135 && g <= 175 && b <= 0 = 90-    | r <= 135 && g <= 175 && b <= 95 = 91-    | r <= 135 && g <= 175 && b <= 135 = 92-    | r <= 135 && g <= 175 && b <= 175 = 93-    | r <= 135 && g <= 175 && b <= 215 = 94-    | r <= 135 && g <= 175 && b <= 255 = 95-    | r <= 135 && g <= 215 && b <= 0 = 96-    | r <= 135 && g <= 215 && b <= 95 = 97-    | r <= 135 && g <= 215 && b <= 135 = 98-    | r <= 135 && g <= 215 && b <= 175 = 99-    | r <= 135 && g <= 215 && b <= 215 = 100-    | r <= 135 && g <= 215 && b <= 255 = 101-    | r <= 135 && g <= 255 && b <= 0 = 102-    | r <= 135 && g <= 255 && b <= 95 = 103-    | r <= 135 && g <= 255 && b <= 135 = 104-    | r <= 135 && g <= 255 && b <= 175 = 105-    | r <= 135 && g <= 255 && b <= 215 = 106-    | r <= 135 && g <= 255 && b <= 255 = 107-    | r <= 175 && g <= 0 && b <= 0 = 108-    | r <= 175 && g <= 0 && b <= 95 = 109-    | r <= 175 && g <= 0 && b <= 135 = 110-    | r <= 175 && g <= 0 && b <= 175 = 111-    | r <= 175 && g <= 0 && b <= 215 = 112-    | r <= 175 && g <= 0 && b <= 255 = 113-    | r <= 175 && g <= 95 && b <= 0 = 114-    | r <= 175 && g <= 95 && b <= 95 = 115-    | r <= 175 && g <= 95 && b <= 135 = 116-    | r <= 175 && g <= 95 && b <= 175 = 117-    | r <= 175 && g <= 95 && b <= 215 = 118-    | r <= 175 && g <= 95 && b <= 255 = 119-    | r <= 175 && g <= 135 && b <= 0 = 120-    | r <= 175 && g <= 135 && b <= 95 = 121-    | r <= 175 && g <= 135 && b <= 135 = 122-    | r <= 175 && g <= 135 && b <= 175 = 123-    | r <= 175 && g <= 135 && b <= 215 = 124-    | r <= 175 && g <= 135 && b <= 255 = 125-    | r <= 175 && g <= 175 && b <= 0 = 126-    | r <= 175 && g <= 175 && b <= 95 = 127-    | r <= 175 && g <= 175 && b <= 135 = 128-    | r <= 175 && g <= 175 && b <= 175 = 129-    | r <= 175 && g <= 175 && b <= 215 = 130-    | r <= 175 && g <= 175 && b <= 255 = 131-    | r <= 175 && g <= 215 && b <= 0 = 132-    | r <= 175 && g <= 215 && b <= 95 = 133-    | r <= 175 && g <= 215 && b <= 135 = 134-    | r <= 175 && g <= 215 && b <= 175 = 135-    | r <= 175 && g <= 215 && b <= 215 = 136-    | r <= 175 && g <= 215 && b <= 255 = 137-    | r <= 175 && g <= 255 && b <= 0 = 138-    | r <= 175 && g <= 255 && b <= 95 = 139-    | r <= 175 && g <= 255 && b <= 135 = 140-    | r <= 175 && g <= 255 && b <= 175 = 141-    | r <= 175 && g <= 255 && b <= 215 = 142-    | r <= 175 && g <= 255 && b <= 255 = 143-    | r <= 215 && g <= 0 && b <= 0 = 144-    | r <= 215 && g <= 0 && b <= 95 = 145-    | r <= 215 && g <= 0 && b <= 135 = 146-    | r <= 215 && g <= 0 && b <= 175 = 147-    | r <= 215 && g <= 0 && b <= 215 = 148-    | r <= 215 && g <= 0 && b <= 255 = 149-    | r <= 215 && g <= 95 && b <= 0 = 150-    | r <= 215 && g <= 95 && b <= 95 = 151-    | r <= 215 && g <= 95 && b <= 135 = 152-    | r <= 215 && g <= 95 && b <= 175 = 153-    | r <= 215 && g <= 95 && b <= 215 = 154-    | r <= 215 && g <= 95 && b <= 255 = 155-    | r <= 215 && g <= 135 && b <= 0 = 156-    | r <= 215 && g <= 135 && b <= 95 = 157-    | r <= 215 && g <= 135 && b <= 135 = 158-    | r <= 215 && g <= 135 && b <= 175 = 159-    | r <= 215 && g <= 135 && b <= 215 = 160-    | r <= 215 && g <= 135 && b <= 255 = 161-    | r <= 215 && g <= 175 && b <= 0 = 162-    | r <= 215 && g <= 175 && b <= 95 = 163-    | r <= 215 && g <= 175 && b <= 135 = 164-    | r <= 215 && g <= 175 && b <= 175 = 165-    | r <= 215 && g <= 175 && b <= 215 = 166-    | r <= 215 && g <= 175 && b <= 255 = 167-    | r <= 215 && g <= 215 && b <= 0 = 168-    | r <= 215 && g <= 215 && b <= 95 = 169-    | r <= 215 && g <= 215 && b <= 135 = 170-    | r <= 215 && g <= 215 && b <= 175 = 171-    | r <= 215 && g <= 215 && b <= 215 = 172-    | r <= 215 && g <= 215 && b <= 255 = 173-    | r <= 215 && g <= 255 && b <= 0 = 174-    | r <= 215 && g <= 255 && b <= 95 = 175-    | r <= 215 && g <= 255 && b <= 135 = 176-    | r <= 215 && g <= 255 && b <= 175 = 177-    | r <= 215 && g <= 255 && b <= 215 = 178-    | r <= 215 && g <= 255 && b <= 255 = 179-    | r <= 255 && g <= 0 && b <= 0 = 180-    | r <= 255 && g <= 0 && b <= 95 = 181-    | r <= 255 && g <= 0 && b <= 135 = 182-    | r <= 255 && g <= 0 && b <= 175 = 183-    | r <= 255 && g <= 0 && b <= 215 = 184-    | r <= 255 && g <= 0 && b <= 255 = 185-    | r <= 255 && g <= 95 && b <= 0 = 186-    | r <= 255 && g <= 95 && b <= 95 = 187-    | r <= 255 && g <= 95 && b <= 135 = 188-    | r <= 255 && g <= 95 && b <= 175 = 189-    | r <= 255 && g <= 95 && b <= 215 = 190-    | r <= 255 && g <= 95 && b <= 255 = 191-    | r <= 255 && g <= 135 && b <= 0 = 192-    | r <= 255 && g <= 135 && b <= 95 = 193-    | r <= 255 && g <= 135 && b <= 135 = 194-    | r <= 255 && g <= 135 && b <= 175 = 195-    | r <= 255 && g <= 135 && b <= 215 = 196-    | r <= 255 && g <= 135 && b <= 255 = 197-    | r <= 255 && g <= 175 && b <= 0 = 198-    | r <= 255 && g <= 175 && b <= 95 = 199-    | r <= 255 && g <= 175 && b <= 135 = 200-    | r <= 255 && g <= 175 && b <= 175 = 201-    | r <= 255 && g <= 175 && b <= 215 = 202-    | r <= 255 && g <= 175 && b <= 255 = 203-    | r <= 255 && g <= 215 && b <= 0 = 204-    | r <= 255 && g <= 215 && b <= 95 = 205-    | r <= 255 && g <= 215 && b <= 135 = 206-    | r <= 255 && g <= 215 && b <= 175 = 207-    | r <= 255 && g <= 215 && b <= 215 = 208-    | r <= 255 && g <= 215 && b <= 255 = 209-    | r <= 255 && g <= 255 && b <= 0 = 210-    | r <= 255 && g <= 255 && b <= 95 = 211-    | r <= 255 && g <= 255 && b <= 135 = 212-    | r <= 255 && g <= 255 && b <= 175 = 213-    | r <= 255 && g <= 255 && b <= 215 = 214-    | r <= 255 && g <= 255 && b <= 255 = 215-    | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."-                                (fromIntegral r :: Int)-                                (fromIntegral g :: Int)-                                (fromIntegral b :: Int))--sameColor :: Int -> Int -> Int -> Bool-sameColor r g b = oldRgbColorToColor240 r g b == rgbColorToColor240 r g b--genVal :: Gen Int-genVal = chooseInt (0, 255)--sameColorCheck :: Property-sameColorCheck = forAll genVal (\r -> forAll genVal (\g -> forAll genVal (sameColor r g)))--tests :: IO [Test]-tests = return-  [ verify "check rgbColorToColor240 optimization is correct" sameColorCheck-  ]-
− test/VerifyConfig.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module Main where--import Graphics.Vty.Config-import Graphics.Vty.Input.Events--import Data.String.QQ-import qualified Data.ByteString.Char8 as B--import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)--exampleConfig :: B.ByteString-exampleConfig = B.pack [s|--- comments should be ignored.-map _ "\ESC[B" KUp []-askfjla dfasjdflk jasdlkfj asdfj -- lines failing parse should be ignored-map _ "\ESC[1;3B" KDown [MAlt]-map "xterm" "\ESC[1;3B" KDown [MAlt]-map "xterm-256-color" "\ESC[1;3B" KDown [MAlt]-debugLog "/tmp/vty-debug.txt"-|]--exampleConfigConfig :: Config-exampleConfigConfig = defaultConfig-    { debugLog = Just "/tmp/vty-debug.txt"-    , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])-                 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])-                 , (Just "xterm", "\ESC[1;3B", EvKey KDown [MAlt])-                 , (Just "xterm-256-color", "\ESC[1;3B", EvKey KDown [MAlt])-                 ]-    }--exampleConfigParses :: IO ()-exampleConfigParses =-  assertEqual "example config parses as expected"-    exampleConfigConfig-    (runParseConfig "exampleConfig" exampleConfig)--main :: IO ()-main = defaultMain-    [ testCase "example config parses" $ exampleConfigParses-    ]
− test/VerifyCropSpanGeneration.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifyCropSpanGeneration where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Span--import Graphics.Vty.Debug-import Graphics.Vty.PictureToSpans--import Verify--import qualified Data.Vector as Vector--cropOpDisplayOps :: (Int -> Image -> Image) ->-                    Int -> Image -> (DisplayOps, Image)-cropOpDisplayOps cropOp v i =-    let iOut = cropOp v i-        p = picForImage iOut-        w = MockWindow (imageWidth iOut) (imageHeight iOut)-    in (displayOpsForPic p (regionForWindow w), iOut)--widthCropOutputColumns :: (Int -> Image -> Image) ->-                          SingleAttrSingleSpanStack ->-                          NonNegative Int ->-                          Property-widthCropOutputColumns cropOp s (NonNegative w) = stackWidth s > w ==>-    let (ops, iOut) = cropOpDisplayOps cropOp w (stackImage s)-    in verifyAllSpansHaveWidth iOut ops w--heightCropOutputColumns :: (Int -> Image -> Image) ->-                           SingleAttrSingleSpanStack ->-                           NonNegative Int ->-                           Property-heightCropOutputColumns cropOp s (NonNegative h) = stackHeight s > h ==>-    let (ops, _) = cropOpDisplayOps cropOp h (stackImage s)-    in displayOpsRows ops == h--cropRightOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropRightOutputColumns = widthCropOutputColumns cropRight--cropLeftOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropLeftOutputColumns = widthCropOutputColumns cropLeft--cropTopOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropTopOutputRows = heightCropOutputColumns cropTop--cropBottomOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropBottomOutputRows = heightCropOutputColumns cropBottom---- TODO: known benign failure.-cropRightAndLeftRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property-cropRightAndLeftRejoinedEquivalence stack = imageWidth (stackImage stack) `mod` 2 == 0 ==>-    let i = stackImage stack-        -- the right part is made by cropping the image from the left.-        iR = cropLeft (imageWidth i `div` 2) i-        -- the left part is made by cropping the image from the right-        iL = cropRight (imageWidth i `div` 2) i-        iAlt = iL <|> iR-        iOps = displayOpsForImage i-        iAltOps = displayOpsForImage iAlt-    in verifyOpsEquality iOps iAltOps--cropTopAndBottomRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property-cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod` 2 == 0 ==>-    let i = stackImage stack-        -- the top part is made by cropping the image from the bottom.-        iT = cropBottom (imageHeight i `div` 2) i-        -- the bottom part is made by cropping the image from the top.-        iB = cropTop (imageHeight i `div` 2) i-        iAlt = iT <-> iB-    in displayOpsForImage i == displayOpsForImage iAlt--tests :: IO [Test]-tests = return-    [ verify "cropping from the bottom produces display operations covering the expected rows"-        cropBottomOutputRows-    , verify "cropping from the top produces display operations covering the expected rows"-        cropTopOutputRows-    , verify "cropping from the left produces display operations covering the expected columns"-        cropLeftOutputColumns-    , verify "cropping from the right produces display operations covering the expected columns"-        cropRightOutputColumns-    -- TODO: known benign failure.-    -- , verify "the output of a stack is the same as that stack cropped left & right and joined together"-    --     cropRightAndLeftRejoinedEquivalence-    , verify "the output of a stack is the same as that stack cropped top & bottom and joined together"-        cropTopAndBottomRejoinedEquivalence-    ]
− test/VerifyDisplayAttributes.hs 
@@ -1,9 +0,0 @@-module VerifyDisplayAttributes where--import Verify.Graphics.Vty.DisplayAttributes-import Verify.Graphics.Vty.Attributes--import Verify--tests :: IO [Test]-tests = return []
− test/VerifyEmptyImageProps.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module VerifyEmptyImageProps where--import Verify---- should be exported by Graphics.Vty.Picture-import Graphics.Vty.Image ( Image, emptyImage )--tests :: IO [Test]-tests = do-    -- should provide an image type.-    let _ :: Image = emptyImage-    return []-
− test/VerifyEvalTerminfoCaps.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE ScopedTypeVariables #-}-module VerifyEvalTerminfoCaps where--import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)-import Data.Terminfo.Eval-import Data.Terminfo.Parse-import Control.DeepSeq--import qualified System.Console.Terminfo as Terminfo--import Verify-import Verify.Graphics.Vty.Output--import Control.Applicative ( (<$>) )-import Control.Exception ( try, SomeException(..) )--import Control.Monad ( mapM_, forM, forM_ )--import Data.Maybe ( fromJust )-import Data.Word--import Foreign.Marshal.Alloc (mallocBytes)-import Foreign.Ptr (Ptr, minusPtr)-import Numeric---- If a terminal defines one of the caps then it's expected to be--- parsable.-capsOfInterest =-    [ "cup"-    , "sc"-    , "rc"-    , "setf"-    , "setb"-    , "setaf"-    , "setab"-    , "op"-    , "cnorm"-    , "civis"-    , "smcup"-    , "rmcup"-    , "clear"-    , "hpa"-    , "vpa"-    , "sgr"-    , "sgr0"-    ]--fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)--tests :: IO [Test]-tests = do-    -- 1 MB should be big enough for any termcaps ;-)-    evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024)-    fmap concat $ forM terminalsOfInterest $ \termName -> do-        putStrLn $ "adding tests for terminal: " ++ termName-        mti <- try $ Terminfo.setupTerm termName-        case mti of-            Left (_e :: SomeException)-                -> return []-            Right ti -> do-                fmap concat $ forM capsOfInterest $ \capName -> do-                    case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of-                        Just capDef -> do-                            putStrLn $ "\tadding test for cap: " ++ capName-                            let testName = termName ++ "(" ++ capName ++ ")"-                            case parseCapExpression capDef of-                                Left error -> return [verify testName (failed {reason = "parse error " ++ show error})]-                                Right !cap_expr -> return [verify testName (verifyEvalCap evalBuffer cap_expr)]-                        Nothing      -> do-                            return []--{-# NOINLINE verifyEvalCap #-}-verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property-verifyEvalCap evalBuffer expr !junkInt = do-    forAll (vector 9) $ \inputValues ->-        let write = writeCapExpr expr inputValues-            !byteCount = getBound write-        in liftIOResult $ do-            let startPtr :: Ptr Word8 = evalBuffer-            forM_ [0..100] $ \i -> runWrite write startPtr-            endPtr <- runWrite write startPtr-            case endPtr `minusPtr` startPtr of-                count | count < 0        ->-                            return $ failed { reason = "End pointer before start pointer." }-                      | toEnum count > byteCount ->-                            return $ failed { reason = "End pointer past end of buffer by "-                                                       ++ show (toEnum count - byteCount)-                                            }-                      | otherwise        ->-                            return succeeded
− test/VerifyImageOps.hs 
@@ -1,174 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module VerifyImageOps where--import Graphics.Vty.Attributes-import Graphics.Vty.Image.Internal-import Verify.Graphics.Vty.Image--import Verify--import Control.DeepSeq--twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool-twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =-    imageWidth (char defAttr c1 <|> char defAttr c2) == 2--manySwHorizConcat :: [SingleColumnChar] -> Bool-manySwHorizConcat cs =-    let chars = [ char | SingleColumnChar char <- cs ]-        l = fromIntegral $ length cs-    in imageWidth ( horizCat $ map (char defAttr) chars ) == l--twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool-twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =-    imageHeight (char defAttr c1 <-> char defAttr c2) == 2--horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool-horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =-    (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2-    ==-    char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)--twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool-twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =-    imageWidth (char defAttr c1 <|> char defAttr c2) == 4--manyDwHorizConcat :: [DoubleColumnChar] -> Bool-manyDwHorizConcat cs =-    let chars = [ char | DoubleColumnChar char <- cs ]-        l = fromIntegral $ length cs-    in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2--twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool-twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =-    imageHeight (char defAttr c1 <-> char defAttr c2) == 2--horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool-horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =-    (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2-    ==-    char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)--vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool-vertContatSingleRow (NonEmpty stack) =-    let expectedHeight :: Int = length stack-        stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]-    in imageHeight stackImage == expectedHeight--disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage-                        -> NonEmptyList SingleRowSingleAttrImage-                        -> Bool-disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =-    let expectedHeight :: Int = max (length stack0) (length stack1)-        stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-    in imageHeight (stackImage0 <|> stackImage1) == expectedHeight---disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage-                              -> NonEmptyList SingleRowSingleAttrImage-                              -> Bool-disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =-    let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-        image = stackImage0 <|> stackImage1-        expectedHeight = imageHeight image-    in case image of-        HorizJoin {}  -> ( expectedHeight == (imageHeight $ partLeft image) )-                         &&-                         ( expectedHeight == (imageHeight $ partRight image) )-        _             -> True--disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage-                      -> NonEmptyList SingleRowSingleAttrImage-                      -> Bool-disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =-    let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)-        stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-        stack0Image = vertCat stack0Images-        stack1Image = vertCat stack1Images-        image = stack0Image <-> stack1Image-    in imageWidth image == expectedWidth--disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage-                            -> NonEmptyList SingleRowSingleAttrImage-                            -> Bool-disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =-    let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)-        stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-        stack0Image = vertCat stack0Images-        stack1Image = vertCat stack1Images-        image = stack0Image <-> stack1Image-    in case image of-        VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )-                       &&-                       ( expectedWidth == (imageWidth $ partBottom image) )-        _           -> True--translationIsLinearOnOutSize :: Translation -> Bool-translationIsLinearOnOutSize (Translation i (x,y) i') =-    imageWidth i' == imageWidth i + x && imageHeight i' == imageHeight i + y--paddingIsLinearOnOutSize :: Image -> Gen Bool-paddingIsLinearOnOutSize i = do-    l <- offset-    t <- offset-    r <- offset-    b <- offset-    let i' = pad l t r b i-    return $ imageWidth i' == imageWidth i + l + r && imageHeight i' == imageHeight i + t + b-    where offset = choose (1,1024)--cropLeftLimitsWidth :: Image -> Int -> Property-cropLeftLimitsWidth i v = v >= 0 ==>-    v >= imageWidth (cropLeft v i)--cropRightLimitsWidth :: Image -> Int -> Property-cropRightLimitsWidth i v = v >= 0 ==>-    v >= imageWidth (cropRight v i)--cropTopLimitsHeight :: Image -> Int -> Property-cropTopLimitsHeight i v = v >= 0 ==>-    v >= imageHeight (cropTop v i)--cropBottomLimitsHeight :: Image -> Int -> Property-cropBottomLimitsHeight i v = v >= 0 ==>-    v >= imageHeight (cropBottom v i)---- ridiculous tests just to satisfy my desire for nice code coverage :-P-canShowImage :: Image -> Bool-canShowImage i = length (show i) > 0--canRnfImage :: Image -> Bool-canRnfImage i = rnf i == ()--canPpImage :: Image -> Bool-canPpImage i = length (ppImageStructure i) > 0--tests :: IO [Test]-tests = return-    [ verify "twoSwHorizConcat" twoSwHorizConcat-    , verify "manySwHorizConcat" manySwHorizConcat-    , verify "twoSwVertConcat" twoSwVertConcat-    , verify "horizConcatSwAssoc" horizConcatSwAssoc-    , verify "manyDwHorizConcat" manyDwHorizConcat-    , verify "twoDwHorizConcat" twoDwHorizConcat-    , verify "twoDwVertConcat" twoDwVertConcat-    , verify "horizConcatDwAssoc" horizConcatDwAssoc-    , verify "single row vert concats to correct height" vertContatSingleRow-    , verify "disjointHeightHorizJoin" disjointHeightHorizJoin-    , verify "disjointHeightHorizJoin BG fill" disjointHeightHorizJoinBgFill-    , verify "disjointWidthVertJoin" disjointWidthVertJoin-    , verify "disjointWidthVertJoin BG fill" disjointWidthVertJoinBgFill-    , verify "translation effects output dimensions linearly" translationIsLinearOnOutSize-    , verify "padding effects output dimensions linearly" paddingIsLinearOnOutSize-    , verify "crop left limits width" cropLeftLimitsWidth-    , verify "crop right limits width" cropRightLimitsWidth-    , verify "crop top limits height" cropTopLimitsHeight-    , verify "crop bottom limits height" cropBottomLimitsHeight-    , verify "can show image" canShowImage-    , verify "can rnf image" canRnfImage-    , verify "can pp image" canPpImage-    ]
− test/VerifyImageTrans.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-module VerifyImageTrans where--import Verify.Graphics.Vty.Image--import Graphics.Vty.Image.Internal--import Verify--import Data.Word--isHorizTextOfColumns :: Image -> Int -> Bool-isHorizTextOfColumns (HorizText { outputWidth = inW }) expectedW = inW == expectedW-isHorizTextOfColumns (BGFill { outputWidth = inW }) expectedW = inW == expectedW-isHorizTextOfColumns _image _expectedW = False--verifyHorizContatWoAttrChangeSimplifies :: SingleRowSingleAttrImage -> Bool-verifyHorizContatWoAttrChangeSimplifies (SingleRowSingleAttrImage _attr charCount image) =-    isHorizTextOfColumns image charCount--verifyHorizContatWAttrChangeSimplifies :: SingleRowTwoAttrImage -> Bool-verifyHorizContatWAttrChangeSimplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 charCount0 _image0)-                                                               (SingleRowSingleAttrImage attr1 charCount1 _image1)-                                                               i-                                             )-    | charCount0 == 0 || charCount1 == 0 || attr0 == attr1 = isHorizTextOfColumns i (charCount0 + charCount1)-    | otherwise = False == isHorizTextOfColumns i (charCount0 + charCount1)--tests :: IO [Test]-tests = return-    [ verify "verifyHorizContatWoAttrChangeSimplifies" verifyHorizContatWoAttrChangeSimplifies-    , verify "verifyHorizContatWAttrChangeSimplifies" verifyHorizContatWAttrChangeSimplifies-    ]-
− test/VerifyInline.hs 
@@ -1,31 +0,0 @@-module VerifyInline where--import Graphics.Vty.Inline-import Graphics.Vty.Output-import Graphics.Vty.Output.TerminfoBased as TerminfoBased--import Verify.Graphics.Vty.Output--import Verify--import Distribution.TestSuite--import System.IO--tests :: IO [Test]-tests = concat <$> forM terminalsOfInterest (\termName -> return $-    [ Test $ TestInstance-        { name = "verify vty inline"-        , run = do-            {- disabled because I cannot get useful output out of cabal why this fails.-            nullOut <- openFile "/dev/null" WriteMode-            t <- TerminfoBased.reserveTerminal termName nullOut-            putAttrChange t $ default_all-            releaseTerminal t-            -}-            return $ Finished Pass-        , tags = []-        , options = []-        , setOption = \_ _ -> Left "no options supported"-        }-    ])
− test/VerifyLayersSpanGeneration.hs 
@@ -1,130 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifyLayersSpanGeneration where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Attributes-import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Span--import Graphics.Vty.Debug-import Graphics.Vty.PictureToSpans--import Verify--import qualified Data.Vector as Vector--largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-largerHorizSpanOcclusion row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        (iLarger, iSmaller) = if imageWidth i0 > imageWidth i1 then (i0, i1) else (i1, i0)-        expectedOps = displayOpsForImage iLarger-        p = picForLayers [iLarger, iSmaller]-        ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger)-    in verifyOpsEquality expectedOps ops---- | Two rows stacked vertical is equivalent to the first row rendered--- as the top layer and the second row rendered as a bottom layer with a--- background fill where the first row would be.-vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-vertStackLayerEquivalence0 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <-> i1-        p = picForImage i-        iLower = backgroundFill (imageWidth i0) 1 <-> i1-        pLayered = picForLayers [i0, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered--vertStackLayerEquivalence1 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-vertStackLayerEquivalence1 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <-> i1-        p = picForImage i-        iLower = i0 <-> backgroundFill (imageWidth i1) 1-        iUpper = backgroundFill (imageWidth i0) 1 <-> i1-        pLayered = picForLayers [iUpper, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered---- | Two rows horiz joined is equivalent to the first row rendered as--- the top layer and the second row rendered as a bottom layer with a--- background fill where the first row would be.-horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-horizJoinLayerEquivalence0 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <|> i1-        p = picForImage i-        iLower = backgroundFill (imageWidth i0) 1 <|> i1-        pLayered = picForLayers [i0, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered--horizJoinLayerEquivalence1 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-horizJoinLayerEquivalence1 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <|> i1-        p = picForImage i-        iLower = i0 <|> backgroundFill (imageWidth i1) 1-        iUpper = backgroundFill (imageWidth i0) 1 <|> i1-        pLayered = picForLayers [iUpper, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered--horizJoinAlternate0 :: Result-horizJoinAlternate0 =-    let size = 4-        str0 = replicate size 'a'-        str1 = replicate size 'b'-        i0 = string defAttr str0-        i1 = string defAttr str1-        i = horizCat $ zipWith horizJoin (replicate size i0) (replicate size i1)-        layer0 = horizCat $ replicate size $ i0 <|> backgroundFill size 1-        layer1 = horizCat $ replicate size $ backgroundFill size 1 <|> i1-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic (picForLayers [layer0, layer1])-                                      (imageWidth i,imageHeight i)-    in verifyOpsEquality expectedOps opsLayered--horizJoinAlternate1 :: Result-horizJoinAlternate1 =-    let size = 4-        str0 = replicate size 'a'-        str1 = replicate size 'b'-        i0 = string defAttr str0-        i1 = string defAttr str1-        i = horizCat $ zipWith horizJoin (replicate size i0) (replicate size i1)-        layers = [l | b <- take 4 [0,size*2..], let l = backgroundFill b 1 <|> i0 <|> i1]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic (picForLayers layers)-                                      (imageWidth i,imageHeight i)-    in verifyOpsEquality expectedOps opsLayered--tests :: IO [Test]-tests = return-    [ verify "a larger horiz span occludes a smaller span on a lower layer"-        largerHorizSpanOcclusion-    , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"-        vertStackLayerEquivalence0-    , verify "two rows stack vertical equiv to first image layered on top of second with padding (1)"-        vertStackLayerEquivalence1-    -- , verify "two rows horiz joined equiv to first image layered on top of second with padding (0)"-    --     horizJoinLayerEquivalence0-    -- , verify "two rows horiz joined equiv to first image layered on top of second with padding (1)"-    --     horizJoinLayerEquivalence1-    -- , verify "alternating images using joins is the same as alternating images using layers (0)"-    --     horizJoinAlternate0-    -- , verify "alternating images using joins is the same as alternating images using layers (1)"-    --     horizJoinAlternate1-    ]
− test/VerifyOutput.hs 
@@ -1,58 +0,0 @@--- We setup the environment to invoke certain terminals of interest.--- This assumes appropriate definitions exist in the current environment--- for the terminals of interest.-{-# LANGUAGE ScopedTypeVariables #-}-module VerifyOutput where--import Verify--import Graphics.Vty--import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Output--import Control.Monad--import qualified System.Console.Terminfo as Terminfo-import System.Posix.IO--tests :: IO [Test]-tests = concat <$> forM terminalsOfInterest (\termName -> do-    -- check if that terminfo exists-    -- putStrLn $ "testing end to end for terminal: " ++ termName-    mti <- try $ Terminfo.setupTerm termName-    case mti of-        Left (_ :: SomeException) -> return []-        Right _ -> return [ verify ("verify " ++ termName ++ " could output a picture")-                                   (smokeTestTermNonMac termName)-                          ]-    )--smokeTestTermNonMac :: String -> Image -> Property-smokeTestTermNonMac termName i = liftIOResult $ do-    smokeTestTerm termName i--smokeTestTerm :: String -> Image -> IO Result-smokeTestTerm termName i = do-    nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags-    t <- outputForConfig $ defaultConfig-        { outputFd = Just nullOut-        , termName = Just termName-        , colorMode = Just NoColor-        }-    -- putStrLn $ "context color count: " ++ show (contextColorCount t)-    reserveDisplay t-    dc <- displayContext t (100,100)-    -- always show the cursor to produce tests for terminals with no-    -- cursor support.-    let pic = (picForImage i) { picCursor = Cursor 0 0 }-    outputPicture dc pic-    setCursorPos t 0 0-    when (supportsCursorVisibility t) $ do-        hideCursor t-        showCursor t-    releaseDisplay t-    releaseTerminal t-    closeFd nullOut-    return succeeded-
− test/VerifyParseTerminfoCaps.hs 
@@ -1,101 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE ScopedTypeVariables #-}-module VerifyParseTerminfoCaps where--import Prelude hiding ( catch )--import qualified System.Console.Terminfo as Terminfo--import Verify.Data.Terminfo.Parse-import Verify.Graphics.Vty.Output-import Verify--import Data.Maybe ( catMaybes, fromJust )-import Data.Word--import Numeric---- If a terminal defines one of the caps then it's expected to be parsable.--- TODO: reduce duplication with terminfo terminal implementation.-capsOfInterest =-    [ "cup"-    , "sc"-    , "rc"-    , "setf"-    , "setb"-    , "setaf"-    , "setab"-    , "op"-    , "cnorm"-    , "civis"-    , "smcup"-    , "rmcup"-    , "clear"-    , "hpa"-    , "vpa"-    , "sgr"-    , "sgr0"-    ]--fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)--tests :: IO [Test]-tests = do-    parseTests <- concat <$> forM terminalsOfInterest (\termName ->-        liftIO (try $ Terminfo.setupTerm termName)-        >>= either (\(_e :: SomeException) -> return [])-                   (\ti -> concat <$> forM capsOfInterest (\capName -> do-                        let caseName = "\tparsing cap: " ++ capName-                        liftIO $ putStrLn caseName-                        return $ case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of-                            Just capDef -> [verify (caseName ++ " -> " ++ show capDef)-                                                   (verifyParseCap capDef $ const succeeded)]-                            Nothing      -> []-                    )-                   )-        )-    return $ [ verify "parse_nonParamaterizedCaps" nonParamaterizedCaps-             , verify "parse cap string with literal %" literalPercentCaps-             , verify "parse cap string with %i op" incFirstTwoCaps-             , verify "parse cap string with %pN op" pushParamCaps-             ] ++ parseTests--verifyParseCap capString onParse =-    case parseCapExpression capString of-        Left error -> failed { reason = "parse error " ++ show error }-        Right e    -> onParse e--nonParamaterizedCaps (NonParamCapString cap) = do-    verifyParseCap cap $ \e ->-        let expectedBytes = map (toEnum . fromEnum) cap-            outBytes = bytesForRange e 0 (length cap)-        in verifyBytesEqual outBytes expectedBytes--literalPercentCaps (LiteralPercentCap capString expectedBytes) = do-    verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes--incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do-    verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes--pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do-    verifyParseCap capString $ \e ->-        let outBytes = collectBytes e-            outParamCount = paramCount e-        in if outParamCount == expectedParamCount-            then verifyBytesEqual outBytes expectedBytes-            else failed { reason = "out param count /= expected param count" }--decPrintParamCaps (DecPrintCap capString expectedParamCount expectedBytes) = do-    verifyParseCap capString $ \e ->-        let outBytes = collectBytes e-            outParamCount = paramCount e-        in if outParamCount == expectedParamCount-            then verifyBytesEqual outBytes expectedBytes-            else failed { reason = "out param count /= expected param count" }--printCap ti capName = do-    putStrLn $ capName ++ ": " ++ show (fromCapname ti capName)--printExpression ti capName = do-    let parseResult = parseCapExpression $ fromCapname ti capName-    putStrLn $ capName ++ ": " ++ show parseResult
− test/VerifySimpleSpanGeneration.hs 
@@ -1,188 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifySimpleSpanGeneration where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Span--import Graphics.Vty.Debug-import Graphics.Vty.PictureToSpans--import Verify--import qualified Data.Vector as Vector--unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool-unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in displayOpsColumns ops == 0 && displayOpsRows ops == 0--unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool-unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )--horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool-horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in displayOpsColumns ops == 0 && displayOpsRows ops == 0--horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool-horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )--horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result-horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        w = MockWindow c 1-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth i ops c--horizSpanImageAndEqualWindow1 :: SingleRowSingleAttrImage -> Bool-horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        w = MockWindow c 1-        ops = displayOpsForPic p (regionForWindow w)-    in spanOpsAffectedRows ops == 1--horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result-horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        lesserWidth = c `div` 2-        w = MockWindow lesserWidth 1-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth i ops lesserWidth--singleAttrSingleSpanStackCropped0 :: SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackCropped0 stack =-    let p = picForImage (stackImage stack)-        w = MockWindow (stackWidth stack `div` 2) (stackHeight stack)-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack `div` 2)--singleAttrSingleSpanStackCropped1 :: SingleAttrSingleSpanStack -> Bool-singleAttrSingleSpanStackCropped1 stack =-    let p = picForImage (stackImage stack)-        expectedRowCount = stackHeight stack `div` 2-        w = MockWindow (stackWidth stack) expectedRowCount-        ops = displayOpsForPic p (regionForWindow w)-        actualRowCount = spanOpsAffectedRows ops-    in expectedRowCount == actualRowCount--singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackCropped2 stack0 stack1 =-    let p = picForImage (stackImage stack0 <|> stackImage stack1)-        w = MockWindow (stackWidth stack0) (imageHeight (picImage p))-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth (picImage p) ops (stackWidth stack0)--singleAttrSingleSpanStackCropped3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool-singleAttrSingleSpanStackCropped3 stack0 stack1 =-    let p = picForImage (stackImage stack0 <|> stackImage stack1)-        w = MockWindow (imageWidth (picImage p))  expectedRowCount-        ops = displayOpsForPic p (regionForWindow w)-        expectedRowCount = imageHeight (picImage p) `div` 2-        actualRowCount = spanOpsAffectedRows ops-    in expectedRowCount == actualRowCount--singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackCropped4 stack0 stack1 =-    let p = picForImage (stackImage stack0 <-> stackImage stack1)-        w = MockWindow expectedWidth (imageHeight (picImage p))-        ops = displayOpsForPic p (regionForWindow w)-        expectedWidth = imageWidth (picImage p) `div` 2-    in verifyAllSpansHaveWidth (picImage p) ops expectedWidth--singleAttrSingleSpanStackCropped5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool-singleAttrSingleSpanStackCropped5 stack0 stack1 =-    let p = picForImage (stackImage stack0 <-> stackImage stack1)-        w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)-        ops = displayOpsForPic p (regionForWindow w)-        expectedRowCount = stackHeight stack0-        actualRowCount = spanOpsAffectedRows ops-    in expectedRowCount == actualRowCount--horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result-horizSpanImageAndGreaterWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        -- SingleRowSingleAttrImage always has width >= 1-        greaterWidth = c * 2-        w = MockWindow greaterWidth 1-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth i ops greaterWidth--arbImageIsCropped :: DefaultImage -> MockWindow -> Bool-arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =-    let pic = picForImage image-        ops = displayOpsForPic pic (regionForWindow win)-    in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )--spanOpsActuallyFillRows :: DefaultPic -> Bool-spanOpsActuallyFillRows (DefaultPic pic win) =-    let ops = displayOpsForPic pic (regionForWindow win)-        expectedRowCount = regionHeight (regionForWindow win)-        actualRowCount = spanOpsAffectedRows ops-    in expectedRowCount == actualRowCount--spanOpsActuallyFillColumns :: DefaultPic -> Bool-spanOpsActuallyFillColumns (DefaultPic pic win) =-    let ops = displayOpsForPic pic (regionForWindow win)-        expectedColumnCount = regionWidth (regionForWindow win)-    in allSpansHaveWidth ops expectedColumnCount--firstSpanOpSetsAttr :: DefaultPic -> Bool-firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =-    let ops = displayOpsForPic pic (regionForWindow win)-    in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops )--singleAttrSingleSpanStackOpCoverage ::  SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackOpCoverage stack =-    let p = picForImage (stackImage stack)-        w = MockWindow (stackWidth stack) (stackHeight stack)-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack)--imageCoverageMatchesBounds :: Image -> Result-imageCoverageMatchesBounds i =-    let p = picForImage i-        r = (imageWidth i,imageHeight i)-        ops = displayOpsForPic p r-    in verifyAllSpansHaveWidth i ops (imageWidth i)--tests :: IO [Test]-tests = return-    [ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0-    , verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1-    , verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0-    , verify "horiz span image is cropped when window size == (0,0) [1]" horizSpanImageAndZeroWindow1-    , verify "horiz span image is not cropped when window size == size of image [width]" horizSpanImageAndEqualWindow0-    , verify "horiz span image is not cropped when window size == size of image [height]" horizSpanImageAndEqualWindow1-    , verify "horiz span image is not cropped when window size < size of image [width]" horizSpanImageAndLesserWindow0-    , verify "horiz span image is not cropped when window size > size of image [width]" horizSpanImageAndGreaterWindow0-    , verify "first span op is always to set the text attribute" firstSpanOpSetsAttr-    , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"-        singleAttrSingleSpanStackOpCoverage-    , verify "a single attr text span is cropped when window size < size of stack image [width]"-        singleAttrSingleSpanStackCropped0-    , verify "a single attr text span is cropped when window size < size of stack image [height]"-        singleAttrSingleSpanStackCropped1-    , verify "single attr text span <|> single attr text span display cropped. [width]"-        singleAttrSingleSpanStackCropped2-    , verify "single attr text span <|> single attr text span display cropped. [height]"-        singleAttrSingleSpanStackCropped3-    , verify "single attr text span <-> single attr text span display cropped. [width]"-        singleAttrSingleSpanStackCropped4-    , verify "single attr text span <-> single attr text span display cropped. [height]"-        singleAttrSingleSpanStackCropped5-    , verify "an arbitrary image when rendered to a window of the same size will cover the entire window"-        imageCoverageMatchesBounds-    ]-
− test/VerifyUsingMockInput.hs 
@@ -1,223 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}--- Generate some input bytes and delays between blocks of input bytes.--- Verify the events produced are as expected.-module Main where--import Verify.Graphics.Vty.Output--import Graphics.Vty hiding (resize)-import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Loop-import Graphics.Vty.Input.Terminfo--import Control.Concurrent-import Control.Concurrent.STM-import Control.Exception-import Lens.Micro ((^.))-import Control.Monad--import Data.IORef-import Data.List (intersperse, reverse, nubBy)--import System.Console.Terminfo-import System.Posix.IO-import System.Posix.Terminal (openPseudoTerminal)-import System.Posix.Types-import System.Timeout--import Test.Framework.Providers.SmallCheck-import Test.Framework-import Test.SmallCheck-import Test.SmallCheck.Series--import Text.Printf---- processing a block of 16 chars is the largest I can do without taking--- too long to run the test.-maxBlockSize :: Int-maxBlockSize = 16--maxTableSize :: Int-maxTableSize = 28--forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m-forEachOf l = over (generate (\n -> take n l))--data InputEvent-    = Bytes String-    -- ^ Input sequence encoded as a string. Regardless, the input is-    -- read a byte at a time.-    | Delay Int-    -- ^ Microsecond delay-    deriving Show--type InputSpec = [InputEvent]--type ExpectedSpec = [Event]--synthesizeInput :: InputSpec -> Fd -> IO ()-synthesizeInput input outHandle = forM_ input f >> (void $ fdWrite outHandle "\xFFFD")-    where-        f (Bytes str) = void $ fdWrite outHandle str-        f (Delay t) = threadDelay t--minDetectableDelay :: Int-minDetectableDelay = 4000--minTimout :: Int-minTimout = 4000000--testKeyDelay :: Int-testKeyDelay = minDetectableDelay * 4--testEscSampleDelay :: Int-testEscSampleDelay = minDetectableDelay * 2--genEventsUsingIoActions :: Int -> IO () -> IO () -> IO ()-genEventsUsingIoActions maxDuration inputAction outputAction = do-    let maxDuration' = max minTimout maxDuration-    readComplete <- newEmptyMVar-    writeComplete <- newEmptyMVar-    _ <- forkOS $ inputAction `finally` putMVar writeComplete ()-    _ <- forkOS $ outputAction `finally` putMVar readComplete ()-    Just () <- timeout maxDuration' $ takeMVar writeComplete-    Just () <- timeout maxDuration' $ takeMVar readComplete-    return ()--compareEvents :: (Show a1, Show a, Eq a1) => a -> [a1] -> [a1] -> IO Bool-compareEvents inputSpec expectedEvents outEvents = compareEvents' expectedEvents outEvents-    where-        compareEvents' [] []         = return True-        compareEvents' [] outEvents' = do-            printf "extra events %s\n" (show outEvents') :: IO ()-            return False-        compareEvents' expectedEvents' [] = do-            printf "events %s were not produced for input %s\n" (show expectedEvents') (show inputSpec) :: IO ()-            printf "expected events %s\n" (show expectedEvents) :: IO ()-            printf "received events %s\n" (show outEvents) :: IO ()-            return False-        compareEvents' (e : expectedEvents') (o : outEvents')-            | e == o    = compareEvents' expectedEvents' outEvents'-            | otherwise = do-                printf "%s expected not %s for input %s\n" (show e) (show o) (show inputSpec) :: IO ()-                printf "expected events %s\n" (show expectedEvents) :: IO ()-                printf "received events %s\n" (show outEvents) :: IO ()-                return False--assertEventsFromSynInput :: ClassifyMap -> InputSpec -> ExpectedSpec -> IO Bool-assertEventsFromSynInput table inputSpec expectedEvents = do-    let maxDuration = sum [t | Delay t <- inputSpec] + minDetectableDelay-        eventCount = length expectedEvents-    (writeFd, readFd) <- openPseudoTerminal-    (setTermAttr,_) <- attributeControl readFd-    setTermAttr-    let testConfig = defaultConfig { inputFd = Just readFd-                                   , termName = Just "dummy"-                                   , vmin = Just 1-                                   , vtime = Just 100-                                   }-    input <- initInput testConfig table-    eventsRef <- newIORef []-    let writeWaitClose = do-            synthesizeInput inputSpec writeFd-            threadDelay minDetectableDelay-            shutdownInput input-            threadDelay minDetectableDelay-            closeFd writeFd-            closeFd readFd-    -- drain output pipe-    let readEvents = readLoop eventCount-        readLoop 0 = return ()-        readLoop n = do-            e <- atomically $ readTChan $ input^.eventChannel-            case e of-                InputEvent ev -> modifyIORef eventsRef ((:) ev)-                ResumeAfterSignal -> return ()-            readLoop (n - 1)-    genEventsUsingIoActions maxDuration writeWaitClose readEvents-    outEvents <- reverse <$> readIORef eventsRef-    compareEvents inputSpec expectedEvents outEvents--newtype InputBlocksUsingTable event-    = InputBlocksUsingTable ([(String,event)] -> [(String, event)])--instance Show (InputBlocksUsingTable event) where-    show (InputBlocksUsingTable _g) = "InputBlocksUsingTable"--instance Monad m => Serial m (InputBlocksUsingTable event) where-    series = do-        n :: Int <- localDepth (const maxTableSize) series-        return $ InputBlocksUsingTable $ \raw_table ->-                 let table = reverse $ nubBy (\(s0,_) (s1,_) -> s0 == s1) $ reverse raw_table-                 in concat (take n (selections table))-        where-            selections []     = []-            selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)--verifyVisibleSynInputToEvent :: Property IO-verifyVisibleSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do-    let table    = visibleChars-        inputSeq = gen table-        events   = map snd inputSeq-        keydowns = map (Bytes . fst) inputSeq-        input    = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-    assertEventsFromSynInput universalTable input events--verifyCapsSynInputToEvent :: Property IO-verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->-    forEachOf terminalsOfInterest $ \terminalName -> monadic $ do-        term <- setupTerm terminalName-        let table         = capsClassifyMap term keysFromCapsTable-            inputSeq      = gen table-            events        = map snd inputSeq-            keydowns      = map (Bytes . fst) inputSeq-            input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-        assertEventsFromSynInput table input events--verifySpecialSynInputToEvent :: Property IO-verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do-    let table         = specialSupportKeys-        inputSeq      = gen table-        events        = map snd inputSeq-        keydowns      = map (Bytes . fst) inputSeq-        input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-    assertEventsFromSynInput universalTable input events--verifyFullSynInputToEvent :: Property IO-verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->-    forEachOf terminalsOfInterest $ \terminalName -> monadic $ do-        term <- setupTerm terminalName-        let table         = classifyMapForTerm terminalName term-            inputSeq      = gen table-            events        = map snd inputSeq-            keydowns      = map (Bytes . fst) inputSeq-            input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-        assertEventsFromSynInput table input events--verifyFullSynInputToEvent_2x :: Property IO-verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->-    forEachOf terminalsOfInterest $ \terminalName -> monadic $ do-        term <- setupTerm terminalName-        let table         = classifyMapForTerm terminalName term-            inputSeq      = gen table-            events        = concatMap ((\s -> [s,s]) . snd) inputSeq-            keydowns      = map (Bytes . (\s -> s ++ s) . fst) inputSeq-            input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-        assertEventsFromSynInput table input events--main :: IO ()-main = defaultMain-    [ testProperty "synthesized typing of single visible chars translates to expected events"-        verifyVisibleSynInputToEvent-    , testProperty "synthesized typing of keys from capabilities tables translates to expected events"-        verifyCapsSynInputToEvent-    , testProperty "synthesized typing of hard coded special keys translates to expected events"-        verifySpecialSynInputToEvent-    , testProperty "synthesized typing of any key in the table translates to its paired event"-        verifyFullSynInputToEvent-    , testProperty "synthesized typing of 2x any key in the table translates to 2x paired event"-        verifyFullSynInputToEvent_2x-    ]-
− test/VerifyUsingMockTerminal.hs 
@@ -1,108 +0,0 @@-module VerifyUsingMockTerminal where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Attributes-import Verify.Graphics.Vty.Span-import Verify.Graphics.Vty.Output-import Graphics.Vty.Output-import Graphics.Vty.Output.Interface-import Graphics.Vty.Output.Mock--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--unitImageUnitBounds :: UnitImage -> Property-unitImageUnitBounds (UnitImage _ i) = liftIOResult $ do-    (_,t) <- mockTerminal (1,1)-    dc <- displayBounds t >>= displayContext t-    let pic = picForImage i-    outputPicture dc pic-    return succeeded--unitImageArbBounds :: UnitImage -> MockWindow -> Property-unitImageArbBounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do-    (_,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    let pic = picForImage i-    outputPicture dc pic-    return succeeded--singleTRow :: MockWindow -> Property-singleTRow (MockWindow w h) = liftIOResult $ do-    (mockData,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains just the character T repeated for a-    -- single row-    let i = horizCat $ replicate (fromEnum w) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- The mock output string that represents the output bytes a single-    -- line containing the T string: Followed by h - 1 lines of a change-    -- to the background attribute and then the background character-    let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T'-                 ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B')-    compareMockOutput mockData expected--manyTRows :: MockWindow -> Property-manyTRows (MockWindow w h) = liftIOResult $ do-    (mockData, t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains the character 'T' repeated for all-    -- the rows-    let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- 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 = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')-    compareMockOutput mockData expected--manyTRowsCroppedWidth :: MockWindow -> Property-manyTRowsCroppedWidth (MockWindow w h) = liftIOResult $ do-    (mockData,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains the character 'T' repeated for all-    -- the rows-    let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w * 2) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- 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 = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')-    compareMockOutput mockData expected--manyTRowsCroppedHeight :: MockWindow -> Property-manyTRowsCroppedHeight (MockWindow w h) = liftIOResult $ do-    (mockData,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains the character 'T' repeated for all-    -- the rows-    let i = vertCat $ replicate (fromEnum h * 2) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- 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 = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')-    compareMockOutput mockData expected--tests :: IO [Test]-tests = return [ verify "unitImageUnitBounds" unitImageUnitBounds-               , verify "unitImageArbBounds" unitImageArbBounds-               , verify "singleTRow" singleTRow-               , verify "manyTRows" manyTRows-               , verify "manyTRowsCroppedWidth" manyTRowsCroppedWidth-               , verify "manyTRowsCroppedHeight" manyTRowsCroppedHeight-               ]
− test/VerifyUtf8Width.hs 
@@ -1,30 +0,0 @@-module VerifyUtf8Width where--import Verify--import Graphics.Text.Width-import Graphics.Vty.Attributes-import Graphics.Vty.Picture-import Graphics.Vty.Image--swIs1Column :: SingleColumnChar -> Bool-swIs1Column (SingleColumnChar c) = imageWidth (char defAttr c) == 1--dwIs2Column :: DoubleColumnChar -> Bool-dwIs2Column (DoubleColumnChar c) = imageWidth (char defAttr c) == 2--dcStringIsEven :: NonEmptyList DoubleColumnChar -> Bool-dcStringIsEven (NonEmpty dw_list) =-    even $ safeWcswidth [ c | DoubleColumnChar c <- dw_list ]--safeWcwidthForControlChars :: Bool-safeWcwidthForControlChars = 0 == safeWcwidth '\NUL'--tests :: IO [Test]-tests = return-  [ verify "swIs1Column" swIs1Column-  , verify "dwIs2Column" dwIs2Column-  , verify "a string of double characters is an even width" dcStringIsEven-  , verify "safeWcwidth provides a width of 0 for chars without widths" safeWcwidthForControlChars-  ]-
vty.cabal view
@@ -1,5 +1,5 @@ name:                vty-version:             5.37+version:             5.38 license:             BSD3 license-file:        LICENSE author:              AUTHORS@@ -9,14 +9,13 @@ 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.+  be easy to use and to provide good support for common terminal types.   .   See the @vty-examples@ package as well as the program-  @test/interactive_terminal_test.hs@ included in the @vty@ package for-  examples on how to use the library.+  @examples/interactive_terminal_test.hs@ included in the @vty@+  repository for examples on how to use the library.   .-  Import the "Graphics.Vty" convenience module to get access to the core+  Import the @Graphics.Vty@ convenience module to get access to the core   parts of the library.   .   &#169; 2006-2007 Stefan O'Rear; BSD3 license.@@ -38,6 +37,10 @@  library   default-language:    Haskell2010+  include-dirs:        cbits+  hs-source-dirs:      src+  ghc-options:         -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10+  ghc-prof-options:    -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10   build-depends:       base >= 4.8 && < 5,                        blaze-builder >= 0.3.3.2 && < 0.5,                        bytestring,@@ -48,9 +51,7 @@                        microlens < 0.4.14,                        microlens-mtl,                        microlens-th,-                       hashable >= 1.2,-                       mtl >= 1.1.1.0 && < 2.3,-                       parallel >= 2.2 && < 3.3,+                       mtl >= 1.1.1.0 && < 2.4,                        parsec >= 2 && < 4,                        stm,                        terminfo >= 0.3 && < 0.5,@@ -68,7 +69,7 @@    exposed-modules:     Graphics.Vty                        Graphics.Vty.Attributes-                       Graphics.Vty.Attributes.Color +                       Graphics.Vty.Attributes.Color                        Graphics.Vty.Attributes.Color240                        Graphics.Vty.Config                        Graphics.Vty.Error@@ -80,7 +81,6 @@                        Graphics.Vty.Picture                        Graphics.Vty.Output                        Graphics.Text.Width-                       Codec.Binary.UTF8.Debug                        Data.Terminfo.Parse                        Data.Terminfo.Eval                        Graphics.Vty.Debug@@ -104,530 +104,46 @@                        Graphics.Vty.UnicodeWidthTable.IO                        Graphics.Vty.UnicodeWidthTable.Query                        Graphics.Vty.UnicodeWidthTable.Install--  other-modules:       Graphics.Vty.Debug.Image-                       Graphics.Vty.Input.Terminfo.ANSIVT-+  other-modules:       Graphics.Vty.Input.Terminfo.ANSIVT   c-sources:           cbits/gwinsz.c                        cbits/set_term_timing.c                        cbits/get_tty_erase.c                        cbits/mk_wcwidth.c -  include-dirs:        cbits--  hs-source-dirs:      src--  ghc-options:         -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10--  ghc-prof-options:    -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10- executable vty-build-width-table   main-is:             BuildWidthTable.hs   hs-source-dirs:      tools-   default-language:    Haskell2010   ghc-options:         -threaded -Wall    if !impl(ghc >= 8.0)     build-depends:     semigroups >= 0.16 -  build-depends:       vty,+  build-depends:       base,+                       vty,                        directory,-                       filepath,-                       base >= 4.8 && < 5+                       filepath  executable vty-mode-demo   main-is:             ModeDemo.hs   hs-source-dirs:      demos-   default-language:    Haskell2010   ghc-options:         -threaded--  build-depends:       vty,-                       base >= 4.8 && < 5,+  build-depends:       base,+                       vty,                        containers,                        microlens,                        microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3+                       mtl  executable vty-demo   main-is:             Demo.hs   hs-source-dirs:      demos-   default-language:    Haskell2010   ghc-options:         -threaded--  build-depends:       vty,-                       base >= 4.8 && < 5,+  build-depends:       base,+                       vty,                        containers,                        microlens,                        microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3--test-suite verify-using-mock-terminal-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyUsingMockTerminal--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       terminfo >= 0.3 && < 0.5,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-terminal-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyOutput--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-display-attributes-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyDisplayAttributes--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.DisplayAttributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-empty-image-props-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyEmptyImageProps--  other-modules:       Verify--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-eval-terminfo-caps-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyEvalTerminfoCaps--  other-modules:       Verify-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       blaze-builder >= 0.3.3.2 && < 0.5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-image-ops-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyImageOps--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Image--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-image-trans-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyImageTrans--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Image--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-inline-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyInline--  other-modules:       Verify-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-parse-terminfo-caps-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyParseTerminfoCaps--  other-modules:       Verify-                       Verify.Data.Terminfo.Parse-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-simple-span-generation-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifySimpleSpanGeneration--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7---test-suite verify-crop-span-generation-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyCropSpanGeneration--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7---test-suite verify-layers-span-generation-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyLayersSpanGeneration--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-color-mapping-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyColor240--  other-modules:       Verify--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-utf8-width-  default-language:    Haskell2010--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyUtf8Width--  other-modules:       Verify--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-using-mock-input-  default-language:    Haskell2010--  type:                exitcode-stdio-1.0--  hs-source-dirs:      test--  main-is:             VerifyUsingMockInput.hs--  other-modules:       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       smallcheck == 1.*,-                       quickcheck-assertions >= 0.1.1,-                       test-framework == 0.8.*,-                       test-framework-smallcheck == 0.2.*,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       microlens,-                       microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3,-                       stm,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--  ghc-options:         -threaded -Wall--test-suite verify-config-  default-language:    Haskell2010--  type:                exitcode-stdio-1.0--  hs-source-dirs:      test--  main-is:             VerifyConfig.hs--  build-depends:       vty,-                       Cabal >= 1.20,-                       HUnit,-                       QuickCheck >= 2.7,-                       smallcheck == 1.*,-                       quickcheck-assertions >= 0.1.1,-                       test-framework == 0.8.*,-                       test-framework-smallcheck == 0.2.*,-                       test-framework-hunit,-                       random >= 1.0 && < 1.3,-                       base >= 4.8 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       microlens,-                       microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3,-                       string-qq,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--  ghc-options:         -threaded -Wall+                       mtl