3 files changed, 86 insertions(+), 58 deletions(-)

M src/Data/Text/ParagraphLayout/Internal/Plain.hs
M src/Data/Text/ParagraphLayout/Internal/TextContainer.hs
M test/Data/Text/ParagraphLayout/Internal/TextContainerSpec.hs

@@ 10,7 10,7 @@ where
 import Control.Applicative (ZipList(ZipList), getZipList)
 import Data.Int (Int32)
 import Data.List (mapAccumL)
-import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty, (<|))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text.Foreign (lengthWord8)
 import Data.Text.Glyphize


@@ 48,7 48,10 @@ layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls
     where
         sls = map SpanLayout fragsBySpan
         fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags
-        frags = layoutAndAlignLines maxWidth $ spansToRunsWrapped spans
+        frags = case nonEmpty wrappedRuns of
+            Just xs -> layoutAndAlignLines maxWidth xs
+            Nothing -> []
+        wrappedRuns = spansToRunsWrapped spans
         maxWidth = paragraphMaxWidth opts
         spans = resolveSpans p
 


@@ 66,12 69,12 @@ spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)
 -- necessary to fit within the requested line width.
 --
 -- The output is a flat list of fragments positioned in both dimensions.
-layoutAndAlignLines :: Int32 -> [WithSpan Run] -> [WithSpan Fragment]
+layoutAndAlignLines :: Int32 -> NonEmpty (WithSpan Run) -> [WithSpan Fragment]
 layoutAndAlignLines maxWidth runs = frags
     where
         frags = concat fragsInLines
         (_, fragsInLines) = mapAccumL positionLineH originY canonicalLines
-        canonicalLines = map canonicalOrder logicalLines
+        canonicalLines = fmap canonicalOrder logicalLines
         logicalLines = layoutLines maxWidth runs
         originY = paragraphOriginY
 


@@ 95,14 98,13 @@ canonicalOrder pfs@((WithSpan _ headPF):_) = case PF.direction headPF of
 --
 -- The output is a two-dimensional list of fragments positioned along the
 -- horizontal axis.
-layoutLines :: Int32 -> [WithSpan Run] -> [[WithSpan PF.ProtoFragment]]
-layoutLines maxWidth runs
-    | null rest
+layoutLines ::
+    Int32 -> NonEmpty (WithSpan Run) -> NonEmpty [WithSpan PF.ProtoFragment]
+layoutLines maxWidth runs = case nonEmpty rest of
         -- Everything fits. We are done.
-        = fitting : []
-    | otherwise
+        Nothing -> NonEmpty.singleton fitting
         -- Something fits, the rest goes on the next line.
-        = fitting : layoutLines maxWidth rest
+        Just rest' -> fitting <| layoutLines maxWidth rest'
     where
         (fitting, rest) = layoutAndWrapRunsH maxWidth runs
 


@@ 152,13 154,13 @@ positionFragmentH originY originX (WithSpan rs pf) = (nextX, WithSpan rs frag)
 -- | Calculate layout for multiple horizontal runs, breaking them as necessary
 -- to fit as much content as possible without exceeding the maximum line width,
 -- and return the remaining runs to be placed on other lines.
-layoutAndWrapRunsH :: Int32 -> [WithSpan Run] ->
+layoutAndWrapRunsH :: Int32 -> NonEmpty (WithSpan Run) ->
     ([WithSpan PF.ProtoFragment], [WithSpan Run])
 layoutAndWrapRunsH maxWidth runs = NonEmpty.head $ validLayouts
     where
         validLayouts = dropWhile1 tooLong layouts
         tooLong (pfs, _) = totalAdvances pfs > maxWidth
-        layouts = NonEmpty.map layoutFst splits
+        layouts = fmap layoutFst splits
         layoutFst (runs1, runs2) = (layoutRunsH runs1, runs2)
         -- TODO: Consider optimising.
         --       We do not need to look for soft breaks further than the


@@ 176,8 178,8 @@ layoutAndWrapRunsH maxWidth runs = NonEmpty.head $ validLayouts
 --
 -- If there is no hard line break in the input, the first output list will
 -- contain the whole input, and the second output list will be empty.
-hardSplit :: [WithSpan Run] -> ([WithSpan Run], [WithSpan Run])
-hardSplit runs = trimFst $ NonEmpty.last $ splits
+hardSplit :: NonEmpty (WithSpan Run) -> ([WithSpan Run], [WithSpan Run])
+hardSplit runs = allowFstEmpty $ trimFst $ NonEmpty.last $ splits
     where
         trimFst (runs1, runs2) = (trim runs1, runs2)
         trim


