bcdd207 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

on develop help sign in

Improved StackWidget. Add documentation

bcdd207Ali Abrar8 years ago

reflex-vty.cabal+1−1

compare with develop

unifiedsplit

@@ -22,7 +22,7 @@ library

22 , Reflex.Vty.Widget.Input

23 , Reflex.Vty.Widget.Input.Text

24 , Data.Text.Zipper

25− , Control.Monad.Writer.Adjustable

25+ , Control.Monad.TimeMachine

26 , Reflex.Class.Orphans

27 , Reflex.Class.Switchable

28 , Reflex.NotReady.Class.Orphans

src-bin/example.hs+9−22

@@ -42,28 +42,16 @@ main = mainWidget $ do

42 w <- displayWidth

43 h <- displayHeight

45− row $ {- sized (div' w 2) $ col $ -} do

46− sized 5 $ textButtonStatic def "A"

47− sized 5 $ textButtonStatic def "B"

48− TextInput value lines <- sized 10 $ multilineTextInput def

49− TextInput value' lines' <- sized 10 $ multilineTextInput def

50− sized 10 $ textButton def ("\n" <> current value)

51− sized 5 $ textButtonStatic def "E"

52− sized 1 $ text "asdf"

53− sized 1 $ text "zxcv"

54−

55− {-

56− let buttons = do

45+ let buttons = col $ do

46+ fixed 4 $ col $ do

47+ fixed 1 $ text "Select an example."

57− text $ pure "Select an example. Esc will bring you back here. Ctrl+c to quit."

48+ fixed 1 $ text "Esc will bring you back here."

58− let w' = fmap (`div`6) w

49+ fixed 1 $ text "Ctrl+c to quit."

59− h' = fmap (`div`6) h

60− region1 = DynRegion w' h' w' h'

61− region2 = DynRegion (2 * w') h' w' h'

62− todo' <- pane region1 (pure True) $ textButtonStatic def "Todo List"

50+ a <- fixed 5 $ textButtonStatic def "Todo List"

63− editor <- pane region2 (pure True) $ textButtonStatic def "Text Editor"

51+ b <- fixed 5 $ textButtonStatic def "Text Editor"

64 return $ leftmost

52 return $ leftmost

65− [ Left Example_TextEditor <$ editor

53+ [ Left Example_Todo <$ a

66− , Left Example_Todo <$ todo'

54+ , Left Example_TextEditor <$ b

67 ]

55 ]

68 escapable w = do

56 escapable w = do

69 void w

57 void w

@@ -75,7 +63,6 @@ main = mainWidget $ do

75 Left Example_TextEditor -> escapable testBoxes

63 Left Example_TextEditor -> escapable testBoxes

76 Left Example_Todo -> escapable taskList

64 Left Example_Todo -> escapable taskList

77 Right () -> buttons

65 Right () -> buttons

78− -}

79 return $ fforMaybe inp $ \case

66 return $ fforMaybe inp $ \case

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

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

81 _ -> Nothing

68 _ -> Nothing

src/Control/Monad/TimeMachine.hsnew file+85

@@ -0,0 +1,85 @@

1+{-|

2+Module: Control.Monad.TimeMachine

3+Description: A bi-directional state monad transformer

4+-}

5+{-# LANGUAGE DeriveFunctor #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

8+{-# LANGUAGE RecursiveDo #-}

9+{-# LANGUAGE TupleSections #-}

10+{-# LANGUAGE UndecidableInstances #-}

11+module Control.Monad.TimeMachine where

12+

13+import Control.Monad.Fix

14+import Control.Monad.Reader

15+import Reflex

16+import Reflex.NotReady.Class

17+

18+-- | A bi-directional state monad transformer. State changes may be propagated backward ("to the past")

19+-- or forward ("to the future"). Backward and forward correspond to the order in which monadic actions

20+-- are run.

21+-- The 3-tuple that is returned by 'runTimeMachineT' is made up of:

22+-- * "back": The value sent by the *first* 'sendToPast'

23+-- * "fwd": The value sent by the *last* 'sendToFuture'

24+-- * "a": The result

25+newtype TimeMachineT back fwd m a = TimeMachineT { runTimeMachineT :: back -> fwd -> m (back, fwd, a) }

26+ deriving (Functor)

27+

28+instance MonadFix m => Applicative (TimeMachineT back fwd m) where

29+ (<*>) = ap

30+ pure = return

31+

32+instance MonadFix m => Monad (TimeMachineT back fwd m) where

33+ x >>= f = TimeMachineT $ \back fwd -> do

34+ rec (back'', fwd', a) <- runTimeMachineT x back' fwd

35+ (back', fwd'', b) <- runTimeMachineT (f a) back fwd'

36+ return (back'', fwd'', b)

37+ return v = TimeMachineT $ \back fwd -> return (back, fwd, v)

38+

39+instance MonadFix m => MonadFix (TimeMachineT back fwd m) where

40+ mfix f = TimeMachineT $ \back fwd -> do

41+ rec (back', fwd', a) <- runTimeMachineT (f a) back fwd

42+ return (back', fwd', a)

43+

44+instance MonadTrans (TimeMachineT back fwd) where

45+ lift x = TimeMachineT $ \back fwd -> (back, fwd,) <$> x

46+

47+instance (MonadFix m, MonadReader r m) => MonadReader r (TimeMachineT back fwd m) where

48+ ask = lift ask

49+ local f x = TimeMachineT $ \back fwd -> local f $ runTimeMachineT x back fwd

50+

51+instance (MonadFix m, MonadSample t m) => MonadSample t (TimeMachineT back fwd m) where

52+ sample = lift . sample

53+

54+instance (MonadFix m, MonadHold t m) => MonadHold t (TimeMachineT back fwd m) where

55+ buildDynamic a b = lift $ buildDynamic a b

56+ headE = lift . headE

57+

58+instance (MonadFix m, NotReady t m) => NotReady t (TimeMachineT back fwd m)

59+

60+instance (MonadFix m, EventWriter t w m) => EventWriter t w (TimeMachineT back fwd m) where

61+ tellEvent = lift . tellEvent

62+

63+instance (MonadFix m, MonadBehaviorWriter t w m) => MonadBehaviorWriter t w (TimeMachineT back fwd m) where

64+ tellBehavior = lift . tellBehavior

65+

66+instance (MonadFix m, MonadDynamicWriter t w m) => MonadDynamicWriter t w (TimeMachineT back fwd m) where

67+ tellDyn = lift . tellDyn

68+

69+-- | Send a message to the preceding 'recvFromFuture'.

70+sendToPast :: Monad m => back -> TimeMachineT back fwd m ()

71+sendToPast x = TimeMachineT $ \_ fwd -> return (x, fwd, ())

72+

73+-- | Receive a message from the next 'sendToPast'. If it does not exist,

74+-- the value received will be the one passed to 'runTimeMachineT'.

75+recvFromFuture :: Monad m => TimeMachineT back fwd m back

76+recvFromFuture = TimeMachineT $ \back fwd -> return (back, fwd, back)

77+

78+-- | Send a message to the next 'recvFromPast'.

79+sendToFuture :: Monad m => fwd -> TimeMachineT back fwd m ()

80+sendToFuture x = TimeMachineT $ \back _ -> return (back, x, ())

81+

82+-- | Receive a message from the preceding 'sendToFuture'. If it does not exist,

83+-- the value received will be the one passed to 'runTimeMachineT'.

84+recvFromPast :: Monad m => TimeMachineT back fwd m fwd

85+recvFromPast = TimeMachineT $ \back fwd -> return (back, fwd, fwd)

src/Control/Monad/Writer/Adjustable.hsdeleted−35

@@ -1,35 +0,0 @@

1−{-|

2−Module: Control.Monad.Writer.Adjustable

3−Description: An Adjustable instance for WriterT

4−-}

5−{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE MultiParamTypeClasses #-}

7−{-# LANGUAGE ScopedTypeVariables #-}

8−{-# LANGUAGE UndecidableInstances #-}

9−{-# OPTIONS_GHC -fno-warn-orphans #-} -- TODO find a better home for this

10−module Control.Monad.Writer.Adjustable where

11−

12−import Control.Monad.Trans

13−import Control.Monad.Trans.Writer

14−import qualified Data.Dependent.Map as DMap

15−import Data.Foldable (fold)

16−import Data.Functor.Compose

17−import Reflex

18−import Reflex.Patch.DMapWithMove

19−import Reflex.Class.Switchable

20−

21−instance (Adjustable t m, MonadHold t m, Switchable t w, Monoid w) => Adjustable t (WriterT w m) where

22− runWithReplace a0 a' = do

23− (result0, result) <- lift $ runWithReplace (runWriterT a0) $ fmap (runWriterT) a'

24− tell =<< switching (snd result0) (snd <$> result)

25− return $ (fst result0, fst <$> result)

26− traverseIntMapWithKeyWithAdjust f dm0 dm' = do

27− (result0, result) <- lift $ traverseIntMapWithKeyWithAdjust (\k v -> runWriterT (f k v)) dm0 dm'

28− tell =<< switching (fold $ fmap snd result0) (fmap (mconcat . patchIntMapNewElements . fmap snd) result)

29− return (fmap fst result0, fmap (fmap fst) result)

30− traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do

31− (result0, result) <- lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> fmap (\(r, r0) -> Compose (r0, r)) $ runWriterT (f k v)) dm0 dm'

32− let result0' = runWriter $ DMap.traverseWithKey (\_ (Compose (w'', x)) -> tell w'' >> return x) result0

33− result' = fmap (runWriter . traversePatchDMapWithMove (\(Compose (w'', x)) -> tell w'' >> return x)) result

34− tell =<< switching (snd result0') (fmap snd result')

35− return (fst result0', fmap fst result')

src/Reflex/Class/Orphans.hs−2

@@ -16,5 +16,3 @@ instance (Num a, Reflex t) => Num (Dynamic t a) where

16 fromInteger = pure . fromInteger

17 negate = fmap negate

18 (-) = liftA2 (-)

19−

20−

src/Reflex/Vty/Widget.hs+180−54

@@ -2,6 +2,7 @@

2Module: Reflex.Vty.Widget

3Description: Basic set of widgets and building blocks for reflex-vty applications

4-}

5+{-# LANGUAGE DefaultSignatures #-}

5{-# LANGUAGE DeriveFunctor #-}

6{-# LANGUAGE DeriveFunctor #-}

6{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleInstances #-}

8{-# LANGUAGE FlexibleInstances #-}

@@ -17,6 +18,7 @@ Description: Basic set of widgets and building blocks for reflex-vty application

17{-# LANGUAGE TupleSections #-}

18{-# LANGUAGE TupleSections #-}

18{-# LANGUAGE TypeFamilies #-}

19{-# LANGUAGE TypeFamilies #-}

19{-# LANGUAGE UndecidableInstances #-}

20{-# LANGUAGE UndecidableInstances #-}

21+

20module Reflex.Vty.Widget

22module Reflex.Vty.Widget

21 ( VtyWidgetCtx(..)

23 ( VtyWidgetCtx(..)

22 , VtyWidget(..)

24 , VtyWidget(..)

@@ -25,14 +27,6 @@ module Reflex.Vty.Widget

25 , runVtyWidget

27 , runVtyWidget

26 , mainWidget

28 , mainWidget

27 , mainWidgetWithHandle

29 , mainWidgetWithHandle

28−

29− , StackWidget(..)

30− , stack

31− , Direction(..)

32− , col

33− , row

34− , sized

35−

36 , HasDisplaySize(..)

30 , HasDisplaySize(..)

37 , HasFocus(..)

31 , HasFocus(..)

38 , HasVtyInput(..)

32 , HasVtyInput(..)

@@ -68,15 +62,30 @@ module Reflex.Vty.Widget

68 , key

62 , key

69 , keys

63 , keys

70 , keyCombos

64 , keyCombos

65+ , SizedWidget

66+ , StackT

67+ , StackConfig(..)

68+ , StackWidget(..)

69+ , stack

70+ , Direction(..)

71+ , askDirection

72+ , askRemainingSpace

73+ , askOffset

74+ , col

75+ , row

76+ , fixed

77+ , fraction

78+ , remaining

79+ , tile

71 ) where

80 ) where

73import Control.Applicative (liftA2)

82import Control.Applicative (liftA2)

74−import Control.Monad (ap)

83+import Control.Monad.TimeMachine

75import Control.Monad.Fix (MonadFix)

84import Control.Monad.Fix (MonadFix)

85+import Control.Monad.Trans.Class

76import Control.Monad.Trans (lift)

86import Control.Monad.Trans (lift)

77−import Control.Monad.Trans.Reader (ReaderT, runReaderT, asks, ask)

87+import Control.Monad.Reader

78import Data.Default (Default(..))

88import Data.Default (Default(..))

79−import Data.Monoid (Sum(..))

80import Data.Set (Set)

89import Data.Set (Set)

81import qualified Data.Set as Set

90import qualified Data.Set as Set

82import Data.Text (Text)

91import Data.Text (Text)

@@ -85,6 +94,7 @@ import qualified Data.Text.Zipper as TZ

85import Graphics.Vty (Image)

94import Graphics.Vty (Image)

86import qualified Graphics.Vty as V

95import qualified Graphics.Vty as V

87import Reflex

96import Reflex

97+import Reflex.Class ()

88import Reflex.Class.Orphans ()

98import Reflex.Class.Orphans ()

89import Reflex.NotReady.Class

99import Reflex.NotReady.Class

90import Reflex.NotReady.Class.Orphans ()

100import Reflex.NotReady.Class.Orphans ()

@@ -125,7 +135,7 @@ instance (Adjustable t m, MonadHold t m, Reflex t) => Adjustable t (VtyWidget t

125newtype VtyWidget t m a = VtyWidget

135newtype VtyWidget t m a = VtyWidget

126 { unVtyWidget :: BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a

136 { unVtyWidget :: BehaviorWriterT t [Image] (ReaderT (VtyWidgetCtx t) m) a

127 }

137 }

128− deriving (Functor, Applicative, Monad, MonadSample t, MonadHold t, MonadFix, NotReady t, ImageWriter t)

138+ deriving (Functor, Applicative, Monad, MonadSample t, MonadHold t, MonadFix, NotReady t, ImageWriter t, PostBuild t)

129

139

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

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

131runVtyWidget

141runVtyWidget

@@ -174,13 +184,23 @@ mainWidget child = do

174class (Reflex t, Monad m) => HasDisplaySize t m | m -> t where

184class (Reflex t, Monad m) => HasDisplaySize t m | m -> t where

175 -- | Retrieve the display width (columns)

185 -- | Retrieve the display width (columns)

176 displayWidth :: m (Dynamic t Int)

186 displayWidth :: m (Dynamic t Int)

187+ default displayWidth :: (f m' ~ m, MonadTrans f, HasDisplaySize t m') => m (Dynamic t Int)

188+ displayWidth = lift displayWidth

177 -- | Retrieve the display height (rows)

189 -- | Retrieve the display height (rows)

178 displayHeight :: m (Dynamic t Int)

190 displayHeight :: m (Dynamic t Int)

179−

191+ default displayHeight :: (f m' ~ m, MonadTrans f, HasDisplaySize t m') => m (Dynamic t Int)

192+ displayHeight = lift displayHeight

180instance (Reflex t, Monad m) => HasDisplaySize t (VtyWidget t m) where

193instance (Reflex t, Monad m) => HasDisplaySize t (VtyWidget t m) where

181 displayWidth = VtyWidget . lift $ asks _vtyWidgetCtx_width

194 displayWidth = VtyWidget . lift $ asks _vtyWidgetCtx_width

182 displayHeight = VtyWidget . lift $ asks _vtyWidgetCtx_height

195 displayHeight = VtyWidget . lift $ asks _vtyWidgetCtx_height

183

196

197+instance HasDisplaySize t m => HasDisplaySize t (ReaderT x m)

198+instance HasDisplaySize t m => HasDisplaySize t (BehaviorWriterT t x m)

199+instance HasDisplaySize t m => HasDisplaySize t (DynamicWriterT t x m)

200+instance HasDisplaySize t m => HasDisplaySize t (EventWriterT t x m)

201+

202+instance (MonadFix m, HasDisplaySize t m) => HasDisplaySize t (TimeMachineT back fwd m)

203+

184-- | A class for things that can receive vty events as input

204-- | A class for things that can receive vty events as input

185class HasVtyInput t m | m -> t where

205class HasVtyInput t m | m -> t where

186 input :: m (Event t VtyEvent)

206 input :: m (Event t VtyEvent)

@@ -290,8 +310,6 @@ pane dr foc child = VtyWidget $ do

290 | otherwise =

310 | otherwise =

291 Just (con (x - l) (y - t))

311 Just (con (x - l) (y - t))

292

312

293−

294−

295-- | Information about a drag operation

313-- | Information about a drag operation

296data Drag = Drag

314data Drag = Drag

297 { _drag_from :: (Int, Int) -- ^ Where the drag began

315 { _drag_from :: (Int, Int) -- ^ Where the drag began

@@ -371,14 +389,18 @@ data MouseUp = MouseUp

371 }

389 }

372 deriving (Eq, Ord, Show)

390 deriving (Eq, Ord, Show)

373

391

392+-- | Type synonym for a key and modifier combination

374type KeyCombo = (V.Key, [V.Modifier])

393type KeyCombo = (V.Key, [V.Modifier])

375

394

395+-- | Emits an event that fires on a particular key press (without modifiers)

376key :: (Monad m, Reflex t) => V.Key -> VtyWidget t m (Event t KeyCombo)

396key :: (Monad m, Reflex t) => V.Key -> VtyWidget t m (Event t KeyCombo)

377key = keyCombos . Set.singleton . (,[])

397key = keyCombos . Set.singleton . (,[])

378

398

399+-- | Emits an event that fires on particular key presses (without modifiers)

379keys :: (Monad m, Reflex t) => [V.Key] -> VtyWidget t m (Event t KeyCombo)

400keys :: (Monad m, Reflex t) => [V.Key] -> VtyWidget t m (Event t KeyCombo)

380keys = keyCombos . Set.fromList . fmap (,[])

401keys = keyCombos . Set.fromList . fmap (,[])

381

402

403+-- | Emit an event that fires whenever any of the provided key combinations occur

382keyCombos

404keyCombos

383 :: (Reflex t, Monad m)

405 :: (Reflex t, Monad m)

384 => Set KeyCombo

406 => Set KeyCombo

@@ -600,65 +622,169 @@ display

600 -> VtyWidget t m ()

622 -> VtyWidget t m ()

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

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

602

624

625+-- | The main-axis orientation of a 'StackWidget' widget

603data Direction = Direction_Column

626data Direction = Direction_Column

604 | Direction_Row

627 | Direction_Row

605 deriving (Show, Read, Eq, Ord)

628 deriving (Show, Read, Eq, Ord)

606

629

607−newtype StackWidget t m a = StackWidget { unStackWidget :: ReaderT Direction (DynamicWriterT t (Sum Int) (VtyWidget t m)) a }

630+-- | Convenience type synonym for the 'TimeMachine' used to manage 'StackWidget'

608− deriving (Functor, MonadSample t, MonadHold t, MonadFix, NotReady t)

631+-- focus and offset states. The first parameter is the "focus previous" event and

609−

632+-- the second parameter is a tuple of "focus next" and the total size.

610−instance (Reflex t, MonadFix m) => Applicative (StackWidget t m) where

633+type StackT t = TimeMachineT (Event t ()) (Event t (), Dynamic t Int)

634+

635+-- | A 'VtyWidget' that can be stacked automatically

636+newtype StackWidget t m a

637+ = StackWidget

638+ { unStackWidget ::

639+ StackT t

640+ (EventWriterT t ()

641+ (ReaderT (StackConfig, Event t ())

642+ (VtyWidget t m))) a

643+ }

644+ deriving

645+ ( Functor

646+ , Applicative

647+ , Monad

648+ , MonadSample t

649+ , MonadHold t

650+ , MonadFix

651+ , NotReady t

652+ , HasDisplaySize t

653+ )

654+

655+-- | Retrieve the 'Direction'/orientation of the current 'StackWidget'

656+askDirection :: MonadFix m => StackWidget t m Direction

657+askDirection = StackWidget $ asks $ _stackConfig_direction . fst

658+

659+-- | Retrieve the offset reported by the previous 'tile'

660+askOffset :: Monad m => StackWidget t m (Dynamic t Int)

661+askOffset = StackWidget $ snd <$> recvFromPast

662+

663+-- | Compute the remaining main-axis space available

664+askRemainingSpace :: (Reflex t, MonadFix m) => StackWidget t m (Dynamic t Int)

665+askRemainingSpace = do

666+ dir <- askDirection

667+ offset <- askOffset

668+ sz <- case dir of

669+ Direction_Column -> displayHeight

670+ Direction_Row -> displayWidth

611− pure = return

671+ return $ sz - offset

612− (<*>) = ap

672+

613−

673+-- | A 'VtyWidget' and its actual main-axis size

674+type SizedWidget t m a = VtyWidget t m (Dynamic t Int, a)

675+

676+-- | Runs a 'StackWidget' with the provided configuration and initial offset

614runStackWidget

677runStackWidget

615− :: (Reflex t, MonadFix m)

678+ :: (MonadFix m, PostBuild t m)

616− => Direction

679+ => StackConfig

617 -> Dynamic t Int

680 -> Dynamic t Int

618 -> StackWidget t m a

681 -> StackWidget t m a

619− -> VtyWidget t m (Dynamic t (Sum Int), a)

682+ -> SizedWidget t m a

620−runStackWidget dir offset x = do

683+runStackWidget cfg offset x = do

621− mkRegion <- case dir of

684+ pb <- getPostBuild

685+ rec ((back, (fwd, sz), a), unfocus) <- runReaderT (runEventWriterT (runTimeMachineT (unStackWidget x) back (fwd <> pb, offset))) (cfg, unfocus)

686+ return (sz, a)

687+

688+-- | Turns a 'SizedWidget' into a 'StackWidget'. Wires up the focus-switching

689+-- and offset propagation.

690+tile

691+ :: (Reflex t, MonadHold t m, MonadFix m)

692+ => SizedWidget t m a

693+ -> StackWidget t m a

694+tile s = StackWidget $ do

695+ (focusTriggerP, offset) <- recvFromPast

696+ rec sendToPast focusBackward

697+ (cfg, unfocus) <- ask

698+ let bk = Set.difference (_stackConfig_focusPrevKey cfg) fk

699+ fk = _stackConfig_focusNextKey cfg

700+ focused <- holdDyn False $ leftmost

701+ [ True <$ (focusTriggerF <> focusTriggerP)

702+ , True <$ click

703+ , False <$ unfocus -- NB: unfocus must come after events that focus the current widget

704+ ]

705+ tellEvent $ mconcat

706+ [ () <$ click

707+ , () <$ keypress

708+ ]

709+ reg <- case _stackConfig_direction cfg of

622− Direction_Column -> (\w sz -> DynRegion 0 offset w sz) <$> displayWidth

710+ Direction_Column -> do

711+ w <- displayWidth

712+ return $ DynRegion 0 offset w sz

713+ Direction_Row -> do

623− Direction_Row -> (\h sz -> DynRegion offset 0 sz h) <$> displayHeight

714+ h <- displayHeight

624− rec (a, h) <- pane (mkRegion h') (pure True) $ runDynamicWriterT $ runReaderT (unStackWidget x) dir

715+ return $ DynRegion offset 0 sz h

625− let h' = getSum <$> h

716+ (click, keypress, (sz, r)) <- lift $ lift $ lift $ pane reg focused $ do

717+ e <- mouseDown V.BLeft

718+ ek <- keyCombos $ Set.union bk fk

719+ v <- s

626− return (h, a)

720+ return (e, ek, v)

627−

721+ let focusForward = () <$ ffilter (flip Set.member fk) keypress

628−instance (MonadFix m, Reflex t) => Monad (StackWidget t m) where

722+ focusBackward = () <$ ffilter (flip Set.member bk) keypress

629− w >>= g = StackWidget $ do

723+ focusTriggerF <- recvFromFuture

630− dir <- ask

724+ sendToFuture (focusForward, sz + offset)

631− (sz, r) <- lift $ lift $ runStackWidget dir 0 w

725+ return r

632− tellDyn sz

726+

633− (sz', r') <- lift $ lift $ runStackWidget dir (getSum <$> sz) (g r)

727+-- | Configuration for a 'StackWidget'

634− tellDyn sz'

728+data StackConfig = StackConfig

635− return r'

729+ { _stackConfig_direction :: Direction

636− return x = StackWidget $ return x

730+ , _stackConfig_focusNextKey :: Set KeyCombo

731+ , _stackConfig_focusPrevKey :: Set KeyCombo

732+ }

637

733

734+instance Default StackConfig where

735+ def = StackConfig

736+ { _stackConfig_direction = Direction_Column

737+ , _stackConfig_focusNextKey = Set.singleton (V.KChar '\t', [])

738+ , _stackConfig_focusPrevKey = Set.singleton (V.KBackTab, [])

739+ }

740+

741+-- | Runs a 'StackWidget' with the provided configuration

638stack

742stack

639− :: (Reflex t, MonadFix m)

743+ :: (MonadFix m, PostBuild t m)

640− => Direction

744+ => StackConfig

641 -> StackWidget t m a

745 -> StackWidget t m a

642 -> VtyWidget t m a

746 -> VtyWidget t m a

643−stack dir w = fmap snd $ runStackWidget dir 0 w

747+stack cfg w = fmap snd $ runStackWidget cfg 0 w

644

748

749+-- | Runs a vertically-oriented 'StackWidget' (i.e., a column)

645col

750col

646− :: (Reflex t, MonadFix m)

751+ :: (MonadFix m, PostBuild t m)

647 => StackWidget t m a

752 => StackWidget t m a

648 -> VtyWidget t m a

753 -> VtyWidget t m a

649−col = stack Direction_Column

754+col = stack def

650

755

756+-- | Runs a horizontally-oriented 'StackWidget' (i.e., a row)

651row

757row

652− :: (Reflex t, MonadFix m)

758+ :: (MonadFix m, PostBuild t m)

653 => StackWidget t m a

759 => StackWidget t m a

654 -> VtyWidget t m a

760 -> VtyWidget t m a

655−row = stack Direction_Row

761+row = stack $ def { _stackConfig_direction = Direction_Row }

656

762

657−sized

763+-- | A 'tile' of a fixed size

764+fixed

658− :: (Reflex t, MonadFix m)

765+ :: (Reflex t, MonadFix m, MonadHold t m)

659 => Dynamic t Int

766 => Dynamic t Int

660 -> VtyWidget t m a

767 -> VtyWidget t m a

661 -> StackWidget t m a

768 -> StackWidget t m a

662−sized sz w = StackWidget $ do

769+fixed sz w = tile $ (sz,) <$> w

663− tellDyn $ Sum <$> sz

770+

664− lift $ lift w

771+-- | A 'tile' that takes up the given fraction of the remaining

772+-- main-axis space

773+fraction

774+ :: (Reflex t, MonadFix m, MonadHold t m)

775+ => Dynamic t Rational

776+ -> VtyWidget t m a

777+ -> StackWidget t m a

778+fraction n w = do

779+ s <- askRemainingSpace

780+ let sz = fmap round $ n * fmap fromIntegral s

781+ fixed sz w

782+

783+-- | A 'tile' that takes up all of the remaining main-axis space

784+remaining

785+ :: (Reflex t, MonadHold t m, MonadFix m)

786+ => VtyWidget t m a

787+ -> StackWidget t m a

788+remaining w = do

789+ s <- askRemainingSpace

790+ fixed s w

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

@@ -91,6 +91,21 @@ multilineTextInput cfg = do

91 ]

92 }

94+-- | Wraps a 'textInput' or 'multilineTextInput' in a tile. Uses

95+-- the computed line count to greedily size the tile when vertically

96+-- oriented, and uses the fallback width when horizontally oriented.

97+textInputTile

98+ :: (Reflex t, MonadHold t m, MonadFix m)

99+ => VtyWidget t m (TextInput t)

100+ -> Dynamic t Int

101+ -> StackWidget t m (TextInput t)

102+textInputTile txt width = do

103+ rec t <- fixed sz txt

104+ sz <- ffor askDirection $ \case

105+ Direction_Column -> _textInput_lines t

106+ Direction_Row -> width

107+ return t

108+

94-- | Default attributes for the text cursor

109-- | Default attributes for the text cursor

95cursorAttributes :: V.Attr

110cursorAttributes :: V.Attr

96cursorAttributes = V.withStyle V.defAttr V.reverseVideo

111cursorAttributes = V.withStyle V.defAttr V.reverseVideo