fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(pandoc): rewrite tests for pandoc applyMetas

Browse Source
This commit is contained in:
Steffen Jost 2022-09-05 15:24:56 +02:00
parent 475eb600bb
commit 58cc35d118
1 changed files with 45 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
test/PandocSpec.hs
View File

@ -15,22 +15,30 @@ import Text.Pandoc.Arbitrary ()
-- Instance Arbitrary Meta is somewhat useless, as it always generates the same 3 keys. -- Instance Arbitrary Meta is somewhat useless, as it always generates the same 3 keys.
newtype ArbitraryMeta = ArbitraryMeta { unArbitraryMeta :: Meta } newtype ArbitraryMeta = ArbitraryMeta { unArbitraryMeta :: Meta }
deriving newtype (Eq, Ord, Semigroup, Monoid, Show, Read) deriving newtype (Eq, Ord, Semigroup, Monoid, Show, Read, Typable, Data, Generic)
newtype ArbitraryPandoc = ArbitraryPandoc { unArbitraryPandoc :: Pandoc }
deriving newtype (Eq, Ord, Show, Read, Typable, Data, Generic)
instance Arbitrary ArbitraryMeta where instance Arbitrary ArbitraryMeta where
arbitrary arbitrary = do
= do (x1 :: Inlines) <- arbitrary (x1 :: Inlines) <- arbitrary
(x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary (x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary
(x3 :: Inlines) <- arbitrary (x3 :: Inlines) <- arbitrary
(x4 :: [(Text, Text)]) <- filter (not . T.null . fst) <$> arbitrary (x4 :: [(Text, Text)]) <- filter (not . T.null . fst) <$> arbitrary
(x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> arbitrary (x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> arbitrary
return $ ArbitraryMeta return $ ArbitraryMeta
$ setMeta "title" x1 $ setMeta "title" x1
$ setMeta "author" x2 $ setMeta "author" x2
$ setMeta "date" x3 $ setMeta "date" x3
$ applyMetas (fmap (second Just) x4) $ applyMetas (fmap (second Just) x4)
$ applyMetas (fmap (second Just) x5) $ applyMetas (fmap (second Just) x5)
nullMeta nullMeta
instance Arbitrary ArbitraryPandoc where
arbitrary = do
meta <- arbitrary
ArbitraryPandoc . Pandoc (unArbitraryMeta meta) <$> arbitrary
-- For Lens Check _Meta required: -- For Lens Check _Meta required:
@ -47,49 +55,47 @@ spec = do
describe "applyMetas" $ do describe "applyMetas" $ do
it "should actually set values" $ do it "should actually set values" $ do
(ml, abMetaOriginal, blocks) <- generate arbitrary (metaList, apd) <- generate arbitrary
let let
metaOriginal = unArbitraryMeta abMetaOriginal pd = unArbitraryPandoc apd
pd = Pandoc metaOriginal blocks (Pandoc metaNew _) = applyMetas (second (Just . MetaString) <$> metaList) pd
mlKeys = Set.fromList $ fst <$> ml mlKeys = Set.fromList $ fst <$> metaList
(Pandoc newMeta _) = applyMetas (fmap (Just . MetaString) <$> ml) pd metaList' = [(k,t) | (k, MetaString t) <- mlist metaNew, Set.member k mlKeys]
ml' = [(k,t) | (k, MetaString t) <- mlist newMeta, Set.member k mlKeys] metaList' `shouldMatchList` metaList
ml `shouldMatchList` ml'
it "should preserve untouched settings" $ do it "should preserve untouched settings" $ do
(ml, abMetaOriginal, blocks) <- generate arbitrary (metaList, apd) <- generate arbitrary
let let
metaOriginal = unArbitraryMeta abMetaOriginal pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
pd = Pandoc metaOriginal blocks changedKeys = Set.fromList [k | (k, Just _) <- metaList]
nullKeys = Set.fromList [k | (k, Nothing) <- ml] (Pandoc metaNew _) = applyMetas (second (fmap MetaString) <$> metaList) pd
(Pandoc newMeta _) = applyMetas (fmap (fmap MetaString) <$> ml) pd oldm = [(k,t) | (k,t) <- mlist metaOriginal , Set.notMember k changedKeys]
oldm = [(k,t) | (k, t) <- mlist metaOriginal , Set.member k nullKeys] newm = [(k,t) | (k,t) <- mlist metaNew , Set.notMember k changedKeys]
newm = [(k,t) | (k, t) <- mlist newMeta , Set.member k nullKeys]
oldm `shouldMatchList` newm oldm `shouldMatchList` newm
describe "addMeta" $ do describe "addMeta" $ do
it "should possibly overwrite existing settings" $ do it "should possibly overwrite existing settings" $ do
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary (abMetaOverwrite, apd) <- generate arbitrary
let let
metaOverwrite = unArbitraryMeta abMetaOverwrite metaOverwrite = unArbitraryMeta abMetaOverwrite
metaOriginal = unArbitraryMeta abMetaOriginal pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
pd = Pandoc metaOriginal blocks
(Pandoc newMeta _) = addMeta metaOverwrite pd (Pandoc newMeta _) = addMeta metaOverwrite pd
(unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True (unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
it "should preserve untouched settings" $ do it "should preserve untouched settings" $ do
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary (abMetaOverwrite, apd) <- generate arbitrary
let let
metaOverwrite = unArbitraryMeta abMetaOverwrite metaOverwrite = unArbitraryMeta abMetaOverwrite
metaOriginal = unArbitraryMeta abMetaOriginal pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
pd = Pandoc metaOriginal blocks
(Pandoc newMeta _) = addMeta metaOverwrite pd (Pandoc newMeta _) = addMeta metaOverwrite pd
((unMeta metaOriginal `Map.difference` unMeta metaOverwrite) `Map.isSubmapOf` unMeta newMeta) `shouldBe` True ((unMeta metaOriginal `Map.difference` unMeta metaOverwrite) `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
it "should preserve document blocks" $ do it "should preserve document blocks" $ do
(metaOverwrite, pd) <- generate arbitrary (abMetaOverwrite, apd) <- generate arbitrary
let let
(Pandoc _ oldBlocks) = pd metaOverwrite = unArbitraryMeta abMetaOverwrite
(Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd pd@(Pandoc _ oldBlocks) = unArbitraryPandoc apd
(Pandoc _ newBlocks) = addMeta metaOverwrite pd
newBlocks `shouldBe` oldBlocks newBlocks `shouldBe` oldBlocks
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta -- describe "_Meta" . it "is a lens" . property $ isLens _Meta