develop..53abc34 · reflex-vty

.travis.ymlnew file+112

since splitsnapshots

unifiedsplit

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

88

86

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)

97

89

reflex-vty.cabal+1−1

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

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 )

28

29type Manager t m =

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

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

47 _ -> Nothing

48

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+2−5

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

12import Prelude

13

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)

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

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

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

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

424 offsets :: OffsetMapWithAlignment

421 offsets :: OffsetMapWithAlignment

425 offsets = offsetMapWithAlignmentInternal $ mconcat

422 offsets = offsetMapWithAlignmentInternal $ mconcat

426 [ linesBefore

423 [ linesBefore

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

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

428 , linesAfter

425 , linesAfter

429 ]

426 ]

430 flattenLines = concatMap (fmap _wrappedLines_text)

427 flattenLines = concatMap (fmap _wrappedLines_text)

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

14

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)

18

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

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

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

55

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

34

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

52

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.

60

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

70

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

83

82

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

43

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

90

81

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

15

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

37

35

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

57

53

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

66

60

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

99

92

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−5

@@ -88,11 +88,6 @@ spec =

88 _displayLines_cursorPos dl4 `shouldBe` (5,0)

89 _displayLines_cursorPos dl5 `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

91 it "displayLinesWithAlignment - spans" $ do

97 let

92 let

98 someText = top $ fromText "0123456789abcdefgh"

93 someText = top $ fromText "0123456789abcdefgh"