module Main (main) where import qualified Data.ByteString as BS import Data.List (intersperse) import Data.Text.Glyphize (Direction(..) ,Font ,GlyphInfo ,GlyphPos ,createFace ,createFont ) import Data.Text.Lazy (pack) import Test.Hspec import Test.Hspec.Golden import System.FilePath (()) import Data.Text.ParagraphLayout import Data.Text.ParagraphLayout.Run type LayoutOutput = [[(GlyphInfo,GlyphPos)]] emptySpan :: Font -> Span emptySpan font = Span { spanText = pack "" , spanFont = font , spanLanguage = Nothing } czechHello :: Font -> Span czechHello font = Span { spanText = pack "Ahoj, světe!" , spanFont = font , spanLanguage = Just "cs" } serbianMixedScript :: Font -> Span serbianMixedScript font = Span { spanText = pack "Vikipedija (Википедија)" , spanFont = font , spanLanguage = Just "sr" } prettyShow :: LayoutOutput -> String prettyShow = showOutput where showOutput rs = concat ["[\n", showRuns rs, "\n]\n"] showRuns = concat . intersperse ",\n" . map showRun showRun gs = concat [indent1, "[\n", showGlyphs gs, "\n", indent1, "]"] showGlyphs = concat . intersperse ",\n" . map showGlyph showGlyph g = concat [indent2, show g] indent1 = " " indent2 = indent1 ++ indent1 shouldBeGolden :: LayoutOutput -> FilePath -> Golden LayoutOutput shouldBeGolden output_ name = Golden { output = output_ , encodePretty = show , writeToFile = \path -> writeFile path . prettyShow , readFromFile = \path -> readFile path >>= return . read , goldenFile = ".golden" name "golden" , actualFile = Just (".golden" name "actual") , failFirstTime = False } main :: IO () main = do ttf <- BS.readFile ("assets" "fonts" "ubuntu" "Ubuntu-R.ttf") let face = createFace ttf 0 let font = createFont face hspec $ do describe "spanToRuns" $ do it "handles span with no text" $ do spanToRuns (emptySpan font) `shouldBe` [] it "handles Czech hello" $ do let inputSpan = czechHello font let runs = spanToRuns inputSpan runs `shouldBe` [ Run { runText = spanText inputSpan , runDirection = Just DirLTR , runScript = Just "Latn" , runOriginalSpan = inputSpan } ] it "handles Serbian with mixed script" $ do let inputSpan = serbianMixedScript font let runs = spanToRuns inputSpan runs `shouldBe` [ Run -- TODO: We might want both parentheses in the same run. { runText = pack "Vikipedija (" , runDirection = Just DirLTR , runScript = Just "Latn" , runOriginalSpan = inputSpan } , Run { runText = pack "Википедија)" , runDirection = Just DirLTR , runScript = Just "Cyrl" , runOriginalSpan = inputSpan } ] describe "layout" $ do it "handles input with no spans" $ do layout [] `shouldBe` [] it "handles one span with no text" $ do layout [emptySpan font] `shouldBe` [] it "handles Czech hello" $ do layout [czechHello font] `shouldBeGolden` "czechHello"