ba2b635 · vty · git.iko.soy

src/Codec/Binary/UTF8/Debug.hs+1−1

compare with master

unifiedsplit

@@ -1,6 +1,6 @@

1{-# OPTIONS_HADDOCK hide #-}

3−module Codec.Binary.UTF8.Debug

3+module Codec.Binary.UTF8.Debug

4 where

5

6import Codec.Binary.UTF8.String ( encode )

src/Data/Sequence/Extra.hs+2−2

@@ -7,7 +7,7 @@ import Data.Sequence

7import Control.Parallel.Strategies

8

9instance NFData a => NFData (Seq a) where

10− rnf = \v -> rnf' (viewl v)

10+ rnf = \v -> rnf' (viewl v)

11− where

11+ where

12 rnf' EmptyL = ()

13 rnf' (a :< r) = rnf a >| rnf' (viewl r)

src/Data/Terminfo/Eval.hs+2−3

@@ -83,7 +83,7 @@ writeCapOp DecOut = do

83 p <- pop

84 forM_ (show p) $ tell.writeWord8.toEnum.fromEnum

85writeCapOp CharOut = do

86− pop >>= tell.writeWord8.toEnum.fromEnum

86+ pop >>= tell.writeWord8.toEnum.fromEnum

87writeCapOp (PushParam pn) = do

88 readParam pn >>= push

89writeCapOp (PushValue v) = do

@@ -91,7 +91,7 @@ writeCapOp (PushValue v) = do

91writeCapOp (Conditional expr parts) = do

92 writeCapOps expr

93 writeContitionalParts parts

94− where

94+ where

95 writeContitionalParts [] = return ()

96 writeContitionalParts ((trueOps, falseOps) : falseParts) = do

97 -- (man 5 terminfo)

@@ -137,4 +137,3 @@ writeCapOp CompareGt = do

137 v1 <- pop

138 v0 <- pop

139 push $ if v0 > v1 then 1 else 0

140−

src/Data/Terminfo/Parse.hs+30−31

@@ -46,13 +46,13 @@ instance Show CapExpression where

46 hexDump = foldr (\b s -> showHex b s) ""

47

48instance NFData CapExpression where

49− rnf (CapExpression ops !_bytes !str !c !pOps)

49+ rnf (CapExpression ops !_bytes !str !c !pOps)

50 = rnf ops `seq` rnf str `seq` rnf c `seq` rnf pOps

51

52type CapParam = Word

53

54type CapOps = [CapOp]

55−data CapOp =

55+data CapOp =

56 Bytes !Int !Int -- offset count

57 | DecOut | CharOut

58 -- This stores a 0-based index to the parameter. However the operation that implies this op is

@@ -60,7 +60,7 @@ data CapOp =

60 | PushParam !Word | PushValue !Word

61 -- The conditional parts are the sequence of (%t expression, %e expression) pairs.

62 -- The %e expression may be NOP

63− | Conditional

63+ | Conditional

64 { conditionalExpr :: !CapOps

65 , conditionalParts :: ![(CapOps, CapOps)]

66 }

@@ -72,8 +72,8 @@ data CapOp =

72instance NFData CapOp where

73 rnf (Bytes offset byteCount ) = rnf offset `seq` rnf byteCount

74 rnf (PushParam pn) = rnf pn

75− rnf (PushValue v) = rnf v

75+ rnf (PushValue v) = rnf v

76− rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts

76+ rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts

77 rnf BitwiseOr = ()

78 rnf BitwiseXOr = ()

79 rnf BitwiseAnd = ()

@@ -94,11 +94,11 @@ instance NFData ParamOp where

94 rnf IncFirstTwo = ()

95

96parseCapExpression :: String -> Either ParseError CapExpression

97−parseCapExpression capString =

97+parseCapExpression capString =

98 let v = runParser capExpressionParser

99 initialBuildState

100− "terminfo cap"

100+ "terminfo cap"

101− capString

101+ capString

102 in case v of

103 Left e -> Left e

104 Right buildResults -> Right $ constructCapExpression capString buildResults

@@ -113,21 +113,21 @@ constructCapExpression capString buildResults =

113 , sourceString = capString

114 , paramCount = outParamCount buildResults

115 , paramOps = outParamOps buildResults

116− }

116+ }

117 in rnf expr `seq` expr

118

119−type CapParser a = Parsec String BuildState a

119+type CapParser a = Parsec String BuildState a

120

121capExpressionParser :: CapParser BuildResults

122capExpressionParser = do

123− rs <- many $ paramEscapeParser <|> bytesOpParser

123+ rs <- many $ paramEscapeParser <|> bytesOpParser

124 return $ mconcat rs

125

126paramEscapeParser :: CapParser BuildResults

127paramEscapeParser = do

128 _ <- char '%'

129 incOffset 1

130− literalPercentParser <|> paramOpParser

130+ literalPercentParser <|> paramOpParser

131

132literalPercentParser :: CapParser BuildResults

133literalPercentParser = do

@@ -138,7 +138,7 @@ literalPercentParser = do

138

139paramOpParser :: CapParser BuildResults

140paramOpParser

141− = incrementOpParser

141+ = incrementOpParser

142 <|> pushOpParser

143 <|> decOutParser

144 <|> charOutParser

@@ -179,16 +179,16 @@ conditionalOpParser = do

179 _ <- char '?'

180 incOffset 1

181 condPart <- manyExpr conditionalTrueParser

182− parts <- manyP

182+ parts <- manyP

183 ( do

184 truePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser

185− , conditionalFalseParser

185+ , conditionalFalseParser

186 ]

187 falsePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser

188 , conditionalTrueParser

189 ]

190 return ( truePart, falsePart )

191− )

191+ )

192 conditionalEndParser

193

194 let trueParts = map fst parts

@@ -208,10 +208,10 @@ conditionalOpParser = do

208

209 return $ BuildResults n'' [ Conditional cond condParts ] pOps

210

211− where

211+ where

212− manyP !p !end = choice

212+ manyP !p !end = choice

213 [ try end >> return []

214− , do !v <- p

214+ , do !v <- p

215 !vs <- manyP p end

216 return $! v : vs

217 ]

@@ -233,7 +233,7 @@ conditionalEndParser = do

233 incOffset 2

234

235bitwiseOpParser :: CapParser BuildResults

236−bitwiseOpParser

236+bitwiseOpParser

237 = bitwiseOrParser

238 <|> bitwiseAndParser

239 <|> bitwiseXorParser

@@ -257,9 +257,9 @@ bitwiseXorParser = do

257 return $ BuildResults 0 [ BitwiseXOr ] [ ]

258

259arithOpParser :: CapParser BuildResults

260−arithOpParser

260+arithOpParser

261− = plusOp

261+ = plusOp

262− <|> minusOp

262+ <|> minusOp

263 where

264 plusOp = do

265 _ <- char '+'

@@ -282,10 +282,10 @@ literalIntOpParser = do

282 return $ BuildResults 0 [ PushValue n ] [ ]

283

284compareOpParser :: CapParser BuildResults

285−compareOpParser

285+compareOpParser

286 = compareEqOp

287− <|> compareLtOp

287+ <|> compareLtOp

288− <|> compareGtOp

288+ <|> compareGtOp

289 where

290 compareEqOp = do

291 _ <- char '='

@@ -313,14 +313,14 @@ bytesOpParser = do

313charConstParser :: CapParser BuildResults

314charConstParser = do

315 _ <- char '\''

316− charValue <- liftM (toEnum . fromEnum) anyChar

316+ charValue <- liftM (toEnum . fromEnum) anyChar

317 _ <- char '\''

318 incOffset 3

319 return $ BuildResults 0 [ PushValue charValue ] [ ]

320

321−data BuildState = BuildState

321+data BuildState = BuildState

322 { nextOffset :: Int

323− }

323+ }

324

325incOffset :: Int -> CapParser ()

326incOffset n = do

@@ -339,10 +339,9 @@ data BuildResults = BuildResults

339

340instance Monoid BuildResults where

341 mempty = BuildResults 0 [] []

342− v0 `mappend` v1

342+ v0 `mappend` v1

343 = BuildResults

344 { outParamCount = (outParamCount v0) `max` (outParamCount v1)

345 , outCapOps = (outCapOps v0) `mappend` (outCapOps v1)

346 , outParamOps = (outParamOps v0) `mappend` (outParamOps v1)

347 }

348−

src/Graphics/Text/Width.hs+1−1

@@ -14,7 +14,7 @@ wcswidth :: String -> Int

14wcswidth = sum . map wcwidth

15

16-- XXX: Characters with unknown widths occupy 1 column?

17−--

17+--

18-- Not sure if this is actually correct. I presume there is a replacement character that is output

19-- by the terminal instead of the character and this replacement character is 1 column wide. If this

20-- is not true for all terminals then a per-terminal replacement character width needs to be

src/Graphics/Vty.hs+6−7

@@ -10,7 +10,7 @@

10-- - The constructors in "Graphics.Vty.Image.Internal" should not be used.

11--

12-- - 'Image's can be styled using 'Attr'. See "Graphics.Vty.Attributes".

13−--

13+--

14-- See the vty-examples package for a number of examples.

15--

16-- @

@@ -28,7 +28,7 @@

28-- 'shutdown' vty

29-- 'print' (\"Last event was: \" '++' 'show' e)

30-- @

31−--

31+--

32-- Good sources of documentation for terminal programming are:

33--

34-- - <https://github.com/b4winckler/vim/blob/master/src/term.c>

@@ -50,7 +50,7 @@ module Graphics.Vty ( Vty(..)

50 , module Graphics.Vty.Picture

51 , DisplayRegion

52 , Mode(..)

53− )

53+ )

54 where

55

56import Graphics.Vty.Prelude

@@ -84,7 +84,7 @@ import Data.Monoid

84-- when another update action is already then it's safe to call this on multiple threads.

85--

86-- \todo Remove explicit `shutdown` requirement.

87−data Vty = Vty

87+data Vty = Vty

