packages feed

vty 5.15.1 → 6.6

raw patch · 88 files changed

Files

CHANGELOG.md view
@@ -1,436 +1,1113 @@-5.15.1-Package changes:-  - Documentation files are now marked accordingly (thanks Michal-    Suchánek)--Bug fixes:-  - translateX/Y: fix negative translations--5.15-Package changes:-  - Discontinued support for GHC versions prior to 7.10.1.-  - Removed instructions and configuration for Stack builds since they-    are no longer supported.-  - Clarified README mention of (lack of) Windows support (contributors-    wanted, though!)-  - Removed dependency on data-default (see below).--API changes:-  - Moved color definitions from Attributes to Color module.-  - In lieu of data-default (Default) instances for Attr and Config, use-    'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.-  - Graphics.Vty.Output no longer re-exports-    Graphics.Vty.Output.Interface.-  - Removed Graphics.Vty.Prelude module and moved DisplayRegion and its-    accessors to Graphics.Vty.Image.-  - Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.-  - Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.--5.14-  - addMaybeClippedJoin: instead of raising an exception when the join-    is totally clipped, just reduce the clip amount and continue-  - addMaybeClipped: skip blit of joins when their primary dimension is-    zero-  - 'string' and related text functions no longer treat an empty string-    as an empty image (thanks Chris Penner). This means that now it is-    possible to use 'str ""' as a non-empty image with height 1.--5.13-  - Reverted changes in 5.12 due to disagreements between terminal-    emulators and utf8proc; for more details, please see the ticket-    discussion at-    https://github.com/coreyoconnor/vty/issues/115--5.12-  - Replaced 'wcwidth' with a call to the utf8proc library's character-    width function, which is much more up to date (by several Unicode-    versions) and returns the right width for a much larger set of-    characters.-  - Added a bundled version of the utf8proc C library.--5.11.3-  - Fix mouse event offsets in mouse-up events--5.11.2-  - Mouse events were modified so that the upper-left corner of the-    window is (0,0) rather than (1,1).--5.11.1-  - Add Generic instance for Image-  - nextEvent: stop trying to refresh on a resize event (fixes segfault-    on refresh with normal cursor positioning mode)-  - Remove redundant clause from clipForCharWidth (thanks Eric Mertens)-  - Update maintainer--5.11-  - Vty now raises a VtyConfigurationError exception when the TERM-    evironment variable is missing (thanks Eric Mertens)-  - Graphics.Vty.Config got an explicit export list to avoid accidentally-    exporting internal types (thanks Eric Mertens)--5.10-  - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This-    mode provides greater control over cursor positioning by bypassing-    the logical positioning provided by default. Rather than positioning-    the cursor by looking at the widths of characters involved, this-    constructor lets you provide a physical row and column instead. This-    is useful in more sophisticated programs. (thanks Eric Mertens)-  - Added a new Generic-derived config parser (thanks Eric Mertens)-  - Fixed the MShift case in the configuration file parser (thanks Eric-    Mertens)-  - Fixed wcwidth import and matched safeWcswidth to its documented-    behavior. Previously vty_mk_wcwidth was being imported with-    the wrong type causing the -1 return value to be mapped to the-    wrong Int value. Additionally safeWcswidth was using the unsafe-    character width function and only ensuring that the final result was-    non-negative. (thanks Eric Mertens)--5.9.1-  - Vty now only emits UTF8 charset sequences in terminals without a-    preexisting UTF8 declaration to avoid emitting garbage sequences-    (fixes #89)--5.9-  - Added new Output methods supportsBell and ringTerminalBell to find-    out whether the output device has an audio bell and to ring it (see-    #102)--5.8.1-  - Fixed "refresh" to work as advertised (see #104)--5.8-  - API change: EvPaste input event now provides paste data as a raw-    ByteString rather than a String to allow the application to decode-    how best to decode it--5.7.1-  - ModeDemo: added an explicit Control.Applicative import for older-    GHCs--5.7-  - Mouse and paste modes are now off by default.-  - The Config type got new fields: mouseMode and bracketedPasteMode.-    These determine whether these modes are enabled initially (for-    terminals that support them).-  - Added a Mode type for modal terminal features (mouse events,-    bracketed paste mode) that is used with new Output interface-    functions:-    * supportsMode :: Mode -> Bool tells whether the device supports a-      mode-    * setMode :: Mode -> Bool -> IO () turns a mode on or off-    * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or-      off-  - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes--5.6-  - Added support for normal and extended mouse modes in Xterm-like-    terminals via the MouseDown and MouseUp Event constructors-  - Added support for bracketed paste mode in Xterm-like terminals via-    the EvPaste event constructor-  - Added derived Show instances for Event and Button (thanks Felix-    Hirn)-  - Now TERM values containing "screen" will automatically use the-    XtermColor driver rather than just TerminfoBased--5.5.0-  - Replaced lens dependency with microlens, microlens-mtl, microlens-th-    dependencies. Issue #90-    - Thanks Jonathan Daugherty-  - Cabal corrections.-    - Thanks Lennart Spitzner--5.4.0-  - Changed eventChannel of Graphics.Vty.Input from Chan to TChan.-    This enables clients to query if there are no pending events. The-    Graphics.Vty interface nextEvent is unchanged. Clients that use-    eventChannel directly will require updating.-    https://github.com/coreyoconnor/vty/issues/60-5.3.1-  - Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due-    to possibly breaking this on reasonable GHC versions--5.3-  - Upgraded QuickCheck dependency to 2.7-  - The standard IO Config (standardIOConfig) was overriding any-    provided application config. In addition, the inputFd and outputFd-    could not be changed if mkVty was used. Fixed.-  - Correct handling of display attributes at end of line. The output-    attributes are set to default at the end of content for the line and-    at the start of a new line. Previously the current attribute would-    extend to the next start of content. This was odd to reason about-    and was the cause of https://github.com/coreyoconnor/vty/issues/76-    IIRC Yi requires the old behavior to display the selection region-    correctly.-  - shutdown of the input thread is now performed using killThread and-    synchronization on an MVar. For correct handling of the terminal-    read vmin and vtime the read must be a blocking read on an OS-    thread. This places a threadWaitRead, which will be interrupted by-    the killThread, prior to the uninterruptable read. An alternative-    would be to re-import the read foreign call as interruptable.--5.2.11-  - deepseq bounds increased for tests.-  - Clean up warnings when compiling on 7.10-    - Thanks Eric Mertens-  - Avoid discarding input bytes after multi-byte encoded codepoint-    - Thanks Eric Mertens--5.2.10-  - "str" now returns EmptyImage for empty strings to match behavior of-    other string-like Image constructors (fixes #74)-    - Thanks Jonathan Daugherty--5.2.9-  - dependency version bumps-    - https://github.com/coreyoconnor/vty/pull/71-    - https://github.com/coreyoconnor/vty/pull/70-  - Correct/Simplify the example code-    - Thanks glguy-    - https://github.com/coreyoconnor/vty/pull/69--5.2.8-  - blaze-builder, lens, utf8-string version constraint bump-      - Thanks glguy-      - https://github.com/coreyoconnor/vty/pull/67-  - Do not differentiate based on TERM_PROGRAM-      - https://github.com/coreyoconnor/vty/issues/68--5.2.7-  - lens and deepseq constraint bump + misc-      - Thanks ethercrow-      - https://github.com/coreyoconnor/vty/pull/66--5.2.6-  - lens constraint bump-      - Thanks alexander-b!-      - https://github.com/coreyoconnor/vty/pull/64--5.2.5-  - lens and random version constraint bump.-      - Thanks RyanGlScott!-      - https://github.com/coreyoconnor/vty/pull/62--5.2.4-  - removed -fpic from cc-options. No longer required.-      - https://github.com/coreyoconnor/vty/issues/61-      - https://ghc.haskell.org/trac/ghc/ticket/9657-      - Thanks Fuuzetsu!--5.2.3-  - evaluate/compile the input parsing table once instead of each-    keystroke.-      - https://github.com/coreyoconnor/vty/pull/59-      - Thanks ethercrow!--5.2.2-  - When looking at input for an event, don't look too deep.-      - https://github.com/coreyoconnor/vty/pull/57-      - Thanks ethercrow!--5.2.1-  - Bump upper version bound for lens to 4.5. Thanks markus1189!--5.2.0-  - Config structure now specifies file descriptor to use. The default-    is stdInput and stdOutput file descriptors. Previously Vty used-    stdInput for input and the follow code for output:-      - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`-        NoBuffering)-      - the difference was required by Vty.Inline. Now, Vty.Inline uses-        the Config structure options to acheive the same effect.-  - removed: derivedVtime, derivedVmin, inputForCurrentTerminal,-    inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO-  - added: inputForConfig, outputForConfig-  - updates to vty-rogue from jtdaugherty. Thanks!-  - the oldest version of GHC tested to support vty is 7.6.2.-  - the oldest version of GHC that vty compiles under is 7.4.2--5.1.4-  - merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!--5.1.1-  - merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!-  - jtdaugherty resolved a number of compiler warnings. Thanks!--5.1.0-  - vmin and vtime can be specified however the application requires.-    See Graphics.Vty.Config.-  - fixed the processing of input when vmin is set > 1.--5.0.0-  - The naming convention now matches:-    - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions-  - all projects using vty for input must be compiled with -threaded.-    Please notify vty author if this is not acceptable.-  - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized-    vty with the default configuration.-  - input handling changes-    - KASCII is now KChar-    - KPN5 is now KCenter-    - tests exist.-    - Applications can add to the input tables by setting inputMap of-      the Config. See Graphics.Vty.Config-    - Users can define input table extensions that will apply to all vty-      applications. See Graphics.Vty.Config-    - terminal timing is now handled by selecting an appropriate VTIME.-      Previously this was implemented within Vty itself. This reduced-      complexity in vty but provides a different meta key behavior and-      implies a requirement on -threaded.-    - The time vty will wait to verify an ESC byte means a single ESC-      key is the singleEscPeriod of the Input Config structure.-  - removed the typeclass based terminal and display context interface-    in favor of a data structure of properties interface.-  - renamed the Terminal interface to Output-  - The default picture for an image now uses the "clear" background.-    This background fills background spans with spaces or just ends the-    line.-    - Previously the background defaulted to the space character. This-      causes issues copying text from a text editor. The text would end-      up with extra spaces at the end of the line.-  - Layer support-    - Each layer is an image.-    - The layers for a picture are a list of images.-    - The first image is the top-most layer. The images are ordered from-      top to bottom.-    - The transparent areas for a layer are the backgroundFill areas.-      backgroundFill is added to pad images when images of different-      sizes are joined.-    - If the background is clear there is no background layer.-    - If there is a background character then the bottom layer is the-      background layer.-    - emptyPicture is a Picture with no layers and no cursor-    - addToTop and addToBottom add a layer to the top and bottom of the-      given Picture.-  - compatibility improvements:-    - terminfo based terminals with no cursor support are silently-      accepted. The cursor visibility changes in the Picture will have-      no effect.-    - alternate (setf/setb) color maps supported. Though colors beyond-      the first 8 are just a guess.-    - added "rgbColor" for easy support of RGB specified colors.-    - Both applications and users can add to the mapping used to-      translate from input bytes to events.-  - Additional information about input and output process can be-    appended to a debug log-    - Set environment variable VTY_DEBUG_LOG to path of debug log-    - Or use "debugLog <path>" config directive-    - Or set 'debugLog' property of the Config provided to mkVty.-  - examples moved to vty-examples package. See test directory for cabal-    file.-    - vty-interactive-terminal-test-      - interactive test. Useful for building a bug report for vty's-        author.-      - test/interactive_terminal_test.hs-    - vty-event-echo-      - view a input event log for vty. Example of interacting with-        user.-      - test/EventEcho.hs-    - vty-rogue-      - The start of a rogue-like game. Example of layers and image-        build operations.-      - test/Rogue.hs-    - vty-benchmark-      - benchmarks vty. A series of tests that push random pictures to-        the terminal. The random pictures are generated using-        QuickCheck. The same generators used in the automated tests.-      - test/benchmark.hs--4.7.0.0-  - API changes:-    - Added Graphics.Vty.Image.crop: Ensure an image is no larger-      than the specified size.-    - Added Graphics.Vty.Image.pad: Ensure an image is no smaller-      than the specified size.-    - Added Graphics.Vty.Image.translate: Offset an image.-  - Thanks Ben Boeckel <MathStuf@gmail.com> for these features.--4.3.0.0--4.2.1.0-  - API changes:-    - Attr record accessor fore_color changed to attr_fore_color-    - Attr record accessor back_color changed to attr_back_color-    - Attr record accessor style changed to attr_style-    - Added an "inline" display attribute changing DSL:-      - put_attr_change applies a display attribute change-        immediately to a terminal-      - For instance, can be used to change the display attrbiutes-        of text output via putStrLn and putStr. EX:-        "put_attr_change $ back_color red" will set the background-        color to red.-      - Changes do not apply to a Picture output via output_picture.-      - See Graphics.Vty.Inline-    - Moved all IO actions into any monad an instance of MonadIO--4.0.0.1-  - binding for mk_wcswidth was incorrect. Most platforms just-    magically worked due to coincidence.--4.0.0-  - API changes:-    - "getSize" has been removed. Use "terminal vty >>= display_bounds"-      where "vty" is an instance of the Vty data structure.-    - added a "terminal" field to the Vty data structure. Accesses the-      TerminalHandle associated with the Vty instance.-    - Graphics.Vty.Types has undergone a number of changes. Summary:-      - Partitioned into Graphics.Vty.Attributes for display attributes.-        Graphics.Vty.Image for image combinators. Graphics.Vty.Picture-        for final picture construction.-    - Graphics.Vty.Attributes:-      - "setFG" and "setBG" are now "with_fore_color" and-        "with_back_color"-      - All other "set.." equations similarly replaced.-      - "attr" is now "def_attr", short for "default display attributes"-        Also added a "current_attr" for "currently applied display-        attributes"-    - Graphics.Vty.Image:-      - "horzcat" is now "horiz_cat"-      - "vertcat" is now "vert_cat"-      - "renderBS" is now "utf8_bytestring"-      - "renderChar" is now "char"-      - "renderFill" is now "char_fill"-      - added a "utf8_string" and "string" (AKA "iso_10464_string") for-        UTF-8 encoded Strings and ISO-10464 encoded Strings. String-        literals in GHC have an ISO-10464 runtime representation.-    - Graphics.Vty.Picture:-      - exports Graphics.Vty.Image-      - "pic" is now "pic_for_image"-      - added API for setting background fill pattern.-  - Completely rewritten output backend.-    - Efficient, scanline style output span generator. Has not been-      fully optimized, but good enough.-    - The details required to display the desired picture on a-      terminal are well encapsulated.-    - Terminfo based display terminal implementation. With specialized-      derivitives for xterm, Terminal.app, and iTerm.app.-        - Attempts to robustly handle even terminals that don't-          support all display attributes.-        - I've tested the following terminals with success: iTerm.app,-          Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,-          konsole, screen, linux vty. Hopefully you will be as-          successfull.-    - Improved unicode support. Double wide characters will display as-      expected.-  - 256 color support. See Graphics.Vty.Attributes.Color240. The actual-    output color is adjusted according to the number of colors the-    terminal supports.-  - The Graphics.Vty.Image combinators no longer require matching-    dimensions to arguments. Unspecified areas are filled in with a-    user-customizable background pattern. See Graphics.Vty.Picture.-  - output images are always cropped to display size.-  - Significant code coverage by QuickCheck tests. An interactive test-    for those final properties that couldn't be automatically verified.--Issues resolved:-  - "gnome terminal displays non-basic attributes as strikethrough"-    - http://trac.haskell.org/vty/ticket/14-  - "Multi-byte characters are not displayed correctly on update"-    - http://trac.haskell.org/vty/ticket/10-  - "Redraw does not handle rendering a line that extends beyond screen-    width characters"-    - http://trac.haskell.org/vty/ticket/13-  - "The <|> and <-> combinators should be more forgiving of mismatched-    dimensions"-    - http://trac.haskell.org/vty/ticket/9-  - "256-color support"-    - http://trac.haskell.org/vty/ticket/19++6.6+---++* Added support for horizontal scrolling inputs. The `Button` type in+  `Graphics.Vty.Input.Events` got new constructors `BScrollLeft` and+  `BScrollRight` for Vty backend implementations that support horizontal+  scrolling inputs.++6.5+---++* Raised upper bound on `microlens` dependency to permit builds against+  0.5.+* Fixed the `utf8-string` dependency lower bound to account for an added+  module in 0.3.1. (#279)+* Improved the allocation behavior of `swapSkipsForSingleColumnCharSpan`.++6.4+---++* Updated the behavior of character width computations when a custom+  character width table has been installed. Now when a custom character+  width table doesn't provide a width for a character, rather than+  defaulting to 1 column, the built-in table is consulted. This change+  shouldn't affect users using width tables generated by `vty-unix`'s+  table-building tool since that tool generates tables that will provide+  widths for all supported characters.++6.3+---++* Raise microlens upper bound to build with 0.4.14 (#278)+* Updated other bounds to permit building with GHC 9.12 (thanks Erik de+  Catro Lopo)+* Removed defunct examples from project++6.2+---++Package changes:+* Update version bounds to support building with GHC 9.8++Bug fixes:+* Updated `PictureToSpans` module to implement its lenses manually to+  avoid template haskell which has trouble on Windows and GHC 9.2 (#271)++6.1+---++API changes:+* `ColorMode` got a `Read` instance.+* The `Config` type got a new `configPreferredColorMode` field for+  specifying a preferred `ColorMode`. Backend packages should respect+  this field, but note that `vty` itself does not (and cannot) enact+  this preference since it's up to the backend driver to configure the+  color mode.+* The Vty configuration file got a new `colorMode` field whose value is+  a string literal compatible with the `ColorMode` `Read` instance.++6.0+---++This release marks the beginning of multi-platform support in Vty.+Getting to this point involved removing Unix-specific functionality+from Vty and moving it to a new package, `vty-unix`. Windows support+is now provided via a `vty-windows` package. Another new package,+`vty-crossplatform`, is provided as a convenience for applications that+want to support both Unix and Windows platforms automatically at build+time. See the migration guide below for details on how to upgrade.++**Migration guide for 6.0**++To upgrade to this version of Vty, most people will only need to take a+few steps:++1. Add a package dependency on `vty-unix`, `vty-windows,` or+   `vty-crossplatform`, depending on the desired level of platform+   support. For example, if an application only supports Unix systems,+   it should depend on `vty-unix`. But if an application is intended to+   work anywhere Vty works, then `vty-crossplatform` is the best choice.+2. Import `mkVty` from the platform package in step (1). (`mkVty` was+   removed from the `vty` package and is now the responsibility of each+   platform package.) Imports are as follows:+   * `vty-unix`: `Graphics.Vty.Platform.Unix`+   * `vty-windows`: `Graphics.Vty.Platform.Windows`+   * `vty-crossplatform`: `Graphics.Vty.CrossPlatform`+3. Maintain any existing package dependency on `vty`; the core library+   abstractions, types, and functions are still obtained from `vty`+   itself. The platform packages do not re-export the core library's+   modules.+4. If desired, call `Graphics.Vty.Config.userConfig` to load the Vty+   user configuration since this step is no longer automatic.+5. Some configurations have been moved to `Graphics.Vty.Output`. For +   example, `mouseMode` is no longer a field in `VtyUserConfig`. +   Instead, use `setMode` to enable it.++For applications using more of Vty's API than just the basic+initialization and rendering API, the full change list is provided+below. For people who want to write their own Vty platform package like+`vty-unix`, see `PLATFORM-HOWTO.md`.++**Detailed change list for 6.0**++* Package changes:+  * The following modules got added to the `vty` library:+    * `Graphics.Vty.UnicodeWidthTable.Main`+  * The following modules got moved to `vty-unix`:+    * `Data.Terminfo.Eval`+    * `Data.Terminfo.Parse`+  * The following modules got moved to `vty-unix` into the+    `Graphics.Vty.Platform.Unix` module namespace (previously+    `Graphics.Vty`):+    * `Graphics.Vty.Input.Classify`+    * `Graphics.Vty.Input.Classify.Parse`+    * `Graphics.Vty.Input.Classify.Types`+    * `Graphics.Vty.Input.Focus`+    * `Graphics.Vty.Input.Loop`+    * `Graphics.Vty.Input.Mouse`+    * `Graphics.Vty.Input.Paste`+    * `Graphics.Vty.Input.Terminfo`+    * `Graphics.Vty.Output.TerminfoBased`+    * `Graphics.Vty.Output.XTermColor`+  * The following modules were removed entirely (with contents migrated+    elsewhere as needed):+    * `Graphics.Vty.Inline.Unsafe`+    * `Graphics.Vty.Output.Interface` (migrated to+      `Graphics.Vty.Output`)+  * Removed library dependencies on the following packages:+    * `ansi-terminal`+    * `containers`+    * `terminfo`+    * `transformers`+    * `unix`+  * The following executables were moved to other packages:+    * `vty-build-width-table` (moved to `vty-unix` as+      `vty-unix-build-width-table`)+    * `vty-mode-demo` (moved to `vty-crossplatform`)+* API changes:+  * `Graphics.Vty.mkVty` moved to the `vty-unix` package's+    `Graphics.Vty.Platform.Unix` module.+  * Added `Graphics.Vty.mkVtyFromPair` for platform packages to+    construct `Vty` handles.+  * The contents of the `Graphics.Vty.Output.Interface` module were+    merged into `Graphics.Vty.Output`.+  * The `vty-build-width-table` tool was removed from the `vty` package,+    but its core functionality is now exposed as a library for+    platform packages to use to provide platform-specific tools using+    `Graphics.Vty.UnicodeWidthTable.Main` and a new tool by the same+    name was added to the `vty-unix` package.+  * `Graphics.Vty.Events`: the `InternalEvent` type's+    `ResumeAfterSignal` constructor was renamed to+    `ResumeAfterInterrupt` to be a bit more abstract and+    platform-agnostic.+  * Removed the following lenses for fields of the `Input` type:+    * `eventChannel` (was for `_eventChannel` which was then renamed to+      `eventChannel`)+    * `configRef` (was for `_configRef` which was then renamed to+      `configRef`)+  * The `Output` record type got a new field, `setOutputWindowTitle`.+  * The `Input` record type got a new field, `inputLogMsg :: String ->+    IO ()`, for logging to the Vty log.+  * `Graphics.Vty.Config` now exposes `VtyUserConfig` instead of+    `Config`. Many of its fields were Unix-specific and were+    consequently moved to the `UnixSettings` type in `vty-unix` and+    given a `settings` prefix. This includes `outputFd`, `inputFd`,+    `vmin`, `vtime`, and `termName`.+  * The `VtyUserConfig` type's fields got a `config` field name prefix.+  * `inputForConfig` was moved to `vty-unix` as `buildInput` but+    generally should not be needed and is exposed only for testing.+  * `outputForConfig` was moved to `vty-unix` as `buildOutput` but+    generally should not be needed and is exposed only for testing.+* Behavior changes:+  * Since `vty` no longer implements `mkVty`, the Vty user configuration+    is no longer implicitly loaded by Vty-based applications.+    Instead, it is now up to the applications to call+    `Graphics.Vty.Config.userConfig` to load any user-provided+    configuration.+  * Vty no longer implicitly attempts to load configured Unicode+    width tables. It is now the responsibility of the platform packages+    (such as `vty-unix`) and/or applications to load tables via+    `Graphics.Vty.UnicodeWidthTable.IO` and install them via+    `Graphics.Vty.UnicodeWidthTable.Install`.+* Changes to demonstration programs:+  * `EventEcho`, `ModeDemo`, and `Rogue` demo programs moved to the+    `vty-crossplatform` package.+* Changes to tests:+  * Where appropriate, some test programs and test cases were moved to+    `vty-unix` or `vty-crossplatform`.++5.39+----++Package changes:+* Now builds with `mtl-2.3.*`.++Bug fixes:+* Fixed a long-standing issue where unused input on stdin could cause a+  memory error and a crash when Vty was being initialized. (#266)++5.38+----++This release includes numerous API changes, although none of them should+break your programs. If so, please open a ticket on the Vty issue+tracker.++Package changes:+* Support mtl 2.3 (thanks Daniel Firth)+* The test and example collections got completely overhauled to clean up+  bit rot.+  * Moved example programs into examples/ under a new vty-examples+    package.+  * Moved test suite programs out of vty.cabal and into tests/ under a+    new vty-tests package.+  * Cleaned up all build-depends lists in all three packages to remove+    unused deps.+  * Consolidated the test suite library modules into the vty-tests+    library to avoid redundant compilation.+  * Added build.sh to build everything in the development process to+    help ensure that examples and tests don't get forgotten.+  * Removeed lots of stale/unused modules in old test/ directory.+* Got vty-examples building again and resolved various warnings and+  issues.++API changes:+* All modules got explicit export lists. Prior to this release, many+  modules exported everything they contained, making it difficult to+  know what was really intended to be part of the public API. The new+  export lists should contain everything that applications need; the+  risk of breakage exists but should be minor. Please open a ticket if+  you were using something that is no longer exported. It might be that+  it was never supposed to be exported to begin with, or it might be+  just something we need to export once again.+* Moved the `attributeControl` function from `Graphics.Vty.Input.Loop`+  to `Graphics.Vty.Input`.+* Removed the `Graphics.Vty.Image.DisplayText` alias for `Text`.+* Unified the `Image` cropping constructors (thanks Fraser Tweedale)++5.37+----++* The Xterm backend is now used when `TERM` matches `rxvt` or `tmux`.+* PictureToSpans now uses `error`, not `fail`, to avoid dependence on+  soon-to-be-removed `MonadFail` instance for `ST` (#248)++5.36+----++ * Raised `microlens` upper bound to allow building with 0.4.13.+ * Replaced incomplete `Show` output for `Picture` with a derived+   instance; derived `Show` for `Cursor` and `Background`, too.++5.35.1+------++Bug fixes:+ * Fixed a build issue with a test program.++5.35+----++New features:+ * Add support for 24-bit color (thanks @u-quark). This change+   updates Vty to look at the `COLORTERM` environment variable that is+   conventionally used to advertise support for truecolor escape+   sequences. The change also updates the Vty demo to demonstrate+   24-bit colors. This change also adds a new data type, `ColorMode`,+   to represent the color mode in use, as well as an `Output` interface+   field, `outputColorMode`, to track the active color mode and use it+   to clamp emitted color escape sequences to the active color range.++API changes:+ * All types in `Graphics.Vty.Input.Events` now have strict constructor+   fields.+ * Internal events are now wrapped in a new `InternalEvent` type to+   improve how signal handling is done. This change modifies the `Input`+   type's event channel API to produce `InternalEvents`, not `Events`.+   The new `InternalEvent` either wraps `Event` with the `InputEvent`+   constructor (the previous behavior) or indicates that Vty resumed+   after handling a signal using the `ResumeAfterSignal` constructor.+   This change avoids the previous use of `EvResize` with lazy exception+   arguments as a sentinel value for `ResumeAfterSignal`.++Other enhancements:+ * Bracketed paste parsing performance has been greatly improved thanks+   to benchmarking and optimization work by @iphydf. As part of that+   work, Vty now uses bytestrings rather than Strings internally when+   parsing input to look for events.+ * The `\b` value is now interpreted as `KBS` (thanks @vglfr)++5.34+----++API changes:+ * Added an `NFData` instance for `Event` (thanks Mario Lang)+ * Removed `Monoid` and `Semigroup` instances for `Attr` and+   `MaybeDefault`. This change removed the instances because they were+   misbehaved; merging `Attr` and `MaybeDefault` values with these+   instances resulted in field value losses. For example, before this+   change,+```+(defAttr `withForeColor` blue) <> (defAttr `withBackColor` green)+```+   would result in just+```+   (defAttr `withBackColor` green)+```+   because the instances were designed to favor the right-hand+   arguments' fields even if they had not been explicitly set+   (a consequence of the `MaybeDefault` `Semigroup` instance).+   While that behavior was sensible specifically in the context of+   `Graphics.Vty.Inline`, it wasn't a useful user-facing API and it made+   for surprising instance behavior. Since there is actually no good way+   to handle this in a `Semigroup` instance for `Attr` -- some choices+   have to be made about how to merge two attributes' foreground colors,+   and that won't be much better than what we had -- the instance was+   just removed.+++5.33+----++API changes:+* The `Cursor` type got a new `PositionOnly` constructor for cursor+  placement without visibility.++Package changes:+* Relaxed upper bound for `random`+* Updated `microlens` bounds to allow 0.4.12++Other improvements:+* Various hlint-driven improvements (thanks Willem Van Onsem)+* The implementation of `color240` was improved (thanks (Willem Van+  Onsem)++5.32+----++New features:+ * Meta-PageUp and Meta-PageDown are now supported (#193)+ * Added `supportsItalics` and `supportsStrikethrough` functions to+   check for feature support in terminfo++Bug fixes:+ * Detect utf-8 mode in `LANG` regardless of case (thanks Emeka+   Nkurumeh)++5.31+----++New features and API changes:+ * Added support for strikethrough mode. This change adds a new+   `strikethrough` `Style` value and uses the `smxx` and `rmxx`+   Terminfo capabilities to activate and deactivate strikethrough mode,+   respectively. If the terminfo does not report those capabilities,+   this style is ignored.+ * `Output`: added the `setDisplayBounds` field to set the output+   dimensions of the output handle; added an implementation of this for+   the `TerminfoBased` backend.++Other changes:+ * The C prototype for `vty_c_get_window_size` in `gwinsz.h` was fixed.++5.30+----++New features:+ * Added `Graphics.Vty.setWindowTitle` to emit an escape+   sequence to set the window title, provide the terminal emulator+   accepts Xterm-style title sequences. For details, see:+   https://tldp.org/HOWTO/Xterm-Title-3.html++5.29+----++API changes:+ * The Input type got a new field, 'restoreInputState'. This field+   allows the end user to have direct access to the logic needed to+   restore the terminal's input state flags. Prior to having this field,+   this state restoration logic could only be invoked as part of calling+   'shutdownInput', but since that function does other things (like+   killing threads) it is not advisable to call it repeatedly (which is+   necessary in the use case this change is intended to support). This+   can be called directly to restore the input state flags as needed,+   although this is not required if 'shutdown' (or 'shutdownInput') is+   called.++Other changes:+ * attributeControl: explicitly enable the ICRNL terminal mode flag (see+   #187 and c572ad).++5.28.2+------++Bug fixes:+ * Added a package dependency on `semigroups` for the+   `vty-build-width-table` tool on older GHCs (#185)++5.28.1+------++Bug fixes:+ * `installUnicodeWidthTable`: use `throwIO`, not `throw`++5.28+----++This release improves Vty's support for multi-column Unicode characters+and provides greater compatibility with a wider array of terminal+emulators. The following sections summarize the relevant changes, but an+overview of the new functionality is motivated and detailed in the new+"Multi-Column Character Support" README section. For+historical context, please also consider reading over+[#175](https://github.com/jtdaugherty/vty/issues/175).++API changes:+ * New modules were added:+   * `Graphics.Vty.UnicodeWidthTable.Types`+   * `Graphics.Vty.UnicodeWidthTable.IO`+   * `Graphics.Vty.UnicodeWidthTable.Query`+   * `Graphics.Vty.UnicodeWidthTable.Install`+ * The `Config` type got a new field, `allowCustomUnicodeWidthTables`,+   that controls whether `mkVty` will attempt to load a Unicode width+   table if specified in the configuration.++Configuration file changes:+ * A new syntax was added to support specifying Unicode width tables on+   a per-`TERM` basis. The syntax is `widthMap <TERM> <PATH>`. See the+   documentation for `Graphics.Vty.Config` for details. Since prior+   versions of this library will silently ignore any configuration file+   lines they cannot parse, this change to user configuration files is+   at least non-breaking for older versions of Vty.++Other changes:+ * The `mkVty` function now automatically attempts to load a custom+   Unicode width table if one is specified in the configuration,+   provided `allowCustomUnicodeWidthTables` is not set to `Just False`.+   See the documentation for `Graphics.Vty.mkVty` for details.+ * Vty now includes a command line tool, `vty-build-width-table`, that+   queries the terminal emulator to construct a custom Unicode width+   table and optionally update the Vty configuration file to use it.+   Programs that want to use that tool's functionality may also do so+   via the API exposed in the various modules listed above.++5.27+----++* Added `Graphics.Vty.Config.getTtyEraseChar` to support querying the+  kernel for the current terminal's settings to obtain the character+  assigned by the `stty erase` command. That can then be added to the+  Vty configuration's input map to map to `KBS` (backspace) if desired.++5.26+----++* Resolved various import warnings (thanks @glguy)+* Removed the `MonadIO` constraint from the Output type's fields and+  removed `MonadFail` uses (PR #177, thanks @glguy)+* Clarified documentation for ANSI colors (thanks Colby Jenn)+* `Graphics.Vty.Attributes` no longer re-exports+  `Graphics.Vty.Attributes.Color`+* The `Graphics.Vty.Attributes.Color` module is now exposed (thanks+  Colby Jenn)+* Raised upper bound for `microlens` to 0.4.12 (thanks Artyom Kazak)+* Changed from using `System.Posix.Env.getEnv` to+  `System.Environment.lookupEnv` (thanks Jonathan Osser)+* Added `Graphics.Vty.Image` functions for dealing with character width+  computations on `Text` values instead of `Strings`:+  * `safeWctwidth`+  * `safeWctlwidth`+  * `wctwidth`+  * `wctlwidth`++5.25.1+------++* Avoided a conflict with a Microlens 0.4.10 operator and added an+  upper bound on Microlens of 0.4.11.++5.25+----++* The Vty type got a new field, isShutdown, that returns whether the+  Vty handle has had its 'shutdown' function called (thanks Ian+  Jeffries)+* Vty's shutdown function is now thread-safe.++5.24.1+------++* The "shutdown" method of Vty handles is now idempotent (#159)++5.24+----++* Add Generic and NFData instances for some types+* Image: remove custom Show instance, add derived Show and Read+  instances+* Updated Travis build settings (thanks Eric Mertens)++5.23.1+------++* Fixed a bug where italics did not combine properly with other display+  modes (#155, thanks Eric Mertens)++5.23+----++* Added support for italicized output when terminfo supports it. This+  takes the form of a new Style, "italic". Note that most terminfo+  descriptors do not report capabilities for italics, so support for+  this will be very spotty.+* Updateed text/string function documentation to indicate that escapes+  are not permitted in their inputs.++5.22+----++* Added Graphics.Vty.Attributes.Color240.color240CodeToRGB function+  (thanks Brent Carmer)+* Added nextEventNonblocking function (field) to Vty type (#87)++5.21+----++* Picture and Background now provide Eq instances (thanks Jaro Reinders)+* #145: vty builds with microlens 0.4.9 (thanks Daniel Wagner)+* #142: note requirement of threaded RTS++5.20+----++API changes:+* Split up Monoid instances into Monoid and Semigroup for newer GHCs+  (thanks Ryan Scott)++5.19.1+------++API changes:+* Cursor now provides an Eq instance (thanks Jaro Reinders)++5.19+----++API changes:+* URL hyperlinking (via 'withURL') is now optional and disabled by+  default due to poor support on some common terminals. A new 'Mode'+  constructor, 'Hyperlink', has been added to enable this feature. To+  change the hyperlinking mode, use 'setMode' on the 'outputIface' of a+  Vty handle.++5.18.1+------++Bug fixes:+* Reset the hyperlink state on line endings to avoid run-on hyperlinks++5.18+----++API changes:+* Added support for hyperlinking attributes (thanks Getty Ritter). This+  change adds a new Attr field for containing the hyperlink to apply,+  as per https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda++5.17.1+------++* withStyle now ignores zero arguments, leaving attribute styles+  untouched if the input style is the null style++5.17+----++API changes:+* Add support for terminal focus events. This change adds a new mode+  usable with setMode, Focus, that requests that the terminal send+  events on focus lose/gain. This change also adds two new Event+  constructors, EvLostFocus and EvGainedFocus.+* No longer enable UTF8 mouse event encoding. This encoding was not+  working properly with Terminal.app, and using the other modes (SGR,+  etc.) work.+* Graphics.Vty.Attributes: escape backticks in Haddock comment (fixes+  #131)++5.16+----++API changes:+* Added support for mouse wheel events while in mouse mode. The Button+  type got two new constructors as a result: BScrollUp and BScrollDown.+  Thanks to doublescale@tutanota.com for this contribution!++Bug fixes:+* charFill now clamps negative arguments to zero (thanks Eric Mertens!)++5.15.1+------++Package changes:+* Documentation files are now marked accordingly (thanks Michal+  Suchánek)++Bug fixes:+* translateX/Y: fix negative translations++5.15+----++Package changes:+* Discontinued support for GHC versions prior to 7.10.1.+* Removed instructions and configuration for Stack builds since they+  are no longer supported.+* Clarified README mention of (lack of) Windows support (contributors+  wanted, though!)+* Removed dependency on data-default (see below).++API changes:+* Moved color definitions from Attributes to Color module.+* In lieu of data-default (Default) instances for Attr and Config, use+  'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.+* Graphics.Vty.Output no longer re-exports+  Graphics.Vty.Output.Interface.+* Removed Graphics.Vty.Prelude module and moved DisplayRegion and its+  accessors to Graphics.Vty.Image.+* Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.+* Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.++5.14+----++* addMaybeClippedJoin: instead of raising an exception when the join+  is totally clipped, just reduce the clip amount and continue+* addMaybeClipped: skip blit of joins when their primary dimension is+  zero+* 'string' and related text functions no longer treat an empty string+  as an empty image (thanks Chris Penner). This means that now it is+  possible to use 'str ""' as a non-empty image with height 1.++5.13+----++* Reverted changes in 5.12 due to disagreements between terminal+  emulators and utf8proc; for more details, please see the ticket+  discussion at+  https://github.com/coreyoconnor/vty/issues/115++5.12+----++* Replaced 'wcwidth' with a call to the utf8proc library's character+  width function, which is much more up to date (by several Unicode+  versions) and returns the right width for a much larger set of+  characters.+* Added a bundled version of the utf8proc C library.++5.11.3+------++* Fix mouse event offsets in mouse-up events++5.11.2+------++* Mouse events were modified so that the upper-left corner of the window+  is (0,0) rather than (1,1).++5.11.1+------++* Add Generic instance for Image+* nextEvent: stop trying to refresh on a resize event (fixes segfault+  on refresh with normal cursor positioning mode)+* Remove redundant clause from clipForCharWidth (thanks Eric Mertens)+* Update maintainer++5.11+----++* Vty now raises a VtyConfigurationError exception when the TERM+  evironment variable is missing (thanks Eric Mertens)+* Graphics.Vty.Config got an explicit export list to avoid accidentally+  exporting internal types (thanks Eric Mertens)++5.10+----++* Add absolute cursor positioning mode AbsoluteCursor to Cursor. This+  mode provides greater control over cursor positioning by bypassing+  the logical positioning provided by default. Rather than positioning+  the cursor by looking at the widths of characters involved, this+  constructor lets you provide a physical row and column instead. This+  is useful in more sophisticated programs. (thanks Eric Mertens)+* Added a new Generic-derived config parser (thanks Eric Mertens)+* Fixed the MShift case in the configuration file parser (thanks Eric+  Mertens)+* Fixed wcwidth import and matched safeWcswidth to its documented+  behavior. Previously vty_mk_wcwidth was being imported with the+  wrong type causing the -1 return value to be mapped to the wrong Int+  value. Additionally safeWcswidth was using the unsafe character width+  function and only ensuring that the final result was non-negative.+  (thanks Eric Mertens)++5.9.1+-----++* Vty now only emits UTF8 charset sequences in terminals without a+  preexisting UTF8 declaration to avoid emitting garbage sequences+  (fixes #89)++5.9+---++* Added new Output methods supportsBell and ringTerminalBell to find out+  whether the output device has an audio bell and to ring it (see #102)++5.8.1+-----++* Fixed "refresh" to work as advertised (see #104)++5.8+---++* API change: EvPaste input event now provides paste data as a raw+  ByteString rather than a String to allow the application to decode how+  best to decode it++5.7.1+-----++* ModeDemo: added an explicit Control.Applicative import for older GHCs++5.7+---++* Mouse and paste modes are now off by default.+* The Config type got new fields: mouseMode and bracketedPasteMode.+  These determine whether these modes are enabled initially (for+  terminals that support them).+* Added a Mode type for modal terminal features (mouse events,+  bracketed paste mode) that is used with new Output interface+  functions:+  * supportsMode :: Mode -> Bool tells whether the device supports a+    mode+  * setMode :: Mode -> Bool -> IO () turns a mode on or off+  * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or+    off+* Added a new demo program, ModeDemo.hs, to demonstrate usage of modes++5.6+---++* Added support for normal and extended mouse modes in Xterm-like+  terminals via the MouseDown and MouseUp Event constructors+* Added support for bracketed paste mode in Xterm-like terminals via+  the EvPaste event constructor+* Added derived Show instances for Event and Button (thanks Felix+  Hirn)+* Now TERM values containing "screen" will automatically use the+  XtermColor driver rather than just TerminfoBased++5.5.0+-----++* Replaced lens dependency with microlens, microlens-mtl, microlens-th+  dependencies. Issue #90+  * Thanks Jonathan Daugherty+* Cabal corrections.+  * Thanks Lennart Spitzner++5.4.0+-----++* Changed eventChannel of Graphics.Vty.Input from Chan to+  TChan. This enables clients to query if there are no pending+  events. The Graphics.Vty interface nextEvent is unchanged.+  Clients that use eventChannel directly will require updating.+  https://github.com/coreyoconnor/vty/issues/60++5.3.1+-----++* Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due to+  possibly breaking this on reasonable GHC versions++5.3+---++* Upgraded QuickCheck dependency to 2.7+* The standard IO Config (standardIOConfig) was overriding any provided+  application config. In addition, the inputFd and outputFd could not be+  changed if mkVty was used. Fixed.+* Correct handling of display attributes at end of line. The output+  attributes are set to default at the end of content for the line and+  at the start of a new line. Previously the current attribute would+  extend to the next start of content. This was odd to reason about and+  was the cause of https://github.com/coreyoconnor/vty/issues/76 IIRC Yi+  requires the old behavior to display the selection region correctly.+* shutdown of the input thread is now performed using killThread and+  synchronization on an MVar. For correct handling of the terminal read+  vmin and vtime the read must be a blocking read on an OS thread.+  This places a threadWaitRead, which will be interrupted by the+  killThread, prior to the uninterruptable read. An alternative would be+  to re-import the read foreign call as interruptable.++5.2.11+------++* deepseq bounds increased for tests.+* Clean up warnings when compiling on 7.10+  * Thanks Eric Mertens+* Avoid discarding input bytes after multi-byte encoded codepoint+  * Thanks Eric Mertens++5.2.10+------++* "str" now returns EmptyImage for empty strings to match behavior of+  other string-like Image constructors (fixes #74)+  * Thanks Jonathan Daugherty++5.2.9+-----++* dependency version bumps+  * https://github.com/coreyoconnor/vty/pull/71+  * https://github.com/coreyoconnor/vty/pull/70+* Correct/Simplify the example code+  * Thanks glguy+  * https://github.com/coreyoconnor/vty/pull/69++5.2.8+-----++* blaze-builder, lens, utf8-string version constraint bump+    * Thanks glguy+    * https://github.com/coreyoconnor/vty/pull/67+* Do not differentiate based on TERM_PROGRAM+    * https://github.com/coreyoconnor/vty/issues/68++5.2.7+-----++* lens and deepseq constraint bump + misc+    * Thanks ethercrow+    * https://github.com/coreyoconnor/vty/pull/66++5.2.6+-----++* lens constraint bump+    * Thanks alexander-b!+    * https://github.com/coreyoconnor/vty/pull/64++5.2.5+-----++* lens and random version constraint bump.+    * Thanks RyanGlScott!+    * https://github.com/coreyoconnor/vty/pull/62++5.2.4+-----++* removed -fpic from cc-options. No longer required.+    * https://github.com/coreyoconnor/vty/issues/61+    * https://ghc.haskell.org/trac/ghc/ticket/9657+    * Thanks Fuuzetsu!++5.2.3+-----++* evaluate/compile the input parsing table once instead of each+  keystroke.+    * https://github.com/coreyoconnor/vty/pull/59+    * Thanks ethercrow!++5.2.2+-----++* When looking at input for an event, don't look too deep.+    * https://github.com/coreyoconnor/vty/pull/57+    * Thanks ethercrow!++5.2.1+-----++* Bump upper version bound for lens to 4.5. Thanks markus1189!++5.2.0+-----++* Config structure now specifies file descriptor to use. The default+  is stdInput and stdOutput file descriptors. Previously Vty used+  stdInput for input and the follow code for output:+    * hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`+      NoBuffering)+    * the difference was required by Vty.Inline. Now, Vty.Inline uses+      the Config structure options to acheive the same effect.+* removed: derivedVtime, derivedVmin, inputForCurrentTerminal,+  inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO+* added: inputForConfig, outputForConfig+* updates to vty-rogue from jtdaugherty. Thanks!+* the oldest version of GHC tested to support vty is 7.6.2.+* the oldest version of GHC that vty compiles under is 7.4.2++5.1.4+-----++* merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!++5.1.1+-----++* merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!+* jtdaugherty resolved a number of compiler warnings. Thanks!++5.1.0+-----++* vmin and vtime can be specified however the application requires.+  See Graphics.Vty.Config.+* fixed the processing of input when vmin is set > 1.++5.0.0+-----++* The naming convention now matches:+  * http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions+* all projects using vty for input must be compiled with -threaded.+  Please notify vty author if this is not acceptable.+* mkVtyEscDelay has been removed. Use "mkVty def". Which initialized+  vty with the default configuration.+* input handling changes+  * KASCII is now KChar+  * KPN5 is now KCenter+  * tests exist.+  * Applications can add to the input tables by setting inputMap of+    the Config. See Graphics.Vty.Config+  * Users can define input table extensions that will apply to all vty+    applications. See Graphics.Vty.Config+  * terminal timing is now handled by selecting an appropriate VTIME.+    Previously this was implemented within Vty itself. This reduced+    complexity in vty but provides a different meta key behavior and+    implies a requirement on -threaded.+  * The time vty will wait to verify an ESC byte means a single ESC+    key is the singleEscPeriod of the Input Config structure.+* removed the typeclass based terminal and display context interface+  in favor of a data structure of properties interface.+* renamed the Terminal interface to Output+* The default picture for an image now uses the "clear" background.+  This background fills background spans with spaces or just ends the+  line.+  * Previously the background defaulted to the space character. This+    causes issues copying text from a text editor. The text would end+    up with extra spaces at the end of the line.+* Layer support+  * Each layer is an image.+  * The layers for a picture are a list of images.+  * The first image is the top-most layer. The images are ordered from+    top to bottom.+  * The transparent areas for a layer are the backgroundFill areas.+    backgroundFill is added to pad images when images of different+    sizes are joined.+  * If the background is clear there is no background layer.+  * If there is a background character then the bottom layer is the+    background layer.+  * emptyPicture is a Picture with no layers and no cursor+  * addToTop and addToBottom add a layer to the top and bottom of the+    given Picture.+* compatibility improvements:+  * terminfo based terminals with no cursor support are silently+    accepted. The cursor visibility changes in the Picture will have+    no effect.+  * alternate (setf/setb) color maps supported. Though colors beyond+    the first 8 are just a guess.+  * added "rgbColor" for easy support of RGB specified colors.+  * Both applications and users can add to the mapping used to+    translate from input bytes to events.+* Additional information about input and output process can be+  appended to a debug log+  * Set environment variable VTY_DEBUG_LOG to path of debug log+  * Or use "debugLog <path>" config directive+  * Or set 'debugLog' property of the Config provided to mkVty.+* examples moved to vty-examples package. See test directory for cabal+  file.+  * vty-interactive-terminal-test+    * interactive test. Useful for building a bug report for vty's+      author.+    * test/interactive_terminal_test.hs+  * vty-event-echo+    * view a input event log for vty. Example of interacting with+      user.+    * test/EventEcho.hs+  * vty-rogue+    * The start of a rogue-like game. Example of layers and image+      build operations.+    * test/Rogue.hs+  * vty-benchmark+    * benchmarks vty. A series of tests that push random pictures to+      the terminal. The random pictures are generated using+      QuickCheck. The same generators used in the automated tests.+    * test/benchmark.hs++4.7.0.0+-------++API changes:+* Added Graphics.Vty.Image.crop: Ensure an image is no larger+  than the specified size.+* Added Graphics.Vty.Image.pad: Ensure an image is no smaller+  than the specified size.+* Added Graphics.Vty.Image.translate: Offset an image.+* Thanks Ben Boeckel <MathStuf@gmail.com> for these features.++4.2.1.0+-------++API changes:+* Attr record accessor fore_color changed to attr_fore_color+* Attr record accessor back_color changed to attr_back_color+* Attr record accessor style changed to attr_style+* Added an "inline" display attribute changing DSL:+  * put_attr_change applies a display attribute change+    immediately to a terminal+  * For instance, can be used to change the display attrbiutes+    of text output via putStrLn and putStr. EX:+    "put_attr_change $ back_color red" will set the background+    color to red.+  * Changes do not apply to a Picture output via output_picture.+  * See Graphics.Vty.Inline+* Moved all IO actions into any monad an instance of MonadIO++4.0.0.1+-------++* binding for mk_wcswidth was incorrect. Most platforms just+  magically worked due to coincidence.++4.0.0+-----++API changes:+* "getSize" has been removed. Use "terminal vty >>= display_bounds"+  where "vty" is an instance of the Vty data structure.+* added a "terminal" field to the Vty data structure. Accesses the+  TerminalHandle associated with the Vty instance.+* Graphics.Vty.Types has undergone a number of changes. Summary:+  * Partitioned into Graphics.Vty.Attributes for display attributes.+    Graphics.Vty.Image for image combinators. Graphics.Vty.Picture+    for final picture construction.+* Graphics.Vty.Attributes:+  * "setFG" and "setBG" are now "with_fore_color" and+    "with_back_color"+  * All other "set.." equations similarly replaced.+  * "attr" is now "def_attr", short for "default display attributes"+    Also added a "current_attr" for "currently applied display+    attributes"+* Graphics.Vty.Image:+  * "horzcat" is now "horiz_cat"+  * "vertcat" is now "vert_cat"+  * "renderBS" is now "utf8_bytestring"+  * "renderChar" is now "char"+  * "renderFill" is now "char_fill"+  * added a "utf8_string" and "string" (AKA "iso_10464_string") for+    UTF-8 encoded Strings and ISO-10464 encoded Strings. String+    literals in GHC have an ISO-10464 runtime representation.+* Graphics.Vty.Picture:+  * exports Graphics.Vty.Image+  * "pic" is now "pic_for_image"+  * added API for setting background fill pattern.+* Completely rewritten output backend.+  * Efficient, scanline style output span generator. Has not been+    fully optimized, but good enough.+  * The details required to display the desired picture on a+    terminal are well encapsulated.+  * Terminfo based display terminal implementation. With specialized+    derivitives for xterm, Terminal.app, and iTerm.app.+      * Attempts to robustly handle even terminals that don't+        support all display attributes.+      * I've tested the following terminals with success: iTerm.app,+        Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,+        konsole, screen, linux vty. Hopefully you will be as+        successfull.+  * Improved unicode support. Double wide characters will display as+    expected.+* 256 color support. See Graphics.Vty.Attributes.Color240. The actual+  output color is adjusted according to the number of colors the+  terminal supports.+* The Graphics.Vty.Image combinators no longer require matching+  dimensions to arguments. Unspecified areas are filled in with a+  user-customizable background pattern. See Graphics.Vty.Picture.+* output images are always cropped to display size.+* Significant code coverage by QuickCheck tests. An interactive test+  for those final properties that couldn't be automatically verified.++Issues resolved:+* "gnome terminal displays non-basic attributes as strikethrough"+  * http://trac.haskell.org/vty/ticket/14+* "Multi-byte characters are not displayed correctly on update"+  * http://trac.haskell.org/vty/ticket/10+* "Redraw does not handle rendering a line that extends beyond screen+  width characters"+  * http://trac.haskell.org/vty/ticket/13+* "The <|> and <-> combinators should be more forgiving of mismatched+  dimensions"+  * http://trac.haskell.org/vty/ticket/9+* "256-color support"+  * http://trac.haskell.org/vty/ticket/19
LICENSE view
@@ -1,3 +1,5 @@+BSD 3-Clause License+ Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009  All rights reserved.
README.md view
@@ -4,51 +4,60 @@ interface for doing terminal I/O. Vty is supported on GHC versions 7.10.1 and up. -Install via `git` with:+`vty` and its partner packages are published on+[Hackage](https://hackage.haskell.org/). The `vty` package works in+concert with one or more *platform packages* to do terminal I/O. Each+platform package provides support for terminal I/O on a specific+platform. Known platform packages are: -```-git clone git://github.com/coreyoconnor/vty.git-```+* [vty-unix](https://github.com/jtdaugherty/vty-unix) - the Unix+  terminal backend for Vty+* [vty-windows](https://github.com/chhackett/vty-windows) - the Windows+  terminal backend for Vty+* [vty-crossplatform](https://github.com/jtdaugherty/vty-crossplatform) -+  a package that builds `vty-unix` or `vty-windows` based on the build+  environment -Install via `cabal` with:+# How to use Vty -```-cabal install vty-```+1. Add a package dependency on `vty-unix`, `vty-windows,` or+   `vty-crossplatform`, depending on the desired level of platform+   support. For example, if an application only supports Unix systems,+   it should depend on `vty-unix`. But if an application is intended to+   work anywhere Vty works, then `vty-crossplatform` is the best choice.+2. Add a package dependency on `vty`; the core library abstractions,+   types, and functions are obtained from `vty` itself. The platform+   packages do not re-export the core library's modules.+3. Import `mkVty` from the platform package in step (1) and use that to+   construct a `Vty` handle and initialize the terminal.+4. If desired, call `Graphics.Vty.Config.userConfig` to load the Vty+   user configuration since this step is not automatic. -# Features+Once you've initialized the terminal and have a `Vty` value, all of the+`vty` package's API is now ready to use to do terminal I/O. -* Supports a large number of terminals. vt100, ansi, hurd, linux,-  screen, etc., or anything with a sufficient terminfo entry.+# Implementing support for a new platform -* Automatic handling of window resizes.+Although this shouldn't be necessary to do very often (if ever!), if+you would like to implement support for a new platform for Vty, see+`PLATFORM-HOWTO.md`. -* Unicode output on terminals with UTF-8 support.+# Features -* Handles multi-column glyphs. (Requires user to properly configure-  terminal.)+* Provides an efficient output algorithm. Output buffering and terminal+  state changes are minimized. -* Efficient output. Output buffering and terminal state changes are-  minimized.+* Automatically handles window resizes.  * Minimizes repaint area, which virtually eliminates the flicker   problems that plague ncurses programs. -* A pure, compositional interface for efficiently constructing display-  images.--* Automatically decodes keyboard keys into (key,[modifier]) tuples.+* Provides a pure, compositional interface for efficiently constructing+  display images.  * Automatically supports refresh on Ctrl-L. -* Supports a keypress timeout after for lone ESC. The timeout is-  customizable.--* The interface is designed for easy extension.--* Supports ANSI graphics modes (SGR as defined in `console_codes(4)`)-  with a type-safe interface and graceful fallback for terminals-  with limited or nonexistent support for such modes.+* Provides extensible input and output interfaces.  * Properly handles cleanup (but not due to signals). @@ -60,81 +69,99 @@ * Supports bracketed paste mode as described at   http://cirw.in/blog/bracketed-paste -# Platform Support--## Posix Terminals--Uses terminfo to determine terminal protocol. With some special rules to-handle some omissions from terminfo.--## Windows--Unsupported (but contributions and testing here are very welcome!)--# Contributing--If you decide to contribute, that's great! Here are some guidelines you-should consider to make submitting patches easier for all concerned:-- - If you want to take on big things, talk to me first; let's have a-   design/vision discussion before you start coding. Create a GitHub-   issue and we can use that as the place to hash things out.- - If you make changes, make them consistent with the syntactic-   conventions already used in the codebase.- - Please provide Haddock documentation for any changes you make.+* Supports multi-column Unicode characters such as emoji characters. In+  cases where Vty and your terminal emulator disagree on character+  widths, Vty provides a tool `vty-build-width-table` and library+  functionality to build a width table that will work for your terminal+  and load it on application startup.  # Development Notes -## Under NixOS+Vty uses threads internally, so programs made with Vty need to be+compiled with the threaded runtime using the GHC `-threaded` option. -### Using cabal+# Multi-Column Character Support -After installing `ncurses` to the user environment:+Vty supports rendering of multi-column characters such as two-column+Asian characters and Emoji characters. This section details how to+take advantage of this feature, since its behavior will depend on the+terminal emulator in use. -~~~-LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal configure --enable-tests --extra-lib-dirs=$HOME/.nix-profile/lib-LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal build-LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal test-~~~+Terminal emulators support Unicode to varying degrees, and each terminal+emulator relies on a table of column widths for each supported Unicode+character. Vty also needs to rely on such a table to compute the width+of Vty images to do image layout. Since those tables can disagree if+Vty and the terminal emulator support different versions of Unicode,+and since different terminal emulators will support different versions+of Unicode, it's likely that for some wide characters, Vty applications+will exhibit rendering problems. Those rendering problems arise from Vty+and the terminal emulator coming to different conclusions about how wide+some characters are. -## Code Coverage+To address this, Vty supports loading custom character width tables+that are based on the terminal's behavior in order to eliminate these+disagreements. By default, though, Vty will use its built-in Unicode+character width table. Since the built-in table is likely to eventually+disagree with your terminal, Vty provides an API and a command-line tool+to generate and install custom tables. -As of last testing, profiling causes issues with coverage when enabled.-To evaluate coverage, configure as follows:+Custom Unicode width tables based on your terminal emulator can+be built by using the API in `Graphics.Vty.UnicodeWidthTable`.+The process works by querying the current terminal environment to+obtain its width measurements for the entire supported Unicode+range. The results are then saved to a disk file. -~~~-rm -rf dist ; cabal configure --enable-tests --enable-library-coverage \-  --disable-library-profiling \-  --disable-executable-profiling-~~~+Saved width tables can then be loaded in one of two ways: -## Profiling+* Via the library API in `Graphics.Vty.UnicodeWidthTable.IO`+* By adding a `widthMap` directive to your Vty configuration file and+  then invoking `mkVty` to initialize Vty -~~~-rm -rf dist ; cabal configure --enable-tests --disable-library-coverage \-  --enable-library-profiling \-  --enable-executable-profiling-~~~+The Vty configuration file supports the `widthMap` directive to allow+users to specify which custom width table should be loaded for a given+terminal type. This is done by specifying, e.g., -# Known Issues+```+widthMap "xterm" "/path/to/map.dat"+``` -* Terminals have numerous quirks and bugs. Vty picks what works best for-  the author in ambiguous or buggy situations.+where the first argument is the value that `TERM` must have in order for+the table to be loaded, and the second argument is the path to the table+file itself as generated by the two alternatives listed above. If the+Vty configuration file contains multiple matching `widthMap` directives+for the current value of `TERM`, the last one listed in the file is+used. -* Signal handling of STOP, TERM and INT are nonexistent.+The tables declared in the configuration file are only ever+automatically loaded when applications set up Vty by calling+`Graphics.Vty.mkVty`. -* The character encoding of the terminal is assumed to be UTF-8 if-  unicode is used.+Before a custom table has been loaded, calls to the library's character+width functions (e.g. `wcwidth`) will use the default built-in table.+Once a custom table has been loaded, the functions will use the new+custom table. Only one custom table load can be performed in a Vty+program. Once a custom table has been loaded, it cannot be replaced or+removed. -* Terminfo is assumed to be correct unless there is an override-  configured. Some terminals will not have correct special key support-  (shifted F10 etc). See `Config` for customizing vty's behavior for a-  particular terminal.+# Contributing -* Uses the `TIOCGWINSZ` ioctl to find the current window size, which-  appears to be limited to Linux and BSD.+If you decide to contribute, that's great! Here are some guidelines you+should consider to make submitting patches easier for all concerned: -# Sources+ - Patches written completely or partially by AI are unlikely to be+   accepted. Please disclose any AI use.+ - If you want to take on big things, talk to me first; let's have a+   design/vision discussion before you start coding. Create a GitHub+   issue and we can use that as the place to hash things out.+ - If you make changes, make them consistent with the syntactic+   conventions already used in the codebase.+ - Please provide Haddock documentation for any changes you make.+ - Please do NOT include package version changes in your patches.+   Package version changes are only done at release time when the full+   scope of a release's changes can be evaluated to determine the+   appropriate version change.++# Further Reading  Good sources of documentation for terminal programming are:
− cbits/gwinsz.c 
@@ -1,9 +0,0 @@-#include <sys/ioctl.h>--unsigned long vty_c_get_window_size(int fd) {-	struct winsize w;-	if (ioctl (fd, TIOCGWINSZ, &w) >= 0)-		return (w.ws_row << 16) + w.ws_col;-	else-		return 0x190050;-}
cbits/mk_wcwidth.c view
@@ -60,7 +60,32 @@  */  #include <HsFFI.h>+#include <stdlib.h>+#include <string.h> +// The maximum size for a custom character width table is the total+// number of possible characters as dictated by the compiler.+#define MAX_CUSTOM_TABLE_SIZE (HS_CHAR_MAX + 1)++// The pointer to the start of the custom character width table, if+// any. If this is NULL or this is set but the ready flag is false, the+// built-in tree search logic is used.+static uint8_t* custom_table = NULL;++// Unused table cell value.+static uint8_t UNUSED_CELL = 0xff;++// The size of the custom table, in entries. This should only be set+// if custom_table is not NULL. Its value should be the size of the+// custom_table array.+static uint32_t custom_table_size = 0;++// A flag indicating whether the custom table is ready for+// use. This should only be set once the table has been+// allocated with vty_init_custom_table and initialized with+// vty_set_custom_table_range.+static uint8_t custom_table_ready = 0;+ struct interval {   int first;   int last;@@ -119,7 +144,7 @@  * in ISO 10646.  */ -HsInt vty_mk_wcwidth(HsChar ucs)+static HsInt builtin_wcwidth(HsChar ucs) {   /* sorted list of non-overlapping intervals of non-spacing characters */   /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */@@ -182,7 +207,7 @@    /* binary search in table of non-spacing characters */   if (vty_bisearch(ucs, combining,-	       sizeof(combining) / sizeof(struct interval) - 1))+              sizeof(combining) / sizeof(struct interval) - 1))     return 0;    /* if we arrive here, ucs is not a combining or C0/C1 control character */@@ -201,4 +226,126 @@       (ucs >= 0xffe0 && ucs <= 0xffe6) ||       (ucs >= 0x20000 && ucs <= 0x2fffd) ||       (ucs >= 0x30000 && ucs <= 0x3fffd)));+}++// Return the width, in terminal cells, of the specified character.+//+// If the global custom width table is present, that table will be+// consulted for the character's width. If the character is not in the+// table, this will fall back to the built-in table. If the character is+// in neither table, zero will be returned. If the custom width table is+// not present, the built-in width table will be used.+HsInt vty_mk_wcwidth(HsChar ch)+{+    if (custom_table_ready) {+        if ((ch >= 0) && (ch < custom_table_size)) {+            uint8_t result = custom_table[ch];++            // The table is filled with UNUSED_CELL values for+            // uninitialized ranges so we can defer to the built-in+            // table in those cases.+            if (result == UNUSED_CELL) {+                return builtin_wcwidth(ch);+            } else {+                return result;+            }+        } else {+            return -1;+        }+    } else {+        return builtin_wcwidth(ch);+    }+}++// Initialize a custom character width table.+//+// This allocates a new character width table of the specified size+// (in characters). If a custom table has already been allocated, this+// returns 1. Otherwise it allocates a new table, initializes all of its+// entries to UNUSED_CELL, and returns zero.+//+// Note that this does *not* mark the table as ready for use. Until the+// table is marked ready, it will not be used by vty_mk_wcwidth. To mark+// the table as ready, call vty_activate_custom_table() after the table+// has been set up with calls to vty_set_custom_table_range.+int vty_init_custom_table(int size)+{+    if (custom_table == NULL) {+        if (size > 0 && size <= MAX_CUSTOM_TABLE_SIZE) {+            custom_table_ready = 0;+            custom_table = malloc(size);+            memset(custom_table, UNUSED_CELL, size);+            custom_table_size = size;+            return 0;+        } else {+            return 1;+        }+    } else {+        return 1;+    }+}++// Set the specified character range in the custom width table to the+// specified width.+//+// This function sets 'width' as the character width for all entries+// in the custom character table starting at the 'start' entry and+// including all entries up to and including 'start + size - 1'.+//+// If this succeeds, it returns zero. If it fails, it returns 1. It+// fails if the table is not allocated, marked as ready (i.e. it is in+// use and has already been populated), or if the start or size values+// are not in bounds for the table.+int vty_set_custom_table_range(uint32_t start, uint32_t size, uint8_t width)+{+    if ((custom_table == NULL) ||+        (size >= custom_table_size) ||+        (start >= custom_table_size) ||+        ((start + 1) >= (custom_table_size - size)) ||+        custom_table_ready) {+        return 1;+    } else {+        memset(custom_table + start, width, size);+        return 0;+    }+}++// Mark the allocated custom character width table as ready for use.+//+// After this call, further calls to vty_set_custom_table_range will+// fail.+//+// This function returns 0 if it succeeds. If it fails, it returns 1.+// It fails if the custom table is already ready or if it has not been+// allocated.+int vty_activate_custom_table()+{+    if (custom_table_ready || (custom_table == NULL)) {+        return 1;+    } else {+        custom_table_ready = 1;+        return 0;+    }+}++// Returns whether a custom character width table has been marked ready.+int vty_custom_table_ready()+{+    return custom_table_ready;+}++// Deallocate the custom width table.+//+// This does nothing if there is no allocated custom width table, or if+// there is one but it is in use (marked ready). This is only useful if+// an initial allocation succeeds, but range population fails, after+// which point the application may want to deallocate the table to avoid+// leaving it in an intermediate state.+void vty_deallocate_custom_table()+{+    if ((custom_table != NULL) && (!custom_table_ready)) {+        free(custom_table);+        custom_table = NULL;+        custom_table_size = 0;+    } }
− cbits/set_term_timing.c 
@@ -1,13 +0,0 @@-#include <termios.h>-#include <stdio.h>-#include <unistd.h>-#include <stdlib.h>--void vty_set_term_timing(int fd, int vmin, int vtime)-{-    struct termios trm;-    tcgetattr(fd, &trm);-    trm.c_cc[VMIN] = vmin;-    trm.c_cc[VTIME] = vtime;-    tcsetattr(fd, TCSANOW, &trm);-}
− demos/Demo.hs 
@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-module Main where--import Graphics.Vty--import Control.Applicative hiding ((<|>))-import Control.Arrow-import Control.Monad.RWS--import Data.Sequence (Seq, (<|) )-import qualified Data.Sequence as Seq-import Data.Foldable--eventBufferSize = 1000--type App = RWST Vty () (Seq String) IO--main = do-    vty <- if True -- change to false for emacs-like input processing-            then mkVty defaultConfig-            else mkVty (defaultConfig { vmin = Just 2, vtime = Just 300 } )-    _ <- execRWST (vtyInteract False) vty Seq.empty-    shutdown vty--vtyInteract :: Bool -> App ()-vtyInteract shouldExit = do-    updateDisplay-    unless shouldExit $ handleNextEvent >>= vtyInteract--introText = vertCat $ map (string defAttr)-    [ "this line is hidden by the top layer"-    , "The vty demo program will echo the events generated by the pressed keys."-    , "Below there is a 240 color box."-    , "Followed by a description of the 16 color pallete."-    , "If the 240 color box is not visible then the terminal"-    , "claims 240 colors are not supported."-    , "Try setting TERM to xterm-256color"-    , "This text is on a lower layer than the event list."-    , "Which means it'll be hidden soon."-    , "Bye!"-    , "Great Faith in the ¯\\_(ツ)_/¯"-    , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"-    ]--colorbox_240 :: Image-colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages-    where-        colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]-        splitColorImages [] = []-        splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))--colorbox_16 :: Image-colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border-    where-        column0 = vertCat $ map lineWithColor normal-        column1 = vertCat $ map lineWithColor bright-        border = vertCat $ replicate (length normal) $ string defAttr " | "-        column2 = vertCat $ map (string defAttr . snd) normal-        lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName-        normal = zip [ black, red, green, yellow, blue, magenta, cyan, white ]-                     [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]-        bright = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue-                     , brightMagenta, brightCyan, brightWhite ]-                     [ "bright black", "bright red", "bright green", "bright yellow"-                     , "bright blue", "bright magenta", "bright cyan", "bright white" ]--updateDisplay :: App ()-updateDisplay = do-    let info = string (defAttr `withForeColor` black `withBackColor` green)-                      "Press ESC to exit. Events for keys below."-    eventLog <- foldMap (string defAttr) <$> get-    let pic = picForImage (info <-> eventLog)-              `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)-    vty <- ask-    liftIO $ update vty pic--handleNextEvent = ask >>= liftIO . nextEvent >>= handleEvent-    where-        handleEvent e               = do-            modify $ (<|) (show e) >>> Seq.take eventBufferSize-            return $ e == EvKey KEsc []-
− demos/ModeDemo.hs 
@@ -1,53 +0,0 @@-module Main where--import Control.Applicative-import Data.Monoid--import Graphics.Vty--mkUI :: (Bool, Bool, Bool, Bool) -> Maybe Event -> Image-mkUI (m, ms, p, ps) e =-    vertCat [ string defAttr $ "Mouse mode supported: " <> show m-            , string defAttr $ "Mouse mode status: " <> show ms-            , string defAttr " "-            , string defAttr $ "Paste mode supported: " <> show p-            , string defAttr $ "Paste mode status: " <> show ps-            , string defAttr " "-            , string defAttr $ "Last event: " <> show e-            , string defAttr " "-            , string defAttr "Press 'm' to toggle mouse mode, 'p' to toggle paste mode, and 'q' to quit."-            ]--main :: IO ()-main = do-    cfg <- standardIOConfig-    vty <- mkVty cfg--    let renderUI lastE = do-          let output = outputIface vty-          info <- (,,,) <$> (pure $ supportsMode output Mouse)-                        <*> getModeStatus output Mouse-                        <*> (pure $ supportsMode output BracketedPaste)-                        <*> getModeStatus output BracketedPaste-          return $ picForImage $ mkUI info lastE--    let go lastE = do-          pic <- renderUI lastE-          update vty pic-          e <- nextEvent vty-          case e of-              EvKey (KChar 'q') [] -> return ()-              EvKey (KChar 'm') [] -> do-                  let output = outputIface vty-                  enabled <- getModeStatus output Mouse-                  setMode output Mouse (not enabled)-                  go (Just e)-              EvKey (KChar 'p') [] -> do-                  let output = outputIface vty-                  enabled <- getModeStatus output BracketedPaste-                  setMode output BracketedPaste (not enabled)-                  go (Just e)-              _ -> go (Just e)--    go Nothing-    shutdown vty
− dist/build/verify-attribute-opsStub/verify-attribute-opsStub-tmp/verify-attribute-opsStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyAttributeOps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-crop-span-generationStub/verify-crop-span-generationStub-tmp/verify-crop-span-generationStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyCropSpanGeneration ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-display-attributesStub/verify-display-attributesStub-tmp/verify-display-attributesStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyDisplayAttributes ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-empty-image-propsStub/verify-empty-image-propsStub-tmp/verify-empty-image-propsStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyEmptyImageProps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-eval-terminfo-capsStub/verify-eval-terminfo-capsStub-tmp/verify-eval-terminfo-capsStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyEvalTerminfoCaps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-image-opsStub/verify-image-opsStub-tmp/verify-image-opsStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyImageOps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-image-transStub/verify-image-transStub-tmp/verify-image-transStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyImageTrans ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-inlineStub/verify-inlineStub-tmp/verify-inlineStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyInline ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-layers-span-generationStub/verify-layers-span-generationStub-tmp/verify-layers-span-generationStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyLayersSpanGeneration ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-parse-terminfo-capsStub/verify-parse-terminfo-capsStub-tmp/verify-parse-terminfo-capsStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyParseTerminfoCaps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-simple-span-generationStub/verify-simple-span-generationStub-tmp/verify-simple-span-generationStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifySimpleSpanGeneration ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-terminalStub/verify-terminalStub-tmp/verify-terminalStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyOutput ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-using-mock-terminalStub/verify-using-mock-terminalStub-tmp/verify-using-mock-terminalStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyUsingMockTerminal ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-utf8-widthStub/verify-utf8-widthStub-tmp/verify-utf8-widthStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyUtf8Width ( tests )-main :: IO ()-main = stubMain tests
− src/Codec/Binary/UTF8/Debug.hs 
@@ -1,18 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--- Copyright 2009 Corey O'Connor-module Codec.Binary.UTF8.Debug where--import Codec.Binary.UTF8.String ( encode )--import Data.Word--import Numeric---- | Converts an array of ISO-10646 characters (Char type) to an array--- of Word8 bytes that is the corresponding UTF8 byte sequence-utf8FromIso :: [Int] -> [Word8]-utf8FromIso = encode . map toEnum--ppUtf8 :: [Int] -> IO ()-ppUtf8 = print . map (\f -> f "") . map showHex . utf8FromIso-
− src/Data/Terminfo/Eval.hs 
@@ -1,132 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# OPTIONS_GHC -funbox-strict-fields #-}-{-# OPTIONS_HADDOCK hide #-}---- | Evaluates the paramaterized terminfo string capability with the--- given parameters.-module Data.Terminfo.Eval-  ( writeCapExpr-  )-where--import Blaze.ByteString.Builder.Word-import Blaze.ByteString.Builder-import Data.Terminfo.Parse--import Control.Monad.Identity-import Control.Monad.State.Strict-import Control.Monad.Writer--import Data.Bits ((.|.), (.&.), xor)-import Data.List--import qualified Data.Vector.Unboxed as Vector---- | capability evaluator state-data EvalState = EvalState-    { evalStack :: ![CapParam]-    , evalExpression :: !CapExpression-    , evalParams :: ![CapParam]-    }--type Eval a = StateT EvalState (Writer Write) a--pop :: Eval CapParam-pop = do-    s <- get-    let v : stack' = evalStack s-        s' = s { evalStack = stack' }-    put s'-    return v--readParam :: Word -> Eval CapParam-readParam pn = do-    !params <- get >>= return . evalParams-    return $! genericIndex params pn--push :: CapParam -> Eval ()-push !v = do-    s <- get-    let s' = s { evalStack = v : evalStack s }-    put s'--applyParamOps :: CapExpression -> [CapParam] -> [CapParam]-applyParamOps cap params = foldl applyParamOp params (paramOps cap)--applyParamOp :: [CapParam] -> ParamOp -> [CapParam]-applyParamOp params IncFirstTwo = map (+ 1) params--writeCapExpr :: CapExpression -> [CapParam] -> Write-writeCapExpr cap params =-    let params' = applyParamOps cap params-        s0 = EvalState [] cap params'-    in snd $ runWriter (runStateT (writeCapOps (capOps cap)) s0)--writeCapOps :: CapOps -> Eval ()-writeCapOps ops = mapM_ writeCapOp ops--writeCapOp :: CapOp -> Eval ()-writeCapOp (Bytes !offset !count) = do-    !cap <- get >>= return . evalExpression-    let bytes = Vector.take count $ Vector.drop offset (capBytes cap)-    Vector.forM_ bytes $ tell.writeWord8-writeCapOp DecOut = do-    p <- pop-    forM_ (show p) $ tell.writeWord8.toEnum.fromEnum-writeCapOp CharOut = do-    pop >>= tell.writeWord8.toEnum.fromEnum-writeCapOp (PushParam pn) = do-    readParam pn >>= push-writeCapOp (PushValue v) = do-    push v-writeCapOp (Conditional expr parts) = do-    writeCapOps expr-    writeContitionalParts parts-    where-        writeContitionalParts [] = return ()-        writeContitionalParts ((trueOps, falseOps) : falseParts) = do-            -- (man 5 terminfo)-            -- Usually the %? expr part pushes a value onto the stack,-            -- and %t pops it from the stack, testing if it is nonzero-            -- (true). If it is zero (false), control passes to the %e-            -- (else) part.-            v <- pop-            if v /= 0-                then writeCapOps trueOps-                else do-                    writeCapOps falseOps-                    writeContitionalParts falseParts--writeCapOp BitwiseOr = do-    v0 <- pop-    v1 <- pop-    push $ v0 .|. v1-writeCapOp BitwiseAnd = do-    v0 <- pop-    v1 <- pop-    push $ v0 .&. v1-writeCapOp BitwiseXOr = do-    v1 <- pop-    v0 <- pop-    push $ v0 `xor` v1-writeCapOp ArithPlus = do-    v1 <- pop-    v0 <- pop-    push $ v0 + v1-writeCapOp ArithMinus = do-    v1 <- pop-    v0 <- pop-    push $ v0 - v1-writeCapOp CompareEq = do-    v1 <- pop-    v0 <- pop-    push $ if v0 == v1 then 1 else 0-writeCapOp CompareLt = do-    v1 <- pop-    v0 <- pop-    push $ if v0 < v1 then 1 else 0-writeCapOp CompareGt = do-    v1 <- pop-    v0 <- pop-    push $ if v0 > v1 then 1 else 0
− src/Data/Terminfo/Parse.hs 
@@ -1,339 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# OPTIONS_GHC -funbox-strict-fields -O #-}--module Data.Terminfo.Parse-  ( module Data.Terminfo.Parse-  , Text.Parsec.ParseError-  )-where--import Control.Monad ( liftM )-import Control.DeepSeq--import Data.Word-import qualified Data.Vector.Unboxed as Vector--import Numeric (showHex)--import Text.Parsec--data CapExpression = CapExpression-    { capOps :: !CapOps-    , capBytes :: !(Vector.Vector Word8)-    , sourceString :: !String-    , paramCount :: !Int-    , paramOps :: !ParamOps-    } deriving (Eq)--instance Show CapExpression where-    show c-        = "CapExpression { " ++ show (capOps c) ++ " }"-        ++ " <- [" ++ hexDump ( map ( toEnum . fromEnum ) $! sourceString c ) ++ "]"-        ++ " <= " ++ show (sourceString c)-        where-            hexDump :: [Word8] -> String-            hexDump = foldr (\b s -> showHex b s) ""--instance NFData CapExpression where-    rnf (CapExpression ops !_bytes !str !c !pOps)-        = rnf ops `seq` rnf str `seq` rnf c `seq` rnf pOps--type CapParam = Word--type CapOps = [CapOp]-data CapOp =-      Bytes !Int !Int -- offset count-    | DecOut | CharOut-    -- This stores a 0-based index to the parameter. However the-    -- operation that implies this op is 1-based-    | PushParam !Word | PushValue !Word-    -- The conditional parts are the sequence of (%t expression, %e-    -- The expression) pairs. %e expression may be NOP-    | Conditional-      { conditionalExpr :: !CapOps-      , conditionalParts :: ![(CapOps, CapOps)]-      }-    | BitwiseOr | BitwiseXOr | BitwiseAnd-    | ArithPlus | ArithMinus-    | CompareEq | CompareLt | CompareGt-    deriving (Show, Eq)--instance NFData CapOp where-    rnf (Bytes offset byteCount ) = rnf offset `seq` rnf byteCount-    rnf (PushParam pn) = rnf pn-    rnf (PushValue v) = rnf v-    rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts-    rnf BitwiseOr = ()-    rnf BitwiseXOr = ()-    rnf BitwiseAnd = ()-    rnf ArithPlus = ()-    rnf ArithMinus = ()-    rnf CompareEq = ()-    rnf CompareLt = ()-    rnf CompareGt = ()-    rnf DecOut = ()-    rnf CharOut = ()--type ParamOps = [ParamOp]-data ParamOp =-      IncFirstTwo-    deriving (Show, Eq)--instance NFData ParamOp where-    rnf IncFirstTwo = ()--parseCapExpression :: String -> Either ParseError CapExpression-parseCapExpression capString =-    let v = runParser capExpressionParser-                      initialBuildState-                      "terminfo cap"-                      capString-    in case v of-        Left e -> Left e-        Right buildResults -> Right $ constructCapExpression capString buildResults--constructCapExpression :: [Char] -> BuildResults -> CapExpression-constructCapExpression capString buildResults =-    let expr = CapExpression-                { capOps = outCapOps buildResults-                -- The cap bytes are the lower 8 bits of the input-                -- string's characters.-                , capBytes = Vector.fromList $ map (toEnum.fromEnum) capString-                , sourceString = capString-                , paramCount = outParamCount buildResults-                , paramOps = outParamOps buildResults-                }-    in rnf expr `seq` expr--type CapParser a = Parsec String BuildState a--capExpressionParser :: CapParser BuildResults-capExpressionParser = do-    rs <- many $ paramEscapeParser <|> bytesOpParser-    return $ mconcat rs--paramEscapeParser :: CapParser BuildResults-paramEscapeParser = do-    _ <- char '%'-    incOffset 1-    literalPercentParser <|> paramOpParser--literalPercentParser :: CapParser BuildResults-literalPercentParser = do-    _ <- char '%'-    startOffset <- getState >>= return . nextOffset-    incOffset 1-    return $ BuildResults 0 [Bytes startOffset 1] []--paramOpParser :: CapParser BuildResults-paramOpParser-    = incrementOpParser-    <|> pushOpParser-    <|> decOutParser-    <|> charOutParser-    <|> conditionalOpParser-    <|> bitwiseOpParser-    <|> arithOpParser-    <|> literalIntOpParser-    <|> compareOpParser-    <|> charConstParser--incrementOpParser :: CapParser BuildResults-incrementOpParser = do-    _ <- char 'i'-    incOffset 1-    return $ BuildResults 0 [] [ IncFirstTwo ]--pushOpParser :: CapParser BuildResults-pushOpParser = do-    _ <- char 'p'-    paramN <- digit >>= return . (\d -> read [d])-    incOffset 2-    return $ BuildResults (fromEnum paramN) [PushParam $ paramN - 1] []--decOutParser :: CapParser BuildResults-decOutParser = do-    _ <- char 'd'-    incOffset 1-    return $ BuildResults 0 [ DecOut ] []--charOutParser :: CapParser BuildResults-charOutParser = do-    _ <- char 'c'-    incOffset 1-    return $ BuildResults 0 [ CharOut ] []--conditionalOpParser :: CapParser BuildResults-conditionalOpParser = do-    _ <- char '?'-    incOffset 1-    condPart <- manyExpr conditionalTrueParser-    parts <- manyP-             ( do-                truePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser-                                              , conditionalFalseParser-                                              ]-                falsePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser-                                               , conditionalTrueParser-                                               ]-                return ( truePart, falsePart )-             )-             conditionalEndParser--    let trueParts = map fst parts-        falseParts = map snd parts-        BuildResults n cond condParamOps = condPart--    let n' = maximum $ n : map outParamCount trueParts-        n'' = maximum $ n' : map outParamCount falseParts--    let trueOps = map outCapOps trueParts-        falseOps = map outCapOps falseParts-        condParts = zip trueOps falseOps--    let trueParamOps = mconcat $ map outParamOps trueParts-        falseParamOps = mconcat $ map outParamOps falseParts-        pOps = mconcat [condParamOps, trueParamOps, falseParamOps]--    return $ BuildResults n'' [ Conditional cond condParts ] pOps--    where-        manyP !p !end = choice-            [ try end >> return []-            , do !v <- p-                 !vs <- manyP p end-                 return $! v : vs-            ]-        manyExpr end = liftM mconcat $ manyP ( paramEscapeParser <|> bytesOpParser ) end--conditionalTrueParser :: CapParser ()-conditionalTrueParser = do-    _ <- string "%t"-    incOffset 2--conditionalFalseParser :: CapParser ()-conditionalFalseParser = do-    _ <- string "%e"-    incOffset 2--conditionalEndParser :: CapParser ()-conditionalEndParser = do-    _ <- string "%;"-    incOffset 2--bitwiseOpParser :: CapParser BuildResults-bitwiseOpParser-    =   bitwiseOrParser-    <|> bitwiseAndParser-    <|> bitwiseXorParser--bitwiseOrParser :: CapParser BuildResults-bitwiseOrParser = do-    _ <- char '|'-    incOffset 1-    return $ BuildResults 0 [ BitwiseOr ] [ ]--bitwiseAndParser :: CapParser BuildResults-bitwiseAndParser = do-    _ <- char '&'-    incOffset 1-    return $ BuildResults 0 [ BitwiseAnd ] [ ]--bitwiseXorParser :: CapParser BuildResults-bitwiseXorParser = do-    _ <- char '^'-    incOffset 1-    return $ BuildResults 0 [ BitwiseXOr ] [ ]--arithOpParser :: CapParser BuildResults-arithOpParser-    =   plusOp-    <|> minusOp-    where-        plusOp = do-            _ <- char '+'-            incOffset 1-            return $ BuildResults 0 [ ArithPlus ] [ ]-        minusOp = do-            _ <- char '-'-            incOffset 1-            return $ BuildResults 0 [ ArithMinus ] [ ]--literalIntOpParser :: CapParser BuildResults-literalIntOpParser = do-    _ <- char '{'-    incOffset 1-    nStr <- many1 digit-    incOffset $ toEnum $ length nStr-    let n :: Word = read nStr-    _ <- char '}'-    incOffset 1-    return $ BuildResults 0 [ PushValue n ] [ ]--compareOpParser :: CapParser BuildResults-compareOpParser-    =   compareEqOp-    <|> compareLtOp-    <|> compareGtOp-    where-        compareEqOp = do-            _ <- char '='-            incOffset 1-            return $ BuildResults 0 [ CompareEq ] [ ]-        compareLtOp = do-            _ <- char '<'-            incOffset 1-            return $ BuildResults 0 [ CompareLt ] [ ]-        compareGtOp = do-            _ <- char '>'-            incOffset 1-            return $ BuildResults 0 [ CompareGt ] [ ]--bytesOpParser :: CapParser BuildResults-bytesOpParser = do-    bytes <- many1 $ satisfy (/= '%')-    startOffset <- getState >>= return . nextOffset-    let !c = length bytes-    !s <- getState-    let s' = s { nextOffset = startOffset + c }-    setState s'-    return $ BuildResults 0 [Bytes startOffset c] []--charConstParser :: CapParser BuildResults-charConstParser = do-    _ <- char '\''-    charValue <- liftM (toEnum . fromEnum) anyChar-    _ <- char '\''-    incOffset 3-    return $ BuildResults 0 [ PushValue charValue ] [ ]--data BuildState = BuildState-    { nextOffset :: Int-    }--incOffset :: Int -> CapParser ()-incOffset n = do-    s <- getState-    let s' = s { nextOffset = nextOffset s + n }-    setState s'--initialBuildState :: BuildState-initialBuildState = BuildState 0--data BuildResults = BuildResults-    { outParamCount :: !Int-    , outCapOps :: !CapOps-    , outParamOps :: !ParamOps-    }--instance Monoid BuildResults where-    mempty = BuildResults 0 [] []-    v0 `mappend` v1-        = BuildResults-        { outParamCount = (outParamCount v0) `max` (outParamCount v1)-        , outCapOps = (outCapOps v0) `mappend` (outCapOps v1)-        , outParamOps = (outParamOps v0) `mappend` (outParamOps v1)-        }
src/Graphics/Text/Width.hs view
@@ -1,27 +1,48 @@ -- Copyright 2009 Corey O'Connor {-# OPTIONS_GHC -D_XOPEN_SOURCE #-} {-# LANGUAGE ForeignFunctionInterface #-}+-- | This module provides functions to measure the terminal column width+-- of characters and strings.+--+-- The functions provided in this module all ultimately make calls to+-- the C implementation in @cbits/mk_wcwidth.c@. That code manages some+-- global state that carries a table of Unicode character widths. For+-- more details, see 'Graphics.Vty.UnicodeWidthTable.Install', the C+-- code, and the "Multi-Column Character Support" section of the project+-- @README@. module Graphics.Text.Width   ( wcwidth   , wcswidth+  , wctwidth+  , wctlwidth   , safeWcwidth   , safeWcswidth+  , safeWctwidth+  , safeWctlwidth   ) where +import Data.List (foldl')+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+ foreign import ccall unsafe "vty_mk_wcwidth" wcwidth :: Char -> Int  wcswidth :: String -> Int-wcswidth = sum . map wcwidth+wcswidth = foldl' (\l c -> wcwidth c + l) 0+{-# INLINE [1] wcswidth #-} --- XXX: Characters with unknown widths occupy 1 column?------ Not sure if this is actually correct. I presume there is a--- replacement character that is output by the terminal instead of the--- character and this replacement character is 1 column wide. If this is--- not true for all terminals then a per-terminal replacement character--- width needs to be implemented.+wctwidth :: T.Text -> Int+wctwidth = T.foldl' (\l c -> wcwidth c + l) 0 +wctlwidth :: TL.Text -> Int+wctlwidth = TL.foldl' (\l c -> wcwidth c + l) 0++{-# RULES+"wcswidth/unpack" forall x. wcswidth (T.unpack x) = wctwidth x+"wcswidth/lazy-unpack" forall x. wcswidth (TL.unpack x) = wctlwidth x+  #-}+ -- | Returns the display width of a character. Assumes all characters -- with unknown widths are 0 width. safeWcwidth :: Char -> Int@@ -30,4 +51,14 @@ -- | Returns the display width of a string. Assumes all characters with -- unknown widths are 0 width. safeWcswidth :: String -> Int-safeWcswidth = sum . map safeWcwidth+safeWcswidth = foldl' (\l c -> safeWcwidth c + l) 0++-- | Returns the display width of a text. Assumes all characters with+-- unknown widths are 0 width.+safeWctwidth :: T.Text -> Int+safeWctwidth = T.foldl' (\l c -> safeWcwidth c + l) 0++-- | Returns the display width of a lazy text. Assumes all characters+-- with unknown widths are 0 width.+safeWctlwidth :: TL.Text -> Int+safeWctlwidth = TL.foldl' (\l c -> safeWcwidth c + l) 0
src/Graphics/Vty.hs view
@@ -1,38 +1,51 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | Vty provides interfaces for both terminal input and terminal -- output. ----- - Input to the terminal is provided to the Vty application as a+-- - User input to the terminal is provided to the Vty application as a --   sequence of 'Event's. ----- - Output is provided to Vty by the application in the form of a+-- - Output is provided to by the application to Vty in the form of a --   'Picture'. A 'Picture' is one or more layers of 'Image's. --   'Image' values can be built by the various constructors in --   "Graphics.Vty.Image". Output can be syled using 'Attr' (attribute) --   values in the "Graphics.Vty.Attributes" module. ----- @---  import "Graphics.Vty"+-- - Each platform on which Vty is supported provides a package that+--   provides Vty with access to the platform-specific terminal+--   interface. For example, on Unix systems, the @vty-unix@ package+--   must be used to initialize Vty with access to a Unix terminal. -----  main = do---      cfg <- 'standardIOConfig'---      vty <- 'mkVty' cfg---      let line0 = 'string' ('defAttr' ` 'withForeColor' ` 'green') \"first line\"---          line1 = 'string' ('defAttr' ` 'withBackColor' ` 'blue') \"second line\"---          img = line0 '<->' line1---          pic = 'picForImage' img---      'update' vty pic---      e <- 'nextEvent' vty---      'shutdown' vty---      'print' (\"Last event was: \" '++' 'show' e)--- @+-- As a small example, the following program demonstrates the use of Vty+-- on a Unix system using the @vty-unix@ package:+--+-- > import Graphics.Vty+-- > import Graphics.Vty.Platform.Unix (mkVty)+-- >+-- > main = do+-- >     vty <- mkVty defaultConfig+-- >     let line0 = string (defAttr `withForeColor` green) "first line"+-- >         line1 = string (defAttr `withBackColor` blue) "second line"+-- >         img = line0 <-> line1+-- >         pic = picForImage img+-- >     update vty pic+-- >     e <- nextEvent vty+-- >     shutdown vty+-- >     print ("Last event was: " ++ show e)+--+-- Vty uses threads internally, so programs made with Vty must be+-- compiled with the threaded runtime using the GHC @-threaded@ option. module Graphics.Vty   ( Vty(..)-  , mkVty-  , Mode(..)+  , setWindowTitle+  , installCustomWidthTable+  , mkVtyFromPair   , module Graphics.Vty.Config   , module Graphics.Vty.Input+  , module Graphics.Vty.Input.Events   , module Graphics.Vty.Output-  , module Graphics.Vty.Output.Interface   , module Graphics.Vty.Picture   , module Graphics.Vty.Image   , module Graphics.Vty.Attributes@@ -41,78 +54,140 @@  import Graphics.Vty.Config import Graphics.Vty.Input+import Graphics.Vty.Input.Events import Graphics.Vty.Output-import Graphics.Vty.Output.Interface import Graphics.Vty.Picture import Graphics.Vty.Image import Graphics.Vty.Attributes+import Graphics.Vty.UnicodeWidthTable.IO+import Graphics.Vty.UnicodeWidthTable.Install +import qualified Control.Exception as E+import Control.Monad (when) import Control.Concurrent.STM  import Data.IORef-import Data.Monoid+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif --- | A Vty value represents a handle to the Vty library that the+-- | A 'Vty' value represents a handle to the Vty library that the -- application must create in order to use Vty. ----- The use of Vty typically follows this process:+-- The use of this library typically follows this process: -----    1. Initialize vty+-- 1. Initialize Vty with the 'mkVty' implementation for your+-- platform's Vty package (e.g. @vty-unix@), or, more generically, with+-- 'mkVtyFromPair'. This takes control of (and sets up) the terminal. -----    2. Use 'update' to display a picture.+-- 2. Use 'update' to display a picture. -----    3. Use 'nextEvent' to get the next input event.+-- 3. Use 'nextEvent' to get the next input event. -----    4. Depending on the event, go to 2 or 5.+-- 4. Depending on the event, go to 2 or 5. -----    5. Shutdown vty.+-- 5. Shutdown Vty and restore the terminal state with 'shutdown'. At+-- this point the 'Vty' handle cannot be used again. -- -- Operations on Vty handles are not thread-safe.-data Vty = Vty-    { -- | Outputs the given 'Picture'.-      update :: Picture -> IO ()-      -- | Get one 'Event' object, blocking if none are available. This-      -- will refresh the terminal if the event is a 'EvResize'.-    , nextEvent :: IO Event-      -- | The input interface. See 'Input'.-    , inputIface :: Input-      -- | The output interface. See 'Output'.-    , outputIface :: Output-      -- | Refresh the display. 'nextEvent' will refresh the display if-      -- a resize occurs, but this can be used to refresh the display-      -- explicitly. If other programs output to the terminal and mess-      -- up the display then the application might want to force a-      -- refresh using this function.-    , refresh :: IO ()-      -- | Clean up after vty. A call to this function is necessary to-      -- cleanly restore the terminal state before application exit. The-      -- above methods will throw an exception if executed after this is-      -- executed.-    , shutdown :: IO ()-    }+data Vty =+    Vty { update :: Picture -> IO ()+        -- ^ Output the given 'Picture' to the terminal.+        , nextEvent :: IO Event+        -- ^ Return the next 'Event' or block until one becomes+        -- available.+        , nextEventNonblocking :: IO (Maybe Event)+        -- ^ Non-blocking version of 'nextEvent'.+        , inputIface :: Input+        -- ^ The input interface. See 'Input'.+        , outputIface :: Output+        -- ^ The output interface. See 'Output'.+        , refresh :: IO ()+        -- ^ Refresh the display. If other programs output to the+        -- terminal and mess up the display then the application might+        -- want to force a refresh using this function.+        , shutdown :: IO ()+        -- ^ Clean up after vty. A call to this function is necessary to+        -- cleanly restore the terminal state before application exit.+        -- The above methods will throw an exception if executed after+        -- this is executed. Idempotent.+        , isShutdown :: IO Bool+        } --- | Create a Vty handle. At most one handle should be created at a time--- for a given terminal device.------ The specified configuration is added to the the configuration--- loaded by 'userConfig' with the 'userConfig' configuration taking--- precedence. See "Graphics.Vty.Config".+-- | Attempt to load and install a custom character width table into+-- this process. ----- For most applications @mkVty defaultConfig@ is sufficient.-mkVty :: Config -> IO Vty-mkVty appConfig = do-    config <- (<> appConfig) <$> userConfig-    input  <- inputForConfig config-    out    <- outputForConfig config-    intMkVty input out+-- This looks up the specified terminal name in the specified width+-- table map and, if a map file path is found, the map is loaded and+-- installed. This is exposed for Vty platform package implementors;+-- application developers should never need to call this.+installCustomWidthTable :: Maybe FilePath+                        -- ^ Optional path to a log file where log+                        -- messages should be written when attempting to+                        -- load a width table.+                        -> Maybe String+                        -- ^ Optional width table entry name (usually+                        -- the terminal name, e.g. value of @TERM@ on+                        -- Unix systems). If omitted, this function does+                        -- not attempt to load a table.+                        -> [(String, FilePath)]+                        -- ^ Mapping from width table entry names to+                        -- width table file paths. This is usually+                        -- obtained from 'configTermWidthMaps' of+                        -- 'VtyUserConfig'.+                        -> IO ()+installCustomWidthTable logPath tblName widthMaps = do+    let doLog s = case logPath of+                      Nothing -> return ()+                      Just path -> appendFile path $ "installWidthTable: " <> s <> "\n" -intMkVty :: Input -> Output -> IO Vty-intMkVty input out = do+    customInstalled <- isCustomTableReady+    when (not customInstalled) $ do+        case tblName of+            Nothing ->+                doLog "No terminal name given in the configuration, skipping load"+            Just name ->+                case lookup name widthMaps of+                    Nothing ->+                        doLog $ "Width table " <> show name <> " not found in custom character width mapping list"+                    Just path -> do+                        tableResult <- E.try $ readUnicodeWidthTable path+                        case tableResult of+                            Left (e::E.SomeException) ->+                                doLog $ "Error reading custom character width table " <>+                                        "at " <> show path <> ": " <> show e+                            Right (Left msg) ->+                                doLog $ "Error reading custom character width table " <>+                                        "at " <> show path <> ": " <> msg+                            Right (Right table) -> do+                                installResult <- E.try $ installUnicodeWidthTable table+                                case installResult of+                                    Left (e::E.SomeException) ->+                                        doLog $ "Error installing unicode table (" <>+                                                show path <> ": " <> show e+                                    Right () ->+                                        doLog $ "Successfully installed Unicode width table " <>+                                                " from " <> show path++-- | Build a 'Vty' handle from an input/output pair.+--+-- This is exposed for Vty platform package implementors; application+-- developers should never need to call this, and should instead call+-- @mkVty@ or equivalent from their platform package of choice.+mkVtyFromPair :: Input -> Output -> IO Vty+mkVtyFromPair input out = do     reserveDisplay out++    shutdownVar <- newTVarIO False     let shutdownIo = do-            shutdownInput input-            releaseDisplay out-            releaseTerminal out+            alreadyShutdown <- atomically $ swapTVar shutdownVar True+            when (not alreadyShutdown) $ do+                shutdownInput input+                releaseDisplay out+                releaseTerminal out++        shutdownStatus = readTVarIO shutdownVar+     lastPicRef <- newIORef Nothing     lastUpdateRef <- newIORef Nothing @@ -136,7 +211,7 @@             writeIORef lastUpdateRef $ Just updateData             writeIORef lastPicRef $ Just inPic -    let innerRefresh = do+        innerRefresh = do             writeIORef lastUpdateRef Nothing             bounds <- displayBounds out             dc <- displayContext out bounds@@ -144,16 +219,31 @@             mPic <- readIORef lastPicRef             maybe (return ()) innerUpdate mPic -    let gkey = do k <- atomically $ readTChan $ _eventChannel input-                  case k of-                    (EvResize _ _)  -> displayBounds out-                                       >>= return . (\(w,h)-> EvResize w h)-                    _               -> return k+        mkResize = uncurry EvResize <$> displayBounds out +        translateInternalEvent ResumeAfterInterrupt = mkResize+        translateInternalEvent (InputEvent e) = return e++        gkey = do+            e <- atomically $ readTChan $ eventChannel input+            translateInternalEvent e+        gkey' = do+            mEv <- atomically $ tryReadTChan $ eventChannel input+            case mEv of+                Just e  -> Just <$> translateInternalEvent e+                Nothing -> return Nothing+     return $ Vty { update = innerUpdate                  , nextEvent = gkey+                 , nextEventNonblocking = gkey'                  , inputIface = input                  , outputIface = out                  , refresh = innerRefresh                  , shutdown = shutdownIo+                 , isShutdown = shutdownStatus                  }++-- | Set the terminal window title string.+setWindowTitle :: Vty -> String -> IO ()+setWindowTitle vty title =+    setOutputWindowTitle (outputIface vty) title
src/Graphics/Vty/Attributes.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}  -- | Display attributes --@@ -10,14 +10,14 @@ -- 'withForeColor', 'withBackColor', and 'withStyle', e.g., -- -- @---     defAttr `withForeColor` red+--     defAttr \`withForeColor\` red -- @ -- -- 'Image' constructors often require an 'Attr' to indicate the -- attributes used in the image, e.g., -- -- @---     string (defAttr `withForeColor` red) "this text will be red"+--     string (defAttr \`withForeColor\` red) "this text will be red" -- @ -- -- The appearance of 'Image's using 'defAttr' is determined by the The@@ -27,7 +27,9 @@ -- The value 'currentAttr' will keep the attributes of whatever was -- output previously. module Graphics.Vty.Attributes-  ( Attr(..)+  ( module Graphics.Vty.Attributes.Color++  , Attr(..)   , FixedAttr(..)   , MaybeDefault(..)   , defAttr@@ -37,6 +39,8 @@   , Style   , withStyle   , standout+  , italic+  , strikethrough   , underline   , reverseVideo   , blink@@ -50,17 +54,18 @@   , withForeColor   , withBackColor -  -- * Colors-  , module Graphics.Vty.Attributes.Color-  , module Graphics.Vty.Attributes.Color240+  -- * Setting hyperlinks+  , withURL   ) where +import Control.DeepSeq import Data.Bits+import Data.Text (Text) import Data.Word+import GHC.Generics  import Graphics.Vty.Attributes.Color-import Graphics.Vty.Attributes.Color240  -- | A display attribute defines the Color and Style of all the -- characters rendered after the attribute is applied.@@ -73,7 +78,8 @@     { attrStyle :: !(MaybeDefault Style)     , attrForeColor :: !(MaybeDefault Color)     , attrBackColor :: !(MaybeDefault Color)-    } deriving ( Eq, Show, Read )+    , attrURL :: !(MaybeDefault Text)+    } deriving ( Eq, Show, Read, Generic, NFData )  -- This could be encoded into a single 32 bit word. The 32 bit word is -- first divided into 4 groups of 8 bits where: The first group codes@@ -94,25 +100,19 @@ --      __ - unused -- --  Next is the style flags---      SURBDO__+--      SURBDOI_ --      S - standout --      U - underline --      R - reverse video --      B - blink --      D - dim --      O - bold---      __ - unused+--      I - italic+--      _ - unused -- --  Then the foreground color encoded into 8 bits. --  Then the background color encoded into 8 bits. -instance Monoid Attr where-    mempty = Attr mempty mempty mempty-    mappend attr0 attr1 =-        Attr ( attrStyle attr0     `mappend` attrStyle attr1 )-             ( attrForeColor attr0 `mappend` attrForeColor attr1 )-             ( attrBackColor attr0 `mappend` attrBackColor attr1 )- -- | Specifies the display attributes such that the final style and -- color values do not depend on the previously applied display -- attribute. The display attributes can still depend on the terminal's@@ -121,38 +121,26 @@     { fixedStyle :: !Style     , fixedForeColor :: !(Maybe Color)     , fixedBackColor :: !(Maybe Color)+    , fixedURL       :: !(Maybe Text)     } deriving ( Eq, Show )  -- | The style and color attributes can either be the terminal defaults. -- Or be equivalent to the previously applied style. Or be a specific -- value.-data MaybeDefault v where-    Default :: MaybeDefault v-    KeepCurrent :: MaybeDefault v-    SetTo :: forall v . ( Eq v, Show v, Read v ) => !v -> MaybeDefault v--deriving instance Eq v => Eq (MaybeDefault v)-deriving instance Eq v => Show (MaybeDefault v)-deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)+data MaybeDefault v = Default | KeepCurrent | SetTo !v+  deriving (Eq, Read, Show) -instance Eq v => Monoid ( MaybeDefault v ) where-    mempty = KeepCurrent-    mappend Default Default = Default-    mappend Default KeepCurrent = Default-    mappend Default ( SetTo v ) = SetTo v-    mappend KeepCurrent Default = Default-    mappend KeepCurrent KeepCurrent = KeepCurrent-    mappend KeepCurrent ( SetTo v ) = SetTo v-    mappend ( SetTo _v ) Default = Default-    mappend ( SetTo v ) KeepCurrent = SetTo v-    mappend ( SetTo _ ) ( SetTo v ) = SetTo v+instance (NFData v) => NFData (MaybeDefault v) where+    rnf Default = ()+    rnf KeepCurrent = ()+    rnf (SetTo v) = rnf v  -- | Styles are represented as an 8 bit word. Each bit in the word is 1 -- if the style attribute assigned to that bit should be applied and 0 -- if the style attribute should not be applied. type Style = Word8 --- | The 6 possible style attributes:+-- | Valid style attributes include: -- --      * standout --@@ -166,15 +154,21 @@ -- --      * bold/bright --+--      * italic+--+--      * strikethrough (via the smxx/rmxx terminfo capabilities)+-- --  (The invisible, protect, and altcharset display attributes some --  terminals support are not supported via VTY.)-standout, underline, reverseVideo, blink, dim, bold :: Style+standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style standout        = 0x01 underline       = 0x02-reverseVideo   = 0x04+reverseVideo    = 0x04 blink           = 0x08 dim             = 0x10 bold            = 0x20+italic          = 0x40+strikethrough   = 0x80  defaultStyleMask :: Style defaultStyleMask = 0x00@@ -200,13 +194,28 @@  -- | Add the given style attribute withStyle :: Attr -> Style -> Attr+withStyle attr 0 = attr withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag } +-- | Add a hyperlinked URL using the proposed [escape sequences for+-- hyperlinked+-- URLs](https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).+-- These escape sequences are comparatively new and aren't widely+-- supported in terminal emulators yet, but most terminal emulators+-- that don't know about these sequences will ignore these sequences,+-- and therefore this should fall back sensibly. In some cases they+-- won't and this will result in garbage, so this is why hyperlinking is+-- disabled by default, in which case this combinator has no observable+-- effect. To enable it, enable 'Hyperlink' mode on your Vty output+-- interface.+withURL :: Attr -> Text -> Attr+withURL attr url = attr { attrURL = SetTo url }+ -- | Sets the style, background color and foreground color to the -- default values for the terminal. There is no easy way to determine -- what the default background and foreground colors are. defAttr :: Attr-defAttr = Attr Default Default Default+defAttr = Attr Default Default Default Default  -- | Keeps the style, background color and foreground color that was -- previously set. Used to override some part of the previous style.@@ -216,4 +225,4 @@ -- Would be the currently applied style (be it underline, bold, etc) but -- with the foreground color set to brightMagenta. currentAttr :: Attr-currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent+currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent
src/Graphics/Vty/Attributes/Color.hs view
@@ -1,5 +1,21 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Graphics.Vty.Attributes.Color   ( Color(..)+  , ColorMode(..)++  -- ** Fixed Colors+  -- | Standard 8-color ANSI terminal color codes.+  --+  -- Note that these map to colors in the terminal's custom palette. For+  -- instance, `white` maps to whatever the terminal color theme uses for+  -- white.+  --+  -- Use these functions if you want to make apps that fit the terminal theme.+  -- If you want access to more/stronger colors use `rgbColor`   , black   , red   , green@@ -8,6 +24,8 @@   , magenta   , cyan   , white++  -- | Bright/Vivid variants of the standard 8-color ANSI   , brightBlack   , brightRed   , brightGreen@@ -16,11 +34,21 @@   , brightMagenta   , brightCyan   , brightWhite+  -- ** Creating Colors From RGB+  , linearColor+  , srgbColor+  , rgbColor+  , color240+  , module Graphics.Vty.Attributes.Color240   ) where  import Data.Word+import GHC.Generics+import Control.DeepSeq +import Graphics.Vty.Attributes.Color240+ -- | Abstract data type representing a color. -- -- Currently the foreground and background color are specified as points@@ -36,21 +64,21 @@ -- -- The 8 ISO 6429 (ANSI) colors are as follows: -----      0. black+--      * black (0) -----      1. red+--      * red (1) -----      2. green+--      * green (2) -----      3. yellow+--      * yellow (3) -----      4. blue+--      * blue (4) -----      5. magenta+--      * magenta (5) -----      6. cyan+--      * cyan (6) -----      7. white+--      * white (7) -- -- The mapping from points in the 240 color palette to colors actually -- displayable by the terminal depends on the number of colors the@@ -59,7 +87,7 @@ -- reported then the color reproduction will be incorrect. -- -- If the terminal reports <= 16 colors then the 240 color palette--- points are only mapped to the 8 color pallete. I'm not sure of+-- points are only mapped to the 8 color palette. I'm not sure of -- the RGB points for the "bright" colors which is why they are not -- addressable via the 240 color palette. --@@ -73,10 +101,17 @@ -- terminfo but I don't know it. -- -- Seriously, terminal color support is INSANE.-data Color = ISOColor !Word8 | Color240 !Word8+data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8+    deriving ( Eq, Show, Read, Generic, NFData )++data ColorMode+    = NoColor+    | ColorMode8+    | ColorMode16+    | ColorMode240 !Word8+    | FullColor     deriving ( Eq, Show, Read ) --- | Standard 8-color ANSI terminal color codes. black, red, green, yellow, blue, magenta, cyan, white :: Color black  = ISOColor 0 red    = ISOColor 1@@ -87,7 +122,6 @@ cyan   = ISOColor 6 white  = ISOColor 7 --- | Bright/Vivid variants of the standard 8-color ANSI brightBlack, brightRed, brightGreen, brightYellow :: Color brightBlue, brightMagenta, brightCyan, brightWhite :: Color brightBlack  = ISOColor 8@@ -98,3 +132,42 @@ brightMagenta= ISOColor 13 brightCyan   = ISOColor 14 brightWhite  = ISOColor 15++-- | Create a color value from RGB values in the 0..255 range inclusive.+-- No transformation of the input values is done; a color is created+-- directly from the RGB values specified, unlike the 'srgbColor' and+-- 'color240' functions.+linearColor :: Integral i => i -> i -> i -> Color+linearColor r g b = RGBColor r' g' b'+    where+        r' = fromIntegral (clamp r) :: Word8+        g' = fromIntegral (clamp g) :: Word8+        b' = fromIntegral (clamp b) :: Word8+        clamp = min 255 . max 0++-- | Given RGB values in the range 0..255 inclusive, create a color+-- using the sRGB transformation described at+--+-- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation+srgbColor :: Integral i => i -> i -> i -> Color+srgbColor r g b =+    -- TODO: it may be worth translating this to a lookup table, as with color240+    let shrink n = fromIntegral n / 255 :: Double+        -- called gamma^-1 in wiki+        gamma u+            | u <= 0.04045 = u/12.92+            | otherwise    = ((u + 0.055) / 1.055) ** 2.4+        -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly?+        expand n = round (255 * n)+        convert = expand . gamma . shrink+     in RGBColor (convert r) (convert g) (convert b)++color240 :: Integral i => i -> i -> i -> Color+color240 r g b = Color240 (rgbColorToColor240 r g b)++-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.+-- This is a synonym for 'color240'. This function is lossy in the sense+-- that we only internally support 240 colors but the #RRGGBB format+-- supports 256^3 colors.+rgbColor :: Integral i => i -> i -> i -> Color+rgbColor = color240
src/Graphics/Vty/Attributes/Color240.hs view
@@ -1,261 +1,301 @@ -- This header file was generated by ./256colres.pl module Graphics.Vty.Attributes.Color240-  ( rgbColor+  ( rgbColorToColor240+  , color240CodeToRGB   ) where -import Graphics.Vty.Attributes.Color-+import Data.Word (Word8) import Text.Printf  -- Note: rgbColor's mapping from RGB to 240 colors was generated from -- 256colres.pl which is forked from xterm 256colres.pl. --- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.-rgbColor :: Integral i => i -> i -> i -> Color-rgbColor r g b+-- | Create a value in the Color240 set from an RGB triple. This maps+-- the input arguments to an entry in the 240-color palette depicted at:+--+-- https://rich.readthedocs.io/en/stable/appendix/colors.html+rgbColorToColor240 :: Integral i => i -> i -> i -> Word8+rgbColorToColor240 r g b     | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"-    | r == 8 && g == 8 && b == 8 = Color240 216-    | r == 18 && g == 18 && b == 18 = Color240 217-    | r == 28 && g == 28 && b == 28 = Color240 218-    | r == 38 && g == 38 && b == 38 = Color240 219-    | r == 48 && g == 48 && b == 48 = Color240 220-    | r == 58 && g == 58 && b == 58 = Color240 221-    | r == 68 && g == 68 && b == 68 = Color240 222-    | r == 78 && g == 78 && b == 78 = Color240 223-    | r == 88 && g == 88 && b == 88 = Color240 224-    | r == 98 && g == 98 && b == 98 = Color240 225-    | r == 108 && g == 108 && b == 108 = Color240 226-    | r == 118 && g == 118 && b == 118 = Color240 227-    | r == 128 && g == 128 && b == 128 = Color240 228-    | r == 138 && g == 138 && b == 138 = Color240 229-    | r == 148 && g == 148 && b == 148 = Color240 230-    | r == 158 && g == 158 && b == 158 = Color240 231-    | r == 168 && g == 168 && b == 168 = Color240 232-    | r == 178 && g == 178 && b == 178 = Color240 233-    | r == 188 && g == 188 && b == 188 = Color240 234-    | r == 198 && g == 198 && b == 198 = Color240 235-    | r == 208 && g == 208 && b == 208 = Color240 236-    | r == 218 && g == 218 && b == 218 = Color240 237-    | r == 228 && g == 228 && b == 228 = Color240 238-    | r == 238 && g == 238 && b == 238 = Color240 239-    | r <= 0 && g <= 0 && b <= 0 = Color240 0-    | r <= 0 && g <= 0 && b <= 95 = Color240 1-    | r <= 0 && g <= 0 && b <= 135 = Color240 2-    | r <= 0 && g <= 0 && b <= 175 = Color240 3-    | r <= 0 && g <= 0 && b <= 215 = Color240 4-    | r <= 0 && g <= 0 && b <= 255 = Color240 5-    | r <= 0 && g <= 95 && b <= 0 = Color240 6-    | r <= 0 && g <= 95 && b <= 95 = Color240 7-    | r <= 0 && g <= 95 && b <= 135 = Color240 8-    | r <= 0 && g <= 95 && b <= 175 = Color240 9-    | r <= 0 && g <= 95 && b <= 215 = Color240 10-    | r <= 0 && g <= 95 && b <= 255 = Color240 11-    | r <= 0 && g <= 135 && b <= 0 = Color240 12-    | r <= 0 && g <= 135 && b <= 95 = Color240 13-    | r <= 0 && g <= 135 && b <= 135 = Color240 14-    | r <= 0 && g <= 135 && b <= 175 = Color240 15-    | r <= 0 && g <= 135 && b <= 215 = Color240 16-    | r <= 0 && g <= 135 && b <= 255 = Color240 17-    | r <= 0 && g <= 175 && b <= 0 = Color240 18-    | r <= 0 && g <= 175 && b <= 95 = Color240 19-    | r <= 0 && g <= 175 && b <= 135 = Color240 20-    | r <= 0 && g <= 175 && b <= 175 = Color240 21-    | r <= 0 && g <= 175 && b <= 215 = Color240 22-    | r <= 0 && g <= 175 && b <= 255 = Color240 23-    | r <= 0 && g <= 215 && b <= 0 = Color240 24-    | r <= 0 && g <= 215 && b <= 95 = Color240 25-    | r <= 0 && g <= 215 && b <= 135 = Color240 26-    | r <= 0 && g <= 215 && b <= 175 = Color240 27-    | r <= 0 && g <= 215 && b <= 215 = Color240 28-    | r <= 0 && g <= 215 && b <= 255 = Color240 29-    | r <= 0 && g <= 255 && b <= 0 = Color240 30-    | r <= 0 && g <= 255 && b <= 95 = Color240 31-    | r <= 0 && g <= 255 && b <= 135 = Color240 32-    | r <= 0 && g <= 255 && b <= 175 = Color240 33-    | r <= 0 && g <= 255 && b <= 215 = Color240 34-    | r <= 0 && g <= 255 && b <= 255 = Color240 35-    | r <= 95 && g <= 0 && b <= 0 = Color240 36-    | r <= 95 && g <= 0 && b <= 95 = Color240 37-    | r <= 95 && g <= 0 && b <= 135 = Color240 38-    | r <= 95 && g <= 0 && b <= 175 = Color240 39-    | r <= 95 && g <= 0 && b <= 215 = Color240 40-    | r <= 95 && g <= 0 && b <= 255 = Color240 41-    | r <= 95 && g <= 95 && b <= 0 = Color240 42-    | r <= 95 && g <= 95 && b <= 95 = Color240 43-    | r <= 95 && g <= 95 && b <= 135 = Color240 44-    | r <= 95 && g <= 95 && b <= 175 = Color240 45-    | r <= 95 && g <= 95 && b <= 215 = Color240 46-    | r <= 95 && g <= 95 && b <= 255 = Color240 47-    | r <= 95 && g <= 135 && b <= 0 = Color240 48-    | r <= 95 && g <= 135 && b <= 95 = Color240 49-    | r <= 95 && g <= 135 && b <= 135 = Color240 50-    | r <= 95 && g <= 135 && b <= 175 = Color240 51-    | r <= 95 && g <= 135 && b <= 215 = Color240 52-    | r <= 95 && g <= 135 && b <= 255 = Color240 53-    | r <= 95 && g <= 175 && b <= 0 = Color240 54-    | r <= 95 && g <= 175 && b <= 95 = Color240 55-    | r <= 95 && g <= 175 && b <= 135 = Color240 56-    | r <= 95 && g <= 175 && b <= 175 = Color240 57-    | r <= 95 && g <= 175 && b <= 215 = Color240 58-    | r <= 95 && g <= 175 && b <= 255 = Color240 59-    | r <= 95 && g <= 215 && b <= 0 = Color240 60-    | r <= 95 && g <= 215 && b <= 95 = Color240 61-    | r <= 95 && g <= 215 && b <= 135 = Color240 62-    | r <= 95 && g <= 215 && b <= 175 = Color240 63-    | r <= 95 && g <= 215 && b <= 215 = Color240 64-    | r <= 95 && g <= 215 && b <= 255 = Color240 65-    | r <= 95 && g <= 255 && b <= 0 = Color240 66-    | r <= 95 && g <= 255 && b <= 95 = Color240 67-    | r <= 95 && g <= 255 && b <= 135 = Color240 68-    | r <= 95 && g <= 255 && b <= 175 = Color240 69-    | r <= 95 && g <= 255 && b <= 215 = Color240 70-    | r <= 95 && g <= 255 && b <= 255 = Color240 71-    | r <= 135 && g <= 0 && b <= 0 = Color240 72-    | r <= 135 && g <= 0 && b <= 95 = Color240 73-    | r <= 135 && g <= 0 && b <= 135 = Color240 74-    | r <= 135 && g <= 0 && b <= 175 = Color240 75-    | r <= 135 && g <= 0 && b <= 215 = Color240 76-    | r <= 135 && g <= 0 && b <= 255 = Color240 77-    | r <= 135 && g <= 95 && b <= 0 = Color240 78-    | r <= 135 && g <= 95 && b <= 95 = Color240 79-    | r <= 135 && g <= 95 && b <= 135 = Color240 80-    | r <= 135 && g <= 95 && b <= 175 = Color240 81-    | r <= 135 && g <= 95 && b <= 215 = Color240 82-    | r <= 135 && g <= 95 && b <= 255 = Color240 83-    | r <= 135 && g <= 135 && b <= 0 = Color240 84-    | r <= 135 && g <= 135 && b <= 95 = Color240 85-    | r <= 135 && g <= 135 && b <= 135 = Color240 86-    | r <= 135 && g <= 135 && b <= 175 = Color240 87-    | r <= 135 && g <= 135 && b <= 215 = Color240 88-    | r <= 135 && g <= 135 && b <= 255 = Color240 89-    | r <= 135 && g <= 175 && b <= 0 = Color240 90-    | r <= 135 && g <= 175 && b <= 95 = Color240 91-    | r <= 135 && g <= 175 && b <= 135 = Color240 92-    | r <= 135 && g <= 175 && b <= 175 = Color240 93-    | r <= 135 && g <= 175 && b <= 215 = Color240 94-    | r <= 135 && g <= 175 && b <= 255 = Color240 95-    | r <= 135 && g <= 215 && b <= 0 = Color240 96-    | r <= 135 && g <= 215 && b <= 95 = Color240 97-    | r <= 135 && g <= 215 && b <= 135 = Color240 98-    | r <= 135 && g <= 215 && b <= 175 = Color240 99-    | r <= 135 && g <= 215 && b <= 215 = Color240 100-    | r <= 135 && g <= 215 && b <= 255 = Color240 101-    | r <= 135 && g <= 255 && b <= 0 = Color240 102-    | r <= 135 && g <= 255 && b <= 95 = Color240 103-    | r <= 135 && g <= 255 && b <= 135 = Color240 104-    | r <= 135 && g <= 255 && b <= 175 = Color240 105-    | r <= 135 && g <= 255 && b <= 215 = Color240 106-    | r <= 135 && g <= 255 && b <= 255 = Color240 107-    | r <= 175 && g <= 0 && b <= 0 = Color240 108-    | r <= 175 && g <= 0 && b <= 95 = Color240 109-    | r <= 175 && g <= 0 && b <= 135 = Color240 110-    | r <= 175 && g <= 0 && b <= 175 = Color240 111-    | r <= 175 && g <= 0 && b <= 215 = Color240 112-    | r <= 175 && g <= 0 && b <= 255 = Color240 113-    | r <= 175 && g <= 95 && b <= 0 = Color240 114-    | r <= 175 && g <= 95 && b <= 95 = Color240 115-    | r <= 175 && g <= 95 && b <= 135 = Color240 116-    | r <= 175 && g <= 95 && b <= 175 = Color240 117-    | r <= 175 && g <= 95 && b <= 215 = Color240 118-    | r <= 175 && g <= 95 && b <= 255 = Color240 119-    | r <= 175 && g <= 135 && b <= 0 = Color240 120-    | r <= 175 && g <= 135 && b <= 95 = Color240 121-    | r <= 175 && g <= 135 && b <= 135 = Color240 122-    | r <= 175 && g <= 135 && b <= 175 = Color240 123-    | r <= 175 && g <= 135 && b <= 215 = Color240 124-    | r <= 175 && g <= 135 && b <= 255 = Color240 125-    | r <= 175 && g <= 175 && b <= 0 = Color240 126-    | r <= 175 && g <= 175 && b <= 95 = Color240 127-    | r <= 175 && g <= 175 && b <= 135 = Color240 128-    | r <= 175 && g <= 175 && b <= 175 = Color240 129-    | r <= 175 && g <= 175 && b <= 215 = Color240 130-    | r <= 175 && g <= 175 && b <= 255 = Color240 131-    | r <= 175 && g <= 215 && b <= 0 = Color240 132-    | r <= 175 && g <= 215 && b <= 95 = Color240 133-    | r <= 175 && g <= 215 && b <= 135 = Color240 134-    | r <= 175 && g <= 215 && b <= 175 = Color240 135-    | r <= 175 && g <= 215 && b <= 215 = Color240 136-    | r <= 175 && g <= 215 && b <= 255 = Color240 137-    | r <= 175 && g <= 255 && b <= 0 = Color240 138-    | r <= 175 && g <= 255 && b <= 95 = Color240 139-    | r <= 175 && g <= 255 && b <= 135 = Color240 140-    | r <= 175 && g <= 255 && b <= 175 = Color240 141-    | r <= 175 && g <= 255 && b <= 215 = Color240 142-    | r <= 175 && g <= 255 && b <= 255 = Color240 143-    | r <= 215 && g <= 0 && b <= 0 = Color240 144-    | r <= 215 && g <= 0 && b <= 95 = Color240 145-    | r <= 215 && g <= 0 && b <= 135 = Color240 146-    | r <= 215 && g <= 0 && b <= 175 = Color240 147-    | r <= 215 && g <= 0 && b <= 215 = Color240 148-    | r <= 215 && g <= 0 && b <= 255 = Color240 149-    | r <= 215 && g <= 95 && b <= 0 = Color240 150-    | r <= 215 && g <= 95 && b <= 95 = Color240 151-    | r <= 215 && g <= 95 && b <= 135 = Color240 152-    | r <= 215 && g <= 95 && b <= 175 = Color240 153-    | r <= 215 && g <= 95 && b <= 215 = Color240 154-    | r <= 215 && g <= 95 && b <= 255 = Color240 155-    | r <= 215 && g <= 135 && b <= 0 = Color240 156-    | r <= 215 && g <= 135 && b <= 95 = Color240 157-    | r <= 215 && g <= 135 && b <= 135 = Color240 158-    | r <= 215 && g <= 135 && b <= 175 = Color240 159-    | r <= 215 && g <= 135 && b <= 215 = Color240 160-    | r <= 215 && g <= 135 && b <= 255 = Color240 161-    | r <= 215 && g <= 175 && b <= 0 = Color240 162-    | r <= 215 && g <= 175 && b <= 95 = Color240 163-    | r <= 215 && g <= 175 && b <= 135 = Color240 164-    | r <= 215 && g <= 175 && b <= 175 = Color240 165-    | r <= 215 && g <= 175 && b <= 215 = Color240 166-    | r <= 215 && g <= 175 && b <= 255 = Color240 167-    | r <= 215 && g <= 215 && b <= 0 = Color240 168-    | r <= 215 && g <= 215 && b <= 95 = Color240 169-    | r <= 215 && g <= 215 && b <= 135 = Color240 170-    | r <= 215 && g <= 215 && b <= 175 = Color240 171-    | r <= 215 && g <= 215 && b <= 215 = Color240 172-    | r <= 215 && g <= 215 && b <= 255 = Color240 173-    | r <= 215 && g <= 255 && b <= 0 = Color240 174-    | r <= 215 && g <= 255 && b <= 95 = Color240 175-    | r <= 215 && g <= 255 && b <= 135 = Color240 176-    | r <= 215 && g <= 255 && b <= 175 = Color240 177-    | r <= 215 && g <= 255 && b <= 215 = Color240 178-    | r <= 215 && g <= 255 && b <= 255 = Color240 179-    | r <= 255 && g <= 0 && b <= 0 = Color240 180-    | r <= 255 && g <= 0 && b <= 95 = Color240 181-    | r <= 255 && g <= 0 && b <= 135 = Color240 182-    | r <= 255 && g <= 0 && b <= 175 = Color240 183-    | r <= 255 && g <= 0 && b <= 215 = Color240 184-    | r <= 255 && g <= 0 && b <= 255 = Color240 185-    | r <= 255 && g <= 95 && b <= 0 = Color240 186-    | r <= 255 && g <= 95 && b <= 95 = Color240 187-    | r <= 255 && g <= 95 && b <= 135 = Color240 188-    | r <= 255 && g <= 95 && b <= 175 = Color240 189-    | r <= 255 && g <= 95 && b <= 215 = Color240 190-    | r <= 255 && g <= 95 && b <= 255 = Color240 191-    | r <= 255 && g <= 135 && b <= 0 = Color240 192-    | r <= 255 && g <= 135 && b <= 95 = Color240 193-    | r <= 255 && g <= 135 && b <= 135 = Color240 194-    | r <= 255 && g <= 135 && b <= 175 = Color240 195-    | r <= 255 && g <= 135 && b <= 215 = Color240 196-    | r <= 255 && g <= 135 && b <= 255 = Color240 197-    | r <= 255 && g <= 175 && b <= 0 = Color240 198-    | r <= 255 && g <= 175 && b <= 95 = Color240 199-    | r <= 255 && g <= 175 && b <= 135 = Color240 200-    | r <= 255 && g <= 175 && b <= 175 = Color240 201-    | r <= 255 && g <= 175 && b <= 215 = Color240 202-    | r <= 255 && g <= 175 && b <= 255 = Color240 203-    | r <= 255 && g <= 215 && b <= 0 = Color240 204-    | r <= 255 && g <= 215 && b <= 95 = Color240 205-    | r <= 255 && g <= 215 && b <= 135 = Color240 206-    | r <= 255 && g <= 215 && b <= 175 = Color240 207-    | r <= 255 && g <= 215 && b <= 215 = Color240 208-    | r <= 255 && g <= 215 && b <= 255 = Color240 209-    | r <= 255 && g <= 255 && b <= 0 = Color240 210-    | r <= 255 && g <= 255 && b <= 95 = Color240 211-    | r <= 255 && g <= 255 && b <= 135 = Color240 212-    | r <= 255 && g <= 255 && b <= 175 = Color240 213-    | r <= 255 && g <= 255 && b <= 215 = Color240 214-    | r <= 255 && g <= 255 && b <= 255 = Color240 215-    | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."+    | r == 8 && g == 8 && b == 8 = 216+    | r == 18 && g == 18 && b == 18 = 217+    | r == 28 && g == 28 && b == 28 = 218+    | r == 38 && g == 38 && b == 38 = 219+    | r == 48 && g == 48 && b == 48 = 220+    | r == 58 && g == 58 && b == 58 = 221+    | r == 68 && g == 68 && b == 68 = 222+    | r == 78 && g == 78 && b == 78 = 223+    | r == 88 && g == 88 && b == 88 = 224+    | r == 98 && g == 98 && b == 98 = 225+    | r == 108 && g == 108 && b == 108 = 226+    | r == 118 && g == 118 && b == 118 = 227+    | r == 128 && g == 128 && b == 128 = 228+    | r == 138 && g == 138 && b == 138 = 229+    | r == 148 && g == 148 && b == 148 = 230+    | r == 158 && g == 158 && b == 158 = 231+    | r == 168 && g == 168 && b == 168 = 232+    | r == 178 && g == 178 && b == 178 = 233+    | r == 188 && g == 188 && b == 188 = 234+    | r == 198 && g == 198 && b == 198 = 235+    | r == 208 && g == 208 && b == 208 = 236+    | r == 218 && g == 218 && b == 218 = 237+    | r == 228 && g == 228 && b == 228 = 238+    | r == 238 && g == 238 && b == 238 = 239+    | otherwise = 36 * go r + 6 * go g + go b+    where go = simpleColor_ (error (printf "RGB color %d %d %d does not map to 240 palette."                                 (fromIntegral r :: Int)                                 (fromIntegral g :: Int)-                                (fromIntegral b :: Int))+                                (fromIntegral b :: Int)))++simpleColor_ :: Integral i => Word8 -> i -> Word8+simpleColor_ e c+    | c <= 0 = 0+    | c <= 95 = 1+    | c <= 255 = fromIntegral ((c-16) `div` 40)+    | otherwise = e++-- | Create a RGB triple from a value in the Color240 set.+color240CodeToRGB :: Word8 -> Maybe (Int, Int, Int)+color240CodeToRGB n = case n of+    0 -> Just (0, 0, 0)+    1 -> Just (0, 0, 95)+    2 -> Just (0, 0, 135)+    3 -> Just (0, 0, 175)+    4 -> Just (0, 0, 215)+    5 -> Just (0, 0, 255)+    6 -> Just (0, 95, 0)+    7 -> Just (0, 95, 95)+    8 -> Just (0, 95, 135)+    9 -> Just (0, 95, 175)+    10 -> Just (0, 95, 215)+    11 -> Just (0, 95, 255)+    12 -> Just (0, 135, 0)+    13 -> Just (0, 135, 95)+    14 -> Just (0, 135, 135)+    15 -> Just (0, 135, 175)+    16 -> Just (0, 135, 215)+    17 -> Just (0, 135, 255)+    18 -> Just (0, 175, 0)+    19 -> Just (0, 175, 95)+    20 -> Just (0, 175, 135)+    21 -> Just (0, 175, 175)+    22 -> Just (0, 175, 215)+    23 -> Just (0, 175, 255)+    24 -> Just (0, 215, 0)+    25 -> Just (0, 215, 95)+    26 -> Just (0, 215, 135)+    27 -> Just (0, 215, 175)+    28 -> Just (0, 215, 215)+    29 -> Just (0, 215, 255)+    30 -> Just (0, 255, 0)+    31 -> Just (0, 255, 95)+    32 -> Just (0, 255, 135)+    33 -> Just (0, 255, 175)+    34 -> Just (0, 255, 215)+    35 -> Just (0, 255, 255)+    36 -> Just (95, 0, 0)+    37 -> Just (95, 0, 95)+    38 -> Just (95, 0, 135)+    39 -> Just (95, 0, 175)+    40 -> Just (95, 0, 215)+    41 -> Just (95, 0, 255)+    42 -> Just (95, 95, 0)+    43 -> Just (95, 95, 95)+    44 -> Just (95, 95, 135)+    45 -> Just (95, 95, 175)+    46 -> Just (95, 95, 215)+    47 -> Just (95, 95, 255)+    48 -> Just (95, 135, 0)+    49 -> Just (95, 135, 95)+    50 -> Just (95, 135, 135)+    51 -> Just (95, 135, 175)+    52 -> Just (95, 135, 215)+    53 -> Just (95, 135, 255)+    54 -> Just (95, 175, 0)+    55 -> Just (95, 175, 95)+    56 -> Just (95, 175, 135)+    57 -> Just (95, 175, 175)+    58 -> Just (95, 175, 215)+    59 -> Just (95, 175, 255)+    60 -> Just (95, 215, 0)+    61 -> Just (95, 215, 95)+    62 -> Just (95, 215, 135)+    63 -> Just (95, 215, 175)+    64 -> Just (95, 215, 215)+    65 -> Just (95, 215, 255)+    66 -> Just (95, 255, 0)+    67 -> Just (95, 255, 95)+    68 -> Just (95, 255, 135)+    69 -> Just (95, 255, 175)+    70 -> Just (95, 255, 215)+    71 -> Just (95, 255, 255)+    72 -> Just (135, 0, 0)+    73 -> Just (135, 0, 95)+    74 -> Just (135, 0, 135)+    75 -> Just (135, 0, 175)+    76 -> Just (135, 0, 215)+    77 -> Just (135, 0, 255)+    78 -> Just (135, 95, 0)+    79 -> Just (135, 95, 95)+    80 -> Just (135, 95, 135)+    81 -> Just (135, 95, 175)+    82 -> Just (135, 95, 215)+    83 -> Just (135, 95, 255)+    84 -> Just (135, 135, 0)+    85 -> Just (135, 135, 95)+    86 -> Just (135, 135, 135)+    87 -> Just (135, 135, 175)+    88 -> Just (135, 135, 215)+    89 -> Just (135, 135, 255)+    90 -> Just (135, 175, 0)+    91 -> Just (135, 175, 95)+    92 -> Just (135, 175, 135)+    93 -> Just (135, 175, 175)+    94 -> Just (135, 175, 215)+    95 -> Just (135, 175, 255)+    96 -> Just (135, 215, 0)+    97 -> Just (135, 215, 95)+    98 -> Just (135, 215, 135)+    99 -> Just (135, 215, 175)+    100 -> Just (135, 215, 215)+    101 -> Just (135, 215, 255)+    102 -> Just (135, 255, 0)+    103 -> Just (135, 255, 95)+    104 -> Just (135, 255, 135)+    105 -> Just (135, 255, 175)+    106 -> Just (135, 255, 215)+    107 -> Just (135, 255, 255)+    108 -> Just (175, 0, 0)+    109 -> Just (175, 0, 95)+    110 -> Just (175, 0, 135)+    111 -> Just (175, 0, 175)+    112 -> Just (175, 0, 215)+    113 -> Just (175, 0, 255)+    114 -> Just (175, 95, 0)+    115 -> Just (175, 95, 95)+    116 -> Just (175, 95, 135)+    117 -> Just (175, 95, 175)+    118 -> Just (175, 95, 215)+    119 -> Just (175, 95, 255)+    120 -> Just (175, 135, 0)+    121 -> Just (175, 135, 95)+    122 -> Just (175, 135, 135)+    123 -> Just (175, 135, 175)+    124 -> Just (175, 135, 215)+    125 -> Just (175, 135, 255)+    126 -> Just (175, 175, 0)+    127 -> Just (175, 175, 95)+    128 -> Just (175, 175, 135)+    129 -> Just (175, 175, 175)+    130 -> Just (175, 175, 215)+    131 -> Just (175, 175, 255)+    132 -> Just (175, 215, 0)+    133 -> Just (175, 215, 95)+    134 -> Just (175, 215, 135)+    135 -> Just (175, 215, 175)+    136 -> Just (175, 215, 215)+    137 -> Just (175, 215, 255)+    138 -> Just (175, 255, 0)+    139 -> Just (175, 255, 95)+    140 -> Just (175, 255, 135)+    141 -> Just (175, 255, 175)+    142 -> Just (175, 255, 215)+    143 -> Just (175, 255, 255)+    144 -> Just (215, 0, 0)+    145 -> Just (215, 0, 95)+    146 -> Just (215, 0, 135)+    147 -> Just (215, 0, 175)+    148 -> Just (215, 0, 215)+    149 -> Just (215, 0, 255)+    150 -> Just (215, 95, 0)+    151 -> Just (215, 95, 95)+    152 -> Just (215, 95, 135)+    153 -> Just (215, 95, 175)+    154 -> Just (215, 95, 215)+    155 -> Just (215, 95, 255)+    156 -> Just (215, 135, 0)+    157 -> Just (215, 135, 95)+    158 -> Just (215, 135, 135)+    159 -> Just (215, 135, 175)+    160 -> Just (215, 135, 215)+    161 -> Just (215, 135, 255)+    162 -> Just (215, 175, 0)+    163 -> Just (215, 175, 95)+    164 -> Just (215, 175, 135)+    165 -> Just (215, 175, 175)+    166 -> Just (215, 175, 215)+    167 -> Just (215, 175, 255)+    168 -> Just (215, 215, 0)+    169 -> Just (215, 215, 95)+    170 -> Just (215, 215, 135)+    171 -> Just (215, 215, 175)+    172 -> Just (215, 215, 215)+    173 -> Just (215, 215, 255)+    174 -> Just (215, 255, 0)+    175 -> Just (215, 255, 95)+    176 -> Just (215, 255, 135)+    177 -> Just (215, 255, 175)+    178 -> Just (215, 255, 215)+    179 -> Just (215, 255, 255)+    180 -> Just (255, 0, 0)+    181 -> Just (255, 0, 95)+    182 -> Just (255, 0, 135)+    183 -> Just (255, 0, 175)+    184 -> Just (255, 0, 215)+    185 -> Just (255, 0, 255)+    186 -> Just (255, 95, 0)+    187 -> Just (255, 95, 95)+    188 -> Just (255, 95, 135)+    189 -> Just (255, 95, 175)+    190 -> Just (255, 95, 215)+    191 -> Just (255, 95, 255)+    192 -> Just (255, 135, 0)+    193 -> Just (255, 135, 95)+    194 -> Just (255, 135, 135)+    195 -> Just (255, 135, 175)+    196 -> Just (255, 135, 215)+    197 -> Just (255, 135, 255)+    198 -> Just (255, 175, 0)+    199 -> Just (255, 175, 95)+    200 -> Just (255, 175, 135)+    201 -> Just (255, 175, 175)+    202 -> Just (255, 175, 215)+    203 -> Just (255, 175, 255)+    204 -> Just (255, 215, 0)+    205 -> Just (255, 215, 95)+    206 -> Just (255, 215, 135)+    207 -> Just (255, 215, 175)+    208 -> Just (255, 215, 215)+    209 -> Just (255, 215, 255)+    210 -> Just (255, 255, 0)+    211 -> Just (255, 255, 95)+    212 -> Just (255, 255, 135)+    213 -> Just (255, 255, 175)+    214 -> Just (255, 255, 215)+    215 -> Just (255, 255, 255)+    216 -> Just (8, 8, 8)+    217 -> Just (18, 18, 18)+    218 -> Just (28, 28, 28)+    219 -> Just (38, 38, 38)+    220 -> Just (48, 48, 48)+    221 -> Just (58, 58, 58)+    222 -> Just (68, 68, 68)+    223 -> Just (78, 78, 78)+    224 -> Just (88, 88, 88)+    225 -> Just (98, 98, 98)+    226 -> Just (108, 108, 108)+    227 -> Just (118, 118, 118)+    228 -> Just (128, 128, 128)+    229 -> Just (138, 138, 138)+    230 -> Just (148, 148, 148)+    231 -> Just (158, 158, 158)+    232 -> Just (168, 168, 168)+    233 -> Just (178, 178, 178)+    234 -> Just (188, 188, 188)+    235 -> Just (198, 198, 198)+    236 -> Just (208, 208, 208)+    237 -> Just (218, 218, 218)+    238 -> Just (228, 228, 228)+    239 -> Just (238, 238, 238)+    _   -> Nothing
src/Graphics/Vty/Config.hs view
@@ -1,16 +1,29 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-}--- | Vty supports a configuration file format and associated 'Config'--- data type. The 'Config' can be provided to 'mkVty' to customize the+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-- | Vty supports a configuration file format and provides a+-- corresponding 'VtyUserConfig' data type. The 'VtyUserConfig' can be+-- provided to platform packages' @mkVty@ functions to customize the -- application's use of Vty. ----- Lines in config files that fail to parse are ignored. Later entries--- take precedence over earlier ones.--- -- = Debug --+-- == @colorMode@+--+-- Format:+--+-- @+--  colorMode \"<ColorMode8|ColorMode16|ColorMode240 <int>|FullColor>\"+-- @+--+-- The preferred color mode to use, chosen from the constructors of the+-- 'ColorMode' type. If absent, the backend driver may detect and choose+-- an appropriate color mode. Implementor's note: backend packages+-- should respect this setting when it is present even when their+-- detection indicates that a different color mode should be used.+-- -- == @debugLog@ -- -- Format:@@ -53,17 +66,50 @@ -- If a debug log is requested then vty will output the current input -- table to the log in the above format. A workflow for using this is -- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for--- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.+-- incorrect mappings. Add corrected mappings to @$HOME\/.vty\/config@.+--+-- = Unicode Character Width Maps+--+-- == @widthMap@+--+-- Format:+--+-- @+--  \"widthMap\" string string+-- @+--+-- E.g.,+--+-- @+--   widthMap \"xterm\" \"\/home\/user\/.vty\/xterm\_map.dat\"+-- @+--+-- This directive specifies the path to a Unicode character+-- width map (the second argument) that should correspond to+-- the terminal named by first argument. Unicode character+-- width maps can be produced either by running platform+-- packages' width table tools or by calling the library routine+-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable'. Vty+-- platform packages should use these configuration settings to attempt+-- to load and install the specified width map. module Graphics.Vty.Config   ( InputMap-  , Config(..)-  , VtyConfigurationError(..)+  , VtyUserConfig(..)   , userConfig   , overrideEnvConfig-  , standardIOConfig+  , currentTerminalName   , runParseConfig   , parseConfigFile   , defaultConfig++  , vtyConfigPath+  , widthTableFilename+  , vtyDataDirectory+  , terminalWidthTablePath+  , vtyConfigFileEnvName++  , ConfigUpdateResult(..)+  , addConfigWidthMap   ) where @@ -71,135 +117,153 @@  import Control.Applicative hiding (many) -import Control.Exception (catch, IOException, Exception(..), throwIO)+import Control.Exception (catch, IOException) import Control.Monad (liftM, guard, void)  import qualified Data.ByteString as BS-import Data.Monoid-import Data.Typeable (Typeable)+#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid (Monoid(..))+#endif+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif+import Text.Read (readMaybe) +import Graphics.Vty.Attributes.Color (ColorMode(..)) import Graphics.Vty.Input.Events  import GHC.Generics -import System.Directory (getAppUserDataDirectory)-import System.Posix.Env (getEnv)-import System.Posix.IO (stdInput, stdOutput)-import System.Posix.Types (Fd(..))+import System.Directory ( getAppUserDataDirectory, doesFileExist+                        , createDirectoryIfMissing+                        )+import System.Environment (lookupEnv)+import System.FilePath ((</>), takeDirectory)  import Text.Parsec hiding ((<|>)) import Text.Parsec.Token ( GenLanguageDef(..) ) import qualified Text.Parsec.Token as P --- | Type of errors that can be thrown when configuring VTY-data VtyConfigurationError-  = VtyMissingTermEnvVar -- ^ TERM environment variable not set-  deriving (Show, Eq, Typeable)--instance Exception VtyConfigurationError where-  displayException VtyMissingTermEnvVar = "TERM environment variable not set"- -- | Mappings from input bytes to event in the order specified. Later -- entries take precedence over earlier in the case multiple entries -- have the same byte string. type InputMap = [(Maybe String, String, Event)] --- | A Vty configuration.-data Config = Config-    {-    -- | The default is 1 character.-      vmin  :: Maybe Int-    -- | The default is 100 milliseconds, 0.1 seconds.-    , vtime :: Maybe Int-    -- | The default is False.-    , mouseMode :: Maybe Bool-    -- | The default is False.-    , bracketedPasteMode :: Maybe Bool-    -- | Debug information is appended to this file if not Nothing.-    , debugLog           :: Maybe FilePath-    -- | The (input byte, output event) pairs extend the internal input-    -- table of VTY and the table from terminfo.-    ---    -- See "Graphics.Vty.Config" module documentation for documentation-    -- of the @map@ directive.-    , inputMap           :: InputMap-    -- | The input file descriptor to use. The default is-    -- 'System.Posix.IO.stdInput'-    , inputFd           :: Maybe Fd-    -- | The output file descriptor to use. The default is-    -- 'System.Posix.IO.stdOutput'-    , outputFd          :: Maybe Fd-    -- | The terminal name used to look up terminfo capabilities.-    -- The default is the value of the TERM environment variable.-    , termName           :: Maybe String-    } deriving (Show, Eq)+-- | A Vty core library configuration. Platform-specific details are not+-- included in the VtyUserConfig.+data VtyUserConfig =+    VtyUserConfig { configDebugLog :: Maybe FilePath+                  -- ^ Debug information is appended to this file if not+                  -- Nothing.+                  , configInputMap :: InputMap+                  -- ^ The (input byte, output event) pairs extend the internal+                  -- input table of VTY and the table from terminfo.+                  --+                  -- See "Graphics.Vty.Config" module documentation for+                  -- documentation of the @map@ directive.+                  , configTermWidthMaps :: [(String, FilePath)]+                  -- ^ Terminal width map files.+                  , configAllowCustomUnicodeWidthTables :: Maybe Bool+                  -- ^ Whether to permit custom Unicode width table loading by+                  -- 'Graphics.Vty.mkVty'. @'Just' 'False'@ indicates that+                  -- table loading should not be performed. Other values permit+                  -- table loading.+                  --+                  -- If a table load is attempted and fails, information+                  -- about the failure will be logged to the debug log if the+                  -- configuration specifies one. If no custom table is loaded+                  -- (or if a load fails), the built-in character width table+                  -- will be used.+                  , configPreferredColorMode :: Maybe ColorMode+                  -- ^ Preferred color mode. If set, this should+                  -- override platform color mode detection.+                  }+                  deriving (Show, Eq) -defaultConfig :: Config+defaultConfig :: VtyUserConfig defaultConfig = mempty -instance Monoid Config where-    mempty = Config-        { vmin         = Nothing-        , vtime        = Nothing-        , mouseMode    = Nothing-        , bracketedPasteMode = Nothing-        , debugLog     = mempty-        , inputMap     = mempty-        , inputFd     = Nothing-        , outputFd    = Nothing-        , termName     = Nothing-        }-    mappend c0 c1 = Config+instance Semigroup VtyUserConfig where+    c0 <> c1 =         -- latter config takes priority for everything but inputMap-        { vmin          = vmin c1     <|> vmin c0-        , vtime         = vtime c1    <|> vtime c0-        , mouseMode     = mouseMode c1-        , bracketedPasteMode = bracketedPasteMode c1-        , debugLog      = debugLog c1 <|> debugLog c0-        , inputMap      = inputMap c0 <>  inputMap c1-        , inputFd      = inputFd c1 <|> inputFd c0-        , outputFd     = outputFd c1 <|> outputFd c0-        , termName      = termName c1 <|> termName c0-        }+        VtyUserConfig { configDebugLog =+                          configDebugLog c1 <|> configDebugLog c0+                      , configInputMap =+                          configInputMap c0 <> configInputMap c1+                      , configTermWidthMaps =+                          configTermWidthMaps c1 <|> configTermWidthMaps c0+                      , configAllowCustomUnicodeWidthTables =+                          configAllowCustomUnicodeWidthTables c1 <|> configAllowCustomUnicodeWidthTables c0+                      , configPreferredColorMode =+                          configPreferredColorMode c1 <|> configPreferredColorMode c0+                      } --- | Load a configuration from @'getAppUserDataDirectory'/config@ and--- @$VTY_CONFIG_FILE@.-userConfig :: IO Config+instance Monoid VtyUserConfig where+    mempty =+        VtyUserConfig { configDebugLog = mempty+                      , configInputMap = mempty+                      , configTermWidthMaps = []+                      , configAllowCustomUnicodeWidthTables = Nothing+                      , configPreferredColorMode = Nothing+                      }+#if !(MIN_VERSION_base(4,11,0))+    mappend = (<>)+#endif++vtyDataDirectory :: IO FilePath+vtyDataDirectory = getAppUserDataDirectory "vty"++vtyConfigPath :: IO FilePath+vtyConfigPath = do+    dir <- vtyDataDirectory+    return $ dir </> "config"++vtyConfigFileEnvName :: String+vtyConfigFileEnvName = "VTY_CONFIG_FILE"++-- | Load a configuration from 'vtyConfigPath' and @$VTY_CONFIG_FILE@.+-- If none is found, build a default configuration.+userConfig :: IO VtyUserConfig userConfig = do-    configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile-    overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"+    configFile <- vtyConfigPath >>= parseConfigFile+    overrideConfig <- maybe (return defaultConfig) parseConfigFile =<<+        lookupEnv vtyConfigFileEnvName     let base = configFile <> overrideConfig     mappend base <$> overrideEnvConfig -overrideEnvConfig :: IO Config-overrideEnvConfig = do-    d <- getEnv "VTY_DEBUG_LOG"-    return $ defaultConfig { debugLog = d }+widthTableFilename :: String -> String+widthTableFilename term = "width_table_" <> term <> ".dat" --- | Configures VTY using defaults suitable for terminals. This function--- can raise 'VtyConfigurationError'.-standardIOConfig :: IO Config-standardIOConfig = do-    mb <- getEnv "TERM"-    case mb of-      Nothing -> throwIO VtyMissingTermEnvVar-      Just t ->-        return defaultConfig-          { vmin               = Just 1-          , mouseMode          = Just False-          , bracketedPasteMode = Just False-          , vtime              = Just 100-          , inputFd            = Just stdInput-          , outputFd           = Just stdOutput-          , termName           = Just t-          }+termVariable :: String+termVariable = "TERM" -parseConfigFile :: FilePath -> IO Config+currentTerminalName :: IO (Maybe String)+currentTerminalName = lookupEnv termVariable++terminalWidthTablePath :: IO (Maybe FilePath)+terminalWidthTablePath = do+    dataDir <- vtyDataDirectory+    result <- lookupEnv termVariable+    case result of+        Nothing -> return Nothing+        Just term -> do+            return $ Just $ dataDir </> widthTableFilename term++overrideEnvConfig :: IO VtyUserConfig+overrideEnvConfig = do+    d <- lookupEnv "VTY_DEBUG_LOG"+    return $ defaultConfig { configDebugLog = d }++-- | Parse a Vty configuration file.+--+-- Lines in config files that fail to parse are ignored. Later entries+-- take precedence over earlier ones.+parseConfigFile :: FilePath -> IO VtyUserConfig parseConfigFile path = do     catch (runParseConfig path <$> BS.readFile path)           (\(_ :: IOException) -> return defaultConfig) -runParseConfig :: String -> BS.ByteString -> Config+runParseConfig :: String -> BS.ByteString -> VtyUserConfig runParseConfig name cfgTxt =   case runParser parseConfig () name cfgTxt of     Right cfg -> cfg@@ -227,7 +291,7 @@ configLexer :: Monad m => P.GenTokenParser BS.ByteString () m configLexer = P.makeTokenParser configLanguage -mapDecl :: Parser Config+mapDecl :: Parser VtyUserConfig mapDecl = do     "map" <- P.identifier configLexer     termIdent <- (char '_' >> P.whiteSpace configLexer >> return Nothing)@@ -235,21 +299,34 @@     bytes     <- P.stringLiteral configLexer     key       <- parseValue     modifiers <- parseValue-    return defaultConfig { inputMap = [(termIdent, bytes, EvKey key modifiers)] }+    return defaultConfig { configInputMap = [(termIdent, bytes, EvKey key modifiers)] } -debugLogDecl :: Parser Config+debugLogDecl :: Parser VtyUserConfig debugLogDecl = do     "debugLog" <- P.identifier configLexer     path       <- P.stringLiteral configLexer-    return defaultConfig { debugLog = Just path }+    return defaultConfig { configDebugLog = Just path } +colorModeDecl :: Parser VtyUserConfig+colorModeDecl = do+    "colorMode" <- P.identifier configLexer+    mode <- P.stringLiteral configLexer+    return defaultConfig { configPreferredColorMode = readMaybe mode }++widthMapDecl :: Parser VtyUserConfig+widthMapDecl = do+    "widthMap" <- P.identifier configLexer+    tName <- P.stringLiteral configLexer+    path <- P.stringLiteral configLexer+    return defaultConfig { configTermWidthMaps = [(tName, path)] }+ ignoreLine :: Parser () ignoreLine = void $ manyTill anyChar newline -parseConfig :: Parser Config+parseConfig :: Parser VtyUserConfig parseConfig = liftM mconcat $ many $ do     P.whiteSpace configLexer-    let directives = [try mapDecl, try debugLogDecl]+    let directives = [try mapDecl, try debugLogDecl, try widthMapDecl, try colorModeDecl]     choice directives <|> (ignoreLine >> return defaultConfig)  class    Parse a        where parseValue :: Parser a@@ -295,3 +372,67 @@   gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con  instance GParseAlts V1 where gparseAlts _ = fail "GParse: V1"++-- | The result of a configuration change attempt made by+-- 'addConfigWidthMap'.+data ConfigUpdateResult =+    ConfigurationCreated+    -- ^ A new configuration file file was written with the new width+    -- table entry.+    | ConfigurationModified+    -- ^ An existing configuration file was modified with the new width+    -- table entry.+    | ConfigurationConflict String+    -- ^ The attempted width table entry could not be written to the+    -- configuration due to a conflict; the argument here is the width+    -- table file path for the conflicting entry.+    | ConfigurationRedundant+    -- ^ No change was made because the existing configuration already+    -- contains the specified mapping.+    deriving (Eq, Show)++-- | Add a @widthMap@ directive to the Vty configuration file at the+-- specified path.+--+-- If the configuration path refers to a configuration that already+-- contains the directive for the specified map and terminal type, the+-- configuration file will not be modified. If the file does not contain+-- the directive, it will be appended to the file.+--+-- If the configuration path does not exist, a new configuration file+-- will be created and any directories in the path will also be created.+--+-- This returns a 'ConfigUpdateResult' indicating the change to the+-- configuration. This does not handle exceptions raised by file or+-- directory permissions issues.+addConfigWidthMap :: FilePath+                  -- ^ The configuration file path of the configuration+                  -- to modify or create.+                  -> String+                  -- ^ The @TERM@ value for the @widthMap@ directive.+                  -> FilePath+                  -- ^ The width table file path for the directive.+                  -> IO ConfigUpdateResult+addConfigWidthMap configPath term tablePath = do+    configEx <- doesFileExist configPath+    if configEx+       then updateConfig+       else createConfig >> return ConfigurationCreated++    where+        directive = "widthMap " <> show term <> " " <> show tablePath <> "\n"++        createConfig = do+            let dir = takeDirectory configPath+            createDirectoryIfMissing True dir+            writeFile configPath directive++        updateConfig = do+            config <- parseConfigFile configPath+            if (term, tablePath) `elem` configTermWidthMaps config+               then return ConfigurationRedundant+               else case lookup term (configTermWidthMaps config) of+                   Just other -> return $ ConfigurationConflict other+                   Nothing -> do+                       appendFile configPath directive+                       return ConfigurationModified
src/Graphics/Vty/Debug.hs view
@@ -1,27 +1,32 @@ -- Copyright 2009-2010 Corey O'Connor module Graphics.Vty.Debug-  ( module Graphics.Vty.Debug-  , module Graphics.Vty.Debug.Image+  ( MockWindow(..)+  , SpanConstructLog+  , regionForWindow+  , allSpansHaveWidth+  , spanOpsAffectedColumns+  , spanOpsAffectedRows+  , rowOpsAffectedColumns+  , isSetAttr   ) where  import Graphics.Vty.Attributes import Graphics.Vty.Image (DisplayRegion)-import Graphics.Vty.Debug.Image import Graphics.Vty.Span  import qualified Data.Vector as Vector -rowOpsEffectedColumns :: DisplayOps -> [Int]-rowOpsEffectedColumns ops-    = Vector.toList $ Vector.map spanOpsEffectedColumns ops+rowOpsAffectedColumns :: DisplayOps -> [Int]+rowOpsAffectedColumns ops+    = Vector.toList $ Vector.map spanOpsAffectedColumns ops  allSpansHaveWidth :: DisplayOps -> Int -> Bool allSpansHaveWidth ops expected-    = all (== expected) $ Vector.toList $ Vector.map spanOpsEffectedColumns ops+    = all (== expected) $ Vector.toList $ Vector.map spanOpsAffectedColumns ops -spanOpsEffectedRows :: DisplayOps -> Int-spanOpsEffectedRows ops+spanOpsAffectedRows :: DisplayOps -> Int+spanOpsAffectedRows ops     = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))  type SpanConstructLog = [SpanConstructEvent]
− src/Graphics/Vty/Debug/Image.hs 
@@ -1,32 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}-module Graphics.Vty.Debug.Image where--import Graphics.Vty.Image--type ImageConstructLog = [ImageConstructEvent]-data ImageConstructEvent = ImageConstructEvent-    deriving ( Show, Eq )--forwardImageOps :: [Image -> Image]-forwardImageOps = map forwardTransform debugImageOps--forwardTransform, reverseTransform :: ImageOp -> (Image -> Image)--forwardTransform (ImageOp f _) = f-reverseTransform (ImageOp _ r) = r--data ImageOp = ImageOp ImageEndo ImageEndo-type ImageEndo = Image -> Image--debugImageOps :: [ImageOp]-debugImageOps =-    [ idImageOp-    -- , renderSingleColumnCharOp-    -- , renderDoubleColumnCharOp-    ]--idImageOp :: ImageOp-idImageOp = ImageOp id id---- renderCharOp :: ImageOp--- renderCharOp = ImageOp id id
src/Graphics/Vty/DisplayAttributes.hs view
@@ -1,11 +1,26 @@ -- Copyright 2009-2010 Corey O'Connor {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} -module Graphics.Vty.DisplayAttributes where+module Graphics.Vty.DisplayAttributes+  ( DisplayAttrDiff(..)+  , StyleStateChange(..)+  , DisplayColorDiff(..)+  , URLDiff(..)+  , fixDisplayAttr+  , displayAttrDiffs+  )+where  import Graphics.Vty.Attributes  import Data.Bits ((.&.))+import Data.ByteString (ByteString)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)  -- | Given the previously applied display attributes as a FixedAttr and -- the current display attributes as an Attr produces a FixedAttr that@@ -17,6 +32,7 @@     = FixedAttr (fixStyle (fixedStyle fattr)     (attrStyle attr))                 (fixColor (fixedForeColor fattr) (attrForeColor attr))                 (fixColor (fixedBackColor fattr) (attrBackColor attr))+                (fixURL   (fixedURL fattr)       (attrURL attr))     where         fixStyle _s Default           = defaultStyleMask         fixStyle s KeepCurrent        = s@@ -24,6 +40,9 @@         fixColor _c Default           = Nothing         fixColor c KeepCurrent        = c         fixColor _c (SetTo c)         = Just c+        fixURL c KeepCurrent          = c+        fixURL _c (SetTo n)           = Just n+        fixURL _c Default             = Nothing  -- | difference between two display attributes. Used in the calculation -- of the operations required to go from one display attribute to the@@ -36,17 +55,24 @@     { styleDiffs    :: [StyleStateChange]     , foreColorDiff :: DisplayColorDiff     , backColorDiff :: DisplayColorDiff+    , urlDiff       :: URLDiff     }     deriving (Show) -instance Monoid DisplayAttrDiff where-    mempty = DisplayAttrDiff [] NoColorChange NoColorChange-    mappend d0 d1 =+instance Semigroup DisplayAttrDiff where+    d0 <> d1 =         let ds  = simplifyStyleDiffs (styleDiffs d0)    (styleDiffs d1)             fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)             bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)-        in DisplayAttrDiff ds fcd bcd+            ud  = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)+        in DisplayAttrDiff ds fcd bcd ud +instance Monoid DisplayAttrDiff where+    mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange+#if !(MIN_VERSION_base(4,11,0))+    mappend = (<>)+#endif+ -- | Used in the computation of a final style attribute change. simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange] simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1@@ -58,6 +84,12 @@ simplifyColorDiffs cd              NoColorChange  = cd simplifyColorDiffs _cd             (SetColor !c)  = SetColor c +-- | Consider two URL changes, which are mostly going to be the latter+-- unless the latter specifies no change.+simplifyUrlDiffs :: URLDiff -> URLDiff -> URLDiff+simplifyUrlDiffs ud NoLinkChange = ud+simplifyUrlDiffs _ ud = ud+ -- | Difference between two display color attribute changes. data DisplayColorDiff     = ColorToDefault@@ -70,6 +102,10 @@ data StyleStateChange     = ApplyStandout     | RemoveStandout+    | ApplyItalic+    | RemoveItalic+    | ApplyStrikethrough+    | RemoveStrikethrough     | ApplyUnderline     | RemoveUnderline     | ApplyReverseVideo@@ -82,6 +118,13 @@     | RemoveBold     deriving (Show, Eq) +-- Setting and unsetting hyperlinks+data URLDiff+    = LinkTo !ByteString+    | NoLinkChange+    | EndLink+    deriving (Show, Eq)+ -- | Determines the diff between two display&color attributes. This diff -- determines the operations that actually get output to the terminal. displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff@@ -89,8 +132,14 @@     { styleDiffs    = diffStyles (fixedStyle attr)      (fixedStyle attr')     , foreColorDiff = diffColor  (fixedForeColor attr) (fixedForeColor attr')     , backColorDiff = diffColor  (fixedBackColor attr) (fixedBackColor attr')+    , urlDiff       = diffURL    (fixedURL attr)       (fixedURL attr')     } +diffURL :: Maybe Text -> Maybe Text -> URLDiff+diffURL Nothing Nothing = NoLinkChange+diffURL (Just _) Nothing = EndLink+diffURL _ (Just url) = LinkTo (encodeUtf8 url)+ diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff diffColor Nothing  (Just c') = SetColor c' diffColor (Just c) (Just c')@@ -104,6 +153,8 @@     = mconcat     [ styleDiff standout      ApplyStandout     RemoveStandout     , styleDiff underline     ApplyUnderline    RemoveUnderline+    , styleDiff italic        ApplyItalic       RemoveItalic+    , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough     , styleDiff reverseVideo  ApplyReverseVideo RemoveReverseVideo     , styleDiff blink         ApplyBlink        RemoveBlink     , styleDiff dim           ApplyDim          RemoveDim
src/Graphics/Vty/Error.hs view
@@ -1,4 +1,7 @@-module Graphics.Vty.Error where+module Graphics.Vty.Error+  ( VtyException(..)+  )+where  -- | The type of exceptions specific to vty. --
src/Graphics/Vty/Image.hs view
@@ -1,5 +1,4 @@ -- Copyright 2009-2010 Corey O'Connor-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DisambiguateRecordFields #-} -- | A Vty program makes 'Picture's from 'Image's. This module provides@@ -46,10 +45,13 @@   -- * Character width functions   , safeWcwidth   , safeWcswidth+  , safeWctwidth+  , safeWctlwidth   , wcwidth   , wcswidth+  , wctwidth+  , wctlwidth   -- * Display Regions-  , DisplayText   , DisplayRegion   , regionWidth   , regionHeight@@ -113,14 +115,18 @@ vertCat :: [Image] -> Image vertCat = foldr vertJoin EmptyImage --- | Make an 'Image' from a lazy text value.+-- | Make an 'Image' from a lazy text value. The text value should be+-- sanitized of escape sequences (ASCII 27) and carriage returns;+-- otherwise layout and attribute problems may result. text :: Attr -> TL.Text -> Image-text a txt = let displayWidth = safeWcswidth (TL.unpack txt)+text a txt = let displayWidth = safeWctlwidth txt              in HorizText a txt displayWidth (fromIntegral $! TL.length txt) --- | Make an 'Image' from a text value.+-- | Make an 'Image' from a text value. The text value should be+-- sanitized of escape sequences (ASCII 27) and carriage returns;+-- otherwise layout and attribute problems may result. text' :: Attr -> T.Text -> Image-text' a txt = let displayWidth = safeWcswidth (T.unpack txt)+text' a txt = let displayWidth = safeWctwidth txt               in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)  -- | Make an image from a single character. This is a standard Haskell@@ -130,9 +136,11 @@     let displayWidth = safeWcwidth c     in HorizText a (TL.singleton c) displayWidth 1 --- | Make an image from a string of characters layed out on a single+-- | Make an image from a string of characters laid out on a single -- row with the same display attribute. The string is assumed to be a--- sequence of ISO-10646 characters.+-- sequence of ISO-10646 characters. The input string should be+-- sanitized of escape sequences (ASCII 27) and carriage returns;+-- otherwise layout and attribute problems may result. -- -- Note: depending on how the Haskell compiler represents string -- literals, a string literal in a UTF-8 encoded source file, for@@ -166,11 +174,14 @@ utf8Bytestring :: Attr -> BL.ByteString -> Image utf8Bytestring a bs = text a (TL.decodeUtf8 bs) --- | Make an 'Image' from a UTF-8 encoded lazy bytestring.+-- | Make an 'Image' from a UTF-8 encoded strict bytestring. utf8Bytestring' :: Attr -> B.ByteString -> Image utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)  -- | Make an image filling a region with the specified character.+--+-- If either the width or height are less than or equal to 0, then+-- the result is the empty image. charFill :: Integral d          => Attr          -- ^ The attribute to use.@@ -181,15 +192,18 @@          -> d          -- ^ The region height.          -> Image-charFill _a _c 0  _h = EmptyImage-charFill _a _c _w 0  = EmptyImage-charFill a c w h =-    vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth-    where-        txt = TL.replicate (fromIntegral w) (TL.singleton c)-        displayWidth = safeWcwidth c * (fromIntegral w)-        charWidth = fromIntegral w+charFill a c w h+  | w <= 0 || h <= 0 = EmptyImage+  | otherwise        = vertCat+                     $ replicate (fromIntegral h)+                     $ HorizText a txt displayWidth charWidth+  where+    txt          = TL.replicate charWidth (TL.singleton c)+    displayWidth = safeWcwidth c * charWidth +    charWidth   :: Num a => a+    charWidth    = fromIntegral w+ -- | The empty image. Useful for fold combinators. These occupy no space -- and do not affect display attributes. emptyImage :: Image@@ -243,7 +257,7 @@ translateX :: Int -> Image -> Image translateX x i     | x < 0 && (abs x > imageWidth i) = emptyImage-    | x < 0     = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)+    | x < 0     = cropLeft (imageWidth i + x) i     | x == 0    = i     | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h @@ -251,7 +265,7 @@ translateY :: Int -> Image -> Image translateY y i     | y < 0 && (abs y > imageHeight i) = emptyImage-    | y < 0     = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)+    | y < 0     = cropTop (imageHeight i + y) i     | y == 0    = i     | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y) @@ -281,12 +295,11 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropBottom {croppedImage, outputWidth, outputHeight})-                | outputHeight <= h = i-                | otherwise          = CropBottom croppedImage outputWidth h+            go i@(Crop {outputHeight})+                = i {outputHeight = min h outputHeight}             go i                 | h >= imageHeight i = i-                | otherwise           = CropBottom i (imageWidth i) h+                | otherwise = Crop i 0 0 (imageWidth i) h  -- | Crop an image's width. If the image's width is less than or equal -- to the specified width then this operation has no effect. Otherwise@@ -298,12 +311,11 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropRight {croppedImage, outputWidth, outputHeight})-                | outputWidth <= w = i-                | otherwise         = CropRight croppedImage w outputHeight+            go i@(Crop {outputWidth})+                = i {outputWidth = min w outputWidth}             go i                 | w >= imageWidth i = i-                | otherwise          = CropRight i w (imageHeight i)+                | otherwise = Crop i 0 0 w (imageHeight i)  -- | Crop an image's width. If the image's width is less than or equal -- to the specified width then this operation has no effect. Otherwise@@ -315,14 +327,13 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})-                | outputWidth <= w = i-                | otherwise         =-                    let leftSkip' = leftSkip + outputWidth - w-                    in CropLeft croppedImage leftSkip' w outputHeight+            go i@(Crop {leftSkip, outputWidth}) =+                let delta = max 0 (outputWidth - w)+                in i { leftSkip = leftSkip + delta+                     , outputWidth = outputWidth - delta }             go i                 | imageWidth i <= w = i-                | otherwise          = CropLeft i (imageWidth i - w) w (imageHeight i)+                | otherwise = Crop i (imageWidth i - w) 0 w (imageHeight i)  -- | Crop an image's height. If the image's height is less than or equal -- to the specified height then this operation has no effect. Otherwise@@ -334,14 +345,13 @@     | otherwise = go inI         where             go EmptyImage = EmptyImage-            go i@(CropTop {croppedImage, topSkip, outputWidth, outputHeight})-                | outputHeight <= h = i-                | otherwise         =-                    let topSkip' = topSkip + outputHeight - h-                    in CropTop croppedImage topSkip' outputWidth h+            go i@(Crop {topSkip, outputHeight}) =+                let delta = max 0 (outputHeight - h)+                in i { topSkip = topSkip + delta+                     , outputHeight = outputHeight - delta }             go i                 | imageHeight i <= h = i-                | otherwise          = CropTop i (imageHeight i - h) (imageWidth i) h+                | otherwise = Crop i 0 (imageHeight i - h) (imageWidth i) h  -- | Generic resize. Pads and crops are added to ensure that the -- resulting image matches the specified dimensions. This is biased to
src/Graphics/Vty/Image/Internal.hs view
@@ -1,9 +1,20 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_HADDOCK hide #-} -module Graphics.Vty.Image.Internal where+module Graphics.Vty.Image.Internal+  ( Image(..)+  , imageHeight+  , imageWidth+  , horizJoin+  , vertJoin +  , ppImageStructure+  , clipText+  )+where+ import Graphics.Vty.Attributes import Graphics.Text.Width @@ -11,12 +22,12 @@  import Control.DeepSeq +#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif import qualified Data.Text.Lazy as TL --- | A display text is a Data.Text.Lazy-type DisplayText = TL.Text--clipText :: DisplayText -> Int -> Int -> DisplayText+clipText :: TL.Text -> Int -> Int -> TL.Text clipText txt leftSkip rightClip =     -- CPS would clarify this I think     let (toDrop,padPrefix) = clipForCharWidth leftSkip txt 0@@ -53,7 +64,7 @@       { attr :: Attr       -- | The text to display. The display width of the text is always       -- outputWidth.-      , displayText :: DisplayText+      , displayText :: TL.Text       -- | The number of display columns for the text.       , outputWidth :: Int       -- | the number of characters in the text.@@ -92,42 +103,12 @@       { outputWidth :: Int -- ^ always > 0       , outputHeight :: Int -- ^ always > 0       }-    -- | Crop an image horizontally to a size by reducing the size from-    -- the right.-    | CropRight-      { croppedImage :: Image-      -- | Always < imageWidth croppedImage > 0-      , outputWidth :: Int-      , outputHeight :: Int -- ^ imageHeight croppedImage-      }-    -- | Crop an image horizontally to a size by reducing the size from-    -- the left.-    | CropLeft+    -- | Crop an image+    | Crop       { croppedImage :: Image-      -- | Always < imageWidth croppedImage > 0       , leftSkip :: Int-      -- | Always < imageWidth croppedImage > 0-      , outputWidth :: Int-      , outputHeight :: Int-      }-    -- | Crop an image vertically to a size by reducing the size from-    -- the bottom-    | CropBottom-      { croppedImage :: Image-      -- | imageWidth croppedImage-      , outputWidth :: Int-      -- | height image is cropped to. Always < imageHeight croppedImage > 0-      , outputHeight :: Int-      }-    -- | Crop an image vertically to a size by reducing the size from-    -- the top-    | CropTop-      { croppedImage :: Image-      -- | Always < imageHeight croppedImage > 0       , topSkip :: Int-      -- | imageWidth croppedImage       , outputWidth :: Int-      -- | Always < imageHeight croppedImage > 0       , outputHeight :: Int       }     -- | The empty image@@ -138,37 +119,11 @@     --     -- Any image of zero size equals the empty image.     | EmptyImage-    deriving (Eq, Generic)--instance Show Image where-    show ( HorizText { attr, displayText, outputWidth, charWidth } )-        = "HorizText " ++ show displayText-                       ++ "@(" ++ show attr ++ ","-                               ++ show outputWidth ++ ","-                               ++ show charWidth ++ ")"-    show ( BGFill { outputWidth, outputHeight } )-        = "BGFill (" ++ show outputWidth ++ "," ++ show outputHeight ++ ")"-    show ( HorizJoin { partLeft = l, partRight = r, outputWidth = c } )-        = "HorizJoin " ++ show c ++ " (" ++ show l ++ " <|> " ++ show r ++ ")"-    show ( VertJoin { partTop = t, partBottom = b, outputWidth = c, outputHeight = r } )-        = "VertJoin [" ++ show c ++ ", " ++ show r ++ "] (" ++ show t ++ ") <-> (" ++ show b ++ ")"-    show ( CropRight { croppedImage, outputWidth, outputHeight } )-        = "CropRight [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"-                     ++ " (" ++ show croppedImage ++ ")"-    show ( CropLeft { croppedImage, leftSkip, outputWidth, outputHeight } )-        = "CropLeft [" ++ show leftSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"-                    ++ " (" ++ show croppedImage ++ ")"-    show ( CropBottom { croppedImage, outputWidth, outputHeight } )-        = "CropBottom [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"-                      ++ " (" ++ show croppedImage ++ ")"-    show ( CropTop { croppedImage, topSkip, outputWidth, outputHeight } )-        = "CropTop [" ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"-                   ++ " (" ++ show croppedImage ++ ")"-    show ( EmptyImage ) = "EmptyImage"+    deriving (Eq, Generic, Show, Read)  -- | pretty print just the structure of an image. ppImageStructure :: Image -> String-ppImageStructure inImg = go 0 inImg+ppImageStructure = go 0     where         go indent img = tab indent ++ pp indent img         tab indent = concat $ replicate indent "  "@@ -181,26 +136,14 @@             = "VertJoin(" ++ show c ++ ", " ++ show r ++ ")\n"               ++ go (i+1) t ++ "\n"               ++ go (i+1) b-        pp i (CropRight {croppedImage, outputWidth, outputHeight})-            = "CropRight(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"-              ++ go (i+1) croppedImage-        pp i (CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})-            = "CropLeft(" ++ show leftSkip ++ "->" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"-              ++ go (i+1) croppedImage-        pp i (CropBottom {croppedImage, outputWidth, outputHeight})-            = "CropBottom(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"-              ++ go (i+1) croppedImage-        pp i (CropTop {croppedImage, topSkip, outputWidth, outputHeight})-            = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n"+        pp i (Crop {croppedImage, leftSkip, topSkip, outputWidth, outputHeight})+            = "Crop(" ++ show leftSkip ++ "," ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"               ++ go (i+1) croppedImage         pp _ EmptyImage = "EmptyImage"  instance NFData Image where     rnf EmptyImage = ()-    rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()-    rnf (CropLeft i s w h) = i `deepseq` s `seq` w `seq` h `seq` ()-    rnf (CropBottom i w h) = i `deepseq` w `seq` h `seq` ()-    rnf (CropTop i s w h) = i `deepseq` s `seq` w `seq` h `seq` ()+    rnf (Crop i x y w h) = i `deepseq` x `seq` y `seq` w `seq` h `seq` ()     rnf (BGFill w h) = w `seq` h `seq` ()     rnf (VertJoin t b w h) = t `deepseq` b `deepseq` w `seq` h `seq` ()     rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` ()@@ -213,10 +156,7 @@ imageWidth HorizJoin { outputWidth = w } = w imageWidth VertJoin { outputWidth = w } = w imageWidth BGFill { outputWidth = w } = w-imageWidth CropRight { outputWidth  = w } = w-imageWidth CropLeft { outputWidth  = w } = w-imageWidth CropBottom { outputWidth = w } = w-imageWidth CropTop { outputWidth = w } = w+imageWidth Crop { outputWidth = w } = w imageWidth EmptyImage = 0  -- | The height of an Image. This is the number of display rows the@@ -226,16 +166,19 @@ imageHeight HorizJoin { outputHeight = h } = h imageHeight VertJoin { outputHeight = h } = h imageHeight BGFill { outputHeight = h } = h-imageHeight CropRight { outputHeight  = h } = h-imageHeight CropLeft { outputHeight  = h } = h-imageHeight CropBottom { outputHeight = h } = h-imageHeight CropTop { outputHeight = h } = h+imageHeight Crop { outputHeight = h } = h imageHeight EmptyImage = 0 --- | Append in the Monoid instance is equivalent to <->.+-- | Append in the 'Semigroup' instance is equivalent to '<->'.+instance Semigroup Image where+    (<>) = vertJoin++-- | Append in the 'Monoid' instance is equivalent to '<->'. instance Monoid Image where     mempty = EmptyImage-    mappend = vertJoin+#if !(MIN_VERSION_base(4,11,0))+    mappend = (<>)+#endif  -- | combines two images side by side --@@ -244,7 +187,7 @@ -- -- The result image will have a width equal to the sum of the two images -- width. And the height will equal the largest height of the two--- images. The area not defined in one image due to a height missmatch+-- images. The area not defined in one image due to a height mismatch -- will be filled with the background pattern. horizJoin :: Image -> Image -> Image horizJoin EmptyImage i          = i@@ -275,7 +218,7 @@ -- -- The result image will have a height equal to the sum of the heights -- of both images. The width will equal the largest width of the two--- images. The area not defined in one image due to a width missmatch+-- images. The area not defined in one image due to a width mismatch -- will be filled with the background pattern. vertJoin :: Image -> Image -> Image vertJoin EmptyImage i          = i
src/Graphics/Vty/Inline.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE BangPatterns #-}- -- | The inline module provides a limited interface to changing the -- style of terminal output. The intention is for this interface to be -- used inline with other output systems.@@ -31,13 +29,11 @@ -- Copyright 2009-2010 Corey O'Connor module Graphics.Vty.Inline   ( module Graphics.Vty.Inline-  , withVty   ) where  import Graphics.Vty import Graphics.Vty.DisplayAttributes-import Graphics.Vty.Inline.Unsafe  import Blaze.ByteString.Builder (writeToByteString) @@ -48,22 +44,33 @@  import System.IO -type InlineM v = State Attr v+type InlineM v = State InlineState v +data InlineState =+    InlineState { inlineAttr :: Attr+                , inlineUrlsEnabled :: Bool+                }+ -- | Set the background color to the provided 'Color'. backColor :: Color -> InlineM ()-backColor c = modify $ flip mappend ( currentAttr `withBackColor` c )+backColor c = modify $ \s ->+    s { inlineAttr = inlineAttr s `withBackColor` c+      }  -- | Set the foreground color to the provided 'Color'. foreColor :: Color -> InlineM ()-foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )+foreColor c = modify $ \s ->+    s { inlineAttr = inlineAttr s `withForeColor` c+      }  -- | Attempt to change the 'Style' of the following text.. -- -- If the terminal does not support the style change then no error is -- produced. The style can still be removed. applyStyle :: Style -> InlineM ()-applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )+applyStyle st = modify $ \s ->+    s { inlineAttr = inlineAttr s `withStyle` st+      }  -- | Attempt to remove the specified 'Style' from the display of the -- following text.@@ -71,16 +78,18 @@ -- This will fail if 'applyStyle' for the given style has not been -- previously called. removeStyle :: Style -> InlineM ()-removeStyle sMask = modify $ \attr ->-    let style' = case attrStyle attr of-                    Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."-                    KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."-                    SetTo s -> s .&. complement sMask-    in attr { attrStyle = SetTo style' }+removeStyle sMask = modify $ \s ->+    s { inlineAttr =+          let style' = case attrStyle (inlineAttr s) of+                Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."+                KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."+                SetTo st -> st .&. complement sMask+          in (inlineAttr s) { attrStyle = SetTo style' }+      }  -- | Reset the display attributes. defaultAll :: InlineM ()-defaultAll = put defAttr+defaultAll = modify $ \s -> s { inlineAttr = defAttr }  -- | Apply the provided display attribute changes to the given terminal -- output device.@@ -93,14 +102,14 @@     mfattr <- prevFattr <$> readIORef (assumedStateRef out)     fattr <- case mfattr of                 Nothing -> do-                    liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc-                    return $ FixedAttr defaultStyleMask Nothing Nothing+                    liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False+                    return $ FixedAttr defaultStyleMask Nothing Nothing Nothing                 Just v -> return v-    let attr = execState c currentAttr+    let InlineState attr urlsEnabled = execState c (InlineState currentAttr False)         attr' = limitAttrForDisplay out attr         fattr' = fixDisplayAttr fattr attr'         diffs = displayAttrDiffs fattr fattr'-    outputByteBuffer out $ writeToByteString $ writeSetAttr dc fattr attr' diffs+    outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs     modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }     inlineHack dc @@ -108,8 +117,8 @@ -- output device. -- -- This will flush the terminal output.-putAttrChange_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()-putAttrChange_ c = liftIO $ withOutput $ \out -> do+putAttrChange_ :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()+putAttrChange_ out c = liftIO $ do     hFlush stdout     putAttrChange out c     hFlush stdout
− src/Graphics/Vty/Inline/Unsafe.hs 
@@ -1,59 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--module Graphics.Vty.Inline.Unsafe where--import Graphics.Vty--import Data.IORef--import GHC.IO.Handle (hDuplicate)--import System.IO (stdin, stdout, hSetBuffering, BufferMode(NoBuffering))--import System.IO.Unsafe--import System.Posix.IO (handleToFd)--globalVty :: IORef (Maybe Vty)-{-# NOINLINE globalVty #-}-globalVty = unsafePerformIO $ newIORef Nothing--globalOutput :: IORef (Maybe Output)-{-# NOINLINE globalOutput #-}-globalOutput = unsafePerformIO $ newIORef Nothing--mkDupeConfig :: IO Config-mkDupeConfig = do-    hSetBuffering stdout NoBuffering-    hSetBuffering stdin NoBuffering-    stdinDupe <- hDuplicate stdin >>= handleToFd-    stdoutDupe <- hDuplicate stdout >>= handleToFd-    return $ defaultConfig { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }---- | This will create a Vty instance using 'mkVty' and execute an IO--- action provided that instance. The created Vty instance will be--- stored to the unsafe 'IORef' 'globalVty'.------ This instance will use duplicates of the stdin and stdout Handles.-withVty :: (Vty -> IO b) -> IO b-withVty f = do-    mvty <- readIORef globalVty-    vty <- case mvty of-        Nothing -> do-            vty <- mkDupeConfig >>= mkVty-            writeIORef globalVty (Just vty)-            return vty-        Just vty -> return vty-    f vty--withOutput :: (Output -> IO b) -> IO b-withOutput f = do-    mout <- readIORef globalOutput-    out <- case mout of-        Nothing -> do-            config <- mappend <$> userConfig <*> mkDupeConfig-            out <- outputForConfig config-            writeIORef globalOutput (Just out)-            return out-        Just out -> return out-    f out
src/Graphics/Vty/Input.hs view
@@ -1,185 +1,32 @@-{-# LANGUAGE RecordWildCards #-}---- | This module provides the input layer for Vty, including methods--- for initializing an 'Input' structure and reading 'Event's from the--- terminal.------ Note that due to the evolution of terminal emulators, some keys--- and combinations will not reliably map to the expected events by--- any terminal program. There is no 1:1 mapping from key events to--- bytes read from the terminal input device. In very limited cases the--- terminal and vty's input process can be customized to resolve these--- issues; see "Graphics.Vty.Config" for how to configure vty's input--- processing.------ = VTY's Implementation------ There are two input modes:------  1. 7-bit------  2. 8-bit------ The 7-bit input mode is the default and the expected mode in most use--- cases. This is what Vty uses.------ == 7-bit input encoding------ Control key combinations are represented by masking the two high bits--- of the 7-bit input. Historically the control key actually grounded--- the two high bit wires: 6 and 7. This is why control key combos--- map to single character events: the input bytes are identical. The--- input byte is the bit encoding of the character with bits 6 and 7--- masked. Bit 6 is set by shift. Bit 6 and 7 are masked by control. For--- example,------ * Control-I is 'i', `01101001`, and has bit 6 and 7 masked to become--- `00001001`, which is the ASCII and UTF-8 encoding of the Tab key.------ * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero--- which is `0000011` and is the "End of Text" code.------ * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: this--- is the value 1 with bit 7 set and 6 unset.------ * Hypothesis: Bit 6 is unset by upper case letters because,--- initially, there were only upper case letters used and a 5 bit--- encoding.------ == 8-bit encoding------ The 8th bit was originally used for parity checking which is useless--- for terminal emulators. Some terminal emulators support an 8-bit--- input encoding. While this provides some advantages, the actual usage--- is low. Most systems use 7-bit mode but recognize 8-bit control--- characters when escaped. This is what Vty does.------ == Escaped Control Keys------ Using 7-bit input encoding, the @ESC@ byte can signal the start of--- an encoded control key. To differentiate a single @ESC@ event from a--- control key, the timing of the input is used.------ 1. @ESC@ individually: @ESC@ byte; no bytes following for a period of--- 'VMIN' milliseconds.------ 2. Control keys that contain @ESC@ in their encoding: The @ESC byte--- is followed by more bytes read within 'VMIN' milliseconds. All bytes--- up until the next valid input block are passed to the classifier.------ If the current runtime is the threaded runtime then the terminal's--- @VMIN@ and @VTIME@ behavior reliably implement the above rules. If--- the current runtime does not support 'forkOS' then there is currently--- no implementation.------ == Unicode Input and Escaped Control Key Sequences------ The input encoding determines how UTF-8 encoded characters are--- recognized.------ * 7-bit mode: UTF-8 can be input unambiguiously. UTF-8 input is--- a superset of ASCII. UTF-8 does not overlap escaped control key--- sequences. However, the escape key must be differentiated from--- escaped control key sequences by the timing of the input bytes.------ * 8-bit mode: UTF-8 cannot be input unambiguously. This does not--- require using the timing of input bytes to differentiate the escape--- key. Many terminals do not support 8-bit mode.------ == Terminfo------ The terminfo system is used to determine how some keys are encoded.--- Terminfo is incomplete and in some cases terminfo is incorrect. Vty--- assumes terminfo is correct but provides a mechanism to override--- terminfo; see "Graphics.Vty.Config", specifically 'inputOverrides'.------ == Terminal Input is Broken------ Clearly terminal input has fundemental issues. There is no easy way--- to reliably resolve these issues.------ One resolution would be to ditch standard terminal interfaces--- entirely and just go directly to scancodes. This would be a--- reasonable option for Vty if everybody used the linux kernel console--- but for obvious reasons this is not possible.------ The "Graphics.Vty.Config" module supports customizing the--- input-byte-to-event mapping and xterm supports customizing the--- scancode-to-input-byte mapping. With a lot of work a user's system--- can be set up to encode all the key combos in an almost-sane manner.------ == See also------ * http://www.leonerd.org.uk/hacks/fixterms/+-- | This module provides the input abstraction for Vty. module Graphics.Vty.Input-  ( Key(..)-  , Modifier(..)-  , Button(..)-  , Event(..)-  , Input(..)-  , inputForConfig+  ( Input(..)+  , module Graphics.Vty.Input.Events   ) where -import Graphics.Vty.Config import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Loop-import Graphics.Vty.Input.Terminfo--import Control.Concurrent.STM-import Lens.Micro--import qualified System.Console.Terminfo as Terminfo-import System.Posix.Signals.Exts--import Data.Monoid ((<>))+import Control.Concurrent.STM (TChan) --- | Set up the terminal with file descriptor `inputFd` for input.--- Returns an 'Input'.------ The table used to determine the 'Events' to produce for the input--- bytes comes from 'classifyMapForTerm' which is then overridden by--- the the applicable entries from the configuration's 'inputMap'.------ The terminal device is configured with the attributes:------ * IXON disabled: disables software flow control on outgoing data.--- This stops the process from being suspended if the output terminal--- cannot keep up.------ * Raw mode is used for input.------ * ISIG disabled (enables keyboard combinations that result in--- signals)------ * ECHO disabled (input is not echoed to the output)------ * ICANON disabled (canonical mode (line mode) input is not used)------ * IEXTEN disabled (extended functions are disabled)-inputForConfig :: Config -> IO Input-inputForConfig config@Config{ termName = Just termName-                            , inputFd = Just termFd-                            , vmin = Just _-                            , vtime = Just _-                            , .. } = do-    terminal <- Terminfo.setupTerm termName-    let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]-        activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides-    (setAttrs,unsetAttrs) <- attributeControl termFd-    setAttrs-    input <- initInput config activeInputMap-    let pokeIO = Catch $ do-            let e = error "vty internal failure: this value should not propagate to users"-            setAttrs-            atomically $ writeTChan (input^.eventChannel) (EvResize e e)-    _ <- installHandler windowChange pokeIO Nothing-    _ <- installHandler continueProcess pokeIO Nothing-    return $ input-        { shutdownInput = do-            shutdownInput input-            _ <- installHandler windowChange Ignore Nothing-            _ <- installHandler continueProcess Ignore Nothing-            unsetAttrs-        }-inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig+-- | The library's input-processing abstraction. Platform-specific+-- implementations must implement an 'Input' and provide it to+-- 'Graphics.Vty.mkVtyFromPair'.+data Input =+    Input { eventChannel :: TChan InternalEvent+          -- ^ A channel of events generated by input processing. The+          -- input implementation must write its input events to this+          -- channel; the Vty event loop will read from this channel+          -- and provide the events to the user's application via+          -- 'nextEvent'.+          , shutdownInput :: IO ()+          -- ^ Shut down the input processing. As part of shutting down+          -- the input, this should also restore the input state if+          -- appropriate.+          , restoreInputState :: IO ()+          -- ^ Restore the terminal's input state to what it was prior+          -- to configuring the input for Vty. This should be done as+          -- part of 'shutdownInput' but is exposed in case it needs to+          -- be used directly.+          , inputLogMsg :: String -> IO ()+          -- ^ Log the specified message.+          }
− src/Graphics/Vty/Input/Classify.hs 
@@ -1,84 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--- This makes a kind of tri. Has space efficiency issues with large--- input blocks. Likely building a parser and just applying that would--- be better.-module Graphics.Vty.Input.Classify-  ( classify-  , KClass(..)-  )-where--import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Mouse-import Graphics.Vty.Input.Paste-import Graphics.Vty.Input.Classify.Types--import Codec.Binary.UTF8.Generic (decode)--import Data.List (inits)-import qualified Data.Map as M( fromList, lookup )-import Data.Maybe ( mapMaybe )-import qualified Data.Set as S( fromList, member )--import Data.Char-import Data.Word--compile :: ClassifyMap -> [Char] -> KClass-compile table = cl' where-    -- take all prefixes and create a set of these-    prefixSet = S.fromList $ concatMap (init . inits . fst) $ table-    maxValidInputLength = maximum (map (length . fst) table)-    eventForInput = M.fromList table-    cl' [] = Prefix-    cl' inputBlock = case M.lookup inputBlock eventForInput of-            -- if the inputBlock is exactly what is expected for an-            -- event then consume the whole block and return the event-            Just e -> Valid e []-            Nothing -> case S.member inputBlock prefixSet of-                True -> Prefix-                -- look up progressively smaller tails of the input-                -- block until an event is found The assumption is that-                -- the event that consumes the most input bytes should-                -- be produced.-                -- The test verifyFullSynInputToEvent2x verifies this.-                -- H: There will always be one match. The prefixSet-                -- contains, by definition, all prefixes of an event.-                False ->-                    let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock-                    in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of-                        (s,e) : _ -> Valid e (drop (length s) inputBlock)-                        -- neither a prefix or a full event.-                        [] -> Invalid--classify :: ClassifyMap -> [Char] -> KClass-classify table =-    let standardClassifier = compile table-    in \s -> case s of-        _ | bracketedPasteStarted s ->-            if bracketedPasteFinished s-            then parseBracketedPaste s-            else Prefix-        _ | isMouseEvent s   -> classifyMouseEvent s-        c:cs | ord c >= 0xC2 -> classifyUtf8 c cs-        _                    -> standardClassifier s--classifyUtf8 :: Char -> [Char] -> KClass-classifyUtf8 c cs =-  let n = utf8Length (ord c)-      (codepoint,rest) = splitAt n (c:cs)--      codepoint8 :: [Word8]-      codepoint8 = map (fromIntegral . ord) codepoint--  in case decode codepoint8 of-       _ | n < length codepoint -> Prefix-       Just (unicodeChar, _)    -> Valid (EvKey (KChar unicodeChar) []) rest-       -- something bad happened; just ignore and continue.-       Nothing                  -> Invalid--utf8Length :: (Num t, Ord a, Num a) => a -> t-utf8Length c-    | c < 0x80 = 1-    | c < 0xE0 = 2-    | c < 0xF0 = 3-    | otherwise = 4
− src/Graphics/Vty/Input/Classify/Parse.hs 
@@ -1,58 +0,0 @@--- | This module provides a simple parser for parsing input event--- control sequences.-module Graphics.Vty.Input.Classify.Parse-  ( Parser-  , runParser-  , failParse-  , readInt-  , readChar-  , expectChar-  )-where--import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Classify.Types--import Control.Monad.Trans.Maybe-import Control.Monad.State--type Parser a = MaybeT (State String) a---- | Run a parser on a given input string. If the parser fails, return--- 'Invalid'. Otherwise return the valid event ('Valid') and the--- remaining unparsed characters.-runParser :: String -> Parser Event -> KClass-runParser s parser =-    case runState (runMaybeT parser) s of-        (Nothing, _)        -> Invalid-        (Just e, remaining) -> Valid e remaining---- | Fail a parsing operation.-failParse :: Parser a-failParse = fail "invalid parse"---- | Read an integer from the input stream. If an integer cannot be--- read, fail parsing. E.g. calling readInt on an input of "123abc" will--- return '123' and consume those characters.-readInt :: Parser Int-readInt = do-    s <- get-    case (reads :: ReadS Int) s of-        [(i, rest)] -> put rest >> return i-        _ -> failParse---- | Read a character from the input stream. If one cannot be read (e.g.--- we are out of characters), fail parsing.-readChar :: Parser Char-readChar = do-    s <- get-    case s of-        c:rest -> put rest >> return c-        _ -> failParse---- | Read a character from the input stream and fail parsing if it is--- not the specified character.-expectChar :: Char -> Parser ()-expectChar c = do-    c' <- readChar-    if c' == c then return () else failParse
− src/Graphics/Vty/Input/Classify/Types.hs 
@@ -1,19 +0,0 @@--- | This module exports the input classification type to avoid import--- cycles between other modules that need this.-module Graphics.Vty.Input.Classify.Types-  ( KClass(..)-  )-where--import Graphics.Vty.Input.Events--data KClass-    = Valid Event [Char]-    -- ^ A valid event was parsed. Any unused characters from the input-    -- stream are also provided.-    | Invalid-    -- ^ The input characters did not represent a valid event.-    | Prefix-    -- ^ The input characters form the prefix of a valid event character-    -- sequence.-    deriving(Show, Eq)
src/Graphics/Vty/Input/Events.hs view
@@ -1,6 +1,16 @@ {-# Language DeriveGeneric #-}-module Graphics.Vty.Input.Events where+{-# Language StrictData #-}+module Graphics.Vty.Input.Events+  ( Key(..)+  , Modifier(..)+  , Event(..)+  , Button(..)+  , ClassifyMap+  , InternalEvent(..)+  )+where +import Control.DeepSeq import Data.ByteString import GHC.Generics @@ -14,23 +24,38 @@ -- -- * Actually, support for most of these but KEsc, KChar, KBS, and -- KEnter vary by terminal and keyboard.-data Key = KEsc  | KChar Char | KBS | KEnter+data Key = KEsc  | KChar {-# UNPACK #-} Char | KBS | KEnter          | KLeft | KRight | KUp | KDown          | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter-         | KFun Int | KBackTab | KPrtScr | KPause | KIns+         | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns          | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu-    deriving (Eq,Show,Read,Ord,Generic)+    deriving (Eq, Show, Read, Ord, Generic) +instance NFData Key+ -- | Modifier keys. Key codes are interpreted such that users are more -- likely to have Meta than Alt; for instance on the PC Linux console, -- 'MMeta' will generally correspond to the physical Alt key. data Modifier = MShift | MCtrl | MMeta | MAlt-    deriving (Eq,Show,Read,Ord,Generic)+    deriving (Eq, Show, Read, Ord, Generic) +instance NFData Modifier+ -- | Mouse buttons.-data Button = BLeft | BMiddle | BRight-    deriving (Eq,Show,Read,Ord,Generic)+data Button+    = BLeft+    | BMiddle+    | BRight+    | BScrollUp+    | BScrollDown+    | BScrollLeft+    -- ^ Some terminals (e.g., Kitty, Alacritty) support horizontal+    -- scrolling in addition to vertical scrolling.+    | BScrollRight+    deriving (Eq, Show, Read, Ord, Generic) +instance NFData Button+ -- | Events. data Event     = EvKey Key [Modifier]@@ -44,10 +69,8 @@     -- without specifying which one; in that case, Nothing is provided.     -- Otherwise Just the button released is included in the event.     | EvResize Int Int-    -- ^ If read from 'eventChannel' this is the size at the time of the-    -- signal. If read from 'nextEvent' this is the size at the time the-    -- event was processed by Vty. Typically these are the same, but if-    -- somebody is resizing the terminal quickly they can be different.+    -- The terminal window was resized and the size is provided in the+    -- integer fields (width, height).     | EvPaste ByteString     -- ^ A paste event occurs when a bracketed paste input sequence is     -- received. For terminals that support bracketed paste mode, these@@ -56,6 +79,22 @@     -- input (which is probably bad, so beware!) Note that the data is     -- provided in raw form and you'll have to decode (e.g. as UTF-8) if     -- that's what your application expects.-    deriving (Eq,Show,Read,Ord,Generic)+    | EvLostFocus+    -- ^ The terminal running the application lost input focus.+    | EvGainedFocus+    -- ^ The terminal running the application gained input focus.+    deriving (Eq, Show, Read, Ord, Generic) +instance NFData Event+ type ClassifyMap = [(String,Event)]++-- | The type of internal events that drive the internal Vty event+-- dispatching to the application.+data InternalEvent =+    ResumeAfterInterrupt+    -- ^ Vty resumed operation after the process was interrupted (e.g.+    -- with a signal). In practice this translates into a screen redraw+    -- in the input event loop.+    | InputEvent Event+    -- ^ An input event was received.
− src/Graphics/Vty/Input/Loop.hs 
@@ -1,229 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE CPP #-}--- | The input layer used to be a single function that correctly--- accounted for the non-threaded runtime by emulating the terminal--- VMIN adn VTIME handling. This has been removed and replace with a--- more straightforward parser. The non-threaded runtime is no longer--- supported.------ This is an example of an algorithm where code coverage could be high,--- even 100%, but the behavior is still under tested. I should collect--- more of these examples...------ reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html-module Graphics.Vty.Input.Loop where--import Graphics.Vty.Config-import Graphics.Vty.Input.Classify-import Graphics.Vty.Input.Events--import Control.Applicative-import Control.Concurrent-import Control.Concurrent.STM-import Control.Exception (mask, try, SomeException)-import Lens.Micro-import Lens.Micro.Mtl-import Lens.Micro.TH-import Control.Monad (when, mzero, forM_)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.State (StateT(..), evalStateT)-import Control.Monad.State.Class (MonadState, modify)-import Control.Monad.Trans.Reader (ReaderT(..))--import Data.Char-import Data.IORef-import Data.Word (Word8)--import Foreign ( allocaArray, peekArray, Ptr )-import Foreign.C.Types (CInt(..))--import System.IO-import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))-import System.Posix.Terminal-import System.Posix.Types (Fd(..))--import Text.Printf (hPrintf)--data Input = Input-    { -- | Channel of events direct from input processing. Unlike-      -- 'nextEvent' this will not refresh the display if the next event-      -- is an 'EvResize'.-      _eventChannel  :: TChan Event-      -- | Shuts down the input processing. This should return the-      -- terminal input state to before he input initialized.-    , shutdownInput :: IO ()-      -- | Changes to this value are reflected after the next event.-    , _configRef :: IORef Config-      -- | input debug log-    , _inputDebug :: Maybe Handle-    }--makeLenses ''Input--data InputBuffer = InputBuffer-    { _ptr :: Ptr Word8-    , _size :: Int-    }--makeLenses ''InputBuffer--data InputState = InputState-    { _unprocessedBytes :: String-    , _appliedConfig :: Config-    , _inputBuffer :: InputBuffer-    , _classifier :: String -> KClass-    }--makeLenses ''InputState--type InputM a = StateT InputState (ReaderT Input IO) a--logMsg :: String -> InputM ()-logMsg msg = do-    d <- view inputDebug-    case d of-        Nothing -> return ()-        Just h -> liftIO $ hPutStrLn h msg >> hFlush h---- this must be run on an OS thread dedicated to this input handling.--- otherwise the terminal timing read behavior will block the execution--- of the lightweight threads.-loopInputProcessor :: InputM ()-loopInputProcessor = do-    readFromDevice >>= addBytesToProcess-    validEvents <- many parseEvent-    forM_ validEvents emit-    dropInvalid-    loopInputProcessor--addBytesToProcess :: String -> InputM ()-addBytesToProcess block = unprocessedBytes <>= block--emit :: Event -> InputM ()-emit event = do-    logMsg $ "parsed event: " ++ show event-    view eventChannel >>= liftIO . atomically . flip writeTChan event---- The timing requirements are assured by the VMIN and VTIME set for the--- device.------ Precondition: Under the threaded runtime. Only current use is from a--- forkOS thread. That case satisfies precondition.-readFromDevice :: InputM String-readFromDevice = do-    newConfig <- view configRef >>= liftIO . readIORef-    oldConfig <- use appliedConfig-    let Just fd = inputFd newConfig-    when (newConfig /= oldConfig) $ do-        logMsg $ "new config: " ++ show newConfig-        liftIO $ applyConfig fd newConfig-        appliedConfig .= newConfig-    bufferPtr <- use $ inputBuffer.ptr-    maxBytes  <- use $ inputBuffer.size-    stringRep <- liftIO $ do-        -- The killThread used in shutdownInput will not interrupt the-        -- foreign call fdReadBuf uses this provides a location to be-        -- interrupted prior to the foreign call. If there is input on-        -- the FD then the fdReadBuf will return in a finite amount of-        -- time due to the vtime terminal setting.-        threadWaitRead fd-        bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)-        if bytesRead > 0-        then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr-        else return []-    when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep-    return stringRep--applyConfig :: Fd -> Config -> IO ()-applyConfig fd (Config{ vmin = Just theVmin, vtime = Just theVtime })-    = setTermTiming fd theVmin (theVtime `div` 100)-applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configuration"--parseEvent :: InputM Event-parseEvent = do-    c <- use classifier-    b <- use unprocessedBytes-    case c b of-        Valid e remaining -> do-            logMsg $ "valid parse: " ++ show e-            logMsg $ "remaining: " ++ show remaining-            unprocessedBytes .= remaining-            return e-        _                   -> mzero--dropInvalid :: InputM ()-dropInvalid = do-    c <- use classifier-    b <- use unprocessedBytes-    when (c b == Invalid) $ do-        logMsg "dropping input bytes"-        unprocessedBytes .= []--runInputProcessorLoop :: ClassifyMap -> Input -> IO ()-runInputProcessorLoop classifyTable input = do-    let bufferSize = 1024-    allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do-        s0 <- InputState [] <$> readIORef (_configRef input)-                            <*> pure (InputBuffer bufferPtr bufferSize)-                            <*> pure (classify classifyTable)-        runReaderT (evalStateT loopInputProcessor s0) input--attributeControl :: Fd -> IO (IO (), IO ())-attributeControl fd = do-    original <- getTerminalAttributes fd-    let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts-                                             , EnableEcho, ProcessInput, ExtendedFunctions-                                             ]-    let setAttrs = setTerminalAttributes fd vtyMode Immediately-        unsetAttrs = setTerminalAttributes fd original Immediately-    return (setAttrs,unsetAttrs)--logInitialInputState :: Input -> ClassifyMap -> IO()-logInitialInputState input classifyTable = case _inputDebug input of-    Nothing -> return ()-    Just h  -> do-        Config{ vmin = Just theVmin-              , vtime = Just theVtime-              , termName = Just theTerm, .. } <- readIORef $ _configRef input-        _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))-        forM_ classifyTable $ \i -> case i of-            (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)-                                                                     (show inBytes)-                                                                     (show k)-                                                                     (show mods)-            _ -> return ()--initInput :: Config -> ClassifyMap -> IO Input-initInput config classifyTable = do-    let Just fd = inputFd config-    setFdOption fd NonBlockingRead False-    applyConfig fd config-    stopSync <- newEmptyMVar-    input <- Input <$> atomically newTChan-                   <*> pure (return ())-                   <*> newIORef config-                   <*> maybe (return Nothing)-                             (\f -> Just <$> openFile f AppendMode)-                             (debugLog config)-    logInitialInputState input classifyTable-    inputThread <- forkOSFinally (runInputProcessorLoop classifyTable input)-                                 (\_ -> putMVar stopSync ())-    let killAndWait = do-          killThread inputThread-          takeMVar stopSync-    return $ input { shutdownInput = killAndWait }--foreign import ccall "vty_set_term_timing" setTermTiming :: Fd -> Int -> Int -> IO ()--forkOSFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId-forkOSFinally action and_then =-  mask $ \restore -> forkOS $ try (restore action) >>= and_then--(<>=) :: (MonadState s m, Monoid a) => ASetter' s a -> a -> m ()-l <>= a = modify (l <>~ a)--(<>~) :: Monoid a => ASetter s t a a -> a -> s -> t-l <>~ n = over l (`mappend` n)
− src/Graphics/Vty/Input/Mouse.hs 
@@ -1,153 +0,0 @@--- | This module provides parsers for mouse events for both "normal" and--- "extended" modes. This implementation was informed by------ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking-module Graphics.Vty.Input.Mouse-  ( requestMouseEvents-  , disableMouseEvents-  , isMouseEvent-  , classifyMouseEvent-  )-where--import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Classify.Types-import Graphics.Vty.Input.Classify.Parse--import Control.Monad.State-import Data.List (isPrefixOf)-import Data.Maybe (catMaybes)-import Data.Bits ((.&.))---- A mouse event in SGR extended mode is------ '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')------ where------ * B is the number with button and modifier bits set,--- * X is the X coordinate of the event starting at 1--- * Y is the Y coordinate of the event starting at 1--- * the final character is 'M' for a press, 'm' for a release---- | These sequences set xterm-based terminals to send mouse event--- sequences.-requestMouseEvents :: String-requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h\ESC[?1005h"---- | These sequences disable mouse events.-disableMouseEvents :: String-disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l\ESC[?1005l"---- | Does the specified string begin with a mouse event?-isMouseEvent :: String -> Bool-isMouseEvent s = isSGREvent s || isNormalEvent s--isSGREvent :: String -> Bool-isSGREvent = isPrefixOf sgrPrefix--sgrPrefix :: String-sgrPrefix = "\ESC[M"--isNormalEvent :: String -> Bool-isNormalEvent = isPrefixOf normalPrefix--normalPrefix :: String-normalPrefix = "\ESC[<"---- Modifier bits:-shiftBit :: Int-shiftBit = 4--metaBit :: Int-metaBit = 8--ctrlBit :: Int-ctrlBit = 16---- These bits indicate the buttons involved:-buttonMask :: Int-buttonMask = 3--leftButton :: Int-leftButton = 0--middleButton :: Int-middleButton = 1--rightButton :: Int-rightButton = 2--hasBitSet :: Int -> Int -> Bool-hasBitSet val bit = val .&. bit > 0---- | Attempt to lassify an input string as a mouse event.-classifyMouseEvent :: String -> KClass-classifyMouseEvent s = runParser s $ do-    when (not $ isMouseEvent s) failParse--    expectChar '\ESC'-    expectChar '['-    ty <- readChar-    case ty of-        '<' -> classifySGRMouseEvent-        'M' -> classifyNormalMouseEvent-        _   -> failParse---- Given a modifer/button value, determine which button was indicated-getSGRButton :: Int -> Parser Button-getSGRButton mods =-    let buttonMap = [ (leftButton,   BLeft)-                    , (middleButton, BMiddle)-                    , (rightButton,  BRight)-                    ]-    in case lookup (mods .&. buttonMask) buttonMap of-        Nothing -> failParse-        Just b -> return b--getModifiers :: Int -> [Modifier]-getModifiers mods =-    catMaybes [ if mods `hasBitSet` shiftBit then Just MShift else Nothing-              , if mods `hasBitSet` metaBit  then Just MMeta  else Nothing-              , if mods `hasBitSet` ctrlBit  then Just MCtrl  else Nothing-              ]---- Attempt to classify a control sequence as a "normal" mouse event. To--- get here we should have already read "\ESC[M" so that will not be--- included in the string to be parsed.-classifyNormalMouseEvent :: Parser Event-classifyNormalMouseEvent = do-    statusChar <- readChar-    xCoordChar <- readChar-    yCoordChar <- readChar--    let xCoord = fromEnum xCoordChar - 32-        yCoord = fromEnum yCoordChar - 32-        status = fromEnum statusChar-        modifiers = getModifiers status--    let press = status .&. buttonMask /= 3-    case press of-            True -> do-                button <- getSGRButton status-                return $ EvMouseDown (xCoord-1) (yCoord-1) button modifiers-            False -> return $ EvMouseUp (xCoord-1) (yCoord-1) Nothing---- Attempt to classify a control sequence as an SGR mouse event. To--- get here we should have already read "\ESC[<" so that will not be--- included in the string to be parsed.-classifySGRMouseEvent :: Parser Event-classifySGRMouseEvent = do-    mods <- readInt-    expectChar ';'-    xCoord <- readInt-    expectChar ';'-    yCoord <- readInt-    final <- readChar--    let modifiers = getModifiers mods-    button <- getSGRButton mods-    case final of-        'M' -> return $ EvMouseDown (xCoord-1) (yCoord-1) button modifiers-        'm' -> return $ EvMouseUp   (xCoord-1) (yCoord-1) (Just button)-        _ -> failParse
− src/Graphics/Vty/Input/Paste.hs 
@@ -1,49 +0,0 @@--- | This module provides bracketed paste support as described at------ http://cirw.in/blog/bracketed-paste-module Graphics.Vty.Input.Paste-  ( parseBracketedPaste-  , bracketedPasteStarted-  , bracketedPasteFinished-  )-where--import qualified Data.ByteString.Char8 as BS8--import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Classify.Types--import Data.List (isPrefixOf, isInfixOf)--bracketedPasteStart :: String-bracketedPasteStart = "\ESC[200~"--bracketedPasteEnd :: String-bracketedPasteEnd = "\ESC[201~"---- | Does the input start a bracketed paste?-bracketedPasteStarted :: String -> Bool-bracketedPasteStarted = isPrefixOf bracketedPasteStart---- | Does the input contain a complete bracketed paste?-bracketedPasteFinished :: String -> Bool-bracketedPasteFinished = isInfixOf bracketedPasteEnd---- | Parse a bracketed paste. This should only be called on a string if--- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return--- 'True'.-parseBracketedPaste :: String -> KClass-parseBracketedPaste s =-    let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd-        rest' = if bracketedPasteEnd `isPrefixOf` rest-                then drop (length bracketedPasteEnd) rest-                else rest-    in Valid (EvPaste $ BS8.pack p) rest'--takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])-takeUntil [] _ = ([], [])-takeUntil cs sub-  | length cs < length sub      = (cs, [])-  | take (length sub) cs == sub = ([], drop (length sub) cs)-  | otherwise                   = let (pre, suf) = takeUntil (tail cs) sub-                                  in (head cs:pre, suf)
− src/Graphics/Vty/Input/Terminfo.hs 
@@ -1,184 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-module Graphics.Vty.Input.Terminfo where--import Graphics.Vty.Input.Events-import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT--import Control.Arrow-import System.Console.Terminfo---- | Queries the terminal for all capability-based input sequences and--- then adds on a terminal-dependent input sequence mapping.------ For reference see:------ * http://vimdoc.sourceforge.net/htmldoc/term.html------ * vim74/src/term.c------ * http://invisible-island.net/vttest/------ * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html------ Terminfo is incomplete. The vim source implies that terminfo is also--- incorrect. Vty assumes that the internal terminfo table added to the--- system-provided terminfo table is correct.------ The procedure used here is:------ 1. Build terminfo table for all caps. Missing caps are not added.------ 2. Add tables for visible chars, esc, del, ctrl, and meta.------ 3. Add internally-defined table for given terminal type.------ Precedence is currently implicit in the 'compile' algorithm.-classifyMapForTerm :: String -> Terminal -> ClassifyMap-classifyMapForTerm termName term =-    concat $ capsClassifyMap term keysFromCapsTable-           : universalTable-           : termSpecificTables termName---- | The key table applicable to all terminals.------ Note that some of these entries are probably only applicable to--- ANSI/VT100 terminals.-universalTable :: ClassifyMap-universalTable = concat [visibleChars, ctrlChars, ctrlMetaChars, specialSupportKeys]--capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap-capsClassifyMap terminal table = [(x,y) | (Just x,y) <- map extractCap table]-    where extractCap = first (getCapability terminal . tiGetStr)---- | Tables specific to a given terminal that are not derivable from--- terminfo.------ Note that this adds the ANSI/VT100/VT50 tables regardless of term--- identifier.-termSpecificTables :: String -> [ClassifyMap]-termSpecificTables _termName = ANSIVT.classifyTable---- | Visible characters in the ISO-8859-1 and UTF-8 common set.------ We limit to < 0xC1. The UTF8 sequence detector will catch all values--- 0xC2 and above before this classify table is reached.-visibleChars :: ClassifyMap-visibleChars = [ ([x], EvKey (KChar x) [])-               | x <- [' ' .. toEnum 0xC1]-               ]---- | Non-printable characters in the ISO-8859-1 and UTF-8 common set--- translated to ctrl + char.------ This treats CTRL-i the same as tab.-ctrlChars :: ClassifyMap-ctrlChars =-    [ ([toEnum x],EvKey (KChar y) [MCtrl])-    | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])-    , y /= 'i'  -- Resolve issue #3 where CTRL-i hides TAB.-    , y /= 'h'  -- CTRL-h should not hide BS-    ]---- | Ctrl+Meta+Char-ctrlMetaChars :: ClassifyMap-ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars---- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.-specialSupportKeys :: ClassifyMap-specialSupportKeys =-    [ -- special support for ESC-      ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])-    -- Special support for backspace-    , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])-    -- Special support for Enter-    , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])-    -- explicit support for tab-    , ("\t", EvKey (KChar '\t') [])-    ]---- | A classification table directly generated from terminfo cap--- strings.  These are:------ * ka1 - keypad up-left------ * ka3 - keypad up-right------ * kb2 - keypad center------ * kbs - keypad backspace------ * kbeg - begin------ * kcbt - back tab------ * kc1 - keypad left-down------ * kc3 - keypad right-down------ * kdch1 - delete------ * kcud1 - down------ * kend - end------ * kent - enter------ * kf0 - kf63 - function keys------ * khome - KHome------ * kich1 - insert------ * kcub1 - left------ * knp - next page (page down)------ * kpp - previous page (page up)------ * kcuf1 - right------ * kDC - shift delete------ * kEND - shift end------ * kHOM - shift home------ * kIC - shift insert------ * kLFT - shift left------ * kRIT - shift right------ * kcuu1 - up-keysFromCapsTable :: ClassifyMap-keysFromCapsTable =-    [ ("ka1",   EvKey KUpLeft    [])-    , ("ka3",   EvKey KUpRight   [])-    , ("kb2",   EvKey KCenter    [])-    , ("kbs",   EvKey KBS        [])-    , ("kbeg",  EvKey KBegin     [])-    , ("kcbt",  EvKey KBackTab   [])-    , ("kc1",   EvKey KDownLeft  [])-    , ("kc3",   EvKey KDownRight [])-    , ("kdch1", EvKey KDel       [])-    , ("kcud1", EvKey KDown      [])-    , ("kend",  EvKey KEnd       [])-    , ("kent",  EvKey KEnter     [])-    , ("khome", EvKey KHome      [])-    , ("kich1", EvKey KIns       [])-    , ("kcub1", EvKey KLeft      [])-    , ("knp",   EvKey KPageDown  [])-    , ("kpp",   EvKey KPageUp    [])-    , ("kcuf1", EvKey KRight     [])-    , ("kDC",   EvKey KDel       [MShift])-    , ("kEND",  EvKey KEnd       [MShift])-    , ("kHOM",  EvKey KHome      [MShift])-    , ("kIC",   EvKey KIns       [MShift])-    , ("kLFT",  EvKey KLeft      [MShift])-    , ("kRIT",  EvKey KRight     [MShift])-    , ("kcuu1", EvKey KUp        [])-    ] ++ functionKeyCapsTable---- | Cap names for function keys.-functionKeyCapsTable :: ClassifyMap-functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])
− src/Graphics/Vty/Input/Terminfo/ANSIVT.hs 
@@ -1,88 +0,0 @@--- | Input mappings for ANSI/VT100/VT50 terminals that is missing from--- terminfo.------ Or that are sent regardless of terminfo by terminal emulators. EG:--- Terminal emulators will often use VT50 input bytes regardless of--- declared terminal type. This provides compatibility with programs--- that don't follow terminfo.-module Graphics.Vty.Input.Terminfo.ANSIVT where--import Graphics.Vty.Input.Events---- | Encoding for navigation keys.-navKeys0 :: ClassifyMap-navKeys0 =-    [ k "G" KCenter-    , k "P" KPause-    , k "A" KUp-    , k "B" KDown-    , k "C" KRight-    , k "D" KLeft-    , k "H" KHome-    , k "F" KEnd-    , k "E" KBegin-    ]-    where k c s = ("\ESC["++c,EvKey s [])---- | encoding for shift, meta and ctrl plus arrows/home/end-navKeys1 :: ClassifyMap-navKeys1 =-   [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)-    | charCnt <- ["1;", ""], -- we can have a count or not-    (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),-               -- modifiers and their codes-               ([MShift, MCtrl],6), ([MShift, MMeta],4)],-    -- directions and their codes-    (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)]-   ]---- | encoding for ins, del, pageup, pagedown, home, end-navKeys2 :: ClassifyMap-navKeys2 =-    let k n s = ("\ESC["++show n++"~",EvKey s [])-    in zipWith k [2::Int,3,5,6,1,4]-                 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]---- | encoding for ctrl + ins, del, pageup, pagedown, home, end-navKeys3 :: ClassifyMap-navKeys3 =-    let k n s = ("\ESC["++show n++";5~",EvKey s [MCtrl])-    in zipWith k [2::Int,3,5,6,1,4]-                 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]---- | encoding for shift plus function keys------ According to------  * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html------ This encoding depends on the terminal.-functionKeys1 :: ClassifyMap-functionKeys1 =-    let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in-    concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]---- | encoding for meta plus char------ 1. removed 'ESC' from second list due to duplication with--- "special_support_keys".--- 2. removed '[' from second list due to conflict with 7-bit encoding--- for ESC. Whether meta+[ is the same as ESC should examine km and--- current encoding.--- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped--- to KBS by special_support_keys.-functionKeys2 :: ClassifyMap-functionKeys2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])-                  | x <- '\t':[' ' .. '~']-                  , x /= '['-                  ]--classifyTable :: [ClassifyMap]-classifyTable =-    [ navKeys0-    , navKeys1-    , navKeys2-    , navKeys3-    , functionKeys1-    , functionKeys2-    ]
src/Graphics/Vty/Output.hs view
@@ -1,106 +1,367 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NamedFieldPuns #-}--- | This module provides functions for accessing the current terminal--- or a specific terminal device.------ See also:------ 1. "Graphics.Vty.Output": This instantiates an abtract interface--- to the terminal based on the @TERM@ and @COLORTERM@ environment--- variables.------ 2. "Graphics.Vty.Output.Interface": Defines the generic interface all--- terminal modules need to implement.------ 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance--- that uses terminfo for all control strings. No attempt is made to--- change the character set to UTF-8 for these terminals.------ 4. "Graphics.Vty.Output.XTermColor": This module contains an--- interface suitable for xterm-like terminals. These are the terminals--- where @TERM@ begins with @xterm@. This does use terminfo for as many--- control codes as possible.+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards, CPP #-}+-- | This module provides an abstract interface for performing terminal+-- output and functions for accessing the current terminal or a specific+-- terminal device. module Graphics.Vty.Output-  ( outputForConfig+  ( Output(..)+  , AssumedState(..)+  , DisplayContext(..)+  , Mode(..)+  , displayContext+  , outputPicture+  , initialAssumedState+  , limitAttrForDisplay   , setCursorPos   , hideCursor   , showCursor   ) where +import Blaze.ByteString.Builder (Write, writeToByteString)+import Blaze.ByteString.Builder.ByteString (writeByteString) import Control.Monad (when)--import Graphics.Vty.Config-import Graphics.Vty.Image (regionWidth, regionHeight)-import Graphics.Vty.Output.Interface-import Graphics.Vty.Output.XTermColor as XTermColor-import Graphics.Vty.Output.TerminfoBased as TerminfoBased--import Blaze.ByteString.Builder (writeToByteString)--import Control.Monad.Trans--import Data.List (isPrefixOf)+import qualified Data.ByteString as BS+import Data.IORef+import qualified Data.Vector as Vector+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))---- | Returns an `Output` for the terminal specified in `Config`.------ The specific Output implementation used is hidden from the API user.--- All terminal implementations are assumed to perform more, or less,--- the same. Currently, all implementations use terminfo for at least--- some terminal specific information.------ If a terminal implementation is developed for a terminal without--- terminfo support then Vty should work as expected on that terminal.------ Selection of a terminal is done as follows:------      * If TERM contains "xterm" or "screen", use XTermColor.---      * otherwise use the TerminfoBased driver.-outputForConfig :: Config -> IO Output-outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do-    t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName-        then XTermColor.reserveTerminal termName fd-        -- Not an xterm-like terminal. try for generic terminfo.-        else TerminfoBased.reserveTerminal termName fd+#endif+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL -    case mouseMode of-        Just s -> setMode t Mouse s-        Nothing -> return ()+import Graphics.Vty.Attributes+import Graphics.Vty.DisplayAttributes+import Graphics.Vty.Image (DisplayRegion, regionWidth, regionHeight)+import Graphics.Vty.Picture+import Graphics.Vty.PictureToSpans+import Graphics.Vty.Span -    case bracketedPasteMode of-        Just s -> setMode t BracketedPaste s-        Nothing -> return ()+-- | Modal terminal features that can be enabled and disabled.+data Mode = Mouse+          -- ^ Mouse mode (whether the terminal is configured to provide+          -- mouse input events)+          | BracketedPaste+          -- ^ Paste mode (whether the terminal is configured to provide+          -- events on OS pastes)+          | Focus+          -- ^ Focus-in/focus-out events (whether the terminal is+          -- configured to provide events on focus change)+          | Hyperlink+          -- ^ Hyperlink mode via the 'withURL' attribute modifier (see+          -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).+          -- Note that this may not work gracefully in all terminal+          -- emulators so be sure to test this mode with the terminals+          -- you intend to support. It is off by default.+          deriving (Eq, Read, Show) -    return t-outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig+-- | The library's device output abstraction. Platform-specific+-- implementations must implement an 'Output' and provide it to+-- 'Graphics.Vty.mkVtyFromPair'.+data Output = Output+    { -- | Text identifier for the output device. Used for debugging.+      terminalID :: String+      -- | Release the terminal just prior to application exit and reset+      -- it to its state prior to application startup.+    , releaseTerminal :: IO ()+      -- | Clear the display and initialize the terminal to some initial+      -- display state.+      --+      -- The expectation of a program is that the display starts in some+      -- The initial state. initial state would consist of fixed values:+      --+      --  - cursor at top left+      --  - UTF-8 character encoding+      --  - drawing characteristics are the default+    , reserveDisplay :: IO ()+      -- | Return the display to the state before `reserveDisplay` If no+      -- previous state then set the display state to the initial state.+    , releaseDisplay :: IO ()+      -- | Sets the current display bounds (width, height).+    , setDisplayBounds :: (Int, Int) -> IO ()+      -- | Returns the current display bounds.+    , displayBounds :: IO DisplayRegion+      -- | Output the bytestring to the terminal device.+    , outputByteBuffer :: BS.ByteString -> IO ()+      -- | Specifies whether the cursor can be shown / hidden.+    , supportsCursorVisibility :: Bool+      -- | Indicates support for terminal modes for this output device.+    , supportsMode :: Mode -> Bool+      -- | Enables or disables a mode (does nothing if the mode is+      -- unsupported).+    , setMode :: Mode -> Bool -> IO ()+      -- | Returns whether a mode is enabled.+    , getModeStatus :: Mode -> IO Bool+    , assumedStateRef :: IORef AssumedState+      -- | Acquire display access to the given region of the display.+      -- Currently all regions have the upper left corner of (0,0) and+      -- the lower right corner at (max displayWidth providedWidth, max+      -- displayHeight providedHeight)+    , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext+      -- | Ring the terminal bell if supported.+    , ringTerminalBell :: IO ()+      -- | Returns whether the terminal has an audio bell feature.+    , supportsBell :: IO Bool+      -- | Returns whether the terminal supports italicized text.+      --+      -- This is terminal-dependent and should make a best effort to+      -- determine whether this feature is supported, but even if the+      -- terminal advertises support (e.g. via terminfo) that might not+      -- be a reliable indicator of whether the feature will work as+      -- desired.+    , supportsItalics :: IO Bool+      -- | Returns whether the terminal supports strikethrough text.+      --+      -- This is terminal-dependent and should make a best effort to+      -- determine whether this feature is supported, but even if the+      -- terminal advertises support (e.g. via terminfo) that might not+      -- be a reliable indicator of whether the feature will work as+      -- desired.+    , supportsStrikethrough :: IO Bool+      -- | Returns how many colors the terminal supports.+    , outputColorMode :: ColorMode+      -- | Set the output's window title, if any.+    , setOutputWindowTitle :: String -> IO ()+    }  -- | Sets the cursor position to the given output column and row. ----- This is not necessarially the same as the character position with the+-- This is not necessarily the same as the character position with the -- same coordinates. Characters can be a variable number of columns in -- width. -- -- Currently, the only way to set the cursor position to a given -- character coordinate is to specify the coordinate in the Picture -- instance provided to 'outputPicture' or 'refresh'.-setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()+setCursorPos :: Output -> Int -> Int -> IO () setCursorPos t x y = do     bounds <- displayBounds t     when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do         dc <- displayContext t bounds-        liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y+        outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y  -- | Hides the cursor.-hideCursor :: MonadIO m => Output -> m ()+hideCursor :: Output -> IO () hideCursor t = do     bounds <- displayBounds t     dc <- displayContext t bounds-    liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc+    outputByteBuffer t $ writeToByteString $ writeHideCursor dc  -- | Shows the cursor.-showCursor :: MonadIO m => Output -> m ()+showCursor :: Output -> IO () showCursor t = do     bounds <- displayBounds t     dc <- displayContext t bounds-    liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc+    outputByteBuffer t $ writeToByteString $ writeShowCursor dc++displayContext :: Output -> DisplayRegion -> IO DisplayContext+displayContext t = mkDisplayContext t t++data AssumedState = AssumedState+    { prevFattr :: Maybe FixedAttr+    , prevOutputOps :: Maybe DisplayOps+    }++initialAssumedState :: AssumedState+initialAssumedState = AssumedState Nothing Nothing++data DisplayContext = DisplayContext+    { contextDevice :: Output+    -- | Provide the bounds of the display context.+    , contextRegion :: DisplayRegion+    -- | Sets the output position to the specified row and column+    -- where the number of bytes required for the control codes can be+    -- specified seperate from the actual byte sequence.+    , writeMoveCursor :: Int -> Int -> Write+    , writeShowCursor :: Write+    , writeHideCursor :: Write+    -- Ensure that the specified output attributes will be applied to+    -- all the following text until the next output attribute change+    -- where the number of bytes required for the control codes can be+    -- specified seperately from the actual byte sequence. The required+    -- number of bytes must be at least the maximum number of bytes+    -- required by any attribute changes. The serialization equations+    -- must provide the ptr to the next byte to be specified in the+    -- output buffer.+    --+    -- The currently applied display attributes are provided as well.+    -- The Attr data type can specify the style or color should not be+    -- changed from the currently applied display attributes. In order+    -- to support this the currently applied display attributes are+    -- required. In addition it may be possible to optimize the state+    -- changes based off the currently applied display attributes.+    , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write+    -- | Reset the display attributes to the default display attributes.+    , writeDefaultAttr :: Bool -> Write+    , writeRowEnd :: Write+    -- | See `Graphics.Vty.Output.XTermColor.inlineHack`+    , inlineHack :: IO ()+    }++-- | All terminals serialize UTF8 text to the terminal device exactly as+-- serialized in memory.+writeUtf8Text  :: BS.ByteString -> Write+writeUtf8Text = writeByteString++-- | Displays the given `Picture`.+--+--      1. The image is cropped to the display size.+--+--      2. Converted into a sequence of attribute changes and text spans.+--+--      3. The cursor is hidden.+--+--      4. Serialized to the display.+--+--      5. The cursor is then shown and positioned or kept hidden.+outputPicture :: DisplayContext -> Picture -> IO ()+outputPicture dc pic = do+    urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink+    as <- readIORef (assumedStateRef $ contextDevice dc)+    let manipCursor = supportsCursorVisibility (contextDevice dc)+        r = contextRegion dc+        ops = displayOpsForPic pic r+        initialAttr = FixedAttr defaultStyleMask Nothing Nothing Nothing+        -- Diff the previous output against the requested output.+        -- Differences are currently on a per-row basis.+        diffs :: [Bool] = case prevOutputOps as of+            Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True+            Just previousOps -> if affectedRegion previousOps /= affectedRegion ops+                then replicate (displayOpsRows ops) True+                else Vector.toList $ Vector.zipWith (/=) previousOps ops+        -- build the Write corresponding to the output image+        out = (if manipCursor then writeHideCursor dc else mempty)+              `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops+              `mappend`+                (let (w,h) = contextRegion dc+                     clampX = max 0 . min (w-1)+                     clampY = max 0 . min (h-1) in+                 case picCursor pic of+                    _ | not manipCursor -> mempty+                    NoCursor            -> mempty+                    AbsoluteCursor x y ->+                        writeShowCursor dc `mappend`+                        writeMoveCursor dc (clampX x) (clampY y)+                    PositionOnly isAbs x y ->+                        if isAbs+                           then writeMoveCursor dc (clampX x) (clampY y)+                           else let (ox, oy) = charToOutputPos m (clampX x, clampY y)+                                    m = cursorOutputMap ops $ picCursor pic+                                in writeMoveCursor dc (clampX ox) (clampY oy)+                    Cursor x y           ->+                        let m = cursorOutputMap ops $ picCursor pic+                            (ox, oy) = charToOutputPos m (clampX x, clampY y)+                        in writeShowCursor dc `mappend`+                           writeMoveCursor dc (clampX ox) (clampY oy)+                )+    -- ... then serialize+    outputByteBuffer (contextDevice dc) (writeToByteString out)+    -- Cache the output spans.+    let as' = as { prevOutputOps = Just ops }+    writeIORef (assumedStateRef $ contextDevice dc) as'++writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write+writeOutputOps urlsEnabled dc initialAttr diffs ops =+    let (_, out, _) = Vector.foldl' writeOutputOps'+                                       (0, mempty, diffs)+                                       ops+    in out+    where+        writeOutputOps' (y, out, True : diffs') spanOps+            = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps+                  out' = out `mappend` spanOut+              in (y+1, out', diffs')+        writeOutputOps' (y, out, False : diffs') _spanOps+            = (y + 1, out, diffs')+        writeOutputOps' (_y, _out, []) _spanOps+            = error "vty - output spans without a corresponding diff."++writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write+writeSpanOps urlsEnabled dc y initialAttr spanOps =+    -- The first operation is to set the cursor to the start of the row+    let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled+    -- then the span ops are serialized in the order specified+    in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of+                              (opOut, fattr') -> (out `mappend` opOut, fattr')+                           )+                           (start, initialAttr)+                           spanOps++writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)+writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr =+    let attr' = limitAttrForDisplay (contextDevice dc) attr+        fattr' = fixDisplayAttr fattr attr'+        diffs = displayAttrDiffs fattr fattr'+        out =  writeSetAttr dc urlsEnabled fattr attr' diffs+               `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)+    in (out, fattr')+writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip"+writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `mappend` writeRowEnd dc, fattr)++-- | The cursor position is given in X,Y character offsets. Due to+-- multi-column characters this needs to be translated to column, row+-- positions.+data CursorOutputMap = CursorOutputMap+    { charToOutputPos :: (Int, Int) -> (Int, Int)+    }++cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap+cursorOutputMap spanOps _cursor = CursorOutputMap+    { charToOutputPos = \(cx, cy) -> (cursorColumnOffset spanOps cx cy, cy)+    }++cursorColumnOffset :: DisplayOps -> Int -> Int -> Int+cursorColumnOffset ops cx cy =+    let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy)+        (outOffset, _, _)+            = Vector.foldl' ( \(d, currentCx, done) op ->+                        if done then (d, currentCx, done) else case spanOpHasWidth op of+                            Nothing -> (d, currentCx, False)+                            Just (cw, ow) -> case compare cx (currentCx + cw) of+                                    GT -> ( d + ow+                                          , currentCx + cw+                                          , False+                                          )+                                    EQ -> ( d + ow+                                          , currentCx + cw+                                          , True+                                          )+                                    LT -> ( d + columnsToCharOffset (cx - currentCx) op+                                          , currentCx + cw+                                          , True+                                          )+                      )+                      (0, 0, False)+                      cursorRowOps+    in outOffset++-- | Not all terminals support all display attributes. This filters a+-- display attribute to what the given terminal can display.+limitAttrForDisplay :: Output -> Attr -> Attr+limitAttrForDisplay t attr+    = attr { attrForeColor = clampColor $ attrForeColor attr+           , attrBackColor = clampColor $ attrBackColor attr+           }+    where+        clampColor Default     = Default+        clampColor KeepCurrent = KeepCurrent+        clampColor (SetTo c)   = clampColor' (outputColorMode t) c++        clampColor' NoColor _ = Default++        clampColor' ColorMode8 (ISOColor v)+            | v >= 8    = SetTo $ ISOColor (v - 8)+            | otherwise = SetTo $ ISOColor v+        clampColor' ColorMode8 _ = Default++        clampColor' ColorMode16 c@(ISOColor _) = SetTo c+        clampColor' ColorMode16 _              = Default++        clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c+        clampColor' (ColorMode240 colorCount) c@(Color240 n)+            | n <= colorCount = SetTo c+            | otherwise       = Default+        clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =+            clampColor' colorMode (color240 r g b)++        clampColor' FullColor c = SetTo c
− src/Graphics/Vty/Output/Interface.hs 
@@ -1,295 +0,0 @@--- Copyright Corey O'Connor-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-}--- | This module provides an abstract interface for performing terminal--- output. The only user-facing part of this API is 'Output'.-module Graphics.Vty.Output.Interface-  ( Output(..)-  , AssumedState(..)-  , DisplayContext(..)-  , Mode(..)-  , displayContext-  , outputPicture-  , initialAssumedState-  , limitAttrForDisplay-  )-where--import Graphics.Vty.Attributes-import Graphics.Vty.Image (DisplayRegion, regionHeight)-import Graphics.Vty.Picture-import Graphics.Vty.PictureToSpans-import Graphics.Vty.Span--import Graphics.Vty.DisplayAttributes--import Blaze.ByteString.Builder (Write, writeToByteString)-import Blaze.ByteString.Builder.ByteString (writeByteString)--import Control.Monad.Trans--import qualified Data.ByteString as BS-import Data.IORef-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Vector as Vector---- | Modal terminal features that can be enabled and disabled.-data Mode = Mouse-          -- ^ Mouse mode (whether the terminal is configured to provide-          -- mouse input events)-          | BracketedPaste-          -- ^ Paste mode (whether the terminal is configured to provide-          -- events on OS pastes)-          deriving (Eq, Read, Show)---- | The Vty terminal output interface.-data Output = Output-    { -- | Text identifier for the output device. Used for debugging.-      terminalID :: String-      -- | Release the terminal just prior to application exit and reset-      -- it to its state prior to application startup.-    , releaseTerminal :: forall m. MonadIO m => m ()-      -- | Clear the display and initialize the terminal to some initial-      -- display state.-      ---      -- The expectation of a program is that the display starts in some-      -- The initial state. initial state would consist of fixed values:-      ---      --  - cursor at top left-      --  - UTF-8 character encoding-      --  - drawing characteristics are the default-    , reserveDisplay :: forall m. MonadIO m => m ()-      -- | Return the display to the state before `reserveDisplay` If no-      -- previous state then set the display state to the initial state.-    , releaseDisplay :: forall m. MonadIO m => m ()-      -- | Returns the current display bounds.-    , displayBounds :: forall m. MonadIO m => m DisplayRegion-      -- | Output the bytestring to the terminal device.-    , outputByteBuffer :: BS.ByteString -> IO ()-      -- | Specifies the maximum number of colors supported by the-      -- context.-    , contextColorCount :: Int-      -- | Specifies whether the cursor can be shown / hidden.-    , supportsCursorVisibility :: Bool-      -- | Indicates support for terminal modes for this output device.-    , supportsMode :: Mode -> Bool-      -- | Enables or disables a mode (does nothing if the mode is-      -- unsupported).-    , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()-      -- | Returns whether a mode is enabled.-    , getModeStatus :: forall m. MonadIO m => Mode -> m Bool-    , assumedStateRef :: IORef AssumedState-      -- | Acquire display access to the given region of the display.-      -- Currently all regions have the upper left corner of (0,0) and-      -- the lower right corner at (max displayWidth providedWidth, max-      -- displayHeight providedHeight)-    , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext-      -- | Ring the terminal bell if supported.-    , ringTerminalBell :: forall m. MonadIO m => m ()-      -- | Returns whether the terminal has an audio bell feature.-    , supportsBell :: forall m. MonadIO m => m Bool-    }--displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext-displayContext t = liftIO . mkDisplayContext t t--data AssumedState = AssumedState-    { prevFattr :: Maybe FixedAttr-    , prevOutputOps :: Maybe DisplayOps-    }--initialAssumedState :: AssumedState-initialAssumedState = AssumedState Nothing Nothing--data DisplayContext = DisplayContext-    { contextDevice :: Output-    -- | Provide the bounds of the display context.-    , contextRegion :: DisplayRegion-    -- | Sets the output position to the specified row and column-    -- where the number of bytes required for the control codes can be-    -- specified seperate from the actual byte sequence.-    , writeMoveCursor :: Int -> Int -> Write-    , writeShowCursor :: Write-    , writeHideCursor :: Write-    -- Ensure that the specified output attributes will be applied to-    -- all the following text until the next output attribute change-    -- where the number of bytes required for the control codes can be-    -- specified seperately from the actual byte sequence. The required-    -- number of bytes must be at least the maximum number of bytes-    -- required by any attribute changes. The serialization equations-    -- must provide the ptr to the next byte to be specified in the-    -- output buffer.-    ---    -- The currently applied display attributes are provided as well.-    -- The Attr data type can specify the style or color should not be-    -- changed from the currently applied display attributes. In order-    -- to support this the currently applied display attributes are-    -- required. In addition it may be possible to optimize the state-    -- changes based off the currently applied display attributes.-    , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write-    -- | Reset the display attributes to the default display attributes.-    , writeDefaultAttr :: Write-    , writeRowEnd :: Write-    -- | See `Graphics.Vty.Output.XTermColor.inlineHack`-    , inlineHack :: IO ()-    }---- | All terminals serialize UTF8 text to the terminal device exactly as--- serialized in memory.-writeUtf8Text  :: BS.ByteString -> Write-writeUtf8Text = writeByteString---- | Displays the given `Picture`.------      1. The image is cropped to the display size.------      2. Converted into a sequence of attribute changes and text spans.------      3. The cursor is hidden.------      4. Serialized to the display.------      5. The cursor is then shown and positioned or kept hidden.-outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()-outputPicture dc pic = liftIO $ do-    as <- readIORef (assumedStateRef $ contextDevice dc)-    let manipCursor = supportsCursorVisibility (contextDevice dc)-        r = contextRegion dc-        ops = displayOpsForPic pic r-        initialAttr = FixedAttr defaultStyleMask Nothing Nothing-        -- Diff the previous output against the requested output.-        -- Differences are currently on a per-row basis.-        diffs :: [Bool] = case prevOutputOps as of-            Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True-            Just previousOps -> if affectedRegion previousOps /= affectedRegion ops-                then replicate (displayOpsRows ops) True-                else zipWith (/=) (Vector.toList previousOps)-                                  (Vector.toList ops)-        -- build the Write corresponding to the output image-        out = (if manipCursor then writeHideCursor dc else mempty)-              `mappend` writeOutputOps dc initialAttr diffs ops-              `mappend`-                (let (w,h) = contextRegion dc-                     clampX = max 0 . min (w-1)-                     clampY = max 0 . min (h-1) in-                 case picCursor pic of-                    _ | not manipCursor -> mempty-                    NoCursor            -> mempty-                    AbsoluteCursor x y ->-                        writeShowCursor dc `mappend`-                        writeMoveCursor dc (clampX x) (clampY y)-                    Cursor x y           ->-                        let m = cursorOutputMap ops $ picCursor pic-                            (ox, oy) = charToOutputPos m (x,y)-                        in writeShowCursor dc `mappend`-                           writeMoveCursor dc (clampX ox) (clampY oy)-                )-    -- ... then serialize-    outputByteBuffer (contextDevice dc) (writeToByteString out)-    -- Cache the output spans.-    let as' = as { prevOutputOps = Just ops }-    writeIORef (assumedStateRef $ contextDevice dc) as'--writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write-writeOutputOps dc initialAttr diffs ops =-    let (_, out, _) = Vector.foldl' writeOutputOps'-                                       (0, mempty, diffs)-                                       ops-    in out-    where-        writeOutputOps' (y, out, True : diffs') spanOps-            = let spanOut = writeSpanOps dc y initialAttr spanOps-                  out' = out `mappend` spanOut-              in (y+1, out', diffs')-        writeOutputOps' (y, out, False : diffs') _spanOps-            = (y + 1, out, diffs')-        writeOutputOps' (_y, _out, []) _spanOps-            = error "vty - output spans without a corresponding diff."--writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write-writeSpanOps dc y initialAttr spanOps =-    -- The first operation is to set the cursor to the start of the row-    let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc-    -- then the span ops are serialized in the order specified-    in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of-                              (opOut, fattr') -> (out `mappend` opOut, fattr')-                           )-                           (start, initialAttr)-                           spanOps--writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)-writeSpanOp dc (TextSpan attr _ _ str) fattr =-    let attr' = limitAttrForDisplay (contextDevice dc) attr-        fattr' = fixDisplayAttr fattr attr'-        diffs = displayAttrDiffs fattr fattr'-        out =  writeSetAttr dc fattr attr' diffs-               `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)-    in (out, fattr')-writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"-writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)---- | The cursor position is given in X,Y character offsets. Due to--- multi-column characters this needs to be translated to column, row--- positions.-data CursorOutputMap = CursorOutputMap-    { charToOutputPos :: (Int, Int) -> (Int, Int)-    }--cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap-cursorOutputMap spanOps _cursor = CursorOutputMap-    { charToOutputPos = \(cx, cy) -> (cursorColumnOffset spanOps cx cy, cy)-    }--cursorColumnOffset :: DisplayOps -> Int -> Int -> Int-cursorColumnOffset ops cx cy =-    let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy)-        (outOffset, _, _)-            = Vector.foldl' ( \(d, currentCx, done) op ->-                        if done then (d, currentCx, done) else case spanOpHasWidth op of-                            Nothing -> (d, currentCx, False)-                            Just (cw, ow) -> case compare cx (currentCx + cw) of-                                    GT -> ( d + ow-                                          , currentCx + cw-                                          , False-                                          )-                                    EQ -> ( d + ow-                                          , currentCx + cw-                                          , True-                                          )-                                    LT -> ( d + columnsToCharOffset (cx - currentCx) op-                                          , currentCx + cw-                                          , True-                                          )-                      )-                      (0, 0, False)-                      cursorRowOps-    in outOffset---- | Not all terminals support all display attributes. This filters a--- display attribute to what the given terminal can display.-limitAttrForDisplay :: Output -> Attr -> Attr-limitAttrForDisplay t attr-    = attr { attrForeColor = clampColor $ attrForeColor attr-           , attrBackColor = clampColor $ attrBackColor attr-           }-    where-        clampColor Default     = Default-        clampColor KeepCurrent = KeepCurrent-        clampColor (SetTo c)   = clampColor' c-        clampColor' (ISOColor v)-            | contextColorCount t < 8            = Default-            | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)-            | otherwise                          = SetTo $ ISOColor v-        clampColor' (Color240 v)-            -- Should we choose closest ISO color?-            | contextColorCount t <  8           = Default-            | contextColorCount t <  16          = Default-            | contextColorCount t <= 256         = SetTo $ Color240 v-            | otherwise-                = let p :: Double = fromIntegral v / 240.0-                      v' = floor $ p * (fromIntegral $ contextColorCount t)-                  in SetTo $ Color240 v'
src/Graphics/Vty/Output/Mock.hs view
@@ -11,7 +11,8 @@ where  import Graphics.Vty.Image (DisplayRegion)-import Graphics.Vty.Output.Interface+import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))+import Graphics.Vty.Output  import Blaze.ByteString.Builder.Word (writeWord8) @@ -30,7 +31,7 @@ -- without considering terminal specific issues. -- -- The mock implementation is useful in manually determining if the--- sequence of terminal operations matche the expected sequence. The+-- sequence of terminal operations matches the expected sequence. The -- requirement of the produced representation is simplicity in parsing -- the text representation and determining how the picture was mapped to -- terminal operations.@@ -48,16 +49,20 @@             , releaseDisplay = return ()             , ringTerminalBell = return ()             , supportsBell = return False+            , supportsItalics = return False+            , supportsStrikethrough = return False+            , setDisplayBounds = const $ return ()             , displayBounds = return r             , outputByteBuffer = \bytes -> do                 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"                 writeIORef outRef $ UTF8.fromRep bytes-            , contextColorCount = 16             , supportsCursorVisibility = True             , supportsMode = const False             , setMode = const $ const $ return ()             , getModeStatus = const $ return False             , assumedStateRef = newAssumedStateRef+            , outputColorMode = ColorMode16+            , setOutputWindowTitle = const $ return ()             , mkDisplayContext = \tActual rActual -> return $ DisplayContext                 { contextRegion = rActual                 , contextDevice = tActual@@ -72,10 +77,10 @@                 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'                 -- An attr change is always visualized as the single                 -- character 'A'-                , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'+                , writeSetAttr = \_ _fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'                 -- default attr is always visualized as the single                 -- character 'D'-                , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'+                , writeDefaultAttr = const $ writeWord8 $ toEnum $ fromEnum 'D'                 -- row end is always visualized as the single character                 -- 'E'                 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'@@ -83,4 +88,3 @@                 }             }     return (outRef, t)-
− src/Graphics/Vty/Output/TerminfoBased.hs 
@@ -1,479 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}-{-# CFILES gwinsz.c #-}---- | Terminfo-based terminal output driver.------ Copyright Corey O'Connor (coreyoconnor@gmail.com)-module Graphics.Vty.Output.TerminfoBased-  ( reserveTerminal-  )-where--import Control.Monad (when)-import Data.ByteString.Internal (toForeignPtr)-import Data.Terminfo.Parse-import Data.Terminfo.Eval--import Graphics.Vty.Attributes-import Graphics.Vty.Image (DisplayRegion)-import Graphics.Vty.DisplayAttributes-import Graphics.Vty.Output.Interface--import Blaze.ByteString.Builder (Write, writeToByteString)--import Control.Monad.Trans--import Data.Bits ((.&.))-import Data.IORef-import Data.Maybe (isJust, isNothing, fromJust)-import Data.Word--import Foreign.C.Types ( CInt(..), CLong(..) )-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, plusPtr)--import qualified System.Console.Terminfo as Terminfo-import System.Posix.IO (fdWriteBuf)-import System.Posix.Types (Fd(..))--data TerminfoCaps = TerminfoCaps-    { smcup :: Maybe CapExpression-    , rmcup :: Maybe CapExpression-    , cup :: CapExpression-    , cnorm :: Maybe CapExpression-    , civis :: Maybe CapExpression-    , supportsNoColors :: Bool-    , useAltColorMap :: Bool-    , setForeColor :: CapExpression-    , setBackColor :: CapExpression-    , setDefaultAttr :: CapExpression-    , clearScreen :: CapExpression-    , clearEol :: CapExpression-    , displayAttrCaps :: DisplayAttrCaps-    , ringBellAudio :: Maybe CapExpression-    }--data DisplayAttrCaps = DisplayAttrCaps-    { setAttrStates :: Maybe CapExpression-    , enterStandout :: Maybe CapExpression-    , exitStandout :: Maybe CapExpression-    , enterUnderline :: Maybe CapExpression-    , exitUnderline :: Maybe CapExpression-    , enterReverseVideo :: Maybe CapExpression-    , enterDimMode :: Maybe CapExpression-    , enterBoldMode :: Maybe CapExpression-    }---- kinda like:--- https://code.google.com/p/vim/source/browse/src/fileio.c#10422--- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR--- the write will be retried.-fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int-fdWriteAll outFd ptr len count-    | len <  0  = fail "fdWriteAll: len is less than 0"-    | len == 0  = return count-    | otherwise = do-        writeCount <- fromEnum <$> fdWriteBuf outFd ptr (toEnum len)-        let len' = len - writeCount-            ptr' = ptr `plusPtr` writeCount-            count' = count + writeCount-        fdWriteAll outFd ptr' len' count'--sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()-sendCapToTerminal t cap capParams = do-    outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams---- | Constructs an output driver that uses terminfo for all control--- codes. While this should provide the most compatible terminal,--- terminfo does not support some features that would increase--- efficiency and improve compatibility:------  * determining the character encoding supported by the terminal.---    Should this be taken from the LANG environment variable?------  * Providing independent string capabilities for all display---    attributes.-reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output-reserveTerminal termName outFd = liftIO $ do-    ti <- Terminfo.setupTerm termName-    -- assumes set foreground always implies set background exists.-    -- if set foreground is not set then all color changing style-    -- attributes are filtered.-    msetaf <- probeCap ti "setaf"-    msetf <- probeCap ti "setf"-    let (noColors, useAlt, setForeCap)-            = case msetaf of-                Just setaf -> (False, False, setaf)-                Nothing -> case msetf of-                    Just setf -> (False, True, setf)-                    Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)-    msetab <- probeCap ti "setab"-    msetb <- probeCap ti "setb"-    let set_back_cap-            = case msetab of-                Nothing -> case msetb of-                    Just setb -> setb-                    Nothing -> error $ "no back color support for terminal " ++ termName-                Just setab -> setab-    terminfoCaps <- pure TerminfoCaps-        <*> probeCap ti "smcup"-        <*> probeCap ti "rmcup"-        <*> requireCap ti "cup"-        <*> probeCap ti "cnorm"-        <*> probeCap ti "civis"-        <*> pure noColors-        <*> pure useAlt-        <*> pure setForeCap-        <*> pure set_back_cap-        <*> requireCap ti "sgr0"-        <*> requireCap ti "clear"-        <*> requireCap ti "el"-        <*> currentDisplayAttrCaps ti-        <*> probeCap ti "bel"-    newAssumedStateRef <- newIORef initialAssumedState-    let t = Output-            { terminalID = termName-            , releaseTerminal = liftIO $ do-                sendCap setDefaultAttr []-                maybeSendCap cnorm []-            , supportsBell = return $ isJust $ ringBellAudio terminfoCaps-            , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []-            , reserveDisplay = liftIO $ do-                -- If there is no support for smcup: Clear the screen-                -- and then move the mouse to the home position to-                -- approximate the behavior.-                maybeSendCap smcup []-                sendCap clearScreen []-            , releaseDisplay = liftIO $ do-                maybeSendCap rmcup []-                maybeSendCap cnorm []-            , displayBounds = do-                rawSize <- liftIO $ getWindowSize outFd-                case rawSize of-                    (w, h)  | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize-                            | otherwise      -> return (w,h)-            , outputByteBuffer = \outBytes -> do-                let (fptr, offset, len) = toForeignPtr outBytes-                actualLen <- withForeignPtr fptr-                             $ \ptr -> fdWriteAll outFd (ptr `plusPtr` offset) len 0-                when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "-                  ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen-                  ++ " Please report this bug to vty project."-            , contextColorCount-                = case supportsNoColors terminfoCaps of-                    False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of-                        Nothing -> 8-                        Just v -> toEnum v-                    True -> 1-            , supportsCursorVisibility = isJust $ civis terminfoCaps-            , supportsMode = const False-            , setMode = const $ const $ return ()-            , getModeStatus = const $ return False-            , assumedStateRef = newAssumedStateRef-            -- I think fix would help assure tActual is the only-            -- reference. I was having issues tho.-            , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps-            }-        sendCap s = sendCapToTerminal t (s terminfoCaps)-        maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)-    return t--requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression-requireCap ti capName-    = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of-        Nothing     -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""-        Just capStr -> parseCap capStr--probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)-probeCap ti capName-    = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of-        Nothing     -> return Nothing-        Just capStr -> Just <$> parseCap capStr--parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression-parseCap capStr = do-    case parseCapExpression capStr of-        Left e -> fail $ show e-        Right cap -> return cap--currentDisplayAttrCaps :: ( Applicative m, MonadIO m )-                       => Terminfo.Terminal-                       -> m DisplayAttrCaps-currentDisplayAttrCaps ti-    =   pure DisplayAttrCaps-    <*> probeCap ti "sgr"-    <*> probeCap ti "smso"-    <*> probeCap ti "rmso"-    <*> probeCap ti "smul"-    <*> probeCap ti "rmul"-    <*> probeCap ti "rev"-    <*> probeCap ti "dim"-    <*> probeCap ti "bold"--foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong--getWindowSize :: Fd -> IO (Int,Int)-getWindowSize fd = do-    (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd-    return (fromIntegral b, fromIntegral a)--terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext-terminfoDisplayContext tActual terminfoCaps r = return dc-    where dc = DisplayContext-            { contextDevice = tActual-            , contextRegion = r-            , writeMoveCursor = \x y -> writeCapExpr (cup terminfoCaps) [toEnum y, toEnum x]-            , writeShowCursor = case cnorm terminfoCaps of-                Nothing -> error "this terminal does not support show cursor"-                Just c -> writeCapExpr c []-            , writeHideCursor = case civis terminfoCaps of-                Nothing -> error "this terminal does not support hide cursor"-                Just c -> writeCapExpr c []-            , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps-            , writeDefaultAttr = writeCapExpr (setDefaultAttr terminfoCaps) []-            , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []-            , inlineHack = return ()-            }---- | Portably setting the display attributes is a giant pain in the ass.------ If the terminal supports the sgr capability (which sets the on/off--- state of each style directly ; and, for no good reason, resets the--- colors to the default) this procedure is used:------  0. set the style attributes. This resets the fore and back color.------  1, If a foreground color is to be set then set the foreground color------  2. likewise with the background color------ If the terminal does not support the sgr cap then: if there is a--- change from an applied color to the default (in either the fore or--- back color) then:------  0. reset all display attributes (sgr0)------  1. enter required style modes------  2. set the fore color if required------  3. set the back color if required------ Entering the required style modes could require a reset of the--- display attributes. If this is the case then the back and fore colors--- always need to be set if not default.------ This equation implements the above logic.------ Note that this assumes the removal of color changes in the--- display attributes is done as expected with noColors == True. See--- `limitAttrForDisplay`.------ Note that this optimizes for fewer state changes followed by fewer--- bytes.-terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write-terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do-    case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of-        -- The only way to reset either color, portably, to the default-        -- is to use either the set state capability or the set default-        -- capability.-        True  -> do-            case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)-                                     (fixedStyle attr )-                                     (styleToApplySeq $ fixedStyle attr) of-                -- only way to reset a color to the defaults-                EnterExitSeq caps -> writeDefaultAttr dc-                                     `mappend`-                                     foldMap (\cap -> writeCapExpr cap []) caps-                                     `mappend`-                                     setColors-                -- implicitly resets the colors to the defaults-                SetState state -> writeCapExpr (fromJust $ setAttrStates-                                                         $ displayAttrCaps-                                                         $ terminfoCaps-                                               )-                                               (sgrArgsForState state)-                                  `mappend`-                                  setColors-        -- Otherwise the display colors are not changing or changing-        -- between two non-default points.-        False -> do-            -- Still, it could be the case that the change in display-            -- attributes requires the colors to be reset because the-            -- required capability was not available.-            case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)-                                     (fixedStyle attr)-                                     (styleDiffs diffs) of-                -- Really, if terminals were re-implemented with modern-                -- concepts instead of bowing down to 40 yr old dumb-                -- terminal requirements this would be the only case-                -- ever reached! Changes the style and color states-                -- according to the differences with the currently-                -- applied states.-                EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps-                                     `mappend`-                                     writeColorDiff setForeColor (foreColorDiff diffs)-                                     `mappend`-                                     writeColorDiff setBackColor (backColorDiff diffs)-                -- implicitly resets the colors to the defaults-                SetState state -> writeCapExpr (fromJust $ setAttrStates-                                                         $ displayAttrCaps terminfoCaps-                                               )-                                               (sgrArgsForState state)-                                  `mappend` setColors-    where-        colorMap = case useAltColorMap terminfoCaps of-                        False -> ansiColorIndex-                        True -> altColorIndex-        attr = fixDisplayAttr prevAttr reqAttr-        setColors =-            (case fixedForeColor attr of-                Just c -> writeCapExpr (setForeColor terminfoCaps)-                                       [toEnum $ colorMap c]-                Nothing -> mempty)-            `mappend`-            (case fixedBackColor attr of-                Just c -> writeCapExpr (setBackColor terminfoCaps)-                                       [toEnum $ colorMap c]-                Nothing -> mempty)-        writeColorDiff _f NoColorChange-            = mempty-        writeColorDiff _f ColorToDefault-            = error "ColorToDefault is not a possible case for applyColorDiffs"-        writeColorDiff f (SetColor c)-            = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]---- | The color table used by a terminal is a 16 color set followed by a--- 240 color set that might not be supported by the terminal.------ This takes a Color which clearly identifies which pallete to use and--- computes the index into the full 256 color pallete.-ansiColorIndex :: Color -> Int-ansiColorIndex (ISOColor v) = fromEnum v-ansiColorIndex (Color240 v) = 16 + fromEnum v---- | For terminals without setaf/setab------ See table in `man terminfo`--- Will error if not in table.-altColorIndex :: Color -> Int-altColorIndex (ISOColor 0) = 0-altColorIndex (ISOColor 1) = 4-altColorIndex (ISOColor 2) = 2-altColorIndex (ISOColor 3) = 6-altColorIndex (ISOColor 4) = 1-altColorIndex (ISOColor 5) = 5-altColorIndex (ISOColor 6) = 3-altColorIndex (ISOColor 7) = 7-altColorIndex (ISOColor v) = fromEnum v-altColorIndex (Color240 v) = 16 + fromEnum v--{- | The sequence of terminfo caps to apply a given style are determined- - according to these rules.- -- -  1. The assumption is that it's preferable to use the simpler- -  enter/exit mode capabilities than the full set display attribute- -  state capability.- -- -  2. If a mode is supposed to be removed but there is not an exit- -  capability defined then the display attributes are reset to defaults- -  then the display attribute state is set.- -- -  3. If a mode is supposed to be applied but there is not an enter- -  capability defined then then display attribute state is set if- -  possible. Otherwise the mode is not applied.- -- -  4. If the display attribute state is being set then just update the- -  arguments to that for any apply/remove.- -}-data DisplayAttrSeq-    = EnterExitSeq [CapExpression]-    | SetState DisplayAttrState--data DisplayAttrState = DisplayAttrState-    { applyStandout :: Bool-    , applyUnderline :: Bool-    , applyReverseVideo :: Bool-    , applyBlink :: Bool-    , applyDim :: Bool-    , applyBold :: Bool-    }--sgrArgsForState :: DisplayAttrState -> [CapParam]-sgrArgsForState attrState = map (\b -> if b then 1 else 0)-    [ applyStandout attrState-    , applyUnderline attrState-    , applyReverseVideo attrState-    , applyBlink attrState-    , applyDim attrState-    , applyBold attrState-    , False -- invis-    , False -- protect-    , False -- alt char set-    ]--reqDisplayCapSeqFor :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq-reqDisplayCapSeqFor caps s diffs-    -- if the state transition implied by any diff cannot be supported-    -- with an enter/exit mode cap then either the state needs to be set-    -- or the attribute change ignored.-    = case (any noEnterExitCap diffs, isJust $ setAttrStates caps) of-        -- If all the diffs have an enter-exit cap then just use those-        ( False, _    ) -> EnterExitSeq $ map enterExitCap diffs-        -- If not all the diffs have an enter-exit cap and there is no-        -- set state cap then filter out all unsupported diffs and just-        -- apply the rest-        ( True, False ) -> EnterExitSeq $ map enterExitCap-                                        $ filter (not . noEnterExitCap) diffs-        -- if not all the diffs have an enter-exit can and there is a-        -- set state cap then just use the set state cap.-        ( True, True  ) -> SetState $ stateForStyle s-    where-        noEnterExitCap ApplyStandout = isNothing $ enterStandout caps-        noEnterExitCap RemoveStandout = isNothing $ exitStandout caps-        noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps-        noEnterExitCap RemoveUnderline = isNothing $ exitUnderline caps-        noEnterExitCap ApplyReverseVideo = isNothing $ enterReverseVideo caps-        noEnterExitCap RemoveReverseVideo = True-        noEnterExitCap ApplyBlink = True-        noEnterExitCap RemoveBlink = True-        noEnterExitCap ApplyDim = isNothing $ enterDimMode caps-        noEnterExitCap RemoveDim = True-        noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps-        noEnterExitCap RemoveBold = True-        enterExitCap ApplyStandout = fromJust $ enterStandout caps-        enterExitCap RemoveStandout = fromJust $ exitStandout caps-        enterExitCap ApplyUnderline = fromJust $ enterUnderline caps-        enterExitCap RemoveUnderline = fromJust $ exitUnderline caps-        enterExitCap ApplyReverseVideo = fromJust $ enterReverseVideo caps-        enterExitCap ApplyDim = fromJust $ enterDimMode caps-        enterExitCap ApplyBold = fromJust $ enterBoldMode caps-        enterExitCap _ = error "enterExitCap applied to diff that was known not to have one."--stateForStyle :: Style -> DisplayAttrState-stateForStyle s = DisplayAttrState-    { applyStandout = isStyleSet standout-    , applyUnderline = isStyleSet underline-    , applyReverseVideo = isStyleSet reverseVideo-    , applyBlink = isStyleSet blink-    , applyDim = isStyleSet dim-    , applyBold = isStyleSet bold-    }-    where isStyleSet = hasStyle s--styleToApplySeq :: Style -> [StyleStateChange]-styleToApplySeq s = concat-    [ applyIfRequired ApplyStandout standout-    , applyIfRequired ApplyUnderline underline-    , applyIfRequired ApplyReverseVideo reverseVideo-    , applyIfRequired ApplyBlink blink-    , applyIfRequired ApplyDim dim-    , applyIfRequired ApplyBlink bold-    ]-    where-        applyIfRequired op flag-            = if 0 == (flag .&. s)-                then []-                else [op]
− src/Graphics/Vty/Output/XTermColor.hs 
@@ -1,107 +0,0 @@--- Copyright 2009-2010 Corey O'Connor--- | Xterm output driver. This uses the Terminfo driver with some--- extensions for Xterm.-module Graphics.Vty.Output.XTermColor-  ( reserveTerminal-  )-where--import Graphics.Vty.Output.Interface-import Graphics.Vty.Input.Mouse-import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased--import Blaze.ByteString.Builder (writeToByteString)-import Blaze.ByteString.Builder.Word (writeWord8)--import Control.Monad (void, when)-import Control.Monad.Trans-import Data.IORef--import System.Posix.IO (fdWrite)-import System.Posix.Types (Fd)-import System.Posix.Env (getEnv)--import Data.List (isInfixOf)-import Data.Maybe (catMaybes)-import Data.Monoid ((<>))---- | Construct an Xterm output driver. Initialize the display to UTF-8.-reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output-reserveTerminal variant outFd = liftIO $ do-    let flushedPut = void . fdWrite outFd-    -- If the terminal variant is xterm-color use xterm instead since,-    -- more often than not, xterm-color is broken.-    let variant' = if variant == "xterm-color" then "xterm" else variant--    utf8a <- utf8Active-    when (not utf8a) $ flushedPut setUtf8CharSet-    t <- TerminfoBased.reserveTerminal variant' outFd--    mouseModeStatus <- newIORef False-    pasteModeStatus <- newIORef False--    let xtermSetMode t' m newStatus = do-          curStatus <- getModeStatus t' m-          when (newStatus /= curStatus) $-              case m of-                  Mouse -> liftIO $ do-                      case newStatus of-                          True -> flushedPut requestMouseEvents-                          False -> flushedPut disableMouseEvents-                      writeIORef mouseModeStatus newStatus-                  BracketedPaste -> liftIO $ do-                      case newStatus of-                          True -> flushedPut enableBracketedPastes-                          False -> flushedPut disableBracketedPastes-                      writeIORef pasteModeStatus newStatus--        xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus-        xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus--    let t' = t-             { terminalID = terminalID t ++ " (xterm-color)"-             , releaseTerminal = do-                 when (not utf8a) $ liftIO $ flushedPut setDefaultCharSet-                 setMode t' BracketedPaste False-                 setMode t' Mouse False-                 releaseTerminal t-             , mkDisplayContext = \tActual r -> do-                dc <- mkDisplayContext t tActual r-                return $ dc { inlineHack = xtermInlineHack t' }-             , supportsMode = const True-             , getModeStatus = xtermGetMode-             , setMode = xtermSetMode t'-             }-    return t'--utf8Active :: IO Bool-utf8Active = do-    let vars = ["LC_ALL", "LANG", "LC_CTYPE"]-    results <- catMaybes <$> mapM getEnv vars-    let matches = filter ("UTF8" `isInfixOf`) results <>-                  filter ("UTF-8" `isInfixOf`) results-    return $ not $ null matches---- | Enable bracketed paste mode:--- http://cirw.in/blog/bracketed-paste-enableBracketedPastes :: String-enableBracketedPastes = "\ESC[?2004h"---- | Disable bracketed paste mode:-disableBracketedPastes :: String-disableBracketedPastes = "\ESC[?2004l"---- | These sequences set xterm based terminals to UTF-8 output.------ There is no known terminfo capability equivalent to this.-setUtf8CharSet, setDefaultCharSet :: String-setUtf8CharSet = "\ESC%G"-setDefaultCharSet = "\ESC%@"---- | I think xterm is broken: Reseting the background color as the first--- bytes serialized on a new line does not effect the background color--- xterm uses to clear the line. Which is used *after* the next newline.-xtermInlineHack :: Output -> IO ()-xtermInlineHack t = do-    let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"-    outputByteBuffer t $ writeToByteString writeReset
src/Graphics/Vty/Picture.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} -- A 'Picture' is a background paired with a set of 'Image' layers. The -- 'Picture' data structure is representative of the final terminal -- view.@@ -31,10 +30,7 @@     , picBackground :: Background     -- ^ The picture's background to be displayed in locations with no     -- Image data.-    }--instance Show Picture where-    show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"+    } deriving (Eq, Show)  instance NFData Picture where     rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` ()@@ -80,11 +76,20 @@ data Cursor =     -- | Hide the cursor     NoCursor+    -- | Set the terminal's cursor position without displaying a cursor+    -- character. This is important for accessibility with screen+    -- readers where a cursor position needs to be reported but we may+    -- not want to show a block cursor in that location for cosmetic+    -- reasons. The boolean argument indicates whether the positioning+    -- should be absolute as with 'AbsoluteCursor' ('True') or logical+    -- as with 'Cursor' ('False').+    | PositionOnly !Bool !Int !Int     -- | Show the cursor at the given logical column accounting for     -- character width in the presence of multi-column characters.     | Cursor !Int !Int     -- | Show the cursor at the given absolute terminal column and row     | AbsoluteCursor !Int !Int+    deriving (Eq, Show)  instance NFData Cursor where     rnf c = c `seq` ()@@ -108,6 +113,7 @@      --      -- * End of line if there are no remaining non-skip ops.     | ClearBackground+    deriving (Eq, Show)  instance NFData Background where     rnf (Background c a) = c `seq` a `seq` ()
src/Graphics/Vty/PictureToSpans.hs view
@@ -3,10 +3,12 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}  -- | Transforms an image into rows of operations.-module Graphics.Vty.PictureToSpans where+module Graphics.Vty.PictureToSpans+  ( displayOpsForPic+  )+where  import Graphics.Vty.Attributes (Attr, currentAttr) import Graphics.Vty.Image@@ -16,7 +18,7 @@  import Lens.Micro import Lens.Micro.Mtl-import Lens.Micro.TH+import Control.Monad import Control.Monad.Reader import Control.Monad.State.Strict hiding ( state ) import Control.Monad.ST.Strict@@ -29,8 +31,6 @@  type MRowOps s = MVector s SpanOps -type MSpanOps s = MVector s SpanOp- -- transform plus clip. More or less. data BlitState = BlitState     -- we always snoc to the operation vectors. Thus the columnOffset =@@ -53,15 +53,35 @@     , _remainingRows :: Int     } -makeLenses ''BlitState+columnOffset :: Lens' BlitState Int+columnOffset = lens _columnOffset (\e v -> e { _columnOffset = v }) +rowOffset :: Lens' BlitState Int+rowOffset = lens _rowOffset (\e v -> e { _rowOffset = v })++skipColumns :: Lens' BlitState Int+skipColumns = lens _skipColumns (\e v -> e { _skipColumns = v })++skipRows :: Lens' BlitState Int+skipRows = lens _skipRows (\e v -> e { _skipRows = v })++remainingColumns :: Lens' BlitState Int+remainingColumns = lens _remainingColumns (\e v -> e { _remainingColumns = v })++remainingRows :: Lens' BlitState Int+remainingRows = lens _remainingRows (\e v -> e { _remainingRows = v })+ data BlitEnv s = BlitEnv     { _region :: DisplayRegion     , _mrowOps :: MRowOps s     } -makeLenses ''BlitEnv+region :: Lens' (BlitEnv s) DisplayRegion+region = lens _region (\e r -> e { _region = r }) +mrowOps :: Lens' (BlitEnv s) (MRowOps s)+mrowOps = lens _mrowOps (\e r -> e { _mrowOps = r })+ type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a  -- | Produces the span ops that will render the given picture, possibly@@ -69,21 +89,14 @@ displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r) --- | Returns the DisplayOps for an image rendered to a window the size--- of the image.------ largerly used only for debugging.-displayOpsForImage :: Image -> DisplayOps-displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)- -- | Produces the span ops for each layer then combines them. combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s) combinedOpsForLayers pic r     | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0     | otherwise = do-        layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)+        layerOps <- mapM (`buildSpans` r) (picLayers pic)         case layerOps of-            []    -> fail "empty picture"+            []    -> error "empty picture"             [ops] -> substituteSkips (picBackground pic) ops             -- instead of merging ops after generation the merging can             -- be performed as part of snocOp.@@ -113,7 +126,7 @@     -- At this point we decide if the background character is single     -- column or not. obviously, single column is easier.     case safeWcwidth backgroundChar of-        w | w == 0 -> fail $ "invalid background character " ++ show backgroundChar+        w | w == 0 -> error $ "invalid background character " ++ show backgroundChar           | w == 1 -> do                 forM_ [0 .. MVector.length ops - 1] $ \row -> do                     rowOps <- MVector.read ops row@@ -136,8 +149,8 @@     return upper  mergeRowUnder :: SpanOps -> SpanOps -> SpanOps-mergeRowUnder upperRowOps lowerRowOps =-    onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps+mergeRowUnder upperRowOps =+    onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)     where         -- H: it will never be the case that we are out of upper ops         -- before lower ops.@@ -159,7 +172,7 @@  swapSkipsForSingleColumnCharSpan :: Char -> Attr -> SpanOps -> SpanOps swapSkipsForSingleColumnCharSpan c a = Vector.map f-    where f (Skip ow) = let txt = TL.pack $ replicate ow c+    where f (Skip ow) = let txt = TL.take (toEnum ow) $ TL.repeat c                         in TextSpan a ow ow txt           f v = v @@ -220,18 +233,18 @@  isOutOfBounds :: Image -> BlitState -> Bool isOutOfBounds i s-    | s ^. remainingColumns <= 0              = True-    | s ^. remainingRows    <= 0              = True+    | s ^. remainingColumns <= 0             = True+    | s ^. remainingRows    <= 0             = True     | s ^. skipColumns      >= imageWidth i  = True     | s ^. skipRows         >= imageHeight i = True     | otherwise = False  -- | This adds an image that might be partially clipped to the output -- ops.--- -- This is a very touchy algorithm. Too touchy. For instance, the--- CropRight and CropBottom implementations are odd. They pass the--- current tests but something seems terribly wrong about all this.+-- Crop implementations is odd. They pass the current tests but+-- something seems terribly wrong about all this.+-- addMaybeClipped :: forall s . Image -> BlitM s () addMaybeClipped EmptyImage = return () addMaybeClipped (HorizText a textStr ow _cw) = do@@ -266,23 +279,13 @@         outputHeight' = min (outputHeight - s^.skipRows   ) (s^.remainingRows)     y <- use rowOffset     forM_ [y..y+outputHeight'-1] $ snocOp (Skip outputWidth')-addMaybeClipped CropRight {croppedImage, outputWidth} = do-    s <- use skipColumns-    r <- use remainingColumns-    let x = outputWidth - s-    when (x < r) $ remainingColumns .= x-    addMaybeClipped croppedImage-addMaybeClipped CropLeft {croppedImage, leftSkip} = do+addMaybeClipped Crop {croppedImage, leftSkip, topSkip, outputWidth, outputHeight} = do+    sx <- use skipColumns     skipColumns += leftSkip-    addMaybeClipped croppedImage-addMaybeClipped CropBottom {croppedImage, outputHeight} = do-    s <- use skipRows-    r <- use remainingRows-    let x = outputHeight - s-    when (x < r) $ remainingRows .= x-    addMaybeClipped croppedImage-addMaybeClipped CropTop {croppedImage, topSkip} = do+    modifying remainingColumns (min (outputWidth - sx))+    sy <- use skipRows     skipRows += topSkip+    modifying remainingRows (min (outputHeight - sy))     addMaybeClipped croppedImage  addMaybeClippedJoin :: forall s . String@@ -296,13 +299,13 @@                        -> BlitM s () addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do     state <- get-    when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"+    when (state^.remaining <= 0) $ error $ name ++ " with remaining <= 0"     case state^.skip of-        s | s > size -> put $ state & skip -~ size+        s | s > size -> put $ state & skip %~ subtract size           | s == 0    -> if state^.remaining > i0Dim                             then do                                 addMaybeClipped i0-                                put $ state & offset +~ i0Dim & remaining -~ i0Dim+                                put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim                                 addMaybeClipped i1                             else addMaybeClipped i0           | s < i0Dim  ->@@ -311,26 +314,26 @@                     then addMaybeClipped i0                     else do                         addMaybeClipped i0-                        put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0+                        put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0                         addMaybeClipped i1           | s >= i0Dim -> do-                put $ state & skip -~ i0Dim+                put $ state & skip %~ subtract i0Dim                 addMaybeClipped i1-        _ -> fail $ name ++ " has unhandled skip class"+        _ -> error $ name ++ " has unhandled skip class" -addUnclippedText :: Attr -> DisplayText -> BlitM s ()+addUnclippedText :: Attr -> TL.Text -> BlitM s () addUnclippedText a txt = do     let op = TextSpan a usedDisplayColumns                       (fromIntegral $ TL.length txt)                       txt-        usedDisplayColumns = wcswidth $ TL.unpack txt+        usedDisplayColumns = wctlwidth txt     use rowOffset >>= snocOp op  addRowCompletion :: DisplayRegion -> Int -> BlitM s () addRowCompletion displayRegion row = do     allRowOps <- view mrowOps     rowOps <- lift $ lift $ MVector.read allRowOps row-    let endX = spanOpsEffectedColumns rowOps+    let endX = spanOpsAffectedColumns rowOps     when (endX < regionWidth displayRegion) $ do         let ow = regionWidth displayRegion - endX         snocOp (Skip ow) row@@ -343,12 +346,6 @@     lift $ lift $ do         ops <- MVector.read theMrowOps row         let ops' = Vector.snoc ops op-        when (spanOpsEffectedColumns ops' > regionWidth theRegion)-             $ fail $ "row " ++ show row ++ " now exceeds region width"+        when (spanOpsAffectedColumns ops' > regionWidth theRegion)+             $ error $ "row " ++ show row ++ " now exceeds region width"         MVector.write theMrowOps row ops'--(-~) :: Num a => ASetter s t a a -> a -> s -> t-l -~ n = over l (subtract n)--(+~) :: Num a => ASetter s t a a -> a -> s -> t-l +~ n = over l (n +)
src/Graphics/Vty/Span.hs view
@@ -1,6 +1,4 @@ -- Copyright Corey O'Connor-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GADTs #-} -- | A picture is translated into a sequences of state changes and -- character spans. The attribute is applied to all following spans,@@ -9,8 +7,23 @@ -- -- A span op sequence will be defined for all rows and columns (and no -- more) of the region provided with the picture to 'spansForPic'.-module Graphics.Vty.Span where+module Graphics.Vty.Span+  ( SpanOp(..)+  , columnsToCharOffset+  , spanOpHasWidth +  , SpanOps+  , spanOpsAffectedColumns+  , splitOpsAt+  , dropOps++  , DisplayOps+  , displayOpsRows+  , displayOpsColumns+  , affectedRegion+  )+where+ import Graphics.Vty.Attributes (Attr) import Graphics.Vty.Image import Graphics.Vty.Image.Internal ( clipText )@@ -30,7 +43,7 @@       { textSpanAttr :: !Attr       , textSpanOutputWidth :: !Int       , textSpanCharWidth :: !Int-      , textSpanText :: DisplayText+      , textSpanText :: TL.Text       }     -- | Skips the given number of columns.     | Skip !Int@@ -52,7 +65,7 @@ dropOps w = snd . splitOpsAt w  splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)-splitOpsAt inW inOps = splitOpsAt' inW inOps+splitOpsAt = splitOpsAt'     where         splitOpsAt' 0 ops = (Vector.empty, ops)         splitOpsAt' remainingColumns ops = case Vector.head ops of@@ -103,18 +116,18 @@  -- | The number of rows the DisplayOps are defined for. displayOpsRows :: DisplayOps -> Int-displayOpsRows ops = Vector.length ops+displayOpsRows = Vector.length  affectedRegion :: DisplayOps -> DisplayRegion affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)  -- | The number of columns a SpanOps affects.-spanOpsEffectedColumns :: SpanOps -> Int-spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps+spanOpsAffectedColumns :: SpanOps -> Int+spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps     where-        spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w-        spanOpsEffectedColumns' t (Skip w) = t + w-        spanOpsEffectedColumns' t (RowEnd w) = t + w+        spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w+        spanOpsAffectedColumns' t (Skip w) = t + w+        spanOpsAffectedColumns' t (RowEnd w) = t + w  -- | The width of a single SpanOp in columns. spanOpHasWidth :: SpanOp -> Maybe (Int, Int)@@ -126,7 +139,6 @@ -- span op. columnsToCharOffset :: Int -> SpanOp -> Int columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =-    let str = TL.unpack utf8Str-    in wcswidth (take cx str)+    wctlwidth (TL.take (fromIntegral cx) utf8Str) columnsToCharOffset cx (Skip _) = cx columnsToCharOffset cx (RowEnd _) = cx
+ src/Graphics/Vty/UnicodeWidthTable/IO.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE CPP #-}+module Graphics.Vty.UnicodeWidthTable.IO+  ( readUnicodeWidthTable+  , parseUnicodeWidthTable+  , writeUnicodeWidthTable+  )+where++import Control.Monad (when, forM)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import qualified Data.ByteString.Lazy as BSL+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif++import Graphics.Vty.UnicodeWidthTable.Types++-- | Load a binary unicode width table from the specified file.+--+-- This either returns a successfully parsed table or a table parsing+-- error message. This does not handle I/O exceptions.+readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)+readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path++-- | Parse a binary unicode width table.+parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable+parseUnicodeWidthTable bs =+    case runGetOrFail tableParser bs of+        Left (_, _, msg) ->+            Left msg++        -- Even if we parsed a table, leftover bytes indicate something+        -- could be wrong.+        Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->+            Left $ "Error: " <> show (BSL.length remainingBytes) <>+                   " byte(s) left unconsumed"++        Right (_, _, table) ->+            Right table++-- | Write the unicode width table to the specified path.+--+-- This does not handle I/O exceptions.+writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()+writeUnicodeWidthTable path table = do+    let body = runPut (tableV1Writer table)+    BSL.writeFile path body++-- | Width table magic bytes for use in the binary format.+widthTableMagic :: Word32+widthTableMagic = 0xc1a9f7e0++tableParser :: Get UnicodeWidthTable+tableParser = do+    magic <- getWord32le++    when (magic /= widthTableMagic) $+        fail "Table magic number invalid"++    version <- getWord8++    case version of+        1 -> tableV1Parser+        _ -> fail "Table version invalid"++tableV1Parser :: Get UnicodeWidthTable+tableV1Parser = do+    numRanges <- getWord32le++    let parseRange = do+            start <- getWord32le+            size <- getWord32le+            cols <- getWord8+            return WidthTableRange { rangeStart = start+                                   , rangeSize = size+                                   , rangeColumns = cols+                                   }++    ranges <- forM [1..numRanges] $ const parseRange++    return UnicodeWidthTable { unicodeWidthTableRanges = ranges+                             }++tableV1Writer :: UnicodeWidthTable -> Put+tableV1Writer table = do+    -- Magic bytes+    putWord32le widthTableMagic++    -- Version+    putWord8 1++    -- Number of ranges+    let ranges = unicodeWidthTableRanges table+    let numRanges = length ranges+    putWord32le (fromIntegral numRanges)++    -- Ranges+    let putRange r = do+            putWord32le $ rangeStart r+            putWord32le $ rangeSize r+            putWord8 $ rangeColumns r++    mapM_ putRange ranges
+ src/Graphics/Vty/UnicodeWidthTable/Install.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+module Graphics.Vty.UnicodeWidthTable.Install+  ( TableInstallException(..)+  , installUnicodeWidthTable+  , isCustomTableReady+  )+where++import Control.Monad (when, forM_)+import qualified Control.Exception as E+import GHC.Conc.Sync (withMVar)+import Control.Concurrent.MVar (MVar, newMVar)+import Data.Word (Word8, Word32)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif+import System.IO.Unsafe (unsafePerformIO)++import Graphics.Vty.UnicodeWidthTable.Types++-- | The lock used to make functions in this module thread-safe.+installLock :: MVar ()+{-# NOINLINE installLock #-}+installLock = unsafePerformIO $ newMVar ()++-- | Returns True if and only if a custom table has been allocated and+-- marked as ready for use.+--+-- This function is thread-safe.+isCustomTableReady :: IO Bool+isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady++withInstallLock :: IO a -> IO a+withInstallLock act = withMVar installLock $ const act++-- This is the size of the allocated custom character width table, in+-- character slots. It's important that this be large enough to hold all+-- possible Unicode character values. At the time of this writing, the+-- valid Unicode range is 0 - 0x10ffff, hence this value.+tableSize :: Int+tableSize = 0x110000++-- | Exception type raised by 'installUnicodeWidthTable'.+data TableInstallException =+    TableInitFailure Int Int+    -- ^ The width table could not be initialized. Args: failure status,+    -- requested table size.+    | TableRangeFailure Int WidthTableRange+    -- ^ A code point range could not be configured. Args: failure+    -- status, offending range.+    | TableActivationFailure Int+    -- ^ The table could not be activated. Args: failure status.+    deriving (Eq, Show)++instance E.Exception TableInstallException++-- | Install a custom unicode character width+-- table. Such tables are obtained with+-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and+-- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'.+--+-- ALERT! This function is probably not what you want to use because+-- it is automatically called by 'Graphics.Vty.mkVty'. You will only+-- ever need to call this function if you want to use functions+-- in 'Graphics.Text.Width' without controlling the terminal with+-- 'Graphics.Vty.mkVty'.+--+-- This affects the behavior of the 'Graphics.Vty.Image.wcwidth'+-- function and functions that call it. It does so by+-- changing global state available to the C implementation+-- of 'Graphics.Vty.Image.wcwidth'. To ensure that your+-- program gets consistent results from evaluating calls to+-- 'Graphics.Vty.Image.wcwidth', the installation of a custom table+-- should be performed before you call 'Graphics.Vty.Image.wcwidth' in+-- your program.+--+-- This is best done at Vty startup, and if you use+-- 'Graphics.Vty.mkVty', that function calls this automatically based on+-- the Vty configuration's declared width tables. It is exposed as part+-- of the public API so that applications can call this as needed if+-- they don't want to control the terminal with 'mkVty' but do want to+-- make calls to 'Graphics.Vty.Image.wcwidth'.+--+-- It's also important to note that once a custom table has been+-- installed, it is permanent for the life of the process. No new table+-- can be installed, and the new custom table cannot be removed.+--+-- If this function fails for any reason -- if the table cannot be+-- installed or is invalid, or if a custom table already exists -- this+-- will raise a 'TableInstallException' exception.+--+-- This function is thread-safe.+installUnicodeWidthTable :: UnicodeWidthTable -> IO ()+installUnicodeWidthTable table = withInstallLock $ do+    initResult <- initCustomTable tableSize+    when (initResult /= 0) $+        E.throwIO $ TableInitFailure initResult tableSize++    forM_ (unicodeWidthTableRanges table) $ \r -> do+        result <- setCustomTableRange (rangeStart r)+                                      (rangeSize r)+                                      (rangeColumns r)++        when (result /= 0) $ do+            deallocateCustomTable+            E.throwIO $ TableRangeFailure result r++    actResult <- activateCustomTable+    when (actResult /= 0) $+        E.throwIO $ TableActivationFailure actResult++------------------------------------------------------------------------+-- C imports++foreign import ccall unsafe "vty_init_custom_table"+    initCustomTable :: Int -> IO Int++foreign import ccall unsafe "vty_set_custom_table_range"+    setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int++foreign import ccall unsafe "vty_activate_custom_table"+    activateCustomTable :: IO Int++foreign import ccall unsafe "vty_custom_table_ready"+    c_isCustomTableReady :: IO Int++foreign import ccall unsafe "vty_deallocate_custom_table"+    deallocateCustomTable :: IO ()
+ src/Graphics/Vty/UnicodeWidthTable/Main.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+-- | This module provides a command-line tool implementation for+-- building Vty character width tables and updating the user's local Vty+-- configuration to load them.+--+-- The API is parameterized on a platform-specific function to obtain+-- character widths. For example, on Unix platforms, this could be done+-- with a routine that communicates with the terminal to query it for+-- character widths. On other platforms, such a routine might interact+-- with a system library.+--+-- This tool is provided as a library implementation so that the tool+-- has a consistent interface across platforms and so that it implements+-- the Vty configuration update the same way everywhere.+module Graphics.Vty.UnicodeWidthTable.Main+  ( defaultMain+  )+where++import qualified Control.Exception as E+import Control.Monad (when)+import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif+import System.Directory (createDirectoryIfMissing)+import System.Environment (getArgs, getProgName)+import System.FilePath (takeDirectory)+import System.Exit (exitFailure)+import System.Console.GetOpt+import Text.Read (readMaybe)++import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName+                           , vtyConfigPath, addConfigWidthMap+                           , ConfigUpdateResult(..)+                           )+import Graphics.Vty.UnicodeWidthTable.IO+import Graphics.Vty.UnicodeWidthTable.Query++data Arg = Help+         | OutputPath String+         | TableUpperBound String+         | UpdateConfig+         | VtyConfigPath String+         deriving (Eq, Show)++options :: Config -> [OptDescr Arg]+options config =+    [ Option "h" ["help"] (NoArg Help)+      "This help output"+    , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")+      ("The maximum Unicode code point to test when building the table " <>+       "(default: " <> (show $ fromEnum $ configBound config) <> ")")+    , Option "p" ["path"] (ReqArg OutputPath "PATH")+      ("The output path to write to (default: " <>+       fromMaybe "<none>" (configOutputPath config) <> ")")+    , Option "u" ["update-config"] (NoArg UpdateConfig)+      "Create or update the Vty configuration file to use the new table (default: no)"+    , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")+      ("Update the specified Vty configuration file path when -u is set (default: " <>+       configPath config <> ")")+    ]++data Config =+    Config { configOutputPath :: Maybe FilePath+           , configBound :: Char+           , configUpdate :: Bool+           , configPath :: FilePath+           }+           deriving (Show)++mkDefaultConfig :: IO Config+mkDefaultConfig = do+    Config <$> terminalWidthTablePath+           <*> pure defaultUnicodeTableUpperBound+           <*> pure False+           <*> vtyConfigPath++usage :: IO ()+usage = do+    config <- mkDefaultConfig+    pn <- getProgName+    putStrLn $ "Usage: " <> pn <> " [options]"+    putStrLn ""+    putStrLn "This tool queries the terminal on stdout to determine the widths"+    putStrLn "of Unicode characters rendered to the terminal. The resulting data"+    putStrLn "is written to a table at the specified output path for later"+    putStrLn "loading by Vty-based applications."+    putStrLn ""++    putStrLn $ usageInfo pn (options config)++updateConfigFromArg :: Arg -> Config -> Config+updateConfigFromArg Help c =+    c+updateConfigFromArg UpdateConfig c =+    c { configUpdate = True }+updateConfigFromArg (VtyConfigPath p) c =+    c { configPath = p }+updateConfigFromArg (TableUpperBound s) c =+    case readMaybe s of+        Nothing -> error $ "Invalid table upper bound: " <> show s+        Just v  -> c { configBound = toEnum v }+updateConfigFromArg (OutputPath p) c =+    c { configOutputPath = Just p }++-- | Run the character width table builder tool using the specified+-- function to obtain character widths. This is intended to be a 'main'+-- implementation, e.g. @main = defaultMain getCharWidth@.+--+-- The tool queries the local terminal in some way (as determined by+-- the provided function) over a wide range of Unicode code points and+-- generates a table of character widths that can subsequently be loaded+-- by Vty-based applications.+--+-- The tool respects the following command-line flags, all of which are+-- optional and have sensible defaults:+--+-- * @-h@/@--help@: help output+-- * @-b@/@--bound@: Unicode code point upper bound to use when building+--   the table.+-- * @-p@/@--path@: the output path where the generated table should be+--   written.+-- * @-u@/@--update-config@: If given, create or update the user's Vty+--   configuration file to use the new table.+-- * @-c@/@--config-path@: the path to the user's Vty configuration.+defaultMain :: (Char -> IO Int) -> IO ()+defaultMain charWidth = do+    defConfig <- mkDefaultConfig+    strArgs <- getArgs+    let (args, unused, errors) = getOpt Permute (options defConfig) strArgs++    when (not $ null errors) $ do+        mapM_ putStrLn errors+        exitFailure++    when ((not $ null unused) || (Help `elem` args)) $ do+        usage+        exitFailure++    let config = foldr updateConfigFromArg defConfig args++    outputPath <- case configOutputPath config of+        Nothing -> do+            putStrLn "Error: could not obtain terminal width table path"+            exitFailure+        Just path -> return path++    putStrLn "Querying terminal:"+    builtTable <- buildUnicodeWidthTable charWidth $ configBound config++    let dir = takeDirectory outputPath+    createDirectoryIfMissing True dir+    writeUnicodeWidthTable outputPath builtTable++    putStrLn $ "\nOutput table written to " <> outputPath++    when (configUpdate config) $ do+        let cPath = configPath config+        Just tName <- currentTerminalName++        result <- E.try $ addConfigWidthMap cPath tName outputPath++        case result of+            Left (e::E.SomeException) -> do+                putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <>+                           show e+                exitFailure+            Right ConfigurationCreated -> do+                putStrLn $ "Configuration file created: " <> cPath+            Right ConfigurationModified -> do+                putStrLn $ "Configuration file updated: " <> cPath+            Right (ConfigurationConflict other) -> do+                putStrLn $ "Configuration file not updated: uses a different table " <>+                           "for TERM=" <> tName <> ": " <> other+            Right ConfigurationRedundant -> do+                putStrLn $ "Configuration file not updated: configuration " <>+                           cPath <> " already uses table " <> outputPath <>+                           " for TERM=" <> tName
+ src/Graphics/Vty/UnicodeWidthTable/Query.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TupleSections #-}+module Graphics.Vty.UnicodeWidthTable.Query+  ( buildUnicodeWidthTable+  , defaultUnicodeTableUpperBound+  )+where++import Control.Monad (forM)+import Data.Char (generalCategory, GeneralCategory(..))++import Graphics.Vty.UnicodeWidthTable.Types++shouldConsider :: Char -> Bool+shouldConsider c =+    case generalCategory c of+        Control     -> False+        NotAssigned -> False+        Surrogate   -> False+        _           -> True++-- | Convert a sequence of character/width pairs into a list of+-- run-length encoded ranges. This function assumes the pairs come+-- sorted by character ordinal value. It does not require that the+-- character range is fully covered by the sequence.+--+-- The result of this function is a list of ranges in reverse order+-- relative to the input sequence.+mkRanges :: [(Char, Int)] -> [WidthTableRange]+mkRanges pairs =+    let convertedPairs = convert <$> pairs+        convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i)++        go Nothing finishedRanges [] = finishedRanges+        go (Just r) finishedRanges [] = r:finishedRanges++        go Nothing finishedRanges ((c, width):rest) =+            go (Just $ WidthTableRange c 1 width) finishedRanges rest++        go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) =+            if c == prevCh + sz && prevWidth == width+            then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest+            else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest++    in go Nothing [] convertedPairs++-- The uppermost code point to consider when building Unicode width+-- tables.+defaultUnicodeTableUpperBound :: Char+defaultUnicodeTableUpperBound = '\xe0000'++-- | Construct a unicode character width table. This works by using the+-- provided function to obtain the appropriate width for each character+-- in a wide range of Unicode code points, which on some platforms+-- may perform local terminal operations or may interact with system+-- libraries. Depending on how the provided width function works, this+-- may need to be run only in a terminal that is not actively controlled+-- by a Vty handle.+--+-- The character argument specifies the upper bound code point to test+-- when building the table. This allows callers to decide how much of+-- the Unicode code point space to scan when building the table.+--+-- This does not handle exceptions.+buildUnicodeWidthTable :: (Char -> IO Int) -> Char -> IO UnicodeWidthTable+buildUnicodeWidthTable charWidth tableUpperBound = do+    pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->+        (i,) <$> charWidth i++    return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs+                             }
+ src/Graphics/Vty/UnicodeWidthTable/Types.hs view
@@ -0,0 +1,29 @@+module Graphics.Vty.UnicodeWidthTable.Types+  ( UnicodeWidthTable(..)+  , WidthTableRange(..)+  )+where++import Data.Word (Word8, Word32)++-- | A range of code points in a width table.+data WidthTableRange =+    WidthTableRange { rangeStart :: Word32+                    -- ^ The range's starting code point.+                    , rangeSize :: Word32+                    -- ^ The number of code points in the contiguous+                    -- range, beginning with the starting code point+                    -- ('rangeStart').+                    , rangeColumns :: Word8+                    -- ^ The terminal width, in columns, of all of the+                    -- characters corresponding to the code points in+                    -- this range.+                    }+    deriving (Eq, Show)++-- | A run-length-encoded table of Unicode character widths.+data UnicodeWidthTable =+    UnicodeWidthTable { unicodeWidthTableRanges :: [WidthTableRange]+                      -- ^ The ranges in the table.+                      }+    deriving (Show)
− test/Verify.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module Verify-  ( module Verify-  , module Control.Applicative-  , module Control.DeepSeq-  , module Control.Exception-  , module Control.Monad-  , module Test.QuickCheck-  , module Test.QuickCheck.Modifiers-  , module Text.Printf-  , succeeded-  , failed-  , monadicIO-  , liftIO-  , liftBool-  , Test(..)-  , Prop.Result(..)-  )-where--import Control.Exception ( bracket, try, SomeException(..) )--import Distribution.TestSuite hiding ( Result(..) )-import qualified Distribution.TestSuite as TS--import Test.QuickCheck hiding ( Result(..) )-import qualified Test.QuickCheck as QC-import Test.QuickCheck.Modifiers-import Test.QuickCheck.Property hiding ( Result(..) )-import qualified Test.QuickCheck.Property as Prop-import Test.QuickCheck.Monadic ( monadicIO )--import Text.Printf--import qualified Codec.Binary.UTF8.String as UTF8--import Control.Applicative hiding ( (<|>) )-import Control.DeepSeq-import Control.Monad ( forM, mapM, mapM_, forM_ )-import Control.Monad.State.Strict--import Numeric ( showHex )--verify :: Testable t => String -> t -> Test-verify testName p = Test $ TestInstance-  { name = testName-  , run = do-    qcResult <- quickCheckWithResult (stdArgs {chatty = False}) p-    case qcResult of-        QC.Success {..} -> return $ Finished TS.Pass-        QC.Failure {numShrinks,reason} -> return $ Finished-            $ TS.Fail $ "After "-                      ++ show numShrinks ++ " shrinks determined failure to be: "-                      ++ show reason-        _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"-  , tags = []-  , options = []-  , setOption = \_ _ -> Left "no options supported"-  }--data SingleColumnChar = SingleColumnChar Char-    deriving (Show, Eq)--instance Arbitrary SingleColumnChar where-    arbitrary = elements $ map SingleColumnChar [toEnum 0x21 .. toEnum 0x7E]--data DoubleColumnChar = DoubleColumnChar Char-    deriving (Eq)--instance Show DoubleColumnChar where-    show (DoubleColumnChar c) = "(0x" ++ showHex (fromEnum c) "" ++ ") ->" ++ UTF8.encodeString [c]--instance Arbitrary DoubleColumnChar where-    arbitrary = elements $ map DoubleColumnChar $-           [ toEnum 0x3040 .. toEnum 0x3098 ]-        ++ [ toEnum 0x309B .. toEnum 0xA4CF ]--liftIOResult :: Testable prop => IO prop -> Property-liftIOResult = ioProperty--data Bench where-    Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench
− test/Verify/Data/Terminfo/Parse.hs 
@@ -1,112 +0,0 @@-module Verify.Data.Terminfo.Parse-  ( module Verify.Data.Terminfo.Parse-  , module Data.Terminfo.Parse-  )-where--import Data.Terminfo.Parse-import Data.Terminfo.Eval-import Verify--import Data.Word-import qualified Data.Vector.Unboxed as Vector--import Numeric--hexDump :: [Word8] -> String-hexDump bytes = foldr (\b s -> showHex b s) "" bytes--data NonParamCapString = NonParamCapString String-    deriving Show--instance Arbitrary NonParamCapString where-    arbitrary-        = ( do-            s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%')-            return $ NonParamCapString s-          ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )--data LiteralPercentCap = LiteralPercentCap String [Word8]-    deriving ( Show )--instance Arbitrary LiteralPercentCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s-            return $ LiteralPercentCap s' bytes-          ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )--data IncFirstTwoCap = IncFirstTwoCap String [Word8]-    deriving ( Show )--instance Arbitrary IncFirstTwoCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            (s', bytes) <- insertEscapeOp "i" [] s-            return $ IncFirstTwoCap s' bytes-          ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )--data PushParamCap = PushParamCap String Int [Word8]-    deriving ( Show )--instance Arbitrary PushParamCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            n <- choose (1,9)-            (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s-            return $ PushParamCap s' n bytes-          ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )--data DecPrintCap = DecPrintCap String Int [Word8]-    deriving ( Show )--instance Arbitrary DecPrintCap where-    arbitrary-        = ( do-            NonParamCapString s <- arbitrary-            n <- choose (1,9)-            (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s-            return $ DecPrintCap s' n bytes-          ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )--insertEscapeOp opStr replBytes s = do-    insertPoints <- listOf1 $ elements [0 .. length s - 1]-    let s' = f s ('%' : opStr)-        remainingBytes = f (map (toEnum . fromEnum) s) replBytes-        f inVs out_v = concat [ vs-                              | vi <- zip inVs [0 .. length s - 1]-                              , let vs = fst vi : ( if snd vi `elem` insertPoints-                                                       then out_v-                                                       else []-                                                  )-                              ]-    return (s', remainingBytes)--isBytesOp :: CapOp -> Bool-isBytesOp (Bytes {}) = True--- isBytesOp _ = False--bytesForRange cap offset count-    = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap--collectBytes :: CapExpression -> [Word8]-collectBytes e = concat [ bytes-                        | Bytes offset count <- capOps e-                        , let bytes = bytesForRange e offset count-                        ]---verifyBytesEqual :: [Word8] -> [Word8] -> Result-verifyBytesEqual outBytes expectedBytes-    = if outBytes == expectedBytes-        then succeeded-        else failed-             { reason = "outBytes ["-                      ++ hexDump outBytes-                      ++ "] /= expectedBytes ["-                      ++ hexDump expectedBytes-                      ++ "]"-             }
− test/Verify/Graphics/Vty/Attributes.hs 
@@ -1,73 +0,0 @@-module Verify.Graphics.Vty.Attributes-  ( module Verify.Graphics.Vty.Attributes-  , module Graphics.Vty.Attributes-  )-where--import Graphics.Vty.Attributes-import Verify--import Data.List ( delete )--allColors :: [Color]-allColors =-    [ black-    , red-    , green-    , yellow-    , blue-    , magenta-    , cyan-    , white-    , brightBlack-    , brightRed-    , brightGreen-    , brightYellow-    , brightBlue-    , brightMagenta-    , brightCyan-    , brightWhite-    ] ++ map Color240 [0..239]--allStyles :: [Style]-allStyles =-    [ standout-    , underline-    , reverseVideo-    , blink-    , dim-    , bold-    ]---- Limit the possible attributes to just a few for now.-possibleAttrMods :: [ AttrOp ]-possibleAttrMods =-    [ idOp-    ] ++ map setForeColorOp allColors-      ++ map setBackColorOp allColors-      ++ map setStyleOp allStyles--instance Arbitrary Attr where-    arbitrary = elements possibleAttrMods >>= return . flip applyOp defAttr--data DiffAttr = DiffAttr Attr Attr--instance Arbitrary DiffAttr where-    arbitrary = do-        op0 <- elements possibleAttrMods-        let possibleAttrMods' = delete op0 possibleAttrMods-        op1 <- elements possibleAttrMods'-        return $ DiffAttr (applyOp op0 defAttr) (applyOp op1 defAttr)--data AttrOp = AttrOp String (Attr -> Attr)--instance Eq AttrOp where-    AttrOp n0 _ == AttrOp n1 _ = n0 == n1--setStyleOp s     = AttrOp "set_style"      (flip withStyle s)-setForeColorOp c = AttrOp "set_fore_color" (flip withForeColor c)-setBackColorOp c = AttrOp "set_back_color" (flip withBackColor c)-idOp = AttrOp "id" id--applyOp :: AttrOp -> Attr -> Attr-applyOp (AttrOp _ f) a = f a
− test/Verify/Graphics/Vty/DisplayAttributes.hs 
@@ -1,8 +0,0 @@-module Verify.Graphics.Vty.DisplayAttributes-  ( module Verify.Graphics.Vty.DisplayAttributes-  , module Graphics.Vty.DisplayAttributes-  )-where--import Graphics.Vty.DisplayAttributes-import Verify
− test/Verify/Graphics/Vty/Image.hs 
@@ -1,218 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE DisambiguateRecordFields #-}-module Verify.Graphics.Vty.Image-  ( module Verify.Graphics.Vty.Image-  , module Graphics.Vty.Image-  )-where--import Verify.Graphics.Vty.Attributes-import Graphics.Vty.Image-import Graphics.Vty.Image.Internal--import Verify--data UnitImage = UnitImage Char Image--instance Arbitrary UnitImage where-    arbitrary = do-        SingleColumnChar c <- arbitrary-        a <- arbitrary-        return $ UnitImage c (char a c)--instance Show UnitImage where-    show (UnitImage c _) = "UnitImage " ++ show c--data DefaultImage = DefaultImage Image--instance Show DefaultImage where-    show (DefaultImage i)-        = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i)--instance Arbitrary DefaultImage where-    arbitrary = do-        i <- return $ char defAttr 'X'-        return $ DefaultImage i--data SingleRowSingleAttrImage-    = SingleRowSingleAttrImage-      { expectedAttr :: Attr-      , expectedColumns :: Int-      , rowImage :: Image-      }--instance Show SingleRowSingleAttrImage where-    show (SingleRowSingleAttrImage attr columns image)-        = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"--newtype WidthResize = WidthResize (Image -> (Image, Int))--instance Arbitrary WidthResize where-    arbitrary = do-        WidthResize f <- arbitrary-        w <- choose (1,64)-        oneof $ map (return . WidthResize)-            [ \i -> (i, imageWidth i)-            , \i -> (resizeWidth w $ fst $ f i, w)-            , \i -> let i' = fst $ f i in (cropLeft w i', min (imageWidth i') w)-            , \i -> let i' = fst $ f i in (cropRight w i', min (imageWidth i') w)-            ]--newtype HeightResize = HeightResize (Image -> (Image, Int))--instance Arbitrary HeightResize where-    arbitrary = do-        HeightResize f <- arbitrary-        h <- choose (1,64)-        oneof $ map (return . HeightResize)-            [ \i -> (i, imageHeight i)-            , \i -> (resizeHeight h $ fst $ f i, h)-            , \i -> let i' = fst $ f i in (cropTop h i', min (imageHeight i') h)-            , \i -> let i' = fst $ f i in (cropBottom h i', min (imageHeight i') h)-            ]--newtype ImageResize = ImageResize (Image -> (Image, (Int, Int)))--instance Arbitrary ImageResize where-    arbitrary = oneof-        [ return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))-        , do-            ImageResize f <- arbitrary-            WidthResize g <- arbitrary-            return $! ImageResize $! \i ->-                let (i0, (_, outHeight)) = f i-                    gI = g i0-                in (fst gI, (snd gI, outHeight))-        , do-            ImageResize f <- arbitrary-            HeightResize g <- arbitrary-            return $! ImageResize $! \i ->-                let (i0, (outWidth, _)) = f i-                    gI = g i0-                in (fst gI, (outWidth, snd gI))-        ]---instance Arbitrary SingleRowSingleAttrImage where-    arbitrary = do-        -- The text must contain at least one character. Otherwise the-        -- image simplifies to the IdImage which has a height of 0. If-        -- this is to represent a single row then the height must be 1-        singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary)-        a <- arbitrary-        let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText]-            outWidth = length singleColumnRowText-        return $ SingleRowSingleAttrImage a outWidth outImage--data SingleRowTwoAttrImage-    = SingleRowTwoAttrImage-    { part0 :: SingleRowSingleAttrImage-    , part1 :: SingleRowSingleAttrImage-    , joinImage :: Image-    } deriving Show--instance Arbitrary SingleRowTwoAttrImage where-    arbitrary = do-        p0 <- arbitrary-        p1 <- arbitrary-        return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1)--data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack-    { stackImage :: Image-    , stackSourceImages :: [SingleRowSingleAttrImage]-    , stackWidth :: Int-    , stackHeight :: Int-    }-    deriving Show--instance Arbitrary SingleAttrSingleSpanStack where-    arbitrary = do-        imageList <- Verify.resize 16 (listOf1 arbitrary)-        return $ mkSingleAttrSingleSpanStack imageList-    shrink s = do-        imageList <- shrink $ stackSourceImages s-        if null imageList-            then []-            else return $ mkSingleAttrSingleSpanStack imageList--mkSingleAttrSingleSpanStack imageList =-    let image = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- imageList ]-    in SingleAttrSingleSpanStack image imageList (maximum $ map expectedColumns imageList)-                                                 (toEnum $ length imageList)--instance Arbitrary Image  where-    arbitrary = oneof-        [ return EmptyImage-        , do-            SingleAttrSingleSpanStack {stackImage} <- Verify.resize 8 arbitrary-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f stackImage-        , do-            SingleAttrSingleSpanStack {stackImage} <- Verify.resize 8 arbitrary-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f stackImage-        , do-            i0 <- arbitrary-            i1 <- arbitrary-            let i = i0 <|> i1-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f i-        , do-            i0 <- arbitrary-            i1 <- arbitrary-            let i = i0 <-> i1-            ImageResize f <- Verify.resize 2 arbitrary-            return $! fst $! f i-        ]-    {--    shrink i@(HorizJoin {partLeft, partRight}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        !partLeft' <- shrink partLeft-        !partRight' <- shrink partRight-        [i_alt, partLeft' <|> partRight']-    shrink i@(VertJoin {partTop, partBottom}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        !partTop' <- shrink partTop-        !partBottom' <- shrink partBottom-        [i_alt, partTop' <-> partBottom']-    shrink i@(CropRight {croppedImage, outputWidth}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i@(CropLeft {croppedImage, leftSkip, outputWidth}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i@(CropBottom {croppedImage, outputHeight}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i@(CropTop {croppedImage, topSkip, outputHeight}) = do-        let !i_alt = backgroundFill (imageWidth i) (imageHeight i)-        [i_alt, croppedImage]-    shrink i = [emptyImage, backgroundFill (imageWidth i) (imageHeight i)]-    -}--data CropOperation-    = CropFromLeft-    | CropFromRight-    | CropFromTop-    | CropFromBottom-    deriving (Eq, Show)--instance Arbitrary CropOperation where-    arbitrary = oneof $ map return [CropFromLeft, CropFromRight, CropFromTop, CropFromBottom]--data Translation = Translation Image (Int, Int) Image-    deriving (Eq, Show)--instance Arbitrary Translation where-    arbitrary = do-        i <- arbitrary-        x <- arbitrary `suchThat` (> 0)-        y <- arbitrary `suchThat` (> 0)-        let i' = translate x y i-        return $ Translation i (x,y) i'
− test/Verify/Graphics/Vty/Output.hs 
@@ -1,59 +0,0 @@-module Verify.Graphics.Vty.Output where--import Control.Applicative ((<$>))--import Graphics.Vty.Output.Mock--import Data.IORef-import qualified Data.String.UTF8 as UTF8--import Test.QuickCheck.Property---- A list of terminals that should be supported. This started with a--- list of terminals ubuntu supported. Then those terminals that really--- could not be supported were removed. Then a few more were pruned--- until a reasonable looking set was made.-terminalsOfInterest :: [String]-terminalsOfInterest =-    [ "vt100"-    , "vt220"-    , "vt102"-    , "xterm-r5"-    , "xterm-xfree86"-    , "xterm-r6"-    , "xterm-256color"-    , "xterm-vt220"-    , "xterm-debian"-    , "xterm-mono"-    , "xterm-color"-    , "xterm"-    , "mach"-    , "mach-bold"-    , "mach-color"-    , "linux"-    , "ansi"-    , "hurd"-    , "Eterm"-    , "pcansi"-    , "screen-256color"-    , "screen-bce"-    , "screen-s"-    , "screen-w"-    , "screen"-    , "screen-256color-bce"-    , "sun"-    , "rxvt"-    , "rxvt-unicode"-    , "rxvt-basic"-    , "cygwin"-    ]--compareMockOutput :: MockData -> String -> IO Result-compareMockOutput mockData expectedStr = do-    outStr <- UTF8.toString <$> readIORef mockData-    if outStr /=  expectedStr-        then return $ failed { reason = "bytes\n" ++ outStr-                                      ++ "\nare not the expected bytes\n"-                                      ++ expectedStr-                             }-        else return succeeded
− test/Verify/Graphics/Vty/Picture.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-module Verify.Graphics.Vty.Picture-  ( module Verify.Graphics.Vty.Picture-  , module Graphics.Vty.Picture-  )-where--import Verify.Graphics.Vty.Prelude--import Graphics.Vty.Picture-import Graphics.Vty.Debug--import Verify.Graphics.Vty.Attributes-import Verify.Graphics.Vty.Image--import Verify--data DefaultPic = DefaultPic-    { defaultPic :: Picture-    , defaultWin :: MockWindow-    }--instance Show DefaultPic where-    show (DefaultPic pic win)-        = "DefaultPic\n\t( " ++ show pic ++ ")\n\t" ++ show win ++ "\n"--instance Arbitrary DefaultPic where-    arbitrary = do-        DefaultImage image <- arbitrary-        let win = MockWindow (imageWidth image) (imageHeight image)-        return $ DefaultPic (picForImage image)-                            win--data PicWithBGAttr = PicWithBGAttr-    { withAttrPic :: Picture-    , withAttrWin :: MockWindow-    , withAttrSpecifiedAttr :: Attr-    } deriving ( Show )--instance Arbitrary PicWithBGAttr where-    arbitrary = do-        DefaultImage image <- arbitrary-        let win = MockWindow (imageWidth image) (imageHeight image)-        attr <- arbitrary-        return $ PicWithBGAttr (picForImage image)-                               win-                               attr--instance Arbitrary Picture where-    arbitrary = do-        layers <- Verify.resize 20 (listOf1 arbitrary)-        return $ picForLayers layers
− test/Verify/Graphics/Vty/Prelude.hs 
@@ -1,24 +0,0 @@-module Verify.Graphics.Vty.Prelude-  ( module Verify.Graphics.Vty.Prelude-  , MockWindow(..)-  )-where--import Graphics.Vty.Debug--import Verify--data EmptyWindow = EmptyWindow MockWindow--instance Arbitrary EmptyWindow where-    arbitrary = return $ EmptyWindow (MockWindow (0 :: Int) (0 :: Int))--instance Show EmptyWindow where-    show (EmptyWindow _) = "EmptyWindow"--instance Arbitrary MockWindow where-    arbitrary = do-        w <- choose (1,1024)-        h <- choose (1,1024)-        return $ MockWindow w h-
− test/Verify/Graphics/Vty/Span.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Verify.Graphics.Vty.Span-  ( module Verify.Graphics.Vty.Span-  , module Graphics.Vty.Span-  )-where--import Graphics.Vty.Debug-import Graphics.Vty.Span--import Verify.Graphics.Vty.Picture--import qualified Data.Vector as Vector-import Data.Word--import Verify--isAttrSpanOp :: SpanOp -> Bool-isAttrSpanOp TextSpan {} = True-isAttrSpanOp _           = False--verifyAllSpansHaveWidth i spans w-    = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)-      in case any ((== True) . fst) v of-        False -> succeeded-        True -> failed { reason = "Not all spans contained operations defining exactly "-                                ++ show w-                                ++ " columns of output - \n"-                                ++ (concatMap ((++ "\n") . show)) v-                            }--verifyOpsEquality i_ops i_alt_ops =-    if i_ops == i_alt_ops-        then succeeded-        else failed { reason = "ops for alternate image " ++ show i_alt_ops-                               ++ " are not the same as " ++ show i_ops-                    }
− test/VerifyAttributeOps.hs 
@@ -1,9 +0,0 @@-module VerifyAttributeOps where--import Verify.Graphics.Vty.Attributes--import Verify--tests :: IO [Test]-tests = return []-
− test/VerifyConfig.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module Main where--import Graphics.Vty.Config-import Graphics.Vty.Input.Events--import Data.String.QQ-import qualified Data.ByteString.Char8 as B--import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)--exampleConfig :: B.ByteString-exampleConfig = B.pack [s|--- comments should be ignored.-map _ "\ESC[B" KUp []-askfjla dfasjdflk jasdlkfj asdfj -- lines failing parse should be ignored-map _ "\ESC[1;3B" KDown [MAlt]-map "xterm" "\ESC[1;3B" KDown [MAlt]-map "xterm-256-color" "\ESC[1;3B" KDown [MAlt]-debugLog "/tmp/vty-debug.txt"-|]--exampleConfigConfig :: Config-exampleConfigConfig = defaultConfig-    { debugLog = Just "/tmp/vty-debug.txt"-    , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])-                 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])-                 , (Just "xterm", "\ESC[1;3B", EvKey KDown [MAlt])-                 , (Just "xterm-256-color", "\ESC[1;3B", EvKey KDown [MAlt])-                 ]-    }--exampleConfigParses :: IO ()-exampleConfigParses =-  assertEqual "example config parses as expected"-    exampleConfigConfig-    (runParseConfig "exampleConfig" exampleConfig)--main :: IO ()-main = defaultMain-    [ testCase "example config parses" $ exampleConfigParses-    ]
− test/VerifyCropSpanGeneration.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifyCropSpanGeneration where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Span--import Graphics.Vty.Debug-import Graphics.Vty.PictureToSpans--import Verify--import qualified Data.Vector as Vector--cropOpDisplayOps :: (Int -> Image -> Image) ->-                    Int -> Image -> (DisplayOps, Image)-cropOpDisplayOps cropOp v i =-    let iOut = cropOp v i-        p = picForImage iOut-        w = MockWindow (imageWidth iOut) (imageHeight iOut)-    in (displayOpsForPic p (regionForWindow w), iOut)--widthCropOutputColumns :: (Int -> Image -> Image) ->-                          SingleAttrSingleSpanStack ->-                          NonNegative Int ->-                          Property-widthCropOutputColumns cropOp s (NonNegative w) = stackWidth s > w ==>-    let (ops, iOut) = cropOpDisplayOps cropOp w (stackImage s)-    in verifyAllSpansHaveWidth iOut ops w--heightCropOutputColumns :: (Int -> Image -> Image) ->-                           SingleAttrSingleSpanStack ->-                           NonNegative Int ->-                           Property-heightCropOutputColumns cropOp s (NonNegative h) = stackHeight s > h ==>-    let (ops, _) = cropOpDisplayOps cropOp h (stackImage s)-    in displayOpsRows ops == h--cropRightOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropRightOutputColumns = widthCropOutputColumns cropRight--cropLeftOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropLeftOutputColumns = widthCropOutputColumns cropLeft--cropTopOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropTopOutputRows = heightCropOutputColumns cropTop--cropBottomOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property-cropBottomOutputRows = heightCropOutputColumns cropBottom---- TODO: known benign failure.-cropRightAndLeftRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property-cropRightAndLeftRejoinedEquivalence stack = imageWidth (stackImage stack) `mod` 2 == 0 ==>-    let i = stackImage stack-        -- the right part is made by cropping the image from the left.-        iR = cropLeft (imageWidth i `div` 2) i-        -- the left part is made by cropping the image from the right-        iL = cropRight (imageWidth i `div` 2) i-        iAlt = iL <|> iR-        iOps = displayOpsForImage i-        iAltOps = displayOpsForImage iAlt-    in verifyOpsEquality iOps iAltOps--cropTopAndBottomRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property-cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod` 2 == 0 ==>-    let i = stackImage stack-        -- the top part is made by cropping the image from the bottom.-        iT = cropBottom (imageHeight i `div` 2) i-        -- the bottom part is made by cropping the image from the top.-        iB = cropTop (imageHeight i `div` 2) i-        iAlt = iT <-> iB-    in displayOpsForImage i == displayOpsForImage iAlt--tests :: IO [Test]-tests = return-    [ verify "cropping from the bottom produces display operations covering the expected rows"-        cropBottomOutputRows-    , verify "cropping from the top produces display operations covering the expected rows"-        cropTopOutputRows-    , verify "cropping from the left produces display operations covering the expected columns"-        cropLeftOutputColumns-    , verify "cropping from the right produces display operations covering the expected columns"-        cropRightOutputColumns-    -- TODO: known benign failure.-    -- , verify "the output of a stack is the same as that stack cropped left & right and joined together"-    --     cropRightAndLeftRejoinedEquivalence-    , verify "the output of a stack is the same as that stack cropped top & bottom and joined together"-        cropTopAndBottomRejoinedEquivalence-    ]
− test/VerifyDisplayAttributes.hs 
@@ -1,9 +0,0 @@-module VerifyDisplayAttributes where--import Verify.Graphics.Vty.DisplayAttributes-import Verify.Graphics.Vty.Attributes--import Verify--tests :: IO [Test]-tests = return []
− test/VerifyEmptyImageProps.hs 
@@ -1,13 +0,0 @@-module VerifyEmptyImageProps where--import Verify---- should be exported by Graphics.Vty.Picture-import Graphics.Vty.Image ( Image, emptyImage )--tests :: IO [Test]-tests = do-    -- should provide an image type.-    let _ :: Image = emptyImage-    return []-
− test/VerifyEvalTerminfoCaps.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifyEvalTerminfoCaps where--import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)-import Data.Terminfo.Eval-import Data.Terminfo.Parse-import Control.DeepSeq--import qualified System.Console.Terminfo as Terminfo--import Verify-import Verify.Graphics.Vty.Output--import Control.Applicative ( (<$>) )-import Control.Exception ( try, SomeException(..) )--import Control.Monad ( mapM_, forM, forM_ )--import Data.Maybe ( fromJust )-import Data.Word--import Foreign.Marshal.Alloc (mallocBytes)-import Foreign.Ptr (Ptr, minusPtr)-import Numeric---- If a terminal defines one of the caps then it's expected to be--- parsable.-capsOfInterest =-    [ "cup"-    , "sc"-    , "rc"-    , "setf"-    , "setb"-    , "setaf"-    , "setab"-    , "op"-    , "cnorm"-    , "civis"-    , "smcup"-    , "rmcup"-    , "clear"-    , "hpa"-    , "vpa"-    , "sgr"-    , "sgr0"-    ]--fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)--tests :: IO [Test]-tests = do-    -- 1 MB should be big enough for any termcaps ;-)-    evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024)-    fmap concat $ forM terminalsOfInterest $ \termName -> do-        putStrLn $ "adding tests for terminal: " ++ termName-        mti <- try $ Terminfo.setupTerm termName-        case mti of-            Left (_e :: SomeException)-                -> return []-            Right ti -> do-                fmap concat $ forM capsOfInterest $ \capName -> do-                    case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of-                        Just capDef -> do-                            putStrLn $ "\tadding test for cap: " ++ capName-                            let testName = termName ++ "(" ++ capName ++ ")"-                            case parseCapExpression capDef of-                                Left error -> return [verify testName (failed {reason = "parse error " ++ show error})]-                                Right !cap_expr -> return [verify testName (verifyEvalCap evalBuffer cap_expr)]-                        Nothing      -> do-                            return []--{-# NOINLINE verifyEvalCap #-}-verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property-verifyEvalCap evalBuffer expr !junkInt = do-    forAll (vector 9) $ \inputValues ->-        let write = writeCapExpr expr inputValues-            !byteCount = getBound write-        in liftIOResult $ do-            let startPtr :: Ptr Word8 = evalBuffer-            forM_ [0..100] $ \i -> runWrite write startPtr-            endPtr <- runWrite write startPtr-            case endPtr `minusPtr` startPtr of-                count | count < 0        ->-                            return $ failed { reason = "End pointer before start pointer." }-                      | toEnum count > byteCount ->-                            return $ failed { reason = "End pointer past end of buffer by "-                                                       ++ show (toEnum count - byteCount)-                                            }-                      | otherwise        ->-                            return succeeded
− test/VerifyImageOps.hs 
@@ -1,173 +0,0 @@-module VerifyImageOps where--import Graphics.Vty.Attributes-import Graphics.Vty.Image.Internal-import Verify.Graphics.Vty.Image--import Verify--import Control.DeepSeq--twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool-twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =-    imageWidth (char defAttr c1 <|> char defAttr c2) == 2--manySwHorizConcat :: [SingleColumnChar] -> Bool-manySwHorizConcat cs =-    let chars = [ char | SingleColumnChar char <- cs ]-        l = fromIntegral $ length cs-    in imageWidth ( horizCat $ map (char defAttr) chars ) == l--twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool-twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =-    imageHeight (char defAttr c1 <-> char defAttr c2) == 2--horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool-horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =-    (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2-    ==-    char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)--twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool-twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =-    imageWidth (char defAttr c1 <|> char defAttr c2) == 4--manyDwHorizConcat :: [DoubleColumnChar] -> Bool-manyDwHorizConcat cs =-    let chars = [ char | DoubleColumnChar char <- cs ]-        l = fromIntegral $ length cs-    in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2--twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool-twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =-    imageHeight (char defAttr c1 <-> char defAttr c2) == 2--horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool-horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =-    (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2-    ==-    char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)--vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool-vertContatSingleRow (NonEmpty stack) =-    let expectedHeight :: Int = length stack-        stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]-    in imageHeight stackImage == expectedHeight--disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage-                        -> NonEmptyList SingleRowSingleAttrImage-                        -> Bool-disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =-    let expectedHeight :: Int = max (length stack0) (length stack1)-        stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-    in imageHeight (stackImage0 <|> stackImage1) == expectedHeight---disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage-                              -> NonEmptyList SingleRowSingleAttrImage-                              -> Bool-disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =-    let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-        image = stackImage0 <|> stackImage1-        expectedHeight = imageHeight image-    in case image of-        HorizJoin {}  -> ( expectedHeight == (imageHeight $ partLeft image) )-                         &&-                         ( expectedHeight == (imageHeight $ partRight image) )-        _             -> True--disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage-                      -> NonEmptyList SingleRowSingleAttrImage-                      -> Bool-disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =-    let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)-        stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-        stack0Image = vertCat stack0Images-        stack1Image = vertCat stack1Images-        image = stack0Image <-> stack1Image-    in imageWidth image == expectedWidth--disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage-                            -> NonEmptyList SingleRowSingleAttrImage-                            -> Bool-disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =-    let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)-        stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]-        stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]-        stack0Image = vertCat stack0Images-        stack1Image = vertCat stack1Images-        image = stack0Image <-> stack1Image-    in case image of-        VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )-                       &&-                       ( expectedWidth == (imageWidth $ partBottom image) )-        _           -> True--translationIsLinearOnOutSize :: Translation -> Bool-translationIsLinearOnOutSize (Translation i (x,y) i') =-    imageWidth i' == imageWidth i + x && imageHeight i' == imageHeight i + y--paddingIsLinearOnOutSize :: Image -> Gen Bool-paddingIsLinearOnOutSize i = do-    l <- offset-    t <- offset-    r <- offset-    b <- offset-    let i' = pad l t r b i-    return $ imageWidth i' == imageWidth i + l + r && imageHeight i' == imageHeight i + t + b-    where offset = choose (1,1024)--cropLeftLimitsWidth :: Image -> Int -> Property-cropLeftLimitsWidth i v = v >= 0 ==>-    v >= imageWidth (cropLeft v i)--cropRightLimitsWidth :: Image -> Int -> Property-cropRightLimitsWidth i v = v >= 0 ==>-    v >= imageWidth (cropRight v i)--cropTopLimitsHeight :: Image -> Int -> Property-cropTopLimitsHeight i v = v >= 0 ==>-    v >= imageHeight (cropTop v i)--cropBottomLimitsHeight :: Image -> Int -> Property-cropBottomLimitsHeight i v = v >= 0 ==>-    v >= imageHeight (cropBottom v i)---- rediculous tests just to satisfy my desire for nice code coverage :-P-canShowImage :: Image -> Bool-canShowImage i = length (show i) > 0--canRnfImage :: Image -> Bool-canRnfImage i = rnf i == ()--canPpImage :: Image -> Bool-canPpImage i = length (ppImageStructure i) > 0--tests :: IO [Test]-tests = return-    [ verify "twoSwHorizConcat" twoSwHorizConcat-    , verify "manySwHorizConcat" manySwHorizConcat-    , verify "twoSwVertConcat" twoSwVertConcat-    , verify "horizConcatSwAssoc" horizConcatSwAssoc-    , verify "manyDwHorizConcat" manyDwHorizConcat-    , verify "twoDwHorizConcat" twoDwHorizConcat-    , verify "twoDwVertConcat" twoDwVertConcat-    , verify "horizConcatDwAssoc" horizConcatDwAssoc-    , verify "single row vert concats to correct height" vertContatSingleRow-    , verify "disjointHeightHorizJoin" disjointHeightHorizJoin-    , verify "disjointHeightHorizJoin BG fill" disjointHeightHorizJoinBgFill-    , verify "disjointWidthVertJoin" disjointWidthVertJoin-    , verify "disjointWidthVertJoin BG fill" disjointWidthVertJoinBgFill-    , verify "translation effects output dimensions linearly" translationIsLinearOnOutSize-    , verify "padding effects output dimensions linearly" paddingIsLinearOnOutSize-    , verify "crop left limits width" cropLeftLimitsWidth-    , verify "crop right limits width" cropRightLimitsWidth-    , verify "crop top limits height" cropTopLimitsHeight-    , verify "crop bottom limits height" cropBottomLimitsHeight-    , verify "can show image" canShowImage-    , verify "can rnf image" canRnfImage-    , verify "can pp image" canPpImage-    ]
− test/VerifyImageTrans.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-module VerifyImageTrans where--import Verify.Graphics.Vty.Image--import Graphics.Vty.Image.Internal--import Verify--import Data.Word--isHorizTextOfColumns :: Image -> Int -> Bool-isHorizTextOfColumns (HorizText { outputWidth = inW }) expectedW = inW == expectedW-isHorizTextOfColumns (BGFill { outputWidth = inW }) expectedW = inW == expectedW-isHorizTextOfColumns _image _expectedW = False--verifyHorizContatWoAttrChangeSimplifies :: SingleRowSingleAttrImage -> Bool-verifyHorizContatWoAttrChangeSimplifies (SingleRowSingleAttrImage _attr charCount image) =-    isHorizTextOfColumns image charCount--verifyHorizContatWAttrChangeSimplifies :: SingleRowTwoAttrImage -> Bool-verifyHorizContatWAttrChangeSimplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 charCount0 _image0)-                                                               (SingleRowSingleAttrImage attr1 charCount1 _image1)-                                                               i-                                             )-    | charCount0 == 0 || charCount1 == 0 || attr0 == attr1 = isHorizTextOfColumns i (charCount0 + charCount1)-    | otherwise = False == isHorizTextOfColumns i (charCount0 + charCount1)--tests :: IO [Test]-tests = return-    [ verify "verifyHorizContatWoAttrChangeSimplifies" verifyHorizContatWoAttrChangeSimplifies-    , verify "verifyHorizContatWAttrChangeSimplifies" verifyHorizContatWAttrChangeSimplifies-    ]-
− test/VerifyInline.hs 
@@ -1,31 +0,0 @@-module VerifyInline where--import Graphics.Vty.Inline-import Graphics.Vty.Output-import Graphics.Vty.Output.TerminfoBased as TerminfoBased--import Verify.Graphics.Vty.Output--import Verify--import Distribution.TestSuite--import System.IO--tests :: IO [Test]-tests = concat <$> forM terminalsOfInterest (\termName -> return $-    [ Test $ TestInstance-        { name = "verify vty inline"-        , run = do-            {- disabled because I cannot get useful output out of cabal why this fails.-            nullOut <- openFile "/dev/null" WriteMode-            t <- TerminfoBased.reserveTerminal termName nullOut-            putAttrChange t $ default_all-            releaseTerminal t-            -}-            return $ Finished Pass-        , tags = []-        , options = []-        , setOption = \_ _ -> Left "no options supported"-        }-    ])
− test/VerifyLayersSpanGeneration.hs 
@@ -1,130 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifyLayersSpanGeneration where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Attributes-import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Span--import Graphics.Vty.Debug-import Graphics.Vty.PictureToSpans--import Verify--import qualified Data.Vector as Vector--largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-largerHorizSpanOcclusion row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        (iLarger, iSmaller) = if imageWidth i0 > imageWidth i1 then (i0, i1) else (i1, i0)-        expectedOps = displayOpsForImage iLarger-        p = picForLayers [iLarger, iSmaller]-        ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger)-    in verifyOpsEquality expectedOps ops---- | Two rows stacked vertical is equivalent to the first row rendered--- as the top layer and the second row rendered as a bottom layer with a--- background fill where the first row would be.-vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-vertStackLayerEquivalence0 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <-> i1-        p = picForImage i-        iLower = backgroundFill (imageWidth i0) 1 <-> i1-        pLayered = picForLayers [i0, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered--vertStackLayerEquivalence1 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-vertStackLayerEquivalence1 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <-> i1-        p = picForImage i-        iLower = i0 <-> backgroundFill (imageWidth i1) 1-        iUpper = backgroundFill (imageWidth i0) 1 <-> i1-        pLayered = picForLayers [iUpper, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered---- | Two rows horiz joined is equivalent to the first row rendered as--- the top layer and the second row rendered as a bottom layer with a--- background fill where the first row would be.-horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-horizJoinLayerEquivalence0 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <|> i1-        p = picForImage i-        iLower = backgroundFill (imageWidth i0) 1 <|> i1-        pLayered = picForLayers [i0, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered--horizJoinLayerEquivalence1 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result-horizJoinLayerEquivalence1 row0 row1 =-    let i0 = rowImage row0-        i1 = rowImage row1-        i = i0 <|> i1-        p = picForImage i-        iLower = i0 <|> backgroundFill (imageWidth i1) 1-        iUpper = backgroundFill (imageWidth i0) 1 <|> i1-        pLayered = picForLayers [iUpper, iLower]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)-    in verifyOpsEquality expectedOps opsLayered--horizJoinAlternate0 :: Result-horizJoinAlternate0 =-    let size = 4-        str0 = replicate size 'a'-        str1 = replicate size 'b'-        i0 = string defAttr str0-        i1 = string defAttr str1-        i = horizCat $ zipWith horizJoin (replicate size i0) (replicate size i1)-        layer0 = horizCat $ replicate size $ i0 <|> backgroundFill size 1-        layer1 = horizCat $ replicate size $ backgroundFill size 1 <|> i1-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic (picForLayers [layer0, layer1])-                                      (imageWidth i,imageHeight i)-    in verifyOpsEquality expectedOps opsLayered--horizJoinAlternate1 :: Result-horizJoinAlternate1 =-    let size = 4-        str0 = replicate size 'a'-        str1 = replicate size 'b'-        i0 = string defAttr str0-        i1 = string defAttr str1-        i = horizCat $ zipWith horizJoin (replicate size i0) (replicate size i1)-        layers = [l | b <- take 4 [0,size*2..], let l = backgroundFill b 1 <|> i0 <|> i1]-        expectedOps = displayOpsForImage i-        opsLayered = displayOpsForPic (picForLayers layers)-                                      (imageWidth i,imageHeight i)-    in verifyOpsEquality expectedOps opsLayered--tests :: IO [Test]-tests = return-    [ verify "a larger horiz span occludes a smaller span on a lower layer"-        largerHorizSpanOcclusion-    , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"-        vertStackLayerEquivalence0-    , verify "two rows stack vertical equiv to first image layered on top of second with padding (1)"-        vertStackLayerEquivalence1-    -- , verify "two rows horiz joined equiv to first image layered on top of second with padding (0)"-    --     horizJoinLayerEquivalence0-    -- , verify "two rows horiz joined equiv to first image layered on top of second with padding (1)"-    --     horizJoinLayerEquivalence1-    -- , verify "alternating images using joins is the same as alternating images using layers (0)"-    --     horizJoinAlternate0-    -- , verify "alternating images using joins is the same as alternating images using layers (1)"-    --     horizJoinAlternate1-    ]
− test/VerifyOutput.hs 
@@ -1,54 +0,0 @@--- We setup the environment to envoke certain terminals of interest.--- This assumes appropriate definitions exist in the current environment--- for the terminals of interest.-module VerifyOutput where--import Verify--import Graphics.Vty--import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Output--import Control.Monad--import qualified System.Console.Terminfo as Terminfo-import System.Posix.Env-import System.Posix.IO--tests :: IO [Test]-tests = concat <$> forM terminalsOfInterest (\termName -> do-    -- check if that terminfo exists-    -- putStrLn $ "testing end to end for terminal: " ++ termName-    mti <- try $ Terminfo.setupTerm termName-    case mti of-        Left (_ :: SomeException) -> return []-        Right _ -> return [ verify ("verify " ++ termName ++ " could output a picture")-                                   (smokeTestTermNonMac termName)-                          ]-    )--smokeTestTermNonMac :: String -> Image -> Property-smokeTestTermNonMac termName i = liftIOResult $ do-    smokeTestTerm termName i--smokeTestTerm :: String -> Image -> IO Result-smokeTestTerm termName i = do-    nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags-    t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }-    -- putStrLn $ "context color count: " ++ show (contextColorCount t)-    reserveDisplay t-    dc <- displayContext t (100,100)-    -- always show the cursor to produce tests for terminals with no-    -- cursor support.-    let pic = (picForImage i) { picCursor = Cursor 0 0 }-    outputPicture dc pic-    setCursorPos t 0 0-    when (supportsCursorVisibility t) $ do-        hideCursor t-        showCursor t-    releaseDisplay t-    releaseTerminal t-    closeFd nullOut-    return succeeded-
− test/VerifyParseTerminfoCaps.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-module VerifyParseTerminfoCaps where--import Prelude hiding ( catch )--import qualified System.Console.Terminfo as Terminfo--import Verify.Data.Terminfo.Parse-import Verify.Graphics.Vty.Output-import Verify--import Data.Maybe ( catMaybes, fromJust )-import Data.Word--import Numeric---- If a terminal defines one of the caps then it's expected to be parsable.--- TODO: reduce duplication with terminfo terminal implementation.-capsOfInterest =-    [ "cup"-    , "sc"-    , "rc"-    , "setf"-    , "setb"-    , "setaf"-    , "setab"-    , "op"-    , "cnorm"-    , "civis"-    , "smcup"-    , "rmcup"-    , "clear"-    , "hpa"-    , "vpa"-    , "sgr"-    , "sgr0"-    ]--fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)--tests :: IO [Test]-tests = do-    parseTests <- concat <$> forM terminalsOfInterest (\termName ->-        liftIO (try $ Terminfo.setupTerm termName)-        >>= either (\(_e :: SomeException) -> return [])-                   (\ti -> concat <$> forM capsOfInterest (\capName -> do-                        let caseName = "\tparsing cap: " ++ capName-                        liftIO $ putStrLn caseName-                        return $ case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of-                            Just capDef -> [verify (caseName ++ " -> " ++ show capDef)-                                                   (verifyParseCap capDef $ const succeeded)]-                            Nothing      -> []-                    )-                   )-        )-    return $ [ verify "parse_nonParamaterizedCaps" nonParamaterizedCaps-             , verify "parse cap string with literal %" literalPercentCaps-             , verify "parse cap string with %i op" incFirstTwoCaps-             , verify "parse cap string with %pN op" pushParamCaps-             ] ++ parseTests--verifyParseCap capString onParse =-    case parseCapExpression capString of-        Left error -> failed { reason = "parse error " ++ show error }-        Right e    -> onParse e--nonParamaterizedCaps (NonParamCapString cap) = do-    verifyParseCap cap $ \e ->-        let expectedBytes = map (toEnum . fromEnum) cap-            outBytes = bytesForRange e 0 (length cap)-        in verifyBytesEqual outBytes expectedBytes--literalPercentCaps (LiteralPercentCap capString expectedBytes) = do-    verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes--incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do-    verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes--pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do-    verifyParseCap capString $ \e ->-        let outBytes = collectBytes e-            outParamCount = paramCount e-        in if outParamCount == expectedParamCount-            then verifyBytesEqual outBytes expectedBytes-            else failed { reason = "out param count /= expected param count" }--decPrintParamCaps (DecPrintCap capString expectedParamCount expectedBytes) = do-    verifyParseCap capString $ \e ->-        let outBytes = collectBytes e-            outParamCount = paramCount e-        in if outParamCount == expectedParamCount-            then verifyBytesEqual outBytes expectedBytes-            else failed { reason = "out param count /= expected param count" }--printCap ti capName = do-    putStrLn $ capName ++ ": " ++ show (fromCapname ti capName)--printExpression ti capName = do-    let parseResult = parseCapExpression $ fromCapname ti capName-    putStrLn $ capName ++ ": " ++ show parseResult
− test/VerifySimpleSpanGeneration.hs 
@@ -1,188 +0,0 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-module VerifySimpleSpanGeneration where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Span--import Graphics.Vty.Debug-import Graphics.Vty.PictureToSpans--import Verify--import qualified Data.Vector as Vector--unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool-unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in displayOpsColumns ops == 0 && displayOpsRows ops == 0--unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool-unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )--horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool-horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in displayOpsColumns ops == 0 && displayOpsRows ops == 0--horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool-horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =-    let p = picForImage i-        ops = displayOpsForPic p (regionForWindow w)-    in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )--horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result-horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        w = MockWindow c 1-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth i ops c--horizSpanImageAndEqualWindow1 :: SingleRowSingleAttrImage -> Bool-horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        w = MockWindow c 1-        ops = displayOpsForPic p (regionForWindow w)-    in spanOpsEffectedRows ops == 1--horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result-horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        lesserWidth = c `div` 2-        w = MockWindow lesserWidth 1-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth i ops lesserWidth--singleAttrSingleSpanStackCropped0 :: SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackCropped0 stack =-    let p = picForImage (stackImage stack)-        w = MockWindow (stackWidth stack `div` 2) (stackHeight stack)-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack `div` 2)--singleAttrSingleSpanStackCropped1 :: SingleAttrSingleSpanStack -> Bool-singleAttrSingleSpanStackCropped1 stack =-    let p = picForImage (stackImage stack)-        expectedRowCount = stackHeight stack `div` 2-        w = MockWindow (stackWidth stack) expectedRowCount-        ops = displayOpsForPic p (regionForWindow w)-        actualRowCount = spanOpsEffectedRows ops-    in expectedRowCount == actualRowCount--singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackCropped2 stack0 stack1 =-    let p = picForImage (stackImage stack0 <|> stackImage stack1)-        w = MockWindow (stackWidth stack0) (imageHeight (picImage p))-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth (picImage p) ops (stackWidth stack0)--singleAttrSingleSpanStackCropped3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool-singleAttrSingleSpanStackCropped3 stack0 stack1 =-    let p = picForImage (stackImage stack0 <|> stackImage stack1)-        w = MockWindow (imageWidth (picImage p))  expectedRowCount-        ops = displayOpsForPic p (regionForWindow w)-        expectedRowCount = imageHeight (picImage p) `div` 2-        actualRowCount = spanOpsEffectedRows ops-    in expectedRowCount == actualRowCount--singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackCropped4 stack0 stack1 =-    let p = picForImage (stackImage stack0 <-> stackImage stack1)-        w = MockWindow expectedWidth (imageHeight (picImage p))-        ops = displayOpsForPic p (regionForWindow w)-        expectedWidth = imageWidth (picImage p) `div` 2-    in verifyAllSpansHaveWidth (picImage p) ops expectedWidth--singleAttrSingleSpanStackCropped5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool-singleAttrSingleSpanStackCropped5 stack0 stack1 =-    let p = picForImage (stackImage stack0 <-> stackImage stack1)-        w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)-        ops = displayOpsForPic p (regionForWindow w)-        expectedRowCount = stackHeight stack0-        actualRowCount = spanOpsEffectedRows ops-    in expectedRowCount == actualRowCount--horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result-horizSpanImageAndGreaterWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =-    let p = picForImage i-        -- SingleRowSingleAttrImage always has width >= 1-        greaterWidth = c * 2-        w = MockWindow greaterWidth 1-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth i ops greaterWidth--arbImageIsCropped :: DefaultImage -> MockWindow -> Bool-arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =-    let pic = picForImage image-        ops = displayOpsForPic pic (regionForWindow win)-    in ( spanOpsEffectedRows ops == h ) && ( allSpansHaveWidth ops w )--spanOpsActuallyFillRows :: DefaultPic -> Bool-spanOpsActuallyFillRows (DefaultPic pic win) =-    let ops = displayOpsForPic pic (regionForWindow win)-        expectedRowCount = regionHeight (regionForWindow win)-        actualRowCount = spanOpsEffectedRows ops-    in expectedRowCount == actualRowCount--spanOpsActuallyFillColumns :: DefaultPic -> Bool-spanOpsActuallyFillColumns (DefaultPic pic win) =-    let ops = displayOpsForPic pic (regionForWindow win)-        expectedColumnCount = regionWidth (regionForWindow win)-    in allSpansHaveWidth ops expectedColumnCount--firstSpanOpSetsAttr :: DefaultPic -> Bool-firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =-    let ops = displayOpsForPic pic (regionForWindow win)-    in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops )--singleAttrSingleSpanStackOpCoverage ::  SingleAttrSingleSpanStack -> Result-singleAttrSingleSpanStackOpCoverage stack =-    let p = picForImage (stackImage stack)-        w = MockWindow (stackWidth stack) (stackHeight stack)-        ops = displayOpsForPic p (regionForWindow w)-    in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack)--imageCoverageMatchesBounds :: Image -> Result-imageCoverageMatchesBounds i =-    let p = picForImage i-        r = (imageWidth i,imageHeight i)-        ops = displayOpsForPic p r-    in verifyAllSpansHaveWidth i ops (imageWidth i)--tests :: IO [Test]-tests = return-    [ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0-    , verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1-    , verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0-    , verify "horiz span image is cropped when window size == (0,0) [1]" horizSpanImageAndZeroWindow1-    , verify "horiz span image is not cropped when window size == size of image [width]" horizSpanImageAndEqualWindow0-    , verify "horiz span image is not cropped when window size == size of image [height]" horizSpanImageAndEqualWindow1-    , verify "horiz span image is not cropped when window size < size of image [width]" horizSpanImageAndLesserWindow0-    , verify "horiz span image is not cropped when window size > size of image [width]" horizSpanImageAndGreaterWindow0-    , verify "first span op is always to set the text attribute" firstSpanOpSetsAttr-    , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"-        singleAttrSingleSpanStackOpCoverage-    , verify "a single attr text span is cropped when window size < size of stack image [width]"-        singleAttrSingleSpanStackCropped0-    , verify "a single attr text span is cropped when window size < size of stack image [height]"-        singleAttrSingleSpanStackCropped1-    , verify "single attr text span <|> single attr text span display cropped. [width]"-        singleAttrSingleSpanStackCropped2-    , verify "single attr text span <|> single attr text span display cropped. [height]"-        singleAttrSingleSpanStackCropped3-    , verify "single attr text span <-> single attr text span display cropped. [width]"-        singleAttrSingleSpanStackCropped4-    , verify "single attr text span <-> single attr text span display cropped. [height]"-        singleAttrSingleSpanStackCropped5-    , verify "an arbitrary image when rendered to a window of the same size will cover the entire window"-        imageCoverageMatchesBounds-    ]-
− test/VerifyUsingMockInput.hs 
@@ -1,220 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}--- Generate some input bytes and delays between blocks of input bytes.--- Verify the events produced are as expected.-module Main where--import Verify.Graphics.Vty.Output--import Graphics.Vty hiding (resize)-import Graphics.Vty.Input.Events-import Graphics.Vty.Input.Loop-import Graphics.Vty.Input.Terminfo--import Control.Concurrent-import Control.Concurrent.STM-import Control.Exception-import Lens.Micro ((^.))-import Control.Monad--import Data.IORef-import Data.List (intersperse, reverse, nubBy)--import System.Console.Terminfo-import System.Posix.IO-import System.Posix.Terminal (openPseudoTerminal)-import System.Posix.Types-import System.Timeout--import Test.Framework.Providers.SmallCheck-import Test.Framework-import Test.SmallCheck-import Test.SmallCheck.Series--import Text.Printf---- processing a block of 16 chars is the largest I can do without taking--- too long to run the test.-maxBlockSize :: Int-maxBlockSize = 16--maxTableSize :: Int-maxTableSize = 28--forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m-forEachOf l = over (generate (\n -> take n l))--data InputEvent-    = Bytes String-    -- ^ Input sequence encoded as a string. Regardless, the input is-    -- read a byte at a time.-    | Delay Int-    -- ^ Microsecond delay-    deriving Show--type InputSpec = [InputEvent]--type ExpectedSpec = [Event]--synthesizeInput :: InputSpec -> Fd -> IO ()-synthesizeInput input outHandle = forM_ input f >> (void $ fdWrite outHandle "\xFFFD")-    where-        f (Bytes str) = void $ fdWrite outHandle str-        f (Delay t) = threadDelay t--minDetectableDelay :: Int-minDetectableDelay = 4000--minTimout :: Int-minTimout = 4000000--testKeyDelay :: Int-testKeyDelay = minDetectableDelay * 4--testEscSampleDelay :: Int-testEscSampleDelay = minDetectableDelay * 2--genEventsUsingIoActions :: Int -> IO () -> IO () -> IO ()-genEventsUsingIoActions maxDuration inputAction outputAction = do-    let maxDuration' = max minTimout maxDuration-    readComplete <- newEmptyMVar-    writeComplete <- newEmptyMVar-    _ <- forkOS $ inputAction `finally` putMVar writeComplete ()-    _ <- forkOS $ outputAction `finally` putMVar readComplete ()-    Just () <- timeout maxDuration' $ takeMVar writeComplete-    Just () <- timeout maxDuration' $ takeMVar readComplete-    return ()--compareEvents :: (Show a1, Show a, Eq a1) => a -> [a1] -> [a1] -> IO Bool-compareEvents inputSpec expectedEvents outEvents = compareEvents' expectedEvents outEvents-    where-        compareEvents' [] []         = return True-        compareEvents' [] outEvents' = do-            printf "extra events %s\n" (show outEvents') :: IO ()-            return False-        compareEvents' expectedEvents' [] = do-            printf "events %s were not produced for input %s\n" (show expectedEvents') (show inputSpec) :: IO ()-            printf "expected events %s\n" (show expectedEvents) :: IO ()-            printf "received events %s\n" (show outEvents) :: IO ()-            return False-        compareEvents' (e : expectedEvents') (o : outEvents')-            | e == o    = compareEvents' expectedEvents' outEvents'-            | otherwise = do-                printf "%s expected not %s for input %s\n" (show e) (show o) (show inputSpec) :: IO ()-                printf "expected events %s\n" (show expectedEvents) :: IO ()-                printf "received events %s\n" (show outEvents) :: IO ()-                return False--assertEventsFromSynInput :: ClassifyMap -> InputSpec -> ExpectedSpec -> IO Bool-assertEventsFromSynInput table inputSpec expectedEvents = do-    let maxDuration = sum [t | Delay t <- inputSpec] + minDetectableDelay-        eventCount = length expectedEvents-    (writeFd, readFd) <- openPseudoTerminal-    (setTermAttr,_) <- attributeControl readFd-    setTermAttr-    let testConfig = defaultConfig { inputFd = Just readFd-                                   , termName = Just "dummy"-                                   , vmin = Just 1-                                   , vtime = Just 100-                                   }-    input <- initInput testConfig table-    eventsRef <- newIORef []-    let writeWaitClose = do-            synthesizeInput inputSpec writeFd-            threadDelay minDetectableDelay-            shutdownInput input-            threadDelay minDetectableDelay-            closeFd writeFd-            closeFd readFd-    -- drain output pipe-    let readEvents = readLoop eventCount-        readLoop 0 = return ()-        readLoop n = do-            e <- atomically $ readTChan $ input^.eventChannel-            modifyIORef eventsRef ((:) e)-            readLoop (n - 1)-    genEventsUsingIoActions maxDuration writeWaitClose readEvents-    outEvents <- reverse <$> readIORef eventsRef-    compareEvents inputSpec expectedEvents outEvents--newtype InputBlocksUsingTable event-    = InputBlocksUsingTable ([(String,event)] -> [(String, event)])--instance Show (InputBlocksUsingTable event) where-    show (InputBlocksUsingTable _g) = "InputBlocksUsingTable"--instance Monad m => Serial m (InputBlocksUsingTable event) where-    series = do-        n :: Int <- localDepth (const maxTableSize) series-        return $ InputBlocksUsingTable $ \raw_table ->-                 let table = reverse $ nubBy (\(s0,_) (s1,_) -> s0 == s1) $ reverse raw_table-                 in concat (take n (selections table))-        where-            selections []     = []-            selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)--verifyVisibleSynInputToEvent :: Property IO-verifyVisibleSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do-    let table    = visibleChars-        inputSeq = gen table-        events   = map snd inputSeq-        keydowns = map (Bytes . fst) inputSeq-        input    = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-    assertEventsFromSynInput universalTable input events--verifyCapsSynInputToEvent :: Property IO-verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->-    forEachOf terminalsOfInterest $ \terminalName -> monadic $ do-        term <- setupTerm terminalName-        let table         = capsClassifyMap term keysFromCapsTable-            inputSeq      = gen table-            events        = map snd inputSeq-            keydowns      = map (Bytes . fst) inputSeq-            input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-        assertEventsFromSynInput table input events--verifySpecialSynInputToEvent :: Property IO-verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do-    let table         = specialSupportKeys-        inputSeq      = gen table-        events        = map snd inputSeq-        keydowns      = map (Bytes . fst) inputSeq-        input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-    assertEventsFromSynInput universalTable input events--verifyFullSynInputToEvent :: Property IO-verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->-    forEachOf terminalsOfInterest $ \terminalName -> monadic $ do-        term <- setupTerm terminalName-        let table         = classifyMapForTerm terminalName term-            inputSeq      = gen table-            events        = map snd inputSeq-            keydowns      = map (Bytes . fst) inputSeq-            input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-        assertEventsFromSynInput table input events--verifyFullSynInputToEvent_2x :: Property IO-verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->-    forEachOf terminalsOfInterest $ \terminalName -> monadic $ do-        term <- setupTerm terminalName-        let table         = classifyMapForTerm terminalName term-            inputSeq      = gen table-            events        = concatMap ((\s -> [s,s]) . snd) inputSeq-            keydowns      = map (Bytes . (\s -> s ++ s) . fst) inputSeq-            input         = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]-        assertEventsFromSynInput table input events--main :: IO ()-main = defaultMain-    [ testProperty "synthesized typing of single visible chars translates to expected events"-        verifyVisibleSynInputToEvent-    , testProperty "synthesized typing of keys from capabilities tables translates to expected events"-        verifyCapsSynInputToEvent-    , testProperty "synthesized typing of hard coded special keys translates to expected events"-        verifySpecialSynInputToEvent-    , testProperty "synthesized typing of any key in the table translates to its paired event"-        verifyFullSynInputToEvent-    , testProperty "synthesized typing of 2x any key in the table translates to 2x paired event"-        verifyFullSynInputToEvent_2x-    ]-
− test/VerifyUsingMockTerminal.hs 
@@ -1,108 +0,0 @@-module VerifyUsingMockTerminal where--import Verify.Graphics.Vty.Prelude--import Verify.Graphics.Vty.Picture-import Verify.Graphics.Vty.Image-import Verify.Graphics.Vty.Attributes-import Verify.Graphics.Vty.Span-import Verify.Graphics.Vty.Output-import Graphics.Vty.Output-import Graphics.Vty.Output.Interface-import Graphics.Vty.Output.Mock--import Graphics.Vty.Debug--import Verify--import qualified Data.ByteString as BS-import Data.IORef-import qualified Data.String.UTF8 as UTF8--import System.IO--unitImageUnitBounds :: UnitImage -> Property-unitImageUnitBounds (UnitImage _ i) = liftIOResult $ do-    (_,t) <- mockTerminal (1,1)-    dc <- displayBounds t >>= displayContext t-    let pic = picForImage i-    outputPicture dc pic-    return succeeded--unitImageArbBounds :: UnitImage -> MockWindow -> Property-unitImageArbBounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do-    (_,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    let pic = picForImage i-    outputPicture dc pic-    return succeeded--singleTRow :: MockWindow -> Property-singleTRow (MockWindow w h) = liftIOResult $ do-    (mockData,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains just the character T repeated for a-    -- single row-    let i = horizCat $ replicate (fromEnum w) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- The mock output string that represents the output bytes a single-    -- line containing the T string: Followed by h - 1 lines of a change-    -- to the background attribute and then the background character-    let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T'-                 ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B')-    compareMockOutput mockData expected--manyTRows :: MockWindow -> Property-manyTRows (MockWindow w h) = liftIOResult $ do-    (mockData, t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains the character 'T' repeated for all-    -- the rows-    let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- The UTF8 string that represents the output bytes is h repeats of-    -- a move, 'M', followed by an attribute change. 'A', followed by w-    -- 'T's-    let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')-    compareMockOutput mockData expected--manyTRowsCroppedWidth :: MockWindow -> Property-manyTRowsCroppedWidth (MockWindow w h) = liftIOResult $ do-    (mockData,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains the character 'T' repeated for all-    -- the rows-    let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w * 2) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- The UTF8 string that represents the output bytes is h repeats of-    -- a move, 'M', followed by an attribute change. 'A', followed by w-    -- 'T's-    let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')-    compareMockOutput mockData expected--manyTRowsCroppedHeight :: MockWindow -> Property-manyTRowsCroppedHeight (MockWindow w h) = liftIOResult $ do-    (mockData,t) <- mockTerminal (w,h)-    dc <- displayBounds t >>= displayContext t-    -- create an image that contains the character 'T' repeated for all-    -- the rows-    let i = vertCat $ replicate (fromEnum h * 2) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')-        pic = (picForImage i) { picBackground = Background 'B' defAttr }-    outputPicture dc pic-    -- The UTF8 string that represents the output bytes is h repeats of-    -- a move, 'M', followed by an attribute change. 'A', followed by w-    -- count 'T's-    let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')-    compareMockOutput mockData expected--tests :: IO [Test]-tests = return [ verify "unitImageUnitBounds" unitImageUnitBounds-               , verify "unitImageArbBounds" unitImageArbBounds-               , verify "singleTRow" singleTRow-               , verify "manyTRows" manyTRows-               , verify "manyTRowsCroppedWidth" manyTRowsCroppedWidth-               , verify "manyTRowsCroppedHeight" manyTRowsCroppedHeight-               ]
− test/VerifyUtf8Width.hs 
@@ -1,30 +0,0 @@-module VerifyUtf8Width where--import Verify--import Graphics.Text.Width-import Graphics.Vty.Attributes-import Graphics.Vty.Picture-import Graphics.Vty.Image--swIs1Column :: SingleColumnChar -> Bool-swIs1Column (SingleColumnChar c) = imageWidth (char defAttr c) == 1--dwIs2Column :: DoubleColumnChar -> Bool-dwIs2Column (DoubleColumnChar c) = imageWidth (char defAttr c) == 2--dcStringIsEven :: NonEmptyList DoubleColumnChar -> Bool-dcStringIsEven (NonEmpty dw_list) =-    even $ safeWcswidth [ c | DoubleColumnChar c <- dw_list ]--safeWcwidthForControlChars :: Bool-safeWcwidthForControlChars = 0 == safeWcwidth '\NUL'--tests :: IO [Test]-tests = return-  [ verify "swIs1Column" swIs1Column-  , verify "dwIs2Column" dwIs2Column-  , verify "a string of double characters is an even width" dcStringIsEven-  , verify "safeWcwidth provides a width of 0 for chars without widths" safeWcwidthForControlChars-  ]-
vty.cabal view
@@ -1,5 +1,5 @@ name:                vty-version:             5.15.1+version:             6.6 license:             BSD3 license-file:        LICENSE author:              AUTHORS@@ -9,28 +9,25 @@ synopsis:            A simple terminal UI library description:   vty is terminal GUI library in the niche of ncurses. It is intended to-  be easy to use, have no confusing corner cases, and good support for-  common terminal types.-  .-  See the @vty-examples@ package as well as the program-  @test/interactive_terminal_test.hs@ included in the @vty@ package for-  examples on how to use the library.+  be easy to use and to provide good support for common terminal types.   .-  Import the "Graphics.Vty" convenience module to get access to the core-  parts of the library.+  See the example programs in the @vty-crossplatform@ package examples+  on how to use the library.   .   &#169; 2006-2007 Stefan O'Rear; BSD3 license.   .   &#169; Corey O'Connor; BSD3 license.   .   &#169; Jonathan Daugherty; BSD3 license.-cabal-version:       >= 1.18+cabal-version:       1.18 build-type:          Simple extra-doc-files:     README.md,                      AUTHORS,                      CHANGELOG.md,                      LICENSE-tested-with:         GHC >= 7.6.2+tested-with:         GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7,+                     GHC==9.0.2, GHC==9.2.8, GHC==9.4.8, GHC==9.6.6, GHC==9.8.4, GHC==9.10.1,+                     GHC==9.12.1  source-repository head   type: git@@ -38,586 +35,52 @@  library   default-language:    Haskell2010-  build-depends:       base >= 4.6 && < 5,+  include-dirs:        cbits+  hs-source-dirs:      src+  ghc-options:         -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10+  ghc-prof-options:    -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10+  build-depends:       base >= 4.8 && < 5,                        blaze-builder >= 0.3.3.2 && < 0.5,                        bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       directory,-                       filepath >= 1.0 && < 2.0,-                       microlens,+                       deepseq >= 1.1 && < 1.6,+                       microlens < 0.6,                        microlens-mtl,-                       microlens-th,-                       -- required for nice installation with yi-                       hashable >= 1.2,-                       mtl >= 1.1.1.0 && < 2.3,-                       parallel >= 2.2 && < 3.3,-                       parsec >= 2 && < 4,+                       mtl >= 1.1.1.0 && < 2.4,                        stm,-                       terminfo >= 0.3 && < 0.5,-                       transformers >= 0.3.0.0,                        text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7+                       utf8-string >= 0.3.1 && < 1.1,+                       vector >= 0.7,+                       binary,+                       parsec,+                       filepath,+                       directory -  exposed-modules:     Graphics.Vty+  if !impl(ghc >= 8.0)+    build-depends:     semigroups >= 0.16,+                       fail++  exposed-modules:     Graphics.Text.Width+                       Graphics.Vty                        Graphics.Vty.Attributes+                       Graphics.Vty.Attributes.Color+                       Graphics.Vty.Attributes.Color240                        Graphics.Vty.Config+                       Graphics.Vty.Debug+                       Graphics.Vty.DisplayAttributes                        Graphics.Vty.Error                        Graphics.Vty.Image+                       Graphics.Vty.Image.Internal                        Graphics.Vty.Inline-                       Graphics.Vty.Inline.Unsafe                        Graphics.Vty.Input                        Graphics.Vty.Input.Events-                       Graphics.Vty.Picture                        Graphics.Vty.Output-                       Graphics.Text.Width-                       -- the modules below are only meant to be used by the tests.-                       Codec.Binary.UTF8.Debug-                       Data.Terminfo.Parse-                       Data.Terminfo.Eval-                       Graphics.Vty.Debug-                       Graphics.Vty.DisplayAttributes-                       Graphics.Vty.Image.Internal-                       Graphics.Vty.Input.Classify-                       Graphics.Vty.Input.Classify.Types-                       Graphics.Vty.Input.Classify.Parse-                       Graphics.Vty.Input.Loop-                       Graphics.Vty.Input.Mouse-                       Graphics.Vty.Input.Paste-                       Graphics.Vty.Input.Terminfo+                       Graphics.Vty.Output.Mock+                       Graphics.Vty.Picture                        Graphics.Vty.PictureToSpans                        Graphics.Vty.Span-                       Graphics.Vty.Output.Mock-                       Graphics.Vty.Output.Interface-                       Graphics.Vty.Output.XTermColor-                       Graphics.Vty.Output.TerminfoBased--  other-modules:       Graphics.Vty.Attributes.Color-                       Graphics.Vty.Attributes.Color240-                       Graphics.Vty.Debug.Image-                       Graphics.Vty.Input.Terminfo.ANSIVT--  c-sources:           cbits/gwinsz.c-                       cbits/set_term_timing.c-                       cbits/mk_wcwidth.c--  include-dirs:        cbits--  hs-source-dirs:      src--  default-extensions:  ScopedTypeVariables-                       ForeignFunctionInterface--  ghc-options:         -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10--  ghc-prof-options:    -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10--  cc-options:          -O2--executable vty-mode-demo-  main-is:             ModeDemo.hs-  hs-source-dirs:      demos--  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables-  ghc-options:         -threaded--  build-depends:       vty,-                       base >= 4.6 && < 5,-                       containers,-                       microlens,-                       microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3--executable vty-demo-  main-is:             Demo.hs-  hs-source-dirs:      demos--  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables-  ghc-options:         -threaded--  build-depends:       vty,-                       base >= 4.6 && < 5,-                       containers,-                       microlens,-                       microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3--test-suite verify-attribute-ops-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables-  type:                detailed-0.9-  hs-source-dirs:      test-  test-module:         VerifyAttributeOps-  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-using-mock-terminal-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyUsingMockTerminal--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       terminfo >= 0.3 && < 0.5,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-terminal-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyOutput--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-display-attributes-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyDisplayAttributes--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.DisplayAttributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-empty-image-props-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyEmptyImageProps--  other-modules:       Verify--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-eval-terminfo-caps-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyEvalTerminfoCaps--  other-modules:       Verify-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       blaze-builder >= 0.3.3.2 && < 0.5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-image-ops-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyImageOps--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Image--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-image-trans-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyImageTrans--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Image--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-inline-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyInline--  other-modules:       Verify-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-parse-terminfo-caps-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyParseTerminfoCaps--  other-modules:       Verify-                       Verify.Data.Terminfo.Parse-                       Verify.Graphics.Vty.Output--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-simple-span-generation-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifySimpleSpanGeneration--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7---test-suite verify-crop-span-generation-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyCropSpanGeneration--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7---test-suite verify-layers-span-generation-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyLayersSpanGeneration--  other-modules:       Verify-                       Verify.Graphics.Vty.Attributes-                       Verify.Graphics.Vty.Prelude-                       Verify.Graphics.Vty.Picture-                       Verify.Graphics.Vty.Image-                       Verify.Graphics.Vty.Span--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-utf8-width-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                detailed-0.9--  hs-source-dirs:      test--  test-module:         VerifyUtf8Width--  other-modules:       Verify--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       mtl >= 1.1.1.0 && < 2.3,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--test-suite verify-using-mock-input-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                exitcode-stdio-1.0--  hs-source-dirs:      test--  main-is:             VerifyUsingMockInput.hs--  build-depends:       vty,-                       Cabal >= 1.20,-                       QuickCheck >= 2.7,-                       smallcheck == 1.*,-                       quickcheck-assertions >= 0.1.1,-                       test-framework == 0.8.*,-                       test-framework-smallcheck == 0.2.*,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       microlens,-                       microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3,-                       stm,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--  ghc-options:         -threaded -Wall--test-suite verify-config-  default-language:    Haskell2010-  default-extensions:  ScopedTypeVariables--  type:                exitcode-stdio-1.0--  hs-source-dirs:      test--  main-is:             VerifyConfig.hs--  build-depends:       vty,-                       Cabal >= 1.20,-                       HUnit,-                       QuickCheck >= 2.7,-                       smallcheck == 1.*,-                       quickcheck-assertions >= 0.1.1,-                       test-framework == 0.8.*,-                       test-framework-smallcheck == 0.2.*,-                       test-framework-hunit,-                       random >= 1.0 && < 1.2,-                       base >= 4.6 && < 5,-                       bytestring,-                       containers,-                       deepseq >= 1.1 && < 1.5,-                       microlens,-                       microlens-mtl,-                       mtl >= 1.1.1.0 && < 2.3,-                       string-qq,-                       terminfo >= 0.3 && < 0.5,-                       text >= 0.11.3,-                       unix,-                       utf8-string >= 0.3 && < 1.1,-                       vector >= 0.7--  ghc-options:         -threaded -Wall+                       Graphics.Vty.UnicodeWidthTable.IO+                       Graphics.Vty.UnicodeWidthTable.Install+                       Graphics.Vty.UnicodeWidthTable.Main+                       Graphics.Vty.UnicodeWidthTable.Query+                       Graphics.Vty.UnicodeWidthTable.Types+  c-sources:           cbits/mk_wcwidth.c