97e0c65...develop · reflex-vty

git.iko.soy/reflex-vty

on develop help sign in

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

since splitsnapshots

unifiedsplit

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

1−name: Haskell CI

1+name: github-action

3on: [push, pull_request]

5jobs:

6 build:

7−

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

9 strategy:

7 strategy:

10 matrix:

8 matrix:

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

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

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

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

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

12+

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

13 steps:

14 steps:

14 - uses: actions/checkout@v2

15 - uses: actions/checkout@v2

15 - uses: actions/setup-haskell@v1

16 - uses: actions/setup-haskell@v1

16 with:

17 with:

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

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

18− cabal-version: '3.0'

19−

20 - name: Cache

19 - name: Cache

21 uses: actions/cache@v1

20 uses: actions/cache@v1

22 env:

21 env:

23 cache-name: cache-cabal

22 cache-name: cache-cabal

24 with:

23 with:

25 path: ~/.cabal

24 path: ~/.cabal

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

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

27 restore-keys: |

26 restore-keys: |

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

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

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

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

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

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

30+ ${{ runner.os }}

32 - name: Install dependencies

33 run: |

@@ -37,3 +37,5 @@ 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.ymldeleted−112

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

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+19−11

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

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

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

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

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

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

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

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

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

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

56 * `splitH`: 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`

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

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

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

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

59+ * `boxTitle`: 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`

60+ * `box`: 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`

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

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

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

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

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

62 * `blank`: Now requires `Monad`

64 * `blank`: Now requires `Monad`

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

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

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

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

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

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

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

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

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

69 * `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`

71 * TextZipper interface changes

70 * TextZipper interface changes

72 * `_displayLines_offsetMap` type changed to `OffsetMapWithAlignment`

71 * `_displayLines_offsetMap` type changed to `OffsetMapWithAlignment`

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

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

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

73 * 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`

75* _Misc_:

77* _Misc_:

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

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

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

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

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

84 * Add various `MFunctor` instances

86 * Add various `MFunctor` instances

85 * Add a CPU usage indicator to the example executable

87 * 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+

87## 0.1.4.1

95## 0.1.4.1

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

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

reflex-vty.cabal+9−8

@@ -12,12 +12,17 @@ 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: GHC ==8.8.4 || ==8.6.5 || ==8.4.4

20+tested-with:

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

22library

27library

23 exposed-modules: Reflex.Vty

28 exposed-modules: Reflex.Vty

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

34 , Reflex.Spider.Orphans

39 , Reflex.Spider.Orphans

35 , Control.Monad.NodeId

40 , Control.Monad.NodeId

36 build-depends:

41 build-depends:

37− base >= 4.10.0 && < 4.14,

42+ base >= 4.10.0 && < 4.15,

38− bimap >= 0.3.3 && < 0.4,

43+ bimap >= 0.3.3 && < 0.5,

39 containers >= 0.5.0 && < 0.7,

44 containers >= 0.5.0 && < 0.7,

40 mtl >= 2.2.2 && < 2.3,

45 mtl >= 2.2.2 && < 2.3,

41 transformers >= 0.5.5 && < 0.6,

46 transformers >= 0.5.5 && < 0.6,

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

147 extra,

152 extra,

148 hspec >= 2.7 && < 2.8

153 hspec >= 2.7 && < 2.8

149 default-language: Haskell2010

154 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

103+ , HasFocusReader t m, HasTheme 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

125+ , HasFocusReader t m, HasTheme t m

126 )

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

128chart pct = do

src-bin/example.hs+11−3

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

23 , HasImageWriter t m

24 , HasDisplayRegion t m

25 , HasFocus t m

26− , HasFocusReader t m

26+ , HasFocusReader t m, HasTheme t m

27 )

29type Manager t m =

@@ -46,12 +46,20 @@ 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+

49main :: IO ()

57main :: IO ()

50main = mainWidget $ withCtrlC $ do

58main = mainWidget $ withCtrlC $ do

51 initManager_ $ do

59 initManager_ $ do

52 tabNavigation

60 tabNavigation

53 let gf = grout . fixed

61 let gf = grout . fixed

54− t = tile flex

62+ t = tile flex

55 buttons = col $ do