@@ 187,7 189,7 @@ hardSplit runs = trimFst $ NonEmpty.last $ splits
         -- TODO: Consider optimising.
         --       We do not need to look for any line breaks further than the
         --       shortest hard break.
-        splits = noSplit :| hSplits
+        splits = noSplit :| map allowSndEmpty hSplits
         noSplit = (runs, [])
         hSplits = -- from longest to shortest
             splitTextsBy (map fst . filter isHard . runLineBreaks) runs


@@ 205,8 207,8 @@ hardSplit runs = trimFst $ NonEmpty.last $ splits
 -- The results in the form (prefix, suffix) will be ordered so that items
 -- closer to the start of the list are preferred for line breaking, but without
 -- considering overflows.
-softSplits :: [WithSpan Run] -> [([WithSpan Run], [WithSpan Run])]
-softSplits runs = map trimFst splits
+softSplits :: NonEmpty (WithSpan Run) -> [([WithSpan Run], [WithSpan Run])]
+softSplits runs = map (allowSndEmpty . trimFst) splits
     where
         trimFst (runs1, runs2) = (trim runs1, runs2)
         trim = trimTextsStart isStartSpace . trimTextsEnd isEndSpace


@@ 217,6 219,12 @@ softSplits runs = map 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.

@@ 13,7 13,10 @@ module Data.Text.ParagraphLayout.Internal.TextContainer
     )
 where
 
-import Data.List.NonEmpty (NonEmpty((:|)))
+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)


@@ 60,14 63,13 @@ instance SeparableTextContainer Text where
 --
 -- The results in the form (prefix, suffix) will be ordered from the longest
 -- prefix to shortest.
-splitTextsBy :: SeparableTextContainer a => (a -> [Int]) -> [a] -> [([a], [a])]
+splitTextsBy :: (SeparableTextContainer a, Foldable f) =>
+    (a -> [Int]) -> f a -> [(NonEmpty a, NonEmpty a)]
 splitTextsBy breakFunc tcs =
-    filter notEmpty $ splitTextsBy' breakFunc [] (reverse tcs)
-    where
-        notEmpty (prefix, suffix) = not (null prefix || null suffix)
+    nonEmptyPairs $ splitTextsBy' breakFunc [] $ reverse $ toList tcs
 
-splitTextsBy' :: SeparableTextContainer a => (a -> [Int]) -> [a] -> [a] ->
-    [([a], [a])]
+splitTextsBy' :: SeparableTextContainer a =>
+    (a -> [Int]) -> [a] -> [a] -> [([a], [a])]
 splitTextsBy' _ _ [] = []
 splitTextsBy' breakFunc closed (tc:tcs) =
     fullSplits ++ splitTextsBy' breakFunc (tc:closed) tcs


@@ 78,6 80,18 @@ 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)


@@ 89,40 103,42 @@ collapse (tc :| tcs)
 --
 -- Empty text containers are removed from the output, so the result may
 -- potentially be an empty list.
-trimTextsStart :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]
-trimTextsStart p tcs = trimTextsStart' p tcs
+trimTextsStart :: (SeparableTextContainer a, Foldable f) =>
+    (Char -> Bool) -> f a -> [a]
+trimTextsStart p tcs = trimTextsStart' p $ toList tcs
 
 -- | Treat a list of text containers as a contiguous sequence,
 -- and remove a prefix of characters that match the given predicate.
 --
 -- Empty text containers are removed from the output except the first one,
 -- which is instead truncated to zero length.
-trimTextsStartPreserve ::
-    SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]
-trimTextsStartPreserve _ [] = []
-trimTextsStartPreserve p ins@(in1:_) = case trimTextsStart' p ins of
-    [] -> [truncateText in1]
-    out -> out
+trimTextsStartPreserve :: SeparableTextContainer a =>
+    (Char -> Bool) -> NonEmpty a -> NonEmpty a
+trimTextsStartPreserve p tcs =
+    case nonEmpty $ trimTextsStart p $ NonEmpty.toList tcs of
+        Nothing -> NonEmpty.singleton $ truncateText $ NonEmpty.head tcs
+        Just out -> out
 
 -- | Treat a list of text containers as a contiguous sequence,
 -- and remove a suffix of characters that match the given predicate.
 --
 -- Empty text containers are removed from the output, so the result may
 -- potentially be an empty list.
