module Data.Text.ParagraphLayoutSpec (spec) where

import Data.Text.Glyphize (Font)

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

type Page = (PageContinuity, ParagraphLayout)

class ShouldBeGolden a where
    shouldBeGolden :: a -> FilePath -> Golden a

instance ShouldBeGolden ParagraphLayout where
    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 = True
        }

instance ShouldBeGolden Pages where
    shouldBeGolden output_ name = Golden
        { output = output_
        , encodePretty = show . getPages
        , writeToFile = \ path -> writeFile path . prettyShow
        , readFromFile = \ path -> readFile path >>= return . Pages . read
        , goldenFile = ".golden" </> name </> "golden"
        , actualFile = Just (".golden" </> name </> "actual")
        , failFirstTime = True
        }

instance ShouldBeGolden ShapedRuns where
    shouldBeGolden output_ name = Golden
        { output = output_
        , encodePretty = show . getShapedRuns
        , writeToFile = \ path -> writeFile path . prettyShow
        , readFromFile = \ path -> readFile path >>= return . ShapedRuns . read
        , goldenFile = ".golden" </> "shapedRuns" </> name </> "golden"
        , actualFile = Just (".golden" </> "shapedRuns" </> name </> "actual")
        , failFirstTime = True
        }

fontInfoPath :: String -> FilePath
fontInfoPath name = ".golden" </> "shapedRuns" </> name </> "fontInfo"

shapedRuns' :: ParagraphLayout -> ShapedRuns
shapedRuns' = ShapedRuns . shapedRuns

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

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

-- | Test shaped runs against an expected value, and write metadata about the
-- used font afterwards.
shapedRunsSpecWithFont ::
    FilePath -> Font -> String -> FilePath -> Paragraph -> SpecWith ()
shapedRunsSpecWithFont fontPath font subject name p = do
    let writeInfo = writeFontInfo (fontInfoPath name) fontPath font
    after_ writeInfo $ it subject $ do
        let result = layoutPlain p
        shapedRuns' result `shouldBeGolden` name

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

        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` "hardBreaksRTLParagraph"

        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` "devanagariAccentParagraph"

            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` "devanagariPrefixedAccentParagraph"

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

        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` "czechHelloParagraph"

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

            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` "mixedLanguageLTRParagraph"

            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` "mixedScriptWordsParagraph"

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

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

    describe "paginate" $ do

        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 pages `shouldBeGolden` "spannedArabicFiller20emPaginated"

        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 pages `shouldBeGolden` "loremIpsum20emPaginated"

    describe "shaped runs for demo" $ do

        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