c58ee15 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

on develop help sign in

Add mapImages to ImageWriter

c58ee15Ali Abrar6 years ago

ChangeLog.md+1

compare with develop

unifiedsplit

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

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

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

53* 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

55## 0.1.4.1

56## 0.1.4.1

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

57* 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

132 askCtx :: m (VtyWidgetCtx t)

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

134 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

136

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

138 askCtx = VtyWidget $ lift ask

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

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

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

141− tellImages $ g images

142− pure a

143

140

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

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

145runVtyWidget

142runVtyWidget

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

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

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

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

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

245 tellImages = lift . tellImages

242 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

246

245

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

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

248 tellImages = tellBehavior

247 tellImages = tellBehavior

248+ mapImages f x = do

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

250+ tellImages $ f images

251+ pure a

249

252

250-- | A chunk of the display area

253-- | A chunk of the display area

251data Region = Region

254data Region = Region

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

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

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

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

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

285pane

288pane

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)

287 => Dynamic t Region

290 => Dynamic t Region

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

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

289 -> m a

292 -> m a

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

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

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

300 (liftA2 (,) reg (current foc))

303 (liftA2 (,) reg (current foc))

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

304 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

303 where

306 where

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

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

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

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

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

444

447

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

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

446-- No visual separator is built in here.

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

448 => Dynamic t (Int -> Int)

451 => Dynamic t (Int -> Int)

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

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

450 -> Dynamic t (Bool, Bool)

453 -> Dynamic t (Bool, Bool)

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

465

468

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

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

467-- No visual separator is built in here.

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

469 => Dynamic t (Int -> Int)

472 => Dynamic t (Int -> Int)

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

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

471 -> Dynamic t (Bool, Bool)

474 -> Dynamic t (Bool, Bool)

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

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

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

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

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

487-- Clicking in a pane switches focus.

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

489 => m ()

492 => m ()

490 -> m a

493 -> m a

491 -> m b

494 -> m b

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

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

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

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

101textInputTile

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)

103 => m (TextInput t)

104 -> Dynamic t Int

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

129 return a

130

131instance (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

133 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

135 tellEvent e

136 tellDyn fs

137 return a

138

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

140

146

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

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

142

148

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

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

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

384

390

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

391instance (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

387 solution <- Layout ask

393 solution <- Layout ask

388 let orientation = snd . rootLT <$> solution

394 let orientation = snd . rootLT <$> solution

389− lift $ localCtx f g $ do

395+ lift $ localCtx f $ do

390 dw <- displayWidth

396 dw <- displayWidth

391 dh <- displayHeight

397 dh <- displayHeight

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

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

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

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

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

403 runLayout orientation reg x

409 runLayout orientation reg x

404

410

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

406

420

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

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

408

422

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

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

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

496-- management.

510-- management.

497tile'

511tile'

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)

499 => Dynamic t Constraint

513 => Dynamic t Constraint

500 -> m a

514 -> m a

501 -> m (FocusId, a)

515 -> m (FocusId, a)

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

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

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

515-- provided constraint.

529-- provided constraint.

516tile

530tile

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)

518 => Dynamic t Constraint

532 => Dynamic t Constraint

519 -> m a

533 -> m a

520 -> m a

534 -> m a

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

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

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

526-- provided constraint.

540-- provided constraint.

527grout

541grout

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)

529 => Dynamic t Constraint

543 => Dynamic t Constraint

530 -> m a

544 -> m a

531 -> m a

545 -> m a