-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module PandocSpec where

import TestImport

import Utils.Print

import qualified Data.Set as Set
import qualified Data.Map.Lazy as Map
import qualified Data.Foldable as Fold
import qualified Data.Text as T

import Text.Pandoc
import Text.Pandoc.Builder
import Text.Pandoc.Arbitrary ()

-- Instance Arbitrary Meta is somewhat useless, as it always generates the same 3 keys.
newtype ArbitraryMeta = ArbitraryMeta { unArbitraryMeta :: Meta }
  deriving newtype (Eq, Ord, Semigroup, Monoid, Show, Read)

newtype ArbitraryPandoc = ArbitraryPandoc { unArbitraryPandoc :: Pandoc }
  deriving newtype (Eq, Ord, Show, Read)

newtype ArbitraryMapText a = ArbitraryMapText { unArbitraryMapText :: [(Text, a)] }

instance Arbitrary ArbitraryMeta where
  arbitrary = do
    (x1 :: Inlines) <- arbitrary
    (x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary
    (x3 :: Inlines) <- arbitrary
    (x4 :: [(Text, Text)]) <- unArbitraryMapText <$> arbitrary
    (x5 :: [(Text, Bool)]) <- unArbitraryMapText <$> arbitrary
    return $ ArbitraryMeta
          $ setMeta "title" x1
          $ setMeta "author" x2
          $ setMeta "date" x3
          $ applyMetas (fmap (second Just) x4)
          $ applyMetas (fmap (second Just) x5)
            nullMeta

instance Arbitrary ArbitraryPandoc where
  arbitrary = do
    meta  <- arbitrary
    ArbitraryPandoc . Pandoc (unArbitraryMeta meta) <$> arbitrary

nonEmptyString :: Gen Text
nonEmptyString = T.pack <$> listOf1 arbitrary

instance Arbitrary a => Arbitrary (ArbitraryMapText a) where
  arbitrary =
    let genKV = (,) <$> nonEmptyString <*> arbitrary
    in ArbitraryMapText <$> listOf1 genKV



-- For Lens Check _Meta required:
--instance CoArbitrary Inline
--instance CoArbitrary MetaValue
--instance CoArbitrary Meta
--instance Function Inline
--instance Function MetaValue
--instance Function Meta

spec :: Spec
spec = do
  let mlist = Map.toAscList . unMeta

  describe "applyMetas" $ do
    it "should actually set values" $ do
      (metaList0, apd) <- generate arbitrary
      let
        metaList1 :: [(Text, Maybe MetaValue)] = second (Just . MetaString) <$> unArbitraryMapText metaList0
        pd = unArbitraryPandoc apd
        (Pandoc metaNew _) = applyMetas metaList1 pd
        metaMap1 = Map.fromList $ reverse metaList1 -- remove duplicate keys, keeping the first        
        metaList' = [(k, Just t) | (k, t) <- mlist metaNew, k `Map.member` metaMap1]
      metaList' `shouldMatchList` Map.toAscList metaMap1

    it "should preserve untouched settings" $ do
      (metaList, apd) <- generate arbitrary
      let
        pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
        changedKeys = Set.fromList [k | (k, Just _) <- metaList]
        (Pandoc metaNew _) = applyMetas (second (fmap MetaString) <$> metaList) pd
        oldm = [(k,t) | (k,t) <- mlist metaOriginal , Set.notMember k changedKeys]
        newm = [(k,t) | (k,t) <- mlist metaNew      , Set.notMember k changedKeys]
      oldm `shouldMatchList` newm

  describe "addMeta" $ do
    it "should possibly overwrite existing settings" $ do
      (abMetaOverwrite, apd) <- generate arbitrary
      let
        metaOverwrite = unArbitraryMeta abMetaOverwrite
        pd = unArbitraryPandoc apd
        (Pandoc newMeta _) = addMeta metaOverwrite pd
      (unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True

    it "should preserve untouched settings" $ do
      (abMetaOverwrite, apd) <- generate arbitrary
      let
        metaOverwrite = unArbitraryMeta abMetaOverwrite
        pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
        (Pandoc newMeta  _) = addMeta metaOverwrite pd
      ((unMeta metaOriginal `Map.difference` unMeta metaOverwrite)  `Map.isSubmapOf` unMeta newMeta) `shouldBe` True

    it "should preserve document blocks" $ do
        (abMetaOverwrite, apd) <- generate arbitrary
        let
          metaOverwrite = unArbitraryMeta abMetaOverwrite
          pd@(Pandoc _ oldBlocks) = unArbitraryPandoc apd
          (Pandoc _ newBlocks) = addMeta metaOverwrite pd
        newBlocks `shouldBe` oldBlocks

  -- describe "_Meta" . it "is a lens" . property $ isLens _Meta