diff --git a/test/PandocSpec.hs b/test/PandocSpec.hs index 135f702ea..e52f83752 100644 --- a/test/PandocSpec.hs +++ b/test/PandocSpec.hs @@ -15,22 +15,30 @@ 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) + 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 - arbitrary - = do (x1 :: Inlines) <- arbitrary - (x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary - (x3 :: Inlines) <- arbitrary - (x4 :: [(Text, Text)]) <- filter (not . T.null . fst) <$> arbitrary - (x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> arbitrary - return $ ArbitraryMeta - $ setMeta "title" x1 - $ setMeta "author" x2 - $ setMeta "date" x3 - $ applyMetas (fmap (second Just) x4) - $ applyMetas (fmap (second Just) x5) - nullMeta + arbitrary = do + (x1 :: Inlines) <- arbitrary + (x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary + (x3 :: Inlines) <- arbitrary + (x4 :: [(Text, Text)]) <- filter (not . T.null . fst) <$> arbitrary + (x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> 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 -- For Lens Check _Meta required: @@ -47,49 +55,47 @@ spec = do describe "applyMetas" $ do it "should actually set values" $ do - (ml, abMetaOriginal, blocks) <- generate arbitrary + (metaList, apd) <- generate arbitrary let - metaOriginal = unArbitraryMeta abMetaOriginal - pd = Pandoc metaOriginal blocks - mlKeys = Set.fromList $ fst <$> ml - (Pandoc newMeta _) = applyMetas (fmap (Just . MetaString) <$> ml) pd - ml' = [(k,t) | (k, MetaString t) <- mlist newMeta, Set.member k mlKeys] - ml `shouldMatchList` ml' + pd = unArbitraryPandoc apd + (Pandoc metaNew _) = applyMetas (second (Just . MetaString) <$> metaList) pd + mlKeys = Set.fromList $ fst <$> metaList + metaList' = [(k,t) | (k, MetaString t) <- mlist metaNew, Set.member k mlKeys] + metaList' `shouldMatchList` metaList + it "should preserve untouched settings" $ do - (ml, abMetaOriginal, blocks) <- generate arbitrary + (metaList, apd) <- generate arbitrary let - metaOriginal = unArbitraryMeta abMetaOriginal - pd = Pandoc metaOriginal blocks - nullKeys = Set.fromList [k | (k, Nothing) <- ml] - (Pandoc newMeta _) = applyMetas (fmap (fmap MetaString) <$> ml) pd - oldm = [(k,t) | (k, t) <- mlist metaOriginal , Set.member k nullKeys] - newm = [(k,t) | (k, t) <- mlist newMeta , Set.member k nullKeys] + 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, abMetaOriginal, blocks) <- generate arbitrary - let - metaOverwrite = unArbitraryMeta abMetaOverwrite - metaOriginal = unArbitraryMeta abMetaOriginal - pd = Pandoc metaOriginal blocks + (abMetaOverwrite, apd) <- generate arbitrary + let + metaOverwrite = unArbitraryMeta abMetaOverwrite + pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd (Pandoc newMeta _) = addMeta metaOverwrite pd (unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True it "should preserve untouched settings" $ do - (abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary + (abMetaOverwrite, apd) <- generate arbitrary let metaOverwrite = unArbitraryMeta abMetaOverwrite - metaOriginal = unArbitraryMeta abMetaOriginal - pd = Pandoc metaOriginal blocks + 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 - (metaOverwrite, pd) <- generate arbitrary + (abMetaOverwrite, apd) <- generate arbitrary let - (Pandoc _ oldBlocks) = pd - (Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd + 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 \ No newline at end of file