-trimTextsEnd :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]
-trimTextsEnd p tcs = trimTextsEnd' p (reverse tcs)
+trimTextsEnd :: (SeparableTextContainer a, Foldable f) =>
+    (Char -> Bool) -> f a -> [a]
+trimTextsEnd p tcs = trimTextsEnd' p $ reverse $ toList tcs
 
 -- | Treat a list of text containers as a contiguous sequence,
 -- and remove a suffix of characters that match the given predicate.
 --
 -- Empty text containers are removed from the output except the first one,
 -- which is instead truncated to zero length.
-trimTextsEndPreserve ::
-    SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]
-trimTextsEndPreserve _ [] = []
-trimTextsEndPreserve p ins@(in1:_) = case trimTextsEnd' p (reverse ins) of
-    [] -> [truncateText in1]
-    out -> out
+trimTextsEndPreserve :: SeparableTextContainer a =>
+    (Char -> Bool) -> NonEmpty a -> NonEmpty a
+trimTextsEndPreserve p tcs =
+    case nonEmpty $ trimTextsEnd p $ NonEmpty.toList tcs of
+        Nothing -> NonEmpty.singleton $ truncateText $ NonEmpty.head tcs
+        Just out -> out
 
 trimTextsStart' :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]
 trimTextsStart' _ [] = []

@@ 1,11 1,15 @@
 module Data.Text.ParagraphLayout.Internal.TextContainerSpec (spec) where
 
+import qualified Data.List.NonEmpty
 import Data.Text (Text, empty, pack)
 import Data.Text.Foreign (lengthWord8)
 
 import Test.Hspec
 import Data.Text.ParagraphLayout.Internal.TextContainer
 
+ne :: [a] -> Data.List.NonEmpty.NonEmpty a
+ne = Data.List.NonEmpty.fromList
+
 data ExampleContainer = Contain { cText :: Text, cOffset :: Int }
     deriving (Show, Eq)
 


@@ 71,32 75,32 @@ spec = do
     describe "splitTextsBy" $ do
         it "splits example text containers" $ do
             splitTextsBy exampleBreakPoints exampleContainers `shouldBe`
-                [ ( [ contain "Vikipedija " 10, contain "(Википеди" 21 ]
-                  , [ contain "ја)" 38 ]
+                [ ( ne [ contain "Vikipedija " 10, contain "(Википеди" 21 ]
+                  , ne [ contain "ја)" 38 ]
                   )
-                , ( [ contain "Vikipedija " 10, contain "(Википе" 21 ]
-                  , [ contain "дија)" 34 ]
+                , ( ne [ contain "Vikipedija " 10, contain "(Википе" 21 ]
+                  , ne [ contain "дија)" 34 ]
                   )
-                , ( [ contain "Vikipedija " 10, contain "(Вики" 21 ]
-                  , [ contain "педија)" 30 ]
+                , ( ne [ contain "Vikipedija " 10, contain "(Вики" 21 ]
+                  , ne [ contain "педија)" 30 ]
                   )
-                , ( [ contain "Vikipedija " 10, contain "(Ви" 21 ]
-                  , [ contain "кипедија)" 26 ]
+                , ( ne [ contain "Vikipedija " 10, contain "(Ви" 21 ]
+                  , ne [ contain "кипедија)" 26 ]
                   )
-                , ( [ contain "Vikipedija " 10 ]
-                  , [ contain "(Википедија)" 21 ]
+                , ( ne [ contain "Vikipedija " 10 ]
+                  , ne [ contain "(Википедија)" 21 ]
                   )
-                , ( [ contain "Vikipedi" 10 ]
-                  , [ contain "ja " 18, contain "(Википедија)" 21 ]
+                , ( ne [ contain "Vikipedi" 10 ]
+                  , ne [ contain "ja " 18, contain "(Википедија)" 21 ]
                   )
-                , ( [ contain "Vikipe" 10 ]
-                  , [ contain "dija " 16, contain "(Википедија)" 21 ]
+                , ( ne [ contain "Vikipe" 10 ]
+                  , ne [ contain "dija " 16, contain "(Википедија)" 21 ]
                   )
-                , ( [ contain "Viki" 10 ]
-                  , [ contain "pedija " 14, contain "(Википедија)" 21 ]
+                , ( ne [ contain "Viki" 10 ]
+                  , ne [ contain "pedija " 14, contain "(Википедија)" 21 ]
                   )
-                , ( [ contain "Vi" 10 ]
-                  , [ contain "kipedija " 12, contain "(Википедија)" 21 ]
+                , ( ne [ contain "Vi" 10 ]
+                  , ne [ contain "kipedija " 12, contain "(Википедија)" 21 ]
                   )
                 ]
     describe "trimTextsEnd" $ do