c58ee15 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

Add mapImages to ImageWriter

commitc58ee1553b3c4298566ee8d041939189f7d7be74 authorAli Abrar <aliabrar@gmail.com> dateTue 23 Mar 2021, 01:14 (6 years ago) parent945321b

4 files changed+38−20

compare with develop

unifiedsplit

ChangeLog.md+1 src/Reflex/Vty/Widget.hs+13−10 src/Reflex/Vty/Widget/Input/Text.hs+1−1 src/Reflex/Vty/Widget/Layout.hs+23−9

ChangeLog.md+1

@@ -51,6 +51,7 @@

5151* _Breaking Change_: `HasVtyInput` now has a method `localInput` for filtering the input a child widget may receive

5252* Add `anyChildFocused`, which provides information about whether subwidgets are focused

5353* Add `filterKeys`, which is the same as `localInput` but only cares about keyboard events

54+* _Breaking Change_: `ImageWriter` now has a method `mapImages` for transforming the images emitted by a child widget

5455

5556## 0.1.4.1

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

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

@@ -132,14 +132,11 @@ class HasVtyWidgetCtx t m | m -> t where

132132 askCtx :: m (VtyWidgetCtx t)

133133 default askCtx :: (f m' ~ m, Monad m', MonadTrans f, HasVtyWidgetCtx t m') => m (VtyWidgetCtx t)

134134 askCtx = lift askCtx

135− localCtx :: (VtyWidgetCtx t -> VtyWidgetCtx t) -> (Behavior t [Image] -> Behavior t [Image]) -> m a -> m a

135+ localCtx :: (VtyWidgetCtx t -> VtyWidgetCtx t) -> m a -> m a

136136

137137instance (Monad m, Reflex t) => HasVtyWidgetCtx t (VtyWidget t m) where

138138 askCtx = VtyWidget $ lift ask

139− localCtx f g (VtyWidget x) = VtyWidget $ do

140− (a, images) :: (a, Behavior t [Image]) <- lift $ local f $ runBehaviorWriterT x

141− tellImages $ g images

142− pure a

139+ localCtx f (VtyWidget x) = VtyWidget $ local f x

143140

144141-- | Runs a 'VtyWidget' with a given context

145142runVtyWidget

@@ -243,9 +240,15 @@ class (Reflex t, Monad m) => ImageWriter t m | m -> t where

243240 tellImages :: Behavior t [Image] -> m ()

244241 default tellImages :: (f m' ~ m, Monad m', MonadTrans f, ImageWriter t m') => Behavior t [Image] -> m ()

245242 tellImages = lift . tellImages

243+ -- | Apply a transformation to the images produced by the child actions

244+ mapImages :: (Behavior t [Image] -> Behavior t [Image]) -> m a -> m a

246245

247246instance (Monad m, Reflex t) => ImageWriter t (BehaviorWriterT t [Image] m) where

248247 tellImages = tellBehavior

248+ mapImages f x = do

249+ (a, images) <- lift $ runBehaviorWriterT x

250+ tellImages $ f images

251+ pure a

249252

250253-- | A chunk of the display area

251254data Region = Region

@@ -283,7 +286,7 @@ withinImage (Region left top width height)

283286-- * mouse inputs inside the region have their coordinates translated such

284287-- that (0,0) is the top-left corner of the region

285288pane

286− :: (Reflex t, Monad m, MonadNodeId m, HasVtyWidgetCtx t m, HasVtyInput t m)

289+ :: (Reflex t, Monad m, MonadNodeId m, HasVtyWidgetCtx t m, HasVtyInput t m, ImageWriter t m)

287290 => Dynamic t Region

288291 -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.

289292 -> m a

@@ -299,7 +302,7 @@ pane dr foc child = do

299302 attachWith (\(r,f) e -> filterInput r f e)

300303 (liftA2 (,) reg (current foc))

301304 let imagesWithinRegion images = liftA2 (\is r -> map (withinImage r) is) images reg

302− localInput inputFilter $ localCtx subContext imagesWithinRegion child

305+ mapImages imagesWithinRegion $ localInput inputFilter $ localCtx subContext child

303306 where

304307 filterInput :: Region -> Bool -> VtyEvent -> Maybe VtyEvent

305308 filterInput (Region l t w h) focused e = case e of

@@ -444,7 +447,7 @@ keyCombos ks = do

444447

445448-- | A plain split of the available space into vertically stacked panes.

446449-- No visual separator is built in here.

447−splitV :: (Reflex t, Monad m, MonadNodeId m, HasVtyWidgetCtx t m, HasDisplaySize t m, HasVtyInput t m)

450+splitV :: (Reflex t, Monad m, MonadNodeId m, HasVtyWidgetCtx t m, HasDisplaySize t m, HasVtyInput t m, ImageWriter t m)

448451 => Dynamic t (Int -> Int)

449452 -- ^ Function used to determine size of first pane based on available size

450453 -> Dynamic t (Bool, Bool)

@@ -465,7 +468,7 @@ splitV sizeFunD focD wA wB = do

465468

466469-- | A plain split of the available space into horizontally stacked panes.

467470-- No visual separator is built in here.

468−splitH :: (Reflex t, Monad m, MonadNodeId m, HasDisplaySize t m, HasVtyWidgetCtx t m, HasVtyInput t m)

471+splitH :: (Reflex t, Monad m, MonadNodeId m, HasDisplaySize t m, HasVtyWidgetCtx t m, HasVtyInput t m, ImageWriter t m)

469472 => Dynamic t (Int -> Int)

470473 -- ^ Function used to determine size of first pane based on available size

471474 -> Dynamic t (Bool, Bool)

@@ -485,7 +488,7 @@ splitH sizeFunD focD wA wB = do

485488-- | A split of the available space into two parts with a draggable separator.

486489-- Starts with half the space allocated to each, and the first pane has focus.

487490-- Clicking in a pane switches focus.

488−splitVDrag :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m, HasDisplaySize t m, HasVtyInput t m, HasVtyWidgetCtx t m)

491+splitVDrag :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m, HasDisplaySize t m, HasVtyInput t m, HasVtyWidgetCtx t m, ImageWriter t m)

