develop..494a520 · reflex-vty

git.iko.soy/reflex-vty

on 494a520 help sign in

.github/workflows/haskell.yml+10−12

since splitsnapshots

unifiedsplit

@@ -1,33 +1,33 @@

1−name: github-action

1+name: Haskell CI

3on: [push, pull_request]

5jobs:

6 build:

8+ runs-on: ${{ matrix.os }}

7 strategy:

9 strategy:

8 matrix:

10 matrix:

9− ghc: ['8.4.4', '8.6.5', '8.8.4', '8.10.2']

11+ ghc: ['8.4.4', '8.6.5', '8.8.4']

10 os: ['ubuntu-latest', 'macos-latest']

12 os: ['ubuntu-latest', 'macos-latest']

11− runs-on: ${{ matrix.os }}

12−

13− name: GHC ${{ matrix.ghc }} on ${{ matrix.os }}

14 steps:

13 steps:

15 - uses: actions/checkout@v2

14 - uses: actions/checkout@v2

16 - uses: actions/setup-haskell@v1

15 - uses: actions/setup-haskell@v1

17 with:

16 with:

18 ghc-version: ${{ matrix.ghc }}

17 ghc-version: ${{ matrix.ghc }}

18+ cabal-version: '3.0'

19+

19 - name: Cache

20 - name: Cache

20 uses: actions/cache@v1

21 uses: actions/cache@v1

21 env:

22 env:

22 cache-name: cache-cabal

23 cache-name: cache-cabal

23 with:

24 with:

24 path: ~/.cabal

25 path: ~/.cabal

25− key: ${{ runner.os }}-${{ matrix.ghc }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}

26+ key: ${{ runner.os }}-1-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}

26 restore-keys: |

27 restore-keys: |

27− ${{ runner.os }}-${{ matrix.ghc }}-build-${{ env.cache-name }}-

28+ ${{ runner.os }}-1-build-${{ env.cache-name }}-

28− ${{ runner.os }}-${{ matrix.ghc }}-build-

29+ ${{ runner.os }}-1-build-

29− ${{ runner.os }}-${{ matrix.ghc }}-

30+ ${{ runner.os }}-1-

30− ${{ runner.os }}

32 - name: Install dependencies

33 run: |

@@ -37,5 +37,3 @@ jobs:

37 run: cabal build --enable-tests --enable-benchmarks all

38 - name: Run tests

39 run: cabal test all

40− - name: Build Docs

41− run: cabal haddock

.travis.ymlnew file+112

@@ -0,0 +1,112 @@

1+# This Travis job script has been generated by a script via

2+#

3+# haskell-ci 'reflex-vty.cabal' '--output' '.travis.yml'

4+#

5+# For more information, see https://github.com/haskell-CI/haskell-ci

6+#

7+# version: 0.3

8+#

9+language: c

10+dist: xenial

11+

12+git:

13+ submodules: false # whether to recursively clone submodules

14+

15+cache:

16+ directories:

17+ - $HOME/.cabal/packages

18+ - $HOME/.cabal/store

19+

20+before_cache:

21+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log

22+ # remove files that are regenerated by 'cabal update'

23+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*

24+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json

25+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache

26+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar

27+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

28+

29+ - rm -rfv $CABALHOME/packages/head.hackage

30+

31+matrix:

32+ include:

33+ - compiler: "ghc-8.8.3"

34+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-3.0,ghc-8.8.3], sources: [hvr-ghc]}}

35+ - compiler: "ghc-8.6.5"

36+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}

37+ - compiler: "ghc-8.4.4"

38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}

39+

40+

41+before_install:

42+ - HC=/opt/ghc/bin/${CC}

43+ - HCPKG=${HC/ghc/ghc-pkg}

44+ - unset CC

45+ - CABAL=/opt/ghc/bin/cabal

46+ - CABALHOME=$HOME/.cabal

47+ - export PATH="$CABALHOME/bin:$PATH"

48+ - ROOTDIR=$(pwd)

49+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

50+ - echo $HCNUMVER

51+

52+install:

53+ - ${CABAL} --version

54+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

55+ - TEST=--enable-tests

56+ - BENCH=--enable-benchmarks

57+ - GHCHEAD=${GHCHEAD-false}

58+ - travis_retry ${CABAL} update -v

59+ - sed -i.bak 's/^jobs:/-- jobs:/' $CABALHOME/config

60+ - rm -fv cabal.project cabal.project.local

61+ - grep -Ev -- '^\s*--' $CABALHOME/config | grep -Ev '^\s*$'

62+ - rm -f cabal.project

63+ - touch cabal.project

64+ - "printf 'packages: \".\"\\n' >> cabal.project"

65+ - "printf 'write-ghc-environment-files: always\\n' >> cabal.project"

66+ - touch cabal.project.local

67+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(reflex-vty)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

68+ - cat cabal.project || true

69+ - cat cabal.project.local || true

70+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi

71+ - rm -f cabal.project.freeze

72+ - ${CABAL} new-freeze -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dry

73+ - "cat \"cabal.project.freeze\" | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"

74+ - rm "cabal.project.freeze"

75+ - ${CABAL} new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

76+ - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

77+ - rm -rf .ghc.environment.* "."/dist

78+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

79+

80+# Here starts the actual work to be performed for the package under test;

81+# any command which exits with a non-zero exit code causes the build to fail.

82+script:

83+ # test that source-distributions can be generated

84+ - ${CABAL} new-sdist all

85+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

86+ - cd ${DISTDIR} || false

87+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

88+ - rm -f cabal.project

89+ - touch cabal.project

90+ - "printf 'packages: \"reflex-vty-*/*.cabal\"\\n' >> cabal.project"

91+ - "printf 'write-ghc-environment-files: always\\n' >> cabal.project"

92+ - touch cabal.project.local

93+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(reflex-vty)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

94+ - cat cabal.project || true

95+ - cat cabal.project.local || true

96+ # this builds all libraries and executables (without tests/benchmarks)

97+ - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks all

98+

99+ # build & run tests, build benchmarks

100+ - ${CABAL} new-build -w ${HC} ${TEST} ${BENCH} all

101+

102+ # cabal check

103+ - (cd reflex-vty-* && ${CABAL} check)

104+

105+ # haddock

106+ - ${CABAL} new-haddock -w ${HC} ${TEST} ${BENCH} all

107+

108+ # Build without installed constraints for packages in global-db

109+ - rm -f cabal.project.local; ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks all

110+

111+# REGENDATA ["reflex-vty.cabal","--output",".travis.yml"]

112+# EOF

ChangeLog.md+11−19

@@ -33,8 +33,6 @@

33 * Introduce a `FocusReader` monad transformer

34 * Replace `HasVtyInput` with `HasInput`

35 * Introduce an `Input` monad transformer

36− * Introduce `HasTheme` reader class to allow setting Vty attributes of all built-in widgets

37− * Introduce `ThemeReader` monad transformer

38 * Remove `DynRegion` and `currentRegion`. Use `Dynamic t Region` and `current` instead. This also changes the type of `pane`'s argument.

36 * Remove `DynRegion` and `currentRegion`. Use `Dynamic t Region` and `current` instead. This also changes the type of `pane`'s argument.

39 * `CheckboxConfig` now has a field taking an `Event` to set the value of the checkbox.

37 * `CheckboxConfig` now has a field taking an `Event` to set the value of the checkbox.

40 * `checkbox` now accepts keyboard input (spacebar to check and uncheck) and is displayed in bold when focused.

38 * `checkbox` now accepts keyboard input (spacebar to check and uncheck) and is displayed in bold when focused.

@@ -56,24 +54,24 @@

56 * `splitH`: Now requires `HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m`

54 * `splitH`: Now requires `HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m`

