From b464ad93704970f027c06d6915a07bf3d8011845 Mon Sep 17 00:00:00 2001 From: Jaro Date: Sat, 10 Jun 2023 18:00:41 +0200 Subject: [PATCH] Separate split list functions into a module. --- balkon.cabal | 3 +- .../Text/ParagraphLayout/Internal/Layout.hs | 7 +-- .../ParagraphLayout/Internal/SplitList.hs | 58 +++++++++++++++++++ .../ParagraphLayout/Internal/TextContainer.hs | 15 +---- 4 files changed, 63 insertions(+), 20 deletions(-) create mode 100644 src/Data/Text/ParagraphLayout/Internal/SplitList.hs diff --git a/balkon.cabal b/balkon.cabal index 18acceb..f6c6574 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -141,7 +141,8 @@ library balkon-internal Data.Text.ParagraphLayout.Internal.ProtoFragment, Data.Text.ParagraphLayout.Internal.ProtoLine, Data.Text.ParagraphLayout.Internal.ProtoRun, - Data.Text.ParagraphLayout.Internal.Script + Data.Text.ParagraphLayout.Internal.Script, + Data.Text.ParagraphLayout.Internal.SplitList build-depends: base >=4.12 && < 4.16, diff --git a/src/Data/Text/ParagraphLayout/Internal/Layout.hs b/src/Data/Text/ParagraphLayout/Internal/Layout.hs index 31d5b83..a1e5674 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Layout.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Layout.hs @@ -39,6 +39,7 @@ import Data.Text.ParagraphLayout.Internal.Rect import qualified Data.Text.ParagraphLayout.Internal.ResolvedBox as RB import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS import Data.Text.ParagraphLayout.Internal.Run +import Data.Text.ParagraphLayout.Internal.SplitList import Data.Text.ParagraphLayout.Internal.TextContainer import Data.Text.ParagraphLayout.Internal.TextOptions import Data.Text.ParagraphLayout.Internal.WithSpan @@ -289,12 +290,6 @@ softSplits runs = map (allowSndEmpty . trimFst) splits -- shortest line break. cSplits = splitTextsBy (map fst . runCharacterBreaks) runs -allowFstEmpty :: (NonEmpty a, b) -> ([a], b) -allowFstEmpty (a, b) = (NonEmpty.toList a, b) - -allowSndEmpty :: (a, NonEmpty b) -> (a, [b]) -allowSndEmpty (a, b) = (a, NonEmpty.toList b) - -- | The suffix remaining after removing the longest prefix of the list for -- which the predicate holds, except always including at least the last element -- of the original list. diff --git a/src/Data/Text/ParagraphLayout/Internal/SplitList.hs b/src/Data/Text/ParagraphLayout/Internal/SplitList.hs new file mode 100644 index 0000000..468c555 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/SplitList.hs @@ -0,0 +1,58 @@ +-- | Utility functions to work with pairs of lists, which may be non-empty. +module Data.Text.ParagraphLayout.Internal.SplitList + ( allowFstEmpty + , allowSndEmpty + , nonEmptyPairs + , nonEmptyFsts + , nonEmptySnds + ) +where + +import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) +import Data.Maybe (catMaybes) + +-- | Generalise the first component of a pair from a non-empty list +-- to a regular list. +allowFstEmpty :: (NonEmpty a, b) -> ([a], b) +allowFstEmpty (a, b) = (toList a, b) + +-- | Generalise the second component of a pair from a non-empty list +-- to a regular list. +allowSndEmpty :: (a, NonEmpty b) -> (a, [b]) +allowSndEmpty (a, b) = (a, toList b) + +-- | Turn pairs of normal lists into pairs of `NonEmpty` lists, +-- removing pairs in which either list is empty. +nonEmptyPairs :: [([a], [b])] -> [(NonEmpty a, NonEmpty b)] +nonEmptyPairs = catMaybes . map nonEmptyPair + +-- | Turn a pair of normal lists into `Just` a pair of `NonEmpty` lists, +-- or `Nothing` if either list is empty. +nonEmptyPair :: ([a], [b]) -> Maybe (NonEmpty a, NonEmpty b) +nonEmptyPair (xs, ys) = case (nonEmpty xs, nonEmpty ys) of + (Just xs1, Just ys1) -> Just (xs1, ys1) + (_, _) -> Nothing + +-- | Turn pairs of normal lists into pairs where the first list is `NonEmpty`, +-- removing pairs in which the first list is empty. +nonEmptyFsts :: [([a], [b])] -> [(NonEmpty a, [b])] +nonEmptyFsts = catMaybes . map nonEmptyFst + +-- | Turn a pair of normal lists into `Just` a pair where the first list is +-- `NonEmpty`, or `Nothing` if the first list is empty. +nonEmptyFst :: ([a], [b]) -> Maybe (NonEmpty a, [b]) +nonEmptyFst (xs, ys) = case nonEmpty xs of + Just xs1 -> Just (xs1, ys) + Nothing -> Nothing + +-- | Turn pairs of normal lists into pairs where the second list is `NonEmpty`, +-- removing pairs in which the second list is empty. +nonEmptySnds :: [([a], [b])] -> [([a], NonEmpty b)] +nonEmptySnds = catMaybes . map nonEmptySnd + +-- | Turn a pair of normal lists into `Just` a pair where the second list is +-- `NonEmpty`, or `Nothing` if the second list is empty. +nonEmptySnd :: ([a], [b]) -> Maybe ([a], NonEmpty b) +nonEmptySnd (xs, ys) = case nonEmpty ys of + Just ys1 -> Just (xs, ys1) + Nothing -> Nothing diff --git a/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs b/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs index 036deca..42e5827 100644 --- a/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs +++ b/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs @@ -16,11 +16,12 @@ where import Data.Foldable (toList) import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import qualified Data.List.NonEmpty as NonEmpty -import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Foreign (dropWord8, takeWord8) +import Data.Text.ParagraphLayout.Internal.SplitList + -- | Class of data types containing `Text` that can be accessed. class TextContainer a where -- | Extract a `Text` from its container. @@ -80,18 +81,6 @@ splitTextsBy' breakFunc closed (tc : tcs) = tcSplits = map (\ i -> splitTextAt8 i tc) tcBreakOffsets tcBreakOffsets = breakFunc tc --- | Turn pairs of normal lists into pairs of `NonEmpty` lists, --- removing pairs in which either list is empty. -nonEmptyPairs :: [([a], [b])] -> [(NonEmpty a, NonEmpty b)] -nonEmptyPairs = catMaybes . map nonEmptyPair - --- | Turn a pair of normal lists into `Just` a pair of `NonEmpty` lists, --- or `Nothing` if either list is empty. -nonEmptyPair :: ([a], [b]) -> Maybe (NonEmpty a, NonEmpty b) -nonEmptyPair (xs, ys) = case (nonEmpty xs, nonEmpty ys) of - (Just xs1, Just ys1) -> Just (xs1, ys1) - (_, _) -> Nothing - -- | If the first container in the list is empty, remove it. collapse :: SeparableTextContainer a => NonEmpty a -> [a] collapse (tc :| tcs) -- 2.30.2