82fd9c4 · vty · git.iko.soy

CHANGELOG+9−7

@@ -3,13 +3,15 @@

33 * Attr record accessor fore_color changed to attr_fore_color

44 * Attr record accessor back_color changed to attr_back_color

55 * Attr record accessor style changed to attr_style

6− * Added an "inline" attribute changing DSL:

7− * put_attr_change applies and attribute change monad action

8− * can be used to change the display attrbiutes of text output via putStrLn and putStr,

9− for instance. EX: "put_attr_change $ back_color red" will set the background color to

10− red.

11− * Does not apply to output_picture.

12− * See Graphics.Vty.AttributeChange

6+ * Added an "inline" display attribute changing DSL:

7+ * put_attr_change applies a display attribute change immediately to a terminal

8+ * For instance, can be used to change the display attrbiutes of text output via putStrLn

9+ and putStr. EX: "put_attr_change $ back_color red" will set the

10+ background color to red.

11+ * Changes do not apply to a Picture output via output_picture.

12+ * See Graphics.Vty.Inline

13+ * Moved all IO actions into any monad an instance of MonadIO

14+

13154.0.0.1

1416 * binding for mk_wcswidth was incorrect. Most platforms just magically worked due to

1517 coincidence.

src/Data/Terminfo/Eval.hs+9−7

@@ -15,16 +15,18 @@ module Data.Terminfo.Eval ( cap_expression_required_bytes

1515import Data.Marshalling

1616import Data.Terminfo.Parse

1717

18+import Control.Monad.Identity

1819import Control.Monad.Reader

1920import Control.Monad.State.Strict

21+import Control.Monad.Trans

2022

2123import Data.Array.Unboxed

2224import Data.Bits ( (.|.) )

2325import Data.List

2426import Data.Word

2527

26−type Eval a = ReaderT (CapExpression,[CapParam]) (State [CapParam]) a

27−type EvalIO a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] IO) a

28+type EvalT m a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] m) a

29+type Eval a = EvalT Identity a

2830

2931pop :: MonadState [CapParam] m => m CapParam

3032pop = do

@@ -61,7 +63,7 @@ bytes_for_range cap (offset, count)

6163cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word

6264cap_expression_required_bytes cap params =

6365 let params' = apply_param_ops cap params

64− in fst $ runState (runReaderT (cap_ops_required_bytes $ cap_ops cap) (cap, params)) []

66+ in fst $! runIdentity $ runStateT (runReaderT (cap_ops_required_bytes $ cap_ops cap) (cap, params')) []

6567

6668cap_ops_required_bytes :: CapOps -> Eval Word

6769cap_ops_required_bytes ops = do

@@ -104,16 +106,16 @@ cap_op_required_bytes CompareEq = do

104106cap_op_required_bytes (LiteralInt i) = do

105107 return $ toEnum $ length $ show i

106108

107−serialize_cap_expression :: CapExpression -> [CapParam] -> OutputBuffer -> IO OutputBuffer

109+serialize_cap_expression :: MonadIO m => CapExpression -> [CapParam] -> OutputBuffer -> m OutputBuffer

108110serialize_cap_expression cap params out_ptr = do

109111 let params' = apply_param_ops cap params

110− (out_ptr', _) <- runStateT (runReaderT (serialize_cap_ops out_ptr (cap_ops cap)) (cap, params')) []

112+ (!out_ptr', _) <- runStateT (runReaderT (serialize_cap_ops out_ptr (cap_ops cap)) (cap, params')) []

111113 return out_ptr'

112114

113−serialize_cap_ops :: OutputBuffer -> CapOps -> EvalIO OutputBuffer

115+serialize_cap_ops :: MonadIO m => OutputBuffer -> CapOps -> EvalT m OutputBuffer

114116serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops

115117

116−serialize_cap_op :: OutputBuffer -> CapOp -> EvalIO OutputBuffer

118+serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer

117119serialize_cap_op out_ptr (Bytes (offset, c)) = do

118120 (cap, _) <- ask

119121 let out_bytes = bytes_for_range cap (offset, c)

src/Graphics/Vty/AttributeChange.hs+3−1

@@ -7,7 +7,9 @@ import Graphics.Vty.Attributes

77import Graphics.Vty.DisplayAttributes

88import Graphics.Vty.Terminal.Generic

99

10+import Control.Applicative

1011import Control.Monad.State.Strict

12+import Control.Monad.Trans

1113

1214import Data.Bits ( (.&.), complement )

1315import Data.Monoid ( mappend )

@@ -67,7 +69,7 @@ remove_all_styles =

6769 , RemoveBold

6870 ]

6971

70−put_attr_change :: TerminalHandle -> AttrChange () -> IO ()

72+put_attr_change :: MonadIO m => TerminalHandle -> AttrChange () -> m ()

7173put_attr_change t c = do

7274 return ()

7375

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

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

99import Graphics.Vty.Image.Debug

1010import Graphics.Vty.Picture

1111import Graphics.Vty.Span

12−import Graphics.Vty.WinRegion

12+import Graphics.Vty.DisplayRegion

1313

1414import Control.Monad

1515import Data.Array

@@ -45,11 +45,10 @@ is_set_attr _attr _event = False

4545data DebugWindow = DebugWindow Word Word

4646 deriving (Show, Eq)

4747

48−type TestWindow = DebugWindow

48+region_for_window :: DebugWindow -> DisplayRegion

49+region_for_window (DebugWindow w h) = DisplayRegion w h

4950

50−instance WinRegion DebugWindow where

51− win_width (DebugWindow w _) = w

52− win_height (DebugWindow _ h) = h

51+type TestWindow = DebugWindow

5352

5453type ImageConstructLog = [ImageConstructEvent]

5554data ImageConstructEvent = ImageConstructEvent

src/Graphics/Vty/Span.hs+6

@@ -54,6 +54,12 @@ data SpanOpSequence = SpanOpSequence

5454type RowOps = Array Word SpanOps

5555type SpanOps = [SpanOp]

5656

57+span_ops_columns :: SpanOpSequence -> Word

58+span_ops_columns ops = region_width $ effected_region ops

59+

60+span_ops_rows :: SpanOpSequence -> Word

61+span_ops_rows ops = region_height $ effected_region ops

62+

5763span_ops_effected_columns :: [SpanOp] -> Word

5864span_ops_effected_columns in_ops = span_ops_effected_columns' 0 in_ops

5965 where

src/Graphics/Vty/Terminal.hs+10−7

@@ -29,7 +29,10 @@ import Graphics.Vty.Terminal.MacOSX as MacOSX

2929import Graphics.Vty.Terminal.XTermColor as XTermColor

3030import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

3131

32+import Control.Applicative

3233import Control.Exception ( SomeException, try )

34+import Control.Monad.Trans

35+

3336import Data.Either

3437import Data.List ( isPrefixOf )

3538import Data.Word

@@ -70,9 +73,9 @@ import System.Environment

7073-- with only what is provided in the haskell platform.

7174--

7275-- todo: The Terminal interface does not provide any input support.

73−terminal_handle :: IO TerminalHandle