63 buttons = col $ do

56 gf 3 $ col $ do

64 gf 3 $ col $ do

57 gf 1 $ text "Select an example."

65 gf 1 $ text "Select an example."

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

77 _ -> Nothing

85 _ -> Nothing

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

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

79 Left Example_Todo -> escapable taskList

87 Left Example_Todo -> escapable taskList

80− Left Example_TextEditor -> escapable testBoxes

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

81 Left Example_ScrollableTextDisplay -> escapable scrolling

89 Left Example_ScrollableTextDisplay -> escapable scrolling

82 Left Example_ClickButtonsGetEmojis -> escapable easyExample

90 Left Example_ClickButtonsGetEmojis -> escapable easyExample

83 Left Example_CPUStat -> escapable cpuStats

91 Left Example_CPUStat -> escapable cpuStats

src/Data/Text/Zipper.hs+27−16

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

12import Prelude

14import Control.Exception (assert)

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

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

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,9 +314,7 @@ 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 []

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

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

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

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

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

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

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

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

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

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

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

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

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

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

367wrapWithOffsetAndAlignment 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

370− r' = splitWordsAtDisplayWidth maxWidth $ T.replicate n " " : wordsWithWhitespace txt

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

371 fmapfn (t,b) = case alignment of

370 fmapfn (t,b) = case alignment of

372 TextAlignment_Left -> WrappedLine t b 0

371 TextAlignment_Left -> WrappedLine t b 0

373 TextAlignment_Right -> WrappedLine t b (maxWidth-l)

372 TextAlignment_Right -> WrappedLine t b (maxWidth-l)

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

380

379

381-- converts deleted eol spaces into logical lines

380-- converts deleted eol spaces into logical lines

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

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

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

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

384

383

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

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

386offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines

385offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines

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

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

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

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

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

421 linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la

420 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

422 offsets :: OffsetMapWithAlignment

424 offsets :: OffsetMapWithAlignment

423 offsets = offsetMapWithAlignmentInternal $ mconcat

425 offsets = offsetMapWithAlignmentInternal $ mconcat

424 [ linesBefore

426 [ linesBefore

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

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

426 , linesAfter

428 , linesAfter

427 ]

429 ]

428 flattenLines = concatMap (fmap _wrappedLines_text)

430 flattenLines = concatMap (fmap _wrappedLines_text)

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

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

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

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

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

434

436

435− -- TODO cursor goes here if align right

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

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

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

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

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

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

439 curLineOffset = spansWidth spansCurLineBefore

440 curLineOffset = spansWidth spansCurLineBefore

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

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

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

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

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

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

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

450

451

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) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width o rest) of

458+ in case map ((:[]) . Span tag) $ _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+

462 cursorY = sum

475 cursorY = sum

