1 files changed, 19 insertions(+), 14 deletions(-)

M src/Data/Text/ParagraphLayout/Internal/Plain.hs

@@ 12,7 12,6 @@ import Data.Int (Int32)
 import Data.List (mapAccumL)
 import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NonEmpty
-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Data.Text.Foreign (lengthWord8)
 import Data.Text.Glyphize
     (Buffer(..)


@@ 154,23 153,29 @@ positionFragmentH originY originX (WithSpan rs pf) = (nextX, WithSpan rs frag)
 -- and return the remaining runs to be placed on other lines.
 layoutAndWrapRunsH :: Int32 -> [WithSpan Run] ->
     ([WithSpan PF.ProtoFragment], [WithSpan Run])
-layoutAndWrapRunsH maxWidth runs =
-    fromMaybe lastResortSplit $ listToMaybe validSplits
+layoutAndWrapRunsH maxWidth runs = NonEmpty.head $ validLayouts
     where
-        lastResortSplit = do
-            let (runs1, runs2) = splitTextsAt8 1 runs
-            let pfs = layoutRunsH runs1
-            (pfs, runs2)
-        applySplit (runs1, runs2) = do
-            let pfs = layoutRunsH $ trimTextsEnd isEndSpace runs1
-            if totalAdvances pfs <= maxWidth
-                then Just (pfs, runs2)
-                else Nothing
-        validSplits = catMaybes $ map applySplit splits
-        splits = noSplit : (filter hasContent $ breakSplits [] (reverse runs))
+        validLayouts = dropWhile1 tooLong layouts
+        tooLong (pfs, _) = totalAdvances pfs > maxWidth
+        layouts = NonEmpty.map layoutFst splits
+        layoutFst (runs1, runs2) = (layout runs1, runs2)
+        layout runs1 = layoutRunsH $ trimTextsEnd isEndSpace runs1
+        splits = noSplit :| (wordSplits ++ [lastResortSplit])
         noSplit = (runs, [])
+        wordSplits = (filter hasContent $ breakSplits [] (reverse runs))
+        lastResortSplit = splitTextsAt8 1 runs
         hasContent = not . null . fst
 
+-- | 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.
+dropWhile1 :: (a -> Bool) -> NonEmpty a -> NonEmpty a
+dropWhile1 p list = case NonEmpty.uncons list of
+    (_, Nothing) -> list
+    (x, Just xs) -> if p x
+        then dropWhile1 p xs
+        else list
+
 -- | Calculate layout for multiple horizontal runs on the same line, without
 -- any breaking.
 layoutRunsH :: [WithSpan Run] -> [WithSpan PF.ProtoFragment]