-- | 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 :: Text -> Widget n
wrappedText Text
theText = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
  Context
ctx <- RenderM n Context
forall n. RenderM n Context
getContext
  let newText :: Text
newText = Int -> Text -> Text
wrapLines (Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL) Text
theText
  Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
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 ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Text]
wrap ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
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