76+terminal_handle :: ( Applicative m, MonadIO m ) => m TerminalHandle

7477terminal_handle = do

75− term_type <- getEnv "TERM"

78+ term_type <- liftIO $ getEnv "TERM"

7679 t <- if "xterm" `isPrefixOf` term_type

7780 then do

7881 maybe_terminal_app <- get_env "TERM_PROGRAM"

@@ -83,7 +86,7 @@ terminal_handle = do

8386 -> do

8487 maybe_xterm <- get_env "XTERM_VERSION"

8588 case maybe_xterm of

86− Nothing -> MacOSX.terminal_instance >>= new_terminal_handle

89+ Nothing -> MacOSX.terminal_instance v >>= new_terminal_handle

8790 Just _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle

8891 -- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app

8992 -- like terminal?

@@ -93,7 +96,7 @@ terminal_handle = do

9396 return t

9497 where

9598 get_env var = do

96− mv <- try $ getEnv var

99+ mv <- liftIO $ try $ getEnv var

97100 case mv of

98101 Left (_e :: SomeException) -> return $ Nothing

99102 Right v -> return $ Just v

@@ -105,21 +108,21 @@ terminal_handle = do

105108--

106109-- Currently, the only way to set the cursor position to a given character coordinate is to specify

107110-- the coordinate in the Picture instance provided to output_picture or refresh.

108−set_cursor_pos :: TerminalHandle -> Word -> Word -> IO ()

111+set_cursor_pos :: MonadIO m => TerminalHandle -> Word -> Word -> m ()

109112set_cursor_pos t x y = do

110113 bounds <- display_bounds t

111114 d <- display_context t bounds

112115 marshall_to_terminal t (move_cursor_required_bytes d x y) (serialize_move_cursor d x y)

113116

114117-- | Hides the cursor

115−hide_cursor :: TerminalHandle -> IO ()

118+hide_cursor :: MonadIO m => TerminalHandle -> m ()

116119hide_cursor t = do

117120 bounds <- display_bounds t

118121 d <- display_context t bounds

119122 marshall_to_terminal t (hide_cursor_required_bytes d) (serialize_hide_cursor d)

120123

121124-- | Shows the cursor

122−show_cursor :: TerminalHandle -> IO ()

125+show_cursor :: MonadIO m => TerminalHandle -> m ()

123126show_cursor t = do

124127 bounds <- display_bounds t

125128 d <- display_context t bounds

src/Graphics/Vty/Terminal/Debug.hs+18−16

@@ -8,9 +8,11 @@ module Graphics.Vty.Terminal.Debug ( DebugTerminal(..)

88 )

99 where

1010

11−import Graphics.Vty.WinRegion

11+import Graphics.Vty.DisplayRegion

1212import Graphics.Vty.Terminal.Generic

1313

14+import Control.Applicative

15+import Control.Monad.Trans

1416import Control.Monad.State.Strict

1517

1618import qualified Data.ByteString.UTF8 as BS

@@ -43,7 +45,7 @@ import Unsafe.Coerce

4345

4446data DebugTerminal = DebugTerminal

4547 { debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)

46− , debug_terminal_bounds :: DisplayBounds

48+ , debug_terminal_bounds :: DisplayRegion

4749 }

4850

4951instance Terminal DebugTerminal where

@@ -52,36 +54,36 @@ instance Terminal DebugTerminal where

5254 reserve_display _t = return ()

5355 release_display _t = return ()

5456 display_bounds t = return $ debug_terminal_bounds t

55− display_context t bounds = return $ DisplayHandle (DebugDisplay bounds) (TerminalHandle t)

57+ display_terminal_instance t r c = return $ c (DebugDisplay r)

5658 output_byte_buffer t out_buffer buffer_size

57− = do

59+ = liftIO $ do

5860 putStrLn $ "output_byte_buffer ?? " ++ show buffer_size

5961 peekArray (fromEnum buffer_size) out_buffer

6062 >>= return . UTF8.fromRep . BSCore.pack

6163 >>= writeIORef (debug_terminal_last_output t)

6264

6365data DebugDisplay = DebugDisplay

64− { debug_display_bounds :: DisplayBounds

66+ { debug_display_bounds :: DisplayRegion

6567 }

6668

67−terminal_instance :: DisplayBounds -> IO TerminalHandle

68−terminal_instance bounds = do

69− output_ref <- newIORef undefined

70− return $ TerminalHandle $ DebugTerminal output_ref bounds

69+terminal_instance :: ( Applicative m, MonadIO m ) => DisplayRegion -> m TerminalHandle

70+terminal_instance r = do

71+ output_ref <- liftIO $ newIORef undefined

72+ new_terminal_handle $ DebugTerminal output_ref r

7173

7274dehandle :: TerminalHandle -> DebugTerminal

73−dehandle (TerminalHandle t) = unsafeCoerce t

75+dehandle (TerminalHandle t _) = unsafeCoerce t

7476

7577instance DisplayTerminal DebugDisplay where

7678 -- | Provide the current bounds of the output terminal.

77− context_bounds d = debug_display_bounds d

79+ context_region d = debug_display_bounds d

7880

7981 -- | A cursor move is always visualized as the single character 'M'

8082 move_cursor_required_bytes _d _x _y = 1

8183

8284 -- | A cursor move is always visualized as the single character 'M'

8385 serialize_move_cursor _d _x _y ptr = do

84− poke ptr (toEnum $ fromEnum 'M')

86+ liftIO $ poke ptr (toEnum $ fromEnum 'M')

8587 return $ ptr `plusPtr` 1

8688

8789 -- | Show cursor is always visualized as the single character 'S'

@@ -89,7 +91,7 @@ instance DisplayTerminal DebugDisplay where

8991

9092 -- | Show cursor is always visualized as the single character 'S'

9193 serialize_show_cursor _d ptr = do

92− poke ptr (toEnum $ fromEnum 'S')

94+ liftIO $ poke ptr (toEnum $ fromEnum 'S')

9395 return $ ptr `plusPtr` 1

9496

9597 -- | Hide cursor is always visualized as the single character 'H'

@@ -97,7 +99,7 @@ instance DisplayTerminal DebugDisplay where

9799

98100 -- | Hide cursor is always visualized as the single character 'H'

99101 serialize_hide_cursor _d ptr = do

100− poke ptr (toEnum $ fromEnum 'H')

102+ liftIO $ poke ptr (toEnum $ fromEnum 'H')

101103 return $ ptr `plusPtr` 1

102104

103105 -- | An attr change is always visualized as the single character 'A'

@@ -105,11 +107,11 @@ instance DisplayTerminal DebugDisplay where

105107

106108 -- | An attr change is always visualized as the single character 'A'

107109 serialize_set_attr _d _fattr _attr ptr = do

108− poke ptr (toEnum $ fromEnum 'A')

110+ liftIO $ poke ptr (toEnum $ fromEnum 'A')

109111 return $ ptr `plusPtr` 1

110112

111113 default_attr_required_bytes _d = 1

112114 serialize_default_attr _d ptr = do

113− poke ptr (toEnum $ fromEnum 'D')

115+ liftIO $ poke ptr (toEnum $ fromEnum 'D')

114116 return $ ptr `plusPtr` 1

115117

src/Graphics/Vty/Terminal/Generic.hs+36−32

@@ -18,6 +18,7 @@ import Graphics.Vty.DisplayRegion

1818import Graphics.Vty.DisplayAttributes

1919

2020import Control.Monad ( liftM )

21+import Control.Monad.Trans

2122

2223import Data.Array

2324import qualified Data.ByteString.Internal as BSCore

@@ -34,7 +35,7 @@ data TerminalHandle where

3435terminal_state :: TerminalHandle -> TerminalState

3536terminal_state (TerminalHandle _ s) = s

3637

37−new_terminal_handle :: forall t. Terminal t => t -> IO TerminalHandle

38+new_terminal_handle :: forall m t. ( MonadIO m, Terminal t ) => t -> m TerminalHandle

3839new_terminal_handle t = liftM (TerminalHandle t) initial_terminal_state

3940

4041data TerminalState = TerminalState

@@ -42,14 +43,14 @@ data TerminalState = TerminalState

4243 current_attr :: Maybe FixedAttr

4344 }

