refactor(tests): pandoc tests simplified

This commit is contained in:
Steffen Jost 2022-07-20 17:31:05 +02:00
parent d5214e49ab
commit 085b7ba3e8
3 changed files with 6 additions and 9 deletions

View File

@ -36,7 +36,7 @@ isLmsSuccess :: LmsStatus -> Bool
isLmsSuccess LmsSuccess{} = True
isLmsSuccess _other = False
-- Entscheidung 08.04.22: LmsSuccess gewinnt immer über LmsBlocked oder umgekehrt
-- Entscheidung 08.04.22: LmsSuccess gewinnt immer über LmsBlocked oder umgekehrt; siehe Model.TypesSpec
instance Semigroup LmsStatus where
a <> b | a >= b = a
| otherwise = b

View File

@ -70,11 +70,12 @@ appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc
appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs
-- appMeta f = _Meta %~ f -- lens version. Not sure this is better
-- Add tests for applyMetas, if ever needed
-- For tests see module PandocSpec
applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
-- | Add meta to pandoc. Existing variables will be overwritten.
-- For specification, see module PandocSpec
addMeta :: P.Meta -> P.Pandoc -> P.Pandoc
addMeta m = appMeta (<> m) -- Data.Map says: (<>) == union and union should prefer the left operand, but somehow it does not!
--addMeta m p = meta <> p

View File

@ -62,8 +62,7 @@ spec = do
metaOriginal = unArbitraryMeta abMetaOriginal
pd = Pandoc metaOriginal blocks
(Pandoc newMeta _) = addMeta metaOverwrite pd
keysToPreserve = Map.keysSet $ unMeta metaOverwrite
mlist metaOverwrite `shouldMatchList` Map.toList (unMeta newMeta `Map.restrictKeys` keysToPreserve)
(unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
it "should preserve untouched settings" $ do
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
@ -72,16 +71,13 @@ spec = do
metaOriginal = unArbitraryMeta abMetaOriginal
pd = Pandoc metaOriginal blocks
(Pandoc newMeta _) = addMeta metaOverwrite pd
keysToPreserve = Map.keysSet (unMeta metaOriginal) `Set.difference` Map.keysSet (unMeta metaOverwrite)
Map.toList (Map.restrictKeys (unMeta newMeta) keysToPreserve)
`shouldMatchList`
Map.toList (Map.restrictKeys (unMeta metaOriginal) keysToPreserve)
((unMeta metaOriginal `Map.difference` unMeta metaOverwrite) `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
it "should preserve document blocks" $ do
(metaOverwrite, pd) <- generate arbitrary
let
(Pandoc _ oldBlocks) = pd
(Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd
oldBlocks `shouldBe` newBlocks
newBlocks `shouldBe` oldBlocks
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta