module Data.Text.ParagraphLayout.Internal.Rich (layoutRich)
where

import Control.Applicative (ZipList (ZipList), getZipList)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.ICU (Breaker, LocaleName, breakCharacter, breakLine)

import Data.Text.ParagraphLayout.Internal.BiDiLevels
import Data.Text.ParagraphLayout.Internal.Break
import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.Layout
import Data.Text.ParagraphLayout.Internal.ParagraphOptions
import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS
import Data.Text.ParagraphLayout.Internal.Rich.Paragraph
import Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.Run
import Data.Text.ParagraphLayout.Internal.TextOptions
import Data.Text.ParagraphLayout.Internal.Tree
import Data.Text.ParagraphLayout.Internal.WithSpan

-- | Lay out a rich text paragraph.
layoutRich :: Paragraph d -> ParagraphLayout d
layoutRich p@(Paragraph _ _ _ opts) = paragraphLayout $ map unwrap frags
    where
        unwrap (WithSpan rs frag) =
            frag { fragmentUserData = RS.spanUserData rs }
        frags = case nonEmpty wrappedRuns of
            Just xs -> layoutAndAlignLines maxWidth xs
            Nothing -> []
        wrappedRuns = spansToRunsWrapped spans
        maxWidth = paragraphMaxWidth opts
        spans = resolveSpans p

-- | Split a number of spans into a flat array of runs and add a wrapper
-- so that each run can be traced back to its originating span.
spansToRunsWrapped :: [RS.ResolvedSpan d] -> [WithSpan d Run]
spansToRunsWrapped ss = concat $ map spanToRunsWrapped ss

-- | Split a span into runs and add a wrapper
-- so that each run can be traced back to its originating span.
spanToRunsWrapped :: RS.ResolvedSpan d -> [WithSpan d Run]
spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)

resolveSpans :: Paragraph d -> [RS.ResolvedSpan d]
resolveSpans p = do
    let Paragraph _ pStart root _ = p
    let RootBox (Box _ rootTextOpts) = root
    let leaves = flatten root
    let sTexts = paragraphSpanTexts p
    let sBounds = paragraphSpanBounds p
    let sStarts = NonEmpty.init sBounds
    let pText = paragraphText p

    (i, leaf, sStart, sText) <- getZipList $ (,,,)
        <$> ZipList [0 ..]
        <*> ZipList leaves
        <*> ZipList sStarts
        <*> ZipList sTexts
    let (TextLeaf userData _ textOpts boxes) = leaf
    let lang = textLanguage textOpts
    -- TODO: Allow BiDi embedding/isolation for inner nodes.
    let pLevels = textLevels (textDirection rootTextOpts) pText
    let lBreaks = paragraphBreaks breakLine pText lang
    let cBreaks = paragraphBreaks breakCharacter pText lang
    -- TODO: Optimise. This has time complexity O(n*s), where n is number of
    --       characters and s is number of resolved spans.
    --       Maybe include byte offsets in the TextLevels data structure?
    let pPrefixLen = Text.length $ paragraphPrefix p sStart
    return RS.ResolvedSpan
        { RS.spanUserData = userData
        , RS.spanIndex = i
        , RS.spanOffsetInParagraph = sStart - pStart
        -- TODO: Consider adding checks for array bounds.
        , RS.spanText = sText
        , RS.spanTextOptions = textOpts
        , RS.spanBoxes = boxes
        , RS.spanBiDiLevels = dropLevels pPrefixLen pLevels
        , RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) lBreaks
        , RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks
        }

paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)]
paragraphBreaks breakFunc txt lang =
    breaksDesc (breakFunc (locale lang LBAuto)) txt