88 { -- | Outputs the given Picture. Equivalent to 'outputPicture' applied to a display context

89 -- implicitly managed by Vty. The managed display context is reset on resize.

90 update :: Picture -> IO ()

@@ -101,7 +101,7 @@ data Vty = Vty

101 , refresh :: IO ()

102 -- | Clean up after vty.

103 -- The above methods will throw an exception if executed after this is executed.

104− , shutdown :: IO ()

104+ , shutdown :: IO ()

105 }

106

107-- | Set up the state object for using vty. At most one state object should be

@@ -157,7 +157,7 @@ intMkVty input out = do

157 maybe (return ()) innerUpdate mPic

158

159 let gkey = do k <- atomically $ readTChan $ _eventChannel input

160− case k of

160+ case k of

161 (EvResize _ _) -> displayBounds out

162 >>= return . (\(w,h)-> EvResize w h)

163 _ -> return k

@@ -169,4 +169,3 @@ intMkVty input out = do

169 , refresh = innerRefresh

170 , shutdown = shutdownIo

171 }

172−

src/Graphics/Vty/Attributes.hs+3−4

@@ -93,7 +93,7 @@ data Attr = Attr

93

94instance Monoid Attr where

95 mempty = Attr mempty mempty mempty

96− mappend attr0 attr1 =

96+ mappend attr0 attr1 =

97 Attr ( attrStyle attr0 `mappend` attrStyle attr1 )

98 ( attrForeColor attr0 `mappend` attrForeColor attr1 )

99 ( attrBackColor attr0 `mappend` attrBackColor attr1 )

@@ -141,7 +141,7 @@ magenta= ISOColor 5

141cyan = ISOColor 6

142white = ISOColor 7

143

144−-- | Bright/Vivid variants of the standard 8-color ANSI

144+-- | Bright/Vivid variants of the standard 8-color ANSI

145brightBlack, brightRed, brightGreen, brightYellow :: Color

146brightBlue, brightMagenta, brightCyan, brightWhite :: Color

147brightBlack = ISOColor 8

@@ -185,7 +185,7 @@ defaultStyleMask :: Style

185defaultStyleMask = 0x00

186

187styleMask :: Attr -> Word8

188−styleMask attr

188+styleMask attr

189 = case attrStyle attr of

190 Default -> 0

191 KeepCurrent -> 0

@@ -224,4 +224,3 @@ instance Default Attr where

224-- set to brightMagenta.

225currentAttr :: Attr

226currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent

227−

src/Graphics/Vty/Attributes/Color.hs+3−4

@@ -2,7 +2,7 @@ module Graphics.Vty.Attributes.Color where

2import Data.Word

3

4-- | Abstract data type representing a color.

5−--

5+--

6-- Currently the foreground and background color are specified as points in either a:

7--

8-- * 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

10--

11-- * 240 color palette. This palette is a regular sampling of the full RGB colorspace for the first

12-- 224 colors. The remaining 16 colors is a greyscale palette.

13−--

13+--

14-- The 8 ISO 6429 (ANSI) colors are as follows:

15--

16-- 0. black

@@ -36,7 +36,7 @@ import Data.Word

36--

37-- If the terminal reports <= 16 colors then the 240 color palette points are only mapped to the 8

38-- color pallete. I'm not sure of the RGB points for the "bright" colors which is why they are not

39−-- addressable via the 240 color palette.

39+-- addressable via the 240 color palette.

40--

41-- If the terminal reports > 16 colors then the 240 color palette points are mapped to the nearest

42-- points in a ("color count" - 16) subsampling of the 240 color palette.

@@ -48,4 +48,3 @@ import Data.Word

48-- Seriously, terminal color support is INSANE.

49data Color = ISOColor !Word8 | Color240 !Word8

50 deriving ( Eq, Show, Read )

51−

src/Graphics/Vty/Attributes/Color240.hs+1−1

@@ -254,7 +254,7 @@ rgbColor r g b

254 | r <= 255 && g <= 255 && b <= 175 = Color240 213

255 | r <= 255 && g <= 255 && b <= 215 = Color240 214

256 | r <= 255 && g <= 255 && b <= 255 = Color240 215

257− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."

257+ | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."

258 (fromIntegral r :: Int)

259 (fromIntegral g :: Int)

260 (fromIntegral b :: Int))

src/Graphics/Vty/Config.hs+2−2

@@ -14,7 +14,7 @@

14-- earlier.

15--

16-- For all directives:

17−--

17+--

18-- @

19-- string := \"\\\"\" chars+ \"\\\"\"

20-- @

@@ -40,7 +40,7 @@

40--

41-- @

42-- \"map\" term string key modifier_list

43−-- where

43+-- where

44-- key := KEsc | KChar Char | KBS ... (same as 'Key')

45-- modifier_list := \"[\" modifier+ \"]\"

46-- modifier := MShift | MCtrl | MMeta | MAlt

src/Graphics/Vty/Debug.hs+3−4

@@ -10,10 +10,10 @@ import Graphics.Vty.Attributes

10import Graphics.Vty.Debug.Image

11import Graphics.Vty.Span

12

13−import qualified Data.Vector as Vector

13+import qualified Data.Vector as Vector

14

15rowOpsEffectedColumns :: DisplayOps -> [Int]

16−rowOpsEffectedColumns ops

16+rowOpsEffectedColumns ops

17 = Vector.toList $ Vector.map spanOpsEffectedColumns ops

18

19allSpansHaveWidth :: DisplayOps -> Int -> Bool

@@ -23,7 +23,7 @@ allSpansHaveWidth ops expected

23spanOpsEffectedRows :: DisplayOps -> Int

24spanOpsEffectedRows ops

25 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))

26−

26+

27type SpanConstructLog = [SpanConstructEvent]

28data SpanConstructEvent = SpanSetAttr Attr

29

@@ -37,4 +37,3 @@ data MockWindow = MockWindow Int Int

37

38regionForWindow :: MockWindow -> DisplayRegion

39regionForWindow (MockWindow w h) = (w,h)

40−

src/Graphics/Vty/Debug/Image.hs+1−1

@@ -19,7 +19,7 @@ data ImageOp = ImageOp ImageEndo ImageEndo

19type ImageEndo = Image -> Image

20

21debugImageOps :: [ImageOp]

22−debugImageOps =

22+debugImageOps =

23 [ idImageOp

24 -- , renderSingleColumnCharOp

25 -- , renderDoubleColumnCharOp

src/Graphics/Vty/DisplayAttributes.hs+1−1

@@ -79,7 +79,7 @@ data DisplayColorDiff

79

80-- | Style attribute changes are transformed into a sequence of apply/removes of the individual

81-- attributes.

82−data StyleStateChange

82+data StyleStateChange

83 = ApplyStandout

84 | RemoveStandout

85 | ApplyUnderline

src/Graphics/Vty/Image.hs+10−11

@@ -61,7 +61,7 @@ infixr 4 <->

61

62-- | An area of the picture's bacground (See Background) of w columns and h rows.

63backgroundFill :: Int -> Int -> Image

64−backgroundFill w h

64+backgroundFill w h

65 | w == 0 = EmptyImage

66 | h == 0 = EmptyImage

67 | otherwise = BGFill w h

@@ -104,21 +104,21 @@ char a c =

104 in HorizText a (TL.singleton c) displayWidth 1

105

106-- | A string of characters layed out on a single row with the same display attribute. The string is

107−-- assumed to be a sequence of ISO-10646 characters.

107+-- assumed to be a sequence of ISO-10646 characters.

108--

109-- Note: depending on how the Haskell compiler represents string literals a string literal in a

110−-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.

110+-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.

111-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry

112-- about the encoding format when outputting string literals. Just provide the string literal

113-- directly to iso10646String or string.

114−--

114+--

115iso10646String :: Attr -> String -> Image

116iso10646String a str =

117 let displayWidth = safeWcswidth str

118 in HorizText a (TL.pack str) displayWidth (length str)

119

120-- | Alias for iso10646String. Since the usual case is that a literal string like "foo" is

121−-- represented internally as a list of ISO 10646 31 bit characters.

121+-- represented internally as a list of ISO 10646 31 bit characters.

122--

123-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while

124-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime

@@ -131,11 +131,11 @@ string = iso10646String

131utf8String :: Attr -> [Word8] -> Image

132utf8String a bytes = utf8Bytestring a (BL.pack bytes)

133

134−-- | Renders a UTF-8 encoded lazy bytestring.

134+-- | Renders a UTF-8 encoded lazy bytestring.

135utf8Bytestring :: Attr -> BL.ByteString -> Image

136utf8Bytestring a bs = text a (TL.decodeUtf8 bs)

137

138−-- | Renders a UTF-8 encoded strict bytestring.

138+-- | Renders a UTF-8 encoded strict bytestring.

139utf8Bytestring' :: Attr -> B.ByteString -> Image

140utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)

141

@@ -146,14 +146,14 @@ charFill _a _c 0 _h = EmptyImage

146charFill _a _c _w 0 = EmptyImage

147charFill a c w h =

148 vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth

149− where

149+ where

150 txt = TL.replicate (fromIntegral w) (TL.singleton c)

151 displayWidth = safeWcwidth c * (fromIntegral w)

152 charWidth = fromIntegral w

153

154-- | The empty image. Useful for fold combinators. These occupy no space nor define any display

155-- attributes.

156−emptyImage :: Image

156+emptyImage :: Image

157emptyImage = EmptyImage

158

159-- | 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

163pad inL inT inR inB inImage

164 | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount"

165 | otherwise = go inL inT inR inB inImage

166− where

166+ where

167 -- TODO: uh.

168 go 0 0 0 0 i = i

169 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

299 LT -> cropBottom h i

300 EQ -> i

301 GT -> i <-> BGFill (imageWidth i) (h - imageHeight i)

302−

src/Graphics/Vty/Image/Internal.hs+6−7

@@ -65,7 +65,7 @@ clipText txt leftSkip rightClip =

65-- * a cropped image

66--

67-- * an empty image of no size or content.

68−data Image =

68+data Image =

69 -- | A horizontal text span has a row height of 1.

70 HorizText

