Allow TextZipper contents to be transformed before display

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for reflex-vty
 
+## 0.1.2.0
+* Allow TextZipper contents to be tranformed before being displayed
+* Fix bug in `row` orientation
+
 ## 0.1.1.1
 
 * Bump minimum version of reflex

src/Data/Text/Zipper.hs

@@ -39,6 +39,15 @@ data TextZipper = TextZipper
 instance IsString TextZipper where
   fromString = fromText . T.pack
 
+-- | Map a replacement function over the characters in a 'TextZipper'
+mapZipper :: (Char -> Char) -> TextZipper -> TextZipper
+mapZipper f (TextZipper lb b a la) = TextZipper
+  { _textZipper_linesBefore = fmap (T.map f) lb
+  , _textZipper_before = T.map f b
+  , _textZipper_after = T.map f a
+  , _textZipper_linesAfter = fmap (T.map f) la
+  }
+
 -- | Move the cursor left one character, if possible
 left :: TextZipper -> TextZipper
 left = leftN 1

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

@@ -30,10 +30,13 @@ data TextInputConfig t = TextInputConfig
   { _textInputConfig_initialValue :: TextZipper
   , _textInputConfig_modify :: Event t (TextZipper -> TextZipper)
   , _textInputConfig_tabWidth :: Int
+  , _textInputConfig_display :: Char -> Char
+  -- ^ Transform the characters in a text input before displaying them. This is useful, e.g., for
+  -- masking characters when entering passwords.
   }
 
 instance Reflex t => Default (TextInputConfig t) where
-  def = TextInputConfig empty never 4
+  def = TextInputConfig empty never 4 id
 
 -- | The output produced by text input widgets, including the text
 -- value and the number of display lines (post-wrapping). Note that some
@@ -62,7 +65,10 @@ textInput cfg = do
         ]
       click <- mouseDown V.BLeft
       let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr
-      let rows = (\w s c -> displayLines w V.defAttr c s) <$> dw <*> v <*> cursorAttrs
+      let rows = (\w s c -> displayLines w V.defAttr c s)
+            <$> dw
+            <*> (mapZipper (_textInputConfig_display cfg) <$> v)
+            <*> cursorAttrs
           img = images . _displayLines_spans <$> rows
       y <- holdUniqDyn $ _displayLines_cursorY <$> rows
       let newScrollTop :: Int -> (Int, Int) -> Int