module Text.Wrap
( WrapSettings(..)
, defaultWrapSettings
, wrapTextToLines
, wrapText
)
where
import Data.Monoid ((<>))
import Data.Char (isSpace)
import qualified Data.Text as T
data WrapSettings =
WrapSettings { WrapSettings -> Bool
preserveIndentation :: Bool
, WrapSettings -> Bool
breakLongWords :: Bool
}
deriving (WrapSettings -> WrapSettings -> Bool
(WrapSettings -> WrapSettings -> Bool)
-> (WrapSettings -> WrapSettings -> Bool) -> Eq WrapSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrapSettings -> WrapSettings -> Bool
$c/= :: WrapSettings -> WrapSettings -> Bool
== :: WrapSettings -> WrapSettings -> Bool
$c== :: WrapSettings -> WrapSettings -> Bool
Eq, Int -> WrapSettings -> ShowS
[WrapSettings] -> ShowS
WrapSettings -> String
(Int -> WrapSettings -> ShowS)
-> (WrapSettings -> String)
-> ([WrapSettings] -> ShowS)
-> Show WrapSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrapSettings] -> ShowS
$cshowList :: [WrapSettings] -> ShowS
show :: WrapSettings -> String
$cshow :: WrapSettings -> String
showsPrec :: Int -> WrapSettings -> ShowS
$cshowsPrec :: Int -> WrapSettings -> ShowS
Show, ReadPrec [WrapSettings]
ReadPrec WrapSettings
Int -> ReadS WrapSettings
ReadS [WrapSettings]
(Int -> ReadS WrapSettings)
-> ReadS [WrapSettings]
-> ReadPrec WrapSettings
-> ReadPrec [WrapSettings]
-> Read WrapSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WrapSettings]
$creadListPrec :: ReadPrec [WrapSettings]
readPrec :: ReadPrec WrapSettings
$creadPrec :: ReadPrec WrapSettings
readList :: ReadS [WrapSettings]
$creadList :: ReadS [WrapSettings]
readsPrec :: Int -> ReadS WrapSettings
$creadsPrec :: Int -> ReadS WrapSettings
Read)
defaultWrapSettings :: WrapSettings
defaultWrapSettings :: WrapSettings
defaultWrapSettings =
WrapSettings :: Bool -> Bool -> WrapSettings
WrapSettings { preserveIndentation :: Bool
preserveIndentation = Bool
False
, breakLongWords :: Bool
breakLongWords = Bool
False
}
wrapTextToLines :: WrapSettings -> Int -> T.Text -> [T.Text]
wrapTextToLines :: WrapSettings -> Int -> Text -> [Text]
wrapTextToLines settings :: WrapSettings
settings amt :: Int
amt s :: Text
s =
[[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WrapSettings -> Int -> Text -> [Text]
wrapLine WrapSettings
settings Int
amt) ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
wrapText :: WrapSettings -> Int -> T.Text -> T.Text
wrapText :: WrapSettings -> Int -> Text -> Text
wrapText settings :: WrapSettings
settings amt :: Int
amt s :: Text
s =
Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack "\n") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ WrapSettings -> Int -> Text -> [Text]
wrapTextToLines WrapSettings
settings Int
amt Text
s
data Token = WS T.Text | NonWS T.Text
deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)
tokenLength :: Token -> Int
tokenLength :: Token -> Int
tokenLength = Text -> Int
T.length (Text -> Int) -> (Token -> Text) -> Token -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
tokenContent
tokenContent :: Token -> T.Text
tokenContent :: Token -> Text
tokenContent (WS t :: Text
t) = Text
t
tokenContent (NonWS t :: Text
t) = Text
t
tokenize :: T.Text -> [Token]
tokenize :: Text -> [Token]
tokenize t :: Text
t | Text -> Bool
T.null Text
t = []
tokenize t :: Text
t =
let leadingWs :: Text
leadingWs = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace Text
t
leadingNonWs :: Text
leadingNonWs = (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
t
tok :: Token
tok = if Text -> Bool
T.null Text
leadingWs
then Text -> Token
NonWS Text
leadingNonWs
else Text -> Token
WS Text
leadingWs
in Token
tok Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Text -> [Token]
tokenize (Int -> Text -> Text
T.drop (Token -> Int
tokenLength Token
tok) Text
t)
wrapLine :: WrapSettings
-> Int
-> T.Text
-> [T.Text]
wrapLine :: WrapSettings -> Int -> Text -> [Text]
wrapLine settings :: WrapSettings
settings limit :: Int
limit t :: Text
t =
let go :: Int -> [Token] -> [Text]
go _ [] = [Text
T.empty]
go _ [WS _] = [Text
T.empty]
go lim :: Int
lim ts :: [Token]
ts =
let (firstLine :: [Token]
firstLine, maybeRest :: Maybe [Token]
maybeRest) = WrapSettings -> Int -> [Token] -> ([Token], Maybe [Token])
breakTokens WrapSettings
settings Int
lim [Token]
ts
firstLineText :: Text
firstLineText = Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Token -> Text) -> [Token] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token -> Text
tokenContent [Token]
firstLine
in case Maybe [Token]
maybeRest of
Nothing -> [Text
firstLineText]
Just rest :: [Token]
rest -> Text
firstLineText Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Token] -> [Text]
go Int
lim [Token]
rest
(indent :: Text
indent, modifiedText :: Text
modifiedText) = if WrapSettings -> Bool
preserveIndentation WrapSettings
settings
then let i :: Text
i = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace Text
t
in (Int -> Text -> Text
T.take (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Text
i, Int -> Text -> Text
T.drop (Text -> Int
T.length Text
i) Text
t)
else (Text
T.empty, Text
t)
result :: [Text]
result = Int -> [Token] -> [Text]
go (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
indent) (Text -> [Token]
tokenize Text
modifiedText)
in (Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
result
breakTokens :: WrapSettings -> Int -> [Token] -> ([Token], Maybe [Token])
breakTokens :: WrapSettings -> Int -> [Token] -> ([Token], Maybe [Token])
breakTokens _ _ [] = ([], Maybe [Token]
forall a. Maybe a
Nothing)
breakTokens settings :: WrapSettings
settings limit :: Int
limit ts :: [Token]
ts =
let go :: Int -> [Token] -> ([Token], [Token])
go _ [] = ([], [])
go acc :: Int
acc (tok :: Token
tok:toks :: [Token]
toks) =
if Token -> Int
tokenLength Token
tok Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
then let (nextAllowed :: [Token]
nextAllowed, nextDisallowed :: [Token]
nextDisallowed) = Int -> [Token] -> ([Token], [Token])
go (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Token -> Int
tokenLength Token
tok) [Token]
toks
in (Token
tok Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
nextAllowed, [Token]
nextDisallowed)
else case Token
tok of
WS _ -> ([], [Token]
toks)
NonWS _ ->
if Int
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& WrapSettings -> Bool
breakLongWords WrapSettings
settings
then let (h :: Text
h, tl :: Text
tl) = Int -> Text -> (Text, Text)
T.splitAt Int
limit (Token -> Text
tokenContent Token
tok)
in ([Text -> Token
NonWS Text
h], Text -> Token
NonWS Text
tl Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
toks)
else if Int
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then ([Token
tok], [Token]
toks)
else ([], Token
tokToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks)
(allowed :: [Token]
allowed, disallowed' :: [Token]
disallowed') = Int -> [Token] -> ([Token], [Token])
go 0 [Token]
ts
disallowed :: [Token]
disallowed = [Token] -> [Token]
maybeTrim [Token]
disallowed'
maybeTrim :: [Token] -> [Token]
maybeTrim [] = []
maybeTrim (WS _:toks :: [Token]
toks) = [Token]
toks
maybeTrim toks :: [Token]
toks = [Token]
toks
result :: ([Token], Maybe [Token])
result = if [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
disallowed
then ([Token]
allowed, Maybe [Token]
forall a. Maybe a
Nothing)
else ([Token]
allowed, [Token] -> Maybe [Token]
forall a. a -> Maybe a
Just [Token]
disallowed)
in ([Token], Maybe [Token])
result