463 [ length spansBefore

476 [ length spansBefore

464 , length spansCurrentBefore

477 , length spansCurrentBefore

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

471 { _displayLines_spans = concat

484 { _displayLines_spans = concat

472 [ spansBefore

485 [ spansBefore

473 , spansCurrentBefore

486 , spansCurrentBefore

474− , if cursorAfterEOL

487+ , curLineSpan

475− then [ spansCurLineBefore, spansCurLineAfter ]

476− else [ spansCurLineBefore <> spansCurLineAfter ]

477 , spansCurrentAfter

488 , spansCurrentAfter

478 , spansAfter

489 , spansAfter

479 ]

490 ]

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

531 -> Int -- ^ Offset for first line

542 -> Int -- ^ Offset for first line

532 -> Text -- ^ Text to be wrapped

543 -> Text -- ^ Text to be wrapped

533 -> [Text]

544 -> [Text]

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

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

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

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

35 , HasDisplayRegion t m

36 , HasFocusReader t m

37 , HasInput t m

38+ , HasTheme t m

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

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

39 -> IO ()

40 -> IO ()

40mainWidgetWithHandle vty child =

41mainWidgetWithHandle vty child =

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

45 let inp' = fforMaybe inp $ \case

46 let inp' = fforMaybe inp $ \case

46 V.EvResize {} -> Nothing

47 V.EvResize {} -> Nothing

47 x -> Just x

48 x -> Just x

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

50+ runFocusReader (pure True) $

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

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

49− runImageWriter $

52+ runImageWriter $

50− runNodeIdT $

53+ runNodeIdT $

51− runInput inp' $ do

54+ runInput inp' $ do

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

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

53− child

56+ child

54 return $ VtyResult

57 return $ VtyResult

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

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

56 , _vtyResult_shutdown = shutdown

59 , _vtyResult_shutdown = shutdown

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

69 , MonadNodeId m

72 , MonadNodeId m

70 , HasDisplayRegion t m

73 , HasDisplayRegion t m

71 , HasFocusReader t m

74 , HasFocusReader t m

75+ , HasTheme t m

72 , HasInput t m

76 , HasInput t m

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

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

74 -> IO ()

78 -> IO ()

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

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

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

234

238

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

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

236−regionBlankImage :: Region -> Image

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

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

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

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

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

239

243

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

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

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

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

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

403 , NotReady t

407 , NotReady t

404 , PerformEvent t

408 , PerformEvent t

405 , PostBuild t

409 , PostBuild t

406− , TriggerEvent t

410+ , TriggerEvent t

407 )

411 )

408

412

409instance MonadTrans (ImageWriter t) where

413instance MonadTrans (ImageWriter t) where

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

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

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

442runImageWriter = runBehaviorWriterT . unImageWriter

446runImageWriter = runBehaviorWriterT . unImageWriter

443

447

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+

444-- ** Manipulating images

517-- ** Manipulating images

445

518

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

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

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

@@ -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) => BoxStyle -> m ()

16+hRule :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme 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)

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

58 => Behavior t BoxStyle

59 -> Behavior t Text

60 -> m a

@@ -62,36 +62,39 @@ 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

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

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

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

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

68+

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

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

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

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

71+

69 pane innerReg (pure True) child

72 pane innerReg (pure True) child

70 where

73 where

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

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

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

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

73 let right = left + width - 1

76 let right = left + width - 1

74 bottom = top + height - 1

77 bottom = top + height - 1

75 sides =

78 sides =

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

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

77− V.text' V.defAttr $

80+ V.text' attr $

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

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

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

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

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

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

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

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

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

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

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

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

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

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

85 ]

88 ]

86 corners =

89 corners =

87 [ withinImage (Region left top 1 1) $

90 [ withinImage (Region left top 1 1) $

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

91+ V.char attr (_boxStyle_nw style)

89 , withinImage (Region right top 1 1) $

92 , withinImage (Region right top 1 1) $

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

93+ V.char attr (_boxStyle_ne style)

91 , withinImage (Region right bottom 1 1) $

94 , withinImage (Region right bottom 1 1) $

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

95+ V.char attr (_boxStyle_se style)

93 , withinImage (Region left bottom 1 1) $

96 , withinImage (Region left bottom 1 1) $

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

97+ V.char attr (_boxStyle_sw style)

95 ]

98 ]

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

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

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

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

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

106 right = mkHalf delta

109 right = mkHalf delta

107

110

108-- | A box without a title

111-- | A box without a title

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

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

110 => Behavior t BoxStyle

113 => Behavior t BoxStyle

111 -> m a

114 -> m a

112 -> m a

115 -> m a

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

114

117

115-- | A box whose style is static

118-- | A box whose style is static

116boxStatic

119boxStatic

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

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

118 => BoxStyle

121 => BoxStyle

119 -> m a

122 -> m a

120 -> m a

123 -> m a

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

@@ -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, HasDisplayRegion t m, HasImageWriter t m, HasInput t m)

37+ :: (Reflex t, Monad m, HasFocusReader t m, HasTheme 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, HasImageWriter t m, HasInput t m)

55+ :: (Reflex t, Monad m, HasDisplayRegion t m, HasFocusReader t m, HasTheme 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, HasImageWriter t m, HasInput t m)

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

64 => ButtonConfig t

65 -> Text

66 -> m (Event t ())

@@ -70,19 +70,20 @@ 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)

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

74 => Behavior t Text

75 -> m (Event t MouseUp)

76link t = do

77+ bt <- theme

77 let cfg = RichTextConfig

78 let cfg = RichTextConfig

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

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

79 }

80 }

