module Data.Text.ParagraphLayout.RichSpec (spec) where

import Data.Int (Int32)
import Data.Word (Word32)
import Data.Text.Glyphize (Direction (DirLTR, DirRTL), codepoint)

import Test.Hspec
import System.FilePath ((</>))
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Internal.Paginable (paginateAll)
import Data.Text.ParagraphLayout.Internal.ParagraphLine (forceLeftAlign)
import Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout (shapedRuns)
import Data.Text.ParagraphLayout.PrettyShow
import Data.Text.ParagraphLayout.PrettyShow.Golden
import Data.Text.ParagraphLayout.Rect
import Data.Text.ParagraphLayout.Rich
import Data.Text.ParagraphLayout.Rich.ParagraphData

fragmentRects :: ParagraphLayout d -> [(d, Rect Int32)]
fragmentRects p = map toItem $ paragraphFragments p
    where toItem (Fragment { fragmentUserData = d, fragmentRect = r }) = (d, r)

glyphRuns :: ParagraphLayout d -> [[Word32]]
glyphRuns = map (map (codepoint . fst) . fragmentGlyphs) . paragraphFragments

-- | A sufficiently large number to prevent line breaking,
-- while being round so that coordinates in test results are easy to read.
largeWidth :: Int32
largeWidth = 1000000000

-- | Expect two paragraph layouts to contain the same fragments,
-- except possibly shifted left or right.
shouldBeWrappedLike :: (Show d, Eq d) =>
    ParagraphLayout d -> ParagraphLayout d -> Expectation
shouldBeWrappedLike a b =
    forceLeftAlign a `shouldBe` forceLeftAlign b

-- | Expect two paragraph layouts to not contain the same fragments,
-- even if ignoring a possible shift to the left or to the right.
shouldNotBeWrappedLike :: (Show d, Eq d) =>
    ParagraphLayout d -> ParagraphLayout d -> Expectation
shouldNotBeWrappedLike a b =
    forceLeftAlign a `shouldNotBe` forceLeftAlign b

