From 033116be7da3e02163292c8f5fee8bee39308f86 Mon Sep 17 00:00:00 2001 From: Jaro Date: Wed, 1 Mar 2023 13:57:50 +0100 Subject: [PATCH] Remove I8/Int distinction. The distinction was meant to provide additional type safety, but inconsistency with other used libraries required too many workarounds for this to be beneficial. --- src/Data/Text/ParagraphLayout/Plain.hs | 34 +++++++++---------- src/Data/Text/ParagraphLayout/ResolvedSpan.hs | 3 +- src/Data/Text/ParagraphLayout/Run.hs | 12 +++---- src/Data/Text/ParagraphLayout/Span.hs | 4 +-- .../Text/ParagraphLayout/TextContainer.hs | 10 +++--- src/Data/Text/Zipper.hs | 23 ++++++------- .../ParagraphLayout/ParagraphConstruction.hs | 6 ++-- 7 files changed, 43 insertions(+), 49 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Plain.hs b/src/Data/Text/ParagraphLayout/Plain.hs index 8f7e8d7..94405d8 100644 --- a/src/Data/Text/ParagraphLayout/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Plain.hs @@ -24,7 +24,7 @@ import Data.Int (Int32) import Data.List (mapAccumL) import Data.Maybe (fromMaybe, listToMaybe) import Data.Text.Array (Array) -import Data.Text.Foreign (I8, lengthWord8) +import Data.Text.Foreign (lengthWord8) import Data.Text.Glyphize (Buffer(..) ,ContentType(ContentTypeUnicode) @@ -60,7 +60,7 @@ data Paragraph = Paragraph Array -- ^ A byte array containing the whole text to be laid out, in UTF-8. - I8 + Int -- ^ Byte offset of the first span. -- Any characters preceding this offset will not be shaped, but may still -- be used to influence the shape of neighbouring characters. @@ -115,7 +115,7 @@ getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs matchingIndex (WithSpan rs _) = (RS.spanIndex rs) == idx contents (WithSpan _ x) = x -runOffsetInParagraph :: WithSpan Run -> I8 +runOffsetInParagraph :: WithSpan Run -> Int runOffsetInParagraph (WithSpan rs run) = runOffsetInSpan run + RS.spanOffsetInParagraph rs @@ -230,12 +230,12 @@ tryAddRunsH :: Int32 -> Int32 -> [WithSpan Run] -> tryAddRunsH maxWidth currentX runs = tryAddSplitRunsH maxWidth currentX runs totalLength where - totalLength = fromIntegral $ sum $ map (lengthWord8 . getText) runs + totalLength = sum $ map (lengthWord8 . getText) runs -- | Like `addRunsH`, but break the input runs at the given position, or closer -- to the start if necessary to prevent overflowing the maximum line width, -- and return the remaining runs to be placed on other lines. -tryAddSplitRunsH :: Int32 -> Int32 -> [WithSpan Run] -> I8 -> +tryAddSplitRunsH :: Int32 -> Int32 -> [WithSpan Run] -> Int -> ([WithSpan PF.ProtoFragment], [WithSpan Run]) tryAddSplitRunsH _ _ [] _ = ([], []) tryAddSplitRunsH _ currentX runs 0 = do @@ -249,10 +249,10 @@ tryAddSplitRunsH maxWidth currentX runs breakPoint = do -- TODO: Trim spaces around breaks. let (runs1, runs2) = splitTextsAt8 breakPoint runs let (nextX, pfs) = mapAccumL addRunH currentX runs1 - let next = nextBreakPoint (fromIntegral breakPoint) runs + let next = nextBreakPoint breakPoint runs if abs nextX <= maxWidth then (pfs, runs2) - else tryAddSplitRunsH maxWidth currentX runs (fromIntegral next) + else tryAddSplitRunsH maxWidth currentX runs next -- | Find the farthermost break point in one of the given runs, whose offset is -- less than the given limit, respecting locale rules. @@ -265,7 +265,7 @@ nextBreakPoint :: Int -> [WithSpan Run] -> Int nextBreakPoint _ [] = 0 nextBreakPoint limit runs@(headRun:_) = fromMaybe 0 $ listToMaybe points where - firstRunOffset = fromIntegral $ runOffsetInParagraph headRun + firstRunOffset = runOffsetInParagraph headRun points = dropWhile (>= limit) $ breakPoints firstRunOffset $ reverse runs @@ -273,7 +273,7 @@ breakPoints :: Int -> [WithSpan Run] -> [Int] breakPoints _ [] = [] breakPoints firstRunOffset (x:xs) = offsets ++ rest where - thisRunOffset = fromIntegral $ runOffsetInParagraph x + thisRunOffset = runOffsetInParagraph x offsets = map (correctOffset . fst) (runLineBreaks x) correctOffset = (+ (thisRunOffset - firstRunOffset)) rest = breakPoints firstRunOffset xs @@ -332,18 +332,18 @@ resolveSpans p@(Paragraph arr off spans opts) = do , RS.spanFont = paragraphFont opts , RS.spanLineHeight = paragraphLineHeight opts , RS.spanLanguage = lang - , RS.spanLineBreaks = subOffsetsDesc (fromIntegral $ o - off) breaks + , RS.spanLineBreaks = subOffsetsDesc (o - off) breaks } -paragraphLineBreaks :: Paragraph -> I8 -> String -> [(Int, BreakStatus.Line)] +paragraphLineBreaks :: Paragraph -> Int -> String -> [(Int, BreakStatus.Line)] paragraphLineBreaks (Paragraph arr off _ _) end lang = breaksDesc (breakLine (localeFromLanguage lang)) paragraphText where - paragraphText = Text arr (fromIntegral off) (fromIntegral (end - off)) + paragraphText = Text arr off (end - off) runLineBreaks :: WithSpan Run -> [(Int, BreakStatus.Line)] runLineBreaks (WithSpan rs run) = dropWhile (not . valid) $ - subOffsetsDesc (fromIntegral $ runOffsetInSpan run) $ RS.spanLineBreaks rs + subOffsetsDesc (runOffsetInSpan run) $ RS.spanLineBreaks rs where valid (off, _) = off < runLength runLength = lengthWord8 $ getText run @@ -357,21 +357,21 @@ localeFromLanguage x = Locale x -- as the offset of the start of each `Text` and the end of the last `Text`. -- -- TODO: Consider adding checks for array bounds. -cutsAndMarks :: Array -> I8 -> [Span] -> (I8, [(I8, Text)]) +cutsAndMarks :: Array -> Int -> [Span] -> (Int, [(Int, Text)]) cutsAndMarks arr initialOffset spans = mapAccumL (cutAndMark arr) initialOffset spans -- | Like `cut`, but also include the starting offset in the output. -cutAndMark :: Array -> I8 -> Span -> (I8, (I8, Text)) +cutAndMark :: Array -> Int -> Span -> (Int, (Int, Text)) cutAndMark arr off s = (end, (off, t)) where (end, t) = cut arr off s -- | Produce a `Text`, defined by an initial offset and a `Span`, out of the -- underlying `Array`. -cut :: Array -> I8 -> Span -> (I8, Text) +cut :: Array -> Int -> Span -> (Int, Text) cut arr off s = (end, t) where len = spanLength s end = off + len - t = Text arr (fromIntegral off) (fromIntegral len) + t = Text arr off len diff --git a/src/Data/Text/ParagraphLayout/ResolvedSpan.hs b/src/Data/Text/ParagraphLayout/ResolvedSpan.hs index 23ac14d..3434768 100644 --- a/src/Data/Text/ParagraphLayout/ResolvedSpan.hs +++ b/src/Data/Text/ParagraphLayout/ResolvedSpan.hs @@ -2,7 +2,6 @@ module Data.Text.ParagraphLayout.ResolvedSpan (ResolvedSpan(..)) where import Data.Text (Text) -import Data.Text.Foreign (I8) import Data.Text.Glyphize (Font) import qualified Data.Text.ICU as BreakStatus (Line) @@ -13,7 +12,7 @@ import Data.Text.ParagraphLayout.TextContainer -- other spans across the paragraph. data ResolvedSpan = ResolvedSpan { spanIndex :: Int - , spanOffsetInParagraph :: I8 + , spanOffsetInParagraph :: Int , spanText :: Text , spanFont :: Font , spanLineHeight :: LineHeight diff --git a/src/Data/Text/ParagraphLayout/Run.hs b/src/Data/Text/ParagraphLayout/Run.hs index fbd6677..7855b96 100644 --- a/src/Data/Text/ParagraphLayout/Run.hs +++ b/src/Data/Text/ParagraphLayout/Run.hs @@ -4,7 +4,7 @@ where import Data.List (mapAccumL) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Text (Text) -import Data.Text.Foreign (I8, dropWord8, lengthWord8, takeWord8) +import Data.Text.Foreign (dropWord8, lengthWord8, takeWord8) import Data.Text.Glyphize (Direction(..)) import qualified Data.Text.ICU.Char as ICUChar import Data.Text.Script (charScript) @@ -21,7 +21,7 @@ type ScriptCode = String -- Each run could have a different script, language, or direction. -- data Run = Run - { runOffsetInSpan :: I8 + { runOffsetInSpan :: Int , runText :: Text , runDirection :: Maybe Direction , runScript :: Maybe ScriptCode @@ -37,9 +37,9 @@ instance SeparableTextContainer Run where , r { runText = t2, runOffsetInSpan = runOffsetInSpan r + l1 } ) where - l1 = fromIntegral (lengthWord8 t1) - t1 = takeWord8 n t - t2 = dropWord8 n t + l1 = lengthWord8 t1 + t1 = takeWord8 (fromIntegral n) t + t2 = dropWord8 (fromIntegral n) t t = getText r type ProtoRun = (Zipper, Maybe Direction, ScriptCode) @@ -73,7 +73,7 @@ spanToRuns s = snd $ mapAccumL run 0 $ protoRuns zipper run acc (z, d, sc) = let t = preceding z in ( acc + lengthWord8 t , Run - { runOffsetInSpan = fromIntegral acc + { runOffsetInSpan = acc , runText = t , runDirection = d , runScript = Just sc diff --git a/src/Data/Text/ParagraphLayout/Span.hs b/src/Data/Text/ParagraphLayout/Span.hs index 439f22a..2d37347 100644 --- a/src/Data/Text/ParagraphLayout/Span.hs +++ b/src/Data/Text/ParagraphLayout/Span.hs @@ -1,8 +1,6 @@ module Data.Text.ParagraphLayout.Span (Span(..)) where -import Data.Text.Foreign (I8) - -- Paragraph is broken into spans by the caller. -- -- Each span could have a different font family, size, style, text decoration, @@ -12,7 +10,7 @@ import Data.Text.Foreign (I8) -- data Span = Span - { spanLength :: I8 + { spanLength :: Int -- ^ Byte offset to the next span or the end of the paragraph text. , spanLanguage :: String diff --git a/src/Data/Text/ParagraphLayout/TextContainer.hs b/src/Data/Text/ParagraphLayout/TextContainer.hs index 03c927f..e2a4637 100644 --- a/src/Data/Text/ParagraphLayout/TextContainer.hs +++ b/src/Data/Text/ParagraphLayout/TextContainer.hs @@ -8,7 +8,7 @@ module Data.Text.ParagraphLayout.TextContainer where import Data.Text (Text) -import Data.Text.Foreign (I8, lengthWord8) +import Data.Text.Foreign (lengthWord8) -- | Class of data types containing `Text` that can be accessed. class TextContainer a where @@ -17,7 +17,7 @@ class TextContainer a where -- | Class of data types containing `Text` that can be split at a given number -- of `Word8` units from the start of the text. class TextContainer a => SeparableTextContainer a where - splitTextAt8 :: I8 -> a -> (a, a) + splitTextAt8 :: Int -> a -> (a, a) splitTextAt8 _ _ = error "container cannot be split" -- | Treat a list of text containers as a contiguous sequence, @@ -26,17 +26,17 @@ class TextContainer a => SeparableTextContainer a where -- -- If @n@ falls on a container boundary, the total number of output containers -- will equal the number of input containers; otherwise, it will be one larger. -splitTextsAt8 :: SeparableTextContainer a => I8 -> [a] -> ([a], [a]) +splitTextsAt8 :: SeparableTextContainer a => Int -> [a] -> ([a], [a]) splitTextsAt8 n rs = (pre, post) where pre = reverse rpre (rpre, post) = splitTextsAt8' n [] rs -splitTextsAt8' :: SeparableTextContainer a => I8 -> [a] -> [a] -> ([a], [a]) +splitTextsAt8' :: SeparableTextContainer a => Int -> [a] -> [a] -> ([a], [a]) splitTextsAt8' _ rpre [] = (rpre, []) splitTextsAt8' n rpre (r:rs) | n <= 0 = (rpre, r:rs) | n >= l = splitTextsAt8' (n - l) (r:rpre) (rs) | otherwise = let (r1, r2) = splitTextAt8 n r in (r1:rpre, r2:rs) where - l = fromIntegral $ lengthWord8 $ getText r + l = lengthWord8 $ getText r diff --git a/src/Data/Text/Zipper.hs b/src/Data/Text/Zipper.hs index ef0fb94..726efa0 100644 --- a/src/Data/Text/Zipper.hs +++ b/src/Data/Text/Zipper.hs @@ -36,9 +36,6 @@ import Prelude ,(>=) ) --- | A type representing a number of UTF-8 code units, that is `Word8` units. -newtype I8 = I8 Int - -- | Represents a body of text with a read cursor which can be moved forward. data Zipper = Zipper { preceding :: Text, following :: Text } deriving @@ -97,11 +94,11 @@ next = fmap fst . uncons . following -- | /O(n)/ If @t@ is long enough to contain @n@ characters, return their size -- in `Word8`. -measureI8 :: Int -> Text -> Maybe I8 +measureI8 :: Int -> Text -> Maybe Int measureI8 n t = let m = measureOff n t in if m >= 0 - then Just (I8 m) + then Just m else Nothing -- | /O(1)/ Unsafe recombination of two `Text`s. @@ -114,12 +111,12 @@ recombine' t (Text _ _ 0) = t recombine' (Text arr off len1) (Text _ _ len2) = Text arr off (len1 + len2) -- | /O(1)/ Unsafely move the zipper forward @m@ `Word8` units. -advanceByWord8 :: I8 -> Zipper -> Zipper -advanceByWord8 (I8 m) z = Zipper (recombine' a b) c +advanceByWord8 :: Int -> Zipper -> Zipper +advanceByWord8 m z = Zipper (recombine' a b) c where a = preceding z - b = takeWord8 (I8 m) (following z) - c = dropWord8 (I8 m) (following z) + b = takeWord8 m (following z) + c = dropWord8 m (following z) -- | /O(1)/ Unsafe version of `Data.Text.Foreign.dropWord8`. -- @@ -127,8 +124,8 @@ advanceByWord8 (I8 m) z = Zipper (recombine' a b) c -- -- Requires that @m@ be within the bounds of the `Text`, not at the beginning -- or at the end, and not inside a code point. -takeWord8 :: I8 -> Text -> Text -takeWord8 (I8 m) (Text arr off _) = Text arr off m +takeWord8 :: Int -> Text -> Text +takeWord8 m (Text arr off _) = Text arr off m -- | /O(1)/ Unsafe version of `Data.Text.Foreign.dropWord8`. -- @@ -137,5 +134,5 @@ takeWord8 (I8 m) (Text arr off _) = Text arr off m -- -- Requires that @m@ be within the bounds of the `Text`, not at the beginning -- or at the end, and not inside a code point. -dropWord8 :: I8 -> Text -> Text -dropWord8 (I8 m) (Text arr off len) = Text arr (off+m) (len-m) +dropWord8 :: Int -> Text -> Text +dropWord8 m (Text arr off len) = Text arr (off+m) (len-m) diff --git a/test/Data/Text/ParagraphLayout/ParagraphConstruction.hs b/test/Data/Text/ParagraphLayout/ParagraphConstruction.hs index a9d53c2..6a1465d 100644 --- a/test/Data/Text/ParagraphLayout/ParagraphConstruction.hs +++ b/test/Data/Text/ParagraphLayout/ParagraphConstruction.hs @@ -31,7 +31,7 @@ infixr 5 >| (spanLanguage, spanText) >| suffix = (newText, newSpans) where newSpans = [newSpan] - newSpan = Span (fromIntegral $ lengthWord8 packedSpanText) spanLanguage + newSpan = Span (lengthWord8 packedSpanText) spanLanguage newText = append packedSpanText packedSuffix packedSpanText = pack spanText packedSuffix = pack suffix @@ -42,14 +42,14 @@ infixr 5 >|< (spanLanguage, spanText) >|< (oldText, oldSpans) = (newText, newSpans) where newSpans = newSpan:oldSpans - newSpan = Span (fromIntegral $ lengthWord8 packedSpanText) spanLanguage + newSpan = Span (lengthWord8 packedSpanText) spanLanguage newText = append packedSpanText oldText packedSpanText = pack spanText -- | Add optional ignored prefix and wrap in a `Paragraph`. infixr 5 |< (|<) :: String -> (Text, [Span]) -> ParagraphOptions -> Paragraph -prefix |< (oldText, spans) = Paragraph arr (fromIntegral afterPrefix) spans +prefix |< (oldText, spans) = Paragraph arr afterPrefix spans where (Text arr beforePrefix _) = append packedPrefix oldText afterPrefix = beforePrefix + lengthWord8 packedPrefix -- 2.30.2