71 { attr :: Attr

@@ -80,7 +80,7 @@ data Image =

80 -- required to be between two images of equal height. The horizJoin constructor adds background

81 -- fills to the provided images that assure this is true for the HorizJoin value produced.

82 | HorizJoin

83− { partLeft :: Image

83+ { partLeft :: Image

84 , partRight :: Image

85 , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 0

86 , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

@@ -136,10 +136,10 @@ data Image =

136 }

137 -- | The empty image

138 --

139− -- The combining operators identity constant.

139+ -- The combining operators identity constant.

140 -- EmptyImage <|> a = a

141 -- EmptyImage <-> a = a

142− --

142+ --

143 -- Any image of zero size equals the empty image.

144 | EmptyImage

145 deriving (Eq, Generic)

@@ -198,7 +198,7 @@ ppImageStructure inImg = go 0 inImg

198 = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n"

199 ++ go (i+1) croppedImage

200 pp _ EmptyImage = "EmptyImage"

201−

201+

202instance NFData Image where

203 rnf EmptyImage = ()

204 rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()

@@ -234,7 +234,7 @@ imageHeight CropBottom { outputHeight = h } = h

234imageHeight CropTop { outputHeight = h } = h

235imageHeight EmptyImage = 0

236

237−-- | Append in the Monoid instance is equivalent to <->.

237+-- | Append in the Monoid instance is equivalent to <->.

238instance Monoid Image where

239 mempty = EmptyImage

240 mappend = vertJoin

@@ -302,4 +302,3 @@ vertJoin i0 i1

302 h1 = imageHeight i1

303 h = h0 + h1

304vertJoin _ _ = error "vertJoin applied to undefined values."

305−

src/Graphics/Vty/Inline.hs+5−5

@@ -1,5 +1,5 @@

1-- | The inline module provides a limited interface to changing the style of terminal output. The

2−-- intention is for this interface to be used inline with other output systems.

2+-- intention is for this interface to be used inline with other output systems.

3--

4-- The changes specified by the InlineM monad are applied to the terminals display attributes. These

5-- display attributes effect the display of all following text output to the terminal file

@@ -11,7 +11,7 @@

11-- @

12-- putStr \"Not styled. \"

13-- putAttrChange_ $ do

14−-- backColor red

14+-- backColor red

15-- applyStyle underline

16-- putStr \" Styled! \"

17-- putAttrChange_ $ defaultAll

@@ -74,14 +74,14 @@ applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

74

75-- | Attempt to remove the specified 'Style' from the display of the following text.

76--

77−-- This will fail if applyStyle for the given style has not been previously called.

77+-- This will fail if applyStyle for the given style has not been previously called.

78removeStyle :: Style -> InlineM ()

79−removeStyle sMask = modify $ \attr ->

79+removeStyle sMask = modify $ \attr ->

80 let style' = case attrStyle attr of

81 Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

82 KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

83 SetTo s -> s .&. complement sMask

84− in attr { attrStyle = SetTo style' }

84+ in attr { attrStyle = SetTo style' }

85

86-- | Reset the display attributes

87defaultAll :: InlineM ()

src/Graphics/Vty/Input.hs+2−2

@@ -113,7 +113,7 @@

113-- Some terminfo capabilities specify millisecond delays. (Capabilities are how terminfo describes

114-- the control sequence to output red, for instance) This is to account for the slow speed of

115-- hardcopy teletype interfaces. Cause, uh, we totally still use those.

116−--

116+--

117-- The output encoding of colors and attributes are also rife with issues.

118--

119-- == See also

@@ -162,7 +162,7 @@ import Data.Monoid ((<>))

162-- suspended if the output terminal cannot keep up. I presume this has little effect these

163-- days. I hope this means that output will be buffered if the terminal cannot keep up. In the

164-- old days the output might of been dropped?

165−--

165+--

166-- "raw" mode is used for input.

167--

168-- * ISIG disabled

src/Graphics/Vty/Input/Classify.hs+1−1

@@ -44,7 +44,7 @@ compile table = cl' where

44 -- produced.

45 -- The test verifyFullSynInputToEvent2x verifies this.

46 -- H: There will always be one match. The prefixSet contains, by definition, all

47− -- prefixes of an event.

47+ -- prefixes of an event.

48 False ->

49 let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

50 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

src/Graphics/Vty/Input/Loop.hs+1−1

@@ -147,7 +147,7 @@ parseEvent = do

147 logMsg $ "remaining: " ++ show remaining

148 unprocessedBytes .= remaining

149 return e

150− _ -> mzero

150+ _ -> mzero

151

152dropInvalid :: InputM ()

153dropInvalid = do

src/Graphics/Vty/Input/Terminfo.hs+2−2

@@ -113,7 +113,7 @@ specialSupportKeys =

113-- * kcbt - back tab

114--

115-- * kc1 - keypad left-down

116−--

116+--

117-- * kc3 - keypad right-down

118--

119-- * kdch1 - delete

@@ -121,7 +121,7 @@ specialSupportKeys =

121-- * kcud1 - down

122--

123-- * kend - end

124−--

124+--

125-- * kent - enter

126--

127-- * kf0 - kf63 - function keys

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+3−4

@@ -1,5 +1,5 @@

1-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from terminfo.

2−--

2+--

3-- Or that are sent regardless of terminfo by terminal emulators. EG: Terminal emulators will often

4-- use VT50 input bytes regardless of declared terminal type. This provides compatibility with

5-- programs that don't follow terminfo.

@@ -49,8 +49,8 @@ navKeys3 =

49 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

50

51-- | encoding for shift plus function keys

52−--

52+--

53−-- According to

53+-- According to

54--

55-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html

56--

@@ -84,4 +84,3 @@ classifyTable =

84 , functionKeys1

85 , functionKeys2

86 ]

87−

src/Graphics/Vty/Output/Interface.hs+18−18

@@ -43,12 +43,12 @@ data Mode = Mouse

43 deriving (Eq, Read, Show)

44

45data Output = Output

46− { -- | Text identifier for the output device. Used for debugging.

46+ { -- | Text identifier for the output device. Used for debugging.

47 terminalID :: String

48 , releaseTerminal :: forall m. MonadIO m => m ()

49− -- | Clear the display and initialize the terminal to some initial display state.

49+ -- | Clear the display and initialize the terminal to some initial display state.

50 --

51− -- The expectation of a program is that the display starts in some initial state.

51+ -- The expectation of a program is that the display starts in some initial state.

52 -- The initial state would consist of fixed values:

53 --

54 -- - cursor at top left

@@ -80,7 +80,7 @@ data Output = Output

80 , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

81 , assumedStateRef :: IORef AssumedState

82 -- | Acquire display access to the given region of the display.

83− -- Currently all regions have the upper left corner of (0,0) and the lower right corner at

83+ -- Currently all regions have the upper left corner of (0,0) and the lower right corner at

84 -- (max displayWidth providedWidth, max displayHeight providedHeight)

85 , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

86 -- | Ring the terminal bell if supported.

@@ -102,7 +102,7 @@ initialAssumedState = AssumedState Nothing Nothing

102

103data DisplayContext = DisplayContext

104 { contextDevice :: Output

105− -- | Provide the bounds of the display context.

105+ -- | Provide the bounds of the display context.

106 , contextRegion :: DisplayRegion

107 -- | sets the output position to the specified row and column. Where the number of bytes

108 -- required for the control codes can be specified seperate from the actual byte sequence.

@@ -134,16 +134,16 @@ writeUtf8Text = writeByteString

134

135-- | Displays the given `Picture`.

136--

137−-- 0. The image is cropped to the display size.

137+-- 0. The image is cropped to the display size.

138--

139-- 1. Converted into a sequence of attribute changes and text spans.

140−--

140+--

141-- 2. The cursor is hidden.

142--

143-- 3. Serialized to the display.

144--

145-- 4. The cursor is then shown and positioned or kept hidden.

146−--

146+--

147-- todo: specify possible IO exceptions.

148-- abstract from IO monad to a MonadIO instance.

149outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()

@@ -193,7 +193,7 @@ writeOutputOps dc initialAttr diffs ops =

193 (0, mempty, diffs)

194 ops

195 in out

196− where

196+ where

197 writeOutputOps' (y, out, True : diffs') spanOps

198 = let spanOut = writeSpanOps dc y initialAttr spanOps

199 out' = out `mappend` spanOut

@@ -229,7 +229,7 @@ writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc,

229-- needs to be translated to column, row positions.

230data CursorOutputMap = CursorOutputMap

231 { charToOutputPos :: (Int, Int) -> (Int, Int)

232− }

232+ }

233

234cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap

235cursorOutputMap spanOps _cursor = CursorOutputMap

@@ -239,18 +239,18 @@ cursorOutputMap spanOps _cursor = CursorOutputMap

239cursorColumnOffset :: DisplayOps -> Int -> Int -> Int

240cursorColumnOffset ops cx cy =

241 let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy)

242− (outOffset, _, _)

242+ (outOffset, _, _)

243− = Vector.foldl' ( \(d, currentCx, done) op ->

243+ = Vector.foldl' ( \(d, currentCx, done) op ->

244 if done then (d, currentCx, done) else case spanOpHasWidth op of

245 Nothing -> (d, currentCx, False)

246 Just (cw, ow) -> case compare cx (currentCx + cw) of

247 GT -> ( d + ow

248 , currentCx + cw

249− , False

249+ , False

250 )

251 EQ -> ( d + ow

252 , currentCx + cw

253− , True

253+ , True

254 )

255 LT -> ( d + columnsToCharOffset (cx - currentCx) op

256 , currentCx + cw

@@ -264,7 +264,7 @@ cursorColumnOffset ops cx cy =

264-- | Not all terminals support all display attributes. This filters a display attribute to what the

265-- given terminal can display.

266limitAttrForDisplay :: Output -> Attr -> Attr

267−limitAttrForDisplay t attr

267+limitAttrForDisplay t attr

268 = attr { attrForeColor = clampColor $ attrForeColor attr

269 , attrBackColor = clampColor $ attrBackColor attr

270 }

@@ -272,7 +272,7 @@ limitAttrForDisplay t attr

272 clampColor Default = Default

273 clampColor KeepCurrent = KeepCurrent

274 clampColor (SetTo c) = clampColor' c

275− clampColor' (ISOColor v)

275+ clampColor' (ISOColor v)

276 | contextColorCount t < 8 = Default

277 | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)

278 | otherwise = SetTo $ ISOColor v

@@ -281,7 +281,7 @@ limitAttrForDisplay t attr

281 | contextColorCount t < 8 = Default

282 | contextColorCount t < 16 = Default

283 | contextColorCount t <= 256 = SetTo $ Color240 v

284− | otherwise

284+ | otherwise

285− = let p :: Double = fromIntegral v / 240.0

285+ = let p :: Double = fromIntegral v / 240.0

286 v' = floor $ p * (fromIntegral $ contextColorCount t)

287 in SetTo $ Color240 v'

src/Graphics/Vty/Output/TerminfoBased.hs+25−26

@@ -50,7 +50,7 @@ import Data.Foldable (foldMap)

50import Data.Monoid

51#endif

52

53−data TerminfoCaps = TerminfoCaps

53+data TerminfoCaps = TerminfoCaps

54 { smcup :: Maybe CapExpression

55 , rmcup :: Maybe CapExpression

56 , cup :: CapExpression

@@ -77,7 +77,7 @@ data DisplayAttrCaps = DisplayAttrCaps

77 , enterDimMode :: Maybe CapExpression

78 , enterBoldMode :: Maybe CapExpression

79 }

80−

80+

81-- kinda like: https://code.google.com/p/vim/source/browse/src/fileio.c#10422

82-- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR the write will be retried.

83fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int

@@ -99,10 +99,10 @@ sendCapToTerminal t cap capParams = do

99 - terminfo does not support some features that would increase efficiency and improve compatibility:

100 -

101 - * determine the character encoding supported by the terminal. Should this be taken from the LANG

102− - environment variable?

102+ - environment variable?

103 -

104 - * Provide independent string capabilities for all display attributes.

105− -

105+ -

106 - todo: Some display attributes like underline and bold have independent string capabilities that

107 - should be used instead of the generic "sgr" string capability.

108 -}

@@ -113,7 +113,7 @@ reserveTerminal termName outFd = liftIO $ do

113 -- if set foreground is not set then all color changing style attributes are filtered.

114 msetaf <- probeCap ti "setaf"

115 msetf <- probeCap ti "setf"

116− let (noColors, useAlt, setForeCap)

116+ let (noColors, useAlt, setForeCap)

117 = case msetaf of

118 Just setaf -> (False, False, setaf)

119 Nothing -> case msetf of

@@ -121,7 +121,7 @@ reserveTerminal termName outFd = liftIO $ do

121 Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

122 msetab <- probeCap ti "setab"

123 msetb <- probeCap ti "setb"

124− let set_back_cap

124+ let set_back_cap

125 = case msetab of

126 Nothing -> case msetb of

127 Just setb -> setb

@@ -190,13 +190,13 @@ reserveTerminal termName outFd = liftIO $ do

190 return t

191

192requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression

193−requireCap ti capName

193+requireCap ti capName

194 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

195 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

196 Just capStr -> parseCap capStr

197

198probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

199−probeCap ti capName

199+probeCap ti capName

200 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

201 Nothing -> return Nothing

202 Just capStr -> Just <$> parseCap capStr

@@ -207,11 +207,11 @@ parseCap capStr = do

207 Left e -> fail $ show e

208 Right cap -> return cap

209

210−currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

210+currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

211− => Terminfo.Terminal

211+ => Terminfo.Terminal

212 -> m DisplayAttrCaps

213−currentDisplayAttrCaps ti

213+currentDisplayAttrCaps ti

214− = pure DisplayAttrCaps

214+ = pure DisplayAttrCaps

215 <*> probeCap ti "sgr"

216 <*> probeCap ti "smso"

217 <*> probeCap ti "rmso"

@@ -224,7 +224,7 @@ currentDisplayAttrCaps ti

224foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong

225

226getWindowSize :: Fd -> IO (Int,Int)

227−getWindowSize fd = do

227+getWindowSize fd = do

228 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

229 return (fromIntegral b, fromIntegral a)

230

@@ -249,14 +249,14 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

249-- | Portably setting the display attributes is a giant pain in the ass.

250--

251-- If the terminal supports the sgr capability (which sets the on/off state of each style

252−-- directly ; and, for no good reason, resets the colors to the default) this procedure is used:

252+-- directly ; and, for no good reason, resets the colors to the default) this procedure is used:

253--

254-- 0. set the style attributes. This resets the fore and back color.

255--

256-- 1, If a foreground color is to be set then set the foreground color

257--

258-- 2. likewise with the background color

259−--

259+--

260-- If the terminal does not support the sgr cap then:

261-- if there is a change from an applied color to the default (in either the fore or back color)

262-- then:

@@ -290,13 +290,13 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

290 (styleToApplySeq $ fixedStyle attr) of

291 -- only way to reset a color to the defaults

292 EnterExitSeq caps -> writeDefaultAttr dc

293− `mappend`

293+ `mappend`

294 foldMap (\cap -> writeCapExpr cap []) caps

295 `mappend`

296 setColors

297 -- implicitly resets the colors to the defaults

298− SetState state -> writeCapExpr (fromJust $ setAttrStates

298+ SetState state -> writeCapExpr (fromJust $ setAttrStates

299− $ displayAttrCaps

299+ $ displayAttrCaps

300 $ terminfoCaps

301 )

302 (sgrArgsForState state)

@@ -320,12 +320,12 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

320 `mappend`

321 writeColorDiff setBackColor (backColorDiff diffs)

322 -- implicitly resets the colors to the defaults

323− SetState state -> writeCapExpr (fromJust $ setAttrStates

323+ SetState state -> writeCapExpr (fromJust $ setAttrStates

324 $ displayAttrCaps terminfoCaps

325 )

326 (sgrArgsForState state)

327 `mappend` setColors

328− where

328+ where

329 colorMap = case useAltColorMap terminfoCaps of

330 False -> ansiColorIndex

331 True -> altColorIndex

@@ -357,7 +357,7 @@ ansiColorIndex (ISOColor v) = fromEnum v

357ansiColorIndex (Color240 v) = 16 + fromEnum v

358

359-- | For terminals without setaf/setab

360−--

360+--

361-- See table in `man terminfo`

362-- Will error if not in table.

363altColorIndex :: Color -> Int

@@ -375,7 +375,7 @@ altColorIndex (Color240 v) = 16 + fromEnum v

375{- | The sequence of terminfo caps to apply a given style are determined according to these rules.

376 -

377 - 1. The assumption is that it's preferable to use the simpler enter/exit mode capabilities than

378− - the full set display attribute state capability.

378+ - the full set display attribute state capability.

379 -

380 - 2. If a mode is supposed to be removed but there is not an exit capability defined then the

381 - display attributes are reset to defaults then the display attribute state is set.

@@ -422,7 +422,7 @@ reqDisplayCapSeqFor caps s diffs

422 ( False, _ ) -> EnterExitSeq $ map enterExitCap diffs

423 -- If not all the diffs have an enter-exit cap and there is no set state cap then filter out

424 -- all unsupported diffs and just apply the rest

425− ( True, False ) -> EnterExitSeq $ map enterExitCap

425+ ( True, False ) -> EnterExitSeq $ map enterExitCap

426 $ filter (not . noEnterExitCap) diffs

427 -- if not all the diffs have an enter-exit can and there is a set state cap then just use

428 -- the set state cap.

@@ -469,9 +469,8 @@ styleToApplySeq s = concat

469 , applyIfRequired ApplyDim dim

470 , applyIfRequired ApplyBlink bold

471 ]

472− where

472+ where

473− applyIfRequired op flag

473+ applyIfRequired op flag

474 = if 0 == (flag .&. s)

475 then []

476 else [op]

477−

src/Graphics/Vty/Output/XTermColor.hs+1−2

@@ -32,7 +32,7 @@ import Data.List (isInfixOf)

32import Data.Maybe (catMaybes)

33import Data.Monoid ((<>))

34

35−-- | Initialize the display to UTF-8.

35+-- | Initialize the display to UTF-8.

36reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

37reserveTerminal variant outFd = liftIO $ do

38 let flushedPut = void . fdWrite outFd

@@ -112,4 +112,3 @@ xtermInlineHack :: Output -> IO ()

112xtermInlineHack t = do

113 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

114 outputByteBuffer t $ writeToByteString writeReset

115−

src/Graphics/Vty/Picture.hs+5−5

@@ -11,7 +11,7 @@ import Graphics.Vty.Image

11

12import Control.DeepSeq

13

14−-- | The type of images to be displayed using 'update'.

14+-- | The type of images to be displayed using 'update'.

15--

16-- Can be constructed directly or using `picForImage`. Which provides an initial instance with

17-- reasonable defaults for picCursor and picBackground.

@@ -42,7 +42,7 @@ addToBottom p i = p {picLayers = picLayers p ++ [i]}

42-- | Create a picture for display for the given image. The picture will not have a displayed cursor

43-- and no background pattern (ClearBackground) will be used.

44picForImage :: Image -> Picture

45−picForImage i = Picture

45+picForImage i = Picture

46 { picCursor = NoCursor

47 , picLayers = [i]

48 , picBackground = ClearBackground

@@ -52,17 +52,17 @@ picForImage i = Picture

52--

53-- The picture will not have a displayed cursor and no background apttern (ClearBackgroun) will be

54-- used.

55−--

55+--

56-- The first 'Image' is the top layer.

57picForLayers :: [Image] -> Picture

58−picForLayers is = Picture

58+picForLayers is = Picture

59 { picCursor = NoCursor

60 , picLayers = is

61 , picBackground = ClearBackground

62 }

63

64-- | A picture can be configured either to not show the cursor or show the cursor at the specified

65−-- character position.

65+-- character position.

66--

67-- There is not a 1 to 1 map from character positions to a row and column on the screen due to

68-- characters that take more than 1 column.

src/Graphics/Vty/PictureToSpans.hs+4−4

@@ -200,7 +200,7 @@ buildSpans image outRegion = do

200 outOps <- MVector.replicate (regionHeight outRegion) Vector.empty

201 -- \todo I think building the span operations in display order would provide better performance.

202 -- However, I got stuck trying to implement an algorithm that did this. This will be considered

203− -- as a possible future optimization.

203+ -- as a possible future optimization.

204 --

205 -- A depth first traversal of the image is performed. ordered according to the column range

206 -- 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

208 -- all unspecified columns.

209 --

210 -- The images are made into span operations from left to right. It's possible that this could

211− -- easily be made to assure top to bottom output as well.

211+ -- easily be made to assure top to bottom output as well.

212 when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ do

213 -- The ops builder recursively descends the image and outputs span ops that would

214 -- display that image. The number of columns remaining in this row before exceeding the

@@ -297,7 +297,7 @@ addMaybeClipped CropTop {croppedImage, topSkip} = do

297 skipRows += topSkip

298 addMaybeClipped croppedImage

299

300−addMaybeClippedJoin :: forall s . String

300+addMaybeClippedJoin :: forall s . String

301 -> Lens BlitState BlitState Int Int

302 -> Lens BlitState BlitState Int Int

303 -> Lens BlitState BlitState Int Int

@@ -312,7 +312,7 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

312 case state^.skip of

313 s -- TODO: check if clipped in other dim. if not use addUnclipped

314 | s > size -> put $ state & skip -~ size

315− | s == 0 -> if state^.remaining > i0Dim

315+ | s == 0 -> if state^.remaining > i0Dim

316 then do

317 addMaybeClipped i0

318 put $ state & offset +~ i0Dim & remaining -~ i0Dim

src/Graphics/Vty/Span.hs+3−5

@@ -31,7 +31,7 @@ data SpanOp =

31 -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

32 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

33 -- TextSpan [Attr] [output width in columns] [number of characters] [data]

34− TextSpan

34+ TextSpan

35 { textSpanAttr :: !Attr

36 , textSpanOutputWidth :: !Int

37 , textSpanCharWidth :: !Int

@@ -89,7 +89,6 @@ splitOpsAt inW inOps = splitOpsAt' inW inOps

89 , Vector.cons (Skip (w - remainingColumns)) (Vector.tail ops)

90 )

91 RowEnd _ -> error "cannot split ops containing a row end"

92−

93

92

94-- | vector of span operation vectors for display. One per row of the output region.

93-- | vector of span operation vectors for display. One per row of the output region.

95type DisplayOps = Vector SpanOps

94type DisplayOps = Vector SpanOps

@@ -103,7 +102,7 @@ instance Show SpanOp where

103--

102--

104-- All spans are verified to define same number of columns. See: VerifySpanOps

103-- All spans are verified to define same number of columns. See: VerifySpanOps

105displayOpsColumns :: DisplayOps -> Int

104displayOpsColumns :: DisplayOps -> Int

106−displayOpsColumns ops

105+displayOpsColumns ops

107 | Vector.length ops == 0 = 0

106 | Vector.length ops == 0 = 0

108 | otherwise = Vector.length $ Vector.head ops

107 | otherwise = Vector.length $ Vector.head ops

109

108

@@ -117,7 +116,7 @@ effectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

117-- | The number of columns a SpanOps effects.

116-- | The number of columns a SpanOps effects.

118spanOpsEffectedColumns :: SpanOps -> Int

117spanOpsEffectedColumns :: SpanOps -> Int

119spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps

118spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps

120− where

119+ where

121 spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w

120 spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w

122 spanOpsEffectedColumns' t (Skip w) = t + w

121 spanOpsEffectedColumns' t (Skip w) = t + w

123 spanOpsEffectedColumns' t (RowEnd w) = t + w

122 spanOpsEffectedColumns' t (RowEnd w) = t + w

@@ -135,4 +134,3 @@ columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

135 in wcswidth (take cx str)

134 in wcswidth (take cx str)

136columnsToCharOffset cx (Skip _) = cx

135columnsToCharOffset cx (Skip _) = cx

137columnsToCharOffset cx (RowEnd _) = cx

136columnsToCharOffset cx (RowEnd _) = cx

138−

test/BenchNoDiffOpt.hs+2−2

@@ -16,7 +16,7 @@ import System.Environment( getArgs )

16import System.IO

17import System.Random

18

19−bench0 = do

19+bench0 = do

20 let fixedGen = mkStdGen 0

21 setStdGen fixedGen

22 vty <- mkVty def

@@ -29,7 +29,7 @@ bench0 = do

29 shutdown vty

30 return $ Bench images bench

31

32−flipOut vty n image0 image1 =

32+flipOut vty n image0 image1 =

33 let !pLeft = picForImage image0

34 !pRight = picForImage image1

35 wLeft 0 = return ()

test/BenchRenderChar.hs+1−1

@@ -23,7 +23,7 @@ bench0 = do

23 shutdown vty

24 return $ Bench testChars bench

25

26−testImageUsingChar c w h

26+testImageUsingChar c w h

27 = vertCat $ replicate (fromIntegral h)

28 $ horizCat $ map (char defAttr) (replicate (fromIntegral w) c)

29

test/BenchVerticalScroll.hs+3−4

@@ -14,7 +14,7 @@ import System.Environment( getArgs )

14import System.IO

15import System.Random

16

17−bench0 = do

17+bench0 = do

18 let fixedGen = mkStdGen 0

19 setStdGen fixedGen

20 return $ Bench (return ()) (\() -> mkVty def >>= liftM2 (>>) run shutdown)

@@ -49,13 +49,12 @@ pad :: Int -> Image -> Image

49pad ml img = img <|> charFill defAttr ' ' (ml - imageWidth img) 1

50

51clines :: StdGen -> Int -> [Image]

52−clines g maxll = map (pad maxll . horizCat . map (uncurry string))

52+clines g maxll = map (pad maxll . horizCat . map (uncurry string))

53 $ fold (length . snd) (lengths maxll g1) (nums g2)

54 where (g1,g2) = split g

55

56benchgen :: DisplayRegion -> [Picture]

57−benchgen (w,h)

57+benchgen (w,h)

58 = take 2000 $ map ((\i -> picForImage i) . vertCat . take (fromEnum h))

59 $ tails

60 $ clines (mkStdGen 80) w

61−

test/ControlTable.hs+1−1

@@ -5,7 +5,7 @@ import Graphics.Vty.ControlStrings

5import System.Console.Terminfo

6

7main = do

8− terminal <- setupTermFromEnv

8+ terminal <- setupTermFromEnv

9 controlTable <- init_controlTable terminal

10 putStrLn $ "ANSI terminal show cursor string: " ++ show cvis

11 putStrLn $ "Current terminal show cursor string: " ++ show (showCursorStr controlTable)

test/Issue18.hs+3−4

@@ -13,8 +13,8 @@ main = do

13 play vty sx sy

14

15play :: Vty -> Int -> Int -> IO ()

16−play vty sx sy =

16+play vty sx sy =

17− let

17+ let

18 testScreen = pic {

19 pCursor = NoCursor

20 , pImage = box 10 10 }

@@ -31,6 +31,5 @@ box w h =

31 vertLine = renderFill attr '|' 1 (h - 2)

32 horizLine = corner <|> renderHFill attr '-' (w - 2) <|> corner

33 centerArea = vertLine <|> renderFill attr 'X' (w - 2) (h - 2) <|> vertLine

34− in

34+ in

35 horizLine <-> centerArea <-> horizLine

36−

test/Makefile+2−2

@@ -45,7 +45,7 @@ all : $(VERIF_TESTS)

45

46.PHONY: $(TESTS)

47.SECONDEXPANSION:

48−$(TESTS) :

48+$(TESTS) :

49 @echo running test $@

50 @mkdir -p results/$@

51 ( ghc $(GHC_PROF_ARGS) $@ \

@@ -54,7 +54,7 @@ $(TESTS) :

54 )

55

56.PHONY: interactive_terminal_test

57−interactive_terminal_test :

57+interactive_terminal_test :

58 ghc $(GHC_ARGS) $@ && ./$@

59

60.PHONY: core

test/Verify.hs+3−4

@@ -35,7 +35,7 @@ import qualified Test.QuickCheck as QC

35import Test.QuickCheck.Modifiers

36import Test.QuickCheck.Property hiding ( Result(..) )

37import qualified Test.QuickCheck.Property as Prop

38−import Test.QuickCheck.Monadic ( monadicIO )

38+import Test.QuickCheck.Monadic ( monadicIO )

39

40import Text.Printf

41

@@ -56,7 +56,7 @@ verify testName p = Test $ TestInstance

56 case qcResult of

57 QC.Success {..} -> return $ Finished TS.Pass

58 QC.Failure {numShrinks,reason} -> return $ Finished

59− $ TS.Fail $ "After "

59+ $ TS.Fail $ "After "

60 ++ show numShrinks ++ " shrinks determined failure to be: "

61 ++ show reason

62 _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"

@@ -87,7 +87,7 @@ liftIOResult = ioProperty

87

88#if __GLASGOW_HASKELL__ <= 701

89instance Random Word where

90− random g =

90+ random g =

91 let (i :: Int, g') = random g

92 in (toEnum i, g')

93 randomR (l,h) g =

@@ -97,4 +97,3 @@ instance Random Word where

97

98data Bench where

99 Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench

100−

test/Verify/Data/Terminfo/Parse.hs+12−13

@@ -19,22 +19,22 @@ data NonParamCapString = NonParamCapString String

19 deriving Show

20

21instance Arbitrary NonParamCapString where

22− arbitrary

22+ arbitrary

23 = ( do

24 s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%')

25 return $ NonParamCapString s

26− ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )

26+ ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )

27

28data LiteralPercentCap = LiteralPercentCap String [Word8]

29 deriving ( Show )

30

31instance Arbitrary LiteralPercentCap where

32− arbitrary

32+ arbitrary

33 = ( do

34 NonParamCapString s <- arbitrary

35 (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s

36 return $ LiteralPercentCap s' bytes

37− ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )

37+ ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )

38

39data IncFirstTwoCap = IncFirstTwoCap String [Word8]

40 deriving ( Show )

@@ -45,7 +45,7 @@ instance Arbitrary IncFirstTwoCap where

45 NonParamCapString s <- arbitrary

46 (s', bytes) <- insertEscapeOp "i" [] s

47 return $ IncFirstTwoCap s' bytes

48− ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )

48+ ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )

49

50data PushParamCap = PushParamCap String Int [Word8]

51 deriving ( Show )

@@ -57,7 +57,7 @@ instance Arbitrary PushParamCap where

57 n <- choose (1,9)

58 (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s

59 return $ PushParamCap s' n bytes

60− ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )

60+ ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )

61

62data DecPrintCap = DecPrintCap String Int [Word8]

63 deriving ( Show )

@@ -69,7 +69,7 @@ instance Arbitrary DecPrintCap where

69 n <- choose (1,9)

70 (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s

71 return $ DecPrintCap s' n bytes

72− ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )

72+ ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )

73

74insertEscapeOp opStr replBytes s = do

75 insertPoints <- listOf1 $ elements [0 .. length s - 1]

@@ -92,21 +92,20 @@ bytesForRange cap offset count

92 = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap

93

94collectBytes :: CapExpression -> [Word8]

95−collectBytes e = concat [ bytes

95+collectBytes e = concat [ bytes

96 | Bytes offset count <- capOps e

97 , let bytes = bytesForRange e offset count

98 ]

99−

99+

100

101verifyBytesEqual :: [Word8] -> [Word8] -> Result

102−verifyBytesEqual outBytes expectedBytes

102+verifyBytesEqual outBytes expectedBytes

103 = if outBytes == expectedBytes

104 then succeeded

105− else failed

105+ else failed

106− { reason = "outBytes ["

106+ { reason = "outBytes ["

107 ++ hexDump outBytes

108 ++ "] /= expectedBytes ["

109 ++ hexDump expectedBytes

110 ++ "]"

111 }

112−

test/Verify/Graphics/Vty/Attributes.hs+2−3

@@ -40,8 +40,8 @@ allStyles =

40

41-- Limit the possible attributes to just a few for now.

42possibleAttrMods :: [ AttrOp ]

43−possibleAttrMods =

43+possibleAttrMods =

44− [ idOp

44+ [ idOp

45 ] ++ map setForeColorOp allColors

46 ++ map setBackColorOp allColors

47 ++ map setStyleOp allStyles

@@ -70,4 +70,3 @@ idOp = AttrOp "id" id

70

71applyOp :: AttrOp -> Attr -> Attr

72applyOp (AttrOp _ f) a = f a

73−

test/Verify/Graphics/Vty/Image.hs+10−11

@@ -26,7 +26,7 @@ instance Show UnitImage where

26data DefaultImage = DefaultImage Image

27

28instance Show DefaultImage where

29− show (DefaultImage i)

29+ show (DefaultImage i)

30 = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i)

31

32instance Arbitrary DefaultImage where

@@ -34,15 +34,15 @@ instance Arbitrary DefaultImage where

34 i <- return $ char defAttr 'X'

35 return $ DefaultImage i

36

37−data SingleRowSingleAttrImage

37+data SingleRowSingleAttrImage

38− = SingleRowSingleAttrImage

38+ = SingleRowSingleAttrImage

39 { expectedAttr :: Attr

40 , expectedColumns :: Int

41 , rowImage :: Image

42 }

43

44instance Show SingleRowSingleAttrImage where

45− show (SingleRowSingleAttrImage attr columns image)

45+ show (SingleRowSingleAttrImage attr columns image)

46 = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"

47

48newtype WidthResize = WidthResize (Image -> (Image, Int))

@@ -84,14 +84,14 @@ instance Arbitrary ImageResize where

84 , do

85 ImageResize f <- arbitrary

86 WidthResize g <- arbitrary

87− return $! ImageResize $! \i ->

87+ return $! ImageResize $! \i ->

88 let (i0, (_, outHeight)) = f i

89 gI = g i0

90 in (fst gI, (snd gI, outHeight))

91 , do

92 ImageResize f <- arbitrary

93 HeightResize g <- arbitrary

94− return $! ImageResize $! \i ->

94+ return $! ImageResize $! \i ->

95 let (i0, (outWidth, _)) = f i

96 gI = g i0

97 in (fst gI, (outWidth, snd gI))

@@ -109,8 +109,8 @@ instance Arbitrary SingleRowSingleAttrImage where

109 outWidth = length singleColumnRowText

110 return $ SingleRowSingleAttrImage a outWidth outImage

111

112−data SingleRowTwoAttrImage

112+data SingleRowTwoAttrImage

113− = SingleRowTwoAttrImage

113+ = SingleRowTwoAttrImage

114 { part0 :: SingleRowSingleAttrImage

115 , part1 :: SingleRowSingleAttrImage

116 , joinImage :: Image

@@ -122,8 +122,8 @@ instance Arbitrary SingleRowTwoAttrImage where

122 p1 <- arbitrary

123 return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1)

124

125−data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

125+data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

126− { stackImage :: Image

126+ { stackImage :: Image

127 , stackSourceImages :: [SingleRowSingleAttrImage]

128 , stackWidth :: Int

129 , stackHeight :: Int

@@ -215,4 +215,3 @@ instance Arbitrary Translation where

215 y <- arbitrary `suchThat` (> 0)

216 let i' = translate x y i

217 return $ Translation i (x,y) i'

218−

test/Verify/Graphics/Vty/Output.hs+1−2

@@ -15,7 +15,7 @@ import Test.QuickCheck.Property

15-- not be supported were removed. Then a few more were pruned until a reasonable looking set was

16-- made.

17terminalsOfInterest :: [String]

18−terminalsOfInterest =

18+terminalsOfInterest =

19 [ "vt100"

20 , "vt220"

21 , "vt102"

@@ -58,4 +58,3 @@ compareMockOutput mockData expectedStr = do

58 ++ expectedStr

59 }

60 else return succeeded

61−

test/Verify/Graphics/Vty/Picture.hs+8−9

@@ -14,9 +14,9 @@ import Verify.Graphics.Vty.Image

14

15import Verify

16

17−data DefaultPic = DefaultPic

17+data DefaultPic = DefaultPic

18 { defaultPic :: Picture

19− , defaultWin :: MockWindow

19+ , defaultWin :: MockWindow

20 }

21

22instance Show DefaultPic where

@@ -27,10 +27,10 @@ instance Arbitrary DefaultPic where

27 arbitrary = do

28 DefaultImage image <- arbitrary

29 let win = MockWindow (imageWidth image) (imageHeight image)

30− return $ DefaultPic (picForImage image)

30+ return $ DefaultPic (picForImage image)

31− win

31+ win

32

33−data PicWithBGAttr = PicWithBGAttr

33+data PicWithBGAttr = PicWithBGAttr

34 { withAttrPic :: Picture

35 , withAttrWin :: MockWindow

36 , withAttrSpecifiedAttr :: Attr

@@ -41,12 +41,11 @@ instance Arbitrary PicWithBGAttr where

41 DefaultImage image <- arbitrary

42 let win = MockWindow (imageWidth image) (imageHeight image)

43 attr <- arbitrary

44− return $ PicWithBGAttr (picForImage image)

44+ return $ PicWithBGAttr (picForImage image)

45− win

45+ win

46 attr

47−

47+

48instance Arbitrary Picture where

49 arbitrary = do

50 layers <- Verify.resize 20 (listOf1 arbitrary)

51 return $ picForLayers layers

52−

test/Verify/Graphics/Vty/Span.hs+1−2

@@ -22,7 +22,7 @@ verifyAllSpansHaveWidth i spans w

22 = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)

23 in case any ((== True) . fst) v of

24 False -> succeeded

25− True -> failed { reason = "Not all spans contained operations defining exactly "

25+ True -> failed { reason = "Not all spans contained operations defining exactly "

26 ++ show w

27 ++ " columns of output - \n"

28 ++ (concatMap ((++ "\n") . show)) v

@@ -34,4 +34,3 @@ verifyOpsEquality i_ops i_alt_ops =

34 else failed { reason = "ops for alternate image " ++ show i_alt_ops

35 ++ " are not the same as " ++ show i_ops

36 }

37−

test/VerifyCropSpanGeneration.hs+2−3

@@ -13,7 +13,7 @@ import Graphics.Vty.PictureToSpans

13

14import Verify

15

16−import qualified Data.Vector as Vector

16+import qualified Data.Vector as Vector

17

18cropOpDisplayOps :: (Int -> Image -> Image) ->

19 Int -> Image -> (DisplayOps, Image)

@@ -75,7 +75,7 @@ cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod`

75 in displayOpsForImage i == displayOpsForImage iAlt

76

77tests :: IO [Test]

78−tests = return

78+tests = return

79 [ verify "cropping from the bottom produces display operations covering the expected rows"

80 cropBottomOutputRows

81 , verify "cropping from the top produces display operations covering the expected rows"

@@ -90,4 +90,3 @@ tests = return

90 , verify "the output of a stack is the same as that stack cropped top & bottom and joined together"

91 cropTopAndBottomRejoinedEquivalence

92 ]

93−

test/VerifyEvalTerminfoCaps.hs+9−9

@@ -3,7 +3,7 @@

3module VerifyEvalTerminfoCaps where

4

5import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

6−import Data.Terminfo.Eval

6+import Data.Terminfo.Eval

7import Data.Terminfo.Parse

8import Control.DeepSeq

9

@@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, minusPtr)

25import Numeric

26

27-- If a terminal defines one of the caps then it's expected to be parsable.

28−capsOfInterest =

28+capsOfInterest =

29 [ "cup"

30 , "sc"

31 , "rc"

@@ -54,7 +54,7 @@ tests = do

54 putStrLn $ "adding tests for terminal: " ++ termName

55 mti <- try $ Terminfo.setupTerm termName

56 case mti of

57− Left (_e :: SomeException)

57+ Left (_e :: SomeException)

58 -> return []

59 Right ti -> do

60 fmap concat $ forM capsOfInterest $ \capName -> do

@@ -71,7 +71,7 @@ tests = do

71{-# NOINLINE verifyEvalCap #-}

72verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property

73verifyEvalCap evalBuffer expr !junkInt = do

74− forAll (vector 9) $ \inputValues ->

74+ forAll (vector 9) $ \inputValues ->

75 let write = writeCapExpr expr inputValues

76 !byteCount = getBound write

77 in liftIOResult $ do

@@ -79,12 +79,12 @@ verifyEvalCap evalBuffer expr !junkInt = do

79 forM_ [0..100] $ \i -> runWrite write startPtr

80 endPtr <- runWrite write startPtr

81 case endPtr `minusPtr` startPtr of

82− count | count < 0 ->

82+ count | count < 0 ->

83 return $ failed { reason = "End pointer before start pointer." }

84− | toEnum count > byteCount ->

84+ | toEnum count > byteCount ->

85− return $ failed { reason = "End pointer past end of buffer by "

85+ return $ failed { reason = "End pointer past end of buffer by "

86− ++ show (toEnum count - byteCount)

86+ ++ show (toEnum count - byteCount)

87 }

88− | otherwise ->

88+ | otherwise ->

89 return succeeded

90

test/VerifyImageOps.hs+25−26

@@ -9,43 +9,43 @@ import Verify

9import Control.DeepSeq

10

11twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool

12−twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =

12+twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =

13 imageWidth (char defAttr c1 <|> char defAttr c2) == 2

14

15manySwHorizConcat :: [SingleColumnChar] -> Bool

16−manySwHorizConcat cs =

16+manySwHorizConcat cs =

17 let chars = [ char | SingleColumnChar char <- cs ]

18 l = fromIntegral $ length cs

19 in imageWidth ( horizCat $ map (char defAttr) chars ) == l

20

21twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool

22−twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =

22+twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =

23 imageHeight (char defAttr c1 <-> char defAttr c2) == 2

24

25horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool

26−horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =

26+horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =

27− (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

27+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

28− ==

28+ ==

29 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)

30

31twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool

32−twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

32+twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

33 imageWidth (char defAttr c1 <|> char defAttr c2) == 4

34

35manyDwHorizConcat :: [DoubleColumnChar] -> Bool

36−manyDwHorizConcat cs =

36+manyDwHorizConcat cs =

37 let chars = [ char | DoubleColumnChar char <- cs ]

38 l = fromIntegral $ length cs

39 in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2

40

41twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool

42−twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

42+twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

43 imageHeight (char defAttr c1 <-> char defAttr c2) == 2

44

45horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool

46−horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =

46+horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =

47− (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

47+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

48− ==

48+ ==

49 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)

50

51vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool

@@ -54,9 +54,9 @@ vertContatSingleRow (NonEmpty stack) =

54 stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]

55 in imageHeight stackImage == expectedHeight

56

57−disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage

57+disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage

58− -> NonEmptyList SingleRowSingleAttrImage

58+ -> NonEmptyList SingleRowSingleAttrImage

59− -> Bool

59+ -> Bool

60disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =

61 let expectedHeight :: Int = max (length stack0) (length stack1)

62 stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

@@ -64,9 +64,9 @@ disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =

64 in imageHeight (stackImage0 <|> stackImage1) == expectedHeight

65

66

67−disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

67+disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

68− -> NonEmptyList SingleRowSingleAttrImage

68+ -> NonEmptyList SingleRowSingleAttrImage

69− -> Bool

69+ -> Bool

70disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

71 let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

72 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

@@ -74,31 +74,31 @@ disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

74 expectedHeight = imageHeight image

75 in case image of

76 HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) )

77− &&

77+ &&

78 ( expectedHeight == (imageHeight $ partRight image) )

79 _ -> True

80

81−disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage

81+disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage

82 -> NonEmptyList SingleRowSingleAttrImage

83 -> Bool

84disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =

85 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)

86 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

87 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

88− stack0Image = vertCat stack0Images

88+ stack0Image = vertCat stack0Images

89− stack1Image = vertCat stack1Images

89+ stack1Image = vertCat stack1Images

90 image = stack0Image <-> stack1Image

91 in imageWidth image == expectedWidth

92

93−disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

93+disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

94 -> NonEmptyList SingleRowSingleAttrImage

95 -> Bool

96disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

97 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)

98 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

99 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

100− stack0Image = vertCat stack0Images

100+ stack0Image = vertCat stack0Images

101− stack1Image = vertCat stack1Images

101+ stack1Image = vertCat stack1Images

102 image = stack0Image <-> stack1Image

103 in case image of

104 VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )

@@ -171,4 +171,3 @@ tests = return

171 , verify "can rnf image" canRnfImage

172 , verify "can pp image" canPpImage

173 ]

174−

test/VerifyImageTrans.hs+1−1

@@ -22,7 +22,7 @@ verifyHorizContatWAttrChangeSimplifies :: SingleRowTwoAttrImage -> Bool

22verifyHorizContatWAttrChangeSimplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 charCount0 _image0)

23 (SingleRowSingleAttrImage attr1 charCount1 _image1)

24 i

25− )

25+ )

26 | charCount0 == 0 || charCount1 == 0 || attr0 == attr1 = isHorizTextOfColumns i (charCount0 + charCount1)

27 | otherwise = False == isHorizTextOfColumns i (charCount0 + charCount1)

28

test/VerifyLayersSpanGeneration.hs+2−2

@@ -13,7 +13,7 @@ import Graphics.Vty.PictureToSpans

13

14import Verify

15

16−import qualified Data.Vector as Vector

16+import qualified Data.Vector as Vector

17

18largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

19largerHorizSpanOcclusion row0 row1 =

@@ -109,7 +109,7 @@ horizJoinAlternate1 =

109 in verifyOpsEquality expectedOps opsLayered

110

111tests :: IO [Test]

112−tests = return

112+tests = return

113 [ verify "a larger horiz span occludes a smaller span on a lower layer"

114 largerHorizSpanOcclusion

115 , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"

test/VerifyParseTerminfoCaps.hs+3−4

@@ -16,7 +16,7 @@ import Numeric

16

17-- If a terminal defines one of the caps then it's expected to be parsable.

18-- TODO: reduce duplication with terminfo terminal implementation.

19−capsOfInterest =

19+capsOfInterest =

20 [ "cup"

21 , "sc"

22 , "rc"

@@ -65,7 +65,7 @@ verifyParseCap capString onParse =

65 Right e -> onParse e

66

67nonParamaterizedCaps (NonParamCapString cap) = do

68− verifyParseCap cap $ \e ->

68+ verifyParseCap cap $ \e ->

69 let expectedBytes = map (toEnum . fromEnum) cap

70 outBytes = bytesForRange e 0 (length cap)

71 in verifyBytesEqual outBytes expectedBytes

@@ -75,7 +75,7 @@ literalPercentCaps (LiteralPercentCap capString expectedBytes) = do

75

76incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do

77 verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes

78−

78+

79pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do

80 verifyParseCap capString $ \e ->

81 let outBytes = collectBytes e

@@ -98,4 +98,3 @@ printCap ti capName = do

98printExpression ti capName = do

99 let parseResult = parseCapExpression $ fromCapname ti capName

100 putStrLn $ capName ++ ": " ++ show parseResult

101−

test/VerifySimpleSpanGeneration.hs+8−8

@@ -13,28 +13,28 @@ import Graphics.Vty.PictureToSpans

13

14import Verify

15

16−import qualified Data.Vector as Vector

16+import qualified Data.Vector as Vector

17

18unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool

19−unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =

19+unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =

20 let p = picForImage i

21 ops = displayOpsForPic p (regionForWindow w)

22 in displayOpsColumns ops == 0 && displayOpsRows ops == 0

23

24unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool

25−unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =

25+unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =

26 let p = picForImage i

27 ops = displayOpsForPic p (regionForWindow w)

28 in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

29

30horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

31−horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

31+horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

32 let p = picForImage i

33 ops = displayOpsForPic p (regionForWindow w)

34 in displayOpsColumns ops == 0 && displayOpsRows ops == 0

35

36horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

37−horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

37+horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

38 let p = picForImage i

39 ops = displayOpsForPic p (regionForWindow w)

40 in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

@@ -139,7 +139,7 @@ spanOpsActuallyFillColumns (DefaultPic pic win) =

139 in allSpansHaveWidth ops expectedColumnCount

140

141firstSpanOpSetsAttr :: DefaultPic -> Bool

142−firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =

142+firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =

143 let ops = displayOpsForPic pic (regionForWindow win)

144 in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops )

145

@@ -158,7 +158,7 @@ imageCoverageMatchesBounds i =

158 in verifyAllSpansHaveWidth i ops (imageWidth i)

159

160tests :: IO [Test]

161−tests = return

161+tests = return

162 [ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0

163 , verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1

164 , verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0

@@ -171,7 +171,7 @@ tests = return

171 , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"

172 singleAttrSingleSpanStackOpCoverage

173 , verify "a single attr text span is cropped when window size < size of stack image [width]"

174− singleAttrSingleSpanStackCropped0

174+ singleAttrSingleSpanStackCropped0

175 , verify "a single attr text span is cropped when window size < size of stack image [height]"

176 singleAttrSingleSpanStackCropped1

177 , verify "single attr text span <|> single attr text span display cropped. [width]"

test/VerifyUsingMockTerminal.hs+1−1

@@ -49,7 +49,7 @@ singleTRow (MockWindow w h) = liftIOResult $ do

49 let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T'

50 ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B')

51 compareMockOutput mockData expected

52−

52+

53manyTRows :: MockWindow -> Property

54manyTRows (MockWindow w h) = liftIOResult $ do

55 (mockData, t) <- mockTerminal (w,h)

test/interactive_terminal_test.hs+49−49

@@ -19,7 +19,7 @@ import Data.Monoid

19import Data.String.QQ

20import Data.Word

21

22−import Foreign.Marshal.Array

22+import Foreign.Marshal.Array

23

24import qualified System.Environment as Env

25

@@ -74,12 +74,12 @@ with the test_results.list file pasted into the issue. A suitable summary is:

74|]

75 waitForReturn

76 results <- doTestMenu 1

77− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )

77+ envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )

78− ( \ (_ :: SomeException) -> return (envName, "") )

78+ ( \ (_ :: SomeException) -> return (envName, "") )

79− )

79+ )

80 [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]

81 t <- standardIOConfig >>= outputForConfig

82− let resultsTxt = show envAttributes ++ "\n"

82+ let resultsTxt = show envAttributes ++ "\n"

83 ++ terminalID t ++ "\n"

84 ++ show results ++ "\n"

85 releaseTerminal t

@@ -94,7 +94,7 @@ testMenu :: [(String, Test)]

94testMenu = zip (map show [1..]) allTests

95

96doTestMenu :: Int -> IO [(String, Bool)]

97−doTestMenu nextID

97+doTestMenu nextID

98 | nextID > length allTests = do

99 putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"

100 return []

@@ -108,26 +108,26 @@ doTestMenu nextID

108 s <- getLine >>= return . filter (/= '\n')

109 case s of

110 "q" -> return mempty

111− "" -> do

111+ "" -> do

112− r <- runTest $ show nextID

112+ r <- runTest $ show nextID

113 rs <- doTestMenu ( nextID + 1 )

114 return $ r : rs

115 i | isJust ( lookup i testMenu ) -> do

116− r <- runTest i

116+ r <- runTest i

117 rs <- doTestMenu ( read i + 1 )

118 return $ r : rs

119 where

120− displayTestMenu

120+ displayTestMenu

121 = mapM_ displayTestMenu' testMenu

122− displayTestMenu' ( i, t )

122+ displayTestMenu' ( i, t )

123− = putStrLn $ ( if i == show nextID

123+ = putStrLn $ ( if i == show nextID

124− then "> "

124+ then "> "

125 else " "

126 ) ++ i ++ ". " ++ testName t

127

128runTest :: String -> IO (String, Bool)

129runTest i = do

130− let t = fromJust $ lookup i testMenu

130+ let t = fromJust $ lookup i testMenu

131 printSummary t

132 waitForReturn

133 testAction t

@@ -153,8 +153,8 @@ data Test = Test

153 , confirmResults :: IO Bool

154 }

155

156−allTests

156+allTests

157− = [ reserveOutputTest

157+ = [ reserveOutputTest

158 , displayBoundsTest0

159 , displayBoundsTest1

160 , displayBoundsTest2

@@ -185,7 +185,7 @@ allTests

185 , layer1

186 ]

187

188−reserveOutputTest = Test

188+reserveOutputTest = Test

189 { testName = "Initialize and reserve terminal output then restore previous state."

190 , testID = "reserveOutputTest"

191 , testAction = do

@@ -203,7 +203,7 @@ reserveOutputTest = Test

203 , printSummary = do

204 putStr $ [s|

205Once return is pressed:

206− 0. The screen will be cleared.

206+ 0. The screen will be cleared.

207 1. Four lines of text should be visible.

208 1. The cursor should be visible and at the start of the fifth line.

209

@@ -391,7 +391,7 @@ utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]

391

392iso10646Txt0 :: String

393iso10646Txt0 = map toEnum

394− [ 8593

394+ [ 8593

395 , 8593

396 , 8595

397 , 8595

@@ -554,11 +554,11 @@ After return is pressed for the second time:

554allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]

555 [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]

556

557−allBrightColors

557+allBrightColors

558 = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]

559 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]

560

561−attributesTest0 = Test

561+attributesTest0 = Test

562 { testName = "Character attributes: foreground colors."

563 , testID = "attributesTest0"

564 , testAction = do

@@ -604,7 +604,7 @@ Did the test output match the description?

604 defaultSuccessConfirmResults

605 }

606

607−attributesTest1 = Test

607+attributesTest1 = Test

608 { testName = "Character attributes: background colors."

609 , testID = "attributesTest1"

610 , testAction = do

@@ -659,7 +659,7 @@ Did the test output match the description?

659 defaultSuccessConfirmResults

660 }

661

662−attributesTest2 = Test

662+attributesTest2 = Test

663 { testName = "Character attributes: Vivid foreground colors."

664 , testID = "attributesTest2"

665 , testAction = do

@@ -686,23 +686,23 @@ Once return is pressed:

686 1. The cursor will be hidden.

687 2. 9 lines of text in three columns will be drawn:

688 a. The first column will be a name of a standard color (for an 8 color

689− terminal) rendered with that color as the foreground color.

689+ terminal) rendered with that color as the foreground color.

690 b. The next column will be also be the name of a standard color rendered

691 with that color as the foreground color but the shade used should be

692− more vivid than the shade used in the first column.

692+ more vivid than the shade used in the first column.

693 c. The final column will be the name of a color rendered with the

694 default attributes.

695

696For instance, one line will be the word "magenta" and that word should be

697−rendered in the magenta color.

697+rendered in the magenta color.

698

699I'm not actually sure exactly what "vivid" means in this context. For xterm the

700−vivid colors are brighter.

700+vivid colors are brighter.

701

702−Verify:

702+Verify:

703 * The first column: The foreground color matches the named color.

704 * The second column: The foreground color matches the named color but is

705− more vivid than the color used in the first column.

705+ more vivid than the color used in the first column.

706 * The third column: All text is rendered with the default attributes.

707 * The vertical bars used in each line to mark the border of a column are

708 lined up.

@@ -718,7 +718,7 @@ Did the test output match the description?

718 defaultSuccessConfirmResults

719 }

720

721−attributesTest3 = Test

721+attributesTest3 = Test

722 { testName = "Character attributes: Vivid background colors."

723 , testID = "attributesTest3"

724 , testAction = do

@@ -746,23 +746,23 @@ Once return is pressed:

746 2. 9 lines of text in three columns will be drawn:

747 a. The first column will contain be a name of a standard color for an 8

748 color terminal rendered with the default foreground color with a

749− background the named color.

749+ background the named color.

750 b. The first column will contain be a name of a standard color for an 8

751 color terminal rendered with the default foreground color with the

752− background a vivid version of the named color.

752+ background a vivid version of the named color.

753 c. The third column will be the name of a standard color rendered with

754 the default attributes.

755−

755+

756For instance, one line will contain be the word "magenta" and the word should

757−be rendered in the default foreground color over a magenta background.

757+be rendered in the default foreground color over a magenta background.

758

759I'm not actually sure exactly what "vivid" means in this context. For xterm the

760vivid colors are brighter.

761

762−Verify:

762+Verify:

763 * The first column: The background color matches the named color.

764 * The second column: The background color matches the named color and is

765− more vivid than the color used in the first column.

765+ more vivid than the color used in the first column.

766 * The third column column: All text is rendered with the default attributes.

767 * The vertical bars used in each line to mark the border of a column are

768 lined up.

@@ -785,7 +785,7 @@ Did the test output match the description?

785 defaultSuccessConfirmResults

786 }

787

788−attrCombos =

788+attrCombos =

789 [ ( "default", id )

790 , ( "bold", flip withStyle bold )

791 , ( "blink", flip withStyle blink )

@@ -796,7 +796,7 @@ attrCombos =

796 , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )

797 ]

798

799−attributesTest4 = Test

799+attributesTest4 = Test

800 { testName = "Character attributes: Bold; Blink; Underline."

801 , testID = "attributesTest4"

802 , testAction = do

@@ -819,10 +819,10 @@ attributesTest4 = Test

819Once return is pressed:

820 0. The screen will be cleared.

821 1. The cursor will be hidden.

822− 2. 8 rows of text in two columns.

822+ 2. 8 rows of text in two columns.

823 The rows will contain the following text:

824 default

825− bold

825+ bold

826 blink

827 underline

828 bold + blink

@@ -831,8 +831,8 @@ Once return is pressed:

831 bold + blink + underline

832 The first column will be rendered with the described attributes. The second

833 column will be rendered with the default attributes.

834−

834+

835−Verify:

835+Verify:

836 * The vertical bars used in each line to mark the border of a column are

837 lined up.

838 * The text in the first column is rendered as described.

@@ -848,7 +848,7 @@ Did the test output match the description?

848 defaultSuccessConfirmResults

849 }

850

851−attributesTest5 = Test

851+attributesTest5 = Test

852 { testName = "Character attributes: 240 color palette"

853 , testID = "attributesTest5"

854 , testAction = do

@@ -873,7 +873,7 @@ Once return is pressed:

873 2. A 20 character wide and 12 row high block of color squares. This should look like a palette

874 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...

875

876−Verify:

876+Verify:

877

878After return is pressed for the second time:

879 0. The screen containing the test summary should be restored.

@@ -971,7 +971,7 @@ outputPicAndWait pic = do

971 releaseDisplay t

972 releaseTerminal t

973 return ()

974−

974+

975vertCropTest0 :: Test

976vertCropTest0 = Test

977 { testName = "Verify bottom cropping works as expected with single column chars"

@@ -1046,7 +1046,7 @@ horizCropTest0 = Test

1046 , testID = "cropTest0"

1047 , testAction = do

1048 let baseImage = vertCat $ map (string defAttr) lorumIpsum

1049− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1049+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1050 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

1051 outputImageAndWait image

1052 , printSummary = putStr $ [s|

@@ -1063,7 +1063,7 @@ horizCropTest1 = Test

1063 , testID = "cropTest0"

1064 , testAction = do

1065 let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese

1066− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1066+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1067 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

1068 outputImageAndWait image

1069 , printSummary = putStr $ [s|

@@ -1080,7 +1080,7 @@ horizCropTest2 = Test

1080 , testID = "cropTest0"

1081 , testAction = do

1082 let baseImage = vertCat $ map (string defAttr) lorumIpsum

1083− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1083+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1084 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

1085 outputImageAndWait image

1086 , printSummary = putStr $ [s|

@@ -1097,7 +1097,7 @@ horizCropTest3 = Test

1097 , testID = "cropTest0"

1098 , testAction = do

1099 let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese

1100− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1100+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1101 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

1102 outputImageAndWait image

1103 , printSummary = putStr $ [s|