spec :: Spec
spec = do

    describe "layoutRich" $ do
        let
            goldenDir = ".golden" </> "richParagraphLayout"
            shouldBeGolden = goldenTest goldenDir id id

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

            let commonWrapWidth = 20000
            let expectedSafeWidth = 19791

            describe "lorem ipsum at 20em, left aligned" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignLeft
                        }
                let input w = loremIpsumParagraph font $
                        opts { paragraphMaxWidth = w }
                let result20em = layoutRich $ input commonWrapWidth
                let resultSafe = layoutRich $ input expectedSafeWidth
                let resultUnsafe = layoutRich $ input (expectedSafeWidth - 1)

                it "wraps correctly" $
                    result20em `shouldBeGolden` "loremIpsum20em"

                it "gives correct safe width" $
                    paragraphSafeWidth result20em `shouldBe` expectedSafeWidth

                it "wraps the same at safe width" $
                    resultSafe `shouldBeWrappedLike` result20em

                it "does not wrap the same at smaller width" $
                    resultUnsafe `shouldNotBeWrappedLike` result20em

            describe "lorem ipsum at 20em, right aligned" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignRight
                        }
                let input w = loremIpsumParagraph font $
                        opts { paragraphMaxWidth = w }
                let result20em = layoutRich $ input commonWrapWidth
                let resultSafe = layoutRich $ input expectedSafeWidth
                let resultUnsafe = layoutRich $ input (expectedSafeWidth - 1)

                it "wraps correctly" $
                    result20em `shouldBeGolden` "loremIpsum20emRight"

                it "gives correct safe width" $
                    paragraphSafeWidth result20em `shouldBe` expectedSafeWidth

                it "wraps the same at safe width" $
                    resultSafe `shouldBeWrappedLike` result20em

                it "does not wrap the same at smaller width" $
                    resultUnsafe `shouldNotBeWrappedLike` result20em

            describe "lorem ipsum at 20em, centred" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignCentreH
                        }
                let input w = loremIpsumParagraph font $
                        opts { paragraphMaxWidth = w }
                let result20em = layoutRich $ input commonWrapWidth
                let resultSafe = layoutRich $ input expectedSafeWidth
                let resultUnsafe = layoutRich $ input (expectedSafeWidth - 1)
                let resultUnsafe2 = layoutRich $ input (expectedSafeWidth - 2)

                it "wraps correctly" $
                    result20em `shouldBeGolden` "loremIpsum20emCentre"

                it "gives correct safe width" $
                    paragraphSafeWidth result20em `shouldBe` expectedSafeWidth

                it "wraps the same at safe width" $
                    resultSafe `shouldBeWrappedLike` result20em

                it "does not wrap the same at smaller width" $
                    resultUnsafe `shouldNotBeWrappedLike` result20em

                -- Cover for false negatives when halving odd numbers.
                it "does not wrap the same at 2 units smaller width" $
                    resultUnsafe2 `shouldNotBeWrappedLike` result20em

            it "handles mixed line height" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let lineHeights = (800, 1300, 1700)
                let input = mixedLineHeightParagraph lineHeights font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedLineHeight"

            it "handles mixed sizes" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = mixedSizesParagraph (font, fontSmall) opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedSizes"

            it "handles mixed script" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = mixedScriptParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedScript"

            it "handles mixed script with line wraps" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 5000
                        }
                let input = mixedScriptParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedScriptWrap"

            it "handles empty box in the middle of the line" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 5193
                        }
                let input = emptyBoxParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "emptyBoxMiddle"

            it "handles space box in the middle of the line" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 4635
                        }
                let input = spaceBoxParagraph AllowBoxCollapse font opts
                let result = layoutRich input
                result `shouldBeGolden` "spaceBoxMiddle"

            it "can collapse space box when on its own line" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 100
                        }
                let input = spaceBoxParagraph AllowBoxCollapse font opts
                let result = layoutRich input
                result `shouldBeGolden` "spaceBoxCollapsed"

            it "can preserve space box when on its own line" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 100
                        }
                let input = spaceBoxParagraph AvoidBoxCollapse font opts
                let result = layoutRich input
                result `shouldBeGolden` "spaceBoxPreserved"

            it "handles nested boxes" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = nestedBoxesParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "nestedBoxes"

            it "handles hard break in LTR boxes" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = hardBoxBreakLTRParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "hardBoxBreakLTR"

            it "breaks line early if box spacing does not fit" $ do
                let lineH = -1121
                let lineY n = lineH * (n - 1)
                let wordAdvancesWithSpace = [3134, 2954, 2659, 1332, 2601]
                let spaceAdvance = 231
                let wordW n = wordAdvancesWithSpace !! (n - 1)
                let wordW_ n = wordW n - spaceAdvance
                let originX = 0
                let wordX n =
                        originX + (sum $ take (n - 1) wordAdvancesWithSpace)
                let endX = originX + (sum wordAdvancesWithSpace)
                -- A paragraph exactly wide enough to fit the whole text.
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = endX
                        }
                -- Small spacing that should push one word onto the next line.
                let s = 5
                -- Large spacing that should push two words onto the next line.
                let s' = wordW 5 + spaceAdvance + 1
                let inputNoSpacing = softBreakParagraph 0 font opts
                let inputSmallSpacing = softBreakParagraph s font opts
                let inputLargeSpacing = softBreakParagraph s' font opts
                let resultNoSpacing = layoutRich inputNoSpacing
                let resultSmallSpacing = layoutRich inputSmallSpacing
                let resultLargeSpacing = layoutRich inputLargeSpacing
                fragmentRects resultNoSpacing `shouldBe`
                    [ ("text1", Rect (wordX 1) (lineY 1) (wordW 1) lineH)
                    , ("text2", Rect (wordX 2) (lineY 1) (wordW 2) lineH)
                    , ("text3", Rect (wordX 3) (lineY 1) (wordW 3) lineH)
                    , ("text4", Rect (wordX 4) (lineY 1) (wordW 4) lineH)
                    , ("text5", Rect (wordX 5) (lineY 1) (wordW 5) lineH)
                    ]
                fragmentRects resultSmallSpacing `shouldBe`
                    [ ("text1", Rect (wordX 1) (lineY 1) (wordW 1) lineH)
                    , ("text2", Rect (wordX 2) (lineY 1) (wordW 2) lineH)
                    , ("text3", Rect (wordX 3 + s) (lineY 1) (wordW 3) lineH)
                    , ("text4", Rect (wordX 4 + s) (lineY 1) (wordW_ 4) lineH)
                    , ("text5", Rect originX (lineY 2) (wordW 5) lineH)
                    ]
                fragmentRects resultLargeSpacing `shouldBe`
                    [ ("text1", Rect (wordX 1) (lineY 1) (wordW 1) lineH)
                    , ("text2", Rect (wordX 2) (lineY 1) (wordW 2) lineH)
                    , ("text3", Rect (wordX 3 + s') (lineY 1) (wordW_ 3) lineH)
                    , ("text4", Rect originX (lineY 2) (wordW 4) lineH)
                    , ("text5",
                        Rect (originX + wordW 4) (lineY 2) (wordW 5) lineH)
                    ]

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

            it "makes space for one newline" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = newline1Paragraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "newline1Paragraph"

            it "makes space for one newline plus text" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = newline1TextParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "newline1TextParagraph"

            it "makes space for two newlines" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = newline2Paragraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "newline2Paragraph"

            it "makes space for two newlines plus text" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = newline2TextParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "newline2TextParagraph"

            it "handles hard break in RTL boxes" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = hardBoxBreakRTLParagraph font opts
                let result = layoutRich input
                result `shouldBeGolden` "hardBoxBreakRTL"

            it "handles neutral characters in RTL paragraph" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = neutralDirectionParagraph DirRTL font opts
                let result = layoutRich input
                result `shouldBeGolden` "neutralDirectionRTL"

            it "handles neutral characters in LTR paragraph" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = neutralDirectionParagraph DirLTR font opts
                let result = layoutRich input
                result `shouldBeGolden` "neutralDirectionLTR"

            it "handles simple mixed direction in RTL paragraph" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = mixedDirectionSimpleParagraph DirRTL font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedDirectionSimpleRTL"

            it "handles simple mixed direction in LTR paragraph" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = mixedDirectionSimpleParagraph DirLTR font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedDirectionSimpleLTR"

            it "handles complex mixed direction in RTL paragraph" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = mixedDirectionComplexParagraph DirRTL font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedDirectionComplexRTL"

            it "handles complex mixed direction in LTR paragraph" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = largeWidth
                        }
                let input = mixedDirectionComplexParagraph DirLTR font opts
                let result = layoutRich input
                result `shouldBeGolden` "mixedDirectionComplexLTR"

            it "preserves joining forms across soft breaks" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 4500
                        }
                let input = intraWordBreakParagraph font opts
                let glyphRunsVisual = glyphRuns $ layoutRich input
                let glyphRunsLogical = map reverse glyphRunsVisual
                -- Glyph indexes for the corresponding Arabic letters/ligatures:
                let n_initial = 407
                let v_final = 971
                let sh_initial = 373
                let tn_final = 1363
                -- Glyph index for the underscore used to break repetitions:
                let sp = 89
                -- Unconventional code formatting here shows that there should
                -- be three repetitions of the same glyph sequence, unaffected
                -- by the line break inserted after an initial form and before
                -- a final form.
                glyphRunsLogical `shouldBe`
                    [[n_initial, v_final, sh_initial, tn_final, sp,
                    n_initial, v_final, sh_initial], [tn_final, sp,
                    n_initial, v_final, sh_initial, tn_final]]

    describe "paginate" $ do
        let
            goldenDir = ".golden" </> "paginatedRichParagraphLayout"
            shouldBeGolden = goldenTest goldenDir getRichPages RichPages

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

            it "wraps lorem ipsum at 20em" $ do
                let opts = defaultParagraphOptions
                        { paragraphAlignment = AlignStart
                        , paragraphMaxWidth = 20000
                        }
                let input = loremIpsumParagraph font opts
                let pl = layoutRich input
                let popts = PageOptions
                        { pageCurrentHeight = 2500
                        , pageNextHeight = 8500
                        , pageOrphans = 2
                        , pageWidows = 3
                        }
                let 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 result = do
                let infoPath = fontInfoPath goldenDir name
                let writeInfo = writeFontInfo infoPath fontPath font
                after_ writeInfo $ it subject $
                    shapedRuns result `shouldBeGolden` name

        describe "with Arabic font" $ do
            let fontPath = arabicFont
            font <- runIO $ loadFont fontPath 0 demoOptions

            let shapedRunsSpec = shapedRunsSpecWithFont fontPath font

            shapedRunsSpec
                "handles complex mixed direction in RTL paragraph"
                "mixedDirectionComplexRTL" $
                layoutRich $
                mixedDirectionComplexParagraph DirRTL font $
                defaultParagraphOptions
                    { paragraphAlignment = AlignStart
                    , paragraphMaxWidth = 640
                    }

            shapedRunsSpec
                "preserves joining forms across soft breaks"
                "intraWordBreak" $
                layoutRich $
                intraWordBreakParagraph font $
                defaultParagraphOptions
                    { paragraphAlignment = AlignStart
                    , paragraphMaxWidth = 144
                    }