module Data.Text.ParagraphLayout.Internal.BiDiLevelsSpec where import Data.Text (Text) import Data.Text.Glyphize (Direction (DirLTR, DirRTL)) import Test.Hspec import Data.Text.ParagraphLayout.Internal.BiDiLevels import Data.Text.ParagraphLayout.RunLengthEncoding 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, runLens) runLevels = it description $ actualLevels `shouldBe` runLengthDecode rls where TextLevels actualLevels _ = result result = textLevels dir text rls = zip runLens runLevels description = case rls of [] -> "should be empty" [(_, lvl)] -> "should all have level " ++ show lvl _ -> "should have multiple levels" -- | Override the paragraph direction of sample data. setDirection :: Direction -> (Direction, a, b, c) -> (Direction, a, b, c) setDirection dir (_, a, b, c) = (dir, a, b, c) -- | Override the paragraph direction of sample data to LTR. setLTR :: (Direction, a, b, c) -> (Direction, a, b, c) setLTR = setDirection DirLTR -- | Override the paragraph direction of sample data to RTL. setRTL :: (Direction, a, b, c) -> (Direction, a, b, c) setRTL = setDirection DirRTL spec :: Spec spec = do describe "textLevels" $ do -- Empty input should produce empty output. -- Infinite list of level 0 is also acceptable. describe "on English input" $ englishEmpty `shouldHaveLevels` [] -- Empty input should produce empty output. -- Infinite list of level 1 is also acceptable. describe "on Arabic empty" $ arabicEmpty `shouldHaveLevels` [] -- All LTR text without numbers should always stay at the base level. describe "on English word in LTR" $ setLTR englishWord `shouldHaveLevels` [0] -- All characters in a RTL paragraph must be at least at level 1. describe "on English word in RTL" $ setRTL englishWord `shouldHaveLevels` [2] describe "on Arabic word in LTR" $ setLTR arabicHello `shouldHaveLevels` [1] describe "on Arabic word in RTL" $ setRTL arabicHello `shouldHaveLevels` [1] describe "on Serbian mixed script" $ serbianMixedScript `shouldHaveLevels` [0] describe "on mixed direction with base LTR" $ mixedDirectionSimple DirLTR `shouldHaveLevels` [0, 1, 0] describe "on mixed direction with base RTL" $ mixedDirectionSimple DirRTL `shouldHaveLevels` [2, 1, 2] describe "on Arabic around English" $ arabicAroundEnglish `shouldHaveLevels` [1, 2, 1, 2, 1] describe "on English around Arabic" $ englishAroundArabic `shouldHaveLevels` [0, 1, 0] describe "on numbers in RTL run in LTR" $ mixedDirectionNumbers `shouldHaveLevels` [0, 1, 2, 1]