module Data.Text.ParagraphLayout.Internal.TextContainer ( SeparableTextContainer , TextContainer , dropWhileEnd , dropWhileEndCascade , dropWhileStart , dropWhileStartCascade , getText , splitTextAt8 , splitTextsBy ) where import Data.Foldable (toList) import Data.List (mapAccumL, mapAccumR) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Foreign (dropWord8, takeWord8) -- | Class of data types containing `Text` that can be accessed. class TextContainer a where -- | Extract a `Text` from its container. getText :: a -> Text -- | As a trivial instance, each `Text` contains itself. instance TextContainer Text where getText = id -- | Class of data types containing `Text` that can be split at a given number -- of `Data.Word.Word8` units from the start of the text. class TextContainer a => SeparableTextContainer a where -- | Split the given `SeparableTextContainer` at the given number of -- `Data.Word.Word8` units from the start of the text, preserving whatever -- constraints the instance requires. splitTextAt8 :: Int -> a -> (a, a) -- | Return the suffix remaining after dropping characters that satisfy the -- given predicate from the beginning of the given `SeparableTextContainer`. dropWhileStart :: (Char -> Bool) -> a -> a -- | Return the prefix remaining after dropping characters that satisfy the -- given predicate from the end of the given `SeparableTextContainer`. dropWhileEnd :: (Char -> Bool) -> a -> a -- | As a trivial instance, each `Text` can be split directly. instance SeparableTextContainer Text where splitTextAt8 n t = (t1, t2) where t1 = takeWord8 (fromIntegral n) t t2 = dropWord8 (fromIntegral n) t dropWhileStart = Text.dropWhile dropWhileEnd = Text.dropWhileEnd -- | Treat a list of text containers as a contiguous sequence, -- and find all possible ways to split them into two lists, -- using the given function to find valid split offsets in `Data.Word.Word8` -- units from the beginning of each container. -- -- The results in the form (prefix, suffix) will be ordered from the longest -- prefix to shortest. splitTextsBy :: (SeparableTextContainer a, Foldable f) => (a -> [Int]) -> f a -> [([a], [a])] splitTextsBy breakFunc tcs = splitTextsBy' breakFunc [] $ reverse $ toList tcs splitTextsBy' :: SeparableTextContainer a => (a -> [Int]) -> [a] -> [a] -> [([a], [a])] splitTextsBy' _ _ [] = [] splitTextsBy' breakFunc closed (tc : tcs) = fullSplits ++ splitTextsBy' breakFunc (tc : closed) tcs where fullSplits = map mergeWithRest tcSplits mergeWithRest (x1, x2) = (reverse $ collapse $ x1 :| tcs, collapse $ x2 :| closed) tcSplits = map (\ i -> splitTextAt8 i tc) tcBreakOffsets tcBreakOffsets = breakFunc tc -- | If the first container in the list is empty, remove it. collapse :: SeparableTextContainer a => NonEmpty a -> [a] collapse (tc :| tcs) | Text.null (getText tc) = tcs | otherwise = tc : tcs -- | Treat a list of text containers as a contiguous sequence, -- and remove a prefix of characters that match the given predicate. -- -- All text containers are preserved but their contents may end up having -- zero length. dropWhileStartCascade :: (SeparableTextContainer a, Traversable t) => (Char -> Bool) -> t a -> t a dropWhileStartCascade p tcs = trimTextsStartCascade (dropWhileStart p) tcs -- | Treat a list of text containers as a contiguous sequence, -- and remove a suffix of characters that match the given predicate. -- -- All text containers are preserved but their contents may end up having -- zero length. dropWhileEndCascade :: (SeparableTextContainer a, Traversable t) => (Char -> Bool) -> t a -> t a dropWhileEndCascade p tcs = trimTextsEndCascade (dropWhileEnd p) tcs -- | Traverse the given structure from start to end, applying the given -- text trimming function to each text container until a non-empty container -- is produced. trimTextsStartCascade :: (SeparableTextContainer a, Traversable t) => (a -> a) -> t a -> t a trimTextsStartCascade trimFunc tcs = snd $ mapAccumL (cascadingTrim trimFunc) True tcs -- | Traverse the given structure from end to start, applying the given -- text trimming function to each text container until a non-empty container -- is produced. trimTextsEndCascade :: (SeparableTextContainer a, Traversable t) => (a -> a) -> t a -> t a trimTextsEndCascade trimFunc tcs = snd $ mapAccumR (cascadingTrim trimFunc) True tcs -- | Wraps a text trimming function in a controlled cascade. -- When the trim produces an empty text, the cascade continues. cascadingTrim :: SeparableTextContainer a => (a -> a) -> Bool -> a -> (Bool, a) cascadingTrim _ False tc = (False, tc) cascadingTrim trimFunc True tc = (continue, trimmed) where trimmed = trimFunc tc continue = Text.null $ getText trimmed