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

      , wrapTextToLines
      , wrapText
      )
    where

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

    -- | How should wrapped lines be filled (i.e. what kind of prefix
    --   should be attached?)
    data FillStrategy
      = NoFill             -- ^ Don't do any filling (default)
      | FillIndent Int     -- ^ Indent by this many spaces
      | FillPrefix T.Text  -- ^ Prepend this text
      deriving (FillStrategy -> FillStrategy -> Bool
    (FillStrategy -> FillStrategy -> Bool)
    -> (FillStrategy -> FillStrategy -> Bool) -> Eq FillStrategy
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FillStrategy -> FillStrategy -> Bool
    == :: FillStrategy -> FillStrategy -> Bool
    $c/= :: FillStrategy -> FillStrategy -> Bool
    /= :: FillStrategy -> FillStrategy -> Bool
    Eq, Int -> FillStrategy -> ShowS
    [FillStrategy] -> ShowS
    FillStrategy -> String
    (Int -> FillStrategy -> ShowS)
    -> (FillStrategy -> String)
    -> ([FillStrategy] -> ShowS)
    -> Show FillStrategy
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FillStrategy -> ShowS
    showsPrec :: Int -> FillStrategy -> ShowS
    $cshow :: FillStrategy -> String
    show :: FillStrategy -> String
    $cshowList :: [FillStrategy] -> ShowS
    showList :: [FillStrategy] -> ShowS
    Show, ReadPrec [FillStrategy]
    ReadPrec FillStrategy
    Int -> ReadS FillStrategy
    ReadS [FillStrategy]
    (Int -> ReadS FillStrategy)
    -> ReadS [FillStrategy]
    -> ReadPrec FillStrategy
    -> ReadPrec [FillStrategy]
    -> Read FillStrategy
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS FillStrategy
    readsPrec :: Int -> ReadS FillStrategy
    $creadList :: ReadS [FillStrategy]
    readList :: ReadS [FillStrategy]
    $creadPrec :: ReadPrec FillStrategy
    readPrec :: ReadPrec FillStrategy
    $creadListPrec :: ReadPrec [FillStrategy]
    readListPrec :: ReadPrec [FillStrategy]
    Read)

    fillWidth :: FillStrategy -> Int
    fillWidth :: FillStrategy -> Int
    fillWidth FillStrategy
    NoFill         = Int
    0
    fillWidth (FillIndent Int
    n) = Int
    n
    fillWidth (FillPrefix Text
    t) = Text -> Int
    T.length Text
    t

    -- | To which lines should the fill strategy be applied?
    data FillScope
      = FillAfterFirst     -- ^ Apply any fill prefix only to lines after
                           --   the first line (default)
      | FillAll            -- ^ Apply any fill prefix to all lines, even
                           --   if there is only one line
      deriving (FillScope -> FillScope -> Bool
    (FillScope -> FillScope -> Bool)
    -> (FillScope -> FillScope -> Bool) -> Eq FillScope
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FillScope -> FillScope -> Bool
    == :: FillScope -> FillScope -> Bool
    $c/= :: FillScope -> FillScope -> Bool
    /= :: FillScope -> FillScope -> Bool
    Eq, Int -> FillScope -> ShowS
    [FillScope] -> ShowS
    FillScope -> String
    (Int -> FillScope -> ShowS)
    -> (FillScope -> String)
    -> ([FillScope] -> ShowS)
    -> Show FillScope
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FillScope -> ShowS
    showsPrec :: Int -> FillScope -> ShowS
    $cshow :: FillScope -> String
    show :: FillScope -> String
    $cshowList :: [FillScope] -> ShowS
    showList :: [FillScope] -> ShowS
    Show, ReadPrec [FillScope]
    ReadPrec FillScope
    Int -> ReadS FillScope
    ReadS [FillScope]
    (Int -> ReadS FillScope)
    -> ReadS [FillScope]
    -> ReadPrec FillScope
    -> ReadPrec [FillScope]
    -> Read FillScope
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS FillScope
    readsPrec :: Int -> ReadS FillScope
    $creadList :: ReadS [FillScope]
    readList :: ReadS [FillScope]
    $creadPrec :: ReadPrec FillScope
    readPrec :: ReadPrec FillScope
    $creadListPrec :: ReadPrec [FillScope]
    readListPrec :: ReadPrec [FillScope]
    Read)

    -- | 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.
                     , WrapSettings -> FillStrategy
    fillStrategy        :: FillStrategy
                     -- ^ What kind of prefix should be applied to lines
                     --   after wrapping? (default: none)
                     , WrapSettings -> FillScope
    fillScope           :: FillScope
                     -- ^ To which lines should the fill strategy be applied?
                     --   (default: all but the first)
                     }
                     deriving (WrapSettings -> WrapSettings -> Bool
    (WrapSettings -> WrapSettings -> Bool)
    -> (WrapSettings -> WrapSettings -> Bool) -> Eq WrapSettings
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: WrapSettings -> WrapSettings -> Bool
    == :: WrapSettings -> WrapSettings -> Bool
    $c/= :: WrapSettings -> WrapSettings -> Bool
    /= :: 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
    $cshowsPrec :: Int -> WrapSettings -> ShowS
    showsPrec :: Int -> WrapSettings -> ShowS
    $cshow :: WrapSettings -> String
    show :: WrapSettings -> String
    $cshowList :: [WrapSettings] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS WrapSettings
    readsPrec :: Int -> ReadS WrapSettings
    $creadList :: ReadS [WrapSettings]
    readList :: ReadS [WrapSettings]
    $creadPrec :: ReadPrec WrapSettings
    readPrec :: ReadPrec WrapSettings
    $creadListPrec :: ReadPrec [WrapSettings]
    readListPrec :: ReadPrec [WrapSettings]
    Read)

    defaultWrapSettings :: WrapSettings
    defaultWrapSettings :: WrapSettings
    defaultWrapSettings =
        WrapSettings { preserveIndentation :: Bool
    preserveIndentation = Bool
    False
                     , breakLongWords :: Bool
    breakLongWords = Bool
    False
                     , fillStrategy :: FillStrategy
    fillStrategy = FillStrategy
    NoFill
                     , fillScope :: FillScope
    fillScope = FillScope
    FillAfterFirst
                     }

    -- | Apply a function to the portion of a list of lines indicated by
    --   the 'FillScope'.
    withScope :: FillScope -> (a -> a) -> [a] -> [a]
    withScope :: forall a. FillScope -> (a -> a) -> [a] -> [a]
    withScope FillScope
    FillAfterFirst = (a -> a) -> [a] -> [a]
    forall a. (a -> a) -> [a] -> [a]
    onTail
    withScope FillScope
    FillAll        = (a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map

    -- | Map a function over the tail of a list.
    onTail :: (a -> a) -> [a] -> [a]
    onTail :: forall a. (a -> a) -> [a] -> [a]
    onTail a -> a
    _ []     = []
    onTail a -> a
    f (a
    a:[a]
    as) = a
    a a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> a
    f [a]
    as

    -- | Apply the fill specified in the 'WrapSettings' to a list of lines.
    applyFill :: WrapSettings -> [T.Text] -> [T.Text]
    applyFill :: WrapSettings -> [Text] -> [Text]
    applyFill WrapSettings
    settings =
        let scope :: FillScope
    scope = WrapSettings -> FillScope
    fillScope WrapSettings
    settings
        in case WrapSettings -> FillStrategy
    fillStrategy WrapSettings
    settings of
               FillStrategy
    NoFill       -> [Text] -> [Text]
    forall a. a -> a
    id
               FillIndent Int
    n -> FillScope -> (Text -> Text) -> [Text] -> [Text]
    forall a. FillScope -> (a -> a) -> [a] -> [a]
    withScope FillScope
    scope (Text -> Text -> Text
    T.append (Int -> Text -> Text
    T.replicate Int
    n (String -> Text
    T.pack String
    " ")))
               FillPrefix Text
    t -> FillScope -> (Text -> Text) -> [Text] -> [Text]
    forall a. FillScope -> (a -> a) -> [a] -> [a]
    withScope FillScope
    scope (Text -> Text -> Text
    T.append Text
    t)

    -- | 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 prior to having any fill applied.  Preserved
    -- indentation is always placed before any fill.
    wrapTextToLines :: WrapSettings -> Int -> T.Text -> [T.Text]
    wrapTextToLines :: WrapSettings -> Int -> Text -> [Text]
    wrapTextToLines WrapSettings
    settings Int
    amt 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 a b. (a -> b) -> [a] -> [b]
    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 WrapSettings
    settings Int
    amt Text
    s =
        Text -> [Text] -> Text
    T.intercalate (String -> Text
    T.pack String
    "\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
    $cshowsPrec :: Int -> Token -> ShowS
    showsPrec :: Int -> Token -> ShowS
    $cshow :: Token -> String
    show :: Token -> String
    $cshowList :: [Token] -> ShowS
    showList :: [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 Text
    t) = Text
    t
    tokenContent (NonWS Text
    t) = Text
    t

    -- | Tokenize text into whitespace and non-whitespace chunks.
    tokenize :: T.Text -> [Token]
    tokenize :: Text -> [Token]
    tokenize Text
    t | Text -> Bool
    T.null Text
    t = []
    tokenize 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 WrapSettings
    settings Int
    limit Text
    t =
        let restFillWidth :: Int
    restFillWidth      = FillStrategy -> Int
    fillWidth (WrapSettings -> FillStrategy
    fillStrategy WrapSettings
    settings)
            firstLineFillWidth :: Int
    firstLineFillWidth = if WrapSettings -> FillScope
    fillScope WrapSettings
    settings FillScope -> FillScope -> Bool
    forall a. Eq a => a -> a -> Bool
    == FillScope
    FillAll then Int
    restFillWidth else Int
    0

            firstLineLimit :: Int
    firstLineLimit = Int
    limit Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    indent Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    firstLineFillWidth
            restLimit :: Int
    restLimit      = Int
    limit Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    indent Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    restFillWidth

            go :: Bool -> [Token] -> [Text]
    go Bool
    _ []     = [Text
    T.empty]
            go Bool
    _ [WS Text
    _] = [Text
    T.empty]
            go Bool
    isFirstLine [Token]
    ts =
                let lim :: Int
    lim = if Bool
    isFirstLine then Int
    firstLineLimit else Int
    restLimit
                    ([Token]
    firstLine, 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 a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Token -> Text
    tokenContent [Token]
    firstLine
                in case Maybe [Token]
    maybeRest of
                    Maybe [Token]
    Nothing   -> [Text
    firstLineText]
                    Just [Token]
    rest -> Text
    firstLineText Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : Bool -> [Token] -> [Text]
    go Bool
    False [Token]
    rest
            (Text
    indent, 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
    - Int
    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 = Bool -> [Token] -> [Text]
    go Bool
    True (Text -> [Token]
    tokenize Text
    modifiedText)
        in (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text
    indent Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrapSettings -> [Text] -> [Text]
    applyFill WrapSettings
    settings ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> 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 WrapSettings
    _ Int
    _ [] = ([], Maybe [Token]
    forall a. Maybe a
    Nothing)
    breakTokens WrapSettings
    settings Int
    limit [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 Int
    _ []     = ([], [])
            -- 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 Int
    acc (Token
    tok:[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 ([Token]
    nextAllowed, [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 Text
    _ -> ([], [Token]
    toks)
                         NonWS Text
    _ ->
                             if Int
    acc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && WrapSettings -> Bool
    breakLongWords WrapSettings
    settings
                             then let (Text
    h, 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
    == Int
    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.
            ([Token]
    allowed, [Token]
    disallowed') = Int -> [Token] -> ([Token], [Token])
    go Int
    0 [Token]
    ts
            disallowed :: [Token]
    disallowed = [Token] -> [Token]
    maybeTrim [Token]
    disallowed'

            -- Trim leading whitespace on wrapped lines.
            maybeTrim :: [Token] -> [Token]
    maybeTrim [] = []
            maybeTrim (WS Text
    _:[Token]
    toks) = [Token]
    toks
            maybeTrim [Token]
    toks = [Token]
    toks

            result :: ([Token], Maybe [Token])
    result = if [Token] -> Bool
    forall a. [a] -> 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