From 4ebfe390a1e8b16f42c6bdb51c135c895a7ce022 Mon Sep 17 00:00:00 2001 From: Jaro Date: Sun, 18 Jun 2023 12:36:49 +0200 Subject: [PATCH] Store default level in BiDiLevels. This will be required for handling empty text sequences. --- .../ParagraphLayout/Internal/BiDiLevels.hs | 45 +++++++++++-------- .../Internal/ApplyBoxesSpec.hs | 2 +- .../Internal/BiDiLevelsSpec.hs | 7 +-- .../Text/ParagraphLayout/Internal/RunSpec.hs | 6 +-- 4 files changed, 35 insertions(+), 25 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Internal/BiDiLevels.hs b/src/Data/Text/ParagraphLayout/Internal/BiDiLevels.hs index 22c52b2..301e092 100644 --- a/src/Data/Text/ParagraphLayout/Internal/BiDiLevels.hs +++ b/src/Data/Text/ParagraphLayout/Internal/BiDiLevels.hs @@ -2,6 +2,8 @@ module Data.Text.ParagraphLayout.Internal.BiDiLevels ( Level , TextLevels (TextLevels) , WithLevel + , baseLevel + , directionLevel , dropLevels , firstStrongDirection , headLevel @@ -27,21 +29,27 @@ type Level = Word8 class WithLevel a where level :: a -> Level --- | BiDi levels for each character from a given input text. +-- | BiDi levels for each character from a given input text, +-- plus the base level (for safe handling of empty text runs). -- -- This wrapper is meant to ease the transition to a different internal -- representation, if required when integrating with the ICU. -newtype TextLevels = TextLevels [Level] +data TextLevels = TextLevels [Level] Level deriving (Eq, Show) headLevel :: TextLevels -> Level -headLevel (TextLevels xs) = head xs +headLevel (TextLevels xs base) = case xs of + [] -> base + (x : _) -> x tailLevels :: TextLevels -> TextLevels -tailLevels (TextLevels xs) = TextLevels (tail xs) +tailLevels (TextLevels xs base) = TextLevels (tail xs) base dropLevels :: Int -> TextLevels -> TextLevels -dropLevels n (TextLevels xs) = TextLevels (drop n xs) +dropLevels n (TextLevels xs base) = TextLevels (drop n xs) base + +baseLevel :: TextLevels -> Level +baseLevel (TextLevels _ base) = base -- | Determine the BiDi level of each character in the input text -- using a simplified algorithm with the following main limitations: @@ -56,25 +64,26 @@ dropLevels n (TextLevels xs) = TextLevels (drop n xs) -- -- TODO: Use Haskell bindings to the ICU BiDi implementation once available. textLevels :: Direction -> Text -> TextLevels -textLevels baseDir txt = TextLevels $ textLevels' baseLevel baseLevel 0 txt +textLevels baseDir txt = + TextLevels (textLevels' base base 0 txt) base where - baseLevel = directionLevel 0 baseDir + base = directionLevel 0 baseDir -- | Determine the BiDi level of each character in the input text -- using a simplified algorithm. textLevels' :: Level -> Level -> Int -> Text -> [Level] -textLevels' baseLevel previousLevel neutrals txt = case uncons txt of - Just (char, rest) -> case charLevel baseLevel char of +textLevels' base previousLevel neutrals txt = case uncons txt of + Just (char, rest) -> case charLevel base char of Just currentLevel -> - replicate neutrals (mergeLevel baseLevel previousLevel currentLevel) + replicate neutrals (mergeLevel base previousLevel currentLevel) ++ currentLevel : - textLevels' baseLevel currentLevel 0 rest + textLevels' base currentLevel 0 rest Nothing -> - textLevels' baseLevel previousLevel (neutrals + 1) rest + textLevels' base previousLevel (neutrals + 1) rest Nothing -> - replicate neutrals baseLevel + replicate neutrals base -- | Determine the level of a neutral character based on its surrounding levels. mergeLevel :: Level -> Level -> Level -> Level @@ -94,12 +103,12 @@ data SimpleType = StrongLTR | StrongRTL | Number | Neutral | Reset -- | Determine the BiDi level of one character -- using a simplified algorithm. charLevel :: Level -> Char -> Maybe Level -charLevel baseLevel c = case simpleType c of - StrongLTR -> Just $ directionLevel baseLevel DirLTR - StrongRTL -> Just $ directionLevel baseLevel DirRTL - Number -> Just $ directionLevel (baseLevel + 1) DirLTR +charLevel base c = case simpleType c of + StrongLTR -> Just $ directionLevel base DirLTR + StrongRTL -> Just $ directionLevel base DirRTL + Number -> Just $ directionLevel (base + 1) DirLTR Neutral -> Nothing - Reset -> Just baseLevel + Reset -> Just base -- | Reduce the character's BiDi class into a simpler category -- for the purposes of the simplified algorithm. diff --git a/test/Data/Text/ParagraphLayout/Internal/ApplyBoxesSpec.hs b/test/Data/Text/ParagraphLayout/Internal/ApplyBoxesSpec.hs index c32928e..f83b5e1 100644 --- a/test/Data/Text/ParagraphLayout/Internal/ApplyBoxesSpec.hs +++ b/test/Data/Text/ParagraphLayout/Internal/ApplyBoxesSpec.hs @@ -24,7 +24,7 @@ trivialSpan d i dir bs = ResolvedSpan , spanText = empty , spanTextOptions = defaultTextOptions dir , spanBoxes = bs - , spanBiDiLevels = TextLevels [] + , spanBiDiLevels = TextLevels [] (directionLevel 0 dir) , spanLineBreaks = [] , spanCharacterBreaks = [] } diff --git a/test/Data/Text/ParagraphLayout/Internal/BiDiLevelsSpec.hs b/test/Data/Text/ParagraphLayout/Internal/BiDiLevelsSpec.hs index b0dfe41..f40d029 100644 --- a/test/Data/Text/ParagraphLayout/Internal/BiDiLevelsSpec.hs +++ b/test/Data/Text/ParagraphLayout/Internal/BiDiLevelsSpec.hs @@ -11,11 +11,12 @@ import Data.Text.ParagraphLayout.TextData -- | Test that `textLevels` produces the levels of the lengths given in -- "Data.Text.ParagraphLayout.TextData" and values given here. shouldHaveLevels :: (Direction, a, Text, [Int]) -> [Level] -> SpecWith () -shouldHaveLevels (dir, _, text, lens) levels = it description $ - result `shouldBe` TextLevels (runLengthDecode rls) +shouldHaveLevels (dir, _, text, runLens) runLevels = it description $ + actualLevels `shouldBe` runLengthDecode rls where + TextLevels actualLevels _ = result result = textLevels dir text - rls = zip lens levels + rls = zip runLens runLevels description = case rls of [] -> "should be empty" [(_, lvl)] -> "should all have level " ++ show lvl diff --git a/test/Data/Text/ParagraphLayout/Internal/RunSpec.hs b/test/Data/Text/ParagraphLayout/Internal/RunSpec.hs index 0ad2846..4da8e80 100644 --- a/test/Data/Text/ParagraphLayout/Internal/RunSpec.hs +++ b/test/Data/Text/ParagraphLayout/Internal/RunSpec.hs @@ -35,13 +35,13 @@ sampleSpan (dir, lang, text, _) levels = ResolvedSpan } allLTR :: TextLevels -allLTR = TextLevels $ repeat 0 +allLTR = TextLevels (repeat 0) 0 allRTL :: TextLevels -allRTL = TextLevels $ repeat 1 +allRTL = TextLevels (repeat 1) 1 levelsRLE :: [(Int, Level)] -> TextLevels -levelsRLE rls = TextLevels $ runLengthDecode rls +levelsRLE rls = TextLevels (runLengthDecode rls) undefined spec :: Spec spec = do -- 2.30.2