ApplyBoxes.hs

-- | Algorithm for finding box edges.
module Data.Text.ParagraphLayout.Internal.ApplyBoxes
    ( WithBoxes (..)
    , applyBoxes
    )
where

import Data.List.NonEmpty (NonEmpty ((:|)), (<|))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text.Glyphize (Direction (DirLTR, DirRTL))

import Data.Text.ParagraphLayout.Internal.ResolvedBox
import Data.Text.ParagraphLayout.Internal.ResolvedSpan
import Data.Text.ParagraphLayout.Internal.WithSpan

-- | Wrapper containing the original input value,
-- with added information about the box edges that it touches.
data WithBoxes d a = WithBoxes

    { leftInBoxes :: [ResolvedBox d]
    -- ^ Boxes whose left edge this item touches.

    , unwrap :: a
    -- ^ The original wrapped value.

    , rightInBoxes :: [ResolvedBox d]
    -- ^ Boxes whose right edge this item touches.

    }

type Boxed d a = WithBoxes d (WithSpan d a)

-- | Determine which horizontal items are the leftmost and which are the
-- rightmost within their ancestor boxes.
applyBoxes
    :: [ResolvedBox d]
    -- ^ Boxes open on a preceding line. Their start edge will be omitted.
    -> [ResolvedBox d]
    -- ^ Boxes open on a following line. Their end edge will be omitted.
    -> NonEmpty (WithSpan d a)
    -- ^ Box items on a given line. Must be ordered from left to right.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with added information about box edges.
applyBoxes prevOpen nextOpen pfs =
    foldr (applyBox prevOpen nextOpen) items boxes
    where
        boxes = allBoxes pfs
        items = fmap initBoxes pfs

-- | Wrap an item in a minimal structure to be filled by the algorithm.
initBoxes :: WithSpan d a -> Boxed d a
initBoxes (WithSpan rs pf) = WithBoxes
    { leftInBoxes = []
    , unwrap = WithSpan rs pf
    , rightInBoxes = []
    }

-- | Determine which horizontal item is the leftmost and which is the
-- rightmost within the given ancestor box.
applyBox
    :: [ResolvedBox d]
    -- ^ Boxes open on a preceding line. Their start edge will be omitted.
    -> [ResolvedBox d]
    -- ^ Boxes open on a following line. Their end edge will be omitted.
    -> ResolvedBox d
    -- ^ The box whose edges are to be determined.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with partial information about box edges.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with added information about edges of the given box.
applyBox prevOpen nextOpen box =
    applyBoxEnd nextOpen box . applyBoxStart prevOpen box

-- | Determine which horizontal item, if any, is the startmost
-- within the given ancestor box.
applyBoxStart
    :: [ResolvedBox d]
    -- ^ Boxes open on a preceding line. Their start edge will be omitted.
    -> ResolvedBox d
    -- ^ Box whose start edge should be found.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with partial information about box edges.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with added information about the start edge of the given box.
applyBoxStart prevOpen box items
    | box `elem` prevOpen = items
    | otherwise = case boxDirection box of
        DirLTR -> pickBoxLeft box items
        DirRTL -> pickBoxRight box items
        _ -> items

-- | Determine which horizontal item, if any, is the endmost
-- within the given ancestor box.
applyBoxEnd
    :: [ResolvedBox d]
    -- ^ Boxes open on a following line. Their end edge will be omitted.
    -> ResolvedBox d
    -- ^ Box whose end edge should be found.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with partial information about box edges.
    -> NonEmpty (Boxed d a)
    -- ^ Box items with added information about the end edge of the given box.
applyBoxEnd nextOpen box items
    | box `elem` nextOpen = items
    | otherwise = case boxDirection box of
        DirLTR -> pickBoxRight box items
        DirRTL -> pickBoxLeft box items
        _ -> items

-- | Pick the leftmost item on the line and apply the left edge
-- of the given box to it. This assumes that the box does not have
-- a left edge on any other line.
pickBoxLeft :: ResolvedBox d -> NonEmpty (Boxed d a) -> NonEmpty (Boxed d a)
pickBoxLeft box items = updateFirst (inBox box) (addBoxLeft box) items

-- | Pick the rightmost item on the line and apply the right edge
-- of the given box to it. This assumes that the box does not have
-- a right edge on any other line.
pickBoxRight :: ResolvedBox d -> NonEmpty (Boxed d a) -> NonEmpty (Boxed d a)
pickBoxRight box items = updateLast (inBox box) (addBoxRight box) items

-- | Determine if the given item is contained by the given box.
inBox :: ResolvedBox d -> Boxed d a -> Bool
inBox box item = box `elem` boxesOf item
    where
        boxesOf (WithBoxes _ (WithSpan rs _) _) = spanBoxes rs

-- | Apply the left edge of the given box to the given item.
addBoxLeft :: ResolvedBox d -> Boxed d a -> Boxed d a
addBoxLeft box item = item { leftInBoxes = leftInBoxes item `union` [box] }

-- | Apply the right edge of the given box to the given item.
addBoxRight :: ResolvedBox d -> Boxed d a -> Boxed d a
addBoxRight box item = item { rightInBoxes = rightInBoxes item `union` [box] }

-- | Update the first item matching the given predicate,
-- or fail if none is found.
updateFirst :: (a -> Bool) -> (a -> a) -> NonEmpty a -> NonEmpty a
updateFirst predicate updateFunc (x :| xs)
    | predicate x = (updateFunc x) :| xs
    | otherwise = x <| updateFirst predicate updateFunc (NonEmpty.fromList xs)

-- | Update the last item matching the given predicate,
-- or fail if none is found.
updateLast :: (a -> Bool) -> (a -> a) -> NonEmpty a -> NonEmpty a
updateLast predicate updateFunc list =
    NonEmpty.reverse $ updateFirst predicate updateFunc $ NonEmpty.reverse list