80 richText cfg t

81 richText cfg t

81 mouseUp

82 mouseUp

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

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

84linkStatic

85linkStatic

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

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

86 => Text

87 => Text

87 -> m (Event t MouseUp)

88 -> m (Event t MouseUp)

88linkStatic = link . pure

89linkStatic = link . pure

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

115-- | Configuration options for a checkbox

116-- | Configuration options for a checkbox

116data CheckboxConfig t = CheckboxConfig

117data CheckboxConfig t = CheckboxConfig

117 { _checkboxConfig_checkboxStyle :: Behavior t CheckboxStyle

118 { _checkboxConfig_checkboxStyle :: Behavior t CheckboxStyle

119+ -- TODO DELETE and use HasTheme instead

118 , _checkboxConfig_attributes :: Behavior t V.Attr

120 , _checkboxConfig_attributes :: Behavior t V.Attr

119 , _checkboxConfig_setValue :: Event t Bool

121 , _checkboxConfig_setValue :: Event t Bool

120 }

122 }

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

128

130

129-- | A checkbox widget

131-- | A checkbox widget

130checkbox

132checkbox

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

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

132 => CheckboxConfig t

134 => CheckboxConfig t

133 -> Bool

135 -> Bool

134 -> m (Dynamic t Bool)

136 -> m (Dynamic t Bool)

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

@@ -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, HasDisplayRegion t m, HasImageWriter t m, HasDisplayRegion t m)

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)

47 => TextInputConfig t

48 -> m (TextInput t)

49textInput cfg = do

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

51 f <- focus

52 dh <- displayHeight

53 dw <- displayWidth

54+ bt <- theme

55+ attr0 <- sample bt

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

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

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

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

56 , _textInputConfig_modify cfg

58 , _textInputConfig_modify cfg

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

59 goToDisplayLinePosition mx (st + my) dl

61 goToDisplayLinePosition mx (st + my) dl

60 ]

62 ]

61 click <- mouseDown V.BLeft

63 click <- mouseDown V.BLeft

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

64+

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

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

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

67+ rowInputDyn = (,,)

64 <$> dw

68 <$> dw

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

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

66− <*> cursorAttrs

70+ <*> f

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

67 img = images . _displayLines_spans <$> rows

76 img = images . _displayLines_spans <$> rows

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

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

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

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

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

82-- | A widget that allows multiline text input

91-- | A widget that allows multiline text input

83multilineTextInput

92multilineTextInput

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

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

85 => TextInputConfig t

94 => TextInputConfig t

86 -> m (TextInput t)

95 -> m (TextInput t)

87multilineTextInput cfg = do

96multilineTextInput cfg = do

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

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

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

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

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

101textInputTile

110textInputTile

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)

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)

103 => m (TextInput t)

112 => m (TextInput t)

104 -> Dynamic t Int

113 -> Dynamic t Int

105 -> m (TextInput t)

114 -> m (TextInput t)

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

111 Orientation_Row -> width

120 Orientation_Row -> width

112 return t

121 return t

113

122

114−-- | Default attributes for the text cursor

115−cursorAttributes :: V.Attr

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

117−

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

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

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

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

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

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

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

@@ -133,6 +133,8 @@ 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+

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

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

137 makeFocus = do

139 makeFocus = do

138 fid <- FocusId <$> lift getNextNodeId

140 fid <- FocusId <$> lift getNextNodeId

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

430

432

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

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

432

434

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

436+

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

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

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

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

435 nodeId <- getNextNodeId

439 nodeId <- getNextNodeId

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

@@ -14,13 +14,15 @@ 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) => Behavior t Char -> m ()

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

18fill bc = do

19 dw <- displayWidth

20 dh <- displayHeight

21+ bt <- theme

21 let fillImg =

22 let fillImg =

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

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

24+ <$> bt

23− <$> current dw

25+ <*> current dw

24 <*> current dh

26 <*> current dh

25 <*> bc

27 <*> bc

26 tellImages fillImg

28 tellImages fillImg

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

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

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

34 def = RichTextConfig $ pure V.defAttr

36 def = RichTextConfig $ pure V.defAttr

38+

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

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

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

37richText

41richText

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

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

39 => RichTextConfig t

