module Data.Text.ParagraphLayout.Internal.ProtoLine
    ( ProtoLine (..)
    , nonEmpty
    , visible
    , width
    , applyBoxes
    , mapFragments
    )
where

import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty ((:|)))

import qualified Data.Text.ParagraphLayout.Internal.ApplyBoxes as Algo
import Data.Text.ParagraphLayout.Internal.BoxOptions
import Data.Text.ParagraphLayout.Internal.ProtoFragment
import Data.Text.ParagraphLayout.Internal.ResolvedBox
import Data.Text.ParagraphLayout.Internal.ResolvedSpan
import Data.Text.ParagraphLayout.Internal.WithSpan

-- | Contents of a line that have not been visually ordered or positioned yet.
data ProtoLine f d = ProtoLine

    { protoFragments :: f (WithSpan d ProtoFragment)
    -- ^ Fragments on the line, in logical order.
    -- Intended to be either a regular list or a non-empty list.

    , prevOpenBoxes :: [ResolvedBox d]
    -- ^ Boxes whose starts are located on preceding lines.
    -- The spacing for their start edge will not count towards this line.

    , nextOpenBoxes :: [ResolvedBox d]
    -- ^ Boxes whose ends are located on following lines.
    -- The spacing for their end edge will not count towards this line.

    }

-- | Covert a line with a regular list of fragments into `Just` a line with
-- a non-empty list of fragments, or `Nothing` if there are no fragments.
nonEmpty :: ProtoLine [] d -> Maybe (ProtoLine NonEmpty d)
nonEmpty (ProtoLine [] _ _) = Nothing
nonEmpty pl@(ProtoLine { protoFragments = (f : fs) }) =
    Just pl { protoFragments = f :| fs }

-- | `True` if this line should generate a visible line box,
-- or `False` if this line should generate an /invisible line box/
-- as defined by <https://www.w3.org/TR/css-inline-3/#invisible-line-boxes>.
visible :: Foldable f => ProtoLine f d -> Bool
visible pl = any visibleProtoFragment $ protoFragments pl

visibleProtoFragment :: WithSpan d ProtoFragment -> Bool
visibleProtoFragment (WithSpan rs pf) =
    hasGlyphs || hasHardBreak || hasNonCollapsibleBoxes
    where
        hasGlyphs = not $ null $ glyphs pf
        hasHardBreak = hardBreak pf
        hasNonCollapsibleBoxes =
            any (== AvoidBoxCollapse) $ map (boxCollapse . boxOptions) boxes
        boxes = spanBoxes rs

-- | Total width of the line (content and spacing).
width :: (Foldable f, Functor f) => ProtoLine f d -> Int32
width pl = totalAdvances pl + totalBoxesStart pl + totalBoxesEnd pl

-- | Determine which horizontal fragments are the leftmost and which are the
-- rightmost within their ancestor inline boxes.
--
-- The input must be ordered from left to right.
applyBoxes :: ProtoLine NonEmpty d ->
    NonEmpty (Algo.WithBoxes d (WithSpan d ProtoFragment))
applyBoxes pl = Algo.applyBoxes prevOpen nextOpen pfs
    where
        prevOpen = prevOpenBoxes pl
        nextOpen = nextOpenBoxes pl
        pfs = protoFragments pl

-- | Total glyph advances on the line.
totalAdvances :: (Foldable f, Functor f) => ProtoLine f d -> Int32
totalAdvances pl = sum $ fmap getAdvance $ protoFragments pl
    where getAdvance (WithSpan _ pf) = advance pf

-- | Total spacing for boxes starting on the line.
totalBoxesStart :: (Foldable f, Functor f) => ProtoLine f d -> Int32
totalBoxesStart pl = sum $ fmap boxStartSpacing $ boxesStart pl

-- | Total spacing for boxes ending on the line.
totalBoxesEnd :: (Foldable f, Functor f) => ProtoLine f d -> Int32
totalBoxesEnd pl = sum $ fmap boxEndSpacing $ boxesEnd pl

-- | Boxes that start on the given line.
boxesStart :: (Foldable f, Functor f) => ProtoLine f d -> [ResolvedBox d]
boxesStart pl = allBoxes (protoFragments pl) `diff` prevOpenBoxes pl

-- | Boxes that end on the given line.
boxesEnd :: (Foldable f, Functor f) => ProtoLine f d -> [ResolvedBox d]
boxesEnd pl = allBoxes (protoFragments pl) `diff` nextOpenBoxes pl

-- | Apply a function to every fragment on the line.
--
-- (`ResolvedSpan` is intentionally not passed to the mapping function,
-- to avoid the need for recalculating `prevOpenBoxes` and `nextOpenBoxes`).
mapFragments :: Functor f =>
    (ProtoFragment -> ProtoFragment) -> ProtoLine f d -> ProtoLine f d
mapFragments mapFunc pl =
    pl { protoFragments = fmap mapFunc' $ protoFragments pl }
    where
        mapFunc' (WithSpan rs pf) = WithSpan rs $ mapFunc pf