4445

45−initial_terminal_state :: IO TerminalState

46+initial_terminal_state :: MonadIO m => m TerminalState

4647initial_terminal_state = return $ TerminalState Nothing

4748

4849class Terminal t where

4950 -- | Text identifier for the terminal. Used for debugging.

5051 terminal_ID :: t -> String

5152 -- |

52− release_terminal :: t -> IO ()

53+ release_terminal :: MonadIO m => t -> m ()

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

5455 --

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

@@ -61,25 +62,26 @@ class Terminal t where

6162 -- access to a display such that:

6263 -- - The previous state cannot be determined

6364 -- - When exclusive access to a display is release the display returns to the previous state.

64− reserve_display :: t -> IO ()

65+ reserve_display :: MonadIO m => t -> m ()

6566

6667 -- | Return the display to the state before reserve_display

6768 -- If no previous state then set the display state to the initial state.

68− release_display :: t -> IO ()

69+ release_display :: MonadIO m => t -> m ()

6970

7071 -- | Returns the current display bounds.

71− display_bounds :: t -> IO DisplayRegion

72+ display_bounds :: MonadIO m => t -> m DisplayRegion

7273

7374 -- Internal method used to provide the DisplayTerminal instance to the DisplayHandle

7475 -- constructor.

75− display_terminal_instance :: t

76+ display_terminal_instance :: MonadIO m

77+ => t

7678 -> DisplayRegion

7779 -> (forall d. DisplayTerminal d => d -> DisplayHandle)

78− -> IO DisplayHandle

80+ -> m DisplayHandle

7981

8082 -- | Output the byte buffer of the specified size to the terminal device. The size is equal to

8183 -- end_ptr - start_ptr

82− output_byte_buffer :: t -> OutputBuffer -> Word -> IO ()

84+ output_byte_buffer :: MonadIO m => t -> OutputBuffer -> Word -> m ()

8385

8486instance Terminal TerminalHandle where

8587 terminal_ID (TerminalHandle t _) = terminal_ID t

@@ -96,7 +98,7 @@ data DisplayHandle where

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

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

98100-- (max display_width provided_width, max display_height provided_height)

99−display_context :: TerminalHandle -> DisplayRegion -> IO DisplayHandle

101+display_context :: MonadIO m => TerminalHandle -> DisplayRegion -> m DisplayHandle

100102display_context t b = do

101103 s <- initial_display_state

102104 let c d = DisplayHandle d t s

@@ -106,8 +108,8 @@ data DisplayState = DisplayState

106108 { previous_output_ref :: IORef (Maybe SpanOpSequence)

107109 }

108110

109−initial_display_state :: IO DisplayState

110−initial_display_state = liftM DisplayState $ newIORef Nothing

111+initial_display_state :: MonadIO m => m DisplayState

112+initial_display_state = liftM DisplayState $ liftIO $ newIORef Nothing

111113

112114class DisplayTerminal d where

113115 -- | Provide the bounds of the display context.

@@ -119,13 +121,13 @@ class DisplayTerminal d where

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

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

121123 move_cursor_required_bytes :: d -> Word -> Word -> Word

122− serialize_move_cursor :: d -> Word -> Word -> OutputBuffer -> IO OutputBuffer

124+ serialize_move_cursor :: MonadIO m => d -> Word -> Word -> OutputBuffer -> m OutputBuffer

123125

124126 show_cursor_required_bytes :: d -> Word

125− serialize_show_cursor :: d -> OutputBuffer -> IO OutputBuffer

127+ serialize_show_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

126128

127129 hide_cursor_required_bytes :: d -> Word

128− serialize_hide_cursor :: d -> OutputBuffer -> IO OutputBuffer

130+ serialize_hide_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

129131

130132 -- | Assure the specified output attributes will be applied to all the following text until the

131133 -- next output attribute change. Where the number of bytes required for the control codes can

@@ -139,11 +141,11 @@ class DisplayTerminal d where

139141 -- In addition it may be possible to optimize the state changes based off the currently applied

140142 -- display attributes.

141143 attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> Word

142− serialize_set_attr :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> OutputBuffer -> IO OutputBuffer

144+ serialize_set_attr :: MonadIO m => d -> FixedAttr -> Attr -> DisplayAttrDiff -> OutputBuffer -> m OutputBuffer

143145

144146 -- | Reset the display attributes to the default display attributes

145147 default_attr_required_bytes :: d -> Word

146− serialize_default_attr :: d -> OutputBuffer -> IO OutputBuffer

148+ serialize_default_attr :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

147149

148150

149151instance DisplayTerminal DisplayHandle where

@@ -167,10 +169,10 @@ utf8_text_required_bytes str =

167169 in toEnum src_bytes_length

168170

169171-- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.

170−serialize_utf8_text :: UTF8 BSCore.ByteString -> OutputBuffer -> IO OutputBuffer

172+serialize_utf8_text :: MonadIO m => UTF8 BSCore.ByteString -> OutputBuffer -> m OutputBuffer

171173serialize_utf8_text str dest_ptr =

172174 let (src_fptr, src_ptr_offset, src_bytes_length) = BSCore.toForeignPtr (toRep str)

173− in withForeignPtr src_fptr $ \src_ptr -> do

175+ in liftIO $ withForeignPtr src_fptr $ \src_ptr -> do

174176 let src_ptr' = src_ptr `plusPtr` src_ptr_offset

175177 BSCore.memcpy dest_ptr src_ptr' (toEnum src_bytes_length)

176178 return (dest_ptr `plusPtr` src_bytes_length)

@@ -191,7 +193,7 @@ serialize_utf8_text str dest_ptr =

191193--

192194-- todo: specify possible IO exceptions.

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

194−output_picture :: DisplayHandle -> Picture -> IO ()

196+output_picture :: MonadIO m => DisplayHandle -> Picture -> m ()

195197output_picture (DisplayHandle d t s) pic = do

196198 let !r = context_region d

197199 let !ops = spans_for_pic pic r