43 => RichTextConfig t

40 -> Behavior t Text

44 -> Behavior t Text

41 -> m ()

45 -> m ()

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

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

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

55text

59text

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

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

57 => Behavior t Text

61 => Behavior t Text

58 -> m ()

62 -> m ()

63+text t = do

64+ bt <- theme

59−text = richText def

65+ richText (RichTextConfig bt) t

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

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

62-- that are hidden)

68-- that are hidden)

63scrollableText

69scrollableText

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

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

65 => Event t Int

71 => Event t Int

66 -- ^ Number of lines to scroll by

72 -- ^ Number of lines to scroll by

67 -> Behavior t Text

73 -> Behavior t Text

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

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

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

70scrollableText scrollBy t = do

76scrollableText scrollBy t = do

71 dw <- displayWidth

77 dw <- displayWidth

78+ bt <- theme

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

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

73 kup <- key V.KUp

80 kup <- key V.KUp

74 kdown <- key V.KDown

81 kdown <- key V.KDown

75 m <- mouseScroll

82 m <- mouseScroll

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

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

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

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

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

90 where

97 where

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

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

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

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

94-- 'String' as text

101-- 'String' as text

95display

102display

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

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

97 => Behavior t a

104 => Behavior t a

98 -> m ()

105 -> m ()

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

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

test/Data/Text/ZipperSpec.hs+83−64

@@ -9,77 +9,96 @@ import Prelude

9import Test.Hspec

11import qualified Data.Map as Map

12−import Data.Text

12+import qualified Data.Text as T

13+import Control.Monad

14import Data.Text.Zipper

15import Data.Text.Zipper

17someSentence = "12345 1234 12"

18someSentence = "12345 1234 12"

19−splitSentenceAtDisplayWidth :: Int -> Text -> [(Text, Bool)]

20+splitSentenceAtDisplayWidth :: Int -> T.Text -> [(T.Text, Bool)]

20splitSentenceAtDisplayWidth w t = splitWordsAtDisplayWidth w (wordsWithWhitespace t)

21splitSentenceAtDisplayWidth w t = splitWordsAtDisplayWidth w (wordsWithWhitespace t)

22spec :: Spec

23spec :: Spec

23−spec = do

24+spec =

24 describe "Zipper" $ do

25 describe "Zipper" $ do

25− it "wordsWithWhitespace" $ do

26+ it "wordsWithWhitespace" $ do

26− wordsWithWhitespace "" `shouldBe` []

27+ wordsWithWhitespace "" `shouldBe` []

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

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

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

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

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

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

30− it "splitWordsAtDisplayWidth" $ do

31+ it "splitWordsAtDisplayWidth" $ do

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

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

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

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

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

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

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

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

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

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

36− 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"]

37− it "wrapWithOffsetAndAlignment" $ do

38+ it "wrapWithOffsetAndAlignment" $ do

38− 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)]

39− 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)]

40− 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)]

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)]

41− it "eolSpacesToLogicalLines" $ do

46+ it "eolSpacesToLogicalLines" $ do

42− eolSpacesToLogicalLines

47+ eolSpacesToLogicalLines

43− [

48+ [

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

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

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

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

46− ]

51+ ]

47− `shouldBe`

52+ `shouldBe`

48− [

53+ [

49− [ ("😱",1) ]

54+ [ ("😱",1) ]

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

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

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

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

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

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

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

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

54− ]

59+ ]

55− it "offsetMapWithAlignmentInternal" $ do

60+ it "offsetMapWithAlignmentInternal" $ do

56− offsetMapWithAlignmentInternal

61+ offsetMapWithAlignmentInternal

57− [

62+ [

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

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

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

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

60− ]

65+ ]

61− `shouldBe`

66+ `shouldBe`

62− Map.fromList

67+ Map.fromList

63− [ (0, (1,0))

68+ [ (0, (1,0))

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

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

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

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

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

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

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

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

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

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

69− ]

74+ ]

70− it "displayLines - cursorPos" $ do

75+ it "displayLines - cursorPos" $ do

71− let

76+ let

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

90+ _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

97+ let

98+ someText = top $ fromText "0123456789abcdefgh"

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

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

101+ 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

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