Replace string with text

reflex-vty.cabal

@@ -39,6 +39,7 @@ executable example
     base,
     reflex,
     reflex-vty,
+    text,
     time,
     transformers,
     vty

src-bin/example.hs

@@ -10,6 +10,7 @@ import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Reader
+import qualified Data.Text as T
 import Data.Time
 import qualified Graphics.Vty as V
 import Reflex
@@ -35,24 +36,24 @@ testBoxes = do
       region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) size
   pane region1 (constDyn False) . box singleBoxStyle $ debugInput
   pane region2 (constDyn True) . box singleBoxStyle $
-    splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle debugInput) (box roundedBoxStyle dragTest)
+    splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle $ multilineTextInput def) (box roundedBoxStyle dragTest)
   return ()
 
 debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
 debugFocus = do
   f <- focus
-  string $ show <$> current f
+  text $ T.pack . show <$> current f
 
 debugInput :: (Reflex t, MonadHold t m) => VtyWidget t m ()
 debugInput = do
   lastEvent <- hold "No event yet" . fmap show =<< input
-  string lastEvent
+  text $ T.pack <$> lastEvent
 
 dragTest :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
 dragTest = do
   lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft
-  string lastEvent
+  text $ T.pack <$> lastEvent
 
 testStringBox :: (Reflex t, Monad m) => VtyWidget t m ()
 testStringBox = box singleBoxStyle .
-  string . pure . take 500 $ cycle ('\n' : ['a'..'z'])
+  text . pure . T.pack . take 500 $ cycle ('\n' : ['a'..'z'])

src/Reflex/Vty/Widget.hs

@@ -30,12 +30,12 @@ module Reflex.Vty.Widget
   , modifyImages
   , tellImages
   , tellShutdown
-  , wrapString
+  , wrapText
   , splitV
   , splitVDrag
   , fractionSz
   , box
-  , string
+  , text
   , hyphenBoxStyle
   , singleBoxStyle
   , roundedBoxStyle
@@ -417,25 +417,30 @@ box style child = do
             ]
       in sides ++ if width > 1 && height > 1 then corners else []
 
-string :: (Reflex t, Monad m) => Behavior t String -> VtyWidget t m ()
-string msg = do
+text :: (Reflex t, Monad m) => Behavior t Text -> VtyWidget t m ()
+text msg = do
   dw <- displayWidth
-  let img = (\w s -> [wrapString w V.defAttr s]) <$> current dw <*> msg
+  let img = (\w s -> [wrapText w V.defAttr s]) <$> current dw <*> msg
   tellImages img
 
 regionBlankImage :: Region -> Image
-regionBlankImage r@(Region _ _ width height) =
-  withinImage r $ wrapString width V.defAttr $ replicate (width * height) ' '
+regionBlankImage r@(Region left top width height) =
+  withinImage r $ V.charFill V.defAttr ' ' width height
 
 withinImage :: Region -> Image -> Image
 withinImage (Region left top width height)
   | width < 0 || height < 0 = withinImage (Region left top 0 0)
   | otherwise = V.translate left top . V.crop width height
 
-wrapString :: Int -> Attr -> String -> Image
-wrapString maxWidth attrs = V.vertCat
-  . concatMap (fmap (V.string attrs) . fmap (take maxWidth) . takeWhile (not . null) . iterate (drop maxWidth))
-  . lines
+wrapText :: Int -> Attr -> Text -> Image
+wrapText maxWidth attrs = V.vertCat
+  . concatMap (fmap (V.string attrs . T.unpack) . wrapWithOffset maxWidth 0)
+  . T.split (=='\n')
+
+wrapWithOffset :: Int -> Int -> Text -> [Text]
+wrapWithOffset maxWidth n xs =
+  let (firstLine, rest) = T.splitAt (maxWidth - n) xs
+  in firstLine : (fmap (T.take maxWidth) . takeWhile (not . T.null) . iterate (T.drop maxWidth) $ rest)
 
 wrapInputState
   :: Int -- ^ Maximum line length
@@ -462,7 +467,7 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =
       (midBeforeTop, midBefore') = fromMaybe ([], "") $ initLast $ wrap [midBefore]
       (midAfter', midAfterBottom) =
         let offset = if T.length midBefore' == maxWidth then 1 else T.length midBefore' + 1
-        in  case wrapWithOffset offset midAfter of
+        in  case wrapWithOffset maxWidth offset midAfter of
               [] -> ("", [])
               x:xs -> (x, xs)
       cursor = V.char cursorAttrs cursorChar
@@ -491,12 +496,8 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =
     before' = T.split (=='\n') before
     after' = T.split (=='\n') after
     vstring = V.string attrs . T.unpack
-    wrapWithOffset :: Int -> Text -> [Text]
-    wrapWithOffset n xs =
-      let (firstLine, rest) = T.splitAt (maxWidth - n) xs
-      in firstLine : (fmap (T.take maxWidth) . takeWhile (not . T.null) . iterate (T.drop maxWidth) $ rest)
     wrap :: [Text] -> [Text]
-    wrap = concatMap (wrapWithOffset 0)
+    wrap = concatMap (wrapWithOffset maxWidth 0)
     headTail :: [a] -> Maybe (a, [a])
     headTail = \case
       [] -> Nothing