-- | TODO Use the built-in wrapping feature in brick-0.20
module Brick.Widgets.WrappedText (wrappedText) where

import           Brick
import           Data.Text (Text)
import qualified Data.Text as T
import           Lens.Micro

-- | Widget like 'txt', but wrap all lines to fit on the screen.
--
-- Doesn't do word wrap, just breaks the line whenever the maximum width is
-- exceeded.
wrappedText :: Text -> Widget n
wrappedText :: forall n. Text -> Widget n
wrappedText Text
theText = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
  Context n
ctx <- forall n. RenderM n (Context n)
getContext
  let newText :: Text
newText = Int -> Text -> Text
wrapLines (Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) Text
theText
  forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
newText

-- | Wrap all lines in input to fit into maximum width.
--
-- Doesn't do word wrap, just breaks the line whenever the maximum width is
-- exceeded.
wrapLines :: Int -> Text -> Text
wrapLines :: Int -> Text -> Text
wrapLines Int
width = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> [Text]
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  where
    wrap :: Text -> [Text]
wrap = Int -> Text -> [Text]
T.chunksOf Int
width