57 * `splitVDrag`: Now requires `HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m`

55 * `splitVDrag`: Now requires `HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m`

58 * `fill`: Now requires `HasImageWriter` and `HasDisplayRegion`

56 * `fill`: Now requires `HasImageWriter` and `HasDisplayRegion`

59− * `boxTitle`: Now requires `HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m`

57+ * `boxTitle`: Now requires `HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m`

60− * `box`: Now requires `HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m`

58+ * `box`: Now requires `HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m`

61− * `boxStatic`: Now requires `HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m`

59+ * `boxStatic`: Now requires `HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m`

62 * `richText`: Now requires `HasImageWriter`, and `HasDisplayRegion`

60 * `richText`: Now requires `HasImageWriter`, and `HasDisplayRegion`

63− * `scrollableText`: Now requires `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

61+ * `scrollableText`: Now requires `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

64 * `blank`: Now requires `Monad`

62 * `blank`: Now requires `Monad`

65− * `button`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

63+ * `button`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

66− * `textButton`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

64+ * `textButton`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

67− * `textButtonStatic`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

65+ * `textButtonStatic`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

68− * `link`: Now requires `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

66+ * `link`: Now requires `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

69 * `checkbox`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

67 * `checkbox`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

68+ * `textInput`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

69+ * `multilineTextInput`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`

70+ * `textInputTile`: Now requires `HasFocusReader`, `HasInput`, `HasLayout`, and `HasFocus`

70 * TextZipper interface changes

71 * TextZipper interface changes

71 * `_displayLines_offsetMap` type changed to `OffsetMapWithAlignment`

72 * `_displayLines_offsetMap` type changed to `OffsetMapWithAlignment`

72 * `_displayLines_cursorY` replaced with `_displayLines_cursorPos` which include X position

73 * `_displayLines_cursorY` replaced with `_displayLines_cursorPos` which include X position

73 * some exposed methods intended for internal use only have been removed

74 * some exposed methods intended for internal use only have been removed

74− * `textInput`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

75− * `multilineTextInput`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, `HasTheme`, and `HasDisplayRegion`

76− * `textInputTile`: Now requires `HasFocusReader`, `HasInput`, `HasLayout`, `HasTheme`, and `HasFocus`

77* _Misc_:

75* _Misc_:

78 * (#40 Add alignment support to TextZipper)[https://github.com/reflex-frp/reflex-vty/pull/40]

76 * (#40 Add alignment support to TextZipper)[https://github.com/reflex-frp/reflex-vty/pull/40]

79 * Add alignment (left/center/right) support to TextZipper

77 * Add alignment (left/center/right) support to TextZipper

@@ -86,12 +84,6 @@

86 * Add various `MFunctor` instances

84 * Add various `MFunctor` instances

87 * Add a CPU usage indicator to the example executable

85 * Add a CPU usage indicator to the example executable

89−## 0.1.4.2

90−

91−* Wider bounds for GHC 8.10 support

92−

93−## 0.1.4.1

94−

95## 0.1.4.1

87## 0.1.4.1

96* Migrate to new dependent-sum / dependent-map (after the "some" package split)

88* Migrate to new dependent-sum / dependent-map (after the "some" package split)

reflex-vty.cabal+8−9

@@ -12,17 +12,12 @@ maintainer: maintainer@obsidian.systems

12copyright: 2020 Obsidian Systems LLC

13category: FRP

14build-type: Simple

15−cabal-version: 1.18

15+cabal-version: >=1.18

16extra-source-files:

17 README.md

18 ChangeLog.md

19extra-doc-files: doc/tasks.png

20−tested-with:

20+tested-with: GHC ==8.8.4 || ==8.6.5 || ==8.4.4

21− GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2

22−

23−source-repository head

24− type: git

25− location: https://github.com/reflex-frp/reflex-vty

27library

22library

28 exposed-modules: Reflex.Vty

23 exposed-modules: Reflex.Vty

@@ -39,8 +34,8 @@ library

39 , Reflex.Spider.Orphans

34 , Reflex.Spider.Orphans

40 , Control.Monad.NodeId

35 , Control.Monad.NodeId

41 build-depends:

36 build-depends:

42− base >= 4.10.0 && < 4.15,

37+ base >= 4.10.0 && < 4.14,

43− bimap >= 0.3.3 && < 0.5,

38+ bimap >= 0.3.3 && < 0.4,

44 containers >= 0.5.0 && < 0.7,

39 containers >= 0.5.0 && < 0.7,

45 mtl >= 2.2.2 && < 2.3,

40 mtl >= 2.2.2 && < 2.3,

46 transformers >= 0.5.5 && < 0.6,

41 transformers >= 0.5.5 && < 0.6,

@@ -152,3 +147,7 @@ test-suite reflex-vty-test

152 extra,

147 extra,

153 hspec >= 2.7 && < 2.8

148 hspec >= 2.7 && < 2.8

154 default-language: Haskell2010

149 default-language: Haskell2010

150+

151+source-repository head

152+ type: git

153+ location: https://github.com/reflex-frp/reflex-vty

src-bin/Example/CPU.hs+2−2

@@ -100,7 +100,7 @@ cpuStats

100 , HasLayout t m

101 , HasFocus t m

102 , HasInput t m

103− , HasFocusReader t m, HasTheme t m

103+ , HasFocusReader t m

104 )

105 => m ()

106cpuStats = do

@@ -122,7 +122,7 @@ chart

122 , HasImageWriter t m

123 , HasInput t m

124 , HasDisplayRegion t m

125− , HasFocusReader t m, HasTheme t m

125+ , HasFocusReader t m

126 )

127 => Dynamic t (Ratio Word64) -> m ()

128chart pct = do

src-bin/example.hs+3−11

@@ -23,7 +23,7 @@ type VtyExample t m =

23 , HasImageWriter t m

24 , HasDisplayRegion t m

25 , HasFocus t m

26− , HasFocusReader t m, HasTheme t m

26+ , HasFocusReader t m

27 )

29type Manager t m =

@@ -46,20 +46,12 @@ withCtrlC f = do

46 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()

47 _ -> Nothing

49−darkTheme :: V.Attr

50−darkTheme = V.Attr {

51− V.attrStyle = V.SetTo V.standout

52− , V.attrForeColor = V.SetTo V.black

53− , V.attrBackColor = V.Default

54− , V.attrURL = V.Default

55−}

56−

57main :: IO ()

49main :: IO ()

58main = mainWidget $ withCtrlC $ do

50main = mainWidget $ withCtrlC $ do

59 initManager_ $ do

51 initManager_ $ do

60 tabNavigation

52 tabNavigation

61 let gf = grout . fixed

53 let gf = grout . fixed

62− t = tile flex

54+ t = tile flex

63 buttons = col $ do

55 buttons = col $ do

64 gf 3 $ col $ do

56 gf 3 $ col $ do

65 gf 1 $ text "Select an example."

57 gf 1 $ text "Select an example."

@@ -85,7 +77,7 @@ main = mainWidget $ withCtrlC $ do

85 _ -> Nothing

77 _ -> Nothing

86 rec out <- networkHold buttons $ ffor (switch (current out)) $ \case

78 rec out <- networkHold buttons $ ffor (switch (current out)) $ \case

87 Left Example_Todo -> escapable taskList

79 Left Example_Todo -> escapable taskList

88− Left Example_TextEditor -> escapable $ localTheme (const (constant darkTheme)) testBoxes

80+ Left Example_TextEditor -> escapable testBoxes

89 Left Example_ScrollableTextDisplay -> escapable scrolling

81 Left Example_ScrollableTextDisplay -> escapable scrolling

90 Left Example_ClickButtonsGetEmojis -> escapable easyExample

82 Left Example_ClickButtonsGetEmojis -> escapable easyExample

91 Left Example_CPUStat -> escapable cpuStats

83 Left Example_CPUStat -> escapable cpuStats

src/Data/Text/Zipper.hs+15−26

@@ -12,7 +12,7 @@ module Data.Text.Zipper where

12import Prelude

14import Control.Exception (assert)

15−import Control.Monad.State (evalState, forM, get, put)

15+import Control.Monad.State (evalState, forM, get, put, join)

16import Data.Char (isSpace)

17import Data.Map (Map)

18import Data.Maybe (fromMaybe)

@@ -170,7 +170,7 @@ deleteLeftWord (TextZipper lb b a la) =

170-- | Insert up to n spaces to get to the next logical column that is a multiple of n

171tab :: Int -> TextZipper -> TextZipper

172tab n z@(TextZipper _ b _ _) =

173− insert (T.replicate (fromEnum $ n - T.length b `mod` max 1 n) " ") z

173+ insert (T.replicate (fromEnum $ n - (T.length b `mod` max 1 n)) " ") z

174

175-- | The plain text contents of the zipper

176value :: TextZipper -> Text

@@ -314,7 +314,9 @@ wordsWithWhitespace :: Text -> [Text]

314wordsWithWhitespace t@(Text arr off len) = loop 0 0 False

315 where

316 loop !start !n !wasSpace

317+ | n >= len = if start == n

318+ then []

317− | n >= len = [Text arr (start+off) (n-start) | not (start == n)]

319+ else [Text arr (start+off) (n-start)]

318 | isSpace c = loop start (n+d) True

320 | isSpace c = loop start (n+d) True

319 | wasSpace = Text arr (start+off) (n-start) : loop n n False

321 | wasSpace = Text arr (start+off) (n-start) : loop n n False

320 | otherwise = loop start (n+d) False

322 | otherwise = loop start (n+d) False

@@ -365,7 +367,6 @@ wrapWithOffsetAndAlignment

365 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)

367 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)

366wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []

368wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []

367wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where

369wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where

368− -- we pad by offset amount with any non-space character which we will remove later so that no changes need to be made to splitWordsAtDisplayWidth

369 r' = splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt)

370 r' = splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt)

370 fmapfn (t,b) = case alignment of

371 fmapfn (t,b) = case alignment of

371 TextAlignment_Left -> WrappedLine t b 0

372 TextAlignment_Left -> WrappedLine t b 0

@@ -379,7 +380,7 @@ wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r w

379

380

380-- converts deleted eol spaces into logical lines

381-- converts deleted eol spaces into logical lines

381eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]

382eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]

382−eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . concatMap (L.groupBy (\(WrappedLine _ b _) _ -> not b))

383+eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . join . fmap (L.groupBy (\(WrappedLine _ b _) _ -> not b))

383

384

384offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment

385offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment

385offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines

386offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines

@@ -418,13 +419,10 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =

418 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb

419 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb

419 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line

420 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line

420 linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la

421 linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la

421−

422− -- simulate trailing cursor character when computing OffsetMap

423− afterWithCursor = if T.null a then " " else a

424 offsets :: OffsetMapWithAlignment

422 offsets :: OffsetMapWithAlignment

425 offsets = offsetMapWithAlignmentInternal $ mconcat

423 offsets = offsetMapWithAlignmentInternal $ mconcat

426 [ linesBefore

424 [ linesBefore

427− , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]

425+ , [wrapWithOffsetAndAlignment alignment width 0 $ b <> a]

428 , linesAfter

426 , linesAfter

429 ]

427 ]

430 flattenLines = concatMap (fmap _wrappedLines_text)

428 flattenLines = concatMap (fmap _wrappedLines_text)

@@ -434,8 +432,9 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =

434 -- * spans that are on earlier display lines (though on the same logical line), and

432 -- * spans that are on earlier display lines (though on the same logical line), and

435 -- * spans that are on the same display line

433 -- * spans that are on the same display line

436

434

435+ -- TODO cursor goes here if align right

437 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $

436 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $

438− initLast $ map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width 0 b)

437+ initLast $ map ((:[]) . Span tag) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width 0 b)

439 -- Calculate the number of columns on the cursor's display line before the cursor

438 -- Calculate the number of columns on the cursor's display line before the cursor

440 curLineOffset = spansWidth spansCurLineBefore

439 curLineOffset = spansWidth spansCurLineBefore

441 -- Check whether the spans on the current display line are long enough that

440 -- Check whether the spans on the current display line are long enough that

@@ -449,29 +448,17 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =

449 -- * spans that are on the same display line, and

448 -- * spans that are on the same display line, and

450 -- * spans that are on later display lines (though on the same logical line)

449 -- * spans that are on later display lines (though on the same logical line)

451

450

451+ -- TODO do not show cursor if align right

452 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $

453 headTail $ case T.uncons a of

454 Nothing -> [[Span cursorTag " "]]

455 Just (c, rest) ->

456 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth

457 cursor = Span cursorTag (T.singleton c)

458− in case map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width o rest) of

458+ in case map ((:[]) . Span tag) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width o rest) of

459 [] -> [[cursor]]

460 (l:ls) -> (cursor : l) : ls

461

462− curLineSpanNormalCase = if cursorAfterEOL

463− then [ spansCurLineBefore, spansCurLineAfter ]

464− else [ spansCurLineBefore <> spansCurLineAfter ]

465−

466− -- for right alignment, we want draw the cursor tag to be on the character just before the logical cursor position

467− curLineSpan = if alignment == TextAlignment_Right && not cursorAfterEOL

468− then case reverse spansCurLineBefore of

469− [] -> curLineSpanNormalCase

470− (Span _ x):xs -> case spansCurLineAfter of

471− [] -> error "should not be possible" -- curLineSpanNormalCase

472− (Span _ y):ys -> [reverse (Span cursorTag x:xs) <> ((Span tag y):ys)]

473− else curLineSpanNormalCase

474−

475 cursorY = sum

462 cursorY = sum

476 [ length spansBefore

463 [ length spansBefore

477 , length spansCurrentBefore

464 , length spansCurrentBefore

@@ -484,7 +471,9 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =

484 { _displayLines_spans = concat

471 { _displayLines_spans = concat

485 [ spansBefore

472 [ spansBefore

486 , spansCurrentBefore

473 , spansCurrentBefore

487− , curLineSpan

474+ , if cursorAfterEOL

475+ then [ spansCurLineBefore, spansCurLineAfter ]

476+ else [ spansCurLineBefore <> spansCurLineAfter ]

488 , spansCurrentAfter

477 , spansCurrentAfter

489 , spansAfter

478 , spansAfter

490 ]

479 ]

@@ -542,4 +531,4 @@ wrapWithOffset

542 -> Int -- ^ Offset for first line

531 -> Int -- ^ Offset for first line

543 -> Text -- ^ Text to be wrapped

532 -> Text -- ^ Text to be wrapped

544 -> [Text]

533 -> [Text]

545−wrapWithOffset maxWidth n xs = _wrappedLines_text <$> wrapWithOffsetAndAlignment TextAlignment_Left maxWidth n xs

534+wrapWithOffset maxWidth n xs = fmap _wrappedLines_text $ wrapWithOffsetAndAlignment TextAlignment_Left maxWidth n xs

src/Reflex/Vty/Widget.hs+10−83

@@ -35,7 +35,6 @@ mainWidgetWithHandle

35 , HasDisplayRegion t m

36 , HasFocusReader t m

37 , HasInput t m

38− , HasTheme t m

39 ) => m (Event t ()))

38 ) => m (Event t ()))

40 -> IO ()

39 -> IO ()

41mainWidgetWithHandle vty child =

40mainWidgetWithHandle vty child =

@@ -46,14 +45,12 @@ mainWidgetWithHandle vty child =

46 let inp' = fforMaybe inp $ \case

45 let inp' = fforMaybe inp $ \case

47 V.EvResize {} -> Nothing

46 V.EvResize {} -> Nothing

48 x -> Just x

47 x -> Just x

49− (shutdown, images) <- runThemeReader (constant V.defAttr) $

50− runFocusReader (pure True) $

51− runDisplayRegion (fmap (\(w, h) -> Region 0 0 w h) size) $

48+ (shutdown, images) <- runFocusReader (pure True) $ runDisplayRegion (fmap (\(w, h) -> Region 0 0 w h) size) $

52− runImageWriter $

49+ runImageWriter $

53− runNodeIdT $

50+ runNodeIdT $

54− runInput inp' $ do

51+ runInput inp' $ do

55− tellImages . ffor (current size) $ \(w, h) -> [V.charFill V.defAttr ' ' w h]

52+ tellImages . ffor (current size) $ \(w, h) -> [V.charFill V.defAttr ' ' w h]

56− child

53+ child

57 return $ VtyResult

54 return $ VtyResult

58 { _vtyResult_picture = fmap (V.picForLayers . reverse) images

55 { _vtyResult_picture = fmap (V.picForLayers . reverse) images

59 , _vtyResult_shutdown = shutdown

56 , _vtyResult_shutdown = shutdown

@@ -72,7 +69,6 @@ mainWidget

72 , MonadNodeId m

69 , MonadNodeId m

73 , HasDisplayRegion t m

70 , HasDisplayRegion t m

74 , HasFocusReader t m

71 , HasFocusReader t m

75− , HasTheme t m

76 , HasInput t m

72 , HasInput t m

77 ) => m (Event t ()))

73 ) => m (Event t ()))

78 -> IO ()

74 -> IO ()

@@ -237,9 +233,9 @@ regionSize :: Region -> (Int, Int)

237regionSize (Region _ _ w h) = (w, h)

233regionSize (Region _ _ w h) = (w, h)

238

234

239-- | Produces an 'Image' that fills a region with space characters

235-- | Produces an 'Image' that fills a region with space characters

240−regionBlankImage :: V.Attr -> Region -> Image

236+regionBlankImage :: Region -> Image

241−regionBlankImage attr r@(Region _ _ width height) =

237+regionBlankImage r@(Region _ _ width height) =

242− withinImage r $ V.charFill attr ' ' width height

238+ withinImage r $ V.charFill V.defAttr ' ' width height

243

239

244-- | A class for things that know their own display size dimensions

240-- | A class for things that know their own display size dimensions

245class (Reflex t, Monad m) => HasDisplayRegion t m | m -> t where

241class (Reflex t, Monad m) => HasDisplayRegion t m | m -> t where

@@ -407,7 +403,7 @@ newtype ImageWriter t m a = ImageWriter

407 , NotReady t

403 , NotReady t

408 , PerformEvent t

404 , PerformEvent t

409 , PostBuild t

405 , PostBuild t

410− , TriggerEvent t

406+ , TriggerEvent t

411 )

407 )

412

408

413instance MonadTrans (ImageWriter t) where

409instance MonadTrans (ImageWriter t) where

@@ -445,75 +441,6 @@ runImageWriter

445 -> m (a, Behavior t [Image])

441 -> m (a, Behavior t [Image])

446runImageWriter = runBehaviorWriterT . unImageWriter

442runImageWriter = runBehaviorWriterT . unImageWriter

447

443

448−-- * Theming

449−

450−-- | A class for things that can be visually styled

451−class (Reflex t, Monad m) => HasTheme t m | m -> t where

452− theme :: m (Behavior t V.Attr)

453− default theme :: (f m' ~ m, Monad m', MonadTrans f, HasTheme t m') => m (Behavior t V.Attr)

454− theme = lift theme

455− localTheme :: (Behavior t V.Attr -> Behavior t V.Attr) -> m a -> m a

456− default localTheme :: (f m' ~ m, Monad m', MFunctor f, HasTheme t m') => (Behavior t V.Attr -> Behavior t V.Attr) -> m a -> m a

457− localTheme f = hoist (localTheme f)

458−

459−instance HasTheme t m => HasTheme t (ReaderT x m)

460−instance HasTheme t m => HasTheme t (BehaviorWriterT t x m)

461−instance HasTheme t m => HasTheme t (DynamicWriterT t x m)

462−instance HasTheme t m => HasTheme t (EventWriterT t x m)

463−instance HasTheme t m => HasTheme t (NodeIdT m)

464−instance HasTheme t m => HasTheme t (Input t m)

465−instance HasTheme t m => HasTheme t (ImageWriter t m)

466−instance HasTheme t m => HasTheme t (DisplayRegion t m)

467−instance HasTheme t m => HasTheme t (FocusReader t m)

468−

469−-- | A widget that has access to theme information

470−newtype ThemeReader t m a = ThemeReader

471− { unThemeReader :: ReaderT (Behavior t V.Attr) m a }

472− deriving

473− ( Functor

474− , Applicative

475− , Monad

476− , MonadFix

477− , MonadHold t

478− , MonadIO

479− , MonadRef

480− , MonadSample t

481− )

482−

483−instance (Monad m, Reflex t) => HasTheme t (ThemeReader t m) where

484− theme = ThemeReader ask

485− localTheme f = ThemeReader . local f . unThemeReader

486−

487−deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ThemeReader t m)

488−deriving instance NotReady t m => NotReady t (ThemeReader t m)

489−deriving instance PerformEvent t m => PerformEvent t (ThemeReader t m)

490−deriving instance PostBuild t m => PostBuild t (ThemeReader t m)

491−deriving instance TriggerEvent t m => TriggerEvent t (ThemeReader t m)

492−instance HasImageWriter t m => HasImageWriter t (ThemeReader t m)

493−

494−instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (ThemeReader t m) where

495− runWithReplace (ThemeReader a) e = ThemeReader $ runWithReplace a $ fmap unThemeReader e

496− traverseIntMapWithKeyWithAdjust f m e = ThemeReader $ traverseIntMapWithKeyWithAdjust (\k v -> unThemeReader $ f k v) m e

497− traverseDMapWithKeyWithAdjust f m e = ThemeReader $ traverseDMapWithKeyWithAdjust (\k v -> unThemeReader $ f k v) m e

498− traverseDMapWithKeyWithAdjustWithMove f m e = ThemeReader $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unThemeReader $ f k v) m e

499−

500−instance MonadTrans (ThemeReader t) where

501− lift = ThemeReader . lift

502−

503−instance MFunctor (ThemeReader t) where

504− hoist f = ThemeReader . hoist f . unThemeReader

505−

506−instance MonadNodeId m => MonadNodeId (ThemeReader t m)

507−

508−-- | Run a 'ThemeReader' action with the given focus value

509−runThemeReader

510− :: (Reflex t, Monad m)

511− => Behavior t V.Attr

512− -> ThemeReader t m a

513− -> m a

514−runThemeReader b = flip runReaderT b . unThemeReader

515−

516−

517-- ** Manipulating images

444-- ** Manipulating images

518

445

519-- | Translates and crops an 'Image' so that it is contained by

446-- | Translates and crops an 'Image' so that it is contained by

src/Reflex/Vty/Widget/Box.hs+16−19

@@ -13,7 +13,7 @@ import Reflex.Vty.Widget

13import Reflex.Vty.Widget.Text

15-- | Fill the background with the bottom box style

16−hRule :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => BoxStyle -> m ()

16+hRule :: (HasDisplayRegion t m, HasImageWriter t m) => BoxStyle -> m ()

17hRule boxStyle = fill $ pure (_boxStyle_s boxStyle)

19-- | Defines a set of symbols to use to draw the outlines of boxes

@@ -54,7 +54,7 @@ roundedBoxStyle :: BoxStyle

54roundedBoxStyle = BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│'

56-- | Draws a titled box in the provided style and a child widget inside of that box

57−boxTitle :: (Monad m, Reflex t ,HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)

57+boxTitle :: (Monad m, Reflex t ,HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m)

58 => Behavior t BoxStyle

59 -> Behavior t Text

60 -> m a

@@ -62,39 +62,36 @@ boxTitle :: (Monad m, Reflex t ,HasDisplayRegion t m, HasImageWriter t m, HasInp

62boxTitle boxStyle title child = do

63 dh <- displayHeight

64 dw <- displayWidth

65− bt <- theme

66 let boxReg = Region 0 0 <$> dw <*> dh

65 let boxReg = Region 0 0 <$> dw <*> dh

67 innerReg = Region 1 1 <$> (subtract 2 <$> dw) <*> (subtract 2 <$> dh)

66 innerReg = Region 1 1 <$> (subtract 2 <$> dw) <*> (subtract 2 <$> dh)

68−

69− tellImages (boxImages <$> bt <*> title <*> boxStyle <*> current boxReg)

67+ tellImages (boxImages <$> title <*> boxStyle <*> current boxReg)

70− tellImages (ffor2 (current innerReg) bt (\r attr -> [regionBlankImage attr r]))

68+ tellImages (fmap (\r -> [regionBlankImage r]) (current innerReg))

71−

72 pane innerReg (pure True) child

69 pane innerReg (pure True) child

73 where

70 where

74− boxImages :: V.Attr -> Text -> BoxStyle -> Region -> [Image]

71+ boxImages :: Text -> BoxStyle -> Region -> [Image]

75− boxImages attr title' style (Region left top width height) =

72+ boxImages title' style (Region left top width height) =

76 let right = left + width - 1

73 let right = left + width - 1

77 bottom = top + height - 1

74 bottom = top + height - 1

78 sides =

75 sides =

79 [ withinImage (Region (left + 1) top (width - 2) 1) $

76 [ withinImage (Region (left + 1) top (width - 2) 1) $

80− V.text' attr $

77+ V.text' V.defAttr $

81 hPadText title' (_boxStyle_n style) (width - 2)

78 hPadText title' (_boxStyle_n style) (width - 2)

82 , withinImage (Region right (top + 1) 1 (height - 2)) $

79 , withinImage (Region right (top + 1) 1 (height - 2)) $

83− V.charFill attr (_boxStyle_e style) 1 (height - 2)

80+ V.charFill V.defAttr (_boxStyle_e style) 1 (height - 2)

84 , withinImage (Region (left + 1) bottom (width - 2) 1) $

81 , withinImage (Region (left + 1) bottom (width - 2) 1) $

85− V.charFill attr (_boxStyle_s style) (width - 2) 1

82+ V.charFill V.defAttr (_boxStyle_s style) (width - 2) 1

86 , withinImage (Region left (top + 1) 1 (height - 2)) $

83 , withinImage (Region left (top + 1) 1 (height - 2)) $

87− V.charFill attr (_boxStyle_w style) 1 (height - 2)

84+ V.charFill V.defAttr (_boxStyle_w style) 1 (height - 2)

88 ]

85 ]

89 corners =

86 corners =

90 [ withinImage (Region left top 1 1) $

87 [ withinImage (Region left top 1 1) $

91− V.char attr (_boxStyle_nw style)

88+ V.char V.defAttr (_boxStyle_nw style)

92 , withinImage (Region right top 1 1) $

89 , withinImage (Region right top 1 1) $

93− V.char attr (_boxStyle_ne style)

90+ V.char V.defAttr (_boxStyle_ne style)

94 , withinImage (Region right bottom 1 1) $

91 , withinImage (Region right bottom 1 1) $

95− V.char attr (_boxStyle_se style)

92+ V.char V.defAttr (_boxStyle_se style)

96 , withinImage (Region left bottom 1 1) $

93 , withinImage (Region left bottom 1 1) $

97− V.char attr (_boxStyle_sw style)

94+ V.char V.defAttr (_boxStyle_sw style)

98 ]

95 ]

99 in sides ++ if width > 1 && height > 1 then corners else []

96 in sides ++ if width > 1 && height > 1 then corners else []

100 hPadText :: T.Text -> Char -> Int -> T.Text

97 hPadText :: T.Text -> Char -> Int -> T.Text

@@ -109,7 +106,7 @@ boxTitle boxStyle title child = do

109 right = mkHalf delta

106 right = mkHalf delta

110

107

111-- | A box without a title

108-- | A box without a title

112−box :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)

109+box :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m)

113 => Behavior t BoxStyle

110 => Behavior t BoxStyle

114 -> m a

111 -> m a

115 -> m a

112 -> m a

@@ -117,7 +114,7 @@ box boxStyle = boxTitle boxStyle mempty

117

114

118-- | A box whose style is static

115-- | A box whose style is static

119boxStatic

116boxStatic

120− :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)

117+ :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m)

121 => BoxStyle

118 => BoxStyle

122 -> m a

119 -> m a

123 -> m a

120 -> m a

src/Reflex/Vty/Widget/Input.hs+7−9

@@ -34,7 +34,7 @@ instance Reflex t => Default (ButtonConfig t) where

35-- | A button widget that contains a sub-widget

36button

37− :: (Reflex t, Monad m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m)

37+ :: (Reflex t, Monad m, HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m)

38 => ButtonConfig t

39 -> m ()

40 -> m (Event t ())

@@ -52,7 +52,7 @@ button cfg child = do

53-- | A button widget that displays text that can change

54textButton

55− :: (Reflex t, Monad m, HasDisplayRegion t m, HasFocusReader t m, HasTheme t m, HasImageWriter t m, HasInput t m)

55+ :: (Reflex t, Monad m, HasDisplayRegion t m, HasFocusReader t m, HasImageWriter t m, HasInput t m)

56 => ButtonConfig t

57 -> Behavior t Text

58 -> m (Event t ())

@@ -60,7 +60,7 @@ textButton cfg = button cfg . text -- TODO Centering etc.

61-- | A button widget that displays a static bit of text

62textButtonStatic

63− :: (Reflex t, Monad m, HasDisplayRegion t m, HasFocusReader t m, HasTheme t m, HasImageWriter t m, HasInput t m)

63+ :: (Reflex t, Monad m, HasDisplayRegion t m, HasFocusReader t m, HasImageWriter t m, HasInput t m)

64 => ButtonConfig t

65 -> Text

66 -> m (Event t ())

@@ -70,20 +70,19 @@ textButtonStatic cfg = textButton cfg . pure

71-- | A clickable link widget

72link

73− :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)

73+ :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m)

74 => Behavior t Text

75 -> m (Event t MouseUp)

76link t = do

77− bt <- theme

78 let cfg = RichTextConfig

77 let cfg = RichTextConfig

79− { _richTextConfig_attributes = fmap (\attr -> V.withStyle attr V.underline) bt

78+ { _richTextConfig_attributes = pure $ V.withStyle V.defAttr V.underline

80 }

79 }

81 richText cfg t

80 richText cfg t

82 mouseUp

81 mouseUp

84-- | A clickable link widget with a static label

83-- | A clickable link widget with a static label

85linkStatic

84linkStatic

86− :: (Reflex t, Monad m, HasImageWriter t m, HasDisplayRegion t m, HasInput t m, HasTheme t m)

85+ :: (Reflex t, Monad m, HasImageWriter t m, HasDisplayRegion t m, HasInput t m)

87 => Text

86 => Text

88 -> m (Event t MouseUp)

87 -> m (Event t MouseUp)

89linkStatic = link . pure

88linkStatic = link . pure

@@ -116,7 +115,6 @@ checkboxStyleTick = CheckboxStyle

116-- | Configuration options for a checkbox

115-- | Configuration options for a checkbox

117data CheckboxConfig t = CheckboxConfig

116data CheckboxConfig t = CheckboxConfig

118 { _checkboxConfig_checkboxStyle :: Behavior t CheckboxStyle

117 { _checkboxConfig_checkboxStyle :: Behavior t CheckboxStyle

119− -- TODO DELETE and use HasTheme instead

120 , _checkboxConfig_attributes :: Behavior t V.Attr

118 , _checkboxConfig_attributes :: Behavior t V.Attr

121 , _checkboxConfig_setValue :: Event t Bool

119 , _checkboxConfig_setValue :: Event t Bool

122 }

120 }

@@ -130,7 +128,7 @@ instance (Reflex t) => Default (CheckboxConfig t) where

130

128

131-- | A checkbox widget

129-- | A checkbox widget

132checkbox

130checkbox

133− :: (MonadHold t m, MonadFix m, Reflex t, HasInput t m, HasDisplayRegion t m, HasImageWriter t m, HasFocusReader t m, HasTheme t m)

131+ :: (MonadHold t m, MonadFix m, Reflex t, HasInput t m, HasDisplayRegion t m, HasImageWriter t m, HasFocusReader t m)

134 => CheckboxConfig t

132 => CheckboxConfig t

135 -> Bool

133 -> Bool

136 -> m (Dynamic t Bool)

134 -> m (Dynamic t Bool)

src/Reflex/Vty/Widget/Input/Text.hs+10−15

@@ -43,7 +43,7 @@ data TextInput t = TextInput

44-- | A widget that allows text input

45textInput

46− :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m, HasDisplayRegion t m)

46+ :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m, HasDisplayRegion t m)

47 => TextInputConfig t

48 -> m (TextInput t)

49textInput cfg = do

@@ -51,8 +51,6 @@ textInput cfg = do

51 f <- focus

52 dh <- displayHeight

53 dw <- displayWidth

54− bt <- theme

55− attr0 <- sample bt

56 rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)

54 rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)

57 [ uncurry (updateTextZipper (_textInputConfig_tabWidth cfg)) <$> attach (current dh) i

55 [ uncurry (updateTextZipper (_textInputConfig_tabWidth cfg)) <$> attach (current dh) i

58 , _textInputConfig_modify cfg

56 , _textInputConfig_modify cfg

@@ -61,18 +59,11 @@ textInput cfg = do

61 goToDisplayLinePosition mx (st + my) dl

59 goToDisplayLinePosition mx (st + my) dl

62 ]

60 ]

63 click <- mouseDown V.BLeft

61 click <- mouseDown V.BLeft

64−

62+ let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr

65− -- TODO reverseVideo is prob not what we want. Does not work with `darkTheme` in example.hs (cursor is dark rather than light bg)

63+ let rows = (\w s c -> displayLines w V.defAttr c s)

66− let toCursorAttrs attr = V.withStyle attr V.reverseVideo

67− rowInputDyn = (,,)

68 <$> dw

64 <$> dw

69 <*> (mapZipper <$> _textInputConfig_display cfg <*> v)

65 <*> (mapZipper <$> _textInputConfig_display cfg <*> v)

70− <*> f

66+ <*> cursorAttrs

71− toDisplayLines attr (w, s, x) =

72− let c = if x then toCursorAttrs attr else attr

73− in displayLines w attr c s

74− attrDyn <- holdDyn attr0 $ pushAlways (\_ -> sample bt) (updated rowInputDyn)

75− let rows = ffor2 attrDyn rowInputDyn toDisplayLines

76 img = images . _displayLines_spans <$> rows

67 img = images . _displayLines_spans <$> rows

77 y <- holdUniqDyn $ fmap snd _displayLines_cursorPos <$> rows

68 y <- holdUniqDyn $ fmap snd _displayLines_cursorPos <$> rows

78 let newScrollTop :: Int -> (Int, Int) -> Int

69 let newScrollTop :: Int -> (Int, Int) -> Int

@@ -90,7 +81,7 @@ textInput cfg = do

91-- | A widget that allows multiline text input

82-- | A widget that allows multiline text input

92multilineTextInput

83multilineTextInput

93− :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m)

84+ :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m)

94 => TextInputConfig t

85 => TextInputConfig t

95 -> m (TextInput t)

86 -> m (TextInput t)

96multilineTextInput cfg = do

87multilineTextInput cfg = do

@@ -108,7 +99,7 @@ multilineTextInput cfg = do

108-- the computed line count to greedily size the tile when vertically

99-- the computed line count to greedily size the tile when vertically

109-- oriented, and uses the fallback width when horizontally oriented.

100-- oriented, and uses the fallback width when horizontally oriented.

110textInputTile

101textInputTile

111− :: (Monad m, Reflex t, MonadFix m, HasLayout t m, HasInput t m, HasFocus t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m, HasTheme t m)

102+ :: (Monad m, Reflex t, MonadFix m, HasLayout t m, HasInput t m, HasFocus t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)

112 => m (TextInput t)

103 => m (TextInput t)

113 -> Dynamic t Int

104 -> Dynamic t Int

114 -> m (TextInput t)

105 -> m (TextInput t)

@@ -120,6 +111,10 @@ textInputTile txt width = do

120 Orientation_Row -> width

111 Orientation_Row -> width

121 return t

112 return t

122

113

114+-- | Default attributes for the text cursor

115+cursorAttributes :: V.Attr

116+cursorAttributes = V.withStyle V.defAttr V.reverseVideo

117+

123-- | Turn a set of display line rows into a list of images (one per line)

118-- | Turn a set of display line rows into a list of images (one per line)

124images :: [[Span V.Attr]] -> [V.Image]

119images :: [[Span V.Attr]] -> [V.Image]

125images = map (V.horizCat . map spanToImage)

120images = map (V.horizCat . map spanToImage)

src/Reflex/Vty/Widget/Layout.hs−4

@@ -133,8 +133,6 @@ instance (HasImageWriter t m, MonadFix m) => HasImageWriter t (Focus t m) where

133

134instance (HasFocusReader t m, Monad m) => HasFocusReader t (Focus t m)

135

136−instance (HasTheme t m, Monad m) => HasTheme t (Focus t m)

137−

138instance (Reflex t, MonadFix m, MonadNodeId m) => HasFocus t (Focus t m) where

136instance (Reflex t, MonadFix m, MonadNodeId m) => HasFocus t (Focus t m) where

139 makeFocus = do

137 makeFocus = do

140 fid <- FocusId <$> lift getNextNodeId

138 fid <- FocusId <$> lift getNextNodeId

@@ -432,8 +430,6 @@ instance (HasDisplayRegion t m, HasImageWriter t m, MonadFix m) => HasImageWrite

432

430

433instance (HasFocusReader t m, Monad m) => HasFocusReader t (Layout t m)

431instance (HasFocusReader t m, Monad m) => HasFocusReader t (Layout t m)

434

432

435−instance (HasTheme t m, Monad m) => HasTheme t (Layout t m)

436−

437instance (Monad m, MonadNodeId m, Reflex t, MonadFix m) => HasLayout t (Layout t m) where

433instance (Monad m, MonadNodeId m, Reflex t, MonadFix m) => HasLayout t (Layout t m) where

438 axis o c (Layout x) = Layout $ do

434 axis o c (Layout x) = Layout $ do

439 nodeId <- getNextNodeId

435 nodeId <- getNextNodeId

src/Reflex/Vty/Widget/Text.hs+10−17

@@ -14,15 +14,13 @@ import Reflex.Vty.Widget

14import Reflex.Vty.Widget.Input.Mouse

16-- | Fill the background with a particular character.

17−fill :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => Behavior t Char -> m ()

17+fill :: (HasDisplayRegion t m, HasImageWriter t m) => Behavior t Char -> m ()

18fill bc = do

19 dw <- displayWidth

20 dh <- displayHeight

21− bt <- theme

22 let fillImg =

21 let fillImg =

23− (\attr w h c -> [V.charFill attr c w h])

22+ (\w h c -> [V.charFill V.defAttr c w h])

24− <$> bt

25− <*> current dw

23+ <$> current dw

26 <*> current dh

24 <*> current dh

27 <*> bc

25 <*> bc

28 tellImages fillImg

26 tellImages fillImg

@@ -35,11 +33,9 @@ data RichTextConfig t = RichTextConfig

35instance Reflex t => Default (RichTextConfig t) where

33instance Reflex t => Default (RichTextConfig t) where

36 def = RichTextConfig $ pure V.defAttr

34 def = RichTextConfig $ pure V.defAttr

38−

39−-- TODO delete this and use new local theming

40-- | A widget that displays text with custom time-varying attributes

36-- | A widget that displays text with custom time-varying attributes

41richText

37richText

42− :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)

38+ :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m)

43 => RichTextConfig t

39 => RichTextConfig t

44 -> Behavior t Text

40 -> Behavior t Text

45 -> m ()

41 -> m ()

@@ -57,17 +53,15 @@ richText cfg t = do

58-- | Renders text, wrapped to the container width

54-- | Renders text, wrapped to the container width

59text

55text

60− :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)

56+ :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m)

61 => Behavior t Text

57 => Behavior t Text

62 -> m ()

58 -> m ()

63−text t = do

64− bt <- theme

65− richText (RichTextConfig bt) t

59+text = richText def

67-- | Scrollable text widget. The output pair exposes the current scroll position and total number of lines (including those

61-- | Scrollable text widget. The output pair exposes the current scroll position and total number of lines (including those

68-- that are hidden)

62-- that are hidden)

69scrollableText

63scrollableText

70− :: forall t m. (Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasTheme t m)

64+ :: forall t m. (Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m)

71 => Event t Int

65 => Event t Int

72 -- ^ Number of lines to scroll by

66 -- ^ Number of lines to scroll by

73 -> Behavior t Text

67 -> Behavior t Text

@@ -75,8 +69,7 @@ scrollableText

75 -- ^ (Current scroll position, total number of lines)

69 -- ^ (Current scroll position, total number of lines)

76scrollableText scrollBy t = do

70scrollableText scrollBy t = do

77 dw <- displayWidth

71 dw <- displayWidth

78− bt <- theme

79− let imgs = wrap <$> bt <*> current dw <*> t

72+ let imgs = wrap <$> current dw <*> t

80 kup <- key V.KUp

73 kup <- key V.KUp

81 kdown <- key V.KDown

74 kdown <- key V.KDown

82 m <- mouseScroll

75 m <- mouseScroll

@@ -95,12 +88,12 @@ scrollableText scrollBy t = do

95 tellImages $ fmap ((:[]) . V.vertCat) $ drop <$> current lineIndex <*> imgs

88 tellImages $ fmap ((:[]) . V.vertCat) $ drop <$> current lineIndex <*> imgs

96 return $ (,) <$> ((+) <$> current lineIndex <*> pure 1) <*> (length <$> imgs)

89 return $ (,) <$> ((+) <$> current lineIndex <*> pure 1) <*> (length <$> imgs)

97 where

90 where

98− wrap attr maxWidth = concatMap (fmap (V.string attr . T.unpack) . TZ.wrapWithOffset maxWidth 0) . T.split (=='\n')

91+ wrap maxWidth = concatMap (fmap (V.string V.defAttr . T.unpack) . TZ.wrapWithOffset maxWidth 0) . T.split (=='\n')

100-- | Renders any behavior whose value can be converted to

93-- | Renders any behavior whose value can be converted to

101-- 'String' as text

94-- 'String' as text

102display

95display

103− :: (Reflex t, Monad m, Show a, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)

96+ :: (Reflex t, Monad m, Show a, HasDisplayRegion t m, HasImageWriter t m)

104 => Behavior t a

97 => Behavior t a

105 -> m ()

98 -> m ()

106display a = text $ T.pack . show <$> a

99display a = text $ T.pack . show <$> a

test/Data/Text/ZipperSpec.hs+71−80

@@ -21,84 +21,75 @@ splitSentenceAtDisplayWidth :: Int -> T.Text -> [(T.Text, Bool)]

21splitSentenceAtDisplayWidth w t = splitWordsAtDisplayWidth w (wordsWithWhitespace t)

23spec :: Spec

24−spec =

24+spec = do

25 describe "Zipper" $ do

26− it "wordsWithWhitespace" $ do

26+ it "wordsWithWhitespace" $ do

27− wordsWithWhitespace "" `shouldBe` []

27+ wordsWithWhitespace "" `shouldBe` []

28− wordsWithWhitespace "😱😱😱" `shouldBe` ["😱😱😱"]

28+ wordsWithWhitespace "😱😱😱" `shouldBe` ["😱😱😱"]

29− wordsWithWhitespace "abcd efgf f" `shouldBe` ["abcd ","efgf ", "f"]

29+ wordsWithWhitespace "abcd efgf f" `shouldBe` ["abcd ","efgf ", "f"]

30− wordsWithWhitespace "aoeu " `shouldBe` ["aoeu "]

30+ wordsWithWhitespace "aoeu " `shouldBe` ["aoeu "]

31− it "splitWordsAtDisplayWidth" $ do

31+ it "splitWordsAtDisplayWidth" $ do

32− fmap fst (splitSentenceAtDisplayWidth 5 "123456") `shouldBe` ["12345","6"]

32+ fmap fst (splitSentenceAtDisplayWidth 5 "123456") `shouldBe` ["12345","6"]

33− fmap fst (splitSentenceAtDisplayWidth 5 "12345 6") `shouldBe` ["12345","6"]

33+ fmap fst (splitSentenceAtDisplayWidth 5 "12345 6") `shouldBe` ["12345","6"]

34− fmap fst (splitSentenceAtDisplayWidth 5 "1234 56") `shouldBe` ["1234","56"]

34+ fmap fst (splitSentenceAtDisplayWidth 5 "1234 56") `shouldBe` ["1234","56"]

35− fmap fst (splitSentenceAtDisplayWidth 5 "12345678912345") `shouldBe` ["12345","67891","2345"]

35+ fmap fst (splitSentenceAtDisplayWidth 5 "12345678912345") `shouldBe` ["12345","67891","2345"]

36− fmap fst (splitSentenceAtDisplayWidth 5 "1234 56") `shouldBe` ["1234 "," 56"]

36+ fmap fst (splitSentenceAtDisplayWidth 5 "1234 56") `shouldBe` ["1234 "," 56"]

37− fmap fst (splitSentenceAtDisplayWidth 8 "1 2 3 4 5 6 7 8 9 1") `shouldBe` ["1 2 3 4","5 6 7 8", "9 1"]

37+ fmap fst (splitSentenceAtDisplayWidth 8 "1 2 3 4 5 6 7 8 9 1") `shouldBe` ["1 2 3 4","5 6 7 8", "9 1"]

38− it "wrapWithOffsetAndAlignment" $ do

38+ it "wrapWithOffsetAndAlignment" $ do

39− wrapWithOffsetAndAlignment TextAlignment_Left 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]

39+ wrapWithOffsetAndAlignment TextAlignment_Left 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]

40− wrapWithOffsetAndAlignment TextAlignment_Right 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 1), (WrappedLine "12" False 3)]

40+ wrapWithOffsetAndAlignment TextAlignment_Right 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 1), (WrappedLine "12" False 3)]

41− wrapWithOffsetAndAlignment TextAlignment_Center 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 1)]

41+ wrapWithOffsetAndAlignment TextAlignment_Center 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 1)]

42− wrapWithOffsetAndAlignment TextAlignment_Left 5 1 someSentence `shouldBe` [(WrappedLine "1234" False 0), (WrappedLine "5" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]

42+ wrapWithOffsetAndAlignment TextAlignment_Left 5 1 someSentence `shouldBe` [(WrappedLine "1234" False 0), (WrappedLine "5" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]

43−

44− -- leading spaces and offset case

45− wrapWithOffsetAndAlignment TextAlignment_Left 5 1 (" " <> someSentence) `shouldBe` [(WrappedLine " " True 0), (WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]

46− it "eolSpacesToLogicalLines" $ do

43+ it "eolSpacesToLogicalLines" $ do

47− eolSpacesToLogicalLines

44+ eolSpacesToLogicalLines

48− [

45+ [

49− [ (WrappedLine "😱" True 1), (WrappedLine "😱" False 2), (WrappedLine "😱" False 3) ]

46+ [ (WrappedLine "😱" True 1), (WrappedLine "😱" False 2), (WrappedLine "😱" False 3) ]

50− , [ (WrappedLine "aa" True 1), (WrappedLine "aa" True 2), (WrappedLine "aa" False 3) ]

47+ , [ (WrappedLine "aa" True 1), (WrappedLine "aa" True 2), (WrappedLine "aa" False 3) ]

51− ]

48+ ]

52− `shouldBe`

49+ `shouldBe`

53− [

50+ [

54− [ ("😱",1) ]

51+ [ ("😱",1) ]

55− , [ ("😱",2), ("😱",3) ]

52+ , [ ("😱",2), ("😱",3) ]

56− , [ ("aa",1) ]

53+ , [ ("aa",1) ]

57− , [ ("aa",2) ]

54+ , [ ("aa",2) ]

58− , [ ("aa",3) ]

55+ , [ ("aa",3) ]

59− ]

56+ ]

60− it "offsetMapWithAlignmentInternal" $ do

57+ it "offsetMapWithAlignmentInternal" $ do

61− offsetMapWithAlignmentInternal

58+ offsetMapWithAlignmentInternal

62− [

59+ [

63− [ (WrappedLine "😱" True 1), (WrappedLine "😱" False 2), (WrappedLine "😱" False 3) ]

60+ [ (WrappedLine "😱" True 1), (WrappedLine "😱" False 2), (WrappedLine "😱" False 3) ]

64− , [ (WrappedLine "aa" True 1), (WrappedLine "aa" True 2), (WrappedLine "aa" False 3) ]

61+ , [ (WrappedLine "aa" True 1), (WrappedLine "aa" True 2), (WrappedLine "aa" False 3) ]

65− ]

62+ ]

66− `shouldBe`

63+ `shouldBe`

67− Map.fromList

64+ Map.fromList

68− [ (0, (1,0))

65+ [ (0, (1,0))

69− , (1, (2,2)) -- jump by 1 for char and 1 for space

66+ , (1, (2,2)) -- jump by 1 for char and 1 for space

70− , (2, (3,3)) -- jump by 1 for char

67+ , (2, (3,3)) -- jump by 1 for char

71− , (3, (1,5)) -- jump by 1 for char and 1 for newline

68+ , (3, (1,5)) -- jump by 1 for char and 1 for newline

72− , (4, (2,8)) -- jump by 2 for char and 1 for space

69+ , (4, (2,8)) -- jump by 2 for char and 1 for space

73− , (5, (3,11)) -- jump by 2 for char and 1 for space

70+ , (5, (3,11)) -- jump by 2 for char and 1 for space

74− ]

71+ ]

75− it "displayLines - cursorPos" $ do

72+ it "displayLines - cursorPos" $ do

76− let

73+ let

77− dl0 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "")

74+ dl0 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "")

78− dl1 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu")

75+ dl1 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu")

79− dl2 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu\n")

76+ dl2 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu\n")

80− dl3 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "0123456789")

77+ dl3 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "0123456789")

81− dl4 = displayLinesWithAlignment TextAlignment_Right 10 () () (insertChar 'a' $ fromText "aoeu")

78+ dl4 = displayLinesWithAlignment TextAlignment_Right 10 () () (insertChar 'a' $ fromText "aoeu")

82− dl5 = displayLinesWithAlignment TextAlignment_Right 10 () () (left $ insertChar 'a' $ fromText "aoeu")

79+ dl5 = displayLinesWithAlignment TextAlignment_Right 10 () () (left $ insertChar 'a' $ fromText "aoeu")

83− dl6 = displayLinesWithAlignment TextAlignment_Right 10 () () (deleteLeft $ insertChar 'a' $ fromText "aoeu")

80+ dl6 = displayLinesWithAlignment TextAlignment_Right 10 () () (deleteLeft $ insertChar 'a' $ fromText "aoeu")

84− _displayLines_cursorPos dl0 `shouldBe` (0,0)

81+ _displayLines_cursorPos dl0 `shouldBe` (0,0)

85− _displayLines_cursorPos dl1 `shouldBe` (4,0)

82+ _displayLines_cursorPos dl1 `shouldBe` (4,0)

86− _displayLines_cursorPos dl2 `shouldBe` (0,1)

83+ _displayLines_cursorPos dl2 `shouldBe` (0,1)

87− _displayLines_cursorPos dl3 `shouldBe` (0,1)

84+ _displayLines_cursorPos dl3 `shouldBe` (0,1)

88− _displayLines_cursorPos dl4 `shouldBe` (5,0)

85+ _displayLines_cursorPos dl4 `shouldBe` (5,0)

89− _displayLines_cursorPos dl5 `shouldBe` (4,0)

86+ _displayLines_cursorPos dl5 `shouldBe` (4,0)

90− _displayLines_cursorPos dl6 `shouldBe` (4,0)

87+ _displayLines_cursorPos dl6 `shouldBe` (4,0)

91− it "displayLines - offsetMap" $ do

92− let

93− dl0 = displayLinesWithAlignment TextAlignment_Left 5 () () (end $ fromText "aoeku")

94− _displayLines_cursorPos dl0 `shouldBe` (0,1)

95− Map.size (_displayLines_offsetMap dl0) `shouldBe` 2 -- cursor character is on second line

96− it "displayLinesWithAlignment - spans" $ do

88+ it "displayLinesWithAlignment - spans" $ do

97− let

89+ let

98− someText = top $ fromText "0123456789abcdefgh"

90+ someText = top $ fromText "0123456789abcdefgh"

99− -- outer span length should be invariant when changing TextAlignment and CursorPosition

91+ -- outer span length should be invariant when changing TextAlignment and CursorPosition

100− forM_ [0..4] $ \x -> do

92+ forM_ [0..4] $ \x -> do

101− forM_ [TextAlignment_Left, TextAlignment_Center, TextAlignment_Right] $ \ta -> do

93+ forM_ [TextAlignment_Left, TextAlignment_Center, TextAlignment_Right] $ \ta -> do

102− let t = rightN x $ someText

103− length (_displayLines_spans $ (displayLinesWithAlignment ta 5 () () t)) `shouldBe` 4

94+ length (_displayLines_spans $ (displayLinesWithAlignment ta 5 () () someText) {_displayLines_cursorPos = (x,x)}) `shouldBe` 4

104− length (_displayLines_spans $ (displayLinesWithAlignment ta 10 () () t)) `shouldBe` 2

95+ length (_displayLines_spans $ (displayLinesWithAlignment ta 10 () () someText) {_displayLines_cursorPos = (x,x)}) `shouldBe` 2