    module Text.Wrap
      ( WrapSettings(..)
      , defaultWrapSettings

      , wrapTextToLines
      , wrapText
      )
    where

    import Data.Monoid ((<>))
    import Data.Char (isSpace)
    import qualified Data.Text as T

    -- | Settings to control how wrapping is performed.
    data WrapSettings =
        WrapSettings { WrapSettings -> Bool
    preserveIndentation :: Bool
                     -- ^ Whether to indent new lines created by wrapping
                     -- when their original line was indented.
                     , WrapSettings -> Bool
    breakLongWords :: Bool
                     -- ^ Whether to break in the middle of the first word
                     -- on a line when that word exceeds the wrapping width.
                     }
                     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
                     }

    -- | Wrap text at the specified width. Newlines and whitespace in the
    -- input text are preserved. Returns the lines of text in wrapped form.
    -- New lines introduced due to wrapping will have leading whitespace
    -- stripped.
    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

    -- | Like 'wrapTextToLines', but returns the wrapped text reconstructed
    -- with newlines inserted at wrap points.
    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 text into whitespace and non-whitespace chunks.
    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)

    -- | Wrap a single line of text into a list of lines that all satisfy
    -- the wrapping width.
    wrapLine :: WrapSettings
             -- ^ Settings.
             -> Int
             -- ^ The wrapping width.
             -> T.Text
             -- ^ A single line of 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

    -- | Break a token sequence so that all tokens up to but not exceeding
    -- a length limit are included on the left, and if any remain on the
    -- right, return Just those too (or Nothing if there weren't any). If
    -- this breaks a sequence at at point where the next token after the
    -- break point is whitespace, that whitespace token is removed.
    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 =
        -- Take enough tokens until we reach the point where taking more
        -- would exceed the line length.
        let go :: Int -> [Token] -> ([Token], [Token])
    go _ []     = ([], [])
            -- Check to see whether the next token exceeds the limit. If so, bump
            -- it to the next line and terminate. Otherwise keep it and continue to
            -- the next token.
            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 tokens are the ones we keep on this line. The rest go
            -- on the next line, to be wrapped again.
            (allowed :: [Token]
    allowed, disallowed' :: [Token]
    disallowed') = Int -> [Token] -> ([Token], [Token])
    go 0 [Token]
    ts
            disallowed :: [Token]
    disallowed = [Token] -> [Token]
    maybeTrim [Token]
    disallowed'

            -- Trim leading whitespace on wrapped lines.
            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