@@ -199,7 +201,7 @@ output_picture (DisplayHandle d t s) pic = do

199201 -- Diff the previous output against the requested output. Differences are currently on a per-row

200202 -- basis.

201203 diffs :: [Bool]

202− <- readIORef (previous_output_ref s)

204+ <- liftIO ( readIORef (previous_output_ref s) )

203205 >>= \mprevious_ops -> case mprevious_ops of

204206 Nothing

205207 -> return $ replicate ( fromEnum $ region_height $ effected_region ops )

@@ -221,7 +223,7 @@ output_picture (DisplayHandle d t s) pic = do

221223 + move_cursor_required_bytes d x y

222224

223225 -- ... then serialize

224− allocaBytes (fromEnum total) $ \start_ptr -> do

226+ liftIO $ allocaBytes (fromEnum total) $ \start_ptr -> do

225227 ptr <- serialize_hide_cursor d start_ptr

226228 ptr' <- serialize_default_attr d ptr

227229 ptr'' <- serialize_output_ops d ptr' initial_attr diffs ops

@@ -237,7 +239,7 @@ output_picture (DisplayHandle d t s) pic = do

237239 | toEnum count > total -> fail $ "End pointer past end of buffer by " ++ show (toEnum count - total)

238240 | otherwise -> output_byte_buffer t start_ptr (toEnum count)

239241 -- Cache the output spans.

240− writeIORef (previous_output_ref s) (Just ops)

242+ liftIO $ writeIORef (previous_output_ref s) (Just ops)

241243 return ()

242244

243245required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> SpanOpSequence -> Word

@@ -272,13 +274,13 @@ span_op_required_bytes d fattr (AttributeChange attr) =

272274 in (c, fattr')

273275span_op_required_bytes _d fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)

274276

275−serialize_output_ops :: DisplayTerminal d

277+serialize_output_ops :: ( MonadIO m, DisplayTerminal d )

276278 => d

277279 -> OutputBuffer

278280 -> FixedAttr

279281 -> [Bool]

280282 -> SpanOpSequence

281− -> IO OutputBuffer

283+ -> m OutputBuffer

282284serialize_output_ops d start_ptr in_fattr diffs ops = do

283285 (_, end_ptr, _, _) <- foldlM serialize_output_ops'

284286 ( 0, start_ptr, in_fattr, diffs )

@@ -293,13 +295,13 @@ serialize_output_ops d start_ptr in_fattr diffs ops = do

293295 serialize_output_ops' (_y, _out_ptr, _fattr, [] ) _span_ops

294296 = error "shouldn't be possible"

295297

296−serialize_span_ops :: DisplayTerminal d

298+serialize_span_ops :: ( MonadIO m, DisplayTerminal d )

297299 => d

298300 -> Word

299301 -> OutputBuffer

300302 -> FixedAttr

301303 -> SpanOps

302− -> IO (OutputBuffer, FixedAttr)

304+ -> m (OutputBuffer, FixedAttr)

303305serialize_span_ops d y out_ptr in_fattr span_ops = do

304306 -- The first operation is to set the cursor to the start of the row

305307 out_ptr' <- serialize_move_cursor d 0 y out_ptr

@@ -308,12 +310,12 @@ serialize_span_ops d y out_ptr in_fattr span_ops = do

