117 lines
4.2 KiB
Haskell
117 lines
4.2 KiB
Haskell
-- 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 |