489492 => m ()

490493 -> m a

491494 -> m b

src/Reflex/Vty/Widget/Input/Text.hs+1−1

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

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

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

101101textInputTile

102− :: (Monad m, MonadNodeId m, Reflex t, MonadFix m, MonadLayout t m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m)

102+ :: (Monad m, MonadNodeId m, Reflex t, MonadFix m, MonadLayout t m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, ImageWriter t m)

103103 => m (TextInput t)

104104 -> Dynamic t Int

105105 -> m (TextInput t)

src/Reflex/Vty/Widget/Layout.hs+23−9

@@ -129,14 +129,20 @@ instance (Reflex t, MonadFix m, HasVtyInput t m) => HasVtyInput t (Focus t m) wh

129129 return a

130130

131131instance (HasVtyWidgetCtx t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Focus t m) where

132− localCtx f g (Focus w) = Focus $ do

132+ localCtx f (Focus w) = Focus $ do

133133 d <- ask

134− ((a, fs), e) <- lift $ lift $ lift $ localCtx f g $ runEventWriterT $ flip runReaderT d $ runDynamicWriterT w

134+ ((a, fs), e) <- lift $ lift $ lift $ localCtx f $ runEventWriterT $ flip runReaderT d $ runDynamicWriterT w

135135 tellEvent e

136136 tellDyn fs

137137 return a

138138

139−instance ImageWriter t m => ImageWriter t (Focus t m)

139+instance (ImageWriter t m, MonadFix m) => ImageWriter t (Focus t m) where

140+ mapImages f (Focus w) = Focus $ do

141+ d <- ask

142+ ((a, fs), e) <- lift $ lift $ lift $ mapImages f $ runEventWriterT $ flip runReaderT d $ runDynamicWriterT w

143+ tellEvent e

144+ tellDyn fs

145+ return a

140146

141147instance (HasFocus t m, Monad m) => HasFocus t (Focus t m)

142148

@@ -383,10 +389,10 @@ instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (Layout t m

383389 traverseDMapWithKeyWithAdjustWithMove f m e = Layout $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unLayout $ f k v) m e

384390

385391instance (HasVtyWidgetCtx t m, HasDisplaySize t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Layout t m) where

386− localCtx f g x = do

392+ localCtx f x = do

387393 solution <- Layout ask

388394 let orientation = snd . rootLT <$> solution

389− lift $ localCtx f g $ do

395+ lift $ localCtx f $ do

390396 dw <- displayWidth

391397 dh <- displayHeight

392398 let reg = Region 0 0 <$> dw <*> dh

@@ -402,7 +408,15 @@ instance (HasVtyInput t m, HasDisplaySize t m, MonadFix m, Reflex t) => HasVtyIn

402408 let reg = Region 0 0 <$> dw <*> dh

403409 runLayout orientation reg x

404410

405−instance ImageWriter t m => ImageWriter t (Layout t m)

411+instance (HasDisplaySize t m, ImageWriter t m, MonadFix m) => ImageWriter t (Layout t m) where

412+ mapImages f x = do

413+ solution <- Layout ask

414+ let orientation = snd . rootLT <$> solution

415+ lift $ mapImages f $ do

416+ dw <- displayWidth

417+ dh <- displayHeight

418+ let reg = Region 0 0 <$> dw <*> dh

419+ runLayout orientation reg x

406420

407421instance (HasFocus t m, Monad m) => HasFocus t (Layout t m)

408422

@@ -495,7 +509,7 @@ initManager_ = fmap fst . initManager

495509-- provided constraint. Returns the 'FocusId' allowing for manual focus

496510-- management.

497511tile'

498− :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)

512+ :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m, ImageWriter t m)

499513 => Dynamic t Constraint

500514 -> m a

501515 -> m (FocusId, a)

@@ -514,7 +528,7 @@ tile' c w = do

514528-- | A widget that is focusable and occupies a layout region based on the

515529-- provided constraint.

516530tile

517− :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)

531+ :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m, ImageWriter t m)

518532 => Dynamic t Constraint

519533 -> m a

520534 -> m a

@@ -525,7 +539,7 @@ tile c = fmap snd . tile' c

525539-- | A widget that is not focusable and occupies a layout region based on the

526540-- provided constraint.

527541grout

528− :: (Reflex t, MonadNodeId m, HasVtyWidgetCtx t m, MonadLayout t m, HasVtyInput t m)

542+ :: (Reflex t, MonadNodeId m, HasVtyWidgetCtx t m, MonadLayout t m, HasVtyInput t m, ImageWriter t m)

529543 => Dynamic t Constraint

530544 -> m a

531545 -> m a