308310 (out_ptr', in_fattr)

309311 span_ops

310312

311−serialize_span_op :: DisplayTerminal d

313+serialize_span_op :: ( MonadIO m, DisplayTerminal d )

312314 => d

313315 -> SpanOp

314316 -> OutputBuffer

315317 -> FixedAttr

316− -> IO (OutputBuffer, FixedAttr)

318+ -> m (OutputBuffer, FixedAttr)

317319serialize_span_op d (AttributeChange attr) out_ptr fattr = do

318320 let attr' = limit_attr_for_display d attr

319321 fattr' = fix_display_attr fattr attr'

@@ -324,16 +326,18 @@ serialize_span_op _d (TextSpan _ _ str) out_ptr fattr = do

324326 out_ptr' <- serialize_utf8_text str out_ptr

325327 return (out_ptr', fattr)

326328

327−marshall_to_terminal :: Terminal t => t -> Word -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()

329+marshall_to_terminal :: ( MonadIO m, Terminal t )

330+ => t -> Word -> (Ptr Word8 -> m (Ptr Word8)) -> m ()

328331marshall_to_terminal t c f = do

329− start_ptr <- mallocBytes (fromEnum c)

332+ start_ptr <- liftIO $ mallocBytes (fromEnum c)

330333 --

331334 -- todo: capture exceptions?

332335 end_ptr <- f start_ptr

333336 case end_ptr `minusPtr` start_ptr of

334337 count | count < 0 -> fail "End pointer before start pointer."

338+ | toEnum count > c -> fail $ "End pointer past end of buffer by " ++ show (toEnum count - c)

335339 | otherwise -> output_byte_buffer t start_ptr (toEnum count)

336− free start_ptr

340+ liftIO $ free start_ptr

337341 return ()

338342

339343data CursorOutputMap = CursorOutputMap

src/Graphics/Vty/Terminal/MacOSX.hs+12−7

@@ -17,22 +17,27 @@ module Graphics.Vty.Terminal.MacOSX ( terminal_instance

1717import Graphics.Vty.Terminal.Generic

1818import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

1919

20+import Control.Applicative

21+import Control.Monad.Trans

22+

2023import System.IO

2124

2225data Term = Term

2326 { super_term :: TerminalHandle

2427 }

2528

26−-- Base this off the xterm terminfo database regardless of what the TERM environment variable is.

27−terminal_instance :: IO Term

28−terminal_instance = do

29− t <- TerminfoBased.terminal_instance "xterm" >>= new_terminal_handle

29+-- for Terminal.app use "xterm". For iTerm.app use "xterm-256color"

30+terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term

31+terminal_instance v = do

32+ let base_term "iTerm.app" = "xterm-256color"

33+ base_term _ = "xterm"

34+ t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle

3035 return $ Term t

3136

32−flushed_put :: String -> IO ()

37+flushed_put :: MonadIO m => String -> m ()

3338flushed_put str = do

34− hPutStr stdout str

35− hFlush stdout

39+ liftIO $ hPutStr stdout str

40+ liftIO $ hFlush stdout

3641

3742-- Terminal.app really does want the xterm-color smcup and rmcup caps. Not the generic xterm ones.

3843smcup_str = "\ESC7\ESC[?47h"

src/Graphics/Vty/Terminal/TerminfoBased.hs+12−9

@@ -18,6 +18,7 @@ import Graphics.Vty.DisplayRegion

1818

1919import Control.Applicative

2020import Control.Monad ( foldM )

21+import Control.Monad.Trans

2122

2223import Data.Bits ( (.&.) )

2324import Data.Maybe ( fromJust )

@@ -55,10 +56,10 @@ data DisplayAttrCaps = DisplayAttrCaps

5556 , enter_bold_mode :: Maybe CapExpression

5657 }

5758

58−marshall_cap_to_terminal :: Term -> (Term -> CapExpression) -> [CapParam] -> IO ()

59+marshall_cap_to_terminal :: MonadIO m => Term -> (Term -> CapExpression) -> [CapParam] -> m ()

5960marshall_cap_to_terminal t cap_selector cap_params = do

60− marshall_to_terminal t (cap_expression_required_bytes (cap_selector t) cap_params)

61− (serialize_cap_expression (cap_selector t) cap_params)

61+ marshall_to_terminal t ( cap_expression_required_bytes (cap_selector t) cap_params )

62+ ( serialize_cap_expression (cap_selector t) cap_params )

6263 return ()

6364

6465{- | Uses terminfo for all control codes. While this should provide the most compatible terminal

@@ -71,9 +72,9 @@ marshall_cap_to_terminal t cap_selector cap_params = do

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

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

7374 -}

74−terminal_instance :: String -> IO Term

75+terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term

7576terminal_instance in_ID = do

76− ti <- Terminfo.setupTerm in_ID

77+ ti <- liftIO $ Terminfo.setupTerm in_ID

7778 let require_cap str

7879 = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of

7980 Nothing -> fail $ "Terminal does not define required capability \"" ++ str ++ "\""

@@ -100,7 +101,9 @@ terminal_instance in_ID = do

100101 <*> require_cap "clear"

101102 <*> current_display_attr_caps ti

102103

103−current_display_attr_caps :: Terminfo.Terminal -> IO DisplayAttrCaps

104+current_display_attr_caps :: ( Applicative m, MonadIO m )

105+ => Terminfo.Terminal

106+ -> m DisplayAttrCaps

104107current_display_attr_caps ti

105108 = pure DisplayAttrCaps

106109 <*> probe_cap "sgr"

@@ -147,15 +150,15 @@ instance Terminal Term where

147150 return $ c (DisplayContext b t color_count)

148151

149152 display_bounds _t = do

150− raw_size <- get_window_size

153+ raw_size <- liftIO $ get_window_size

151154 case raw_size of

152155 ( w, h ) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show raw_size

153156 | otherwise -> return $ DisplayRegion (toEnum w) (toEnum h)

154157

155158 -- Output the byte buffer of the specified size to the terminal device.

156159 output_byte_buffer _t out_ptr out_byte_count = do

157− hPutBuf stdout out_ptr (fromEnum out_byte_count)

158− hFlush stdout

160+ liftIO $ hPutBuf stdout out_ptr (fromEnum out_byte_count)

161+ liftIO $ hFlush stdout

159162

160163foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong

161164

src/Graphics/Vty/Terminal/XTermColor.hs+7−4

@@ -11,6 +11,9 @@ module Graphics.Vty.Terminal.XTermColor ( terminal_instance

1111import Graphics.Vty.Terminal.Generic

1212import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

1313

14+import Control.Applicative

15+import Control.Monad.Trans

16+

1417import System.IO

1518

1619data XTermColor = XTermColor

@@ -20,16 +23,16 @@ data XTermColor = XTermColor

2023

2124-- Initialize the display to UTF-8

2225-- Regardless of what is output the text encoding is assumed to be UTF-8

23−terminal_instance :: String -> IO XTermColor

26+terminal_instance :: ( Applicative m, MonadIO m ) => String -> m XTermColor

2427terminal_instance variant = do

2528 flushed_put set_utf8_char_set

2629 t <- TerminfoBased.terminal_instance variant >>= new_terminal_handle

2730 return $ XTermColor variant t

2831

29−flushed_put :: String -> IO ()

32+flushed_put :: MonadIO m => String -> m ()

3033flushed_put str = do

31− hPutStr stdout str

32− hFlush stdout

34+ liftIO $ hPutStr stdout str

35+ liftIO $ hFlush stdout

3336

3437-- Since I don't know of a terminfo string cap that produces these strings these are hardcoded.

3538set_utf8_char_set, set_default_char_set :: String

test/Bench.hs+2

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

1+module Main where

2+

13import Graphics.Vty

24

35import Control.Concurrent( threadDelay )

test/Makefile+2−1

@@ -2,6 +2,7 @@ VERIF_TESTS := \

22verify_attribute_ops \

33verify_display_attributes \

44verify_parse_terminfo_caps \

5+verify_eval_terminfo_caps \

56verify_utf8_width \

67verify_image_ops \

78verify_image_trans \

@@ -38,7 +39,7 @@ $(TESTS) :

3839 @echo running test $@

3940 @mkdir -p results/$@

4041 ( ghc $(GHC_PROF_ARGS) $@ \

41− && time --output results/$@/time_report ./$@ +RTS -p -sresults/$@/mem_report \

42+ && time ./$@ +RTS -p -sresults/$@/mem_report \

4243 && cp $@.prof results/$@/profile \

4344 )

4445

test/Test.hs+2

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

11{-# LANGUAGE ScopedTypeVariables #-}

2+module Main where

3+

24import Graphics.Vty

35

46import qualified Data.ByteString as B

test/Verify.hs+9−1

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

1+{-# LANGUAGE TypeSynonymInstances #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE StandaloneDeriving #-}

14{-# LANGUAGE DisambiguateRecordFields #-}

25{-# LANGUAGE NamedFieldPuns #-}

36module Verify ( module Verify

@@ -20,6 +23,7 @@ import Test.QuickCheck.Monadic ( monadicIO )

2023

2124import qualified Codec.Binary.UTF8.String as UTF8

2225

26+import Control.Applicative

2327import Control.Monad.State.Strict

2428import Control.Monad.Trans ( liftIO )

2529

@@ -30,7 +34,11 @@ import Numeric ( showHex )

3034

3135import System.IO

3236

33−type Test v = StateT TestState IO v

37+type Test = StateT TestState IO

38+

39+instance Applicative Test where

40+ pure = return

41+ ( <*> ) = ap

3442

3543data TestState = TestState

3644 { results_ref :: IORef [QC.Result]

test/Verify/Data/Terminfo/Parse.hs+2−2

@@ -97,8 +97,8 @@ is_bytes_op (Bytes {}) = True

9797

9898collect_bytes :: CapExpression -> [Word8]

9999collect_bytes e = concat [ bytes

100− | Bytes byte_range <- cap_ops e

101− , let bytes = bytes_for_range e byte_range

100+ | Bytes offset c <- cap_ops e

101+ , let bytes = bytes_for_range e offset c

102102 ]

103103

104104verify_bytes_equal out_bytes expected_bytes

test/Verify/Graphics/Vty/WinRegion.hs → test/Verify/Graphics/Vty/DisplayRegion.hsrenamed+4−4

@@ -1,11 +1,11 @@

11{-# LANGUAGE ScopedTypeVariables #-}

2−module Verify.Graphics.Vty.WinRegion ( module Verify.Graphics.Vty.WinRegion

3− , module Graphics.Vty.WinRegion

4− )

2+module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion

3+ , module Graphics.Vty.DisplayRegion

4+ )

55 where

66

77import Graphics.Vty.Debug

8−import Graphics.Vty.WinRegion

8+import Graphics.Vty.DisplayRegion

99

1010import Verify

1111

test/Verify/Graphics/Vty/Image.hs+1−1

@@ -5,7 +5,7 @@ module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image

55

66import Graphics.Vty.Debug

77import Graphics.Vty.Image

8−import Graphics.Vty.WinRegion

8+import Graphics.Vty.DisplayRegion

99

1010import Verify

1111import Verify.Graphics.Vty.Attributes

test/Verify/Graphics/Vty/Picture.hs+1−1

@@ -9,7 +9,7 @@ import Graphics.Vty.Debug

99

1010import Verify.Graphics.Vty.Attributes

1111import Verify.Graphics.Vty.Image

12−import Verify.Graphics.Vty.WinRegion

12+import Verify.Graphics.Vty.DisplayRegion

1313

1414import Verify

1515

test/interactive_terminal_test.hs+5−5

@@ -7,7 +7,7 @@ import Graphics.Vty.AttributeChange

77import Graphics.Vty.Image

88import Graphics.Vty.Picture

99import Graphics.Vty.Terminal

10−import Graphics.Vty.WinRegion

10+import Graphics.Vty.DisplayRegion

1111

1212import Control.Monad

1313

@@ -199,7 +199,7 @@ display_bounds_test_0 = Test

199199 , test_action = do

200200 t <- terminal_handle

201201 reserve_display t

202− DisplayBounds w h <- display_bounds t

202+ DisplayRegion w h <- display_bounds t

203203 let row_0 = replicate (fromEnum w) 'X' ++ "\n"

204204 row_h = replicate (fromEnum w - 1) 'X'

205205 row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"

@@ -220,7 +220,7 @@ display_bounds_test_1 = Test

220220 , test_action = do

221221 t <- terminal_handle

222222 reserve_display t

223− DisplayBounds w h <- display_bounds t

223+ DisplayRegion w h <- display_bounds t

224224 set_cursor_pos t 0 0

225225 let row_0 = replicate (fromEnum w) 'X' ++ "\n"

226226 putStr row_0

@@ -247,7 +247,7 @@ display_bounds_test_2 = Test

247247 , test_action = do

248248 t <- terminal_handle

249249 reserve_display t

250− bounds@(DisplayBounds w h) <- display_bounds t

250+ bounds@(DisplayRegion w h) <- display_bounds t

251251 let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')

252252 middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row

253253 middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')

@@ -270,7 +270,7 @@ display_bounds_test_3 = Test

270270 , test_action = do

271271 t <- terminal_handle

272272 reserve_display t

273− DisplayBounds w h <- display_bounds t

273+ DisplayRegion w h <- display_bounds t

274274 hide_cursor t

275275 set_cursor_pos t 0 0

276276 let row_0 = replicate (fromEnum w) 'X'

test/verify_debug_terminal.hs+7−7

@@ -1,7 +1,7 @@

11{-# LANGUAGE ScopedTypeVariables #-}

22module Main where

33

4−import Verify.Graphics.Vty.WinRegion

4+import Verify.Graphics.Vty.DisplayRegion

55import Verify.Graphics.Vty.Picture

66import Verify.Graphics.Vty.Image

77import Verify.Graphics.Vty.Span

@@ -20,7 +20,7 @@ import System.IO

2020

2121unit_image_unit_bounds :: UnitImage -> Property

2222unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do

23− t <- terminal_instance (DisplayBounds 1 1)

23+ t <- terminal_instance (DisplayRegion 1 1)

2424 d <- display_bounds t >>= display_context t

2525 let pic = pic_for_image i

2626 output_picture d pic

@@ -28,7 +28,7 @@ unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do

2828

2929unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property

3030unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do

31− t <- terminal_instance (DisplayBounds w h)

31+ t <- terminal_instance (DisplayRegion w h)

3232 d <- display_bounds t >>= display_context t

3333 let pic = pic_for_image i

3434 output_picture d pic

@@ -36,7 +36,7 @@ unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do

3636

3737single_T_row :: DebugWindow -> Property

3838single_T_row (DebugWindow w h) = liftIOResult $ do

39− t <- terminal_instance (DisplayBounds w h)

39+ t <- terminal_instance (DisplayRegion w h)

4040 d <- display_bounds t >>= display_context t

4141 -- create an image that contains just the character T repeated for a single row

4242 let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

@@ -55,7 +55,7 @@ single_T_row (DebugWindow w h) = liftIOResult $ do

5555

5656many_T_rows :: DebugWindow -> Property

5757many_T_rows (DebugWindow w h) = liftIOResult $ do

58− t <- terminal_instance (DisplayBounds w h)

58+ t <- terminal_instance (DisplayRegion w h)

5959 d <- display_bounds t >>= display_context t

6060 -- create an image that contains the character 'T' repeated for all the rows

6161 let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

@@ -72,7 +72,7 @@ many_T_rows (DebugWindow w h) = liftIOResult $ do

7272

7373many_T_rows_cropped_width :: DebugWindow -> Property

7474many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do

75− t <- terminal_instance (DisplayBounds w h)

75+ t <- terminal_instance (DisplayRegion w h)

7676 d <- display_bounds t >>= display_context t

7777 -- create an image that contains the character 'T' repeated for all the rows

7878 let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')

@@ -89,7 +89,7 @@ many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do

8989

9090many_T_rows_cropped_height :: DebugWindow -> Property

9191many_T_rows_cropped_height (DebugWindow w h) = liftIOResult $ do

92− t <- terminal_instance (DisplayBounds w h)

92+ t <- terminal_instance (DisplayRegion w h)

9393 d <- display_bounds t >>= display_context t

9494 -- create an image that contains the character 'T' repeated for all the rows

9595 let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

test/verify_eval_terminfo_caps.hsnew file+129

@@ -0,0 +1,129 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

2+{-# LANGUAGE NamedFieldPuns #-}

3+module Main where

4+

5+import Data.Marshalling

6+

7+import Data.Terminfo.Eval

8+import Data.Terminfo.Parse

9+

10+import qualified System.Console.Terminfo as Terminfo

11+

12+import Verify

13+

14+import Control.Exception ( try, SomeException(..) )

15+

16+import Control.Monad ( mapM_, forM_ )

17+

18+import Data.Array.Unboxed

19+import Data.Maybe ( fromJust )

20+import Data.Word

21+

22+import Numeric

23+

24+-- A list of terminals that ubuntu includes a terminfo cap file for.

25+-- Assuming that is a good place to start.

26+terminals_of_interest =

27+ [ "wsvt25"

28+ , "wsvt25m"

29+ , "vt52"

30+ , "vt100"

31+ , "vt220"

32+ , "vt102"

33+ , "xterm-r5"

34+ , "xterm-xfree86"

35+ , "xterm-r6"

36+ , "xterm-256color"

37+ , "xterm-vt220"

38+ , "xterm-debian"

39+ , "xterm-mono"

40+ , "xterm-color"

41+ , "xterm"

42+ , "mach"

43+ , "mach-bold"

44+ , "mach-color"

45+ , "linux"

46+ , "ansi"

47+ , "hurd"

48+ , "Eterm"

49+ , "pcansi"

50+ , "screen-256color"

51+ , "screen-bce"

52+ , "screen-s"

53+ , "screen-w"

54+ , "screen"

55+ , "screen-256color-bce"

56+ , "sun"

57+ , "rxvt"

58+ , "rxvt-unicode"

59+ , "rxvt-basic"

60+ , "cygwin"

61+ , "cons25"

62+ , "dumb"

63+ ]

64+

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

66+caps_of_interest =

67+ [ "cup"

68+ , "sc"

69+ , "rc"

70+ , "setf"

71+ , "setb"

72+ , "setaf"

73+ , "setab"

74+ , "op"

75+ , "cnorm"

76+ , "civis"

77+ , "smcup"

78+ , "rmcup"

79+ , "clear"

80+ , "hpa"

81+ , "vpa"

82+ , "sgr"

83+ , "sgr0"

84+ ]

85+

86+from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)

87+

88+main = do

89+ run_test $ do

90+ forM_ terminals_of_interest $ \term_name -> do

91+ liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name

92+ mti <- liftIO $ try $ Terminfo.setupTerm term_name

93+ case mti of

94+ Left (_e :: SomeException)

95+ -> return ()

96+ Right ti -> do

97+ forM_ caps_of_interest $ \cap_name -> do

98+ liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name

99+ case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of

100+ Just cap_def -> do

101+ verify ( "\teval cap " ++ cap_name ++ " -> " ++ show cap_def )

102+ ( verify_eval_cap cap_def )

103+ return ()

104+ Nothing -> do

105+ return ()

106+ return ()

107+ return ()

108+

109+verify_eval_cap cap_string

110+ = case parse_cap_expression cap_string of

111+ Left error ->

112+ liftResult $ failed { reason = "parse error " ++ show error }

113+ Right expr ->

114+ forAll (vector 9) $ \input_values ->

115+ let byte_count = cap_expression_required_bytes expr input_values

116+ in liftIOResult $ do

117+ start_ptr :: Ptr Word8 <- mallocBytes (fromEnum byte_count)

118+ end_ptr <- serialize_cap_expression expr input_values start_ptr

119+ free start_ptr

120+ case end_ptr `minusPtr` start_ptr of

121+ count | count < 0 ->

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

123+ | toEnum count > byte_count ->

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

125+ ++ show (toEnum count - byte_count)

126+ }

127+ | otherwise ->

128+ return succeeded

129+

test/verify_parse_terminfo_caps.hs+65−9

@@ -2,6 +2,8 @@

22{-# LANGUAGE NamedFieldPuns #-}

33module Main where

44

5+import Prelude hiding ( catch )

6+

57import Data.Terminfo.Eval ( bytes_for_range )

68

79import qualified System.Console.Terminfo as Terminfo

@@ -9,7 +11,8 @@ import qualified System.Console.Terminfo as Terminfo

911import Verify.Data.Terminfo.Parse

1012import Verify

1113

12−import Control.Monad ( mapM_ )

14+import Control.Exception ( try, SomeException(..) )

15+import Control.Monad ( mapM_, forM_ )

1316

1417import Data.Array.Unboxed

1518import Data.Maybe ( fromJust )

@@ -17,7 +20,49 @@ import Data.Word

1720

1821import Numeric

1922

20−caps =

23+-- A list of terminals that ubuntu includes a terminfo cap file for.

24+-- Assuming that is a good place to start.

25+terminals_of_interest =

26+ [ "wsvt25"

27+ , "wsvt25m"

28+ , "vt52"

29+ , "vt100"

30+ , "vt220"

31+ , "vt102"

32+ , "xterm-r5"

33+ , "xterm-xfree86"

34+ , "xterm-r6"

35+ , "xterm-256color"

36+ , "xterm-vt220"

37+ , "xterm-debian"

38+ , "xterm-mono"

39+ , "xterm-color"

40+ , "xterm"

41+ , "mach"

42+ , "mach-bold"

43+ , "mach-color"

44+ , "linux"

45+ , "ansi"

46+ , "hurd"

47+ , "Eterm"

48+ , "pcansi"

49+ , "screen-256color"

50+ , "screen-bce"

51+ , "screen-s"

52+ , "screen-w"

53+ , "screen"

54+ , "screen-256color-bce"

55+ , "sun"

56+ , "rxvt"

57+ , "rxvt-unicode"

58+ , "rxvt-basic"

59+ , "cygwin"

60+ , "cons25"

61+ , "dumb"

62+ ]

63+

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

65+caps_of_interest =

2166 [ "cup"

2267 , "sc"

2368 , "rc"

@@ -40,13 +85,24 @@ caps =

4085from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)

4186

4287main = do

43− ti <- Terminfo.setupTermFromEnv

44− mapM_ ( print_cap ti) caps

4588 run_test $ do

46− mapM_ ( \cap -> let cap_str = from_capname ti cap

47− in verify ( "parse cap " ++ show cap ++ " -> " ++ show cap_str )

48− ( verify_parse_cap cap_str $ const (liftResult succeeded) )

49− ) caps

89+ forM_ terminals_of_interest $ \term_name -> do

90+ liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name

91+ mti <- liftIO $ try $ Terminfo.setupTerm term_name

92+ case mti of

93+ Left (_e :: SomeException)

94+ -> return ()

95+ Right ti -> do

96+ forM_ caps_of_interest $ \cap_name -> do

97+ liftIO $ putStrLn $ "\tparsing cap: " ++ cap_name

98+ case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of

99+ Just cap_def -> do

100+ verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def )

101+ ( verify_parse_cap cap_def $ const (liftResult succeeded) )

102+ return ()

103+ Nothing -> do

104+ return ()

105+ -- The quickcheck tests

50106 verify "parse_non_paramaterized_caps" non_paramaterized_caps

51107 verify "parse cap string with literal %" literal_percent_caps

52108 verify "parse cap string with %i op" inc_first_two_caps

@@ -63,7 +119,7 @@ non_paramaterized_caps (NonParamCapString cap) = do

63119 verify_parse_cap cap $ \e ->

64120 let expected_count :: Word8 = toEnum $ length cap

65121 expected_bytes = map (toEnum . fromEnum) cap

66− out_bytes = bytes_for_range e (0, expected_count)

122+ out_bytes = bytes_for_range e 0 expected_count

67123 in verify_bytes_equal out_bytes expected_bytes

68124

69125literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do

test/verify_span_ops.hs+24−24

@@ -5,7 +5,7 @@ module Main where

55import Verify.Graphics.Vty.Picture

66import Verify.Graphics.Vty.Image

77import Verify.Graphics.Vty.Span

8−import Verify.Graphics.Vty.WinRegion

8+import Verify.Graphics.Vty.DisplayRegion

99

1010import Graphics.Vty.Debug

1111

@@ -16,39 +16,39 @@ import Data.Array

1616unit_image_and_zero_window_0 :: UnitImage -> EmptyWindow -> Bool

1717unit_image_and_zero_window_0 (UnitImage _ i) (EmptyWindow w) =

1818 let p = pic_for_image i

19− spans = spans_for_pic p w

20− in win_width spans == 0 && win_height spans == 0

19+ spans = spans_for_pic p (region_for_window w)

20+ in span_ops_columns spans == 0 && span_ops_rows spans == 0

2121

2222unit_image_and_zero_window_1 :: UnitImage -> EmptyWindow -> Bool

2323unit_image_and_zero_window_1 (UnitImage _ i) (EmptyWindow w) =

2424 let p = pic_for_image i

25− spans = spans_for_pic p w

25+ spans = spans_for_pic p (region_for_window w)

2626 in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 )

2727

2828horiz_span_image_and_zero_window_0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

2929horiz_span_image_and_zero_window_0 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) =

3030 let p = pic_for_image i

31− spans = spans_for_pic p w

32− in win_width spans == 0 && win_height spans == 0

31+ spans = spans_for_pic p (region_for_window w)

32+ in span_ops_columns spans == 0 && span_ops_rows spans == 0

3333

3434horiz_span_image_and_zero_window_1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

3535horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) =

3636 let p = pic_for_image i

37− spans = spans_for_pic p w

37+ spans = spans_for_pic p (region_for_window w)

3838 in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 )

3939

4040horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result

4141horiz_span_image_and_equal_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

4242 let p = pic_for_image i

4343 w = DebugWindow c 1

44− spans = spans_for_pic p w

44+ spans = spans_for_pic p (region_for_window w)

4545 in verify_all_spans_have_width i spans c

4646

4747horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool

4848horiz_span_image_and_equal_window_1 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

4949 let p = pic_for_image i

5050 w = DebugWindow c 1

51− spans = spans_for_pic p w

51+ spans = spans_for_pic p (region_for_window w)

5252 in span_ops_effected_rows spans == 1

5353

5454horiz_span_image_and_lesser_window_0 :: SingleRowSingleAttrImage -> Result

@@ -56,14 +56,14 @@ horiz_span_image_and_lesser_window_0 (SingleRowSingleAttrImage { row_image = i,

5656 let p = pic_for_image i

5757 lesser_width = c `div` 2

5858 w = DebugWindow lesser_width 1

59− spans = spans_for_pic p w

59+ spans = spans_for_pic p (region_for_window w)

6060 in verify_all_spans_have_width i spans lesser_width

6161

6262single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result

6363single_attr_single_span_stack_cropped_0 stack =

6464 let p = pic_for_image (stack_image stack)

6565 w = DebugWindow (stack_width stack `div` 2) (stack_height stack)

66− spans = spans_for_pic p w

66+ spans = spans_for_pic p (region_for_window w)

6767 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2)

6868

6969single_attr_single_span_stack_cropped_1 :: SingleAttrSingleSpanStack -> Bool

@@ -71,7 +71,7 @@ single_attr_single_span_stack_cropped_1 stack =

7171 let p = pic_for_image (stack_image stack)

7272 expected_row_count = stack_height stack `div` 2

7373 w = DebugWindow (stack_width stack) expected_row_count

74− spans = spans_for_pic p w

74+ spans = spans_for_pic p (region_for_window w)

7575 actual_row_count = span_ops_effected_rows spans

7676 in expected_row_count == actual_row_count

7777

@@ -79,14 +79,14 @@ single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAt

7979single_attr_single_span_stack_cropped_2 stack_0 stack_1 =

8080 let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)

8181 w = DebugWindow (stack_width stack_0) (image_height (pic_image p))

82− spans = spans_for_pic p w

82+ spans = spans_for_pic p (region_for_window w)

8383 in verify_all_spans_have_width (pic_image p) spans (stack_width stack_0)

8484

8585single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool

8686single_attr_single_span_stack_cropped_3 stack_0 stack_1 =

8787 let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)

8888 w = DebugWindow (image_width (pic_image p)) expected_row_count

89− spans = spans_for_pic p w

89+ spans = spans_for_pic p (region_for_window w)

9090 expected_row_count = image_height (pic_image p) `div` 2

9191 actual_row_count = span_ops_effected_rows spans

9292 in expected_row_count == actual_row_count

@@ -95,7 +95,7 @@ single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAt

9595single_attr_single_span_stack_cropped_4 stack_0 stack_1 =

9696 let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)

9797 w = DebugWindow expected_width (image_height (pic_image p))

98− spans = spans_for_pic p w

98+ spans = spans_for_pic p (region_for_window w)

9999 expected_width = image_width (pic_image p) `div` 2

100100 in verify_all_spans_have_width (pic_image p) spans expected_width

101101

@@ -103,7 +103,7 @@ single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAt

103103single_attr_single_span_stack_cropped_5 stack_0 stack_1 =

104104 let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)

105105 w = DebugWindow (image_width (pic_image p)) (stack_height stack_0)

106− spans = spans_for_pic p w

106+ spans = spans_for_pic p (region_for_window w)

107107 expected_row_count = stack_height stack_0

108108 actual_row_count = span_ops_effected_rows spans

109109 in expected_row_count == actual_row_count

@@ -114,38 +114,38 @@ horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i,

114114 -- SingleRowSingleAttrImage always has width >= 1

115115 greater_width = c * 2

116116 w = DebugWindow greater_width 1

117− spans = spans_for_pic p w

117+ spans = spans_for_pic p (region_for_window w)

118118 in verify_all_spans_have_width i spans greater_width

119119

120120arb_image_is_cropped :: DefaultImage -> DebugWindow -> Bool

121121arb_image_is_cropped (DefaultImage image _) win@(DebugWindow w h) =

122122 let pic = pic_for_image image

123− spans = spans_for_pic pic win

123+ spans = spans_for_pic pic (region_for_window win)

124124 in ( span_ops_effected_rows spans == h ) && ( all_spans_have_width spans w )

125125

126126span_ops_actually_fill_rows :: DefaultPic -> Bool

127127span_ops_actually_fill_rows (DefaultPic pic win _) =

128− let spans = spans_for_pic pic win

129− expected_row_count = win_height win

128+ let spans = spans_for_pic pic (region_for_window win)

129+ expected_row_count = region_height (region_for_window win)

130130 actual_row_count = span_ops_effected_rows spans

131131 in expected_row_count == actual_row_count

132132

133133span_ops_actually_fill_columns :: DefaultPic -> Bool

134134span_ops_actually_fill_columns (DefaultPic pic win _) =

135− let spans = spans_for_pic pic win

136− expected_column_count = win_width win

135+ let spans = spans_for_pic pic (region_for_window win)

136+ expected_column_count = region_width (region_for_window win)

137137 in all_spans_have_width spans expected_column_count

138138

139139first_span_op_sets_attr :: DefaultPic -> Bool

140140first_span_op_sets_attr DefaultPic { default_pic = pic, default_win = win } =

141− let spans = spans_for_pic pic win

141+ let spans = spans_for_pic pic (region_for_window win)

142142 in all ( is_attr_span_op . head ) ( elems $ row_ops spans )

143143

144144single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result

145145single_attr_single_span_stack_op_coverage stack =

146146 let p = pic_for_image (stack_image stack)

147147 w = DebugWindow (stack_width stack) (stack_height stack)

148− spans = spans_for_pic p w

148+ spans = spans_for_pic p (region_for_window w)

149149 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)

150150

151151main :: IO ()