module Text.Wrap
( WrapSettings(..)
, defaultWrapSettings
, wrapTextToLines
, wrapText
)
where
import Data.Monoid ((<>))
import Data.Char (isSpace)
import qualified Data.Text as T
data WrapSettings =
WrapSettings { preserveIndentation :: Bool
, breakLongWords :: Bool
}
deriving (Eq, Show, Read)
defaultWrapSettings :: WrapSettings
defaultWrapSettings =
WrapSettings { preserveIndentation = False
, breakLongWords = False
}
wrapTextToLines :: WrapSettings -> Int -> T.Text -> [T.Text]
wrapTextToLines settings amt s =
concat $ fmap (wrapLine settings amt) $ T.lines s
wrapText :: WrapSettings -> Int -> T.Text -> T.Text
wrapText settings amt s =
T.intercalate (T.pack "\n") $ wrapTextToLines settings amt s
data Token = WS T.Text | NonWS T.Text
deriving (Show)
tokenLength :: Token -> Int
tokenLength = T.length . tokenContent
tokenContent :: Token -> T.Text
tokenContent (WS t) = t
tokenContent (NonWS t) = t
tokenize :: T.Text -> [Token]
tokenize t | T.null t = []
tokenize t =
let leadingWs = T.takeWhile isSpace t
leadingNonWs = T.takeWhile (not . isSpace) t
tok = if T.null leadingWs
then NonWS leadingNonWs
else WS leadingWs
in tok : tokenize (T.drop (tokenLength tok) t)
wrapLine :: WrapSettings
-> Int
-> T.Text
-> [T.Text]
wrapLine settings limit t =
let go [] = [T.empty]
go [WS _] = [T.empty]
go ts =
let (firstLine, maybeRest) = breakTokens settings limit ts
firstLineText = T.stripEnd $ T.concat $ fmap tokenContent firstLine
in case maybeRest of
Nothing -> [firstLineText]
Just rest ->
let maybeIndent = if preserveIndentation settings
then ((WS indent) :)
else id
indent = T.takeWhile isSpace firstLineText
in firstLineText : go (maybeIndent rest)
in go (tokenize t)
breakTokens :: WrapSettings -> Int -> [Token] -> ([Token], Maybe [Token])
breakTokens _ _ [] = ([], Nothing)
breakTokens settings limit ts =
let go _ [] = ([], [])
go acc (tok:rest) | acc == 0 && tokenLength tok > limit =
case breakLongWords settings of
False -> ([tok], rest)
True ->
case tok of
WS _ -> ([], rest)
NonWS _ ->
let (h, tl) = T.splitAt limit (tokenContent tok)
in ([NonWS h], tokenize tl <> rest)
go acc (tok:toks) =
if tokenLength tok + acc <= limit
then let (nextAllowed, nextDisallowed) = go (acc + tokenLength tok) toks
in (tok : nextAllowed, nextDisallowed)
else if not $ breakLongWords settings
then ([], (tok:toks))
else case tok of
WS _ -> ([], toks)
NonWS _ ->
let (h, tl) = T.splitAt (limit acc) (tokenContent tok)
in ([NonWS h], tokenize tl <> toks)
(allowed, disallowed') = go 0 ts
disallowed = maybeTrim disallowed'
maybeTrim [] = []
maybeTrim (WS _:toks) = toks
maybeTrim toks = toks
result = if null disallowed
then (allowed, Nothing)
else (allowed, Just disallowed)
in result