module Data.Text.ParagraphLayoutSpec (spec) where

import Test.Hspec
import System.FilePath ((</>))
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
import Data.Text.ParagraphLayout.Plain.ParagraphData
import Data.Text.ParagraphLayout.PrettyShow
import Data.Text.ParagraphLayout.PrettyShow.Golden
import Data.Text.ParagraphLayout.Rect

type Page = (PageContinuity, ParagraphLayout)

emptyLayout :: ParagraphLayout
emptyLayout = ParagraphLayout (Rect 0 0 0 0) []

emptySpanLayout :: ParagraphLayout
emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []]

paginateAll :: PageOptions -> ParagraphLayout -> [Page]
paginateAll opts pl = case paginate opts pl of
    (c, pl1, next) -> (c, pl1) : case next of
        Just pl2 -> paginateAll opts' pl2
        Nothing -> []
    where
        opts' = opts { pageCurrentHeight = pageNextHeight opts }

spec :: Spec
spec = do

    describe "layoutPlain" $ do
        let
            goldenDir = ".golden" </> "paragraphLayout"
            shouldBeGolden = goldenTest goldenDir id id

        describe "with Arabic font" $ do
            font <- runIO $ loadFont arabicFont 0 testingOptions

            it "handles input with no spans" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ emptyParagraph opts
                result `shouldBe` emptyLayout

            it "wraps filler text at 20em" $ do
                let opts = ParagraphOptions font Normal 20000
                let result = layoutPlain $ arabicFillerParagraph opts
                result `shouldBeGolden` "arabicFiller20em"

            it "wraps filler text with spans at 20em" $ do
                let opts = ParagraphOptions font Normal 20000
                let result = layoutPlain $ spannedArabicFillerParagraph opts
                result `shouldBeGolden` "spannedArabicFiller20em"

            it "spans do not reposition filler text at 20em" $ do
                let opts = ParagraphOptions font Normal 20000
                let withoutSpans = layoutPlain $ arabicFillerParagraph opts
                let withSpans = layoutPlain $ spannedArabicFillerParagraph opts
                paragraphRect withoutSpans `shouldBe` paragraphRect withSpans

            it "applies hard breaks correctly" $ do
                let opts = ParagraphOptions font Normal 6000
                let result = layoutPlain $ hardBreaksRTLParagraph opts
                result `shouldBeGolden` "hardBreaksRTL"

        describe "with Devanagari font" $ do
            font <- runIO $ loadFont devanagariFont 0 testingOptions

            describe "lone accent character" $ do
                let
                    opts = ParagraphOptions font Normal 8000
                    result = layoutPlain $
                        devanagariAccentParagraph opts

                it "inserts a dotted circle" $ do
                    x_size (paragraphRect result) `shouldBe` 645

                it "is golden" $ do
                    result `shouldBeGolden` "devanagariAccent"

            describe "lone accent character after prefix" $ do
                let
                    opts = ParagraphOptions font Normal 8000
                    result = layoutPlain $
                        devanagariPrefixedAccentParagraph opts

                it "does not insert a dotted circle" $ do
                    x_size (paragraphRect result) `shouldBe` 0

                it "is golden" $ do
                    result `shouldBeGolden` "devanagariPrefixedAccent"

            it "handles input without wrapping" $ do
                let opts = ParagraphOptions font Normal 9000
                let result = layoutPlain $ devanagariParagraph opts
                result `shouldBeGolden` "devanagari"

        describe "with Latin font" $ do
            -- Note: This font does not contain Japanese glyphs.
            font <- runIO $ loadFont latinFont 0 testingOptions

            it "handles input with no spans" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ emptyParagraph opts
                result `shouldBe` emptyLayout

            it "handles one span with no text" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ emptySpanParagraph opts
                result `shouldBe` emptySpanLayout

            it "handles Czech hello" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ czechHelloParagraph opts
                result `shouldBeGolden` "czechHello"

            it "renders an \"ffi\" ligature" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ ligatureParagraph opts
                result `shouldBeGolden` "ligature"

            it "breaks an \"ffi\" ligature into \"ff\" + \"i\"" $ do
                let opts = ParagraphOptions font Normal 2418
                let result = layoutPlain $ ligatureParagraph opts
                result `shouldBeGolden` "ligatureParagraphBreak1"

            it "breaks an \"ffi\" ligature into \"f\" + \"fi\"" $ do
                let opts = ParagraphOptions font Normal 1800
                let result = layoutPlain $ ligatureParagraph opts
                result `shouldBeGolden` "ligatureParagraphBreak2"

            it "handles mixed languages in LTR layout" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ mixedLanguageLTRParagraph opts
                result `shouldBeGolden` "mixedLanguageLTR"

            it "handles normal line height" $ do
                let opts = ParagraphOptions font Normal 8000
                let result = layoutPlain $ trivialParagraph opts
                result `shouldBeGolden` "lineHeightNormal"

            it "handles larger line height" $ do
                let opts = ParagraphOptions font (Absolute 1600) 8000
                let result = layoutPlain $ trivialParagraph opts
                result `shouldBeGolden` "lineHeightLarger"

            it "handles smaller line height" $ do
                let opts = ParagraphOptions font (Absolute 599) 8000
                let result = layoutPlain $ trivialParagraph opts
                result `shouldBeGolden` "lineHeightSmaller"

            it "wraps mid-word when line is narrow" $ do
                let opts = ParagraphOptions font Normal 1300
                let result = layoutPlain $ czechHelloParagraph opts
                result `shouldBeGolden` "czechHelloParagraphNarrow"

            it "wraps by characters when line is ultra narrow" $ do
                let opts = ParagraphOptions font Normal 100
                let result = layoutPlain $ czechHelloParagraph opts
                result `shouldBeGolden` "czechHelloParagraphUltraNarrow"

            it "wraps lorem ipsum at 20em" $ do
                let opts = ParagraphOptions font Normal 20000
                let result = layoutPlain $ loremIpsumParagraph opts
                result `shouldBeGolden` "loremIpsum20em"

            it "wraps lorem ipsum at 100em" $ do
                let opts = ParagraphOptions font Normal 100000
                let result = layoutPlain $ loremIpsumParagraph opts
                result `shouldBeGolden` "loremIpsum100em"

            it "wraps lorem ipsum with spans at 20em" $ do
                let opts = ParagraphOptions font Normal 20000
                let result = layoutPlain $ spannedLoremIpsumParagraph opts
                result `shouldBeGolden` "spannedLoremIpsum20em"

            it "spans do not reposition lorem ipsum at 20em" $ do
                let opts = ParagraphOptions font Normal 20000
                let withoutSpans = layoutPlain $ loremIpsumParagraph opts
                let withSpans = layoutPlain $ spannedLoremIpsumParagraph opts
                paragraphRect withoutSpans `shouldBe` paragraphRect withSpans

            it "wraps mixed-script words correctly" $ do
                let opts = ParagraphOptions font Normal 6000
                let result = layoutPlain $ mixedScriptWordsParagraph opts
                result `shouldBeGolden` "mixedScriptWords"

            it "trims spaces around lines" $ do
                let opts = ParagraphOptions font Normal 6000
                let result = layoutPlain $ manySpacesParagraph opts
                result `shouldBeGolden` "manySpaces"

            it "applies hard breaks correctly" $ do
                let opts = ParagraphOptions font Normal 5000
                let result = layoutPlain $ hardBreaksLTRParagraph opts
                result `shouldBeGolden` "hardBreaksLTR"

    describe "paginate" $ do
        let
            goldenDir = ".golden" </> "paginatedParagraphLayout"
            shouldBeGolden = goldenTest goldenDir getPages Pages

        describe "with Arabic font" $ do
            font <- runIO $ loadFont arabicFont 0 testingOptions

            it "wraps filler text with spans at 20em" $ do
                let
                    opts = ParagraphOptions font Normal 20000
                    pl = layoutPlain $ spannedArabicFillerParagraph opts
                    popts = PageOptions
                        { pageCurrentHeight = 1000
                        , pageNextHeight = 5000
                        , pageOrphans = 2
                        , pageWidows = 2
                        }
                    pages = paginateAll popts pl
                pages `shouldBeGolden` "spannedArabicFiller20em"

        describe "with Latin font" $ do
            font <- runIO $ loadFont latinFont 0 testingOptions

            it "wraps lorem ipsum at 20em" $ do
                let
                    opts = ParagraphOptions font Normal 20000
                    pl = layoutPlain $ loremIpsumParagraph opts
                    popts = PageOptions
                        { pageCurrentHeight = 2500
                        , pageNextHeight = 8500
                        , pageOrphans = 2
                        , pageWidows = 3
                        }
                    pages = paginateAll popts pl
                pages `shouldBeGolden` "loremIpsum20em"

    describe "shaped runs for demo" $ do
        let
            goldenDir = ".golden" </> "shapedRuns"
            shouldBeGolden = goldenTest goldenDir getShapedRuns ShapedRuns
            -- | Test shaped runs against an expected value,
            -- and write metadata about the used font afterwards.
            shapedRunsSpecWithFont fontPath font subject name p = do
                let infoPath = fontInfoPath goldenDir name
                let writeInfo = writeFontInfo infoPath fontPath font
                after_ writeInfo $ it subject $ do
                    let result = layoutPlain p
                    shapedRuns result `shouldBeGolden` name

        describe "with Latin font" $ do
            let fontPath = latinFont
            font <- runIO $ loadFont fontPath 0 demoOptions
            let shapedRunsSpec = shapedRunsSpecWithFont fontPath font

            shapedRunsSpec "wraps lorem ipsum with spans at 20em"
                "spannedLoremIpsum20em" $
                spannedLoremIpsumParagraph $
                ParagraphOptions font Normal 640