diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 ---- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/demos/Demo.hs b/demos/Demo.hs --- a/demos/Demo.hs +++ b/demos/Demo.hs @@ -5,6 +5,7 @@ import Control.Applicative hiding ((<|>)) import Control.Arrow +import Control.Monad import Control.Monad.RWS import Data.Sequence (Seq, (<|) ) diff --git a/src/Codec/Binary/UTF8/Debug.hs b/src/Codec/Binary/UTF8/Debug.hs deleted file mode 100644 --- a/src/Codec/Binary/UTF8/Debug.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# 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 diff --git a/src/Data/Terminfo/Eval.hs b/src/Data/Terminfo/Eval.hs --- a/src/Data/Terminfo/Eval.hs +++ b/src/Data/Terminfo/Eval.hs @@ -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 diff --git a/src/Graphics/Vty/Attributes/Color.hs b/src/Graphics/Vty/Attributes/Color.hs --- a/src/Graphics/Vty/Attributes/Color.hs +++ b/src/Graphics/Vty/Attributes/Color.hs @@ -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 diff --git a/src/Graphics/Vty/Attributes/Color240.hs b/src/Graphics/Vty/Attributes/Color240.hs --- a/src/Graphics/Vty/Attributes/Color240.hs +++ b/src/Graphics/Vty/Attributes/Color240.hs @@ -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" diff --git a/src/Graphics/Vty/Debug.hs b/src/Graphics/Vty/Debug.hs --- a/src/Graphics/Vty/Debug.hs +++ b/src/Graphics/Vty/Debug.hs @@ -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 diff --git a/src/Graphics/Vty/Debug/Image.hs b/src/Graphics/Vty/Debug/Image.hs deleted file mode 100644 --- a/src/Graphics/Vty/Debug/Image.hs +++ /dev/null @@ -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 diff --git a/src/Graphics/Vty/DisplayAttributes.hs b/src/Graphics/Vty/DisplayAttributes.hs --- a/src/Graphics/Vty/DisplayAttributes.hs +++ b/src/Graphics/Vty/DisplayAttributes.hs @@ -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 diff --git a/src/Graphics/Vty/Error.hs b/src/Graphics/Vty/Error.hs --- a/src/Graphics/Vty/Error.hs +++ b/src/Graphics/Vty/Error.hs @@ -1,4 +1,7 @@ -module Graphics.Vty.Error where +module Graphics.Vty.Error + ( VtyException(..) + ) +where -- | The type of exceptions specific to vty. -- diff --git a/src/Graphics/Vty/Image.hs b/src/Graphics/Vty/Image.hs --- a/src/Graphics/Vty/Image.hs +++ b/src/Graphics/Vty/Image.hs @@ -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 diff --git a/src/Graphics/Vty/Image/Internal.hs b/src/Graphics/Vty/Image/Internal.hs --- a/src/Graphics/Vty/Image/Internal.hs +++ b/src/Graphics/Vty/Image/Internal.hs @@ -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 '<->'. diff --git a/src/Graphics/Vty/Inline/Unsafe.hs b/src/Graphics/Vty/Inline/Unsafe.hs --- a/src/Graphics/Vty/Inline/Unsafe.hs +++ b/src/Graphics/Vty/Inline/Unsafe.hs @@ -1,6 +1,10 @@ {-# OPTIONS_HADDOCK hide #-} -module Graphics.Vty.Inline.Unsafe where +module Graphics.Vty.Inline.Unsafe + ( withOutput + , withVty + ) +where import Graphics.Vty diff --git a/src/Graphics/Vty/Input.hs b/src/Graphics/Vty/Input.hs --- a/src/Graphics/Vty/Input.hs +++ b/src/Graphics/Vty/Input.hs @@ -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) diff --git a/src/Graphics/Vty/Input/Events.hs b/src/Graphics/Vty/Input/Events.hs --- a/src/Graphics/Vty/Input/Events.hs +++ b/src/Graphics/Vty/Input/Events.hs @@ -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 diff --git a/src/Graphics/Vty/Input/Focus.hs b/src/Graphics/Vty/Input/Focus.hs --- a/src/Graphics/Vty/Input/Focus.hs +++ b/src/Graphics/Vty/Input/Focus.hs @@ -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 diff --git a/src/Graphics/Vty/Input/Loop.hs b/src/Graphics/Vty/Input/Loop.hs --- a/src/Graphics/Vty/Input/Loop.hs +++ b/src/Graphics/Vty/Input/Loop.hs @@ -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 diff --git a/src/Graphics/Vty/Input/Mouse.hs b/src/Graphics/Vty/Input/Mouse.hs --- a/src/Graphics/Vty/Input/Mouse.hs +++ b/src/Graphics/Vty/Input/Mouse.hs @@ -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 ((.&.)) diff --git a/src/Graphics/Vty/Input/Terminfo.hs b/src/Graphics/Vty/Input/Terminfo.hs --- a/src/Graphics/Vty/Input/Terminfo.hs +++ b/src/Graphics/Vty/Input/Terminfo.hs @@ -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 diff --git a/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs b/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs --- a/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs +++ b/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs @@ -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 diff --git a/src/Graphics/Vty/PictureToSpans.hs b/src/Graphics/Vty/PictureToSpans.hs --- a/src/Graphics/Vty/PictureToSpans.hs +++ b/src/Graphics/Vty/PictureToSpans.hs @@ -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) diff --git a/src/Graphics/Vty/Span.hs b/src/Graphics/Vty/Span.hs --- a/src/Graphics/Vty/Span.hs +++ b/src/Graphics/Vty/Span.hs @@ -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 diff --git a/test/Verify.hs b/test/Verify.hs deleted file mode 100644 --- a/test/Verify.hs +++ /dev/null @@ -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 diff --git a/test/Verify/Data/Terminfo/Parse.hs b/test/Verify/Data/Terminfo/Parse.hs deleted file mode 100644 --- a/test/Verify/Data/Terminfo/Parse.hs +++ /dev/null @@ -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 - ++ "]" - } diff --git a/test/Verify/Graphics/Vty/Attributes.hs b/test/Verify/Graphics/Vty/Attributes.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/Attributes.hs +++ /dev/null @@ -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 diff --git a/test/Verify/Graphics/Vty/DisplayAttributes.hs b/test/Verify/Graphics/Vty/DisplayAttributes.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/DisplayAttributes.hs +++ /dev/null @@ -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 diff --git a/test/Verify/Graphics/Vty/Image.hs b/test/Verify/Graphics/Vty/Image.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/Image.hs +++ /dev/null @@ -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' diff --git a/test/Verify/Graphics/Vty/Output.hs b/test/Verify/Graphics/Vty/Output.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/Output.hs +++ /dev/null @@ -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 diff --git a/test/Verify/Graphics/Vty/Picture.hs b/test/Verify/Graphics/Vty/Picture.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/Picture.hs +++ /dev/null @@ -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 diff --git a/test/Verify/Graphics/Vty/Prelude.hs b/test/Verify/Graphics/Vty/Prelude.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/Prelude.hs +++ /dev/null @@ -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 - diff --git a/test/Verify/Graphics/Vty/Span.hs b/test/Verify/Graphics/Vty/Span.hs deleted file mode 100644 --- a/test/Verify/Graphics/Vty/Span.hs +++ /dev/null @@ -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 - } diff --git a/test/VerifyColor240.hs b/test/VerifyColor240.hs deleted file mode 100644 --- a/test/VerifyColor240.hs +++ /dev/null @@ -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 - ] - diff --git a/test/VerifyConfig.hs b/test/VerifyConfig.hs deleted file mode 100644 --- a/test/VerifyConfig.hs +++ /dev/null @@ -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 - ] diff --git a/test/VerifyCropSpanGeneration.hs b/test/VerifyCropSpanGeneration.hs deleted file mode 100644 --- a/test/VerifyCropSpanGeneration.hs +++ /dev/null @@ -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 - ] diff --git a/test/VerifyDisplayAttributes.hs b/test/VerifyDisplayAttributes.hs deleted file mode 100644 --- a/test/VerifyDisplayAttributes.hs +++ /dev/null @@ -1,9 +0,0 @@ -module VerifyDisplayAttributes where - -import Verify.Graphics.Vty.DisplayAttributes -import Verify.Graphics.Vty.Attributes - -import Verify - -tests :: IO [Test] -tests = return [] diff --git a/test/VerifyEmptyImageProps.hs b/test/VerifyEmptyImageProps.hs deleted file mode 100644 --- a/test/VerifyEmptyImageProps.hs +++ /dev/null @@ -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 [] - diff --git a/test/VerifyEvalTerminfoCaps.hs b/test/VerifyEvalTerminfoCaps.hs deleted file mode 100644 --- a/test/VerifyEvalTerminfoCaps.hs +++ /dev/null @@ -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 diff --git a/test/VerifyImageOps.hs b/test/VerifyImageOps.hs deleted file mode 100644 --- a/test/VerifyImageOps.hs +++ /dev/null @@ -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 - ] diff --git a/test/VerifyImageTrans.hs b/test/VerifyImageTrans.hs deleted file mode 100644 --- a/test/VerifyImageTrans.hs +++ /dev/null @@ -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 - ] - diff --git a/test/VerifyInline.hs b/test/VerifyInline.hs deleted file mode 100644 --- a/test/VerifyInline.hs +++ /dev/null @@ -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" - } - ]) diff --git a/test/VerifyLayersSpanGeneration.hs b/test/VerifyLayersSpanGeneration.hs deleted file mode 100644 --- a/test/VerifyLayersSpanGeneration.hs +++ /dev/null @@ -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 - ] diff --git a/test/VerifyOutput.hs b/test/VerifyOutput.hs deleted file mode 100644 --- a/test/VerifyOutput.hs +++ /dev/null @@ -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 - diff --git a/test/VerifyParseTerminfoCaps.hs b/test/VerifyParseTerminfoCaps.hs deleted file mode 100644 --- a/test/VerifyParseTerminfoCaps.hs +++ /dev/null @@ -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 diff --git a/test/VerifySimpleSpanGeneration.hs b/test/VerifySimpleSpanGeneration.hs deleted file mode 100644 --- a/test/VerifySimpleSpanGeneration.hs +++ /dev/null @@ -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 - ] - diff --git a/test/VerifyUsingMockInput.hs b/test/VerifyUsingMockInput.hs deleted file mode 100644 --- a/test/VerifyUsingMockInput.hs +++ /dev/null @@ -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 - ] - diff --git a/test/VerifyUsingMockTerminal.hs b/test/VerifyUsingMockTerminal.hs deleted file mode 100644 --- a/test/VerifyUsingMockTerminal.hs +++ /dev/null @@ -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 - ] diff --git a/test/VerifyUtf8Width.hs b/test/VerifyUtf8Width.hs deleted file mode 100644 --- a/test/VerifyUtf8Width.hs +++ /dev/null @@ -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 - ] - diff --git a/vty.cabal b/vty.cabal --- a/vty.cabal +++ b/vty.cabal @@ -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. . © 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