From ba2b6356eaa43b3339b48fba84851346bd93b9e9 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 21 Jan 2017 22:21:58 -0800 Subject: [PATCH] Library-wide trailing whitespace cleanup --- src/Codec/Binary/UTF8/Debug.hs | 2 +- src/Data/Sequence/Extra.hs | 4 +- src/Data/Terminfo/Eval.hs | 5 +- src/Data/Terminfo/Parse.hs | 61 +++++++------- src/Graphics/Text/Width.hs | 2 +- src/Graphics/Vty.hs | 13 ++- src/Graphics/Vty/Attributes.hs | 7 +- src/Graphics/Vty/Attributes/Color.hs | 7 +- src/Graphics/Vty/Attributes/Color240.hs | 2 +- src/Graphics/Vty/Config.hs | 4 +- src/Graphics/Vty/Debug.hs | 7 +- src/Graphics/Vty/Debug/Image.hs | 2 +- src/Graphics/Vty/DisplayAttributes.hs | 2 +- src/Graphics/Vty/Image.hs | 21 +++-- src/Graphics/Vty/Image/Internal.hs | 13 ++- src/Graphics/Vty/Inline.hs | 10 +-- src/Graphics/Vty/Input.hs | 4 +- src/Graphics/Vty/Input/Classify.hs | 2 +- src/Graphics/Vty/Input/Loop.hs | 2 +- src/Graphics/Vty/Input/Terminfo.hs | 4 +- src/Graphics/Vty/Input/Terminfo/ANSIVT.hs | 7 +- src/Graphics/Vty/Output/Interface.hs | 36 ++++----- src/Graphics/Vty/Output/TerminfoBased.hs | 51 ++++++------ src/Graphics/Vty/Output/XTermColor.hs | 3 +- src/Graphics/Vty/Picture.hs | 10 +-- src/Graphics/Vty/PictureToSpans.hs | 8 +- src/Graphics/Vty/Span.hs | 8 +- test/BenchNoDiffOpt.hs | 4 +- test/BenchRenderChar.hs | 2 +- test/BenchVerticalScroll.hs | 7 +- test/ControlTable.hs | 2 +- test/Issue18.hs | 7 +- test/Makefile | 4 +- test/Verify.hs | 7 +- test/Verify/Data/Terminfo/Parse.hs | 25 +++--- test/Verify/Graphics/Vty/Attributes.hs | 5 +- test/Verify/Graphics/Vty/Image.hs | 21 +++-- test/Verify/Graphics/Vty/Output.hs | 3 +- test/Verify/Graphics/Vty/Picture.hs | 17 ++-- test/Verify/Graphics/Vty/Span.hs | 3 +- test/VerifyCropSpanGeneration.hs | 5 +- test/VerifyEvalTerminfoCaps.hs | 18 ++--- test/VerifyImageOps.hs | 51 ++++++------ test/VerifyImageTrans.hs | 2 +- test/VerifyLayersSpanGeneration.hs | 4 +- test/VerifyParseTerminfoCaps.hs | 7 +- test/VerifySimpleSpanGeneration.hs | 16 ++-- test/VerifyUsingMockTerminal.hs | 2 +- test/interactive_terminal_test.hs | 98 +++++++++++------------ 49 files changed, 291 insertions(+), 316 deletions(-) diff --git a/src/Codec/Binary/UTF8/Debug.hs b/src/Codec/Binary/UTF8/Debug.hs index 4826fd3..3e69cfa 100644 --- a/src/Codec/Binary/UTF8/Debug.hs +++ b/src/Codec/Binary/UTF8/Debug.hs @@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} -- Copyright 2009 Corey O'Connor -module Codec.Binary.UTF8.Debug +module Codec.Binary.UTF8.Debug where import Codec.Binary.UTF8.String ( encode ) diff --git a/src/Data/Sequence/Extra.hs b/src/Data/Sequence/Extra.hs index 89ba356..cab9b9c 100644 --- a/src/Data/Sequence/Extra.hs +++ b/src/Data/Sequence/Extra.hs @@ -7,7 +7,7 @@ import Data.Sequence import Control.Parallel.Strategies instance NFData a => NFData (Seq a) where - rnf = \v -> rnf' (viewl v) - where + rnf = \v -> rnf' (viewl v) + where rnf' EmptyL = () rnf' (a :< r) = rnf a >| rnf' (viewl r) diff --git a/src/Data/Terminfo/Eval.hs b/src/Data/Terminfo/Eval.hs index 641cad7..628ec88 100644 --- a/src/Data/Terminfo/Eval.hs +++ b/src/Data/Terminfo/Eval.hs @@ -83,7 +83,7 @@ writeCapOp DecOut = do p <- pop forM_ (show p) $ tell.writeWord8.toEnum.fromEnum writeCapOp CharOut = do - pop >>= tell.writeWord8.toEnum.fromEnum + pop >>= tell.writeWord8.toEnum.fromEnum writeCapOp (PushParam pn) = do readParam pn >>= push writeCapOp (PushValue v) = do @@ -91,7 +91,7 @@ writeCapOp (PushValue v) = do writeCapOp (Conditional expr parts) = do writeCapOps expr writeContitionalParts parts - where + where writeContitionalParts [] = return () writeContitionalParts ((trueOps, falseOps) : falseParts) = do -- (man 5 terminfo) @@ -137,4 +137,3 @@ writeCapOp CompareGt = do v1 <- pop v0 <- pop push $ if v0 > v1 then 1 else 0 - diff --git a/src/Data/Terminfo/Parse.hs b/src/Data/Terminfo/Parse.hs index eb21fbc..e8f88ce 100644 --- a/src/Data/Terminfo/Parse.hs +++ b/src/Data/Terminfo/Parse.hs @@ -46,13 +46,13 @@ instance Show CapExpression where hexDump = foldr (\b s -> showHex b s) "" instance NFData CapExpression where - rnf (CapExpression ops !_bytes !str !c !pOps) + rnf (CapExpression ops !_bytes !str !c !pOps) = rnf ops `seq` rnf str `seq` rnf c `seq` rnf pOps type CapParam = Word type CapOps = [CapOp] -data CapOp = +data CapOp = Bytes !Int !Int -- offset count | DecOut | CharOut -- This stores a 0-based index to the parameter. However the operation that implies this op is @@ -60,7 +60,7 @@ data CapOp = | PushParam !Word | PushValue !Word -- The conditional parts are the sequence of (%t expression, %e expression) pairs. -- The %e expression may be NOP - | Conditional + | Conditional { conditionalExpr :: !CapOps , conditionalParts :: ![(CapOps, CapOps)] } @@ -72,8 +72,8 @@ data CapOp = instance NFData CapOp where rnf (Bytes offset byteCount ) = rnf offset `seq` rnf byteCount rnf (PushParam pn) = rnf pn - rnf (PushValue v) = rnf v - rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts + rnf (PushValue v) = rnf v + rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts rnf BitwiseOr = () rnf BitwiseXOr = () rnf BitwiseAnd = () @@ -94,11 +94,11 @@ instance NFData ParamOp where rnf IncFirstTwo = () parseCapExpression :: String -> Either ParseError CapExpression -parseCapExpression capString = +parseCapExpression capString = let v = runParser capExpressionParser initialBuildState - "terminfo cap" - capString + "terminfo cap" + capString in case v of Left e -> Left e Right buildResults -> Right $ constructCapExpression capString buildResults @@ -113,21 +113,21 @@ constructCapExpression capString buildResults = , sourceString = capString , paramCount = outParamCount buildResults , paramOps = outParamOps buildResults - } + } in rnf expr `seq` expr -type CapParser a = Parsec String BuildState a +type CapParser a = Parsec String BuildState a capExpressionParser :: CapParser BuildResults capExpressionParser = do - rs <- many $ paramEscapeParser <|> bytesOpParser + rs <- many $ paramEscapeParser <|> bytesOpParser return $ mconcat rs paramEscapeParser :: CapParser BuildResults paramEscapeParser = do _ <- char '%' incOffset 1 - literalPercentParser <|> paramOpParser + literalPercentParser <|> paramOpParser literalPercentParser :: CapParser BuildResults literalPercentParser = do @@ -138,7 +138,7 @@ literalPercentParser = do paramOpParser :: CapParser BuildResults paramOpParser - = incrementOpParser + = incrementOpParser <|> pushOpParser <|> decOutParser <|> charOutParser @@ -179,16 +179,16 @@ conditionalOpParser = do _ <- char '?' incOffset 1 condPart <- manyExpr conditionalTrueParser - parts <- manyP + parts <- manyP ( do truePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser - , conditionalFalseParser + , conditionalFalseParser ] falsePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser , conditionalTrueParser ] return ( truePart, falsePart ) - ) + ) conditionalEndParser let trueParts = map fst parts @@ -208,10 +208,10 @@ conditionalOpParser = do return $ BuildResults n'' [ Conditional cond condParts ] pOps - where - manyP !p !end = choice + where + manyP !p !end = choice [ try end >> return [] - , do !v <- p + , do !v <- p !vs <- manyP p end return $! v : vs ] @@ -233,7 +233,7 @@ conditionalEndParser = do incOffset 2 bitwiseOpParser :: CapParser BuildResults -bitwiseOpParser +bitwiseOpParser = bitwiseOrParser <|> bitwiseAndParser <|> bitwiseXorParser @@ -257,9 +257,9 @@ bitwiseXorParser = do return $ BuildResults 0 [ BitwiseXOr ] [ ] arithOpParser :: CapParser BuildResults -arithOpParser - = plusOp - <|> minusOp +arithOpParser + = plusOp + <|> minusOp where plusOp = do _ <- char '+' @@ -282,10 +282,10 @@ literalIntOpParser = do return $ BuildResults 0 [ PushValue n ] [ ] compareOpParser :: CapParser BuildResults -compareOpParser +compareOpParser = compareEqOp - <|> compareLtOp - <|> compareGtOp + <|> compareLtOp + <|> compareGtOp where compareEqOp = do _ <- char '=' @@ -313,14 +313,14 @@ bytesOpParser = do charConstParser :: CapParser BuildResults charConstParser = do _ <- char '\'' - charValue <- liftM (toEnum . fromEnum) anyChar + charValue <- liftM (toEnum . fromEnum) anyChar _ <- char '\'' incOffset 3 return $ BuildResults 0 [ PushValue charValue ] [ ] -data BuildState = BuildState +data BuildState = BuildState { nextOffset :: Int - } + } incOffset :: Int -> CapParser () incOffset n = do @@ -339,10 +339,9 @@ data BuildResults = BuildResults instance Monoid BuildResults where mempty = BuildResults 0 [] [] - v0 `mappend` v1 + v0 `mappend` v1 = BuildResults { outParamCount = (outParamCount v0) `max` (outParamCount v1) , outCapOps = (outCapOps v0) `mappend` (outCapOps v1) , outParamOps = (outParamOps v0) `mappend` (outParamOps v1) } - diff --git a/src/Graphics/Text/Width.hs b/src/Graphics/Text/Width.hs index 0d8beb4..4abba1d 100644 --- a/src/Graphics/Text/Width.hs +++ b/src/Graphics/Text/Width.hs @@ -14,7 +14,7 @@ wcswidth :: String -> Int wcswidth = sum . map wcwidth -- XXX: Characters with unknown widths occupy 1 column? --- +-- -- Not sure if this is actually correct. I presume there is a replacement character that is output -- by the terminal instead of the character and this replacement character is 1 column wide. If this -- is not true for all terminals then a per-terminal replacement character width needs to be diff --git a/src/Graphics/Vty.hs b/src/Graphics/Vty.hs index d94a20c..f0a82c0 100644 --- a/src/Graphics/Vty.hs +++ b/src/Graphics/Vty.hs @@ -10,7 +10,7 @@ -- - The constructors in "Graphics.Vty.Image.Internal" should not be used. -- -- - 'Image's can be styled using 'Attr'. See "Graphics.Vty.Attributes". --- +-- -- See the vty-examples package for a number of examples. -- -- @ @@ -28,7 +28,7 @@ -- 'shutdown' vty -- 'print' (\"Last event was: \" '++' 'show' e) -- @ --- +-- -- Good sources of documentation for terminal programming are: -- -- - @@ -50,7 +50,7 @@ module Graphics.Vty ( Vty(..) , module Graphics.Vty.Picture , DisplayRegion , Mode(..) - ) + ) where import Graphics.Vty.Prelude @@ -84,7 +84,7 @@ import Data.Monoid -- when another update action is already then it's safe to call this on multiple threads. -- -- \todo Remove explicit `shutdown` requirement. -data Vty = Vty +data Vty = Vty { -- | Outputs the given Picture. Equivalent to 'outputPicture' applied to a display context -- implicitly managed by Vty. The managed display context is reset on resize. update :: Picture -> IO () @@ -101,7 +101,7 @@ data Vty = Vty , refresh :: IO () -- | Clean up after vty. -- The above methods will throw an exception if executed after this is executed. - , shutdown :: IO () + , shutdown :: IO () } -- | Set up the state object for using vty. At most one state object should be @@ -157,7 +157,7 @@ intMkVty input out = do maybe (return ()) innerUpdate mPic let gkey = do k <- atomically $ readTChan $ _eventChannel input - case k of + case k of (EvResize _ _) -> displayBounds out >>= return . (\(w,h)-> EvResize w h) _ -> return k @@ -169,4 +169,3 @@ intMkVty input out = do , refresh = innerRefresh , shutdown = shutdownIo } - diff --git a/src/Graphics/Vty/Attributes.hs b/src/Graphics/Vty/Attributes.hs index cf97f87..ee2517b 100644 --- a/src/Graphics/Vty/Attributes.hs +++ b/src/Graphics/Vty/Attributes.hs @@ -93,7 +93,7 @@ data Attr = Attr instance Monoid Attr where mempty = Attr mempty mempty mempty - mappend attr0 attr1 = + mappend attr0 attr1 = Attr ( attrStyle attr0 `mappend` attrStyle attr1 ) ( attrForeColor attr0 `mappend` attrForeColor attr1 ) ( attrBackColor attr0 `mappend` attrBackColor attr1 ) @@ -141,7 +141,7 @@ magenta= ISOColor 5 cyan = ISOColor 6 white = ISOColor 7 --- | Bright/Vivid variants of the standard 8-color ANSI +-- | Bright/Vivid variants of the standard 8-color ANSI brightBlack, brightRed, brightGreen, brightYellow :: Color brightBlue, brightMagenta, brightCyan, brightWhite :: Color brightBlack = ISOColor 8 @@ -185,7 +185,7 @@ defaultStyleMask :: Style defaultStyleMask = 0x00 styleMask :: Attr -> Word8 -styleMask attr +styleMask attr = case attrStyle attr of Default -> 0 KeepCurrent -> 0 @@ -224,4 +224,3 @@ instance Default Attr where -- set to brightMagenta. currentAttr :: Attr currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent - diff --git a/src/Graphics/Vty/Attributes/Color.hs b/src/Graphics/Vty/Attributes/Color.hs index cca182d..b11f73e 100644 --- a/src/Graphics/Vty/Attributes/Color.hs +++ b/src/Graphics/Vty/Attributes/Color.hs @@ -2,7 +2,7 @@ module Graphics.Vty.Attributes.Color where import Data.Word -- | Abstract data type representing a color. --- +-- -- Currently the foreground and background color are specified as points in either a: -- -- * 16 color palette. Where the first 8 colors are equal to the 8 colors of the ISO 6429 (ANSI) 8 @@ -10,7 +10,7 @@ import Data.Word -- -- * 240 color palette. This palette is a regular sampling of the full RGB colorspace for the first -- 224 colors. The remaining 16 colors is a greyscale palette. --- +-- -- The 8 ISO 6429 (ANSI) colors are as follows: -- -- 0. black @@ -36,7 +36,7 @@ import Data.Word -- -- If the terminal reports <= 16 colors then the 240 color palette points are only mapped to the 8 -- color pallete. I'm not sure of the RGB points for the "bright" colors which is why they are not --- addressable via the 240 color palette. +-- addressable via the 240 color palette. -- -- If the terminal reports > 16 colors then the 240 color palette points are mapped to the nearest -- points in a ("color count" - 16) subsampling of the 240 color palette. @@ -48,4 +48,3 @@ import Data.Word -- Seriously, terminal color support is INSANE. data Color = ISOColor !Word8 | Color240 !Word8 deriving ( Eq, Show, Read ) - diff --git a/src/Graphics/Vty/Attributes/Color240.hs b/src/Graphics/Vty/Attributes/Color240.hs index 052078c..0262fba 100644 --- a/src/Graphics/Vty/Attributes/Color240.hs +++ b/src/Graphics/Vty/Attributes/Color240.hs @@ -254,7 +254,7 @@ rgbColor r g b | r <= 255 && g <= 255 && b <= 175 = Color240 213 | r <= 255 && g <= 255 && b <= 215 = Color240 214 | r <= 255 && g <= 255 && b <= 255 = Color240 215 - | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette." + | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette." (fromIntegral r :: Int) (fromIntegral g :: Int) (fromIntegral b :: Int)) diff --git a/src/Graphics/Vty/Config.hs b/src/Graphics/Vty/Config.hs index 9789e18..76ce872 100644 --- a/src/Graphics/Vty/Config.hs +++ b/src/Graphics/Vty/Config.hs @@ -14,7 +14,7 @@ -- earlier. -- -- For all directives: --- +-- -- @ -- string := \"\\\"\" chars+ \"\\\"\" -- @ @@ -40,7 +40,7 @@ -- -- @ -- \"map\" term string key modifier_list --- where +-- where -- key := KEsc | KChar Char | KBS ... (same as 'Key') -- modifier_list := \"[\" modifier+ \"]\" -- modifier := MShift | MCtrl | MMeta | MAlt diff --git a/src/Graphics/Vty/Debug.hs b/src/Graphics/Vty/Debug.hs index 5d3eb8a..94ea378 100644 --- a/src/Graphics/Vty/Debug.hs +++ b/src/Graphics/Vty/Debug.hs @@ -10,10 +10,10 @@ import Graphics.Vty.Attributes import Graphics.Vty.Debug.Image import Graphics.Vty.Span -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector rowOpsEffectedColumns :: DisplayOps -> [Int] -rowOpsEffectedColumns ops +rowOpsEffectedColumns ops = Vector.toList $ Vector.map spanOpsEffectedColumns ops allSpansHaveWidth :: DisplayOps -> Int -> Bool @@ -23,7 +23,7 @@ allSpansHaveWidth ops expected spanOpsEffectedRows :: DisplayOps -> Int spanOpsEffectedRows ops = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops)) - + type SpanConstructLog = [SpanConstructEvent] data SpanConstructEvent = SpanSetAttr Attr @@ -37,4 +37,3 @@ data MockWindow = MockWindow Int Int regionForWindow :: MockWindow -> DisplayRegion regionForWindow (MockWindow w h) = (w,h) - diff --git a/src/Graphics/Vty/Debug/Image.hs b/src/Graphics/Vty/Debug/Image.hs index 2ae9e1a..0a59aba 100644 --- a/src/Graphics/Vty/Debug/Image.hs +++ b/src/Graphics/Vty/Debug/Image.hs @@ -19,7 +19,7 @@ data ImageOp = ImageOp ImageEndo ImageEndo type ImageEndo = Image -> Image debugImageOps :: [ImageOp] -debugImageOps = +debugImageOps = [ idImageOp -- , renderSingleColumnCharOp -- , renderDoubleColumnCharOp diff --git a/src/Graphics/Vty/DisplayAttributes.hs b/src/Graphics/Vty/DisplayAttributes.hs index 4270f85..b4a76cb 100644 --- a/src/Graphics/Vty/DisplayAttributes.hs +++ b/src/Graphics/Vty/DisplayAttributes.hs @@ -79,7 +79,7 @@ data DisplayColorDiff -- | Style attribute changes are transformed into a sequence of apply/removes of the individual -- attributes. -data StyleStateChange +data StyleStateChange = ApplyStandout | RemoveStandout | ApplyUnderline diff --git a/src/Graphics/Vty/Image.hs b/src/Graphics/Vty/Image.hs index 22b261e..1f08427 100644 --- a/src/Graphics/Vty/Image.hs +++ b/src/Graphics/Vty/Image.hs @@ -61,7 +61,7 @@ infixr 4 <-> -- | An area of the picture's bacground (See Background) of w columns and h rows. backgroundFill :: Int -> Int -> Image -backgroundFill w h +backgroundFill w h | w == 0 = EmptyImage | h == 0 = EmptyImage | otherwise = BGFill w h @@ -104,21 +104,21 @@ char a c = in HorizText a (TL.singleton c) displayWidth 1 -- | A string of characters layed out on a single row with the same display attribute. The string is --- assumed to be a sequence of ISO-10646 characters. +-- assumed to be a sequence of ISO-10646 characters. -- -- Note: depending on how the Haskell compiler represents string literals a string literal in a --- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string. +-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string. -- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry -- about the encoding format when outputting string literals. Just provide the string literal -- directly to iso10646String or string. --- +-- iso10646String :: Attr -> String -> Image iso10646String a str = let displayWidth = safeWcswidth str in HorizText a (TL.pack str) displayWidth (length str) -- | Alias for iso10646String. Since the usual case is that a literal string like "foo" is --- represented internally as a list of ISO 10646 31 bit characters. +-- represented internally as a list of ISO 10646 31 bit characters. -- -- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while -- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime @@ -131,11 +131,11 @@ string = iso10646String utf8String :: Attr -> [Word8] -> Image utf8String a bytes = utf8Bytestring a (BL.pack bytes) --- | Renders a UTF-8 encoded lazy bytestring. +-- | Renders a UTF-8 encoded lazy bytestring. utf8Bytestring :: Attr -> BL.ByteString -> Image utf8Bytestring a bs = text a (TL.decodeUtf8 bs) --- | Renders a UTF-8 encoded strict bytestring. +-- | Renders a UTF-8 encoded strict bytestring. utf8Bytestring' :: Attr -> B.ByteString -> Image utf8Bytestring' a bs = text' a (T.decodeUtf8 bs) @@ -146,14 +146,14 @@ charFill _a _c 0 _h = EmptyImage charFill _a _c _w 0 = EmptyImage charFill a c w h = vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth - where + where txt = TL.replicate (fromIntegral w) (TL.singleton c) displayWidth = safeWcwidth c * (fromIntegral w) charWidth = fromIntegral w -- | The empty image. Useful for fold combinators. These occupy no space nor define any display -- attributes. -emptyImage :: Image +emptyImage :: Image emptyImage = EmptyImage -- | pad the given image. This adds background character fills to the left, top, right, bottom. @@ -163,7 +163,7 @@ pad 0 0 0 0 i = i pad inL inT inR inB inImage | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount" | otherwise = go inL inT inR inB inImage - where + where -- TODO: uh. go 0 0 0 0 i = i go 0 0 0 b i = VertJoin i (BGFill w b) w h @@ -299,4 +299,3 @@ resizeHeight h i = case h `compare` imageHeight i of LT -> cropBottom h i EQ -> i GT -> i <-> BGFill (imageWidth i) (h - imageHeight i) - diff --git a/src/Graphics/Vty/Image/Internal.hs b/src/Graphics/Vty/Image/Internal.hs index 32fdece..b62b07f 100644 --- a/src/Graphics/Vty/Image/Internal.hs +++ b/src/Graphics/Vty/Image/Internal.hs @@ -65,7 +65,7 @@ clipText txt leftSkip rightClip = -- * a cropped image -- -- * an empty image of no size or content. -data Image = +data Image = -- | A horizontal text span has a row height of 1. HorizText { attr :: Attr @@ -80,7 +80,7 @@ data Image = -- required to be between two images of equal height. The horizJoin constructor adds background -- fills to the provided images that assure this is true for the HorizJoin value produced. | HorizJoin - { partLeft :: Image + { partLeft :: Image , partRight :: Image , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 0 , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0 @@ -136,10 +136,10 @@ data Image = } -- | The empty image -- - -- The combining operators identity constant. + -- The combining operators identity constant. -- EmptyImage <|> a = a -- EmptyImage <-> a = a - -- + -- -- Any image of zero size equals the empty image. | EmptyImage deriving (Eq, Generic) @@ -198,7 +198,7 @@ ppImageStructure inImg = go 0 inImg = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ 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` () @@ -234,7 +234,7 @@ imageHeight CropBottom { outputHeight = h } = h imageHeight CropTop { outputHeight = h } = h imageHeight EmptyImage = 0 --- | Append in the Monoid instance is equivalent to <->. +-- | Append in the Monoid instance is equivalent to <->. instance Monoid Image where mempty = EmptyImage mappend = vertJoin @@ -302,4 +302,3 @@ vertJoin i0 i1 h1 = imageHeight i1 h = h0 + h1 vertJoin _ _ = error "vertJoin applied to undefined values." - diff --git a/src/Graphics/Vty/Inline.hs b/src/Graphics/Vty/Inline.hs index a1421bd..de5836f 100644 --- a/src/Graphics/Vty/Inline.hs +++ b/src/Graphics/Vty/Inline.hs @@ -1,5 +1,5 @@ -- | The inline module provides a limited interface to changing the style of terminal output. The --- intention is for this interface to be used inline with other output systems. +-- intention is for this interface to be used inline with other output systems. -- -- The changes specified by the InlineM monad are applied to the terminals display attributes. These -- display attributes effect the display of all following text output to the terminal file @@ -11,7 +11,7 @@ -- @ -- putStr \"Not styled. \" -- putAttrChange_ $ do --- backColor red +-- backColor red -- applyStyle underline -- putStr \" Styled! \" -- putAttrChange_ $ defaultAll @@ -74,14 +74,14 @@ applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s ) -- | Attempt to remove the specified 'Style' from the display of the following text. -- --- This will fail if applyStyle for the given style has not been previously called. +-- This will fail if applyStyle for the given style has not been previously called. removeStyle :: Style -> InlineM () -removeStyle sMask = modify $ \attr -> +removeStyle sMask = modify $ \attr -> let style' = case attrStyle attr of Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used." KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used." SetTo s -> s .&. complement sMask - in attr { attrStyle = SetTo style' } + in attr { attrStyle = SetTo style' } -- | Reset the display attributes defaultAll :: InlineM () diff --git a/src/Graphics/Vty/Input.hs b/src/Graphics/Vty/Input.hs index d5ff80a..588e1ba 100644 --- a/src/Graphics/Vty/Input.hs +++ b/src/Graphics/Vty/Input.hs @@ -113,7 +113,7 @@ -- Some terminfo capabilities specify millisecond delays. (Capabilities are how terminfo describes -- the control sequence to output red, for instance) This is to account for the slow speed of -- hardcopy teletype interfaces. Cause, uh, we totally still use those. --- +-- -- The output encoding of colors and attributes are also rife with issues. -- -- == See also @@ -162,7 +162,7 @@ import Data.Monoid ((<>)) -- suspended if the output terminal cannot keep up. I presume this has little effect these -- days. I hope this means that output will be buffered if the terminal cannot keep up. In the -- old days the output might of been dropped? --- +-- -- "raw" mode is used for input. -- -- * ISIG disabled diff --git a/src/Graphics/Vty/Input/Classify.hs b/src/Graphics/Vty/Input/Classify.hs index 6b13481..22b1d4b 100644 --- a/src/Graphics/Vty/Input/Classify.hs +++ b/src/Graphics/Vty/Input/Classify.hs @@ -44,7 +44,7 @@ compile table = cl' where -- produced. -- The test verifyFullSynInputToEvent2x verifies this. -- H: There will always be one match. The prefixSet contains, by definition, all - -- prefixes of an event. + -- prefixes of an event. False -> let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of diff --git a/src/Graphics/Vty/Input/Loop.hs b/src/Graphics/Vty/Input/Loop.hs index 761d7ca..f4edf61 100644 --- a/src/Graphics/Vty/Input/Loop.hs +++ b/src/Graphics/Vty/Input/Loop.hs @@ -147,7 +147,7 @@ parseEvent = do logMsg $ "remaining: " ++ show remaining unprocessedBytes .= remaining return e - _ -> mzero + _ -> mzero dropInvalid :: InputM () dropInvalid = do diff --git a/src/Graphics/Vty/Input/Terminfo.hs b/src/Graphics/Vty/Input/Terminfo.hs index 1b4ae53..04b35d9 100644 --- a/src/Graphics/Vty/Input/Terminfo.hs +++ b/src/Graphics/Vty/Input/Terminfo.hs @@ -113,7 +113,7 @@ specialSupportKeys = -- * kcbt - back tab -- -- * kc1 - keypad left-down --- +-- -- * kc3 - keypad right-down -- -- * kdch1 - delete @@ -121,7 +121,7 @@ specialSupportKeys = -- * kcud1 - down -- -- * kend - end --- +-- -- * kent - enter -- -- * kf0 - kf63 - function keys diff --git a/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs b/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs index 90404d7..70e4d87 100644 --- a/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs +++ b/src/Graphics/Vty/Input/Terminfo/ANSIVT.hs @@ -1,5 +1,5 @@ -- | Input mappings for ANSI/VT100/VT50 terminals that is missing from terminfo. --- +-- -- Or that are sent regardless of terminfo by terminal emulators. EG: Terminal emulators will often -- use VT50 input bytes regardless of declared terminal type. This provides compatibility with -- programs that don't follow terminfo. @@ -49,8 +49,8 @@ navKeys3 = [KIns,KDel,KPageUp,KPageDown,KHome,KEnd] -- | encoding for shift plus function keys --- --- According to +-- +-- According to -- -- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html -- @@ -84,4 +84,3 @@ classifyTable = , functionKeys1 , functionKeys2 ] - diff --git a/src/Graphics/Vty/Output/Interface.hs b/src/Graphics/Vty/Output/Interface.hs index 9c82a8b..b7a8186 100644 --- a/src/Graphics/Vty/Output/Interface.hs +++ b/src/Graphics/Vty/Output/Interface.hs @@ -43,12 +43,12 @@ data Mode = Mouse deriving (Eq, Read, Show) data Output = Output - { -- | Text identifier for the output device. Used for debugging. + { -- | Text identifier for the output device. Used for debugging. terminalID :: String , releaseTerminal :: forall m. MonadIO m => m () - -- | Clear the display and initialize the terminal to some initial display state. + -- | Clear the display and initialize the terminal to some initial display state. -- - -- The expectation of a program is that the display starts in some initial state. + -- The expectation of a program is that the display starts in some initial state. -- The initial state would consist of fixed values: -- -- - cursor at top left @@ -80,7 +80,7 @@ data Output = Output , getModeStatus :: forall m. MonadIO m => Mode -> m Bool , assumedStateRef :: IORef AssumedState -- | Acquire display access to the given region of the display. - -- Currently all regions have the upper left corner of (0,0) and the lower right corner at + -- Currently all regions have the upper left corner of (0,0) and the lower right corner at -- (max displayWidth providedWidth, max displayHeight providedHeight) , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext -- | Ring the terminal bell if supported. @@ -102,7 +102,7 @@ initialAssumedState = AssumedState Nothing Nothing data DisplayContext = DisplayContext { contextDevice :: Output - -- | Provide the bounds of the display context. + -- | Provide the bounds of the display context. , contextRegion :: DisplayRegion -- | sets the output position to the specified row and column. Where the number of bytes -- required for the control codes can be specified seperate from the actual byte sequence. @@ -134,16 +134,16 @@ writeUtf8Text = writeByteString -- | Displays the given `Picture`. -- --- 0. The image is cropped to the display size. +-- 0. The image is cropped to the display size. -- -- 1. Converted into a sequence of attribute changes and text spans. --- +-- -- 2. The cursor is hidden. -- -- 3. Serialized to the display. -- -- 4. The cursor is then shown and positioned or kept hidden. --- +-- -- todo: specify possible IO exceptions. -- abstract from IO monad to a MonadIO instance. outputPicture :: MonadIO m => DisplayContext -> Picture -> m () @@ -193,7 +193,7 @@ writeOutputOps dc initialAttr diffs ops = (0, mempty, diffs) ops in out - where + where writeOutputOps' (y, out, True : diffs') spanOps = let spanOut = writeSpanOps dc y initialAttr spanOps out' = out `mappend` spanOut @@ -229,7 +229,7 @@ writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, -- needs to be translated to column, row positions. data CursorOutputMap = CursorOutputMap { charToOutputPos :: (Int, Int) -> (Int, Int) - } + } cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap cursorOutputMap spanOps _cursor = CursorOutputMap @@ -239,18 +239,18 @@ cursorOutputMap spanOps _cursor = CursorOutputMap cursorColumnOffset :: DisplayOps -> Int -> Int -> Int cursorColumnOffset ops cx cy = let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy) - (outOffset, _, _) - = Vector.foldl' ( \(d, currentCx, done) op -> + (outOffset, _, _) + = Vector.foldl' ( \(d, currentCx, done) op -> if done then (d, currentCx, done) else case spanOpHasWidth op of Nothing -> (d, currentCx, False) Just (cw, ow) -> case compare cx (currentCx + cw) of GT -> ( d + ow , currentCx + cw - , False + , False ) EQ -> ( d + ow , currentCx + cw - , True + , True ) LT -> ( d + columnsToCharOffset (cx - currentCx) op , currentCx + cw @@ -264,7 +264,7 @@ cursorColumnOffset ops cx cy = -- | Not all terminals support all display attributes. This filters a display attribute to what the -- given terminal can display. limitAttrForDisplay :: Output -> Attr -> Attr -limitAttrForDisplay t attr +limitAttrForDisplay t attr = attr { attrForeColor = clampColor $ attrForeColor attr , attrBackColor = clampColor $ attrBackColor attr } @@ -272,7 +272,7 @@ limitAttrForDisplay t attr clampColor Default = Default clampColor KeepCurrent = KeepCurrent clampColor (SetTo c) = clampColor' c - clampColor' (ISOColor v) + clampColor' (ISOColor v) | contextColorCount t < 8 = Default | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8) | otherwise = SetTo $ ISOColor v @@ -281,7 +281,7 @@ limitAttrForDisplay t attr | contextColorCount t < 8 = Default | contextColorCount t < 16 = Default | contextColorCount t <= 256 = SetTo $ Color240 v - | otherwise - = let p :: Double = fromIntegral v / 240.0 + | otherwise + = let p :: Double = fromIntegral v / 240.0 v' = floor $ p * (fromIntegral $ contextColorCount t) in SetTo $ Color240 v' diff --git a/src/Graphics/Vty/Output/TerminfoBased.hs b/src/Graphics/Vty/Output/TerminfoBased.hs index e44654e..bdf869e 100644 --- a/src/Graphics/Vty/Output/TerminfoBased.hs +++ b/src/Graphics/Vty/Output/TerminfoBased.hs @@ -50,7 +50,7 @@ import Data.Foldable (foldMap) import Data.Monoid #endif -data TerminfoCaps = TerminfoCaps +data TerminfoCaps = TerminfoCaps { smcup :: Maybe CapExpression , rmcup :: Maybe CapExpression , cup :: CapExpression @@ -77,7 +77,7 @@ data DisplayAttrCaps = DisplayAttrCaps , enterDimMode :: Maybe CapExpression , enterBoldMode :: Maybe CapExpression } - + -- kinda like: https://code.google.com/p/vim/source/browse/src/fileio.c#10422 -- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR the write will be retried. fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int @@ -99,10 +99,10 @@ sendCapToTerminal t cap capParams = do - terminfo does not support some features that would increase efficiency and improve compatibility: - - * determine the character encoding supported by the terminal. Should this be taken from the LANG - - environment variable? + - environment variable? - - * Provide independent string capabilities for all display attributes. - - + - - todo: Some display attributes like underline and bold have independent string capabilities that - should be used instead of the generic "sgr" string capability. -} @@ -113,7 +113,7 @@ reserveTerminal termName outFd = liftIO $ do -- if set foreground is not set then all color changing style attributes are filtered. msetaf <- probeCap ti "setaf" msetf <- probeCap ti "setf" - let (noColors, useAlt, setForeCap) + let (noColors, useAlt, setForeCap) = case msetaf of Just setaf -> (False, False, setaf) Nothing -> case msetf of @@ -121,7 +121,7 @@ reserveTerminal termName outFd = liftIO $ do Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName) msetab <- probeCap ti "setab" msetb <- probeCap ti "setb" - let set_back_cap + let set_back_cap = case msetab of Nothing -> case msetb of Just setb -> setb @@ -190,13 +190,13 @@ reserveTerminal termName outFd = liftIO $ do return t requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression -requireCap ti capName +requireCap ti capName = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\"" Just capStr -> parseCap capStr probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression) -probeCap ti capName +probeCap ti capName = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of Nothing -> return Nothing Just capStr -> Just <$> parseCap capStr @@ -207,11 +207,11 @@ parseCap capStr = do Left e -> fail $ show e Right cap -> return cap -currentDisplayAttrCaps :: ( Applicative m, MonadIO m ) - => Terminfo.Terminal +currentDisplayAttrCaps :: ( Applicative m, MonadIO m ) + => Terminfo.Terminal -> m DisplayAttrCaps -currentDisplayAttrCaps ti - = pure DisplayAttrCaps +currentDisplayAttrCaps ti + = pure DisplayAttrCaps <*> probeCap ti "sgr" <*> probeCap ti "smso" <*> probeCap ti "rmso" @@ -224,7 +224,7 @@ currentDisplayAttrCaps ti foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong getWindowSize :: Fd -> IO (Int,Int) -getWindowSize fd = do +getWindowSize fd = do (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd return (fromIntegral b, fromIntegral a) @@ -249,14 +249,14 @@ terminfoDisplayContext tActual terminfoCaps r = return dc -- | Portably setting the display attributes is a giant pain in the ass. -- -- If the terminal supports the sgr capability (which sets the on/off state of each style --- directly ; and, for no good reason, resets the colors to the default) this procedure is used: +-- directly ; and, for no good reason, resets the colors to the default) this procedure is used: -- -- 0. set the style attributes. This resets the fore and back color. -- -- 1, If a foreground color is to be set then set the foreground color -- -- 2. likewise with the background color --- +-- -- If the terminal does not support the sgr cap then: -- if there is a change from an applied color to the default (in either the fore or back color) -- then: @@ -290,13 +290,13 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do (styleToApplySeq $ fixedStyle attr) of -- only way to reset a color to the defaults EnterExitSeq caps -> writeDefaultAttr dc - `mappend` + `mappend` foldMap (\cap -> writeCapExpr cap []) caps `mappend` setColors -- implicitly resets the colors to the defaults - SetState state -> writeCapExpr (fromJust $ setAttrStates - $ displayAttrCaps + SetState state -> writeCapExpr (fromJust $ setAttrStates + $ displayAttrCaps $ terminfoCaps ) (sgrArgsForState state) @@ -320,12 +320,12 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do `mappend` writeColorDiff setBackColor (backColorDiff diffs) -- implicitly resets the colors to the defaults - SetState state -> writeCapExpr (fromJust $ setAttrStates + SetState state -> writeCapExpr (fromJust $ setAttrStates $ displayAttrCaps terminfoCaps ) (sgrArgsForState state) `mappend` setColors - where + where colorMap = case useAltColorMap terminfoCaps of False -> ansiColorIndex True -> altColorIndex @@ -357,7 +357,7 @@ ansiColorIndex (ISOColor v) = fromEnum v ansiColorIndex (Color240 v) = 16 + fromEnum v -- | For terminals without setaf/setab --- +-- -- See table in `man terminfo` -- Will error if not in table. altColorIndex :: Color -> Int @@ -375,7 +375,7 @@ altColorIndex (Color240 v) = 16 + fromEnum v {- | The sequence of terminfo caps to apply a given style are determined according to these rules. - - 1. The assumption is that it's preferable to use the simpler enter/exit mode capabilities than - - the full set display attribute state capability. + - the full set display attribute state capability. - - 2. If a mode is supposed to be removed but there is not an exit capability defined then the - display attributes are reset to defaults then the display attribute state is set. @@ -422,7 +422,7 @@ reqDisplayCapSeqFor caps s diffs ( False, _ ) -> EnterExitSeq $ map enterExitCap diffs -- If not all the diffs have an enter-exit cap and there is no set state cap then filter out -- all unsupported diffs and just apply the rest - ( True, False ) -> EnterExitSeq $ map enterExitCap + ( True, False ) -> EnterExitSeq $ map enterExitCap $ filter (not . noEnterExitCap) diffs -- if not all the diffs have an enter-exit can and there is a set state cap then just use -- the set state cap. @@ -469,9 +469,8 @@ styleToApplySeq s = concat , applyIfRequired ApplyDim dim , applyIfRequired ApplyBlink bold ] - where - applyIfRequired op flag + where + applyIfRequired op flag = if 0 == (flag .&. s) then [] else [op] - diff --git a/src/Graphics/Vty/Output/XTermColor.hs b/src/Graphics/Vty/Output/XTermColor.hs index 5a922b5..af5ba61 100644 --- a/src/Graphics/Vty/Output/XTermColor.hs +++ b/src/Graphics/Vty/Output/XTermColor.hs @@ -32,7 +32,7 @@ import Data.List (isInfixOf) import Data.Maybe (catMaybes) import Data.Monoid ((<>)) --- | Initialize the display to UTF-8. +-- | Initialize the display to UTF-8. reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output reserveTerminal variant outFd = liftIO $ do let flushedPut = void . fdWrite outFd @@ -112,4 +112,3 @@ xtermInlineHack :: Output -> IO () xtermInlineHack t = do let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K" outputByteBuffer t $ writeToByteString writeReset - diff --git a/src/Graphics/Vty/Picture.hs b/src/Graphics/Vty/Picture.hs index 94d9fed..a1457ed 100644 --- a/src/Graphics/Vty/Picture.hs +++ b/src/Graphics/Vty/Picture.hs @@ -11,7 +11,7 @@ import Graphics.Vty.Image import Control.DeepSeq --- | The type of images to be displayed using 'update'. +-- | The type of images to be displayed using 'update'. -- -- Can be constructed directly or using `picForImage`. Which provides an initial instance with -- reasonable defaults for picCursor and picBackground. @@ -42,7 +42,7 @@ addToBottom p i = p {picLayers = picLayers p ++ [i]} -- | Create a picture for display for the given image. The picture will not have a displayed cursor -- and no background pattern (ClearBackground) will be used. picForImage :: Image -> Picture -picForImage i = Picture +picForImage i = Picture { picCursor = NoCursor , picLayers = [i] , picBackground = ClearBackground @@ -52,17 +52,17 @@ picForImage i = Picture -- -- The picture will not have a displayed cursor and no background apttern (ClearBackgroun) will be -- used. --- +-- -- The first 'Image' is the top layer. picForLayers :: [Image] -> Picture -picForLayers is = Picture +picForLayers is = Picture { picCursor = NoCursor , picLayers = is , picBackground = ClearBackground } -- | A picture can be configured either to not show the cursor or show the cursor at the specified --- character position. +-- character position. -- -- There is not a 1 to 1 map from character positions to a row and column on the screen due to -- characters that take more than 1 column. diff --git a/src/Graphics/Vty/PictureToSpans.hs b/src/Graphics/Vty/PictureToSpans.hs index 9904487..5bffd57 100644 --- a/src/Graphics/Vty/PictureToSpans.hs +++ b/src/Graphics/Vty/PictureToSpans.hs @@ -200,7 +200,7 @@ buildSpans image outRegion = do outOps <- MVector.replicate (regionHeight outRegion) Vector.empty -- \todo I think building the span operations in display order would provide better performance. -- However, I got stuck trying to implement an algorithm that did this. This will be considered - -- as a possible future optimization. + -- as a possible future optimization. -- -- A depth first traversal of the image is performed. ordered according to the column range -- defined by the image from least to greatest. The output row ops will at least have the @@ -208,7 +208,7 @@ buildSpans image outRegion = do -- all unspecified columns. -- -- The images are made into span operations from left to right. It's possible that this could - -- easily be made to assure top to bottom output as well. + -- easily be made to assure top to bottom output as well. when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ do -- The ops builder recursively descends the image and outputs span ops that would -- display that image. The number of columns remaining in this row before exceeding the @@ -297,7 +297,7 @@ addMaybeClipped CropTop {croppedImage, topSkip} = do skipRows += topSkip addMaybeClipped croppedImage -addMaybeClippedJoin :: forall s . String +addMaybeClippedJoin :: forall s . String -> Lens BlitState BlitState Int Int -> Lens BlitState BlitState Int Int -> Lens BlitState BlitState Int Int @@ -312,7 +312,7 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do case state^.skip of s -- TODO: check if clipped in other dim. if not use addUnclipped | s > size -> put $ state & skip -~ size - | s == 0 -> if state^.remaining > i0Dim + | s == 0 -> if state^.remaining > i0Dim then do addMaybeClipped i0 put $ state & offset +~ i0Dim & remaining -~ i0Dim diff --git a/src/Graphics/Vty/Span.hs b/src/Graphics/Vty/Span.hs index 061bb27..66fb926 100644 --- a/src/Graphics/Vty/Span.hs +++ b/src/Graphics/Vty/Span.hs @@ -31,7 +31,7 @@ data SpanOp = -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width -- TextSpan [Attr] [output width in columns] [number of characters] [data] - TextSpan + TextSpan { textSpanAttr :: !Attr , textSpanOutputWidth :: !Int , textSpanCharWidth :: !Int @@ -89,7 +89,6 @@ splitOpsAt inW inOps = splitOpsAt' inW inOps , Vector.cons (Skip (w - remainingColumns)) (Vector.tail ops) ) RowEnd _ -> error "cannot split ops containing a row end" - -- | vector of span operation vectors for display. One per row of the output region. type DisplayOps = Vector SpanOps @@ -103,7 +102,7 @@ instance Show SpanOp where -- -- All spans are verified to define same number of columns. See: VerifySpanOps displayOpsColumns :: DisplayOps -> Int -displayOpsColumns ops +displayOpsColumns ops | Vector.length ops == 0 = 0 | otherwise = Vector.length $ Vector.head ops @@ -117,7 +116,7 @@ effectedRegion ops = (displayOpsColumns ops, displayOpsRows ops) -- | The number of columns a SpanOps effects. spanOpsEffectedColumns :: SpanOps -> Int spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps - where + where spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w spanOpsEffectedColumns' t (Skip w) = t + w spanOpsEffectedColumns' t (RowEnd w) = t + w @@ -135,4 +134,3 @@ columnsToCharOffset cx (TextSpan _ _ _ utf8Str) = in wcswidth (take cx str) columnsToCharOffset cx (Skip _) = cx columnsToCharOffset cx (RowEnd _) = cx - diff --git a/test/BenchNoDiffOpt.hs b/test/BenchNoDiffOpt.hs index edf3b4f..1ae975c 100644 --- a/test/BenchNoDiffOpt.hs +++ b/test/BenchNoDiffOpt.hs @@ -16,7 +16,7 @@ import System.Environment( getArgs ) import System.IO import System.Random -bench0 = do +bench0 = do let fixedGen = mkStdGen 0 setStdGen fixedGen vty <- mkVty def @@ -29,7 +29,7 @@ bench0 = do shutdown vty return $ Bench images bench -flipOut vty n image0 image1 = +flipOut vty n image0 image1 = let !pLeft = picForImage image0 !pRight = picForImage image1 wLeft 0 = return () diff --git a/test/BenchRenderChar.hs b/test/BenchRenderChar.hs index deca056..9ac8b85 100644 --- a/test/BenchRenderChar.hs +++ b/test/BenchRenderChar.hs @@ -23,7 +23,7 @@ bench0 = do shutdown vty return $ Bench testChars bench -testImageUsingChar c w h +testImageUsingChar c w h = vertCat $ replicate (fromIntegral h) $ horizCat $ map (char defAttr) (replicate (fromIntegral w) c) diff --git a/test/BenchVerticalScroll.hs b/test/BenchVerticalScroll.hs index 0e4b1cc..83f1eb3 100644 --- a/test/BenchVerticalScroll.hs +++ b/test/BenchVerticalScroll.hs @@ -14,7 +14,7 @@ import System.Environment( getArgs ) import System.IO import System.Random -bench0 = do +bench0 = do let fixedGen = mkStdGen 0 setStdGen fixedGen return $ Bench (return ()) (\() -> mkVty def >>= liftM2 (>>) run shutdown) @@ -49,13 +49,12 @@ pad :: Int -> Image -> Image pad ml img = img <|> charFill defAttr ' ' (ml - imageWidth img) 1 clines :: StdGen -> Int -> [Image] -clines g maxll = map (pad maxll . horizCat . map (uncurry string)) +clines g maxll = map (pad maxll . horizCat . map (uncurry string)) $ fold (length . snd) (lengths maxll g1) (nums g2) where (g1,g2) = split g benchgen :: DisplayRegion -> [Picture] -benchgen (w,h) +benchgen (w,h) = take 2000 $ map ((\i -> picForImage i) . vertCat . take (fromEnum h)) $ tails $ clines (mkStdGen 80) w - diff --git a/test/ControlTable.hs b/test/ControlTable.hs index a930b71..2e87dc3 100644 --- a/test/ControlTable.hs +++ b/test/ControlTable.hs @@ -5,7 +5,7 @@ import Graphics.Vty.ControlStrings import System.Console.Terminfo main = do - terminal <- setupTermFromEnv + terminal <- setupTermFromEnv controlTable <- init_controlTable terminal putStrLn $ "ANSI terminal show cursor string: " ++ show cvis putStrLn $ "Current terminal show cursor string: " ++ show (showCursorStr controlTable) diff --git a/test/Issue18.hs b/test/Issue18.hs index 4dd07dd..f3f86f6 100644 --- a/test/Issue18.hs +++ b/test/Issue18.hs @@ -13,8 +13,8 @@ main = do play vty sx sy play :: Vty -> Int -> Int -> IO () -play vty sx sy = - let +play vty sx sy = + let testScreen = pic { pCursor = NoCursor , pImage = box 10 10 } @@ -31,6 +31,5 @@ box w h = vertLine = renderFill attr '|' 1 (h - 2) horizLine = corner <|> renderHFill attr '-' (w - 2) <|> corner centerArea = vertLine <|> renderFill attr 'X' (w - 2) (h - 2) <|> vertLine - in + in horizLine <-> centerArea <-> horizLine - diff --git a/test/Makefile b/test/Makefile index 04bee8f..c841df3 100644 --- a/test/Makefile +++ b/test/Makefile @@ -45,7 +45,7 @@ all : $(VERIF_TESTS) .PHONY: $(TESTS) .SECONDEXPANSION: -$(TESTS) : +$(TESTS) : @echo running test $@ @mkdir -p results/$@ ( ghc $(GHC_PROF_ARGS) $@ \ @@ -54,7 +54,7 @@ $(TESTS) : ) .PHONY: interactive_terminal_test -interactive_terminal_test : +interactive_terminal_test : ghc $(GHC_ARGS) $@ && ./$@ .PHONY: core diff --git a/test/Verify.hs b/test/Verify.hs index 3573733..c8a3a07 100644 --- a/test/Verify.hs +++ b/test/Verify.hs @@ -35,7 +35,7 @@ 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 Test.QuickCheck.Monadic ( monadicIO ) import Text.Printf @@ -56,7 +56,7 @@ verify testName p = Test $ TestInstance case qcResult of QC.Success {..} -> return $ Finished TS.Pass QC.Failure {numShrinks,reason} -> return $ Finished - $ TS.Fail $ "After " + $ TS.Fail $ "After " ++ show numShrinks ++ " shrinks determined failure to be: " ++ show reason _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message" @@ -87,7 +87,7 @@ liftIOResult = ioProperty #if __GLASGOW_HASKELL__ <= 701 instance Random Word where - random g = + random g = let (i :: Int, g') = random g in (toEnum i, g') randomR (l,h) g = @@ -97,4 +97,3 @@ instance Random Word where 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 index 2d5d6b7..ac4527a 100644 --- a/test/Verify/Data/Terminfo/Parse.hs +++ b/test/Verify/Data/Terminfo/Parse.hs @@ -19,22 +19,22 @@ data NonParamCapString = NonParamCapString String deriving Show instance Arbitrary NonParamCapString where - arbitrary + arbitrary = ( do s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%') return $ NonParamCapString s - ) `suchThat` ( \(NonParamCapString str) -> length str < 255 ) + ) `suchThat` ( \(NonParamCapString str) -> length str < 255 ) data LiteralPercentCap = LiteralPercentCap String [Word8] deriving ( Show ) instance Arbitrary LiteralPercentCap where - arbitrary + arbitrary = ( do NonParamCapString s <- arbitrary (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s return $ LiteralPercentCap s' bytes - ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 ) + ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 ) data IncFirstTwoCap = IncFirstTwoCap String [Word8] deriving ( Show ) @@ -45,7 +45,7 @@ instance Arbitrary IncFirstTwoCap where NonParamCapString s <- arbitrary (s', bytes) <- insertEscapeOp "i" [] s return $ IncFirstTwoCap s' bytes - ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 ) + ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 ) data PushParamCap = PushParamCap String Int [Word8] deriving ( Show ) @@ -57,7 +57,7 @@ instance Arbitrary PushParamCap where n <- choose (1,9) (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s return $ PushParamCap s' n bytes - ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 ) + ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 ) data DecPrintCap = DecPrintCap String Int [Word8] deriving ( Show ) @@ -69,7 +69,7 @@ instance Arbitrary DecPrintCap where n <- choose (1,9) (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s return $ DecPrintCap s' n bytes - ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 ) + ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 ) insertEscapeOp opStr replBytes s = do insertPoints <- listOf1 $ elements [0 .. length s - 1] @@ -92,21 +92,20 @@ bytesForRange cap offset count = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap collectBytes :: CapExpression -> [Word8] -collectBytes e = concat [ bytes +collectBytes e = concat [ bytes | Bytes offset count <- capOps e , let bytes = bytesForRange e offset count ] - + verifyBytesEqual :: [Word8] -> [Word8] -> Result -verifyBytesEqual outBytes expectedBytes +verifyBytesEqual outBytes expectedBytes = if outBytes == expectedBytes then succeeded - else failed - { reason = "outBytes [" + 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 index 64062c7..d38c56b 100644 --- a/test/Verify/Graphics/Vty/Attributes.hs +++ b/test/Verify/Graphics/Vty/Attributes.hs @@ -40,8 +40,8 @@ allStyles = -- Limit the possible attributes to just a few for now. possibleAttrMods :: [ AttrOp ] -possibleAttrMods = - [ idOp +possibleAttrMods = + [ idOp ] ++ map setForeColorOp allColors ++ map setBackColorOp allColors ++ map setStyleOp allStyles @@ -70,4 +70,3 @@ idOp = AttrOp "id" id applyOp :: AttrOp -> Attr -> Attr applyOp (AttrOp _ f) a = f a - diff --git a/test/Verify/Graphics/Vty/Image.hs b/test/Verify/Graphics/Vty/Image.hs index ad83751..36abeac 100644 --- a/test/Verify/Graphics/Vty/Image.hs +++ b/test/Verify/Graphics/Vty/Image.hs @@ -26,7 +26,7 @@ instance Show UnitImage where data DefaultImage = DefaultImage Image instance Show DefaultImage where - show (DefaultImage i) + show (DefaultImage i) = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i) instance Arbitrary DefaultImage where @@ -34,15 +34,15 @@ instance Arbitrary DefaultImage where i <- return $ char defAttr 'X' return $ DefaultImage i -data SingleRowSingleAttrImage - = SingleRowSingleAttrImage +data SingleRowSingleAttrImage + = SingleRowSingleAttrImage { expectedAttr :: Attr , expectedColumns :: Int , rowImage :: Image } instance Show SingleRowSingleAttrImage where - show (SingleRowSingleAttrImage attr columns image) + show (SingleRowSingleAttrImage attr columns image) = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )" newtype WidthResize = WidthResize (Image -> (Image, Int)) @@ -84,14 +84,14 @@ instance Arbitrary ImageResize where , do ImageResize f <- arbitrary WidthResize g <- arbitrary - return $! ImageResize $! \i -> + 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 -> + return $! ImageResize $! \i -> let (i0, (outWidth, _)) = f i gI = g i0 in (fst gI, (outWidth, snd gI)) @@ -109,8 +109,8 @@ instance Arbitrary SingleRowSingleAttrImage where outWidth = length singleColumnRowText return $ SingleRowSingleAttrImage a outWidth outImage -data SingleRowTwoAttrImage - = SingleRowTwoAttrImage +data SingleRowTwoAttrImage + = SingleRowTwoAttrImage { part0 :: SingleRowSingleAttrImage , part1 :: SingleRowSingleAttrImage , joinImage :: Image @@ -122,8 +122,8 @@ instance Arbitrary SingleRowTwoAttrImage where p1 <- arbitrary return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1) -data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack - { stackImage :: Image +data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack + { stackImage :: Image , stackSourceImages :: [SingleRowSingleAttrImage] , stackWidth :: Int , stackHeight :: Int @@ -215,4 +215,3 @@ instance Arbitrary Translation where 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 index 17a4d38..866e710 100644 --- a/test/Verify/Graphics/Vty/Output.hs +++ b/test/Verify/Graphics/Vty/Output.hs @@ -15,7 +15,7 @@ import Test.QuickCheck.Property -- not be supported were removed. Then a few more were pruned until a reasonable looking set was -- made. terminalsOfInterest :: [String] -terminalsOfInterest = +terminalsOfInterest = [ "vt100" , "vt220" , "vt102" @@ -58,4 +58,3 @@ compareMockOutput mockData expectedStr = do ++ expectedStr } else return succeeded - diff --git a/test/Verify/Graphics/Vty/Picture.hs b/test/Verify/Graphics/Vty/Picture.hs index 8e9500b..b729284 100644 --- a/test/Verify/Graphics/Vty/Picture.hs +++ b/test/Verify/Graphics/Vty/Picture.hs @@ -14,9 +14,9 @@ import Verify.Graphics.Vty.Image import Verify -data DefaultPic = DefaultPic +data DefaultPic = DefaultPic { defaultPic :: Picture - , defaultWin :: MockWindow + , defaultWin :: MockWindow } instance Show DefaultPic where @@ -27,10 +27,10 @@ instance Arbitrary DefaultPic where arbitrary = do DefaultImage image <- arbitrary let win = MockWindow (imageWidth image) (imageHeight image) - return $ DefaultPic (picForImage image) - win + return $ DefaultPic (picForImage image) + win -data PicWithBGAttr = PicWithBGAttr +data PicWithBGAttr = PicWithBGAttr { withAttrPic :: Picture , withAttrWin :: MockWindow , withAttrSpecifiedAttr :: Attr @@ -41,12 +41,11 @@ instance Arbitrary PicWithBGAttr where DefaultImage image <- arbitrary let win = MockWindow (imageWidth image) (imageHeight image) attr <- arbitrary - return $ PicWithBGAttr (picForImage image) - win + 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/Span.hs b/test/Verify/Graphics/Vty/Span.hs index 5a7a1bd..45228b7 100644 --- a/test/Verify/Graphics/Vty/Span.hs +++ b/test/Verify/Graphics/Vty/Span.hs @@ -22,7 +22,7 @@ verifyAllSpansHaveWidth i spans w = let v = map (\s -> (spanOpsEffectedColumns 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 " + True -> failed { reason = "Not all spans contained operations defining exactly " ++ show w ++ " columns of output - \n" ++ (concatMap ((++ "\n") . show)) v @@ -34,4 +34,3 @@ verifyOpsEquality i_ops i_alt_ops = else failed { reason = "ops for alternate image " ++ show i_alt_ops ++ " are not the same as " ++ show i_ops } - diff --git a/test/VerifyCropSpanGeneration.hs b/test/VerifyCropSpanGeneration.hs index 86c01a8..1f3db8e 100644 --- a/test/VerifyCropSpanGeneration.hs +++ b/test/VerifyCropSpanGeneration.hs @@ -13,7 +13,7 @@ import Graphics.Vty.PictureToSpans import Verify -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector cropOpDisplayOps :: (Int -> Image -> Image) -> Int -> Image -> (DisplayOps, Image) @@ -75,7 +75,7 @@ cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod` in displayOpsForImage i == displayOpsForImage iAlt tests :: IO [Test] -tests = return +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" @@ -90,4 +90,3 @@ tests = return , verify "the output of a stack is the same as that stack cropped top & bottom and joined together" cropTopAndBottomRejoinedEquivalence ] - diff --git a/test/VerifyEvalTerminfoCaps.hs b/test/VerifyEvalTerminfoCaps.hs index 780fa49..9f31cdc 100644 --- a/test/VerifyEvalTerminfoCaps.hs +++ b/test/VerifyEvalTerminfoCaps.hs @@ -3,7 +3,7 @@ module VerifyEvalTerminfoCaps where import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound) -import Data.Terminfo.Eval +import Data.Terminfo.Eval import Data.Terminfo.Parse import Control.DeepSeq @@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, minusPtr) import Numeric -- If a terminal defines one of the caps then it's expected to be parsable. -capsOfInterest = +capsOfInterest = [ "cup" , "sc" , "rc" @@ -54,7 +54,7 @@ tests = do putStrLn $ "adding tests for terminal: " ++ termName mti <- try $ Terminfo.setupTerm termName case mti of - Left (_e :: SomeException) + Left (_e :: SomeException) -> return [] Right ti -> do fmap concat $ forM capsOfInterest $ \capName -> do @@ -71,7 +71,7 @@ tests = do {-# NOINLINE verifyEvalCap #-} verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property verifyEvalCap evalBuffer expr !junkInt = do - forAll (vector 9) $ \inputValues -> + forAll (vector 9) $ \inputValues -> let write = writeCapExpr expr inputValues !byteCount = getBound write in liftIOResult $ do @@ -79,12 +79,12 @@ verifyEvalCap evalBuffer expr !junkInt = do forM_ [0..100] $ \i -> runWrite write startPtr endPtr <- runWrite write startPtr case endPtr `minusPtr` startPtr of - count | count < 0 -> + 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) + | toEnum count > byteCount -> + return $ failed { reason = "End pointer past end of buffer by " + ++ show (toEnum count - byteCount) } - | otherwise -> + | otherwise -> return succeeded diff --git a/test/VerifyImageOps.hs b/test/VerifyImageOps.hs index 3c6127c..a8608f0 100644 --- a/test/VerifyImageOps.hs +++ b/test/VerifyImageOps.hs @@ -9,43 +9,43 @@ import Verify import Control.DeepSeq twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool -twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) = +twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) = imageWidth (char defAttr c1 <|> char defAttr c2) == 2 manySwHorizConcat :: [SingleColumnChar] -> Bool -manySwHorizConcat cs = +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) = +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 - == +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) = +twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) = imageWidth (char defAttr c1 <|> char defAttr c2) == 4 manyDwHorizConcat :: [DoubleColumnChar] -> Bool -manyDwHorizConcat cs = +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) = +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 - == +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 @@ -54,9 +54,9 @@ vertContatSingleRow (NonEmpty stack) = stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ] in imageHeight stackImage == expectedHeight -disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage - -> Bool +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 ] @@ -64,9 +64,9 @@ disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) = in imageHeight (stackImage0 <|> stackImage1) == expectedHeight -disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage - -> Bool +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 ] @@ -74,31 +74,31 @@ disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) = expectedHeight = imageHeight image in case image of HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) ) - && + && ( expectedHeight == (imageHeight $ partRight image) ) _ -> True -disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage +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 + stack0Image = vertCat stack0Images + stack1Image = vertCat stack1Images image = stack0Image <-> stack1Image in imageWidth image == expectedWidth -disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage +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 + stack0Image = vertCat stack0Images + stack1Image = vertCat stack1Images image = stack0Image <-> stack1Image in case image of VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) ) @@ -171,4 +171,3 @@ tests = return , verify "can rnf image" canRnfImage , verify "can pp image" canPpImage ] - diff --git a/test/VerifyImageTrans.hs b/test/VerifyImageTrans.hs index 19f7419..b911176 100644 --- a/test/VerifyImageTrans.hs +++ b/test/VerifyImageTrans.hs @@ -22,7 +22,7 @@ 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) diff --git a/test/VerifyLayersSpanGeneration.hs b/test/VerifyLayersSpanGeneration.hs index 130b533..e79df6f 100644 --- a/test/VerifyLayersSpanGeneration.hs +++ b/test/VerifyLayersSpanGeneration.hs @@ -13,7 +13,7 @@ import Graphics.Vty.PictureToSpans import Verify -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result largerHorizSpanOcclusion row0 row1 = @@ -109,7 +109,7 @@ horizJoinAlternate1 = in verifyOpsEquality expectedOps opsLayered tests :: IO [Test] -tests = return +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)" diff --git a/test/VerifyParseTerminfoCaps.hs b/test/VerifyParseTerminfoCaps.hs index 76b4af8..2504a6c 100644 --- a/test/VerifyParseTerminfoCaps.hs +++ b/test/VerifyParseTerminfoCaps.hs @@ -16,7 +16,7 @@ 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 = +capsOfInterest = [ "cup" , "sc" , "rc" @@ -65,7 +65,7 @@ verifyParseCap capString onParse = Right e -> onParse e nonParamaterizedCaps (NonParamCapString cap) = do - verifyParseCap cap $ \e -> + verifyParseCap cap $ \e -> let expectedBytes = map (toEnum . fromEnum) cap outBytes = bytesForRange e 0 (length cap) in verifyBytesEqual outBytes expectedBytes @@ -75,7 +75,7 @@ literalPercentCaps (LiteralPercentCap capString expectedBytes) = do 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 @@ -98,4 +98,3 @@ printCap ti capName = do printExpression ti capName = do let parseResult = parseCapExpression $ fromCapname ti capName putStrLn $ capName ++ ": " ++ show parseResult - diff --git a/test/VerifySimpleSpanGeneration.hs b/test/VerifySimpleSpanGeneration.hs index 80b4ef6..d2d05a0 100644 --- a/test/VerifySimpleSpanGeneration.hs +++ b/test/VerifySimpleSpanGeneration.hs @@ -13,28 +13,28 @@ import Graphics.Vty.PictureToSpans import Verify -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool -unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) = +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) = +unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) = let p = picForImage i ops = displayOpsForPic p (regionForWindow w) in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 ) horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool -horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) = +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) = +horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) = let p = picForImage i ops = displayOpsForPic p (regionForWindow w) in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 ) @@ -139,7 +139,7 @@ spanOpsActuallyFillColumns (DefaultPic pic win) = in allSpansHaveWidth ops expectedColumnCount firstSpanOpSetsAttr :: DefaultPic -> Bool -firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } = +firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } = let ops = displayOpsForPic pic (regionForWindow win) in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops ) @@ -158,7 +158,7 @@ imageCoverageMatchesBounds i = in verifyAllSpansHaveWidth i ops (imageWidth i) tests :: IO [Test] -tests = return +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 @@ -171,7 +171,7 @@ tests = return , 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 + 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]" diff --git a/test/VerifyUsingMockTerminal.hs b/test/VerifyUsingMockTerminal.hs index 47aa4e6..028d7fc 100644 --- a/test/VerifyUsingMockTerminal.hs +++ b/test/VerifyUsingMockTerminal.hs @@ -49,7 +49,7 @@ singleTRow (MockWindow w h) = liftIOResult $ do 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) diff --git a/test/interactive_terminal_test.hs b/test/interactive_terminal_test.hs index c9c38e0..2270f61 100644 --- a/test/interactive_terminal_test.hs +++ b/test/interactive_terminal_test.hs @@ -19,7 +19,7 @@ import Data.Monoid import Data.String.QQ import Data.Word -import Foreign.Marshal.Array +import Foreign.Marshal.Array import qualified System.Environment as Env @@ -74,12 +74,12 @@ with the test_results.list file pasted into the issue. A suitable summary is: |] waitForReturn results <- doTestMenu 1 - envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName ) - ( \ (_ :: SomeException) -> return (envName, "") ) - ) + envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName ) + ( \ (_ :: SomeException) -> return (envName, "") ) + ) [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ] t <- standardIOConfig >>= outputForConfig - let resultsTxt = show envAttributes ++ "\n" + let resultsTxt = show envAttributes ++ "\n" ++ terminalID t ++ "\n" ++ show results ++ "\n" releaseTerminal t @@ -94,7 +94,7 @@ testMenu :: [(String, Test)] testMenu = zip (map show [1..]) allTests doTestMenu :: Int -> IO [(String, Bool)] -doTestMenu nextID +doTestMenu nextID | nextID > length allTests = do putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com" return [] @@ -108,26 +108,26 @@ doTestMenu nextID s <- getLine >>= return . filter (/= '\n') case s of "q" -> return mempty - "" -> do - r <- runTest $ show nextID + "" -> do + r <- runTest $ show nextID rs <- doTestMenu ( nextID + 1 ) return $ r : rs i | isJust ( lookup i testMenu ) -> do - r <- runTest i + r <- runTest i rs <- doTestMenu ( read i + 1 ) return $ r : rs where - displayTestMenu + displayTestMenu = mapM_ displayTestMenu' testMenu - displayTestMenu' ( i, t ) - = putStrLn $ ( if i == show nextID - then "> " + displayTestMenu' ( i, t ) + = putStrLn $ ( if i == show nextID + then "> " else " " ) ++ i ++ ". " ++ testName t runTest :: String -> IO (String, Bool) runTest i = do - let t = fromJust $ lookup i testMenu + let t = fromJust $ lookup i testMenu printSummary t waitForReturn testAction t @@ -153,8 +153,8 @@ data Test = Test , confirmResults :: IO Bool } -allTests - = [ reserveOutputTest +allTests + = [ reserveOutputTest , displayBoundsTest0 , displayBoundsTest1 , displayBoundsTest2 @@ -185,7 +185,7 @@ allTests , layer1 ] -reserveOutputTest = Test +reserveOutputTest = Test { testName = "Initialize and reserve terminal output then restore previous state." , testID = "reserveOutputTest" , testAction = do @@ -203,7 +203,7 @@ reserveOutputTest = Test , printSummary = do putStr $ [s| Once return is pressed: - 0. The screen will be cleared. + 0. The screen will be cleared. 1. Four lines of text should be visible. 1. The cursor should be visible and at the start of the fifth line. @@ -391,7 +391,7 @@ utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ] iso10646Txt0 :: String iso10646Txt0 = map toEnum - [ 8593 + [ 8593 , 8593 , 8595 , 8595 @@ -554,11 +554,11 @@ After return is pressed for the second time: allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ] [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ] -allBrightColors +allBrightColors = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ] [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ] -attributesTest0 = Test +attributesTest0 = Test { testName = "Character attributes: foreground colors." , testID = "attributesTest0" , testAction = do @@ -604,7 +604,7 @@ Did the test output match the description? defaultSuccessConfirmResults } -attributesTest1 = Test +attributesTest1 = Test { testName = "Character attributes: background colors." , testID = "attributesTest1" , testAction = do @@ -659,7 +659,7 @@ Did the test output match the description? defaultSuccessConfirmResults } -attributesTest2 = Test +attributesTest2 = Test { testName = "Character attributes: Vivid foreground colors." , testID = "attributesTest2" , testAction = do @@ -686,23 +686,23 @@ Once return is pressed: 1. The cursor will be hidden. 2. 9 lines of text in three columns will be drawn: a. The first column will be a name of a standard color (for an 8 color - terminal) rendered with that color as the foreground color. + terminal) rendered with that color as the foreground color. b. The next column will be also be the name of a standard color rendered with that color as the foreground color but the shade used should be - more vivid than the shade used in the first column. + more vivid than the shade used in the first column. c. The final column will be the name of a color rendered with the default attributes. For instance, one line will be the word "magenta" and that word should be -rendered in the magenta color. +rendered in the magenta color. I'm not actually sure exactly what "vivid" means in this context. For xterm the -vivid colors are brighter. +vivid colors are brighter. -Verify: +Verify: * The first column: The foreground color matches the named color. * The second column: The foreground color matches the named color but is - more vivid than the color used in the first column. + more vivid than the color used in the first column. * The third column: All text is rendered with the default attributes. * The vertical bars used in each line to mark the border of a column are lined up. @@ -718,7 +718,7 @@ Did the test output match the description? defaultSuccessConfirmResults } -attributesTest3 = Test +attributesTest3 = Test { testName = "Character attributes: Vivid background colors." , testID = "attributesTest3" , testAction = do @@ -746,23 +746,23 @@ Once return is pressed: 2. 9 lines of text in three columns will be drawn: a. The first column will contain be a name of a standard color for an 8 color terminal rendered with the default foreground color with a - background the named color. + background the named color. b. The first column will contain be a name of a standard color for an 8 color terminal rendered with the default foreground color with the - background a vivid version of the named color. + background a vivid version of the named color. c. The third column will be the name of a standard color rendered with the default attributes. - + For instance, one line will contain be the word "magenta" and the word should -be rendered in the default foreground color over a magenta background. +be rendered in the default foreground color over a magenta background. I'm not actually sure exactly what "vivid" means in this context. For xterm the vivid colors are brighter. -Verify: +Verify: * The first column: The background color matches the named color. * The second column: The background color matches the named color and is - more vivid than the color used in the first column. + more vivid than the color used in the first column. * The third column column: All text is rendered with the default attributes. * The vertical bars used in each line to mark the border of a column are lined up. @@ -785,7 +785,7 @@ Did the test output match the description? defaultSuccessConfirmResults } -attrCombos = +attrCombos = [ ( "default", id ) , ( "bold", flip withStyle bold ) , ( "blink", flip withStyle blink ) @@ -796,7 +796,7 @@ attrCombos = , ( "bold + blink + underline", flip withStyle (bold + blink + underline) ) ] -attributesTest4 = Test +attributesTest4 = Test { testName = "Character attributes: Bold; Blink; Underline." , testID = "attributesTest4" , testAction = do @@ -819,10 +819,10 @@ attributesTest4 = Test Once return is pressed: 0. The screen will be cleared. 1. The cursor will be hidden. - 2. 8 rows of text in two columns. + 2. 8 rows of text in two columns. The rows will contain the following text: default - bold + bold blink underline bold + blink @@ -831,8 +831,8 @@ Once return is pressed: bold + blink + underline The first column will be rendered with the described attributes. The second column will be rendered with the default attributes. - -Verify: + +Verify: * The vertical bars used in each line to mark the border of a column are lined up. * The text in the first column is rendered as described. @@ -848,7 +848,7 @@ Did the test output match the description? defaultSuccessConfirmResults } -attributesTest5 = Test +attributesTest5 = Test { testName = "Character attributes: 240 color palette" , testID = "attributesTest5" , testAction = do @@ -873,7 +873,7 @@ Once return is pressed: 2. A 20 character wide and 12 row high block of color squares. This should look like a palette of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it... -Verify: +Verify: After return is pressed for the second time: 0. The screen containing the test summary should be restored. @@ -971,7 +971,7 @@ outputPicAndWait pic = do releaseDisplay t releaseTerminal t return () - + vertCropTest0 :: Test vertCropTest0 = Test { testName = "Verify bottom cropping works as expected with single column chars" @@ -1046,7 +1046,7 @@ horizCropTest0 = Test , testID = "cropTest0" , testAction = do let baseImage = vertCat $ map (string defAttr) lorumIpsum - croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage + croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage image = baseImage <-> backgroundFill 10 2 <-> croppedImage outputImageAndWait image , printSummary = putStr $ [s| @@ -1063,7 +1063,7 @@ horizCropTest1 = Test , testID = "cropTest0" , testAction = do let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese - croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage + croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage image = baseImage <-> backgroundFill 10 2 <-> croppedImage outputImageAndWait image , printSummary = putStr $ [s| @@ -1080,7 +1080,7 @@ horizCropTest2 = Test , testID = "cropTest0" , testAction = do let baseImage = vertCat $ map (string defAttr) lorumIpsum - croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage + croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage image = baseImage <-> backgroundFill 10 2 <-> croppedImage outputImageAndWait image , printSummary = putStr $ [s| @@ -1097,7 +1097,7 @@ horizCropTest3 = Test , testID = "cropTest0" , testAction = do let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese - croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage + croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage image = baseImage <-> backgroundFill 10 2 <-> croppedImage outputImageAndWait image , printSummary = putStr $ [s|